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                 *            DLOPEN            *
  482                 *******************************/
  483
  484%!  open_shared_object(+File, -Handle) is det.
  485%!  open_shared_object(+File, -Handle, +Flags) is det.
  486%
  487%   Open a shared object or DLL file. Flags  is a list of flags. The
  488%   following flags are recognised. Note   however  that these flags
  489%   may have no affect on the target platform.
  490%
  491%       * =now=
  492%       Resolve all symbols in the file now instead of lazily.
  493%       * =global=
  494%       Make new symbols globally known.
  495
  496open_shared_object(File, Handle) :-
  497    open_shared_object(File, Handle, []). % use pl-load.c defaults
  498
  499open_shared_object(File, Handle, Flags) :-
  500    (   is_list(Flags)
  501    ->  true
  502    ;   throw(error(type_error(list, Flags), _))
  503    ),
  504    map_dlflags(Flags, Mask),
  505    '$open_shared_object'(File, Handle, Mask).
  506
  507dlopen_flag(now,        2'01).          % see pl-load.c for these constants
  508dlopen_flag(global,     2'10).          % Solaris only
  509
  510map_dlflags([], 0).
  511map_dlflags([F|T], M) :-
  512    map_dlflags(T, M0),
  513    (   dlopen_flag(F, I)
  514    ->  true
  515    ;   throw(error(domain_error(dlopen_flag, F), _))
  516    ),
  517    M is M0 \/ I.
  518
  519:- export(open_shared_object/2).  520:- export(open_shared_object/3).  521
  522
  523		 /*******************************
  524		 *      FOREIGN LIBRARIES	*
  525		 *******************************/
  526
  527%!  use_foreign_library(+FileSpec) is det.
  528%!  use_foreign_library(+FileSpec, +Entry:atom) is det.
  529%
  530%   Load and install a foreign   library as load_foreign_library/1,2
  531%   and register the installation using   initialization/2  with the
  532%   option =now=. This is similar to using:
  533%
  534%     ==
  535%     :- initialization(load_foreign_library(foreign(mylib))).
  536%     ==
  537%
  538%   but using the initialization/1 wrapper causes  the library to be
  539%   loaded _after_ loading of  the  file   in  which  it  appears is
  540%   completed,  while  use_foreign_library/1  loads    the   library
  541%   _immediately_. I.e. the  difference  is   only  relevant  if the
  542%   remainder of the file uses functionality of the C-library.
  543
  544:- meta_predicate
  545    use_foreign_library(:),
  546    use_foreign_library(:, +).  547:- public
  548    use_foreign_library_noi/1.  549
  550use_foreign_library(FileSpec) :-
  551    ensure_shlib,
  552    initialization(use_foreign_library_noi(FileSpec), now).
  553
  554% noi -> no initialize; used by '$autoload':exports/3.
  555use_foreign_library_noi(FileSpec) :-
  556    ensure_shlib,
  557    shlib:load_foreign_library(FileSpec).
  558
  559use_foreign_library(FileSpec, Entry) :-
  560    ensure_shlib,
  561    initialization(shlib:load_foreign_library(FileSpec, Entry), now).
  562
  563ensure_shlib :-
  564    '$get_predicate_attribute'(shlib:load_foreign_library(_), defined, 1),
  565    '$get_predicate_attribute'(shlib:load_foreign_library(_,_), defined, 1),
  566    !.
  567ensure_shlib :-
  568    use_module(library(shlib), []).
  569
  570:- export(use_foreign_library/1).  571:- export(use_foreign_library/2).  572
  573:- elif(current_predicate('$activate_static_extension'/1)).  574
  575% Version when using shared objects is disabled and extensions are added
  576% as static libraries.
  577
  578:- meta_predicate
  579    use_foreign_library(:).  580:- public
  581    use_foreign_library_noi/1.  582:- dynamic
  583    loading/1,
  584    foreign_predicate/2.  585
  586use_foreign_library(FileSpec) :-
  587    initialization(use_foreign_library_noi(FileSpec), now).
  588
  589use_foreign_library_noi(Module:foreign(Extension)) :-
  590    setup_call_cleanup(
  591        asserta(loading(foreign(Extension)), Ref),
  592        @('$activate_static_extension'(Extension), Module),
  593        erase(Ref)).
  594
  595:- export(use_foreign_library/1).  596
  597system:'$foreign_registered'(M, H) :-
  598    (   loading(Lib)
  599    ->  true
  600    ;   Lib = '<spontaneous>'
  601    ),
  602    assert(foreign_predicate(Lib, M:H)).
  603
  604%!  current_foreign_library(?File, -Public)
  605%
  606%   Query currently loaded shared libraries.
  607
  608current_foreign_library(File, Public) :-
  609    setof(Pred, foreign_predicate(File, Pred), Public).
  610
  611:- export(current_foreign_library/2).  612
  613:- endif. /* open_shared_object support */
  614
  615                 /*******************************
  616                 *            STREAMS           *
  617                 *******************************/
  618
  619%!  stream_position_data(?Field, +Pos, ?Date)
  620%
  621%   Extract values from stream position objects. '$stream_position' is
  622%   of the format '$stream_position'(Byte, Char, Line, LinePos)
  623
  624stream_position_data(Prop, Term, Value) :-
  625    nonvar(Prop),
  626    !,
  627    (   stream_position_field(Prop, Pos)
  628    ->  arg(Pos, Term, Value)
  629    ;   throw(error(domain_error(stream_position_data, Prop)))
  630    ).
  631stream_position_data(Prop, Term, Value) :-
  632    stream_position_field(Prop, Pos),
  633    arg(Pos, Term, Value).
  634
  635stream_position_field(char_count,    1).
  636stream_position_field(line_count,    2).
  637stream_position_field(line_position, 3).
  638stream_position_field(byte_count,    4).
  639
  640
  641                 /*******************************
  642                 *            CONTROL           *
  643                 *******************************/
  644
  645%!  call_with_depth_limit(:Goal, +DepthLimit, -Result)
  646%
  647%   Try to proof Goal, but fail on any branch exceeding the indicated
  648%   depth-limit.  Unify Result with the maximum-reached limit on success,
  649%   depth_limit_exceeded if the limit was exceeded and fails otherwise.
  650
  651:- meta_predicate
  652    call_with_depth_limit(0, +, -).  653
  654call_with_depth_limit(G, Limit, Result) :-
  655    '$depth_limit'(Limit, OLimit, OReached),
  656    (   catch(G, E, '$depth_limit_except'(OLimit, OReached, E)),
  657        '$depth_limit_true'(Limit, OLimit, OReached, Result, Det),
  658        ( Det == ! -> ! ; true )
  659    ;   '$depth_limit_false'(OLimit, OReached, Result)
  660    ).
  661
  662%!  call_with_inference_limit(:Goal, +InferenceLimit, -Result)
  663%
  664%   Equivalent to call(Goal),  but  poses  a   limit  on  the  number of
  665%   inferences. If this  limit  is  reached,   Result  is  unified  with
  666%   `inference_limit_exceeded`, otherwise Result is unified  with `!` if
  667%   Goal succeeded without a choicepoint and `true` otherwise.
  668%
  669%   Note that we perform calls in  system to avoid auto-importing, which
  670%   makes raiseInferenceLimitException() fail  to   recognise  that  the
  671%   exception happens in the overhead.
  672
  673:- meta_predicate
  674    call_with_inference_limit(0, +, -).  675
  676call_with_inference_limit(G, Limit, Result) :-
  677    '$inference_limit'(Limit, OLimit),
  678    (   catch(G, Except,
  679              system:'$inference_limit_except'(OLimit, Except, Result0)),
  680        (   Result0 == inference_limit_exceeded
  681        ->  !
  682        ;   system:'$inference_limit_true'(Limit, OLimit, Result0),
  683            ( Result0 == ! -> ! ; true )
  684        ),
  685        Result = Result0
  686    ;   system:'$inference_limit_false'(OLimit)
  687    ).
  688
  689
  690                /********************************
  691                *           DATA BASE           *
  692                *********************************/
  693
  694/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
  695The predicate current_predicate/2 is   a  difficult subject since  the
  696introduction  of defaulting     modules   and   dynamic     libraries.
  697current_predicate/2 is normally  called with instantiated arguments to
  698verify some  predicate can   be called without trapping   an undefined
  699predicate.  In this case we must  perform the search algorithm used by
  700the prolog system itself.
  701
  702If the pattern is not fully specified, we only generate the predicates
  703actually available in this  module.   This seems the best for listing,
  704etc.
  705- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
  706
  707
  708:- meta_predicate
  709    current_predicate(?, :),
  710    '$defined_predicate'(:).  711
  712current_predicate(Name, Module:Head) :-
  713    (var(Module) ; var(Head)),
  714    !,
  715    generate_current_predicate(Name, Module, Head).
  716current_predicate(Name, Term) :-
  717    '$c_current_predicate'(Name, Term),
  718    '$defined_predicate'(Term),
  719    !.
  720current_predicate(Name, Module:Head) :-
  721    default_module(Module, DefModule),
  722    '$c_current_predicate'(Name, DefModule:Head),
  723    '$defined_predicate'(DefModule:Head),
  724    !.
  725current_predicate(Name, Module:Head) :-
  726    '$autoload':autoload_in(Module, general),
  727    \+ current_prolog_flag(Module:unknown, fail),
  728    (   compound(Head)
  729    ->  compound_name_arity(Head, Name, Arity)
  730    ;   Name = Head, Arity = 0
  731    ),
  732    '$find_library'(Module, Name, Arity, _LoadModule, _Library),
  733    !.
  734
  735generate_current_predicate(Name, Module, Head) :-
  736    current_module(Module),
  737    QHead = Module:Head,
  738    '$c_current_predicate'(Name, QHead),
  739    '$get_predicate_attribute'(QHead, defined, 1).
  740
  741'$defined_predicate'(Head) :-
  742    '$get_predicate_attribute'(Head, defined, 1),
  743    !.
  744
  745%!  predicate_property(?Predicate, ?Property) is nondet.
  746%
  747%   True when Property is a property of Predicate.
  748
  749:- meta_predicate
  750    predicate_property(:, ?).  751
  752:- multifile
  753    '$predicate_property'/2.  754
  755:- '$iso'(predicate_property/2).  756
  757predicate_property(Pred, Property) :-           % Mode ?,+
  758    nonvar(Property),
  759    !,
  760    property_predicate(Property, Pred).
  761predicate_property(Pred, Property) :-           % Mode +,-
  762    define_or_generate(Pred),
  763    '$predicate_property'(Property, Pred).
  764
  765%!  property_predicate(+Property, ?Pred)
  766%
  767%   First handle the special  cases  that   are  not  about querying
  768%   normally  defined  predicates:   =undefined=,    =visible=   and
  769%   =autoload=, followed by the generic case.
  770
  771property_predicate(undefined, Pred) :-
  772    !,
  773    Pred = Module:Head,
  774    current_module(Module),
  775    '$c_current_predicate'(_, Pred),
  776    \+ '$defined_predicate'(Pred),          % Speed up a bit
  777    \+ current_predicate(_, Pred),
  778    goal_name_arity(Head, Name, Arity),
  779    \+ system_undefined(Module:Name/Arity).
  780property_predicate(visible, Pred) :-
  781    !,
  782    visible_predicate(Pred).
  783property_predicate(autoload(File), Head) :-
  784    !,
  785    \+ current_prolog_flag(autoload, false),
  786    '$autoload':autoloadable(Head, File).
  787property_predicate(implementation_module(IM), M:Head) :-
  788    !,
  789    atom(M),
  790    (   default_module(M, DM),
  791        '$get_predicate_attribute'(DM:Head, defined, 1)
  792    ->  (   '$get_predicate_attribute'(DM:Head, imported, ImportM)
  793        ->  IM = ImportM
  794        ;   IM = M
  795        )
  796    ;   \+ current_prolog_flag(M:unknown, fail),
  797        goal_name_arity(Head, Name, Arity),
  798        '$find_library'(_, Name, Arity, LoadModule, _File)
  799    ->  IM = LoadModule
  800    ;   M = IM
  801    ).
  802property_predicate(iso, _:Head) :-
  803    callable(Head),
  804    !,
  805    goal_name_arity(Head, Name, Arity),
  806    current_predicate(system:Name/Arity),
  807    '$predicate_property'(iso, system:Head).
  808property_predicate(built_in, Module:Head) :-
  809    callable(Head),
  810    !,
  811    goal_name_arity(Head, Name, Arity),
  812    current_predicate(Module:Name/Arity),
  813    '$predicate_property'(built_in, Module:Head).
  814property_predicate(Property, Pred) :-
  815    define_or_generate(Pred),
  816    '$predicate_property'(Property, Pred).
  817
  818goal_name_arity(Head, Name, Arity) :-
  819    compound(Head),
  820    !,
  821    compound_name_arity(Head, Name, Arity).
  822goal_name_arity(Head, Head, 0).
  823
  824
  825%!  define_or_generate(+Head) is semidet.
  826%!  define_or_generate(-Head) is nondet.
  827%
  828%   If the predicate is known, try to resolve it. Otherwise generate
  829%   the known predicate, but do not try to (auto)load the predicate.
  830
  831define_or_generate(M:Head) :-
  832    callable(Head),
  833    atom(M),
  834    '$get_predicate_attribute'(M:Head, defined, 1),
  835    !.
  836define_or_generate(M:Head) :-
  837    callable(Head),
  838    nonvar(M), M \== system,
  839    !,
  840    '$define_predicate'(M:Head).
  841define_or_generate(Pred) :-
  842    current_predicate(_, Pred),
  843    '$define_predicate'(Pred).
  844
  845
  846'$predicate_property'(interpreted, Pred) :-
  847    '$get_predicate_attribute'(Pred, foreign, 0).
  848'$predicate_property'(visible, Pred) :-
  849    '$get_predicate_attribute'(Pred, defined, 1).
  850'$predicate_property'(built_in, Pred) :-
  851    '$get_predicate_attribute'(Pred, system, 1).
  852'$predicate_property'(exported, Pred) :-
  853    '$get_predicate_attribute'(Pred, exported, 1).
  854'$predicate_property'(public, Pred) :-
  855    '$get_predicate_attribute'(Pred, public, 1).
  856'$predicate_property'(non_terminal, Pred) :-
  857    '$get_predicate_attribute'(Pred, non_terminal, 1).
  858'$predicate_property'(foreign, Pred) :-
  859    '$get_predicate_attribute'(Pred, foreign, 1).
  860'$predicate_property'((dynamic), Pred) :-
  861    '$get_predicate_attribute'(Pred, (dynamic), 1).
  862'$predicate_property'((static), Pred) :-
  863    '$get_predicate_attribute'(Pred, (dynamic), 0).
  864'$predicate_property'((volatile), Pred) :-
  865    '$get_predicate_attribute'(Pred, (volatile), 1).
  866'$predicate_property'((thread_local), Pred) :-
  867    '$get_predicate_attribute'(Pred, (thread_local), 1).
  868'$predicate_property'((multifile), Pred) :-
  869    '$get_predicate_attribute'(Pred, (multifile), 1).
  870'$predicate_property'((discontiguous), Pred) :-
  871    '$get_predicate_attribute'(Pred, (discontiguous), 1).
  872'$predicate_property'(imported_from(Module), Pred) :-
  873    '$get_predicate_attribute'(Pred, imported, Module).
  874'$predicate_property'(transparent, Pred) :-
  875    '$get_predicate_attribute'(Pred, transparent, 1).
  876'$predicate_property'(meta_predicate(Pattern), Pred) :-
  877    '$get_predicate_attribute'(Pred, meta_predicate, Pattern).
  878'$predicate_property'(file(File), Pred) :-
  879    '$get_predicate_attribute'(Pred, file, File).
  880'$predicate_property'(line_count(LineNumber), Pred) :-
  881    '$get_predicate_attribute'(Pred, line_count, LineNumber).
  882'$predicate_property'(notrace, Pred) :-
  883    '$get_predicate_attribute'(Pred, trace, 0).
  884'$predicate_property'(nodebug, Pred) :-
  885    '$get_predicate_attribute'(Pred, hide_childs, 1).
  886'$predicate_property'(spying, Pred) :-
  887    '$get_predicate_attribute'(Pred, spy, 1).
  888'$predicate_property'(number_of_clauses(N), Pred) :-
  889    '$get_predicate_attribute'(Pred, number_of_clauses, N).
  890'$predicate_property'(number_of_rules(N), Pred) :-
  891    '$get_predicate_attribute'(Pred, number_of_rules, N).
  892'$predicate_property'(last_modified_generation(Gen), Pred) :-
  893    '$get_predicate_attribute'(Pred, last_modified_generation, Gen).
  894'$predicate_property'(indexed(Indices), Pred) :-
  895    '$get_predicate_attribute'(Pred, indexed, Indices).
  896'$predicate_property'(noprofile, Pred) :-
  897    '$get_predicate_attribute'(Pred, noprofile, 1).
  898'$predicate_property'(ssu, Pred) :-
  899    '$get_predicate_attribute'(Pred, ssu, 1).
  900'$predicate_property'(iso, Pred) :-
  901    '$get_predicate_attribute'(Pred, iso, 1).
  902'$predicate_property'(det, Pred) :-
  903    '$get_predicate_attribute'(Pred, det, 1).
  904'$predicate_property'(sig_atomic, Pred) :-
  905    '$get_predicate_attribute'(Pred, sig_atomic, 1).
  906'$predicate_property'(quasi_quotation_syntax, Pred) :-
  907    '$get_predicate_attribute'(Pred, quasi_quotation_syntax, 1).
  908'$predicate_property'(defined, Pred) :-
  909    '$get_predicate_attribute'(Pred, defined, 1).
  910'$predicate_property'(tabled, Pred) :-
  911    '$get_predicate_attribute'(Pred, tabled, 1).
  912'$predicate_property'(tabled(Flag), Pred) :-
  913    '$get_predicate_attribute'(Pred, tabled, 1),
  914    table_flag(Flag, Pred).
  915'$predicate_property'(incremental, Pred) :-
  916    '$get_predicate_attribute'(Pred, incremental, 1).
  917'$predicate_property'(monotonic, Pred) :-
  918    '$get_predicate_attribute'(Pred, monotonic, 1).
  919'$predicate_property'(opaque, Pred) :-
  920    '$get_predicate_attribute'(Pred, opaque, 1).
  921'$predicate_property'(lazy, Pred) :-
  922    '$get_predicate_attribute'(Pred, lazy, 1).
  923'$predicate_property'(abstract(N), Pred) :-
  924    '$get_predicate_attribute'(Pred, abstract, N).
  925'$predicate_property'(size(Bytes), Pred) :-
  926    '$get_predicate_attribute'(Pred, size, Bytes).
  927
  928system_undefined(user:prolog_trace_interception/4).
  929system_undefined(prolog:prolog_exception_hook/5).
  930system_undefined(system:'$c_call_prolog'/0).
  931system_undefined(system:window_title/2).
  932
  933table_flag(variant, Pred) :-
  934    '$tbl_implementation'(Pred, M:Head),
  935    M:'$tabled'(Head, variant).
  936table_flag(subsumptive, Pred) :-
  937    '$tbl_implementation'(Pred, M:Head),
  938    M:'$tabled'(Head, subsumptive).
  939table_flag(shared, Pred) :-
  940    '$get_predicate_attribute'(Pred, tshared, 1).
  941table_flag(incremental, Pred) :-
  942    '$get_predicate_attribute'(Pred, incremental, 1).
  943table_flag(monotonic, Pred) :-
  944    '$get_predicate_attribute'(Pred, monotonic, 1).
  945table_flag(subgoal_abstract(N), Pred) :-
  946    '$get_predicate_attribute'(Pred, subgoal_abstract, N).
  947table_flag(answer_abstract(N), Pred) :-
  948    '$get_predicate_attribute'(Pred, subgoal_abstract, N).
  949table_flag(subgoal_abstract(N), Pred) :-
  950    '$get_predicate_attribute'(Pred, max_answers, N).
  951
  952
  953%!  visible_predicate(:Head) is nondet.
  954%
  955%   True when Head can be called without raising an existence error.
  956%   This implies it is defined,  can   be  inherited  from a default
  957%   module or can be autoloaded.
  958
  959visible_predicate(Pred) :-
  960    Pred = M:Head,
  961    current_module(M),
  962    (   callable(Head)
  963    ->  (   '$get_predicate_attribute'(Pred, defined, 1)
  964        ->  true
  965        ;   \+ current_prolog_flag(M:unknown, fail),
  966            '$head_name_arity'(Head, Name, Arity),
  967            '$find_library'(M, Name, Arity, _LoadModule, _Library)
  968        )
  969    ;   setof(PI, visible_in_module(M, PI), PIs),
  970        '$member'(Name/Arity, PIs),
  971        functor(Head, Name, Arity)
  972    ).
  973
  974visible_in_module(M, Name/Arity) :-
  975    default_module(M, DefM),
  976    DefHead = DefM:Head,
  977    '$c_current_predicate'(_, DefHead),
  978    '$get_predicate_attribute'(DefHead, defined, 1),
  979    \+ hidden_system_predicate(Head),
  980    functor(Head, Name, Arity).
  981visible_in_module(_, Name/Arity) :-
  982    '$in_library'(Name, Arity, _).
  983
  984hidden_system_predicate(Head) :-
  985    functor(Head, Name, _),
  986    atom(Name),                     % Avoid [].
  987    sub_atom(Name, 0, _, _, $),
  988    \+ current_prolog_flag(access_level, system).
  989
  990
  991%!  clause_property(+ClauseRef, ?Property) is nondet.
  992%
  993%   Provide information on individual clauses.  Defined properties
  994%   are:
  995%
  996%       * line_count(-Line)
  997%       Line from which the clause is loaded.
  998%       * file(-File)
  999%       File from which the clause is loaded.
 1000%       * source(-File)
 1001%       File that `owns' the clause: reloading this file wipes
 1002%       the clause.
 1003%       * fact
 1004%       Clause has body =true=.
 1005%       * erased
 1006%       Clause was erased.
 1007%       * predicate(:PI)
 1008%       Predicate indicator of the predicate this clause belongs
 1009%       to.  Can be used to find the predicate of erased clauses.
 1010%       * module(-M)
 1011%       Module context in which the clause was compiled.
 1012
 1013clause_property(Clause, Property) :-
 1014    '$clause_property'(Property, Clause).
 1015
 1016'$clause_property'(line_count(LineNumber), Clause) :-
 1017    '$get_clause_attribute'(Clause, line_count, LineNumber).
 1018'$clause_property'(file(File), Clause) :-
 1019    '$get_clause_attribute'(Clause, file, File).
 1020'$clause_property'(source(File), Clause) :-
 1021    '$get_clause_attribute'(Clause, owner, File).
 1022'$clause_property'(size(Bytes), Clause) :-
 1023    '$get_clause_attribute'(Clause, size, Bytes).
 1024'$clause_property'(fact, Clause) :-
 1025    '$get_clause_attribute'(Clause, fact, true).
 1026'$clause_property'(erased, Clause) :-
 1027    '$get_clause_attribute'(Clause, erased, true).
 1028'$clause_property'(predicate(PI), Clause) :-
 1029    '$get_clause_attribute'(Clause, predicate_indicator, PI).
 1030'$clause_property'(module(M), Clause) :-
 1031    '$get_clause_attribute'(Clause, module, M).
 1032
 1033%!  dynamic(:Predicates, +Options) is det.
 1034%
 1035%   Define a predicate as dynamic with optionally additional properties.
 1036%   Defined options are:
 1037%
 1038%     - incremental(+Bool)
 1039%     - abstract(+Level)
 1040%     - multifile(+Bool)
 1041%     - discontiguous(+Bool)
 1042%     - thread(+Mode)
 1043%     - volatile(+Bool)
 1044
 1045dynamic(M:Predicates, Options) :-
 1046    '$must_be'(list, Predicates),
 1047    options_properties(Options, Props),
 1048    set_pprops(Predicates, M, [dynamic|Props]).
 1049
 1050set_pprops([], _, _).
 1051set_pprops([H|T], M, Props) :-
 1052    set_pprops1(Props, M:H),
 1053    strip_module(M:H, M2, P),
 1054    '$pi_head'(M2:P, Pred),
 1055    '$set_table_wrappers'(Pred),
 1056    set_pprops(T, M, Props).
 1057
 1058set_pprops1([], _).
 1059set_pprops1([H|T], P) :-
 1060    (   atom(H)
 1061    ->  '$set_predicate_attribute'(P, H, true)
 1062    ;   H =.. [Name,Value]
 1063    ->  '$set_predicate_attribute'(P, Name, Value)
 1064    ),
 1065    set_pprops1(T, P).
 1066
 1067options_properties(Options, Props) :-
 1068    G = opt_prop(_,_,_,_),
 1069    findall(G, G, Spec),
 1070    options_properties(Spec, Options, Props).
 1071
 1072options_properties([], _, []).
 1073options_properties([opt_prop(Name, Type, SetValue, Prop)|T],
 1074                   Options, [Prop|PT]) :-
 1075    Opt =.. [Name,V],
 1076    '$option'(Opt, Options),
 1077    '$must_be'(Type, V),
 1078    V = SetValue,
 1079    !,
 1080    options_properties(T, Options, PT).
 1081options_properties([_|T], Options, PT) :-
 1082    options_properties(T, Options, PT).
 1083
 1084opt_prop(incremental,   boolean,               Bool,  incremental(Bool)).
 1085opt_prop(abstract,      between(0,0),          0,     abstract).
 1086opt_prop(multifile,     boolean,               true,  multifile).
 1087opt_prop(discontiguous, boolean,               true,  discontiguous).
 1088opt_prop(volatile,      boolean,               true,  volatile).
 1089opt_prop(thread,        oneof(atom, [local,shared],[local,shared]),
 1090                                               local, thread_local).
 1091
 1092                /********************************
 1093                *            MODULES            *
 1094                *********************************/
 1095
 1096%!  current_module(?Module) is nondet.
 1097%
 1098%   True if Module is a currently defined module.
 1099
 1100current_module(Module) :-
 1101    '$current_module'(Module, _).
 1102
 1103%!  module_property(?Module, ?Property) is nondet.
 1104%
 1105%   True if Property is a property of Module.  Defined properties
 1106%   are:
 1107%
 1108%       * file(File)
 1109%       Module is loaded from File.
 1110%       * line_count(Count)
 1111%       The module declaration is on line Count of File.
 1112%       * exports(ListOfPredicateIndicators)
 1113%       The module exports ListOfPredicateIndicators
 1114%       * exported_operators(ListOfOp3)
 1115%       The module exports the operators ListOfOp3.
 1116
 1117module_property(Module, Property) :-
 1118    nonvar(Module), nonvar(Property),
 1119    !,
 1120    property_module(Property, Module).
 1121module_property(Module, Property) :-    % -, file(File)
 1122    nonvar(Property), Property = file(File),
 1123    !,
 1124    (   nonvar(File)
 1125    ->  '$current_module'(Modules, File),
 1126        (   atom(Modules)
 1127        ->  Module = Modules
 1128        ;   '$member'(Module, Modules)
 1129        )
 1130    ;   '$current_module'(Module, File),
 1131        File \== []
 1132    ).
 1133module_property(Module, Property) :-
 1134    current_module(Module),
 1135    property_module(Property, Module).
 1136
 1137property_module(Property, Module) :-
 1138    module_property(Property),
 1139    (   Property = exported_operators(List)
 1140    ->  '$exported_ops'(Module, List, [])
 1141    ;   '$module_property'(Module, Property)
 1142    ).
 1143
 1144module_property(class(_)).
 1145module_property(file(_)).
 1146module_property(line_count(_)).
 1147module_property(exports(_)).
 1148module_property(exported_operators(_)).
 1149module_property(size(_)).
 1150module_property(program_size(_)).
 1151module_property(program_space(_)).
 1152module_property(last_modified_generation(_)).
 1153
 1154%!  module(+Module) is det.
 1155%
 1156%   Set the module that is associated to the toplevel to Module.
 1157
 1158module(Module) :-
 1159    atom(Module),
 1160    current_module(Module),
 1161    !,
 1162    '$set_typein_module'(Module).
 1163module(Module) :-
 1164    '$set_typein_module'(Module),
 1165    print_message(warning, no_current_module(Module)).
 1166
 1167%!  working_directory(-Old, +New)
 1168%
 1169%   True when Old is the current working directory and the working
 1170%   directory has been updated to New.
 1171
 1172working_directory(Old, New) :-
 1173    '$cwd'(Old),
 1174    (   Old == New
 1175    ->  true
 1176    ;   '$chdir'(New)
 1177    ).
 1178
 1179
 1180                 /*******************************
 1181                 *            TRIES             *
 1182                 *******************************/
 1183
 1184%!  current_trie(?Trie) is nondet.
 1185%
 1186%   True if Trie is the handle of an existing trie.
 1187
 1188current_trie(Trie) :-
 1189    current_blob(Trie, trie),
 1190    is_trie(Trie).
 1191
 1192%!  trie_property(?Trie, ?Property)
 1193%
 1194%   True when Property is a property of Trie. Defined properties
 1195%   are:
 1196%
 1197%     - value_count(Count)
 1198%       Number of terms in the trie.
 1199%     - node_count(Count)
 1200%       Number of nodes in the trie.
 1201%     - size(Bytes)
 1202%       Number of bytes needed to store the trie.
 1203%     - hashed(Count)
 1204%       Number of hashed nodes.
 1205%     - compiled_size(Bytes)
 1206%       Size of the compiled representation (if the trie is compiled)
 1207%     - lookup_count(Count)
 1208%       Number of data lookups on the trie
 1209%     - gen_call_count(Count)
 1210%       Number of trie_gen/2 calls on this trie
 1211%
 1212%   Incremental tabling statistics:
 1213%
 1214%     - invalidated(Count)
 1215%       Number of times the trie was inivalidated
 1216%     - reevaluated(Count)
 1217%       Number of times the trie was re-evaluated
 1218%
 1219%   Shared tabling statistics:
 1220%
 1221%     - deadlock(Count)
 1222%       Number of times the table was involved in a deadlock
 1223%     - wait(Count)
 1224%       Number of times a thread had to wait for this table
 1225
 1226trie_property(Trie, Property) :-
 1227    current_trie(Trie),
 1228    trie_property(Property),
 1229    '$trie_property'(Trie, Property).
 1230
 1231trie_property(node_count(_)).
 1232trie_property(value_count(_)).
 1233trie_property(size(_)).
 1234trie_property(hashed(_)).
 1235trie_property(compiled_size(_)).
 1236                                                % below only when -DO_TRIE_STATS
 1237trie_property(lookup_count(_)).                 % is enabled in pl-trie.h
 1238trie_property(gen_call_count(_)).
 1239trie_property(invalidated(_)).                  % IDG stats
 1240trie_property(reevaluated(_)).
 1241trie_property(deadlock(_)).                     % Shared tabling stats
 1242trie_property(wait(_)).
 1243trie_property(idg_affected_count(_)).
 1244trie_property(idg_dependent_count(_)).
 1245trie_property(idg_size(_)).
 1246
 1247
 1248                /********************************
 1249                *      SYSTEM INTERACTION       *
 1250                *********************************/
 1251
 1252shell(Command) :-
 1253    shell(Command, 0).
 1254
 1255
 1256                 /*******************************
 1257                 *            SIGNALS           *
 1258                 *******************************/
 1259
 1260:- meta_predicate
 1261    on_signal(+, :, :),
 1262    current_signal(?, ?, :). 1263
 1264%!  on_signal(+Signal, -OldHandler, :NewHandler) is det.
 1265
 1266on_signal(Signal, Old, New) :-
 1267    atom(Signal),
 1268    !,
 1269    '$on_signal'(_Num, Signal, Old, New).
 1270on_signal(Signal, Old, New) :-
 1271    integer(Signal),
 1272    !,
 1273    '$on_signal'(Signal, _Name, Old, New).
 1274on_signal(Signal, _Old, _New) :-
 1275    '$type_error'(signal_name, Signal).
 1276
 1277%!  current_signal(?Name, ?SignalNumber, :Handler) is nondet.
 1278
 1279current_signal(Name, Id, Handler) :-
 1280    between(1, 32, Id),
 1281    '$on_signal'(Id, Name, Handler, Handler).
 1282
 1283:- multifile
 1284    prolog:called_by/2. 1285
 1286prolog:called_by(on_signal(_,_,New), [New+1]) :-
 1287    (   new == throw
 1288    ;   new == default
 1289    ), !, fail.
 1290
 1291
 1292                 /*******************************
 1293                 *             I/O              *
 1294                 *******************************/
 1295
 1296format(Fmt) :-
 1297    format(Fmt, []).
 1298
 1299                 /*******************************
 1300                 *            FILES             *
 1301                 *******************************/
 1302
 1303%!  absolute_file_name(+Term, -AbsoluteFile)
 1304
 1305absolute_file_name(Name, Abs) :-
 1306    atomic(Name),
 1307    !,
 1308    '$absolute_file_name'(Name, Abs).
 1309absolute_file_name(Term, Abs) :-
 1310    '$chk_file'(Term, [''], [access(read)], true, File),
 1311    !,
 1312    '$absolute_file_name'(File, Abs).
 1313absolute_file_name(Term, Abs) :-
 1314    '$chk_file'(Term, [''], [], true, File),
 1315    !,
 1316    '$absolute_file_name'(File, Abs).
 1317
 1318%!  tmp_file_stream(-File, -Stream, +Options) is det.
 1319%!  tmp_file_stream(+Encoding, -File, -Stream) is det.
 1320%
 1321%   Create a temporary file and open it   atomically. The second mode is
 1322%   for compatibility reasons.
 1323
 1324tmp_file_stream(Enc, File, Stream) :-
 1325    atom(Enc), var(File), var(Stream),
 1326    !,
 1327    '$tmp_file_stream'('', Enc, File, Stream).
 1328tmp_file_stream(File, Stream, Options) :-
 1329    current_prolog_flag(encoding, DefEnc),
 1330    '$option'(encoding(Enc), Options, DefEnc),
 1331    '$option'(extension(Ext), Options, ''),
 1332    '$tmp_file_stream'(Ext, Enc, File, Stream),
 1333    set_stream(Stream, file_name(File)).
 1334
 1335
 1336                /********************************
 1337                *        MEMORY MANAGEMENT      *
 1338                *********************************/
 1339
 1340%!  garbage_collect is det.
 1341%
 1342%   Invoke the garbage collector.  The   argument  of the underlying
 1343%   '$garbage_collect'/1  is  the  debugging  level  to  use  during
 1344%   garbage collection. This only works if   the  system is compiled
 1345%   with the -DODEBUG cpp flag. Only to simplify maintenance.
 1346
 1347garbage_collect :-
 1348    '$garbage_collect'(0).
 1349
 1350%!  set_prolog_stack(+Name, +Option) is det.
 1351%
 1352%   Set a parameter for one of the Prolog stacks.
 1353
 1354set_prolog_stack(Stack, Option) :-
 1355    Option =.. [Name,Value0],
 1356    Value is Value0,
 1357    '$set_prolog_stack'(Stack, Name, _Old, Value).
 1358
 1359%!  prolog_stack_property(?Stack, ?Property) is nondet.
 1360%
 1361%   Examine stack properties.
 1362
 1363prolog_stack_property(Stack, Property) :-
 1364    stack_property(P),
 1365    stack_name(Stack),
 1366    Property =.. [P,Value],
 1367    '$set_prolog_stack'(Stack, P, Value, Value).
 1368
 1369stack_name(local).
 1370stack_name(global).
 1371stack_name(trail).
 1372
 1373stack_property(limit).
 1374stack_property(spare).
 1375stack_property(min_free).
 1376stack_property(low).
 1377stack_property(factor).
 1378
 1379
 1380		 /*******************************
 1381		 *            CLAUSE		*
 1382		 *******************************/
 1383
 1384%!  rule(:Head, -Rule) is nondet.
 1385%!  rule(:Head, -Rule, Ref) is nondet.
 1386%
 1387%   Similar to clause/2,3. but deals with clauses   that do not use `:-`
 1388%   as _neck_.
 1389
 1390rule(Head, Rule) :-
 1391    '$rule'(Head, Rule0),
 1392    conditional_rule(Rule0, Rule1),
 1393    Rule = Rule1.
 1394rule(Head, Rule, Ref) :-
 1395    '$rule'(Head, Rule0, Ref),
 1396    conditional_rule(Rule0, Rule1),
 1397    Rule = Rule1.
 1398
 1399conditional_rule(?=>(Head, (!, Body)), Rule) =>
 1400    Rule = (Head => Body).
 1401conditional_rule(?=>(Head, !), Rule) =>
 1402    Rule = (Head => true).
 1403conditional_rule(?=>(Head, Body0), Rule),
 1404    split_on_cut(Body0, Cond, Body) =>
 1405    Rule = (Head,Cond=>Body).
 1406conditional_rule(Head, Rule) =>
 1407    Rule = Head.
 1408
 1409split_on_cut((Cond0,!,Body0), Cond, Body) =>
 1410    Cond = Cond0,
 1411    Body = Body0.
 1412split_on_cut((!,Body0), Cond, Body) =>
 1413    Cond = true,
 1414    Body = Body0.
 1415split_on_cut((A,B), Cond, Body) =>
 1416    Cond = (A,Cond1),
 1417    split_on_cut(B, Cond1, Body).
 1418split_on_cut(_, _, _) =>
 1419    fail.
 1420
 1421
 1422                 /*******************************
 1423                 *             TERM             *
 1424                 *******************************/
 1425
 1426:- '$iso'((numbervars/3)). 1427
 1428%!  numbervars(+Term, +StartIndex, -EndIndex) is det.
 1429%
 1430%   Number all unbound variables in Term   using  '$VAR'(N), where the
 1431%   first N is StartIndex and EndIndex is  unified to the index that
 1432%   will be given to the next variable.
 1433
 1434numbervars(Term, From, To) :-
 1435    numbervars(Term, From, To, []).
 1436
 1437
 1438                 /*******************************
 1439                 *            STRING            *
 1440                 *******************************/
 1441
 1442%!  term_string(?Term, ?String, +Options)
 1443%
 1444%   Parse/write a term from/to a string using Options.
 1445
 1446term_string(Term, String, Options) :-
 1447    nonvar(String),
 1448    !,
 1449    read_term_from_atom(String, Term, Options).
 1450term_string(Term, String, Options) :-
 1451    (   '$option'(quoted(_), Options)
 1452    ->  Options1 = Options
 1453    ;   '$merge_options'(_{quoted:true}, Options, Options1)
 1454    ),
 1455    format(string(String), '~W', [Term, Options1]).
 1456
 1457
 1458                 /*******************************
 1459                 *             GVAR             *
 1460                 *******************************/
 1461
 1462%!  nb_setval(+Name, +Value) is det.
 1463%
 1464%   Bind the non-backtrackable variable Name with a copy of Value
 1465
 1466nb_setval(Name, Value) :-
 1467    duplicate_term(Value, Copy),
 1468    nb_linkval(Name, Copy).
 1469
 1470
 1471		 /*******************************
 1472		 *            THREADS		*
 1473		 *******************************/
 1474
 1475:- meta_predicate
 1476    thread_create(0, -). 1477
 1478%!  thread_create(:Goal, -Id)
 1479%
 1480%   Shorthand for thread_create(Goal, Id, []).
 1481
 1482thread_create(Goal, Id) :-
 1483    thread_create(Goal, Id, []).
 1484
 1485%!  thread_join(+Id)
 1486%
 1487%   Join a thread and raise an error of the thread did not succeed.
 1488%
 1489%   @error  thread_error(Status),  where  Status  is    the   result  of
 1490%   thread_join/2.
 1491
 1492thread_join(Id) :-
 1493    thread_join(Id, Status),
 1494    (   Status == true
 1495    ->  true
 1496    ;   throw(error(thread_error(Id, Status), _))
 1497    ).
 1498
 1499%!  sig_block(:Pattern) is det.
 1500%
 1501%   Block thread signals that unify with Pattern.
 1502
 1503%!  sig_unblock(:Pattern) is det.
 1504%
 1505%   Remove any signal block that is more specific than Pattern.
 1506
 1507sig_block(Pattern) :-
 1508    (   nb_current('$sig_blocked', List)
 1509    ->  true
 1510    ;   List = []
 1511    ),
 1512    nb_setval('$sig_blocked', [Pattern|List]).
 1513
 1514sig_unblock(Pattern) :-
 1515    (   nb_current('$sig_blocked', List)
 1516    ->  unblock(List, Pattern, NewList),
 1517        (   List == NewList
 1518        ->  true
 1519        ;   nb_setval('$sig_blocked', NewList),
 1520            '$sig_unblock'
 1521        )
 1522    ;   true
 1523    ).
 1524
 1525unblock([], _, []).
 1526unblock([H|T], P, List) :-
 1527    (   subsumes_term(P, H)
 1528    ->  unblock(T, P, List)
 1529    ;   List = [H|T1],
 1530        unblock(T, P, T1)
 1531    ).
 1532
 1533:- public signal_is_blocked/1.          % called by signal_is_blocked()
 1534
 1535signal_is_blocked(Head) :-
 1536    nb_current('$sig_blocked', List),
 1537    '$member'(Head, List),
 1538    !.
 1539
 1540%!  set_prolog_gc_thread(+Status)
 1541%
 1542%   Control the GC thread.  Status is one of
 1543%
 1544%     - false
 1545%     Disable the separate GC thread, running atom and clause
 1546%     garbage collection in the triggering thread.
 1547%     - true
 1548%     Enable the separate GC thread.  All implicit atom and clause
 1549%     garbage collection is executed by the thread `gc`.
 1550%     - stop
 1551%     Stop the `gc` thread if it is running.  The thread is recreated
 1552%     on the next implicit atom or clause garbage collection.  Used
 1553%     by fork/1 to avoid forking a multi-threaded application.
 1554
 1555set_prolog_gc_thread(Status) :-
 1556    var(Status),
 1557    !,
 1558    '$instantiation_error'(Status).
 1559set_prolog_gc_thread(false) :-
 1560    !,
 1561    set_prolog_flag(gc_thread, false),
 1562    (   current_prolog_flag(threads, true)
 1563    ->  (   '$gc_stop'
 1564        ->  thread_join(gc)
 1565        ;   true
 1566        )
 1567    ;   true
 1568    ).
 1569set_prolog_gc_thread(true) :-
 1570    !,
 1571    set_prolog_flag(gc_thread, true).
 1572set_prolog_gc_thread(stop) :-
 1573    !,
 1574    (   current_prolog_flag(threads, true)
 1575    ->  (   '$gc_stop'
 1576        ->  thread_join(gc)
 1577        ;   true
 1578        )
 1579    ;   true
 1580    ).
 1581set_prolog_gc_thread(Status) :-
 1582    '$domain_error'(gc_thread, Status).
 1583
 1584%!  transaction(:Goal).
 1585%!  transaction(:Goal, +Options).
 1586%!  transaction(:Goal, :Constraint, +Mutex).
 1587%!  snapshot(:Goal).
 1588%
 1589%   Wrappers to guarantee clean Module:Goal terms.
 1590
 1591transaction(Goal) :-
 1592    '$transaction'(Goal, []).
 1593transaction(Goal, Options) :-
 1594    '$transaction'(Goal, Options).
 1595transaction(Goal, Constraint, Mutex) :-
 1596    '$transaction'(Goal, Constraint, Mutex).
 1597snapshot(Goal) :-
 1598    '$snapshot'(Goal).
 1599
 1600
 1601		 /*******************************
 1602		 *            UNDO		*
 1603		 *******************************/
 1604
 1605:- meta_predicate
 1606    undo(0). 1607
 1608%!  undo(:Goal)
 1609%
 1610%   Schedule Goal to be called when backtracking takes us back to
 1611%   before this call.
 1612
 1613undo(Goal) :-
 1614    '$undo'(Goal).
 1615
 1616:- public
 1617    '$run_undo'/1. 1618
 1619'$run_undo'([One]) :-
 1620    !,
 1621    call(One).
 1622'$run_undo'(List) :-
 1623    run_undo(List, _, Error),
 1624    (   var(Error)
 1625    ->  true
 1626    ;   throw(Error)
 1627    ).
 1628
 1629run_undo([], E, E).
 1630run_undo([H|T], E0, E) :-
 1631    (   catch(H, E1, true)
 1632    ->  (   var(E1)
 1633        ->  true
 1634        ;   '$urgent_exception'(E0, E1, E2)
 1635        )
 1636    ;   true
 1637    ),
 1638    run_undo(T, E2, E).
 1639
 1640
 1641%!  '$wrap_predicate'(:Head, +Name, -Closure, -Wrapped, +Body) is det.
 1642%
 1643%   Would be nicer to have this   from library(prolog_wrap), but we need
 1644%   it for tabling, so it must be a system predicate.
 1645
 1646:- meta_predicate
 1647    '$wrap_predicate'(:, +, -, -, +). 1648
 1649'$wrap_predicate'(M:Head, WName, Closure, call(Wrapped), Body) :-
 1650    callable_name_arguments(Head, PName, Args),
 1651    callable_name_arity(Head, PName, Arity),
 1652    (   is_most_general_term(Head)
 1653    ->  true
 1654    ;   '$domain_error'(most_general_term, Head)
 1655    ),
 1656    atomic_list_concat(['$wrap$', PName], WrapName),
 1657    volatile(M:WrapName/Arity),
 1658    module_transparent(M:WrapName/Arity),
 1659    WHead =.. [WrapName|Args],
 1660    '$c_wrap_predicate'(M:Head, WName, Closure, Wrapped, M:(WHead :- Body)).
 1661
 1662callable_name_arguments(Head, PName, Args) :-
 1663    atom(Head),
 1664    !,
 1665    PName = Head,
 1666    Args = [].
 1667callable_name_arguments(Head, PName, Args) :-
 1668    compound_name_arguments(Head, PName, Args).
 1669
 1670callable_name_arity(Head, PName, Arity) :-
 1671    atom(Head),
 1672    !,
 1673    PName = Head,
 1674    Arity = 0.
 1675callable_name_arity(Head, PName, Arity) :-
 1676    compound_name_arity(Head, PName, Arity)