View source with raw comments or as raw
    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-2017, 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            thread_create/2,                    % :Goal, -Id
   84            thread_join/1,                      % +Id
   85            set_prolog_gc_thread/1		% +Status
   86          ]).   87
   88                /********************************
   89                *           DEBUGGER            *
   90                *********************************/
 map_bits(:Pred, +Modify, +OldBits, -NewBits)
   94:- meta_predicate
   95    map_bits(2, +, +, -).   96
   97map_bits(_, Var, _, _) :-
   98    var(Var),
   99    !,
  100    '$instantiation_error'(Var).
  101map_bits(_, [], Bits, Bits) :- !.
  102map_bits(Pred, [H|T], Old, New) :-
  103    map_bits(Pred, H, Old, New0),
  104    map_bits(Pred, T, New0, New).
  105map_bits(Pred, +Name, Old, New) :-     % set a bit
  106    !,
  107    bit(Pred, Name, Bits),
  108    !,
  109    New is Old \/ Bits.
  110map_bits(Pred, -Name, Old, New) :-     % clear a bit
  111    !,
  112    bit(Pred, Name, Bits),
  113    !,
  114    New is Old /\ (\Bits).
  115map_bits(Pred, ?(Name), Old, Old) :-   % ask a bit
  116    !,
  117    bit(Pred, Name, Bits),
  118    Old /\ Bits > 0.
  119map_bits(_, Term, _, _) :-
  120    '$type_error'('+|-|?(Flag)', Term).
  121
  122bit(Pred, Name, Bits) :-
  123    call(Pred, Name, Bits),
  124    !.
  125bit(_:Pred, Name, _) :-
  126    '$domain_error'(Pred, Name).
  127
  128:- public port_name/2.                  % used by library(test_cover)
  129
  130port_name(      call, 2'000000001).
  131port_name(      exit, 2'000000010).
  132port_name(      fail, 2'000000100).
  133port_name(      redo, 2'000001000).
  134port_name(     unify, 2'000010000).
  135port_name(     break, 2'000100000).
  136port_name(  cut_call, 2'001000000).
  137port_name(  cut_exit, 2'010000000).
  138port_name( exception, 2'100000000).
  139port_name(       cut, 2'011000000).
  140port_name(       all, 2'000111111).
  141port_name(      full, 2'000101111).
  142port_name(      half, 2'000101101).     % '
  143
  144leash(Ports) :-
  145    '$leash'(Old, Old),
  146    map_bits(port_name, Ports, Old, New),
  147    '$leash'(_, New).
  148
  149visible(Ports) :-
  150    '$visible'(Old, Old),
  151    map_bits(port_name, Ports, Old, New),
  152    '$visible'(_, New).
  153
  154style_name(atom,            0x0001) :-
  155    print_message(warning, decl_no_effect(style_check(atom))).
  156style_name(singleton,       0x0042).            % semantic and syntactic
  157style_name(discontiguous,   0x0008).
  158style_name(charset,         0x0020).
  159style_name(no_effect,       0x0080).
  160style_name(var_branches,    0x0100).
 style_check(+Spec) is nondet
  164style_check(Var) :-
  165    var(Var),
  166    !,
  167    '$instantiation_error'(Var).
  168style_check(?(Style)) :-
  169    !,
  170    (   var(Style)
  171    ->  enum_style_check(Style)
  172    ;   enum_style_check(Style)
  173    ->  true
  174    ).
  175style_check(Spec) :-
  176    '$style_check'(Old, Old),
  177    map_bits(style_name, Spec, Old, New),
  178    '$style_check'(_, New).
  179
  180enum_style_check(Style) :-
  181    '$style_check'(Bits, Bits),
  182    style_name(Style, Bit),
  183    Bit /\ Bits =\= 0.
 prolog:debug_control_hook(+Action)
Allow user-hooks in the Prolog debugger interaction. See the calls below for the provided hooks. We use a single predicate with action argument to avoid an uncontrolled poliferation of hooks.

TBD: What hooks to provide for trace/[1,2]

  194:- multifile
  195    prolog:debug_control_hook/1.    % +Action
 trace(:Preds) is det
 trace(:Preds, +PortSpec) is det
Start printing messages if control passes specified ports of the given predicates.
  203:- meta_predicate
  204    trace(:),
  205    trace(:, +).  206
  207trace(Preds) :-
  208    trace(Preds, +all).
  209
  210trace(_:X, _) :-
  211    var(X),
  212    !,
  213    throw(error(instantiation_error, _)).
  214trace(_:[], _) :- !.
  215trace(M:[H|T], Ps) :-
  216    !,
  217    trace(M:H, Ps),
  218    trace(M:T, Ps).
  219trace(Pred, Ports) :-
  220    '$find_predicate'(Pred, Preds),
  221    Preds \== [],
  222    set_prolog_flag(debug, true),
  223    (   '$member'(PI, Preds),
  224            pi_to_head(PI, Head),
  225            (   Head = _:_
  226            ->  QHead0 = Head
  227            ;   QHead0 = user:Head
  228            ),
  229            '$define_predicate'(QHead0),
  230            (   predicate_property(QHead0, imported_from(M))
  231            ->  QHead0 = _:Plain,
  232                QHead = M:Plain
  233            ;   QHead = QHead0
  234            ),
  235            '$trace'(Ports, QHead),
  236            trace_ports(QHead, Tracing),
  237            print_message(informational, trace(QHead, Tracing)),
  238        fail
  239    ;   true
  240    ).
  241
  242trace_alias(all,  [trace_call, trace_redo, trace_exit, trace_fail]).
  243trace_alias(call, [trace_call]).
  244trace_alias(redo, [trace_redo]).
  245trace_alias(exit, [trace_exit]).
  246trace_alias(fail, [trace_fail]).
  247
  248'$trace'([], _) :- !.
  249'$trace'([H|T], Head) :-
  250    !,
  251    '$trace'(H, Head),
  252    '$trace'(T, Head).
  253'$trace'(+H, Head) :-
  254    trace_alias(H, A0),
  255    !,
  256    tag_list(A0, +, A1),
  257    '$trace'(A1, Head).
  258'$trace'(+H, Head) :-
  259    !,
  260    trace_alias(_, [H]),
  261    '$set_predicate_attribute'(Head, H, true).
  262'$trace'(-H, Head) :-
  263    trace_alias(H, A0),
  264    !,
  265    tag_list(A0, -, A1),
  266    '$trace'(A1, Head).
  267'$trace'(-H, Head) :-
  268    !,
  269    trace_alias(_, [H]),
  270    '$set_predicate_attribute'(Head, H, false).
  271'$trace'(H, Head) :-
  272    atom(H),
  273    '$trace'(+H, Head).
  274
  275tag_list([], _, []).
  276tag_list([H0|T0], F, [H1|T1]) :-
  277    H1 =.. [F, H0],
  278    tag_list(T0, F, T1).
  279
  280:- meta_predicate
  281    spy(:),
  282    nospy(:).
 spy(:Spec) is det
 nospy(:Spec) is det
 nospyall is det
Set/clear spy-points. A successfully set or cleared spy-point is reported using print_message/2, level informational, with one of the following terms, where Spec is of the form M:Head.
See also
- spy/1 and nospy/1 call the hook debug_control_hook/1 to allow for alternative specifications of the thing to debug.
  299spy(_:X) :-
  300    var(X),
  301    throw(error(instantiation_error, _)).
  302spy(_:[]) :- !.
  303spy(M:[H|T]) :-
  304    !,
  305    spy(M:H),
  306    spy(M:T).
  307spy(Spec) :-
  308    notrace(prolog:debug_control_hook(spy(Spec))),
  309    !.
  310spy(Spec) :-
  311    '$find_predicate'(Spec, Preds),
  312    '$member'(PI, Preds),
  313        pi_to_head(PI, Head),
  314        '$define_predicate'(Head),
  315        '$spy'(Head),
  316    fail.
  317spy(_).
  318
  319nospy(_:X) :-
  320    var(X),
  321    throw(error(instantiation_error, _)).
  322nospy(_:[]) :- !.
  323nospy(M:[H|T]) :-
  324    !,
  325    nospy(M:H),
  326    nospy(M:T).
  327nospy(Spec) :-
  328    notrace(prolog:debug_control_hook(nospy(Spec))),
  329    !.
  330nospy(Spec) :-
  331    '$find_predicate'(Spec, Preds),
  332    '$member'(PI, Preds),
  333         pi_to_head(PI, Head),
  334        '$nospy'(Head),
  335    fail.
  336nospy(_).
  337
  338nospyall :-
  339    notrace(prolog:debug_control_hook(nospyall)),
  340    fail.
  341nospyall :-
  342    spy_point(Head),
  343        '$nospy'(Head),
  344    fail.
  345nospyall.
  346
  347pi_to_head(M:PI, M:Head) :-
  348    !,
  349    pi_to_head(PI, Head).
  350pi_to_head(Name/Arity, Head) :-
  351    functor(Head, Name, Arity).
 debugging is det
Report current status of the debugger.
  357debugging :-
  358    notrace(prolog:debug_control_hook(debugging)),
  359    !.
  360debugging :-
  361    current_prolog_flag(debug, true),
  362    !,
  363    print_message(informational, debugging(on)),
  364    findall(H, spy_point(H), SpyPoints),
  365    print_message(informational, spying(SpyPoints)),
  366    findall(trace(H,P), trace_point(H,P), TracePoints),
  367    print_message(informational, tracing(TracePoints)).
  368debugging :-
  369    print_message(informational, debugging(off)).
  370
  371spy_point(Module:Head) :-
  372    current_predicate(_, Module:Head),
  373    '$get_predicate_attribute'(Module:Head, spy, 1),
  374    \+ predicate_property(Module:Head, imported_from(_)).
  375
  376trace_point(Module:Head, Ports) :-
  377    current_predicate(_, Module:Head),
  378        '$get_predicate_attribute'(Module:Head, trace_any, 1),
  379        \+ predicate_property(Module:Head, imported_from(_)),
  380        trace_ports(Module:Head, Ports).
  381
  382trace_ports(Head, Ports) :-
  383    findall(Port,
  384            (trace_alias(Port, [AttName]),
  385             '$get_predicate_attribute'(Head, AttName, 1)),
  386            Ports).
 flag(+Name, -Old, +New) is det
True when Old is the current value associated with the flag Name and New has become the new value.
  394flag(Name, Old, New) :-
  395    Old == New,
  396    !,
  397    get_flag(Name, Old).
  398flag(Name, Old, New) :-
  399    with_mutex('$flag', update_flag(Name, Old, New)).
  400
  401update_flag(Name, Old, New) :-
  402    get_flag(Name, Old),
  403    (   atom(New)
  404    ->  set_flag(Name, New)
  405    ;   Value is New,
  406        set_flag(Name, Value)
  407    ).
  408
  409
  410                 /*******************************
  411                 *            RATIONAL          *
  412                 *******************************/
 rational(+Rat, -Numerator, -Denominator) is semidet
True when Rat is a rational number with given Numerator and Denominator.
  419rational(Rat, M, N) :-
  420    rational(Rat),
  421    (   Rat = rdiv(M, N)
  422    ->  true
  423    ;   integer(Rat)
  424    ->  M = Rat,
  425        N = 1
  426    ).
  427
  428
  429                /********************************
  430                *             ATOMS             *
  431                *********************************/
  432
  433dwim_match(A1, A2) :-
  434    dwim_match(A1, A2, _).
  435
  436atom_prefix(Atom, Prefix) :-
  437    sub_atom(Atom, 0, _, _, Prefix).
  438
  439
  440                /********************************
  441                *             SOURCE            *
  442                *********************************/
 source_file(-File) is nondet
source_file(+File) is semidet
True if File is loaded into Prolog. If File is unbound it is bound to the canonical name for it. If File is bound it succeeds if the canonical name as defined by absolute_file_name/2 is known as a loaded filename.

Note that Time = 0.0 is used by PlDoc and other code that needs to create a file record without being interested in the time.

  455source_file(File) :-
  456    (   current_prolog_flag(access_level, user)
  457    ->  Level = user
  458    ;   true
  459    ),
  460    (   ground(File)
  461    ->  (   '$time_source_file'(File, Time, Level)
  462        ;   absolute_file_name(File, Abs),
  463            '$time_source_file'(Abs, Time, Level)
  464        ), !
  465    ;   '$time_source_file'(File, Time, Level)
  466    ),
  467    Time > 0.0.
 source_file(+Head, -File) is semidet
source_file(?Head, ?File) is nondet
True when Head is a predicate owned by File.
  474:- meta_predicate source_file(:, ?).  475
  476source_file(M:Head, File) :-
  477    nonvar(M), nonvar(Head),
  478    !,
  479    (   '$c_current_predicate'(_, M:Head),
  480        predicate_property(M:Head, multifile)
  481    ->  multi_source_files(M:Head, Files),
  482        '$member'(File, Files)
  483    ;   '$source_file'(M:Head, File)
  484    ).
  485source_file(M:Head, File) :-
  486    (   nonvar(File)
  487    ->  true
  488    ;   source_file(File)
  489    ),
  490    '$source_file_predicates'(File, Predicates),
  491    '$member'(M:Head, Predicates).
  492
  493:- thread_local found_src_file/1.  494
  495multi_source_files(Head, Files) :-
  496    call_cleanup(
  497        findall(File, multi_source_file(Head, File), Files),
  498        retractall(found_src_file(_))).
  499
  500multi_source_file(Head, File) :-
  501    nth_clause(Head, _, Clause),
  502    clause_property(Clause, source(File)),
  503    \+ found_src_file(File),
  504    asserta(found_src_file(File)).
 source_file_property(?File, ?Property) is nondet
True if Property is a property of the loaded source-file File.
  511source_file_property(File, P) :-
  512    nonvar(File),
  513    !,
  514    canonical_source_file(File, Path),
  515    property_source_file(P, Path).
  516source_file_property(File, P) :-
  517    property_source_file(P, File).
  518
  519property_source_file(modified(Time), File) :-
  520    '$time_source_file'(File, Time, user).
  521property_source_file(module(M), File) :-
  522    (   nonvar(M)
  523    ->  '$current_module'(M, File)
  524    ;   nonvar(File)
  525    ->  '$current_module'(ML, File),
  526        (   atom(ML)
  527        ->  M = ML
  528        ;   '$member'(M, ML)
  529        )
  530    ;   '$current_module'(M, File)
  531    ).
  532property_source_file(load_context(Module, Location, Options), File) :-
  533    '$time_source_file'(File, _, user),
  534    clause(system:'$load_context_module'(File, Module, Options), true, Ref),
  535    (   clause_property(Ref, file(FromFile)),
  536        clause_property(Ref, line_count(FromLine))
  537    ->  Location = FromFile:FromLine
  538    ;   Location = user
  539    ).
  540property_source_file(includes(Master, Stamp), File) :-
  541    system:'$included'(File, _Line, Master, Stamp).
  542property_source_file(included_in(Master, Line), File) :-
  543    system:'$included'(Master, Line, File, _).
  544property_source_file(derived_from(DerivedFrom, Stamp), File) :-
  545    system:'$derived_source'(File, DerivedFrom, Stamp).
  546property_source_file(reloading, File) :-
  547    source_file(File),
  548    '$source_file_property'(File, reloading, true).
  549property_source_file(load_count(Count), File) :-
  550    source_file(File),
  551    '$source_file_property'(File, load_count, Count).
  552property_source_file(number_of_clauses(Count), File) :-
  553    source_file(File),
  554    '$source_file_property'(File, number_of_clauses, Count).
 canonical_source_file(+Spec, -File) is semidet
File is the canonical representation of the source-file Spec.
  561canonical_source_file(Spec, File) :-
  562    atom(Spec),
  563    '$time_source_file'(Spec, _, _),
  564    !,
  565    File = Spec.
  566canonical_source_file(Spec, File) :-
  567    system:'$included'(_Master, _Line, Spec, _),
  568    !,
  569    File = Spec.
  570canonical_source_file(Spec, File) :-
  571    absolute_file_name(Spec,
  572                           [ file_type(prolog),
  573                             access(read),
  574                             file_errors(fail)
  575                           ],
  576                           File),
  577    source_file(File).
 prolog_load_context(+Key, -Value)
Provides context information for term_expansion and directives. Note that only the line-number info is valid for the '$stream_position'. Largely Quintus compatible.
  586prolog_load_context(module, Module) :-
  587    '$current_source_module'(Module).
  588prolog_load_context(file, F) :-
  589    source_location(F, _).
  590prolog_load_context(source, F) :-       % SICStus compatibility
  591    source_location(F0, _),
  592    '$input_context'(Context),
  593    '$top_file'(Context, F0, F).
  594prolog_load_context(stream, S) :-
  595    (   system:'$load_input'(_, S0)
  596    ->  S = S0
  597    ).
  598prolog_load_context(directory, D) :-
  599    source_location(F, _),
  600    file_directory_name(F, D).
  601prolog_load_context(dialect, D) :-
  602    current_prolog_flag(emulated_dialect, D).
  603prolog_load_context(term_position, TermPos) :-
  604    source_location(_, L),
  605    (   nb_current('$term_position', Pos),
  606        compound(Pos),              % actually set
  607        stream_position_data(line_count, Pos, L)
  608    ->  TermPos = Pos
  609    ;   TermPos = '$stream_position'(0,L,0,0)
  610    ).
  611prolog_load_context(script, Bool) :-
  612    (   '$toplevel':loaded_init_file(script, Path),
  613        source_location(Path, _)
  614    ->  Bool = true
  615    ;   Bool = false
  616    ).
  617prolog_load_context(variable_names, Bindings) :-
  618    nb_current('$variable_names', Bindings).
  619prolog_load_context(term, Term) :-
  620    nb_current('$term', Term).
  621prolog_load_context(reloading, true) :-
  622    prolog_load_context(source, F),
  623    '$source_file_property'(F, reloading, true).
 unload_file(+File) is det
Remove all traces of loading file.
  629unload_file(File) :-
  630    (   canonical_source_file(File, Path)
  631    ->  '$unload_file'(Path)
  632    ;   true
  633    ).
  634
  635
  636                 /*******************************
  637                 *            STREAMS           *
  638                 *******************************/
 stream_position_data(?Field, +Pos, ?Date)
Extract values from stream position objects. '$stream_position' is of the format '$stream_position'(Byte, Char, Line, LinePos)
  645stream_position_data(Prop, Term, Value) :-
  646    nonvar(Prop),
  647    !,
  648    (   stream_position_field(Prop, Pos)
  649    ->  arg(Pos, Term, Value)
  650    ;   throw(error(domain_error(stream_position_data, Prop)))
  651    ).
  652stream_position_data(Prop, Term, Value) :-
  653    stream_position_field(Prop, Pos),
  654    arg(Pos, Term, Value).
  655
  656stream_position_field(char_count,    1).
  657stream_position_field(line_count,    2).
  658stream_position_field(line_position, 3).
  659stream_position_field(byte_count,    4).
  660
  661
  662                 /*******************************
  663                 *            CONTROL           *
  664                 *******************************/
 call_with_depth_limit(:Goal, +DepthLimit, -Result)
Try to proof Goal, but fail on any branch exceeding the indicated depth-limit. Unify Result with the maximum-reached limit on success, depth_limit_exceeded if the limit was exceeded and fails otherwise.
  672:- meta_predicate
  673    call_with_depth_limit(0, +, -).  674
  675call_with_depth_limit(G, Limit, Result) :-
  676    '$depth_limit'(Limit, OLimit, OReached),
  677    (   catch(G, E, '$depth_limit_except'(OLimit, OReached, E)),
  678        '$depth_limit_true'(Limit, OLimit, OReached, Result, Det),
  679        ( Det == ! -> ! ; true )
  680    ;   '$depth_limit_false'(OLimit, OReached, Result)
  681    ).
 call_with_inference_limit(:Goal, +InferenceLimit, -Result)
Equivalent to call(Goal), but poses a limit on the number of inferences. If this limit is reached, Result is unified with inference_limit_exceeded, otherwise Result is unified with ! if Goal succeeded without a choicepoint and true otherwise.

Note that we perform calls in system to avoid auto-importing, which makes raiseInferenceLimitException() fail to recognise that the exception happens in the overhead.

  695:- meta_predicate
  696    call_with_inference_limit(0, +, -).  697
  698call_with_inference_limit(G, Limit, Result) :-
  699    '$inference_limit'(Limit, OLimit),
  700    (   catch(G, Except,
  701              system:'$inference_limit_except'(OLimit, Except, Result0)),
  702        system:'$inference_limit_true'(Limit, OLimit, Result0),
  703        ( Result0 == ! -> ! ; true ),
  704        Result = Result0
  705    ;   system:'$inference_limit_false'(OLimit)
  706    ).
  707
  708
  709                /********************************
  710                *           DATA BASE           *
  711                *********************************/
  712
  713/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
  714The predicate current_predicate/2 is   a  difficult subject since  the
  715introduction  of defaulting     modules   and   dynamic     libraries.
  716current_predicate/2 is normally  called with instantiated arguments to
  717verify some  predicate can   be called without trapping   an undefined
  718predicate.  In this case we must  perform the search algorithm used by
  719the prolog system itself.
  720
  721If the pattern is not fully specified, we only generate the predicates
  722actually available in this  module.   This seems the best for listing,
  723etc.
  724- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
  725
  726
  727:- meta_predicate
  728    current_predicate(?, :),
  729    '$defined_predicate'(:).  730
  731current_predicate(Name, Module:Head) :-
  732    (var(Module) ; var(Head)),
  733    !,
  734    generate_current_predicate(Name, Module, Head).
  735current_predicate(Name, Term) :-
  736    '$c_current_predicate'(Name, Term),
  737    '$defined_predicate'(Term),
  738    !.
  739current_predicate(Name, Module:Head) :-
  740    default_module(Module, DefModule),
  741    '$c_current_predicate'(Name, DefModule:Head),
  742    '$defined_predicate'(DefModule:Head),
  743    !.
  744current_predicate(Name, Module:Head) :-
  745    current_prolog_flag(autoload, true),
  746    \+ current_prolog_flag(Module:unknown, fail),
  747    (   compound(Head)
  748    ->  compound_name_arity(Head, Name, Arity)
  749    ;   Name = Head, Arity = 0
  750    ),
  751    '$find_library'(Module, Name, Arity, _LoadModule, _Library),
  752    !.
  753
  754generate_current_predicate(Name, Module, Head) :-
  755    current_module(Module),
  756    QHead = Module:Head,
  757    '$c_current_predicate'(Name, QHead),
  758    '$get_predicate_attribute'(QHead, defined, 1).
  759
  760'$defined_predicate'(Head) :-
  761    '$get_predicate_attribute'(Head, defined, 1),
  762    !.
 predicate_property(?Predicate, ?Property) is nondet
True when Property is a property of Predicate.
  768:- meta_predicate
  769    predicate_property(:, ?).  770
  771:- '$iso'(predicate_property/2).  772
  773predicate_property(Pred, Property) :-           % Mode ?,+
  774    nonvar(Property),
  775    !,
  776    property_predicate(Property, Pred).
  777predicate_property(Pred, Property) :-           % Mode +,-
  778    define_or_generate(Pred),
  779    '$predicate_property'(Property, Pred).
 property_predicate(+Property, ?Pred)
First handle the special cases that are not about querying normally defined predicates: undefined, visible and autoload, followed by the generic case.
  787property_predicate(undefined, Pred) :-
  788    !,
  789    Pred = Module:Head,
  790    current_module(Module),
  791    '$c_current_predicate'(_, Pred),
  792    \+ '$defined_predicate'(Pred),          % Speed up a bit
  793    \+ current_predicate(_, Pred),
  794    goal_name_arity(Head, Name, Arity),
  795    \+ system_undefined(Module:Name/Arity).
  796property_predicate(visible, Pred) :-
  797    !,
  798    visible_predicate(Pred).
  799property_predicate(autoload(File), _:Head) :-
  800    !,
  801    current_prolog_flag(autoload, true),
  802    (   callable(Head)
  803    ->  goal_name_arity(Head, Name, Arity),
  804        (   '$find_library'(_, Name, Arity, _, File)
  805        ->  true
  806        )
  807    ;   '$in_library'(Name, Arity, File),
  808        functor(Head, Name, Arity)
  809    ).
  810property_predicate(implementation_module(IM), M:Head) :-
  811    !,
  812    atom(M),
  813    (   default_module(M, DM),
  814        '$get_predicate_attribute'(DM:Head, defined, 1)
  815    ->  (   '$get_predicate_attribute'(DM:Head, imported, ImportM)
  816        ->  IM = ImportM
  817        ;   IM = M
  818        )
  819    ;   \+ current_prolog_flag(M:unknown, fail),
  820        goal_name_arity(Head, Name, Arity),
  821        '$find_library'(_, Name, Arity, LoadModule, _File)
  822    ->  IM = LoadModule
  823    ;   M = IM
  824    ).
  825property_predicate(Property, Pred) :-
  826    define_or_generate(Pred),
  827    '$predicate_property'(Property, Pred).
  828
  829goal_name_arity(Head, Name, Arity) :-
  830    compound(Head),
  831    !,
  832    compound_name_arity(Head, Name, Arity).
  833goal_name_arity(Head, Head, 0).
 define_or_generate(+Head) is semidet
define_or_generate(-Head) is nondet
If the predicate is known, try to resolve it. Otherwise generate the known predicate, but do not try to (auto)load the predicate.
  842define_or_generate(M:Head) :-
  843    callable(Head),
  844    atom(M),
  845    '$get_predicate_attribute'(M:Head, defined, 1),
  846    !.
  847define_or_generate(M:Head) :-
  848    callable(Head),
  849    nonvar(M), M \== system,
  850    !,
  851    '$define_predicate'(M:Head).
  852define_or_generate(Pred) :-
  853    current_predicate(_, Pred),
  854    '$define_predicate'(Pred).
  855
  856
  857'$predicate_property'(interpreted, Pred) :-
  858    '$get_predicate_attribute'(Pred, foreign, 0).
  859'$predicate_property'(visible, Pred) :-
  860    '$get_predicate_attribute'(Pred, defined, 1).
  861'$predicate_property'(built_in, Pred) :-
  862    '$get_predicate_attribute'(Pred, system, 1).
  863'$predicate_property'(exported, Pred) :-
  864    '$get_predicate_attribute'(Pred, exported, 1).
  865'$predicate_property'(public, Pred) :-
  866    '$get_predicate_attribute'(Pred, public, 1).
  867'$predicate_property'(foreign, Pred) :-
  868    '$get_predicate_attribute'(Pred, foreign, 1).
  869'$predicate_property'((dynamic), Pred) :-
  870    '$get_predicate_attribute'(Pred, (dynamic), 1).
  871'$predicate_property'((static), Pred) :-
  872    '$get_predicate_attribute'(Pred, (dynamic), 0).
  873'$predicate_property'((volatile), Pred) :-
  874    '$get_predicate_attribute'(Pred, (volatile), 1).
  875'$predicate_property'((thread_local), Pred) :-
  876    '$get_predicate_attribute'(Pred, (thread_local), 1).
  877'$predicate_property'((multifile), Pred) :-
  878    '$get_predicate_attribute'(Pred, (multifile), 1).
  879'$predicate_property'(imported_from(Module), Pred) :-
  880    '$get_predicate_attribute'(Pred, imported, Module).
  881'$predicate_property'(transparent, Pred) :-
  882    '$get_predicate_attribute'(Pred, transparent, 1).
  883'$predicate_property'(meta_predicate(Pattern), Pred) :-
  884    '$get_predicate_attribute'(Pred, meta_predicate, Pattern).
  885'$predicate_property'(file(File), Pred) :-
  886    '$get_predicate_attribute'(Pred, file, File).
  887'$predicate_property'(line_count(LineNumber), Pred) :-
  888    '$get_predicate_attribute'(Pred, line_count, LineNumber).
  889'$predicate_property'(notrace, Pred) :-
  890    '$get_predicate_attribute'(Pred, trace, 0).
  891'$predicate_property'(nodebug, Pred) :-
  892    '$get_predicate_attribute'(Pred, hide_childs, 1).
  893'$predicate_property'(spying, Pred) :-
  894    '$get_predicate_attribute'(Pred, spy, 1).
  895'$predicate_property'(number_of_clauses(N), Pred) :-
  896    '$get_predicate_attribute'(Pred, number_of_clauses, N).
  897'$predicate_property'(number_of_rules(N), Pred) :-
  898    '$get_predicate_attribute'(Pred, number_of_rules, N).
  899'$predicate_property'(last_modified_generation(Gen), Pred) :-
  900    '$get_predicate_attribute'(Pred, last_modified_generation, Gen).
  901'$predicate_property'(indexed(Indices), Pred) :-
  902    '$get_predicate_attribute'(Pred, indexed, Indices).
  903'$predicate_property'(noprofile, Pred) :-
  904    '$get_predicate_attribute'(Pred, noprofile, 1).
  905'$predicate_property'(iso, Pred) :-
  906    '$get_predicate_attribute'(Pred, iso, 1).
  907'$predicate_property'(quasi_quotation_syntax, Pred) :-
  908    '$get_predicate_attribute'(Pred, quasi_quotation_syntax, 1).
  909'$predicate_property'(defined, Pred) :-
  910    '$get_predicate_attribute'(Pred, defined, 1).
  911
  912system_undefined(user:prolog_trace_interception/4).
  913system_undefined(user:prolog_exception_hook/4).
  914system_undefined(system:'$c_call_prolog'/0).
  915system_undefined(system:window_title/2).
 visible_predicate(:Head) is nondet
True when Head can be called without raising an existence error. This implies it is defined, can be inherited from a default module or can be autoloaded.
  923visible_predicate(Pred) :-
  924    Pred = M:Head,
  925    current_module(M),
  926    (   callable(Head)
  927    ->  (   '$get_predicate_attribute'(Pred, defined, 1)
  928        ->  true
  929        ;   \+ current_prolog_flag(M:unknown, fail),
  930            functor(Head, Name, Arity),
  931            '$find_library'(M, Name, Arity, _LoadModule, _Library)
  932        )
  933    ;   setof(PI, visible_in_module(M, PI), PIs),
  934        '$member'(Name/Arity, PIs),
  935        functor(Head, Name, Arity)
  936    ).
  937
  938visible_in_module(M, Name/Arity) :-
  939    default_module(M, DefM),
  940    DefHead = DefM:Head,
  941    '$c_current_predicate'(_, DefHead),
  942    '$get_predicate_attribute'(DefHead, defined, 1),
  943    \+ hidden_system_predicate(Head),
  944    functor(Head, Name, Arity).
  945visible_in_module(_, Name/Arity) :-
  946    '$in_library'(Name, Arity, _).
  947
  948hidden_system_predicate(Head) :-
  949    functor(Head, Name, _),
  950    atom(Name),                     % Avoid [].
  951    sub_atom(Name, 0, _, _, $),
  952    \+ current_prolog_flag(access_level, system).
 clause_property(+ClauseRef, ?Property) is nondet
Provide information on individual clauses. Defined properties are:
line_count(-Line)
Line from which the clause is loaded.
file(-File)
File from which the clause is loaded.
source(-File)
File that `owns' the clause: reloading this file wipes the clause.
fact
Clause has body true.
erased
Clause was erased.
predicate(:PI)
Predicate indicator of the predicate this clause belongs to. Can be used to find the predicate of erased clauses.
module(-M)
Module context in which the clause was compiled.
  977clause_property(Clause, Property) :-
  978    '$clause_property'(Property, Clause).
  979
  980'$clause_property'(line_count(LineNumber), Clause) :-
  981    '$get_clause_attribute'(Clause, line_count, LineNumber).
  982'$clause_property'(file(File), Clause) :-
  983    '$get_clause_attribute'(Clause, file, File).
  984'$clause_property'(source(File), Clause) :-
  985    '$get_clause_attribute'(Clause, owner, File).
  986'$clause_property'(size(Bytes), Clause) :-
  987    '$get_clause_attribute'(Clause, size, Bytes).
  988'$clause_property'(fact, Clause) :-
  989    '$get_clause_attribute'(Clause, fact, true).
  990'$clause_property'(erased, Clause) :-
  991    '$get_clause_attribute'(Clause, erased, true).
  992'$clause_property'(predicate(PI), Clause) :-
  993    '$get_clause_attribute'(Clause, predicate_indicator, PI).
  994'$clause_property'(module(M), Clause) :-
  995    '$get_clause_attribute'(Clause, module, M).
  996
  997
  998                 /*******************************
  999                 *             REQUIRE          *
 1000                 *******************************/
 1001
 1002:- meta_predicate
 1003    require(:).
 require(:ListOfPredIndicators) is det
Tag given predicates as undefined, so they will be included into a saved state through the autoloader.
See also
- autoload/0.
 1012require(M:List) :-
 1013    (   is_list(List)
 1014    ->  require(List, M)
 1015    ;   throw(error(type_error(list, List), _))
 1016    ).
 1017
 1018require([], _).
 1019require([N/A|T], M) :-
 1020    !,
 1021    functor(Head, N, A),
 1022    '$require'(M:Head),
 1023    require(T, M).
 1024require([H|_T], _) :-
 1025    throw(error(type_error(predicate_indicator, H), _)).
 1026
 1027
 1028                /********************************
 1029                *            MODULES            *
 1030                *********************************/
 current_module(?Module) is nondet
True if Module is a currently defined module.
 1036current_module(Module) :-
 1037    '$current_module'(Module, _).
 module_property(?Module, ?Property) is nondet
True if Property is a property of Module. Defined properties are:
file(File)
Module is loaded from File.
line_count(Count)
The module declaration is on line Count of File.
exports(ListOfPredicateIndicators)
The module exports ListOfPredicateIndicators
exported_operators(ListOfOp3)
The module exports the operators ListOfOp3.
 1053module_property(Module, Property) :-
 1054    nonvar(Module), nonvar(Property),
 1055    !,
 1056    property_module(Property, Module).
 1057module_property(Module, Property) :-    % -, file(File)
 1058    nonvar(Property), Property = file(File),
 1059    !,
 1060    (   nonvar(File)
 1061    ->  '$current_module'(Modules, File),
 1062        (   atom(Modules)
 1063        ->  Module = Modules
 1064        ;   '$member'(Module, Modules)
 1065        )
 1066    ;   '$current_module'(Module, File),
 1067        File \== []
 1068    ).
 1069module_property(Module, Property) :-
 1070    current_module(Module),
 1071    property_module(Property, Module).
 1072
 1073property_module(Property, Module) :-
 1074    module_property(Property),
 1075    (   Property = exported_operators(List)
 1076    ->  '$exported_ops'(Module, List, []),
 1077        List \== []
 1078    ;   '$module_property'(Module, Property)
 1079    ).
 1080
 1081module_property(class(_)).
 1082module_property(file(_)).
 1083module_property(line_count(_)).
 1084module_property(exports(_)).
 1085module_property(exported_operators(_)).
 1086module_property(program_size(_)).
 1087module_property(program_space(_)).
 1088module_property(last_modified_generation(_)).
 module(+Module) is det
Set the module that is associated to the toplevel to Module.
 1094module(Module) :-
 1095    atom(Module),
 1096    current_module(Module),
 1097    !,
 1098    '$set_typein_module'(Module).
 1099module(Module) :-
 1100    '$set_typein_module'(Module),
 1101    print_message(warning, no_current_module(Module)).
 working_directory(-Old, +New)
True when Old is the current working directory and the working directory has been updated to New.
 1108working_directory(Old, New) :-
 1109    '$cwd'(Old),
 1110    (   Old == New
 1111    ->  true
 1112    ;   '$chdir'(New)
 1113    ).
 1114
 1115
 1116                 /*******************************
 1117                 *            TRIES             *
 1118                 *******************************/
 current_trie(?Trie) is nondet
True if Trie is the handle of an existing trie.
 1124current_trie(Trie) :-
 1125    current_blob(Trie, trie),
 1126    is_trie(Trie).
 trie_property(?Trie, ?Property)
True when Property is a property of Trie. Defined properties are:
value_count(Count)
Number of terms in the trie.
node_count(Count)
Number of nodes in the trie.
size(Bytes)
Number of bytes needed to store the trie.
hashed(Count)
Number of hashed nodes.
 1142trie_property(Trie, Property) :-
 1143    current_trie(Trie),
 1144    trie_property(Property),
 1145    '$trie_property'(Trie, Property).
 1146
 1147trie_property(node_count(_)).
 1148trie_property(value_count(_)).
 1149trie_property(size(_)).
 1150trie_property(hashed(_)).
 1151
 1152
 1153
 1154                /********************************
 1155                *      SYSTEM INTERACTION       *
 1156                *********************************/
 1157
 1158shell(Command) :-
 1159    shell(Command, 0).
 win_add_dll_directory(+AbsDir) is det
Add AbsDir to the directories where dependent DLLs are searched on Windows systems.
 1166:- if(current_prolog_flag(windows, true)). 1167:- export(win_add_dll_directory/1). 1168win_add_dll_directory(Dir) :-
 1169    win_add_dll_directory(Dir, _),
 1170    !.
 1171win_add_dll_directory(Dir) :-
 1172    prolog_to_os_filename(Dir, OSDir),
 1173    getenv('PATH', Path0),
 1174    atomic_list_concat([Path0, OSDir], ';', Path),
 1175    setenv('PATH', Path).
 1176:- endif. 1177
 1178                 /*******************************
 1179                 *            SIGNALS           *
 1180                 *******************************/
 1181
 1182:- meta_predicate
 1183    on_signal(+, :, :),
 1184    current_signal(?, ?, :).
 on_signal(+Signal, -OldHandler, :NewHandler) is det
 1188on_signal(Signal, Old, New) :-
 1189    atom(Signal),
 1190    !,
 1191    '$on_signal'(_Num, Signal, Old, New).
 1192on_signal(Signal, Old, New) :-
 1193    integer(Signal),
 1194    !,
 1195    '$on_signal'(Signal, _Name, Old, New).
 1196on_signal(Signal, _Old, _New) :-
 1197    '$type_error'(signal_name, Signal).
 current_signal(?Name, ?SignalNumber, :Handler) is nondet
 1201current_signal(Name, Id, Handler) :-
 1202    between(1, 32, Id),
 1203    '$on_signal'(Id, Name, Handler, Handler).
 1204
 1205:- multifile
 1206    prolog:called_by/2. 1207
 1208prolog:called_by(on_signal(_,_,New), [New+1]) :-
 1209    (   new == throw
 1210    ;   new == default
 1211    ), !, fail.
 1212
 1213
 1214                 /*******************************
 1215                 *            DLOPEN            *
 1216                 *******************************/
 open_shared_object(+File, -Handle) is det
 open_shared_object(+File, -Handle, +Flags) is det
Open a shared object or DLL file. Flags is a list of flags. The following flags are recognised. Note however that these flags may have no affect on the target platform.
 1230open_shared_object(File, Handle) :-
 1231    open_shared_object(File, Handle, []). % use pl-load.c defaults
 1232
 1233open_shared_object(File, Handle, Flags) :-
 1234    (   is_list(Flags)
 1235    ->  true
 1236    ;   throw(error(type_error(list, Flags), _))
 1237    ),
 1238    map_dlflags(Flags, Mask),
 1239    '$open_shared_object'(File, Handle, Mask).
 1240
 1241dlopen_flag(now,        2'01).          % see pl-load.c for these constants
 1242dlopen_flag(global,     2'10).          % Solaris only
 1243
 1244map_dlflags([], 0).
 1245map_dlflags([F|T], M) :-
 1246    map_dlflags(T, M0),
 1247    (   dlopen_flag(F, I)
 1248    ->  true
 1249    ;   throw(error(domain_error(dlopen_flag, F), _))
 1250    ),
 1251    M is M0 \/ I.
 1252
 1253
 1254                 /*******************************
 1255                 *             I/O              *
 1256                 *******************************/
 1257
 1258format(Fmt) :-
 1259    format(Fmt, []).
 1260
 1261                 /*******************************
 1262                 *            FILES             *
 1263                 *******************************/
 1264
 1265%       absolute_file_name(+Term, -AbsoluteFile)
 1266
 1267absolute_file_name(Name, Abs) :-
 1268    atomic(Name),
 1269    !,
 1270    '$absolute_file_name'(Name, Abs).
 1271absolute_file_name(Term, Abs) :-
 1272    '$chk_file'(Term, [''], [access(read)], true, File),
 1273    !,
 1274    '$absolute_file_name'(File, Abs).
 1275absolute_file_name(Term, Abs) :-
 1276    '$chk_file'(Term, [''], [], true, File),
 1277    !,
 1278    '$absolute_file_name'(File, Abs).
 1279
 1280
 1281                /********************************
 1282                *        MEMORY MANAGEMENT      *
 1283                *********************************/
 garbage_collect is det
Invoke the garbage collector. The argument of the underlying '$garbage_collect'/1 is the debugging level to use during garbage collection. This only works if the system is compiled with the -DODEBUG cpp flag. Only to simplify maintenance.
 1292garbage_collect :-
 1293    '$garbage_collect'(0).
 set_prolog_stack(+Name, +Option) is det
Set a parameter for one of the Prolog stacks.
 1299set_prolog_stack(Stack, Option) :-
 1300    Option =.. [Name,Value0],
 1301    Value is Value0,
 1302    '$set_prolog_stack'(Stack, Name, _Old, Value).
 prolog_stack_property(?Stack, ?Property) is nondet
Examine stack properties.
 1308prolog_stack_property(Stack, Property) :-
 1309    stack_property(P),
 1310    stack_name(Stack),
 1311    Property =.. [P,Value],
 1312    '$set_prolog_stack'(Stack, P, Value, Value).
 1313
 1314stack_name(local).
 1315stack_name(global).
 1316stack_name(trail).
 1317
 1318stack_property(limit).
 1319stack_property(spare).
 1320stack_property(min_free).
 1321stack_property(low).
 1322stack_property(factor).
 1323
 1324
 1325                 /*******************************
 1326                 *             TERM             *
 1327                 *******************************/
 1328
 1329:- '$iso'((numbervars/3)).
 numbervars(+Term, +StartIndex, -EndIndex) is det
Number all unbound variables in Term using '$VAR'(N), where the first N is StartIndex and EndIndex is unified to the index that will be given to the next variable.
 1337numbervars(Term, From, To) :-
 1338    numbervars(Term, From, To, []).
 1339
 1340
 1341                 /*******************************
 1342                 *            STRING            *
 1343                 *******************************/
 term_string(?Term, ?String, +Options)
Parse/write a term from/to a string using Options.
 1349term_string(Term, String, Options) :-
 1350    nonvar(String),
 1351    !,
 1352    read_term_from_atom(String, Term, Options).
 1353term_string(Term, String, Options) :-
 1354    (   '$option'(quoted(_), Options)
 1355    ->  Options1 = Options
 1356    ;   '$merge_options'(_{quoted:true}, Options, Options1)
 1357    ),
 1358    format(string(String), '~W', [Term, Options1]).
 1359
 1360
 1361                 /*******************************
 1362                 *             GVAR             *
 1363                 *******************************/
 nb_setval(+Name, +Value) is det
Bind the non-backtrackable variable Name with a copy of Value
 1369nb_setval(Name, Value) :-
 1370    duplicate_term(Value, Copy),
 1371    nb_linkval(Name, Copy).
 1372
 1373
 1374		 /*******************************
 1375		 *            THREADS		*
 1376		 *******************************/
 1377
 1378:- meta_predicate
 1379    thread_create(0, -).
 thread_create(:Goal, -Id)
Shorthand for thread_create(Goal, Id, []).
 1385thread_create(Goal, Id) :-
 1386    thread_create(Goal, Id, []).
 thread_join(+Id)
Join a thread and raise an error of the thread did not succeed.
Errors
- thread_error(Status), where Status is the result of thread_join/2.
 1395thread_join(Id) :-
 1396    thread_join(Id, Status),
 1397    (   Status == true
 1398    ->  true
 1399    ;   throw(error(thread_error(Status), _))
 1400    ).
 set_prolog_gc_thread(+Status)
Control the GC thread. Status is one of
false
Disable the separate GC thread, running atom and clause garbage collection in the triggering thread.
true
Enable the separate GC thread. All implicit atom and clause garbage collection is executed by the thread gc.
stop
Stop the gc thread it it is running. The thread is recreated on the next implicit atom or clause garbage collection. Used by fork/1 to avoid forking a multi-threaded application.
 1417set_prolog_gc_thread(Status) :-
 1418    var(Status),
 1419    !,
 1420    '$instantiation_error'(Status).
 1421:- if(current_prolog_flag(threads,true)). 1422set_prolog_gc_thread(false) :-
 1423    !,
 1424    set_prolog_flag(gc_thread, false),
 1425    (   '$gc_stop'
 1426    ->  thread_join(gc)
 1427    ;   true
 1428    ).
 1429set_prolog_gc_thread(true) :-
 1430    !,
 1431    set_prolog_flag(gc_thread, true).
 1432set_prolog_gc_thread(stop) :-
 1433    !,
 1434    (   '$gc_stop'
 1435    ->  thread_join(gc)
 1436    ;   true
 1437    ).
 1438:- else. 1439set_prolog_gc_thread(false) :- !.
 1440set_prolog_gc_thread(true) :- !.
 1441set_prolog_gc_thread(stop) :- !.
 1442:- endif. 1443set_prolog_gc_thread(Status) :-
 1444    '$domain_error'(gc_thread, Status)