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