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