1/*  Part of SWI-Prolog
   2
   3    Author:        Jan Wielemaker
   4    E-mail:        J.Wielemaker@vu.nl
   5    WWW:           http://www.swi-prolog.org
   6    Copyright (c)  1985-2015, University of Amsterdam
   7                              VU University Amsterdam
   8    All rights reserved.
   9
  10    Redistribution and use in source and binary forms, with or without
  11    modification, are permitted provided that the following conditions
  12    are met:
  13
  14    1. Redistributions of source code must retain the above copyright
  15       notice, this list of conditions and the following disclaimer.
  16
  17    2. Redistributions in binary form must reproduce the above copyright
  18       notice, this list of conditions and the following disclaimer in
  19       the documentation and/or other materials provided with the
  20       distribution.
  21
  22    THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
  23    "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
  24    LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS
  25    FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE
  26    COPYRIGHT OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT,
  27    INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING,
  28    BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES;
  29    LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER
  30    CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
  31    LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN
  32    ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
  33    POSSIBILITY OF SUCH DAMAGE.
  34*/
  35
  36:- module('$syspreds',
  37          [ leash/1,
  38            visible/1,
  39            style_check/1,
  40            (spy)/1,
  41            (nospy)/1,
  42            trace/1,
  43            trace/2,
  44            nospyall/0,
  45            debugging/0,
  46            rational/3,
  47            flag/3,
  48            atom_prefix/2,
  49            dwim_match/2,
  50            source_file_property/2,
  51            source_file/1,
  52            source_file/2,
  53            unload_file/1,
  54            prolog_load_context/2,
  55            stream_position_data/3,
  56            current_predicate/2,
  57            '$defined_predicate'/1,
  58            predicate_property/2,
  59            '$predicate_property'/2,
  60            clause_property/2,
  61            current_module/1,                   % ?Module
  62            module_property/2,                  % ?Module, ?Property
  63            module/1,                           % +Module
  64            current_trie/1,                     % ?Trie
  65            trie_property/2,                    % ?Trie, ?Property
  66            working_directory/2,                % -OldDir, +NewDir
  67            shell/1,                            % +Command
  68            on_signal/3,
  69            current_signal/3,
  70            open_shared_object/2,
  71            open_shared_object/3,
  72            format/1,
  73            garbage_collect/0,
  74            set_prolog_stack/2,
  75            prolog_stack_property/2,
  76            absolute_file_name/2,
  77            require/1,
  78            call_with_depth_limit/3,    % :Goal, +Limit, -Result
  79            call_with_inference_limit/3,% :Goal, +Limit, -Result
  80            numbervars/3,               % +Term, +Start, -End
  81            term_string/3,              % ?Term, ?String, +Options
  82            nb_setval/2                 % +Var, +Value
  83          ]).
  84
  85                /********************************
  86                *           DEBUGGER            *
  87                *********************************/
  88
  89%!  map_bits(:Pred, +Modify, +OldBits, -NewBits)
  90
  91:- meta_predicate
  92    map_bits(2, +, +, -).
  93
  94map_bits(_, Var, _, _) :-
  95    var(Var),
  96    !,
  97    '$instantiation_error'(Var).
  98map_bits(_, [], Bits, Bits) :- !.
  99map_bits(Pred, [H|T], Old, New) :-
 100    map_bits(Pred, H, Old, New0),
 101    map_bits(Pred, T, New0, New).
 102map_bits(Pred, +Name, Old, New) :-     % set a bit
 103    !,
 104    bit(Pred, Name, Bits),
 105    !,
 106    New is Old \/ Bits.
 107map_bits(Pred, -Name, Old, New) :-     % clear a bit
 108    !,
 109    bit(Pred, Name, Bits),
 110    !,
 111    New is Old /\ (\Bits).
 112map_bits(Pred, ?(Name), Old, Old) :-   % ask a bit
 113    !,
 114    bit(Pred, Name, Bits),
 115    Old /\ Bits > 0.
 116map_bits(_, Term, _, _) :-
 117    '$type_error'('+|-|?(Flag)', Term).
 118
 119bit(Pred, Name, Bits) :-
 120    call(Pred, Name, Bits),
 121    !.
 122bit(_:Pred, Name, _) :-
 123    '$domain_error'(Pred, Name).
 124
 125:- public port_name/2.                  % used by library(test_cover)
 126
 127port_name(      call, 2'000000001).
 128port_name(      exit, 2'000000010).
 129port_name(      fail, 2'000000100).
 130port_name(      redo, 2'000001000).
 131port_name(     unify, 2'000010000).
 132port_name(     break, 2'000100000).
 133port_name(  cut_call, 2'001000000).
 134port_name(  cut_exit, 2'010000000).
 135port_name( exception, 2'100000000).
 136port_name(       cut, 2'011000000).
 137port_name(       all, 2'000111111).
 138port_name(      full, 2'000101111).
 139port_name(      half, 2'000101101).     % '
 140
 141leash(Ports) :-
 142    '$leash'(Old, Old),
 143    map_bits(port_name, Ports, Old, New),
 144    '$leash'(_, New).
 145
 146visible(Ports) :-
 147    '$visible'(Old, Old),
 148    map_bits(port_name, Ports, Old, New),
 149    '$visible'(_, New).
 150
 151style_name(atom,            0x0001) :-
 152    print_message(warning, decl_no_effect(style_check(atom))).
 153style_name(singleton,       0x0042).            % semantic and syntactic
 154style_name(discontiguous,   0x0008).
 155style_name(charset,         0x0020).
 156style_name(no_effect,       0x0080).
 157style_name(var_branches,    0x0100).
 158
 159%!  style_check(+Spec) is nondet.
 160
 161style_check(Var) :-
 162    var(Var),
 163    !,
 164    '$instantiation_error'(Var).
 165style_check(?(Style)) :-
 166    !,
 167    (   var(Style)
 168    ->  enum_style_check(Style)
 169    ;   enum_style_check(Style)
 170    ->  true
 171    ).
 172style_check(Spec) :-
 173    '$style_check'(Old, Old),
 174    map_bits(style_name, Spec, Old, New),
 175    '$style_check'(_, New).
 176
 177enum_style_check(Style) :-
 178    '$style_check'(Bits, Bits),
 179    style_name(Style, Bit),
 180    Bit /\ Bits =\= 0.
 181
 182
 183%!  prolog:debug_control_hook(+Action)
 184%
 185%   Allow user-hooks in the Prolog debugger interaction.  See the calls
 186%   below for the provided hooks.  We use a single predicate with action
 187%   argument to avoid an uncontrolled poliferation of hooks.
 188%
 189%   TBD: What hooks to provide for trace/[1,2]
 190
 191:- multifile
 192    prolog:debug_control_hook/1.    % +Action
 193
 194%!  trace(:Preds) is det.
 195%!  trace(:Preds, +PortSpec) is det.
 196%
 197%   Start printing messages if control passes specified ports of
 198%   the given predicates.
 199
 200:- meta_predicate
 201    trace(:),
 202    trace(:, +).
 203
 204trace(Preds) :-
 205    trace(Preds, +all).
 206
 207trace(_:X, _) :-
 208    var(X),
 209    !,
 210    throw(error(instantiation_error, _)).
 211trace(_:[], _) :- !.
 212trace(M:[H|T], Ps) :-
 213    !,
 214    trace(M:H, Ps),
 215    trace(M:T, Ps).
 216trace(Pred, Ports) :-
 217    '$find_predicate'(Pred, Preds),
 218    Preds \== [],
 219    set_prolog_flag(debug, true),
 220    (   '$member'(PI, Preds),
 221            pi_to_head(PI, Head),
 222            (   Head = _:_
 223            ->  QHead0 = Head
 224            ;   QHead0 = user:Head
 225            ),
 226            '$define_predicate'(QHead0),
 227            (   predicate_property(QHead0, imported_from(M))
 228            ->  QHead0 = _:Plain,
 229                QHead = M:Plain
 230            ;   QHead = QHead0
 231            ),
 232            '$trace'(Ports, QHead),
 233            trace_ports(QHead, Tracing),
 234            print_message(informational, trace(QHead, Tracing)),
 235        fail
 236    ;   true
 237    ).
 238
 239trace_alias(all,  [trace_call, trace_redo, trace_exit, trace_fail]).
 240trace_alias(call, [trace_call]).
 241trace_alias(redo, [trace_redo]).
 242trace_alias(exit, [trace_exit]).
 243trace_alias(fail, [trace_fail]).
 244
 245'$trace'([], _) :- !.
 246'$trace'([H|T], Head) :-
 247    !,
 248    '$trace'(H, Head),
 249    '$trace'(T, Head).
 250'$trace'(+H, Head) :-
 251    trace_alias(H, A0),
 252    !,
 253    tag_list(A0, +, A1),
 254    '$trace'(A1, Head).
 255'$trace'(+H, Head) :-
 256    !,
 257    trace_alias(_, [H]),
 258    '$set_predicate_attribute'(Head, H, true).
 259'$trace'(-H, Head) :-
 260    trace_alias(H, A0),
 261    !,
 262    tag_list(A0, -, A1),
 263    '$trace'(A1, Head).
 264'$trace'(-H, Head) :-
 265    !,
 266    trace_alias(_, [H]),
 267    '$set_predicate_attribute'(Head, H, false).
 268'$trace'(H, Head) :-
 269    atom(H),
 270    '$trace'(+H, Head).
 271
 272tag_list([], _, []).
 273tag_list([H0|T0], F, [H1|T1]) :-
 274    H1 =.. [F, H0],
 275    tag_list(T0, F, T1).
 276
 277:- meta_predicate
 278    spy(:),
 279    nospy(:).
 280
 281%!  spy(:Spec) is det.
 282%!  nospy(:Spec) is det.
 283%!  nospyall is det.
 284%
 285%   Set/clear spy-points. A successfully set or cleared spy-point is
 286%   reported using print_message/2, level  =informational=, with one
 287%   of the following terms, where Spec is of the form M:Head.
 288%
 289%       - spy(Spec)
 290%       - nospy(Spec)
 291%
 292%   @see    spy/1 and nospy/1 call the hook prolog:debug_control_hook/1
 293%           to allow for alternative specifications of the thing to
 294%           debug.
 295
 296spy(_:X) :-
 297    var(X),
 298    throw(error(instantiation_error, _)).
 299spy(_:[]) :- !.
 300spy(M:[H|T]) :-
 301    !,
 302    spy(M:H),
 303    spy(M:T).
 304spy(Spec) :-
 305    notrace(prolog:debug_control_hook(spy(Spec))),
 306    !.
 307spy(Spec) :-
 308    '$find_predicate'(Spec, Preds),
 309    '$member'(PI, Preds),
 310        pi_to_head(PI, Head),
 311        '$define_predicate'(Head),
 312        '$spy'(Head),
 313    fail.
 314spy(_).
 315
 316nospy(_:X) :-
 317    var(X),
 318    throw(error(instantiation_error, _)).
 319nospy(_:[]) :- !.
 320nospy(M:[H|T]) :-
 321    !,
 322    nospy(M:H),
 323    nospy(M:T).
 324nospy(Spec) :-
 325    notrace(prolog:debug_control_hook(nospy(Spec))),
 326    !.
 327nospy(Spec) :-
 328    '$find_predicate'(Spec, Preds),
 329    '$member'(PI, Preds),
 330         pi_to_head(PI, Head),
 331        '$nospy'(Head),
 332    fail.
 333nospy(_).
 334
 335nospyall :-
 336    notrace(prolog:debug_control_hook(nospyall)),
 337    fail.
 338nospyall :-
 339    spy_point(Head),
 340        '$nospy'(Head),
 341    fail.
 342nospyall.
 343
 344pi_to_head(M:PI, M:Head) :-
 345    !,
 346    pi_to_head(PI, Head).
 347pi_to_head(Name/Arity, Head) :-
 348    functor(Head, Name, Arity).
 349
 350%!  debugging is det.
 351%
 352%   Report current status of the debugger.
 353
 354debugging :-
 355    notrace(prolog:debug_control_hook(debugging)),
 356    !.
 357debugging :-
 358    current_prolog_flag(debug, true),
 359    !,
 360    print_message(informational, debugging(on)),
 361    findall(H, spy_point(H), SpyPoints),
 362    print_message(informational, spying(SpyPoints)),
 363    findall(trace(H,P), trace_point(H,P), TracePoints),
 364    print_message(informational, tracing(TracePoints)).
 365debugging :-
 366    print_message(informational, debugging(off)).
 367
 368spy_point(Module:Head) :-
 369    current_predicate(_, Module:Head),
 370    '$get_predicate_attribute'(Module:Head, spy, 1),
 371    \+ predicate_property(Module:Head, imported_from(_)).
 372
 373trace_point(Module:Head, Ports) :-
 374    current_predicate(_, Module:Head),
 375        '$get_predicate_attribute'(Module:Head, trace_any, 1),
 376        \+ predicate_property(Module:Head, imported_from(_)),
 377        trace_ports(Module:Head, Ports).
 378
 379trace_ports(Head, Ports) :-
 380    findall(Port,
 381            (trace_alias(Port, [AttName]),
 382             '$get_predicate_attribute'(Head, AttName, 1)),
 383            Ports).
 384
 385
 386%!  flag(+Name, -Old, +New) is det.
 387%
 388%   True when Old is the current value associated with the flag Name
 389%   and New has become the new value.
 390
 391flag(Name, Old, New) :-
 392    Old == New,
 393    !,
 394    get_flag(Name, Old).
 395flag(Name, Old, New) :-
 396    with_mutex('$flag', update_flag(Name, Old, New)).
 397
 398update_flag(Name, Old, New) :-
 399    get_flag(Name, Old),
 400    (   atom(New)
 401    ->  set_flag(Name, New)
 402    ;   Value is New,
 403        set_flag(Name, Value)
 404    ).
 405
 406
 407                 /*******************************
 408                 *            RATIONAL          *
 409                 *******************************/
 410
 411%!  rational(+Rat, -Numerator, -Denominator) is semidet.
 412%
 413%   True when Rat is a  rational   number  with  given Numerator and
 414%   Denominator.
 415
 416rational(Rat, M, N) :-
 417    rational(Rat),
 418    (   Rat = rdiv(M, N)
 419    ->  true
 420    ;   integer(Rat)
 421    ->  M = Rat,
 422        N = 1
 423    ).
 424
 425
 426                /********************************
 427                *             ATOMS             *
 428                *********************************/
 429
 430dwim_match(A1, A2) :-
 431    dwim_match(A1, A2, _).
 432
 433atom_prefix(Atom, Prefix) :-
 434    sub_atom(Atom, 0, _, _, Prefix).
 435
 436
 437                /********************************
 438                *             SOURCE            *
 439                *********************************/
 440
 441%!  source_file(-File) is nondet.
 442%!  source_file(+File) is semidet.
 443%
 444%   True if File is loaded into  Prolog.   If  File is unbound it is
 445%   bound to the canonical name for it. If File is bound it succeeds
 446%   if the canonical name  as   defined  by  absolute_file_name/2 is
 447%   known as a loaded filename.
 448%
 449%   Note that Time = 0.0 is used by  PlDoc and other code that needs
 450%   to create a file record without being interested in the time.
 451
 452source_file(File) :-
 453    (   current_prolog_flag(access_level, user)
 454    ->  Level = user
 455    ;   true
 456    ),
 457    (   ground(File)
 458    ->  (   '$time_source_file'(File, Time, Level)
 459        ;   absolute_file_name(File, Abs),
 460            '$time_source_file'(Abs, Time, Level)
 461        ), !
 462    ;   '$time_source_file'(File, Time, Level)
 463    ),
 464    Time > 0.0.
 465
 466%!  source_file(+Head, -File) is semidet.
 467%!  source_file(?Head, ?File) is nondet.
 468%
 469%   True when Head is a predicate owned by File.
 470
 471:- meta_predicate source_file(:, ?).
 472
 473source_file(M:Head, File) :-
 474    nonvar(M), nonvar(Head),
 475    !,
 476    (   predicate_property(M:Head, multifile)
 477    ->  multi_source_files(M:Head, Files),
 478        '$member'(File, Files)
 479    ;   '$source_file'(M:Head, File)
 480    ).
 481source_file(M:Head, File) :-
 482    (   nonvar(File)
 483    ->  true
 484    ;   source_file(File)
 485    ),
 486    '$source_file_predicates'(File, Predicates),
 487    '$member'(M:Head, Predicates).
 488
 489:- thread_local found_src_file/1.
 490
 491multi_source_files(Head, Files) :-
 492    call_cleanup(
 493        findall(File, multi_source_file(Head, File), Files),
 494        retractall(found_src_file(_))).
 495
 496multi_source_file(Head, File) :-
 497    nth_clause(Head, _, Clause),
 498    clause_property(Clause, source(File)),
 499    \+ found_src_file(File),
 500    asserta(found_src_file(File)).
 501
 502
 503%!  source_file_property(?File, ?Property) is nondet.
 504%
 505%   True if Property is a property of the loaded source-file File.
 506
 507source_file_property(File, P) :-
 508    nonvar(File),
 509    !,
 510    canonical_source_file(File, Path),
 511    property_source_file(P, Path).
 512source_file_property(File, P) :-
 513    property_source_file(P, File).
 514
 515property_source_file(modified(Time), File) :-
 516    '$time_source_file'(File, Time, user).
 517property_source_file(module(M), File) :-
 518    (   nonvar(M)
 519    ->  '$current_module'(M, File)
 520    ;   nonvar(File)
 521    ->  '$current_module'(ML, File),
 522        (   atom(ML)
 523        ->  M = ML
 524        ;   '$member'(M, ML)
 525        )
 526    ;   '$current_module'(M, File)
 527    ).
 528property_source_file(load_context(Module, Location, Options), File) :-
 529    '$time_source_file'(File, _, user),
 530    clause(system:'$load_context_module'(File, Module, Options), true, Ref),
 531    (   clause_property(Ref, file(FromFile)),
 532        clause_property(Ref, line_count(FromLine))
 533    ->  Location = FromFile:FromLine
 534    ;   Location = user
 535    ).
 536property_source_file(includes(Master, Stamp), File) :-
 537    system:'$included'(File, _Line, Master, Stamp).
 538property_source_file(included_in(Master, Line), File) :-
 539    system:'$included'(Master, Line, File, _).
 540property_source_file(derived_from(DerivedFrom, Stamp), File) :-
 541    system:'$derived_source'(File, DerivedFrom, Stamp).
 542property_source_file(reloading, File) :-
 543    source_file(File),
 544    '$source_file_property'(File, reloading, true).
 545property_source_file(load_count(Count), File) :-
 546    source_file(File),
 547    '$source_file_property'(File, load_count, Count).
 548property_source_file(number_of_clauses(Count), File) :-
 549    source_file(File),
 550    '$source_file_property'(File, number_of_clauses, Count).
 551
 552
 553%!  canonical_source_file(+Spec, -File) is semidet.
 554%
 555%   File is the canonical representation of the source-file Spec.
 556
 557canonical_source_file(Spec, File) :-
 558    atom(Spec),
 559    '$time_source_file'(Spec, _, _),
 560    !,
 561    File = Spec.
 562canonical_source_file(Spec, File) :-
 563    system:'$included'(_Master, _Line, Spec, _),
 564    !,
 565    File = Spec.
 566canonical_source_file(Spec, File) :-
 567    absolute_file_name(Spec,
 568                           [ file_type(prolog),
 569                             access(read),
 570                             file_errors(fail)
 571                           ],
 572                           File),
 573    source_file(File).
 574
 575
 576%!  prolog_load_context(+Key, -Value)
 577%
 578%   Provides context information for  term_expansion and directives.
 579%   Note  that  only  the  line-number  info    is   valid  for  the
 580%   '$stream_position'. Largely Quintus compatible.
 581
 582prolog_load_context(module, Module) :-
 583    '$current_source_module'(Module).
 584prolog_load_context(file, F) :-
 585    source_location(F, _).
 586prolog_load_context(source, F) :-       % SICStus compatibility
 587    source_location(F0, _),
 588    '$input_context'(Context),
 589    '$top_file'(Context, F0, F).
 590prolog_load_context(stream, S) :-
 591    source_location(F, _),
 592    (   system:'$load_input'(F, S0)
 593    ->  S = S0
 594    ).
 595prolog_load_context(directory, D) :-
 596    source_location(F, _),
 597    file_directory_name(F, D).
 598prolog_load_context(dialect, D) :-
 599    current_prolog_flag(emulated_dialect, D).
 600prolog_load_context(term_position, TermPos) :-
 601    source_location(_, L),
 602    (   nb_current('$term_position', Pos),
 603        compound(Pos),              % actually set
 604        stream_position_data(line_count, Pos, L)
 605    ->  TermPos = Pos
 606    ;   TermPos = '$stream_position'(0,L,0,0)
 607    ).
 608prolog_load_context(script, Bool) :-
 609    (   '$toplevel':loaded_init_file(script, Path),
 610        source_location(Path, _)
 611    ->  Bool = true
 612    ;   Bool = false
 613    ).
 614prolog_load_context(variable_names, Bindings) :-
 615    nb_current('$variable_names', Bindings).
 616prolog_load_context(term, Term) :-
 617    nb_current('$term', Term).
 618prolog_load_context(reloading, true) :-
 619    prolog_load_context(source, F),
 620    '$source_file_property'(F, reloading, true).
 621
 622%!  unload_file(+File) is det.
 623%
 624%   Remove all traces of loading file.
 625
 626unload_file(File) :-
 627    (   canonical_source_file(File, Path)
 628    ->  '$unload_file'(Path)
 629    ;   true
 630    ).
 631
 632
 633                 /*******************************
 634                 *            STREAMS           *
 635                 *******************************/
 636
 637%!  stream_position_data(?Field, +Pos, ?Date)
 638%
 639%   Extract values from stream position objects. '$stream_position' is
 640%   of the format '$stream_position'(Byte, Char, Line, LinePos)
 641
 642stream_position_data(Prop, Term, Value) :-
 643    nonvar(Prop),
 644    !,
 645    (   stream_position_field(Prop, Pos)
 646    ->  arg(Pos, Term, Value)
 647    ;   throw(error(domain_error(stream_position_data, Prop)))
 648    ).
 649stream_position_data(Prop, Term, Value) :-
 650    stream_position_field(Prop, Pos),
 651    arg(Pos, Term, Value).
 652
 653stream_position_field(char_count,    1).
 654stream_position_field(line_count,    2).
 655stream_position_field(line_position, 3).
 656stream_position_field(byte_count,    4).
 657
 658
 659                 /*******************************
 660                 *            CONTROL           *
 661                 *******************************/
 662
 663%!  call_with_depth_limit(:Goal, +DepthLimit, -Result)
 664%
 665%   Try to proof Goal, but fail on any branch exceeding the indicated
 666%   depth-limit.  Unify Result with the maximum-reached limit on success,
 667%   depth_limit_exceeded if the limit was exceeded and fails otherwise.
 668
 669:- meta_predicate
 670    call_with_depth_limit(0, +, -).
 671
 672call_with_depth_limit(G, Limit, Result) :-
 673    '$depth_limit'(Limit, OLimit, OReached),
 674    (   catch(G, E, '$depth_limit_except'(OLimit, OReached, E)),
 675        '$depth_limit_true'(Limit, OLimit, OReached, Result, Det),
 676        ( Det == ! -> ! ; true )
 677    ;   '$depth_limit_false'(OLimit, OReached, Result)
 678    ).
 679
 680%!  call_with_inference_limit(:Goal, +InferenceLimit, -Result)
 681%
 682%   Equivalent to call(Goal), but poses  a   limit  on the number of
 683%   inferences. If this limit is  reached,   Result  is unified with
 684%   =inference_limit_exceeded=, otherwise Result  is   unified  with
 685%   =|!|=  if  Goal  succeeded  without  a  choicepoint  and  =true=
 686%   otherwise.
 687%
 688%   Note that we perform calls in   system  to avoid auto-importing,
 689%   which makes raiseInferenceLimitException()  fail   to  recognise
 690%   that the exception happens in the overhead.
 691
 692:- meta_predicate
 693    call_with_inference_limit(0, +, -).
 694
 695call_with_inference_limit(G, Limit, Result) :-
 696    '$inference_limit'(Limit, OLimit),
 697    (   catch(G, Except,
 698              system:'$inference_limit_except'(OLimit, Except, Result0)),
 699        system:'$inference_limit_true'(Limit, OLimit, Result0),
 700        ( Result0 == ! -> ! ; true ),
 701        Result = Result0
 702    ;   system:'$inference_limit_false'(OLimit)
 703    ).
 704
 705
 706                /********************************
 707                *           DATA BASE           *
 708                *********************************/
 709
 710/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
 711The predicate current_predicate/2 is   a  difficult subject since  the
 712introduction  of defaulting     modules   and   dynamic     libraries.
 713current_predicate/2 is normally  called with instantiated arguments to
 714verify some  predicate can   be called without trapping   an undefined
 715predicate.  In this case we must  perform the search algorithm used by
 716the prolog system itself.
 717
 718If the pattern is not fully specified, we only generate the predicates
 719actually available in this  module.   This seems the best for listing,
 720etc.
 721- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
 722
 723
 724:- meta_predicate
 725    current_predicate(?, :),
 726    '$defined_predicate'(:).
 727
 728current_predicate(Name, Module:Head) :-
 729    (var(Module) ; var(Head)),
 730    !,
 731    generate_current_predicate(Name, Module, Head).
 732current_predicate(Name, Term) :-
 733    '$c_current_predicate'(Name, Term),
 734    '$defined_predicate'(Term),
 735    !.
 736current_predicate(Name, Module:Head) :-
 737    default_module(Module, DefModule),
 738    '$c_current_predicate'(Name, DefModule:Head),
 739    '$defined_predicate'(DefModule:Head),
 740    !.
 741current_predicate(Name, Module:Head) :-
 742    current_prolog_flag(autoload, true),
 743    \+ current_prolog_flag(Module:unknown, fail),
 744    (   compound(Head)
 745    ->  compound_name_arity(Head, Name, Arity)
 746    ;   Name = Head, Arity = 0
 747    ),
 748    '$find_library'(Module, Name, Arity, _LoadModule, _Library),
 749    !.
 750
 751generate_current_predicate(Name, Module, Head) :-
 752    current_module(Module),
 753    QHead = Module:Head,
 754    '$c_current_predicate'(Name, QHead),
 755    '$get_predicate_attribute'(QHead, defined, 1).
 756
 757'$defined_predicate'(Head) :-
 758    '$get_predicate_attribute'(Head, defined, 1),
 759    !.
 760
 761%!  predicate_property(?Predicate, ?Property) is nondet.
 762%
 763%   True when Property is a property of Predicate.
 764
 765:- meta_predicate
 766    predicate_property(:, ?).
 767
 768:- '$iso'(predicate_property/2).
 769
 770predicate_property(Pred, Property) :-           % Mode ?,+
 771    nonvar(Property),
 772    !,
 773    property_predicate(Property, Pred).
 774predicate_property(Pred, Property) :-           % Mode +,-
 775    define_or_generate(Pred),
 776    '$predicate_property'(Property, Pred).
 777
 778%!  property_predicate(+Property, ?Pred)
 779%
 780%   First handle the special  cases  that   are  not  about querying
 781%   normally  defined  predicates:   =undefined=,    =visible=   and
 782%   =autoload=, followed by the generic case.
 783
 784property_predicate(undefined, Pred) :-
 785    !,
 786    Pred = Module:Head,
 787    current_module(Module),
 788    '$c_current_predicate'(_, Pred),
 789    \+ '$defined_predicate'(Pred),          % Speed up a bit
 790    \+ current_predicate(_, Pred),
 791    goal_name_arity(Head, Name, Arity),
 792    \+ system_undefined(Module:Name/Arity).
 793property_predicate(visible, Pred) :-
 794    !,
 795    visible_predicate(Pred).
 796property_predicate(autoload(File), _:Head) :-
 797    !,
 798    current_prolog_flag(autoload, true),
 799    (   callable(Head)
 800    ->  goal_name_arity(Head, Name, Arity),
 801        (   '$find_library'(_, Name, Arity, _, File)
 802        ->  true
 803        )
 804    ;   '$find_library'(_, Name, Arity, _, File),
 805        functor(Head, Name, Arity)
 806    ).
 807property_predicate(implementation_module(IM), M:Head) :-
 808    !,
 809    atom(M),
 810    (   default_module(M, DM),
 811        '$get_predicate_attribute'(DM:Head, defined, 1)
 812    ->  (   '$get_predicate_attribute'(DM:Head, imported, ImportM)
 813        ->  IM = ImportM
 814        ;   IM = M
 815        )
 816    ;   \+ current_prolog_flag(M:unknown, fail),
 817        goal_name_arity(Head, Name, Arity),
 818        '$find_library'(_, Name, Arity, LoadModule, _File)
 819    ->  IM = LoadModule
 820    ;   M = IM
 821    ).
 822property_predicate(Property, Pred) :-
 823    define_or_generate(Pred),
 824    '$predicate_property'(Property, Pred).
 825
 826goal_name_arity(Head, Name, Arity) :-
 827    compound(Head),
 828    !,
 829    compound_name_arity(Head, Name, Arity).
 830goal_name_arity(Head, Head, 0).
 831
 832
 833%!  define_or_generate(+Head) is semidet.
 834%!  define_or_generate(-Head) is nondet.
 835%
 836%   If the predicate is known, try to resolve it. Otherwise generate
 837%   the known predicate, but do not try to (auto)load the predicate.
 838
 839define_or_generate(M:Head) :-
 840    callable(Head),
 841    atom(M),
 842    '$get_predicate_attribute'(M:Head, defined, 1),
 843    !.
 844define_or_generate(M:Head) :-
 845    callable(Head),
 846    nonvar(M), M \== system,
 847    !,
 848    '$define_predicate'(M:Head).
 849define_or_generate(Pred) :-
 850    current_predicate(_, Pred),
 851    '$define_predicate'(Pred).
 852
 853
 854'$predicate_property'(interpreted, Pred) :-
 855    '$get_predicate_attribute'(Pred, foreign, 0).
 856'$predicate_property'(visible, Pred) :-
 857    '$get_predicate_attribute'(Pred, defined, 1).
 858'$predicate_property'(built_in, Pred) :-
 859    '$get_predicate_attribute'(Pred, system, 1).
 860'$predicate_property'(exported, Pred) :-
 861    '$get_predicate_attribute'(Pred, exported, 1).
 862'$predicate_property'(public, Pred) :-
 863    '$get_predicate_attribute'(Pred, public, 1).
 864'$predicate_property'(foreign, Pred) :-
 865    '$get_predicate_attribute'(Pred, foreign, 1).
 866'$predicate_property'((dynamic), Pred) :-
 867    '$get_predicate_attribute'(Pred, (dynamic), 1).
 868'$predicate_property'((static), Pred) :-
 869    '$get_predicate_attribute'(Pred, (dynamic), 0).
 870'$predicate_property'((volatile), Pred) :-
 871    '$get_predicate_attribute'(Pred, (volatile), 1).
 872'$predicate_property'((thread_local), Pred) :-
 873    '$get_predicate_attribute'(Pred, (thread_local), 1).
 874'$predicate_property'((multifile), Pred) :-
 875    '$get_predicate_attribute'(Pred, (multifile), 1).
 876'$predicate_property'(imported_from(Module), Pred) :-
 877    '$get_predicate_attribute'(Pred, imported, Module).
 878'$predicate_property'(transparent, Pred) :-
 879    '$get_predicate_attribute'(Pred, transparent, 1).
 880'$predicate_property'(meta_predicate(Pattern), Pred) :-
 881    '$get_predicate_attribute'(Pred, meta_predicate, Pattern).
 882'$predicate_property'(file(File), Pred) :-
 883    '$get_predicate_attribute'(Pred, file, File).
 884'$predicate_property'(line_count(LineNumber), Pred) :-
 885    '$get_predicate_attribute'(Pred, line_count, LineNumber).
 886'$predicate_property'(notrace, Pred) :-
 887    '$get_predicate_attribute'(Pred, trace, 0).
 888'$predicate_property'(nodebug, Pred) :-
 889    '$get_predicate_attribute'(Pred, hide_childs, 1).
 890'$predicate_property'(spying, Pred) :-
 891    '$get_predicate_attribute'(Pred, spy, 1).
 892'$predicate_property'(number_of_clauses(N), Pred) :-
 893    '$get_predicate_attribute'(Pred, number_of_clauses, N).
 894'$predicate_property'(number_of_rules(N), Pred) :-
 895    '$get_predicate_attribute'(Pred, number_of_rules, N).
 896'$predicate_property'(indexed(Indices), Pred) :-
 897    '$get_predicate_attribute'(Pred, indexed, Indices).
 898'$predicate_property'(noprofile, Pred) :-
 899    '$get_predicate_attribute'(Pred, noprofile, 1).
 900'$predicate_property'(iso, Pred) :-
 901    '$get_predicate_attribute'(Pred, iso, 1).
 902'$predicate_property'(quasi_quotation_syntax, Pred) :-
 903    '$get_predicate_attribute'(Pred, quasi_quotation_syntax, 1).
 904'$predicate_property'(defined, Pred) :-
 905    '$get_predicate_attribute'(Pred, defined, 1).
 906
 907system_undefined(user:prolog_trace_interception/4).
 908system_undefined(user:prolog_exception_hook/4).
 909system_undefined(system:'$c_call_prolog'/0).
 910system_undefined(system:window_title/2).
 911
 912%!  visible_predicate(:Head) is nondet.
 913%
 914%   True when Head can be called without raising an existence error.
 915%   This implies it is defined,  can   be  inherited  from a default
 916%   module or can be autoloaded.
 917
 918visible_predicate(Pred) :-
 919    Pred = M:Head,
 920    current_module(M),
 921    (   callable(Head)
 922    ->  (   '$get_predicate_attribute'(Pred, defined, 1)
 923        ->  true
 924        ;   \+ current_prolog_flag(M:unknown, fail),
 925            functor(Head, Name, Arity),
 926            '$find_library'(M, Name, Arity, _LoadModule, _Library)
 927        )
 928    ;   setof(PI, visible_in_module(M, PI), PIs),
 929        '$member'(Name/Arity, PIs),
 930        functor(Head, Name, Arity)
 931    ).
 932
 933visible_in_module(M, Name/Arity) :-
 934    default_module(M, DefM),
 935    DefHead = DefM:Head,
 936    '$c_current_predicate'(_, DefHead),
 937    '$get_predicate_attribute'(DefHead, defined, 1),
 938    \+ hidden_system_predicate(Head),
 939    functor(Head, Name, Arity).
 940visible_in_module(_, Name/Arity) :-
 941    '$in_library'(Name, Arity, _).
 942
 943hidden_system_predicate(Head) :-
 944    functor(Head, Name, _),
 945    atom(Name),                     % Avoid [].
 946    sub_atom(Name, 0, _, _, $),
 947    \+ current_prolog_flag(access_level, system).
 948
 949
 950%!  clause_property(+ClauseRef, ?Property) is nondet.
 951%
 952%   Provide information on individual clauses.  Defined properties
 953%   are:
 954%
 955%       * line_count(-Line)
 956%       Line from which the clause is loaded.
 957%       * file(-File)
 958%       File from which the clause is loaded.
 959%       * source(-File)
 960%       File that `owns' the clause: reloading this file wipes
 961%       the clause.
 962%       * fact
 963%       Clause has body =true=.
 964%       * erased
 965%       Clause was erased.
 966%       * predicate(:PI)
 967%       Predicate indicator of the predicate this clause belongs
 968%       to.  Can be used to find the predicate of erased clauses.
 969%       * module(-M)
 970%       Module context in which the clause was compiled.
 971
 972clause_property(Clause, Property) :-
 973    '$clause_property'(Property, Clause).
 974
 975'$clause_property'(line_count(LineNumber), Clause) :-
 976    '$get_clause_attribute'(Clause, line_count, LineNumber).
 977'$clause_property'(file(File), Clause) :-
 978    '$get_clause_attribute'(Clause, file, File).
 979'$clause_property'(source(File), Clause) :-
 980    '$get_clause_attribute'(Clause, owner, File).
 981'$clause_property'(size(Bytes), Clause) :-
 982    '$get_clause_attribute'(Clause, size, Bytes).
 983'$clause_property'(fact, Clause) :-
 984    '$get_clause_attribute'(Clause, fact, true).
 985'$clause_property'(erased, Clause) :-
 986    '$get_clause_attribute'(Clause, erased, true).
 987'$clause_property'(predicate(PI), Clause) :-
 988    '$get_clause_attribute'(Clause, predicate_indicator, PI).
 989'$clause_property'(module(M), Clause) :-
 990    '$get_clause_attribute'(Clause, module, M).
 991
 992
 993                 /*******************************
 994                 *             REQUIRE          *
 995                 *******************************/
 996
 997:- meta_predicate
 998    require(:).
 999
1000%!  require(:ListOfPredIndicators) is det.
1001%
1002%   Tag given predicates as undefined, so they will be included
1003%   into a saved state through the autoloader.
1004%
1005%   @see autoload/0.
1006
1007require(M:List) :-
1008    (   is_list(List)
1009    ->  require(List, M)
1010    ;   throw(error(type_error(list, List), _))
1011    ).
1012
1013require([], _).
1014require([N/A|T], M) :-
1015    !,
1016    functor(Head, N, A),
1017    '$require'(M:Head),
1018    require(T, M).
1019require([H|_T], _) :-
1020    throw(error(type_error(predicate_indicator, H), _)).
1021
1022
1023                /********************************
1024                *            MODULES            *
1025                *********************************/
1026
1027%!  current_module(?Module) is nondet.
1028%
1029%   True if Module is a currently defined module.
1030
1031current_module(Module) :-
1032    '$current_module'(Module, _).
1033
1034%!  module_property(?Module, ?Property) is nondet.
1035%
1036%   True if Property is a property of Module.  Defined properties
1037%   are:
1038%
1039%       * file(File)
1040%       Module is loaded from File.
1041%       * line_count(Count)
1042%       The module declaration is on line Count of File.
1043%       * exports(ListOfPredicateIndicators)
1044%       The module exports ListOfPredicateIndicators
1045%       * exported_operators(ListOfOp3)
1046%       The module exports the operators ListOfOp3.
1047
1048module_property(Module, Property) :-
1049    nonvar(Module), nonvar(Property),
1050    !,
1051    property_module(Property, Module).
1052module_property(Module, Property) :-    % -, file(File)
1053    nonvar(Property), Property = file(File),
1054    !,
1055    (   nonvar(File)
1056    ->  '$current_module'(Modules, File),
1057        (   atom(Modules)
1058        ->  Module = Modules
1059        ;   '$member'(Module, Modules)
1060        )
1061    ;   '$current_module'(Module, File),
1062        File \== []
1063    ).
1064module_property(Module, Property) :-
1065    current_module(Module),
1066    property_module(Property, Module).
1067
1068property_module(Property, Module) :-
1069    module_property(Property),
1070    (   Property = exported_operators(List)
1071    ->  '$exported_ops'(Module, List, []),
1072        List \== []
1073    ;   '$module_property'(Module, Property)
1074    ).
1075
1076module_property(class(_)).
1077module_property(file(_)).
1078module_property(line_count(_)).
1079module_property(exports(_)).
1080module_property(exported_operators(_)).
1081module_property(program_size(_)).
1082module_property(program_space(_)).
1083
1084%!  module(+Module) is det.
1085%
1086%   Set the module that is associated to the toplevel to Module.
1087
1088module(Module) :-
1089    atom(Module),
1090    current_module(Module),
1091    !,
1092    '$set_typein_module'(Module).
1093module(Module) :-
1094    '$set_typein_module'(Module),
1095    print_message(warning, no_current_module(Module)).
1096
1097%!  working_directory(-Old, +New)
1098%
1099%   True when Old is the current working directory and the working
1100%   directory has been updated to New.
1101
1102working_directory(Old, New) :-
1103    '$cwd'(Old),
1104    (   Old == New
1105    ->  true
1106    ;   '$chdir'(New)
1107    ).
1108
1109
1110                 /*******************************
1111                 *            TRIES             *
1112                 *******************************/
1113
1114%!  current_trie(?Trie) is nondet.
1115%
1116%   True if Trie is the handle of an existing trie.
1117
1118current_trie(Trie) :-
1119    current_blob(Trie, trie).
1120
1121%!  trie_property(?Trie, ?Property)
1122%
1123%   True when Property is a property of Trie. Defined properties
1124%   are:
1125%
1126%     - value_count(Count)
1127%     Number of terms in the trie.
1128%     - node_count(Count)
1129%     Number of nodes in the trie.
1130%     - size(Bytes)
1131%     Number of bytes needed to store the trie.
1132%     - hashed(Count)
1133%     Number of hashed nodes.
1134
1135trie_property(Trie, Property) :-
1136    current_trie(Trie),
1137    trie_property(Property),
1138    '$trie_property'(Trie, Property).
1139
1140trie_property(node_count(_)).
1141trie_property(value_count(_)).
1142trie_property(size(_)).
1143trie_property(hashed(_)).
1144
1145
1146
1147                /********************************
1148                *      SYSTEM INTERACTION       *
1149                *********************************/
1150
1151shell(Command) :-
1152    shell(Command, 0).
1153
1154%!  win_add_dll_directory(+AbsDir) is det.
1155%
1156%   Add AbsDir to the directories where  dependent DLLs are searched
1157%   on Windows systems.
1158
1159:- if(current_prolog_flag(windows, true)).
1160:- export(win_add_dll_directory/1).
1161win_add_dll_directory(Dir) :-
1162    win_add_dll_directory(Dir, _),
1163    !.
1164win_add_dll_directory(Dir) :-
1165    prolog_to_os_filename(Dir, OSDir),
1166    getenv('PATH', Path0),
1167    atomic_list_concat([Path0, OSDir], ';', Path),
1168    setenv('PATH', Path).
1169:- endif.
1170
1171                 /*******************************
1172                 *            SIGNALS           *
1173                 *******************************/
1174
1175:- meta_predicate
1176    on_signal(+, :, :),
1177    current_signal(?, ?, :).
1178
1179%!  on_signal(+Signal, -OldHandler, :NewHandler) is det.
1180
1181on_signal(Signal, Old, New) :-
1182    atom(Signal),
1183    !,
1184    '$on_signal'(_Num, Signal, Old, New).
1185on_signal(Signal, Old, New) :-
1186    integer(Signal),
1187    !,
1188    '$on_signal'(Signal, _Name, Old, New).
1189on_signal(Signal, _Old, _New) :-
1190    '$type_error'(signal_name, Signal).
1191
1192%!  current_signal(?Name, ?SignalNumber, :Handler) is nondet.
1193
1194current_signal(Name, Id, Handler) :-
1195    between(1, 32, Id),
1196    '$on_signal'(Id, Name, Handler, Handler).
1197
1198:- multifile
1199    prolog:called_by/2.
1200
1201prolog:called_by(on_signal(_,_,New), [New+1]) :-
1202    (   new == throw
1203    ;   new == default
1204    ), !, fail.
1205
1206
1207                 /*******************************
1208                 *            DLOPEN            *
1209                 *******************************/
1210
1211%!  open_shared_object(+File, -Handle) is det.
1212%!  open_shared_object(+File, -Handle, +Flags) is det.
1213%
1214%   Open a shared object or DLL file. Flags  is a list of flags. The
1215%   following flags are recognised. Note   however  that these flags
1216%   may have no affect on the target platform.
1217%
1218%       * =now=
1219%       Resolve all symbols in the file now instead of lazily.
1220%       * =global=
1221%       Make new symbols globally known.
1222
1223open_shared_object(File, Handle) :-
1224    open_shared_object(File, Handle, []). % use pl-load.c defaults
1225
1226open_shared_object(File, Handle, Flags) :-
1227    (   is_list(Flags)
1228    ->  true
1229    ;   throw(error(type_error(list, Flags), _))
1230    ),
1231    map_dlflags(Flags, Mask),
1232    '$open_shared_object'(File, Handle, Mask).
1233
1234dlopen_flag(now,        2'01).          % see pl-load.c for these constants
1235dlopen_flag(global,     2'10).          % Solaris only
1236
1237map_dlflags([], 0).
1238map_dlflags([F|T], M) :-
1239    map_dlflags(T, M0),
1240    (   dlopen_flag(F, I)
1241    ->  true
1242    ;   throw(error(domain_error(dlopen_flag, F), _))
1243    ),
1244    M is M0 \/ I.
1245
1246
1247                 /*******************************
1248                 *             I/O              *
1249                 *******************************/
1250
1251format(Fmt) :-
1252    format(Fmt, []).
1253
1254                 /*******************************
1255                 *            FILES             *
1256                 *******************************/
1257
1258%       absolute_file_name(+Term, -AbsoluteFile)
1259
1260absolute_file_name(Name, Abs) :-
1261    atomic(Name),
1262    !,
1263    '$absolute_file_name'(Name, Abs).
1264absolute_file_name(Term, Abs) :-
1265    '$chk_file'(Term, [''], [access(read)], true, File),
1266    !,
1267    '$absolute_file_name'(File, Abs).
1268absolute_file_name(Term, Abs) :-
1269    '$chk_file'(Term, [''], [], true, File),
1270    !,
1271    '$absolute_file_name'(File, Abs).
1272
1273
1274                /********************************
1275                *        MEMORY MANAGEMENT      *
1276                *********************************/
1277
1278%!  garbage_collect is det.
1279%
1280%   Invoke the garbage collector.  The   argument  of the underlying
1281%   '$garbage_collect'/1  is  the  debugging  level  to  use  during
1282%   garbage collection. This only works if   the  system is compiled
1283%   with the -DODEBUG cpp flag. Only to simplify maintenance.
1284
1285garbage_collect :-
1286    '$garbage_collect'(0).
1287
1288%!  set_prolog_stack(+Name, +Option) is det.
1289%
1290%   Set a parameter for one of the Prolog stacks.
1291
1292set_prolog_stack(Stack, Option) :-
1293    Option =.. [Name,Value0],
1294    Value is Value0,
1295    '$set_prolog_stack'(Stack, Name, _Old, Value).
1296
1297%!  prolog_stack_property(?Stack, ?Property) is nondet.
1298%
1299%   Examine stack properties.
1300
1301prolog_stack_property(Stack, Property) :-
1302    stack_property(P),
1303    stack_name(Stack),
1304    Property =.. [P,Value],
1305    '$set_prolog_stack'(Stack, P, Value, Value).
1306
1307stack_name(local).
1308stack_name(global).
1309stack_name(trail).
1310
1311stack_property(limit).
1312stack_property(spare).
1313stack_property(min_free).
1314
1315
1316                 /*******************************
1317                 *             TERM             *
1318                 *******************************/
1319
1320:- '$iso'((numbervars/3)).
1321
1322%!  numbervars(+Term, +StartIndex, -EndIndex) is det.
1323%
1324%   Number all unbound variables in Term   using  '$VAR'(N), where the
1325%   first N is StartIndex and EndIndex is  unified to the index that
1326%   will be given to the next variable.
1327
1328numbervars(Term, From, To) :-
1329    numbervars(Term, From, To, []).
1330
1331
1332                 /*******************************
1333                 *            STRING            *
1334                 *******************************/
1335
1336%!  term_string(?Term, ?String, +Options)
1337%
1338%   Parse/write a term from/to a string using Options.
1339
1340term_string(Term, String, Options) :-
1341    nonvar(String),
1342    !,
1343    read_term_from_atom(String, Term, Options).
1344term_string(Term, String, Options) :-
1345    (   '$option'(quoted(_), Options)
1346    ->  Options1 = Options
1347    ;   '$merge_options'(_{quoted:true}, Options, Options1)
1348    ),
1349    format(string(String), '~W', [Term, Options1]).
1350
1351
1352                 /*******************************
1353                 *             GVAR             *
1354                 *******************************/
1355
1356%!  nb_setval(+Name, +Value) is det.
1357%
1358%   Bind the non-backtrackable variable Name with a copy of Value
1359
1360nb_setval(Name, Value) :-
1361    duplicate_term(Value, Copy),
1362    nb_linkval(Name, Copy).