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