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            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            '$head_name_arity'(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, (!, Body)), Rule) =>
 1346    Rule = (Head => Body).
 1347conditional_rule(?=>(Head, !), Rule) =>
 1348    Rule = (Head => true).
 1349conditional_rule(?=>(Head, Body0), Rule),
 1350    split_on_cut(Body0, Cond, Body) =>
 1351    Rule = (Head,Cond=>Body).
 1352conditional_rule(Head, Rule) =>
 1353    Rule = Head.
 1354
 1355split_on_cut((Cond0,!,Body0), Cond, Body) =>
 1356    Cond = Cond0,
 1357    Body = Body0.
 1358split_on_cut((!,Body0), Cond, Body) =>
 1359    Cond = true,
 1360    Body = Body0.
 1361split_on_cut((A,B), Cond, Body) =>
 1362    Cond = (A,Cond1),
 1363    split_on_cut(B, Cond1, Body).
 1364split_on_cut(_, _, _) =>
 1365    fail.
 1366
 1367
 1368                 /*******************************
 1369                 *             TERM             *
 1370                 *******************************/
 1371
 1372:- '$iso'((numbervars/3)). 1373
 1374%!  numbervars(+Term, +StartIndex, -EndIndex) is det.
 1375%
 1376%   Number all unbound variables in Term   using  '$VAR'(N), where the
 1377%   first N is StartIndex and EndIndex is  unified to the index that
 1378%   will be given to the next variable.
 1379
 1380numbervars(Term, From, To) :-
 1381    numbervars(Term, From, To, []).
 1382
 1383
 1384                 /*******************************
 1385                 *            STRING            *
 1386                 *******************************/
 1387
 1388%!  term_string(?Term, ?String, +Options)
 1389%
 1390%   Parse/write a term from/to a string using Options.
 1391
 1392term_string(Term, String, Options) :-
 1393    nonvar(String),
 1394    !,
 1395    read_term_from_atom(String, Term, Options).
 1396term_string(Term, String, Options) :-
 1397    (   '$option'(quoted(_), Options)
 1398    ->  Options1 = Options
 1399    ;   '$merge_options'(_{quoted:true}, Options, Options1)
 1400    ),
 1401    format(string(String), '~W', [Term, Options1]).
 1402
 1403
 1404                 /*******************************
 1405                 *             GVAR             *
 1406                 *******************************/
 1407
 1408%!  nb_setval(+Name, +Value) is det.
 1409%
 1410%   Bind the non-backtrackable variable Name with a copy of Value
 1411
 1412nb_setval(Name, Value) :-
 1413    duplicate_term(Value, Copy),
 1414    nb_linkval(Name, Copy).
 1415
 1416
 1417		 /*******************************
 1418		 *            THREADS		*
 1419		 *******************************/
 1420
 1421:- meta_predicate
 1422    thread_create(0, -). 1423
 1424%!  thread_create(:Goal, -Id)
 1425%
 1426%   Shorthand for thread_create(Goal, Id, []).
 1427
 1428thread_create(Goal, Id) :-
 1429    thread_create(Goal, Id, []).
 1430
 1431%!  thread_join(+Id)
 1432%
 1433%   Join a thread and raise an error of the thread did not succeed.
 1434%
 1435%   @error  thread_error(Status),  where  Status  is    the   result  of
 1436%   thread_join/2.
 1437
 1438thread_join(Id) :-
 1439    thread_join(Id, Status),
 1440    (   Status == true
 1441    ->  true
 1442    ;   throw(error(thread_error(Id, Status), _))
 1443    ).
 1444
 1445%!  sig_block(:Pattern) is det.
 1446%
 1447%   Block thread signals that unify with Pattern.
 1448
 1449%!  sig_unblock(:Pattern) is det.
 1450%
 1451%   Remove any signal block that is more specific than Pattern.
 1452
 1453sig_block(Pattern) :-
 1454    (   nb_current('$sig_blocked', List)
 1455    ->  true
 1456    ;   List = []
 1457    ),
 1458    nb_setval('$sig_blocked', [Pattern|List]).
 1459
 1460sig_unblock(Pattern) :-
 1461    (   nb_current('$sig_blocked', List)
 1462    ->  unblock(List, Pattern, NewList),
 1463        (   List == NewList
 1464        ->  true
 1465        ;   nb_setval('$sig_blocked', NewList),
 1466            '$sig_unblock'
 1467        )
 1468    ;   true
 1469    ).
 1470
 1471unblock([], _, []).
 1472unblock([H|T], P, List) :-
 1473    (   subsumes_term(P, H)
 1474    ->  unblock(T, P, List)
 1475    ;   List = [H|T1],
 1476        unblock(T, P, T1)
 1477    ).
 1478
 1479:- public signal_is_blocked/1.          % called by signal_is_blocked()
 1480
 1481signal_is_blocked(Head) :-
 1482    nb_current('$sig_blocked', List),
 1483    '$member'(Head, List),
 1484    !.
 1485
 1486%!  set_prolog_gc_thread(+Status)
 1487%
 1488%   Control the GC thread.  Status is one of
 1489%
 1490%     - false
 1491%     Disable the separate GC thread, running atom and clause
 1492%     garbage collection in the triggering thread.
 1493%     - true
 1494%     Enable the separate GC thread.  All implicit atom and clause
 1495%     garbage collection is executed by the thread `gc`.
 1496%     - stop
 1497%     Stop the `gc` thread if it is running.  The thread is recreated
 1498%     on the next implicit atom or clause garbage collection.  Used
 1499%     by fork/1 to avoid forking a multi-threaded application.
 1500
 1501set_prolog_gc_thread(Status) :-
 1502    var(Status),
 1503    !,
 1504    '$instantiation_error'(Status).
 1505set_prolog_gc_thread(false) :-
 1506    !,
 1507    set_prolog_flag(gc_thread, false),
 1508    (   current_prolog_flag(threads, true)
 1509    ->  (   '$gc_stop'
 1510        ->  thread_join(gc)
 1511        ;   true
 1512        )
 1513    ;   true
 1514    ).
 1515set_prolog_gc_thread(true) :-
 1516    !,
 1517    set_prolog_flag(gc_thread, true).
 1518set_prolog_gc_thread(stop) :-
 1519    !,
 1520    (   current_prolog_flag(threads, true)
 1521    ->  (   '$gc_stop'
 1522        ->  thread_join(gc)
 1523        ;   true
 1524        )
 1525    ;   true
 1526    ).
 1527set_prolog_gc_thread(Status) :-
 1528    '$domain_error'(gc_thread, Status).
 1529
 1530%!  transaction(:Goal).
 1531%!  transaction(:Goal, +Options).
 1532%!  transaction(:Goal, :Constraint, +Mutex).
 1533%!  snapshot(:Goal).
 1534%
 1535%   Wrappers to guarantee clean Module:Goal terms.
 1536
 1537transaction(Goal) :-
 1538    '$transaction'(Goal, []).
 1539transaction(Goal, Options) :-
 1540    '$transaction'(Goal, Options).
 1541transaction(Goal, Constraint, Mutex) :-
 1542    '$transaction'(Goal, Constraint, Mutex).
 1543snapshot(Goal) :-
 1544    '$snapshot'(Goal).
 1545
 1546
 1547		 /*******************************
 1548		 *            UNDO		*
 1549		 *******************************/
 1550
 1551:- meta_predicate
 1552    undo(0). 1553
 1554%!  undo(:Goal)
 1555%
 1556%   Schedule Goal to be called when backtracking takes us back to
 1557%   before this call.
 1558
 1559undo(Goal) :-
 1560    '$undo'(Goal).
 1561
 1562:- public
 1563    '$run_undo'/1. 1564
 1565'$run_undo'([One]) :-
 1566    !,
 1567    call(One).
 1568'$run_undo'(List) :-
 1569    run_undo(List, _, Error),
 1570    (   var(Error)
 1571    ->  true
 1572    ;   throw(Error)
 1573    ).
 1574
 1575run_undo([], E, E).
 1576run_undo([H|T], E0, E) :-
 1577    (   catch(H, E1, true)
 1578    ->  (   var(E1)
 1579        ->  true
 1580        ;   '$urgent_exception'(E0, E1, E2)
 1581        )
 1582    ;   true
 1583    ),
 1584    run_undo(T, E2, E).
 1585
 1586
 1587%!  '$wrap_predicate'(:Head, +Name, -Closure, -Wrapped, +Body) is det.
 1588%
 1589%   Would be nicer to have this   from library(prolog_wrap), but we need
 1590%   it for tabling, so it must be a system predicate.
 1591
 1592:- meta_predicate
 1593    '$wrap_predicate'(:, +, -, -, +). 1594
 1595'$wrap_predicate'(M:Head, WName, Closure, call(Wrapped), Body) :-
 1596    callable_name_arguments(Head, PName, Args),
 1597    callable_name_arity(Head, PName, Arity),
 1598    (   is_most_general_term(Head)
 1599    ->  true
 1600    ;   '$domain_error'(most_general_term, Head)
 1601    ),
 1602    atomic_list_concat(['$wrap$', PName], WrapName),
 1603    volatile(M:WrapName/Arity),
 1604    module_transparent(M:WrapName/Arity),
 1605    WHead =.. [WrapName|Args],
 1606    '$c_wrap_predicate'(M:Head, WName, Closure, Wrapped, M:(WHead :- Body)).
 1607
 1608callable_name_arguments(Head, PName, Args) :-
 1609    atom(Head),
 1610    !,
 1611    PName = Head,
 1612    Args = [].
 1613callable_name_arguments(Head, PName, Args) :-
 1614    compound_name_arguments(Head, PName, Args).
 1615
 1616callable_name_arity(Head, PName, Arity) :-
 1617    atom(Head),
 1618    !,
 1619    PName = Head,
 1620    Arity = 0.
 1621callable_name_arity(Head, PName, Arity) :-
 1622    compound_name_arity(Head, PName, Arity)