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