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