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-2025, University of Amsterdam
    7                              VU University Amsterdam
    8                              CWI, Amsterdam
    9                              SWI-Prolog Solutions b.v.
   10    All rights reserved.
   11
   12    Redistribution and use in source and binary forms, with or without
   13    modification, are permitted provided that the following conditions
   14    are met:
   15
   16    1. Redistributions of source code must retain the above copyright
   17       notice, this list of conditions and the following disclaimer.
   18
   19    2. Redistributions in binary form must reproduce the above copyright
   20       notice, this list of conditions and the following disclaimer in
   21       the documentation and/or other materials provided with the
   22       distribution.
   23
   24    THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
   25    "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
   26    LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS
   27    FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE
   28    COPYRIGHT OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT,
   29    INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING,
   30    BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES;
   31    LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER
   32    CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
   33    LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN
   34    ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
   35    POSSIBILITY OF SUCH DAMAGE.
   36*/
   37
   38:- module('$syspreds',
   39          [ leash/1,
   40            visible/1,
   41            style_check/1,
   42            flag/3,
   43            atom_prefix/2,
   44            dwim_match/2,
   45            source_file_property/2,
   46            source_file/1,
   47            source_file/2,
   48            unload_file/1,
   49            exists_source/1,                    % +Spec
   50            exists_source/2,                    % +Spec, -Path
   51            prolog_load_context/2,
   52            stream_position_data/3,
   53            current_predicate/2,
   54            '$defined_predicate'/1,
   55            predicate_property/2,
   56            '$predicate_property'/2,
   57            (dynamic)/2,                        % :Predicates, +Options
   58            clause_property/2,
   59            current_module/1,                   % ?Module
   60            module_property/2,                  % ?Module, ?Property
   61            module/1,                           % +Module
   62            current_trie/1,                     % ?Trie
   63            trie_property/2,                    % ?Trie, ?Property
   64            working_directory/2,                % -OldDir, +NewDir
   65            shell/1,                            % +Command
   66            on_signal/3,
   67            current_signal/3,
   68            format/1,
   69            garbage_collect/0,
   70            set_prolog_stack/2,
   71            prolog_stack_property/2,
   72            absolute_file_name/2,
   73            tmp_file_stream/3,                  % +Enc, -File, -Stream
   74            call_with_depth_limit/3,            % :Goal, +Limit, -Result
   75            call_with_inference_limit/3,        % :Goal, +Limit, -Result
   76            rule/2,                             % :Head, -Rule
   77            rule/3,                             % :Head, -Rule, ?Ref
   78            numbervars/3,                       % +Term, +Start, -End
   79            term_string/3,                      % ?Term, ?String, +Options
   80            thread_create/2,                    % :Goal, -Id
   81            thread_join/1,                      % +Id
   82            sig_block/1,                        % :Pattern
   83            sig_unblock/1,                      % :Pattern
   84            transaction/1,                      % :Goal
   85            transaction/2,                      % :Goal, +Options
   86            transaction/3,                      % :Goal, :Constraint, +Mutex
   87            snapshot/1,                         % :Goal
   88            undo/1,                             % :Goal
   89            set_prolog_gc_thread/1,		% +Status
   90
   91            '$wrap_predicate'/5,                % :Head, +Name, -Closure, -Wrapped, +Body
   92            '$predicate_source_location'/2,     % :Head, -File:Line
   93            '$addr2line_location'/3             % +Description, -File, -Line
   94          ]).   95
   96:- meta_predicate
   97    dynamic(:, +),
   98    transaction(0),
   99    transaction(0,0,+),
  100    snapshot(0),
  101    rule(:, -),
  102    rule(:, -, ?),
  103    sig_block(:),
  104    sig_unblock(:).  105
  106
  107                /********************************
  108                *           DEBUGGER            *
  109                *********************************/
  110
  111%!  map_bits(:Pred, +Modify, +OldBits, -NewBits)
  112
  113:- meta_predicate
  114    map_bits(2, +, +, -).  115
  116map_bits(_, Var, _, _) :-
  117    var(Var),
  118    !,
  119    '$instantiation_error'(Var).
  120map_bits(_, [], Bits, Bits) :- !.
  121map_bits(Pred, [H|T], Old, New) :-
  122    map_bits(Pred, H, Old, New0),
  123    map_bits(Pred, T, New0, New).
  124map_bits(Pred, +Name, Old, New) :-     % set a bit
  125    !,
  126    bit(Pred, Name, Bits),
  127    !,
  128    New is Old \/ Bits.
  129map_bits(Pred, -Name, Old, New) :-     % clear a bit
  130    !,
  131    bit(Pred, Name, Bits),
  132    !,
  133    New is Old /\ (\Bits).
  134map_bits(Pred, ?(Name), Old, Old) :-   % ask a bit
  135    !,
  136    bit(Pred, Name, Bits),
  137    Old /\ Bits > 0.
  138map_bits(_, Term, _, _) :-
  139    '$type_error'('+|-|?(Flag)', Term).
  140
  141bit(Pred, Name, Bits) :-
  142    call(Pred, Name, Bits),
  143    !.
  144bit(_:Pred, Name, _) :-
  145    '$domain_error'(Pred, Name).
  146
  147:- public port_name/2.                  % used by library(test_cover)
  148
  149port_name(      call, 2'000000001).
  150port_name(      exit, 2'000000010).
  151port_name(      fail, 2'000000100).
  152port_name(      redo, 2'000001000).
  153port_name(     unify, 2'000010000).
  154port_name(     break, 2'000100000).
  155port_name(  cut_call, 2'001000000).
  156port_name(  cut_exit, 2'010000000).
  157port_name( exception, 2'100000000).
  158port_name(       cut, 2'011000000).
  159port_name(       all, 2'000111111).
  160port_name(      full, 2'000101111).
  161port_name(      half, 2'000101101).     % '
  162
  163leash(Ports) :-
  164    '$leash'(Old, Old),
  165    map_bits(port_name, Ports, Old, New),
  166    '$leash'(_, New).
  167
  168visible(Ports) :-
  169    '$visible'(Old, Old),
  170    map_bits(port_name, Ports, Old, New),
  171    '$visible'(_, New).
  172
  173style_name(atom,            0x0001) :-
  174    print_message(warning, decl_no_effect(style_check(atom))).
  175style_name(singleton,       0x0042).            % semantic and syntactic
  176style_name(discontiguous,   0x0008).
  177style_name(charset,         0x0020).
  178style_name(no_effect,       0x0080).
  179style_name(var_branches,    0x0100).
  180
  181%!  style_check(+Spec) is nondet.
  182
  183style_check(Var) :-
  184    var(Var),
  185    !,
  186    '$instantiation_error'(Var).
  187style_check(?(Style)) :-
  188    !,
  189    (   var(Style)
  190    ->  enum_style_check(Style)
  191    ;   enum_style_check(Style)
  192    ->  true
  193    ).
  194style_check(Spec) :-
  195    '$style_check'(Old, Old),
  196    map_bits(style_name, Spec, Old, New),
  197    '$style_check'(_, New).
  198
  199enum_style_check(Style) :-
  200    '$style_check'(Bits, Bits),
  201    style_name(Style, Bit),
  202    Bit /\ Bits =\= 0.
  203
  204
  205%!  flag(+Name, -Old, +New) is det.
  206%
  207%   True when Old is the current value associated with the flag Name
  208%   and New has become the new value.
  209
  210flag(Name, Old, New) :-
  211    Old == New,
  212    !,
  213    get_flag(Name, Old).
  214flag(Name, Old, New) :-
  215    with_mutex('$flag', update_flag(Name, Old, New)).
  216
  217update_flag(Name, Old, New) :-
  218    get_flag(Name, Old),
  219    (   atom(New)
  220    ->  set_flag(Name, New)
  221    ;   Value is New,
  222        set_flag(Name, Value)
  223    ).
  224
  225
  226                /********************************
  227                *             ATOMS             *
  228                *********************************/
  229
  230dwim_match(A1, A2) :-
  231    dwim_match(A1, A2, _).
  232
  233atom_prefix(Atom, Prefix) :-
  234    sub_atom(Atom, 0, _, _, Prefix).
  235
  236
  237                /********************************
  238                *             SOURCE            *
  239                *********************************/
  240
  241%!  source_file(-File) is nondet.
  242%!  source_file(+File) is semidet.
  243%
  244%   True if File is loaded into  Prolog.   If  File is unbound it is
  245%   bound to the canonical name for it. If File is bound it succeeds
  246%   if the canonical name  as   defined  by  absolute_file_name/2 is
  247%   known as a loaded filename.
  248%
  249%   Note that Time = 0 is used by PlDoc and other code that needs to
  250%   create a file record without being interested in the time.
  251
  252source_file(File) :-
  253    (   current_prolog_flag(access_level, user)
  254    ->  Level = user
  255    ;   true
  256    ),
  257    (   ground(File)
  258    ->  (   '$time_source_file'(File, Time, Level)
  259        ;   absolute_file_name(File, Abs),
  260            '$time_source_file'(Abs, Time, Level)
  261        ), !
  262    ;   '$time_source_file'(File, Time, Level)
  263    ),
  264    float(Time).
  265
  266%!  source_file(+Head, -File) is semidet.
  267%!  source_file(?Head, ?File) is nondet.
  268%
  269%   True when Head is a predicate owned by File.
  270
  271:- meta_predicate source_file(:, ?).  272
  273source_file(M:Head, File) :-
  274    nonvar(M), nonvar(Head),
  275    !,
  276    (   '$c_current_predicate'(_, M:Head),
  277        predicate_property(M:Head, multifile)
  278    ->  multi_source_file(M:Head, File)
  279    ;   '$source_file'(M:Head, File)
  280    ).
  281source_file(M:Head, File) :-
  282    (   nonvar(File)
  283    ->  true
  284    ;   source_file(File)
  285    ),
  286    '$source_file_predicates'(File, Predicates),
  287    '$member'(M:Head, Predicates).
  288
  289multi_source_file(Head, File) :-
  290    State = state([]),
  291    nth_clause(Head, _, Clause),
  292    clause_property(Clause, source(File)),
  293    arg(1, State, Found),
  294    (   memberchk(File, Found)
  295    ->  fail
  296    ;   nb_linkarg(1, State, [File|Found])
  297    ).
  298
  299
  300%!  source_file_property(?File, ?Property) is nondet.
  301%
  302%   True if Property is a property of the loaded source-file File.
  303
  304source_file_property(File, P) :-
  305    nonvar(File),
  306    !,
  307    canonical_source_file(File, Path),
  308    property_source_file(P, Path).
  309source_file_property(File, P) :-
  310    property_source_file(P, File).
  311
  312property_source_file(modified(Time), File) :-
  313    '$time_source_file'(File, Time, user).
  314property_source_file(source(Source), File) :-
  315    (   '$source_file_property'(File, from_state, true)
  316    ->  Source = state
  317    ;   '$source_file_property'(File, resource, true)
  318    ->  Source = resource
  319    ;   Source = file
  320    ).
  321property_source_file(module(M), File) :-
  322    (   nonvar(M)
  323    ->  '$current_module'(M, File)
  324    ;   nonvar(File)
  325    ->  '$current_module'(ML, File),
  326        (   atom(ML)
  327        ->  M = ML
  328        ;   '$member'(M, ML)
  329        )
  330    ;   '$current_module'(M, File)
  331    ).
  332property_source_file(load_context(Module, Location, Options), File) :-
  333    clause(system:'$load_context_module'(File, Module, Options), true, Ref),
  334    '$time_source_file'(File, _, user),
  335    (   clause_property(Ref, file(FromFile)),
  336        clause_property(Ref, line_count(FromLine))
  337    ->  Location = FromFile:FromLine
  338    ;   Location = user
  339    ).
  340property_source_file(includes(Master, Stamp), File) :-
  341    system:'$included'(File, _Line, Master, Stamp).
  342property_source_file(included_in(Master, Line), File) :-
  343    system:'$included'(Master, Line, File, _).
  344property_source_file(derived_from(DerivedFrom, Stamp), File) :-
  345    system:'$derived_source'(File, DerivedFrom, Stamp).
  346property_source_file(reloading, File) :-
  347    source_file(File),
  348    '$source_file_property'(File, reloading, true).
  349property_source_file(load_count(Count), File) :-
  350    source_file(File),
  351    '$source_file_property'(File, load_count, Count).
  352property_source_file(number_of_clauses(Count), File) :-
  353    source_file(File),
  354    '$source_file_property'(File, number_of_clauses, Count).
  355property_source_file(loaded(Stamp), File) :-
  356    source_file(File),
  357    '$source_file_property'(File, loaded, Stamp).
  358
  359
  360%!  canonical_source_file(+Spec, -File) is semidet.
  361%
  362%   File is the canonical representation of the source-file Spec.
  363
  364canonical_source_file(Spec, File) :-
  365    atom(Spec),
  366    '$time_source_file'(Spec, _, _),
  367    !,
  368    File = Spec.
  369canonical_source_file(Spec, File) :-
  370    system:'$included'(_Master, _Line, Spec, _),
  371    !,
  372    File = Spec.
  373canonical_source_file(Spec, File) :-
  374    absolute_file_name(Spec, File,
  375                       [ file_type(source),
  376                         solutions(all),
  377                         file_errors(fail)
  378                       ]),
  379    source_file(File),
  380    !.
  381
  382
  383%!  exists_source(+Source) is semidet.
  384%!  exists_source(+Source, -Path) is semidet.
  385%
  386%   True if Source (a term  valid   for  load_files/2) exists. Fails
  387%   without error if this is not the case. The predicate is intended
  388%   to be used with  :-  if,  as   in  the  example  below. See also
  389%   source_exports/2.
  390%
  391%   ```
  392%   :- if(exists_source(library(error))).
  393%   :- use_module_library(error).
  394%   :- endif.
  395%   ```
  396
  397exists_source(Source) :-
  398    exists_source(Source, _Path).
  399
  400exists_source(Source, Path) :-
  401    absolute_file_name(Source, Path,
  402                       [ file_type(prolog),
  403                         access(read),
  404                         file_errors(fail)
  405                       ]).
  406
  407
  408%!  prolog_load_context(+Key, -Value)
  409%
  410%   Provides context information for  term_expansion and directives.
  411%   Note  that  only  the  line-number  info    is   valid  for  the
  412%   '$stream_position'. Largely Quintus compatible.
  413
  414prolog_load_context(module, Module) :-
  415    '$current_source_module'(Module).
  416prolog_load_context(file, File) :-
  417    input_file(File).
  418prolog_load_context(source, F) :-       % SICStus compatibility
  419    input_file(F0),
  420    '$input_context'(Context),
  421    '$top_file'(Context, F0, F).
  422prolog_load_context(stream, S) :-
  423    (   system:'$load_input'(_, S0)
  424    ->  S = S0
  425    ).
  426prolog_load_context(directory, D) :-
  427    input_file(F),
  428    file_directory_name(F, D).
  429prolog_load_context(dialect, D) :-
  430    current_prolog_flag(emulated_dialect, D).
  431prolog_load_context(term_position, TermPos) :-
  432    source_location(_, L),
  433    (   nb_current('$term_position', Pos),
  434        compound(Pos),              % actually set
  435        stream_position_data(line_count, Pos, L)
  436    ->  TermPos = Pos
  437    ;   TermPos = '$stream_position'(0,L,0,0)
  438    ).
  439prolog_load_context(script, Bool) :-
  440    (   '$toplevel':loaded_init_file(script, Path),
  441        input_file(File),
  442        same_file(File, Path)
  443    ->  Bool = true
  444    ;   Bool = false
  445    ).
  446prolog_load_context(variable_names, Bindings) :-
  447    (   nb_current('$variable_names', Bindings0)
  448    ->  Bindings = Bindings0
  449    ;   Bindings = []
  450    ).
  451prolog_load_context(term, Term) :-
  452    nb_current('$term', Term).
  453prolog_load_context(reloading, true) :-
  454    prolog_load_context(source, F),
  455    '$source_file_property'(F, reloading, true).
  456
  457input_file(File) :-
  458    (   system:'$load_input'(_, Stream)
  459    ->  stream_property(Stream, file_name(File))
  460    ),
  461    !.
  462input_file(File) :-
  463    source_location(File, _).
  464
  465
  466%!  unload_file(+File) is det.
  467%
  468%   Remove all traces of loading file. If the  file is a module file and
  469%   used use_foreign_library/1,2 to load foreign   extensions, these are
  470%   removed first.
  471%
  472%   @tbd Should we introduce a counterpart  for initialization/1 that is
  473%   called when a file is unloaded?
  474
  475:- dynamic system:'$resolved_source_path'/2.  476
  477unload_file(File) :-
  478    (   canonical_source_file(File, Path)
  479    ->  unload_file_(Path),
  480        '$clear_source_admin'(Path),
  481        garbage_collect_clauses
  482    ;   true
  483    ).
  484
  485:- if(current_prolog_flag(open_shared_object, true)).  486unload_file_(Path) :-
  487    source_file_property(Path, module(M)),
  488    ensure_shlib,
  489    !,
  490    forall(shlib:foreign_library_property(Foreign, module(M)),
  491           shlib:unload_foreign_library(Foreign)),
  492    '$unload_file'(Path).
  493:- endif.  494unload_file_(Path) :-
  495    '$unload_file'(Path).
  496
  497:- if(current_prolog_flag(open_shared_object, true)).  498
  499		 /*******************************
  500		 *      FOREIGN LIBRARIES	*
  501		 *******************************/
  502
  503%!  use_foreign_library(+FileSpec) is det.
  504%!  use_foreign_library(+FileSpec, +Entry:atom) is det.
  505%
  506%   Load and install a foreign   library as load_foreign_library/1,2
  507%   and register the installation using   initialization/2  with the
  508%   option =now=. This is similar to using:
  509%
  510%     ==
  511%     :- initialization(load_foreign_library(foreign(mylib))).
  512%     ==
  513%
  514%   but using the initialization/1 wrapper causes  the library to be
  515%   loaded _after_ loading of  the  file   in  which  it  appears is
  516%   completed,  while  use_foreign_library/1  loads    the   library
  517%   _immediately_. I.e. the  difference  is   only  relevant  if the
  518%   remainder of the file uses functionality of the C-library.
  519
  520:- meta_predicate
  521    use_foreign_library(:),
  522    use_foreign_library(:, +).  523:- public
  524    use_foreign_library_noi/1.  525
  526use_foreign_library(FileSpec) :-
  527    ensure_shlib,
  528    initialization(use_foreign_library_noi(FileSpec), now).
  529
  530% noi -> no initialize; used by '$autoload':exports/3.
  531use_foreign_library_noi(FileSpec) :-
  532    ensure_shlib,
  533    shlib:load_foreign_library(FileSpec).
  534
  535use_foreign_library(FileSpec, Options) :-
  536    ensure_shlib,
  537    initialization(shlib:load_foreign_library(FileSpec, Options), now).
  538
  539ensure_shlib :-
  540    '$get_predicate_attribute'(shlib:load_foreign_library(_), defined, 1),
  541    '$get_predicate_attribute'(shlib:load_foreign_library(_,_), defined, 1),
  542    !.
  543ensure_shlib :-
  544    use_module(library(shlib), []).
  545
  546:- export(use_foreign_library/1).  547:- export(use_foreign_library/2).  548
  549:- elif(current_predicate('$activate_static_extension'/1)).  550
  551% Version when using shared objects is disabled and extensions are added
  552% as static libraries.
  553
  554:- meta_predicate
  555    use_foreign_library(:).  556:- public
  557    use_foreign_library_noi/1.  558:- dynamic
  559    loading/1,
  560    foreign_predicate/2.  561
  562use_foreign_library(FileSpec) :-
  563    initialization(use_foreign_library_noi(FileSpec), now).
  564
  565use_foreign_library_noi(Module:foreign(Extension)) :-
  566    setup_call_cleanup(
  567        asserta(loading(foreign(Extension)), Ref),
  568        @('$activate_static_extension'(Extension), Module),
  569        erase(Ref)).
  570
  571:- export(use_foreign_library/1).  572
  573system:'$foreign_registered'(M, H) :-
  574    (   loading(Lib)
  575    ->  true
  576    ;   Lib = '<spontaneous>'
  577    ),
  578    assert(foreign_predicate(Lib, M:H)).
  579
  580%!  current_foreign_library(?File, -Public)
  581%
  582%   Query currently loaded shared libraries.
  583
  584current_foreign_library(File, Public) :-
  585    setof(Pred, foreign_predicate(File, Pred), Public).
  586
  587:- export(current_foreign_library/2).  588
  589:- endif. /* open_shared_object support */
  590
  591                 /*******************************
  592                 *            STREAMS           *
  593                 *******************************/
  594
  595%!  stream_position_data(?Field, +Pos, ?Date)
  596%
  597%   Extract values from stream position objects. '$stream_position' is
  598%   of the format '$stream_position'(Byte, Char, Line, LinePos)
  599
  600stream_position_data(Prop, Term, Value) :-
  601    nonvar(Prop),
  602    !,
  603    (   stream_position_field(Prop, Pos)
  604    ->  arg(Pos, Term, Value)
  605    ;   throw(error(domain_error(stream_position_data, Prop)))
  606    ).
  607stream_position_data(Prop, Term, Value) :-
  608    stream_position_field(Prop, Pos),
  609    arg(Pos, Term, Value).
  610
  611stream_position_field(char_count,    1).
  612stream_position_field(line_count,    2).
  613stream_position_field(line_position, 3).
  614stream_position_field(byte_count,    4).
  615
  616
  617                 /*******************************
  618                 *            CONTROL           *
  619                 *******************************/
  620
  621%!  call_with_depth_limit(:Goal, +DepthLimit, -Result)
  622%
  623%   Try to proof Goal, but fail on any branch exceeding the indicated
  624%   depth-limit.  Unify Result with the maximum-reached limit on success,
  625%   depth_limit_exceeded if the limit was exceeded and fails otherwise.
  626
  627:- meta_predicate
  628    call_with_depth_limit(0, +, -).  629
  630call_with_depth_limit(G, Limit, Result) :-
  631    '$depth_limit'(Limit, OLimit, OReached),
  632    (   catch(G, E, '$depth_limit_except'(OLimit, OReached, E)),
  633        '$depth_limit_true'(Limit, OLimit, OReached, Result, Det),
  634        ( Det == ! -> ! ; true )
  635    ;   '$depth_limit_false'(OLimit, OReached, Result)
  636    ).
  637
  638%!  call_with_inference_limit(:Goal, +InferenceLimit, -Result)
  639%
  640%   Equivalent to call(Goal),  but  poses  a   limit  on  the  number of
  641%   inferences. If this  limit  is  reached,   Result  is  unified  with
  642%   `inference_limit_exceeded`, otherwise Result is unified  with `!` if
  643%   Goal succeeded without a choicepoint and `true` otherwise.
  644%
  645%   Note that we perform calls in  system to avoid auto-importing, which
  646%   makes raiseInferenceLimitException() fail  to   recognise  that  the
  647%   exception happens in the overhead.
  648
  649:- meta_predicate
  650    call_with_inference_limit(0, +, -).  651
  652call_with_inference_limit(G, Limit, Result) :-
  653    '$inference_limit'(Limit, OLimit),
  654    (   catch(G, Except,
  655              system:'$inference_limit_except'(OLimit, Except, Result0)),
  656        (   Result0 == inference_limit_exceeded
  657        ->  !
  658        ;   system:'$inference_limit_true'(Limit, OLimit, Result0),
  659            ( Result0 == ! -> ! ; true )
  660        ),
  661        Result = Result0
  662    ;   system:'$inference_limit_false'(OLimit)
  663    ).
  664
  665
  666                /********************************
  667                *           DATA BASE           *
  668                *********************************/
  669
  670/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
  671The predicate current_predicate/2 is   a  difficult subject since  the
  672introduction  of defaulting     modules   and   dynamic     libraries.
  673current_predicate/2 is normally  called with instantiated arguments to
  674verify some  predicate can   be called without trapping   an undefined
  675predicate.  In this case we must  perform the search algorithm used by
  676the prolog system itself.
  677
  678If the pattern is not fully specified, we only generate the predicates
  679actually available in this  module.   This seems the best for listing,
  680etc.
  681- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
  682
  683
  684:- meta_predicate
  685    current_predicate(?, :),
  686    '$defined_predicate'(:).  687
  688current_predicate(Name, Module:Head) :-
  689    (var(Module) ; var(Head)),
  690    !,
  691    generate_current_predicate(Name, Module, Head).
  692current_predicate(Name, Term) :-
  693    '$c_current_predicate'(Name, Term),
  694    '$defined_predicate'(Term),
  695    !.
  696current_predicate(Name, Module:Head) :-
  697    default_module(Module, DefModule),
  698    '$c_current_predicate'(Name, DefModule:Head),
  699    '$defined_predicate'(DefModule:Head),
  700    !.
  701current_predicate(Name, Module:Head) :-
  702    '$autoload':autoload_in(Module, general),
  703    \+ current_prolog_flag(Module:unknown, fail),
  704    (   compound(Head)
  705    ->  compound_name_arity(Head, Name, Arity)
  706    ;   Name = Head, Arity = 0
  707    ),
  708    '$find_library'(Module, Name, Arity, _LoadModule, _Library),
  709    !.
  710
  711generate_current_predicate(Name, Module, Head) :-
  712    current_module(Module),
  713    QHead = Module:Head,
  714    '$c_current_predicate'(Name, QHead),
  715    '$get_predicate_attribute'(QHead, defined, 1).
  716
  717'$defined_predicate'(Head) :-
  718    '$get_predicate_attribute'(Head, defined, 1),
  719    !.
  720
  721%!  predicate_property(?Predicate, ?Property) is nondet.
  722%
  723%   True when Property is a property of Predicate.
  724
  725:- meta_predicate
  726    predicate_property(:, ?).  727
  728:- multifile
  729    '$predicate_property'/2.  730
  731:- '$iso'(predicate_property/2).  732
  733predicate_property(Pred, Property) :-           % Mode ?,+
  734    nonvar(Property),
  735    !,
  736    property_predicate(Property, Pred).
  737predicate_property(Pred, Property) :-           % Mode +,-
  738    define_or_generate(Pred),
  739    '$predicate_property'(Property, Pred).
  740
  741%!  property_predicate(+Property, ?Pred)
  742%
  743%   First handle the special  cases  that   are  not  about querying
  744%   normally  defined  predicates:   =undefined=,    =visible=   and
  745%   =autoload=, followed by the generic case.
  746
  747property_predicate(undefined, Pred) :-
  748    !,
  749    Pred = Module:Head,
  750    current_module(Module),
  751    '$c_current_predicate'(_, Pred),
  752    \+ '$defined_predicate'(Pred),          % Speed up a bit
  753    \+ current_predicate(_, Pred),
  754    goal_name_arity(Head, Name, Arity),
  755    \+ system_undefined(Module:Name/Arity).
  756property_predicate(visible, Pred) :-
  757    !,
  758    visible_predicate(Pred).
  759property_predicate(autoload(File), Head) :-
  760    !,
  761    \+ current_prolog_flag(autoload, false),
  762    '$autoload':autoloadable(Head, File).
  763property_predicate(implementation_module(IM), M:Head) :-
  764    !,
  765    atom(M),
  766    (   default_module(M, DM),
  767        '$get_predicate_attribute'(DM:Head, defined, 1)
  768    ->  (   '$get_predicate_attribute'(DM:Head, imported, ImportM)
  769        ->  IM = ImportM
  770        ;   IM = M
  771        )
  772    ;   \+ current_prolog_flag(M:unknown, fail),
  773        goal_name_arity(Head, Name, Arity),
  774        '$find_library'(_, Name, Arity, LoadModule, _File)
  775    ->  IM = LoadModule
  776    ;   M = IM
  777    ).
  778property_predicate(iso, _:Head) :-
  779    callable(Head),
  780    !,
  781    goal_name_arity(Head, Name, Arity),
  782    current_predicate(system:Name/Arity),
  783    '$predicate_property'(iso, system:Head).
  784property_predicate(built_in, Module:Head) :-
  785    callable(Head),
  786    !,
  787    goal_name_arity(Head, Name, Arity),
  788    current_predicate(Module:Name/Arity),
  789    '$predicate_property'(built_in, Module:Head).
  790property_predicate(Property, Pred) :-
  791    define_or_generate(Pred),
  792    '$predicate_property'(Property, Pred).
  793
  794goal_name_arity(Head, Name, Arity) :-
  795    compound(Head),
  796    !,
  797    compound_name_arity(Head, Name, Arity).
  798goal_name_arity(Head, Head, 0).
  799
  800
  801%!  define_or_generate(+Head) is semidet.
  802%!  define_or_generate(-Head) is nondet.
  803%
  804%   If the predicate is known, try to resolve it. Otherwise generate
  805%   the known predicate, but do not try to (auto)load the predicate.
  806
  807define_or_generate(M:Head) :-
  808    callable(Head),
  809    atom(M),
  810    '$get_predicate_attribute'(M:Head, defined, 1),
  811    !.
  812define_or_generate(M:Head) :-
  813    callable(Head),
  814    nonvar(M), M \== system,
  815    !,
  816    '$define_predicate'(M:Head).
  817define_or_generate(Pred) :-
  818    current_predicate(_, Pred),
  819    '$define_predicate'(Pred).
  820
  821
  822'$predicate_property'(interpreted, Pred) :-
  823    '$get_predicate_attribute'(Pred, foreign, 0).
  824'$predicate_property'(visible, Pred) :-
  825    '$get_predicate_attribute'(Pred, defined, 1).
  826'$predicate_property'(built_in, Pred) :-
  827    '$get_predicate_attribute'(Pred, system, 1).
  828'$predicate_property'(exported, Pred) :-
  829    '$get_predicate_attribute'(Pred, exported, 1).
  830'$predicate_property'(public, Pred) :-
  831    '$get_predicate_attribute'(Pred, public, 1).
  832'$predicate_property'(non_terminal, Pred) :-
  833    '$get_predicate_attribute'(Pred, non_terminal, 1).
  834'$predicate_property'(foreign, Pred) :-
  835    '$get_predicate_attribute'(Pred, foreign, 1).
  836'$predicate_property'((dynamic), Pred) :-
  837    '$get_predicate_attribute'(Pred, (dynamic), 1).
  838'$predicate_property'((static), Pred) :-
  839    '$get_predicate_attribute'(Pred, (dynamic), 0).
  840'$predicate_property'((volatile), Pred) :-
  841    '$get_predicate_attribute'(Pred, (volatile), 1).
  842'$predicate_property'((thread_local), Pred) :-
  843    '$get_predicate_attribute'(Pred, (thread_local), 1).
  844'$predicate_property'((multifile), Pred) :-
  845    '$get_predicate_attribute'(Pred, (multifile), 1).
  846'$predicate_property'((discontiguous), Pred) :-
  847    '$get_predicate_attribute'(Pred, (discontiguous), 1).
  848'$predicate_property'(imported_from(Module), Pred) :-
  849    '$get_predicate_attribute'(Pred, imported, Module).
  850'$predicate_property'(transparent, Pred) :-
  851    '$get_predicate_attribute'(Pred, transparent, 1).
  852'$predicate_property'(meta_predicate(Pattern), Pred) :-
  853    '$get_predicate_attribute'(Pred, transparent, 1),
  854    '$get_predicate_attribute'(Pred, meta_predicate, Pattern).
  855'$predicate_property'(mode(Pattern), Pred) :-
  856    '$get_predicate_attribute'(Pred, transparent, 0),
  857    '$get_predicate_attribute'(Pred, meta_predicate, Pattern).
  858'$predicate_property'(file(File), Pred) :-
  859    '$get_predicate_attribute'(Pred, file, File).
  860'$predicate_property'(line_count(LineNumber), Pred) :-
  861    '$get_predicate_attribute'(Pred, line_count, LineNumber).
  862'$predicate_property'(notrace, Pred) :-
  863    '$get_predicate_attribute'(Pred, trace, 0).
  864'$predicate_property'(nodebug, Pred) :-
  865    '$get_predicate_attribute'(Pred, hide_childs, 1).
  866'$predicate_property'(spying, Pred) :-
  867    '$get_predicate_attribute'(Pred, spy, 1).
  868'$predicate_property'(number_of_clauses(N), Pred) :-
  869    '$get_predicate_attribute'(Pred, number_of_clauses, N).
  870'$predicate_property'(number_of_rules(N), Pred) :-
  871    '$get_predicate_attribute'(Pred, number_of_rules, N).
  872'$predicate_property'(last_modified_generation(Gen), Pred) :-
  873    '$get_predicate_attribute'(Pred, last_modified_generation, Gen).
  874'$predicate_property'(indexed(Indices), Pred) :-
  875    '$get_predicate_attribute'(Pred, indexed, Indices).
  876'$predicate_property'(noprofile, Pred) :-
  877    '$get_predicate_attribute'(Pred, noprofile, 1).
  878'$predicate_property'(ssu, Pred) :-
  879    '$get_predicate_attribute'(Pred, ssu, 1).
  880'$predicate_property'(iso, Pred) :-
  881    '$get_predicate_attribute'(Pred, iso, 1).
  882'$predicate_property'(det, Pred) :-
  883    '$get_predicate_attribute'(Pred, det, 1).
  884'$predicate_property'(sig_atomic, Pred) :-
  885    '$get_predicate_attribute'(Pred, sig_atomic, 1).
  886'$predicate_property'(quasi_quotation_syntax, Pred) :-
  887    '$get_predicate_attribute'(Pred, quasi_quotation_syntax, 1).
  888'$predicate_property'(defined, Pred) :-
  889    '$get_predicate_attribute'(Pred, defined, 1).
  890'$predicate_property'(tabled, Pred) :-
  891    '$get_predicate_attribute'(Pred, tabled, 1).
  892'$predicate_property'(tabled(Flag), Pred) :-
  893    '$get_predicate_attribute'(Pred, tabled, 1),
  894    table_flag(Flag, Pred).
  895'$predicate_property'(incremental, Pred) :-
  896    '$get_predicate_attribute'(Pred, incremental, 1).
  897'$predicate_property'(monotonic, Pred) :-
  898    '$get_predicate_attribute'(Pred, monotonic, 1).
  899'$predicate_property'(opaque, Pred) :-
  900    '$get_predicate_attribute'(Pred, opaque, 1).
  901'$predicate_property'(lazy, Pred) :-
  902    '$get_predicate_attribute'(Pred, lazy, 1).
  903'$predicate_property'(abstract(N), Pred) :-
  904    '$get_predicate_attribute'(Pred, abstract, N).
  905'$predicate_property'(size(Bytes), Pred) :-
  906    '$get_predicate_attribute'(Pred, size, Bytes).
  907'$predicate_property'(primary_index(Arg), Pred) :-
  908    '$get_predicate_attribute'(Pred, primary_index, Arg).
  909
  910system_undefined(user:prolog_trace_interception/4).
  911system_undefined(prolog:prolog_exception_hook/5).
  912system_undefined(system:'$c_call_prolog'/0).
  913system_undefined(system:window_title/2).
  914
  915table_flag(variant, Pred) :-
  916    '$tbl_implementation'(Pred, M:Head),
  917    M:'$tabled'(Head, variant).
  918table_flag(subsumptive, Pred) :-
  919    '$tbl_implementation'(Pred, M:Head),
  920    M:'$tabled'(Head, subsumptive).
  921table_flag(shared, Pred) :-
  922    '$get_predicate_attribute'(Pred, tshared, 1).
  923table_flag(incremental, Pred) :-
  924    '$get_predicate_attribute'(Pred, incremental, 1).
  925table_flag(monotonic, Pred) :-
  926    '$get_predicate_attribute'(Pred, monotonic, 1).
  927table_flag(subgoal_abstract(N), Pred) :-
  928    '$get_predicate_attribute'(Pred, subgoal_abstract, N).
  929table_flag(answer_abstract(N), Pred) :-
  930    '$get_predicate_attribute'(Pred, subgoal_abstract, N).
  931table_flag(subgoal_abstract(N), Pred) :-
  932    '$get_predicate_attribute'(Pred, max_answers, N).
  933
  934
  935%!  visible_predicate(:Head) is nondet.
  936%
  937%   True when Head can be called without raising an existence error.
  938%   This implies it is defined,  can   be  inherited  from a default
  939%   module or can be autoloaded.
  940
  941visible_predicate(Pred) :-
  942    Pred = M:Head,
  943    current_module(M),
  944    (   callable(Head)
  945    ->  (   '$get_predicate_attribute'(Pred, defined, 1)
  946        ->  true
  947        ;   \+ current_prolog_flag(M:unknown, fail),
  948            '$head_name_arity'(Head, Name, Arity),
  949            '$find_library'(M, Name, Arity, _LoadModule, _Library)
  950        )
  951    ;   setof(PI, visible_in_module(M, PI), PIs),
  952        '$member'(Name/Arity, PIs),
  953        functor(Head, Name, Arity)
  954    ).
  955
  956visible_in_module(M, Name/Arity) :-
  957    default_module(M, DefM),
  958    DefHead = DefM:Head,
  959    '$c_current_predicate'(_, DefHead),
  960    '$get_predicate_attribute'(DefHead, defined, 1),
  961    \+ hidden_system_predicate(Head),
  962    functor(Head, Name, Arity).
  963visible_in_module(_, Name/Arity) :-
  964    '$in_library'(Name, Arity, _).
  965
  966hidden_system_predicate(Head) :-
  967    functor(Head, Name, _),
  968    atom(Name),                     % Avoid [].
  969    sub_atom(Name, 0, _, _, $),
  970    \+ current_prolog_flag(access_level, system).
  971
  972
  973                /********************************
  974                *      SOURCE LOCATION          *
  975                *********************************/
  976
  977%!  '$predicate_source_location'(:Head, -Location) is semidet.
  978%
  979%   Location is File:Line, the place  where   the  predicate Head is
  980%   defined.  Head is resolved to  its   _primary_  definition, i.e.,
  981%   imported predicates are traced back to  the module that defines
  982%   them.  For predicates defined in C, the location of the C function
  983%   that implements it is used.  See '$foreign_predicate_source'/2.
  984%
  985%   This predicate provides the source location   for  both the message
  986%   system (see predicate_reference//2 in `boot/messages.pl`) and
  987%   library(edit).
  988
  989:- meta_predicate
  990    '$predicate_source_location'(:, -).  991
  992'$predicate_source_location'(Head, File:Line) :-
  993    '$primary_predicate'(Head, Primary),
  994    (   predicate_property(Primary, file(File)),
  995        predicate_property(Primary, line_count(Line))
  996    ->  true
  997    ;   predicate_property(Primary, foreign),
  998        '$foreign_source_location'(Primary, File, Line)
  999    ).
 1000
 1001%!  '$primary_predicate'(:Head, -Primary) is det.
 1002%
 1003%   Primary is the module qualified Head in the module that _defines_
 1004%   the predicate rather than one that imports it.
 1005
 1006'$primary_predicate'(Pred, Primary) :-
 1007    (   predicate_property(Pred, imported_from(Module))
 1008    ->  strip_module(Pred, _, Head),
 1009        Primary = Module:Head
 1010    ;   Primary = Pred
 1011    ).
 1012
 1013%!  '$foreign_source_location'(:Head, -File, -Line) is semidet.
 1014%
 1015%   Source location of a foreign  (C  defined)   predicate.  As  this is
 1016%   resolved by running `addr2line` or `atos`  in a child process we can
 1017%   only afford to do this once per predicate.
 1018
 1019:- dynamic
 1020    '$foreign_source_cache'/2.              % PI, File:Line or `none`
 1021
 1022'$foreign_source_location'(Head, File, Line) :-
 1023    '$pi_head'(PI, Head),
 1024    (   '$foreign_source_cache'(PI, Cached)
 1025    ->  true
 1026    ;   (   '$foreign_predicate_source'(Head, Source),
 1027            '$addr2line_location'(Source, File0, Line0)
 1028        ->  Cached = File0:Line0
 1029        ;   Cached = none
 1030        ),
 1031        assertz('$foreign_source_cache'(PI, Cached))
 1032    ),
 1033    Cached = File:Line.
 1034
 1035%!  '$addr2line_location'(+Description, -File, -Line) is semidet.
 1036%
 1037%   Parse the ``Function() at File:Line``  description as produced by
 1038%   '$foreign_predicate_source'/2 and '$addr2line'/2.  Fails if the
 1039%   description does not carry a source location, which happens if the
 1040%   symbol lives in the main executable  or   the  file  has no debug
 1041%   information.
 1042
 1043'$addr2line_location'(Description, File, Line) :-
 1044    sub_string(Description, Before, _, After, " at "),
 1045    !,
 1046    Start is Before+4,
 1047    sub_string(Description, Start, After, 0, Rest),
 1048    '$split_file_line'(Rest, File, Line).
 1049
 1050'$split_file_line'(Rest, File, Line) :-
 1051    sub_string(Rest, BC, _, AC, ":"),
 1052    Start is BC+1,
 1053    sub_string(Rest, Start, AC, 0, Tail),
 1054    (   sub_string(Tail, BS, _, _, " ")      % e.g. " (discriminator 1)"
 1055    ->  sub_string(Tail, 0, BS, _, LineText)
 1056    ;   LineText = Tail
 1057    ),
 1058    number_string(Line, LineText),
 1059    integer(Line),
 1060    Line >= 1,                               % `addr2line` says 0 if unknown
 1061    !,
 1062    sub_string(Rest, 0, BC, _, FileText),
 1063    FileText \== "??",                       % and `??` for the file
 1064    atom_string(File, FileText).
 1065
 1066
 1067%!  clause_property(+ClauseRef, ?Property) is nondet.
 1068%
 1069%   Provide information on individual clauses.  Defined properties
 1070%   are:
 1071%
 1072%       * line_count(-Line)
 1073%       Line from which the clause is loaded.
 1074%       * file(-File)
 1075%       File from which the clause is loaded.
 1076%       * source(-File)
 1077%       File that `owns' the clause: reloading this file wipes
 1078%       the clause.
 1079%       * fact
 1080%       Clause has body =true=.
 1081%       * erased
 1082%       Clause was erased.
 1083%       * predicate(:PI)
 1084%       Predicate indicator of the predicate this clause belongs
 1085%       to.  Can be used to find the predicate of erased clauses.
 1086%       * module(-M)
 1087%       Module context in which the clause was compiled.
 1088
 1089clause_property(Clause, Property) :-
 1090    '$clause_property'(Property, Clause).
 1091
 1092'$clause_property'(line_count(LineNumber), Clause) :-
 1093    '$get_clause_attribute'(Clause, line_count, LineNumber).
 1094'$clause_property'(file(File), Clause) :-
 1095    '$get_clause_attribute'(Clause, file, File).
 1096'$clause_property'(source(File), Clause) :-
 1097    '$get_clause_attribute'(Clause, owner, File).
 1098'$clause_property'(size(Bytes), Clause) :-
 1099    '$get_clause_attribute'(Clause, size, Bytes).
 1100'$clause_property'(fact, Clause) :-
 1101    '$get_clause_attribute'(Clause, fact, true).
 1102'$clause_property'(erased, Clause) :-
 1103    '$get_clause_attribute'(Clause, erased, true).
 1104'$clause_property'(predicate(PI), Clause) :-
 1105    '$get_clause_attribute'(Clause, predicate_indicator, PI).
 1106'$clause_property'(module(M), Clause) :-
 1107    '$get_clause_attribute'(Clause, module, M).
 1108
 1109%!  dynamic(:Predicates, +Options) is det.
 1110%
 1111%   Define a predicate as dynamic with optionally additional properties.
 1112%   Defined options are:
 1113%
 1114%     - incremental(+Bool)
 1115%     - abstract(+Level)
 1116%     - multifile(+Bool)
 1117%     - discontiguous(+Bool)
 1118%     - thread(+Mode)
 1119%     - volatile(+Bool)
 1120
 1121dynamic(M:Predicates, Options) :-
 1122    '$must_be'(list, Predicates),
 1123    options_properties(Options, Props),
 1124    set_pprops(Predicates, M, [dynamic|Props]).
 1125
 1126set_pprops([], _, _).
 1127set_pprops([H|T], M, Props) :-
 1128    set_pprops1(Props, M:H),
 1129    strip_module(M:H, M2, P),
 1130    '$pi_head'(M2:P, Pred),
 1131    '$set_table_wrappers'(Pred),
 1132    set_pprops(T, M, Props).
 1133
 1134set_pprops1([], _).
 1135set_pprops1([H|T], P) :-
 1136    (   atom(H)
 1137    ->  '$set_predicate_attribute'(P, H, true)
 1138    ;   H =.. [Name,Value]
 1139    ->  '$set_predicate_attribute'(P, Name, Value)
 1140    ),
 1141    set_pprops1(T, P).
 1142
 1143options_properties(Options, Props) :-
 1144    G = opt_prop(_,_,_,_),
 1145    findall(G, G, Spec),
 1146    options_properties(Spec, Options, Props).
 1147
 1148options_properties([], _, []).
 1149options_properties([opt_prop(Name, Type, SetValue, Prop)|T],
 1150                   Options, [Prop|PT]) :-
 1151    Opt =.. [Name,V],
 1152    '$option'(Opt, Options),
 1153    '$must_be'(Type, V),
 1154    V = SetValue,
 1155    !,
 1156    options_properties(T, Options, PT).
 1157options_properties([_|T], Options, PT) :-
 1158    options_properties(T, Options, PT).
 1159
 1160opt_prop(incremental,   boolean,               Bool,  incremental(Bool)).
 1161opt_prop(abstract,      between(0,0),          0,     abstract).
 1162opt_prop(multifile,     boolean,               true,  multifile).
 1163opt_prop(discontiguous, boolean,               true,  discontiguous).
 1164opt_prop(volatile,      boolean,               true,  volatile).
 1165opt_prop(thread,        oneof(atom, [local,shared],[local,shared]),
 1166                                               local, thread_local).
 1167
 1168                /********************************
 1169                *            MODULES            *
 1170                *********************************/
 1171
 1172%!  current_module(?Module) is nondet.
 1173%
 1174%   True if Module is a currently defined module.
 1175
 1176current_module(Module) :-
 1177    '$current_module'(Module, _).
 1178
 1179%!  module_property(?Module, ?Property) is nondet.
 1180%
 1181%   True if Property is a property of Module.  Defined properties
 1182%   are:
 1183%
 1184%       * file(File)
 1185%       Module is loaded from File.
 1186%       * line_count(Count)
 1187%       The module declaration is on line Count of File.
 1188%       * exports(ListOfPredicateIndicators)
 1189%       The module exports ListOfPredicateIndicators
 1190%       * exported_operators(ListOfOp3)
 1191%       The module exports the operators ListOfOp3.
 1192
 1193module_property(Module, Property) :-
 1194    nonvar(Module), nonvar(Property),
 1195    !,
 1196    property_module(Property, Module).
 1197module_property(Module, Property) :-    % -, file(File)
 1198    nonvar(Property), Property = file(File),
 1199    !,
 1200    (   nonvar(File)
 1201    ->  '$current_module'(Modules, File),
 1202        (   atom(Modules)
 1203        ->  Module = Modules
 1204        ;   '$member'(Module, Modules)
 1205        )
 1206    ;   '$current_module'(Module, File),
 1207        File \== []
 1208    ).
 1209module_property(Module, Property) :-
 1210    current_module(Module),
 1211    property_module(Property, Module).
 1212
 1213property_module(Property, Module) :-
 1214    module_property(Property),
 1215    (   Property = exported_operators(List)
 1216    ->  '$exported_ops'(Module, List, [])
 1217    ;   '$module_property'(Module, Property)
 1218    ).
 1219
 1220module_property(class(_)).
 1221module_property(file(_)).
 1222module_property(line_count(_)).
 1223module_property(exports(_)).
 1224module_property(exported_operators(_)).
 1225module_property(size(_)).
 1226module_property(program_size(_)).
 1227module_property(program_space(_)).
 1228module_property(last_modified_generation(_)).
 1229
 1230%!  module(+Module) is det.
 1231%
 1232%   Set the module that is associated to the toplevel to Module.
 1233
 1234module(Module) :-
 1235    atom(Module),
 1236    current_module(Module),
 1237    !,
 1238    '$set_typein_module'(Module).
 1239module(Module) :-
 1240    '$set_typein_module'(Module),
 1241    print_message(warning, no_current_module(Module)).
 1242
 1243%!  working_directory(-Old, +New)
 1244%
 1245%   True when Old is the current working directory and the working
 1246%   directory has been updated to New.
 1247
 1248working_directory(Old, New) :-
 1249    '$cwd'(Old),
 1250    (   Old == New
 1251    ->  true
 1252    ;   '$chdir'(New)
 1253    ).
 1254
 1255
 1256                 /*******************************
 1257                 *            TRIES             *
 1258                 *******************************/
 1259
 1260%!  current_trie(?Trie) is nondet.
 1261%
 1262%   True if Trie is the handle of an existing trie.
 1263
 1264current_trie(Trie) :-
 1265    current_blob(Trie, trie),
 1266    is_trie(Trie).
 1267
 1268%!  trie_property(?Trie, ?Property)
 1269%
 1270%   True when Property is a property of Trie. Defined properties
 1271%   are:
 1272%
 1273%     - value_count(Count)
 1274%       Number of terms in the trie.
 1275%     - node_count(Count)
 1276%       Number of nodes in the trie.
 1277%     - size(Bytes)
 1278%       Number of bytes needed to store the trie.
 1279%     - hashed(Count)
 1280%       Number of hashed nodes.
 1281%     - compiled_size(Bytes)
 1282%       Size of the compiled representation (if the trie is compiled)
 1283%     - lookup_count(Count)
 1284%       Number of data lookups on the trie
 1285%     - gen_call_count(Count)
 1286%       Number of trie_gen/2 calls on this trie
 1287%
 1288%   Incremental tabling statistics:
 1289%
 1290%     - invalidated(Count)
 1291%       Number of times the trie was inivalidated
 1292%     - reevaluated(Count)
 1293%       Number of times the trie was re-evaluated
 1294%
 1295%   Shared tabling statistics:
 1296%
 1297%     - deadlock(Count)
 1298%       Number of times the table was involved in a deadlock
 1299%     - wait(Count)
 1300%       Number of times a thread had to wait for this table
 1301
 1302trie_property(Trie, Property) :-
 1303    current_trie(Trie),
 1304    trie_property(Property),
 1305    '$trie_property'(Trie, Property).
 1306
 1307trie_property(node_count(_)).
 1308trie_property(value_count(_)).
 1309trie_property(size(_)).
 1310trie_property(hashed(_)).
 1311trie_property(compiled_size(_)).
 1312                                                % below only when -DO_TRIE_STATS
 1313trie_property(lookup_count(_)).                 % is enabled in pl-trie.h
 1314trie_property(gen_call_count(_)).
 1315trie_property(invalidated(_)).                  % IDG stats
 1316trie_property(reevaluated(_)).
 1317trie_property(deadlock(_)).                     % Shared tabling stats
 1318trie_property(wait(_)).
 1319trie_property(idg_affected_count(_)).
 1320trie_property(idg_dependent_count(_)).
 1321trie_property(idg_size(_)).
 1322
 1323
 1324                /********************************
 1325                *      SYSTEM INTERACTION       *
 1326                *********************************/
 1327
 1328shell(Command) :-
 1329    shell(Command, 0).
 1330
 1331
 1332                 /*******************************
 1333                 *            SIGNALS           *
 1334                 *******************************/
 1335
 1336:- meta_predicate
 1337    on_signal(+, :, :),
 1338    current_signal(?, ?, :). 1339
 1340%!  on_signal(+Signal, -OldHandler, :NewHandler) is det.
 1341
 1342on_signal(Signal, Old, New) :-
 1343    atom(Signal),
 1344    !,
 1345    '$on_signal'(_Num, Signal, Old, New).
 1346on_signal(Signal, Old, New) :-
 1347    integer(Signal),
 1348    !,
 1349    '$on_signal'(Signal, _Name, Old, New).
 1350on_signal(Signal, _Old, _New) :-
 1351    '$type_error'(signal_name, Signal).
 1352
 1353%!  current_signal(?Name, ?SignalNumber, :Handler) is nondet.
 1354
 1355current_signal(Name, Id, Handler) :-
 1356    between(1, 32, Id),
 1357    '$on_signal'(Id, Name, Handler, Handler).
 1358
 1359:- multifile
 1360    prolog:called_by/2. 1361
 1362prolog:called_by(on_signal(_,_,New), [New+1]) :-
 1363    (   new == throw
 1364    ;   new == default
 1365    ), !, fail.
 1366
 1367
 1368                 /*******************************
 1369                 *             I/O              *
 1370                 *******************************/
 1371
 1372format(Fmt) :-
 1373    format(Fmt, []).
 1374
 1375                 /*******************************
 1376                 *            FILES             *
 1377                 *******************************/
 1378
 1379%!  absolute_file_name(+Term, -AbsoluteFile)
 1380
 1381absolute_file_name(Name, Abs) :-
 1382    atomic(Name),
 1383    !,
 1384    '$absolute_file_name'(Name, Abs).
 1385absolute_file_name(Term, Abs) :-
 1386    '$chk_file'(Term, [''], [access(read)], true, File),
 1387    !,
 1388    '$absolute_file_name'(File, Abs).
 1389absolute_file_name(Term, Abs) :-
 1390    '$chk_file'(Term, [''], [], true, File),
 1391    !,
 1392    '$absolute_file_name'(File, Abs).
 1393
 1394%!  tmp_file_stream(-File, -Stream, +Options) is det.
 1395%!  tmp_file_stream(+Encoding, -File, -Stream) is det.
 1396%
 1397%   Create a temporary file and open it   atomically. The second mode is
 1398%   for compatibility reasons.
 1399
 1400tmp_file_stream(Enc, File, Stream) :-
 1401    atom(Enc), var(File), var(Stream),
 1402    !,
 1403    '$tmp_file_stream'('', Enc, File, Stream).
 1404tmp_file_stream(File, Stream, Options) :-
 1405    current_prolog_flag(encoding, DefEnc),
 1406    '$option'(encoding(Enc), Options, DefEnc),
 1407    '$option'(extension(Ext), Options, ''),
 1408    '$tmp_file_stream'(Ext, Enc, File, Stream),
 1409    set_stream(Stream, file_name(File)).
 1410
 1411
 1412                /********************************
 1413                *        MEMORY MANAGEMENT      *
 1414                *********************************/
 1415
 1416%!  garbage_collect is det.
 1417%
 1418%   Invoke the garbage collector.  The   argument  of the underlying
 1419%   '$garbage_collect'/1  is  the  debugging  level  to  use  during
 1420%   garbage collection. This only works if   the  system is compiled
 1421%   with the -DODEBUG cpp flag. Only to simplify maintenance.
 1422
 1423garbage_collect :-
 1424    '$garbage_collect'(0).
 1425
 1426%!  set_prolog_stack(+Name, +Option) is det.
 1427%
 1428%   Set a parameter for one of the Prolog stacks.
 1429
 1430set_prolog_stack(Stack, Option) :-
 1431    Option =.. [Name,Value0],
 1432    Value is Value0,
 1433    '$set_prolog_stack'(Stack, Name, _Old, Value).
 1434
 1435%!  prolog_stack_property(?Stack, ?Property) is nondet.
 1436%
 1437%   Examine stack properties.
 1438
 1439prolog_stack_property(Stack, Property) :-
 1440    stack_property(P),
 1441    stack_name(Stack),
 1442    Property =.. [P,Value],
 1443    '$set_prolog_stack'(Stack, P, Value, Value).
 1444
 1445stack_name(local).
 1446stack_name(global).
 1447stack_name(trail).
 1448
 1449stack_property(limit).
 1450stack_property(spare).
 1451stack_property(min_free).
 1452stack_property(low).
 1453stack_property(factor).
 1454
 1455
 1456		 /*******************************
 1457		 *            CLAUSE		*
 1458		 *******************************/
 1459
 1460%!  rule(:Head, -Rule) is nondet.
 1461%!  rule(:Head, -Rule, Ref) is nondet.
 1462%
 1463%   Similar to clause/2,3. but deals with clauses   that do not use `:-`
 1464%   as _neck_.
 1465
 1466rule(Head, Rule) :-
 1467    '$rule'(Head, Rule0),
 1468    conditional_rule(Rule0, Rule1),
 1469    Rule = Rule1.
 1470rule(Head, Rule, Ref) :-
 1471    '$rule'(Head, Rule0, Ref),
 1472    conditional_rule(Rule0, Rule1),
 1473    Rule = Rule1.
 1474
 1475conditional_rule(?=>(Head, (!, Body)), Rule) =>
 1476    Rule = (Head => Body).
 1477conditional_rule(?=>(Head, !), Rule) =>
 1478    Rule = (Head => true).
 1479conditional_rule(?=>(Head, Body0), Rule),
 1480    split_on_cut(Body0, Cond, Body) =>
 1481    Rule = (Head,Cond=>Body).
 1482conditional_rule(Head, Rule) =>
 1483    Rule = Head.
 1484
 1485split_on_cut((Cond0,!,Body0), Cond, Body) =>
 1486    Cond = Cond0,
 1487    Body = Body0.
 1488split_on_cut((!,Body0), Cond, Body) =>
 1489    Cond = true,
 1490    Body = Body0.
 1491split_on_cut((A,B), Cond, Body) =>
 1492    Cond = (A,Cond1),
 1493    split_on_cut(B, Cond1, Body).
 1494split_on_cut(_, _, _) =>
 1495    fail.
 1496
 1497
 1498                 /*******************************
 1499                 *             TERM             *
 1500                 *******************************/
 1501
 1502:- '$iso'((numbervars/3)). 1503
 1504%!  numbervars(+Term, +StartIndex, -EndIndex) is det.
 1505%
 1506%   Number all unbound variables in Term   using  '$VAR'(N), where the
 1507%   first N is StartIndex and EndIndex is  unified to the index that
 1508%   will be given to the next variable.
 1509
 1510numbervars(Term, From, To) :-
 1511    numbervars(Term, From, To, []).
 1512
 1513
 1514                 /*******************************
 1515                 *            STRING            *
 1516                 *******************************/
 1517
 1518%!  term_string(?Term, ?String, +Options)
 1519%
 1520%   Parse/write a term from/to a string using Options.
 1521
 1522term_string(Term, String, Options) :-
 1523    nonvar(String),
 1524    !,
 1525    read_term_from_atom(String, Term, Options).
 1526term_string(Term, String, Options) :-
 1527    (   '$option'(quoted(_), Options)
 1528    ->  Options1 = Options
 1529    ;   '$merge_options'(_{quoted:true}, Options, Options1)
 1530    ),
 1531    format(string(String), '~W', [Term, Options1]).
 1532
 1533
 1534		 /*******************************
 1535		 *            THREADS		*
 1536		 *******************************/
 1537
 1538:- meta_predicate
 1539    thread_create(0, -). 1540
 1541%!  thread_create(:Goal, -Id)
 1542%
 1543%   Shorthand for thread_create(Goal, Id, []).
 1544
 1545thread_create(Goal, Id) :-
 1546    thread_create(Goal, Id, []).
 1547
 1548%!  thread_join(+Id)
 1549%
 1550%   Join a thread and raise an error of the thread did not succeed.
 1551%
 1552%   @error  thread_error(Status),  where  Status  is    the   result  of
 1553%   thread_join/2.
 1554
 1555thread_join(Id) :-
 1556    thread_join(Id, Status),
 1557    (   Status == true
 1558    ->  true
 1559    ;   throw(error(thread_error(Id, Status), _))
 1560    ).
 1561
 1562%!  sig_block(:Pattern) is det.
 1563%
 1564%   Block thread signals that unify with Pattern.
 1565
 1566%!  sig_unblock(:Pattern) is det.
 1567%
 1568%   Remove any signal block that is more specific than Pattern.
 1569
 1570sig_block(Pattern) :-
 1571    (   nb_current('$sig_blocked', List)
 1572    ->  true
 1573    ;   List = []
 1574    ),
 1575    nb_setval('$sig_blocked', [Pattern|List]).
 1576
 1577sig_unblock(Pattern) :-
 1578    (   nb_current('$sig_blocked', List)
 1579    ->  unblock(List, Pattern, NewList),
 1580        (   List == NewList
 1581        ->  true
 1582        ;   nb_setval('$sig_blocked', NewList),
 1583            '$sig_unblock'
 1584        )
 1585    ;   true
 1586    ).
 1587
 1588unblock([], _, []).
 1589unblock([H|T], P, List) :-
 1590    (   subsumes_term(P, H)
 1591    ->  unblock(T, P, List)
 1592    ;   List = [H|T1],
 1593        unblock(T, P, T1)
 1594    ).
 1595
 1596:- public signal_is_blocked/1.          % called by signal_is_blocked()
 1597
 1598signal_is_blocked(Head) :-
 1599    nb_current('$sig_blocked', List),
 1600    memberchk(Head, List).
 1601
 1602%!  set_prolog_gc_thread(+Status)
 1603%
 1604%   Control the GC thread.  Status is one of
 1605%
 1606%     - false
 1607%     Disable the separate GC thread, running atom and clause
 1608%     garbage collection in the triggering thread.
 1609%     - true
 1610%     Enable the separate GC thread.  All implicit atom and clause
 1611%     garbage collection is executed by the thread `gc`.
 1612%     - stop
 1613%     Stop the `gc` thread if it is running.  The thread is recreated
 1614%     on the next implicit atom or clause garbage collection.  Used
 1615%     by fork/1 to avoid forking a multi-threaded application.
 1616
 1617set_prolog_gc_thread(Status) :-
 1618    var(Status),
 1619    !,
 1620    '$instantiation_error'(Status).
 1621set_prolog_gc_thread(_) :-
 1622    \+ current_prolog_flag(threads, true),
 1623    !.
 1624set_prolog_gc_thread(false) :-
 1625    !,
 1626    set_prolog_flag(gc_thread, false),
 1627    (   current_prolog_flag(threads, true)
 1628    ->  (   '$gc_stop'
 1629        ->  thread_join(gc)
 1630        ;   true
 1631        )
 1632    ;   true
 1633    ).
 1634set_prolog_gc_thread(true) :-
 1635    !,
 1636    set_prolog_flag(gc_thread, true).
 1637set_prolog_gc_thread(stop) :-
 1638    !,
 1639    (   current_prolog_flag(threads, true)
 1640    ->  (   '$gc_stop'
 1641        ->  thread_join(gc)
 1642        ;   true
 1643        )
 1644    ;   true
 1645    ).
 1646set_prolog_gc_thread(Status) :-
 1647    '$domain_error'(gc_thread, Status).
 1648
 1649%!  transaction(:Goal).
 1650%!  transaction(:Goal, +Options).
 1651%!  transaction(:Goal, :Constraint, +Mutex).
 1652%!  snapshot(:Goal).
 1653%
 1654%   Wrappers to guarantee clean Module:Goal terms.
 1655
 1656transaction(Goal) :-
 1657    '$transaction'(Goal, []).
 1658transaction(Goal, Options) :-
 1659    '$transaction'(Goal, Options).
 1660transaction(Goal, Constraint, Mutex) :-
 1661    '$transaction'(Goal, Constraint, Mutex).
 1662snapshot(Goal) :-
 1663    '$snapshot'(Goal).
 1664
 1665
 1666		 /*******************************
 1667		 *            UNDO		*
 1668		 *******************************/
 1669
 1670:- meta_predicate
 1671    undo(0). 1672
 1673%!  undo(:Goal)
 1674%
 1675%   Schedule Goal to be called when backtracking takes us back to
 1676%   before this call.
 1677
 1678undo(Goal) :-
 1679    '$undo'(Goal).
 1680
 1681:- public
 1682    '$run_undo'/1. 1683
 1684'$run_undo'([One]) :-
 1685    !,
 1686    (   call(One)
 1687    ->  true
 1688    ;   true
 1689    ).
 1690'$run_undo'(List) :-
 1691    run_undo(List, _, Error),
 1692    (   var(Error)
 1693    ->  true
 1694    ;   throw(Error)
 1695    ).
 1696
 1697run_undo([], E, E).
 1698run_undo([H|T], E0, E) :-
 1699    (   catch(H, E1, true)
 1700    ->  (   var(E1)
 1701        ->  true
 1702        ;   '$urgent_exception'(E0, E1, E2)
 1703        )
 1704    ;   true
 1705    ),
 1706    run_undo(T, E2, E).
 1707
 1708
 1709%!  '$wrap_predicate'(:Head, +Name, -Closure, -Wrapped, :Body) is det.
 1710%
 1711%   Would be nicer to have this   from library(prolog_wrap), but we need
 1712%   it for tabling, so it must be a system predicate.
 1713
 1714:- meta_predicate
 1715    '$wrap_predicate'(:, +, -, -, 0). 1716
 1717'$wrap_predicate'(M:Head, WName, Closure, call(Wrapped), Body) :-
 1718    callable_name_arguments(Head, PName, Args),
 1719    callable_name_arity(Head, PName, Arity),
 1720    (   is_most_general_term(Head)
 1721    ->  true
 1722    ;   '$domain_error'(most_general_term, Head)
 1723    ),
 1724    atomic_list_concat(['$wrap$', PName], WrapName),
 1725    PI = M:WrapName/Arity,
 1726    dynamic(PI),
 1727    '$notransact'(PI),
 1728    volatile(PI),
 1729    module_transparent(PI),
 1730    WHead =.. [WrapName|Args],
 1731    wrapped_clause(M, WHead, Body, Clause),
 1732    '$c_wrap_predicate'(M:Head, WName, Closure, Wrapped, Clause).
 1733
 1734callable_name_arguments(Head, PName, Args) :-
 1735    atom(Head),
 1736    !,
 1737    PName = Head,
 1738    Args = [].
 1739callable_name_arguments(Head, PName, Args) :-
 1740    compound_name_arguments(Head, PName, Args).
 1741
 1742callable_name_arity(Head, PName, Arity) :-
 1743    atom(Head),
 1744    !,
 1745    PName = Head,
 1746    Arity = 0.
 1747callable_name_arity(Head, PName, Arity) :-
 1748    compound_name_arity(Head, PName, Arity).
 1749
 1750wrapped_clause(M, WHead, M:Body, M:(WHead :- Body)) :- !.
 1751wrapped_clause(M, WHead, MB:Body, M:(WHead :- MB:Body))