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