1/*  Part of SWI-Prolog
    2
    3    Author:        Jan Wielemaker
    4    E-mail:        J.Wielemaker@vu.nl
    5    WWW:           http://www.swi-prolog.org
    6    Copyright (c)  1985-2021, University of Amsterdam
    7                              VU University Amsterdam
    8                              CWI, Amsterdam
    9                              SWI-Prolog Solutions b.v.
   10    All rights reserved.
   11
   12    Redistribution and use in source and binary forms, with or without
   13    modification, are permitted provided that the following conditions
   14    are met:
   15
   16    1. Redistributions of source code must retain the above copyright
   17       notice, this list of conditions and the following disclaimer.
   18
   19    2. Redistributions in binary form must reproduce the above copyright
   20       notice, this list of conditions and the following disclaimer in
   21       the documentation and/or other materials provided with the
   22       distribution.
   23
   24    THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
   25    "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
   26    LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS
   27    FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE
   28    COPYRIGHT OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT,
   29    INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING,
   30    BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES;
   31    LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER
   32    CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
   33    LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN
   34    ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
   35    POSSIBILITY OF SUCH DAMAGE.
   36*/
   37
   38:- module('$syspreds',
   39          [ leash/1,
   40            visible/1,
   41            style_check/1,
   42            (spy)/1,
   43            (nospy)/1,
   44            nospyall/0,
   45            debugging/0,
   46            flag/3,
   47            atom_prefix/2,
   48            dwim_match/2,
   49            source_file_property/2,
   50            source_file/1,
   51            source_file/2,
   52            unload_file/1,
   53            exists_source/1,                    % +Spec
   54            exists_source/2,                    % +Spec, -Path
   55            use_foreign_library/1,		% :FileSpec
   56            use_foreign_library/2,		% :FileSpec, +Install
   57            prolog_load_context/2,
   58            stream_position_data/3,
   59            current_predicate/2,
   60            '$defined_predicate'/1,
   61            predicate_property/2,
   62            '$predicate_property'/2,
   63            (dynamic)/2,                        % :Predicates, +Options
   64            clause_property/2,
   65            current_module/1,                   % ?Module
   66            module_property/2,                  % ?Module, ?Property
   67            module/1,                           % +Module
   68            current_trie/1,                     % ?Trie
   69            trie_property/2,                    % ?Trie, ?Property
   70            working_directory/2,                % -OldDir, +NewDir
   71            shell/1,                            % +Command
   72            on_signal/3,
   73            current_signal/3,
   74            open_shared_object/2,
   75            open_shared_object/3,
   76            format/1,
   77            garbage_collect/0,
   78            set_prolog_stack/2,
   79            prolog_stack_property/2,
   80            absolute_file_name/2,
   81            tmp_file_stream/3,                  % +Enc, -File, -Stream
   82            call_with_depth_limit/3,            % :Goal, +Limit, -Result
   83            call_with_inference_limit/3,        % :Goal, +Limit, -Result
   84            rule/2,                             % :Head, -Rule
   85            rule/3,                             % :Head, -Rule, ?Ref
   86            numbervars/3,                       % +Term, +Start, -End
   87            term_string/3,                      % ?Term, ?String, +Options
   88            nb_setval/2,                        % +Var, +Value
   89            thread_create/2,                    % :Goal, -Id
   90            thread_join/1,                      % +Id
   91            transaction/1,                      % :Goal
   92            transaction/2,                      % :Goal, +Options
   93            transaction/3,                      % :Goal, :Constraint, +Mutex
   94            snapshot/1,                         % :Goal
   95            set_prolog_gc_thread/1,		% +Status
   96
   97            '$wrap_predicate'/5                 % :Head, +Name, -Closure, -Wrapped, +Body
   98          ]).   99
  100:- meta_predicate
  101    dynamic(:, +),
  102    use_foreign_library(:),
  103    use_foreign_library(:, +),
  104    transaction(0),
  105    transaction(0,0,+),
  106    snapshot(0),
  107    rule(:, -),
  108    rule(:, -, ?).  109
  110
  111                /********************************
  112                *           DEBUGGER            *
  113                *********************************/
  114
  115%!  map_bits(:Pred, +Modify, +OldBits, -NewBits)
  116
  117:- meta_predicate
  118    map_bits(2, +, +, -).  119
  120map_bits(_, Var, _, _) :-
  121    var(Var),
  122    !,
  123    '$instantiation_error'(Var).
  124map_bits(_, [], Bits, Bits) :- !.
  125map_bits(Pred, [H|T], Old, New) :-
  126    map_bits(Pred, H, Old, New0),
  127    map_bits(Pred, T, New0, New).
  128map_bits(Pred, +Name, Old, New) :-     % set a bit
  129    !,
  130    bit(Pred, Name, Bits),
  131    !,
  132    New is Old \/ Bits.
  133map_bits(Pred, -Name, Old, New) :-     % clear a bit
  134    !,
  135    bit(Pred, Name, Bits),
  136    !,
  137    New is Old /\ (\Bits).
  138map_bits(Pred, ?(Name), Old, Old) :-   % ask a bit
  139    !,
  140    bit(Pred, Name, Bits),
  141    Old /\ Bits > 0.
  142map_bits(_, Term, _, _) :-
  143    '$type_error'('+|-|?(Flag)', Term).
  144
  145bit(Pred, Name, Bits) :-
  146    call(Pred, Name, Bits),
  147    !.
  148bit(_:Pred, Name, _) :-
  149    '$domain_error'(Pred, Name).
  150
  151:- public port_name/2.                  % used by library(test_cover)
  152
  153port_name(      call, 2'000000001).
  154port_name(      exit, 2'000000010).
  155port_name(      fail, 2'000000100).
  156port_name(      redo, 2'000001000).
  157port_name(     unify, 2'000010000).
  158port_name(     break, 2'000100000).
  159port_name(  cut_call, 2'001000000).
  160port_name(  cut_exit, 2'010000000).
  161port_name( exception, 2'100000000).
  162port_name(       cut, 2'011000000).
  163port_name(       all, 2'000111111).
  164port_name(      full, 2'000101111).
  165port_name(      half, 2'000101101).     % '
  166
  167leash(Ports) :-
  168    '$leash'(Old, Old),
  169    map_bits(port_name, Ports, Old, New),
  170    '$leash'(_, New).
  171
  172visible(Ports) :-
  173    '$visible'(Old, Old),
  174    map_bits(port_name, Ports, Old, New),
  175    '$visible'(_, New).
  176
  177style_name(atom,            0x0001) :-
  178    print_message(warning, decl_no_effect(style_check(atom))).
  179style_name(singleton,       0x0042).            % semantic and syntactic
  180style_name(discontiguous,   0x0008).
  181style_name(charset,         0x0020).
  182style_name(no_effect,       0x0080).
  183style_name(var_branches,    0x0100).
  184
  185%!  style_check(+Spec) is nondet.
  186
  187style_check(Var) :-
  188    var(Var),
  189    !,
  190    '$instantiation_error'(Var).
  191style_check(?(Style)) :-
  192    !,
  193    (   var(Style)
  194    ->  enum_style_check(Style)
  195    ;   enum_style_check(Style)
  196    ->  true
  197    ).
  198style_check(Spec) :-
  199    '$style_check'(Old, Old),
  200    map_bits(style_name, Spec, Old, New),
  201    '$style_check'(_, New).
  202
  203enum_style_check(Style) :-
  204    '$style_check'(Bits, Bits),
  205    style_name(Style, Bit),
  206    Bit /\ Bits =\= 0.
  207
  208
  209%!  prolog:debug_control_hook(+Action)
  210%
  211%   Allow user-hooks in the Prolog debugger interaction.  See the calls
  212%   below for the provided hooks.  We use a single predicate with action
  213%   argument to avoid an uncontrolled poliferation of hooks.
  214
  215:- multifile
  216    prolog:debug_control_hook/1.    % +Action
  217
  218:- meta_predicate
  219    spy(:),
  220    nospy(:).  221
  222%!  spy(:Spec) is det.
  223%!  nospy(:Spec) is det.
  224%!  nospyall is det.
  225%
  226%   Set/clear spy-points. A successfully set or cleared spy-point is
  227%   reported using print_message/2, level  =informational=, with one
  228%   of the following terms, where Spec is of the form M:Head.
  229%
  230%       - spy(Spec)
  231%       - nospy(Spec)
  232%
  233%   @see    spy/1 and nospy/1 call the hook prolog:debug_control_hook/1
  234%           to allow for alternative specifications of the thing to
  235%           debug.
  236
  237spy(_:X) :-
  238    var(X),
  239    throw(error(instantiation_error, _)).
  240spy(_:[]) :- !.
  241spy(M:[H|T]) :-
  242    !,
  243    spy(M:H),
  244    spy(M:T).
  245spy(Spec) :-
  246    notrace(prolog:debug_control_hook(spy(Spec))),
  247    !.
  248spy(Spec) :-
  249    '$find_predicate'(Spec, Preds),
  250    '$member'(PI, Preds),
  251        pi_to_head(PI, Head),
  252        '$define_predicate'(Head),
  253        '$spy'(Head),
  254    fail.
  255spy(_).
  256
  257nospy(_:X) :-
  258    var(X),
  259    throw(error(instantiation_error, _)).
  260nospy(_:[]) :- !.
  261nospy(M:[H|T]) :-
  262    !,
  263    nospy(M:H),
  264    nospy(M:T).
  265nospy(Spec) :-
  266    notrace(prolog:debug_control_hook(nospy(Spec))),
  267    !.
  268nospy(Spec) :-
  269    '$find_predicate'(Spec, Preds),
  270    '$member'(PI, Preds),
  271         pi_to_head(PI, Head),
  272        '$nospy'(Head),
  273    fail.
  274nospy(_).
  275
  276nospyall :-
  277    notrace(prolog:debug_control_hook(nospyall)),
  278    fail.
  279nospyall :-
  280    spy_point(Head),
  281        '$nospy'(Head),
  282    fail.
  283nospyall.
  284
  285pi_to_head(M:PI, M:Head) :-
  286    !,
  287    pi_to_head(PI, Head).
  288pi_to_head(Name/Arity, Head) :-
  289    functor(Head, Name, Arity).
  290
  291%!  debugging is det.
  292%
  293%   Report current status of the debugger.
  294
  295debugging :-
  296    notrace(prolog:debug_control_hook(debugging)),
  297    !.
  298debugging :-
  299    current_prolog_flag(debug, true),
  300    !,
  301    print_message(informational, debugging(on)),
  302    findall(H, spy_point(H), SpyPoints),
  303    print_message(informational, spying(SpyPoints)).
  304debugging :-
  305    print_message(informational, debugging(off)).
  306
  307spy_point(Module:Head) :-
  308    current_predicate(_, Module:Head),
  309    '$get_predicate_attribute'(Module:Head, spy, 1),
  310    \+ predicate_property(Module:Head, imported_from(_)).
  311
  312%!  flag(+Name, -Old, +New) is det.
  313%
  314%   True when Old is the current value associated with the flag Name
  315%   and New has become the new value.
  316
  317flag(Name, Old, New) :-
  318    Old == New,
  319    !,
  320    get_flag(Name, Old).
  321flag(Name, Old, New) :-
  322    with_mutex('$flag', update_flag(Name, Old, New)).
  323
  324update_flag(Name, Old, New) :-
  325    get_flag(Name, Old),
  326    (   atom(New)
  327    ->  set_flag(Name, New)
  328    ;   Value is New,
  329        set_flag(Name, Value)
  330    ).
  331
  332
  333                /********************************
  334                *             ATOMS             *
  335                *********************************/
  336
  337dwim_match(A1, A2) :-
  338    dwim_match(A1, A2, _).
  339
  340atom_prefix(Atom, Prefix) :-
  341    sub_atom(Atom, 0, _, _, Prefix).
  342
  343
  344                /********************************
  345                *             SOURCE            *
  346                *********************************/
  347
  348%!  source_file(-File) is nondet.
  349%!  source_file(+File) is semidet.
  350%
  351%   True if File is loaded into  Prolog.   If  File is unbound it is
  352%   bound to the canonical name for it. If File is bound it succeeds
  353%   if the canonical name  as   defined  by  absolute_file_name/2 is
  354%   known as a loaded filename.
  355%
  356%   Note that Time = 0.0 is used by  PlDoc and other code that needs
  357%   to create a file record without being interested in the time.
  358
  359source_file(File) :-
  360    (   current_prolog_flag(access_level, user)
  361    ->  Level = user
  362    ;   true
  363    ),
  364    (   ground(File)
  365    ->  (   '$time_source_file'(File, Time, Level)
  366        ;   absolute_file_name(File, Abs),
  367            '$time_source_file'(Abs, Time, Level)
  368        ), !
  369    ;   '$time_source_file'(File, Time, Level)
  370    ),
  371    Time > 0.0.
  372
  373%!  source_file(+Head, -File) is semidet.
  374%!  source_file(?Head, ?File) is nondet.
  375%
  376%   True when Head is a predicate owned by File.
  377
  378:- meta_predicate source_file(:, ?).  379
  380source_file(M:Head, File) :-
  381    nonvar(M), nonvar(Head),
  382    !,
  383    (   '$c_current_predicate'(_, M:Head),
  384        predicate_property(M:Head, multifile)
  385    ->  multi_source_files(M:Head, Files),
  386        '$member'(File, Files)
  387    ;   '$source_file'(M:Head, File)
  388    ).
  389source_file(M:Head, File) :-
  390    (   nonvar(File)
  391    ->  true
  392    ;   source_file(File)
  393    ),
  394    '$source_file_predicates'(File, Predicates),
  395    '$member'(M:Head, Predicates).
  396
  397:- thread_local found_src_file/1.  398
  399multi_source_files(Head, Files) :-
  400    call_cleanup(
  401        findall(File, multi_source_file(Head, File), Files),
  402        retractall(found_src_file(_))).
  403
  404multi_source_file(Head, File) :-
  405    nth_clause(Head, _, Clause),
  406    clause_property(Clause, source(File)),
  407    \+ found_src_file(File),
  408    asserta(found_src_file(File)).
  409
  410
  411%!  source_file_property(?File, ?Property) is nondet.
  412%
  413%   True if Property is a property of the loaded source-file File.
  414
  415source_file_property(File, P) :-
  416    nonvar(File),
  417    !,
  418    canonical_source_file(File, Path),
  419    property_source_file(P, Path).
  420source_file_property(File, P) :-
  421    property_source_file(P, File).
  422
  423property_source_file(modified(Time), File) :-
  424    '$time_source_file'(File, Time, user).
  425property_source_file(source(Source), File) :-
  426    (   '$source_file_property'(File, from_state, true)
  427    ->  Source = state
  428    ;   '$source_file_property'(File, resource, true)
  429    ->  Source = resource
  430    ;   Source = file
  431    ).
  432property_source_file(module(M), File) :-
  433    (   nonvar(M)
  434    ->  '$current_module'(M, File)
  435    ;   nonvar(File)
  436    ->  '$current_module'(ML, File),
  437        (   atom(ML)
  438        ->  M = ML
  439        ;   '$member'(M, ML)
  440        )
  441    ;   '$current_module'(M, File)
  442    ).
  443property_source_file(load_context(Module, Location, Options), File) :-
  444    '$time_source_file'(File, _, user),
  445    clause(system:'$load_context_module'(File, Module, Options), true, Ref),
  446    (   clause_property(Ref, file(FromFile)),
  447        clause_property(Ref, line_count(FromLine))
  448    ->  Location = FromFile:FromLine
  449    ;   Location = user
  450    ).
  451property_source_file(includes(Master, Stamp), File) :-
  452    system:'$included'(File, _Line, Master, Stamp).
  453property_source_file(included_in(Master, Line), File) :-
  454    system:'$included'(Master, Line, File, _).
  455property_source_file(derived_from(DerivedFrom, Stamp), File) :-
  456    system:'$derived_source'(File, DerivedFrom, Stamp).
  457property_source_file(reloading, File) :-
  458    source_file(File),
  459    '$source_file_property'(File, reloading, true).
  460property_source_file(load_count(Count), File) :-
  461    source_file(File),
  462    '$source_file_property'(File, load_count, Count).
  463property_source_file(number_of_clauses(Count), File) :-
  464    source_file(File),
  465    '$source_file_property'(File, number_of_clauses, Count).
  466
  467
  468%!  canonical_source_file(+Spec, -File) is semidet.
  469%
  470%   File is the canonical representation of the source-file Spec.
  471
  472canonical_source_file(Spec, File) :-
  473    atom(Spec),
  474    '$time_source_file'(Spec, _, _),
  475    !,
  476    File = Spec.
  477canonical_source_file(Spec, File) :-
  478    system:'$included'(_Master, _Line, Spec, _),
  479    !,
  480    File = Spec.
  481canonical_source_file(Spec, File) :-
  482    absolute_file_name(Spec,
  483                       [ file_type(prolog),
  484                         access(read),
  485                         file_errors(fail)
  486                       ],
  487                       File),
  488    source_file(File).
  489
  490
  491%!  exists_source(+Source) is semidet.
  492%!  exists_source(+Source, -Path) is semidet.
  493%
  494%   True if Source (a term  valid   for  load_files/2) exists. Fails
  495%   without error if this is not the case. The predicate is intended
  496%   to be used with  :-  if,  as   in  the  example  below. See also
  497%   source_exports/2.
  498%
  499%   ```
  500%   :- if(exists_source(library(error))).
  501%   :- use_module_library(error).
  502%   :- endif.
  503%   ```
  504
  505exists_source(Source) :-
  506    exists_source(Source, _Path).
  507
  508exists_source(Source, Path) :-
  509    absolute_file_name(Source, Path,
  510                       [ file_type(prolog),
  511                         access(read),
  512                         file_errors(fail)
  513                       ]).
  514
  515
  516%!  prolog_load_context(+Key, -Value)
  517%
  518%   Provides context information for  term_expansion and directives.
  519%   Note  that  only  the  line-number  info    is   valid  for  the
  520%   '$stream_position'. Largely Quintus compatible.
  521
  522prolog_load_context(module, Module) :-
  523    '$current_source_module'(Module).
  524prolog_load_context(file, File) :-
  525    input_file(File).
  526prolog_load_context(source, F) :-       % SICStus compatibility
  527    input_file(F0),
  528    '$input_context'(Context),
  529    '$top_file'(Context, F0, F).
  530prolog_load_context(stream, S) :-
  531    (   system:'$load_input'(_, S0)
  532    ->  S = S0
  533    ).
  534prolog_load_context(directory, D) :-
  535    input_file(F),
  536    file_directory_name(F, D).
  537prolog_load_context(dialect, D) :-
  538    current_prolog_flag(emulated_dialect, D).
  539prolog_load_context(term_position, TermPos) :-
  540    source_location(_, L),
  541    (   nb_current('$term_position', Pos),
  542        compound(Pos),              % actually set
  543        stream_position_data(line_count, Pos, L)
  544    ->  TermPos = Pos
  545    ;   TermPos = '$stream_position'(0,L,0,0)
  546    ).
  547prolog_load_context(script, Bool) :-
  548    (   '$toplevel':loaded_init_file(script, Path),
  549        input_file(File),
  550        same_file(File, Path)
  551    ->  Bool = true
  552    ;   Bool = false
  553    ).
  554prolog_load_context(variable_names, Bindings) :-
  555    nb_current('$variable_names', Bindings).
  556prolog_load_context(term, Term) :-
  557    nb_current('$term', Term).
  558prolog_load_context(reloading, true) :-
  559    prolog_load_context(source, F),
  560    '$source_file_property'(F, reloading, true).
  561
  562input_file(File) :-
  563    (   system:'$load_input'(_, Stream)
  564    ->  stream_property(Stream, file_name(File))
  565    ),
  566    !.
  567input_file(File) :-
  568    source_location(File, _).
  569
  570
  571%!  unload_file(+File) is det.
  572%
  573%   Remove all traces of loading file.
  574
  575:- dynamic system:'$resolved_source_path'/2.  576
  577unload_file(File) :-
  578    (   canonical_source_file(File, Path)
  579    ->  '$unload_file'(Path),
  580        retractall(system:'$resolved_source_path'(_, Path))
  581    ;   true
  582    ).
  583
  584		 /*******************************
  585		 *      FOREIGN LIBRARIES	*
  586		 *******************************/
  587
  588%!  use_foreign_library(+FileSpec) is det.
  589%!  use_foreign_library(+FileSpec, +Entry:atom) is det.
  590%
  591%   Load and install a foreign   library as load_foreign_library/1,2
  592%   and register the installation using   initialization/2  with the
  593%   option =now=. This is similar to using:
  594%
  595%     ==
  596%     :- initialization(load_foreign_library(foreign(mylib))).
  597%     ==
  598%
  599%   but using the initialization/1 wrapper causes  the library to be
  600%   loaded _after_ loading of  the  file   in  which  it  appears is
  601%   completed,  while  use_foreign_library/1  loads    the   library
  602%   _immediately_. I.e. the  difference  is   only  relevant  if the
  603%   remainder of the file uses functionality of the C-library.
  604
  605use_foreign_library(FileSpec) :-
  606    ensure_shlib,
  607    initialization(shlib:load_foreign_library(FileSpec), now).
  608
  609use_foreign_library(FileSpec, Entry) :-
  610    ensure_shlib,
  611    initialization(shlib:load_foreign_library(FileSpec, Entry), now).
  612
  613ensure_shlib :-
  614    '$get_predicate_attribute'(shlib:load_foreign_library(_), defined, 1),
  615    '$get_predicate_attribute'(shlib:load_foreign_library(_,_), defined, 1),
  616    !.
  617ensure_shlib :-
  618    use_module(library(shlib), []).
  619
  620
  621                 /*******************************
  622                 *            STREAMS           *
  623                 *******************************/
  624
  625%!  stream_position_data(?Field, +Pos, ?Date)
  626%
  627%   Extract values from stream position objects. '$stream_position' is
  628%   of the format '$stream_position'(Byte, Char, Line, LinePos)
  629
  630stream_position_data(Prop, Term, Value) :-
  631    nonvar(Prop),
  632    !,
  633    (   stream_position_field(Prop, Pos)
  634    ->  arg(Pos, Term, Value)
  635    ;   throw(error(domain_error(stream_position_data, Prop)))
  636    ).
  637stream_position_data(Prop, Term, Value) :-
  638    stream_position_field(Prop, Pos),
  639    arg(Pos, Term, Value).
  640
  641stream_position_field(char_count,    1).
  642stream_position_field(line_count,    2).
  643stream_position_field(line_position, 3).
  644stream_position_field(byte_count,    4).
  645
  646
  647                 /*******************************
  648                 *            CONTROL           *
  649                 *******************************/
  650
  651%!  call_with_depth_limit(:Goal, +DepthLimit, -Result)
  652%
  653%   Try to proof Goal, but fail on any branch exceeding the indicated
  654%   depth-limit.  Unify Result with the maximum-reached limit on success,
  655%   depth_limit_exceeded if the limit was exceeded and fails otherwise.
  656
  657:- meta_predicate
  658    call_with_depth_limit(0, +, -).  659
  660call_with_depth_limit(G, Limit, Result) :-
  661    '$depth_limit'(Limit, OLimit, OReached),
  662    (   catch(G, E, '$depth_limit_except'(OLimit, OReached, E)),
  663        '$depth_limit_true'(Limit, OLimit, OReached, Result, Det),
  664        ( Det == ! -> ! ; true )
  665    ;   '$depth_limit_false'(OLimit, OReached, Result)
  666    ).
  667
  668%!  call_with_inference_limit(:Goal, +InferenceLimit, -Result)
  669%
  670%   Equivalent to call(Goal),  but  poses  a   limit  on  the  number of
  671%   inferences. If this  limit  is  reached,   Result  is  unified  with
  672%   `inference_limit_exceeded`, otherwise Result is unified  with `!` if
  673%   Goal succeeded without a choicepoint and `true` otherwise.
  674%
  675%   Note that we perform calls in  system to avoid auto-importing, which
  676%   makes raiseInferenceLimitException() fail  to   recognise  that  the
  677%   exception happens in the overhead.
  678
  679:- meta_predicate
  680    call_with_inference_limit(0, +, -).  681
  682call_with_inference_limit(G, Limit, Result) :-
  683    '$inference_limit'(Limit, OLimit),
  684    (   catch(G, Except,
  685              system:'$inference_limit_except'(OLimit, Except, Result0)),
  686        (   Result0 == inference_limit_exceeded
  687        ->  !
  688        ;   system:'$inference_limit_true'(Limit, OLimit, Result0),
  689            ( Result0 == ! -> ! ; true )
  690        ),
  691        Result = Result0
  692    ;   system:'$inference_limit_false'(OLimit)
  693    ).
  694
  695
  696                /********************************
  697                *           DATA BASE           *
  698                *********************************/
  699
  700/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
  701The predicate current_predicate/2 is   a  difficult subject since  the
  702introduction  of defaulting     modules   and   dynamic     libraries.
  703current_predicate/2 is normally  called with instantiated arguments to
  704verify some  predicate can   be called without trapping   an undefined
  705predicate.  In this case we must  perform the search algorithm used by
  706the prolog system itself.
  707
  708If the pattern is not fully specified, we only generate the predicates
  709actually available in this  module.   This seems the best for listing,
  710etc.
  711- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
  712
  713
  714:- meta_predicate
  715    current_predicate(?, :),
  716    '$defined_predicate'(:).  717
  718current_predicate(Name, Module:Head) :-
  719    (var(Module) ; var(Head)),
  720    !,
  721    generate_current_predicate(Name, Module, Head).
  722current_predicate(Name, Term) :-
  723    '$c_current_predicate'(Name, Term),
  724    '$defined_predicate'(Term),
  725    !.
  726current_predicate(Name, Module:Head) :-
  727    default_module(Module, DefModule),
  728    '$c_current_predicate'(Name, DefModule:Head),
  729    '$defined_predicate'(DefModule:Head),
  730    !.
  731current_predicate(Name, Module:Head) :-
  732    '$autoload':autoload_in(Module, general),
  733    \+ current_prolog_flag(Module:unknown, fail),
  734    (   compound(Head)
  735    ->  compound_name_arity(Head, Name, Arity)
  736    ;   Name = Head, Arity = 0
  737    ),
  738    '$find_library'(Module, Name, Arity, _LoadModule, _Library),
  739    !.
  740
  741generate_current_predicate(Name, Module, Head) :-
  742    current_module(Module),
  743    QHead = Module:Head,
  744    '$c_current_predicate'(Name, QHead),
  745    '$get_predicate_attribute'(QHead, defined, 1).
  746
  747'$defined_predicate'(Head) :-
  748    '$get_predicate_attribute'(Head, defined, 1),
  749    !.
  750
  751%!  predicate_property(?Predicate, ?Property) is nondet.
  752%
  753%   True when Property is a property of Predicate.
  754
  755:- meta_predicate
  756    predicate_property(:, ?).  757
  758:- multifile
  759    '$predicate_property'/2.  760
  761:- '$iso'(predicate_property/2).  762
  763predicate_property(Pred, Property) :-           % Mode ?,+
  764    nonvar(Property),
  765    !,
  766    property_predicate(Property, Pred).
  767predicate_property(Pred, Property) :-           % Mode +,-
  768    define_or_generate(Pred),
  769    '$predicate_property'(Property, Pred).
  770
  771%!  property_predicate(+Property, ?Pred)
  772%
  773%   First handle the special  cases  that   are  not  about querying
  774%   normally  defined  predicates:   =undefined=,    =visible=   and
  775%   =autoload=, followed by the generic case.
  776
  777property_predicate(undefined, Pred) :-
  778    !,
  779    Pred = Module:Head,
  780    current_module(Module),
  781    '$c_current_predicate'(_, Pred),
  782    \+ '$defined_predicate'(Pred),          % Speed up a bit
  783    \+ current_predicate(_, Pred),
  784    goal_name_arity(Head, Name, Arity),
  785    \+ system_undefined(Module:Name/Arity).
  786property_predicate(visible, Pred) :-
  787    !,
  788    visible_predicate(Pred).
  789property_predicate(autoload(File), Head) :-
  790    !,
  791    \+ current_prolog_flag(autoload, false),
  792    '$autoload':autoloadable(Head, File).
  793property_predicate(implementation_module(IM), M:Head) :-
  794    !,
  795    atom(M),
  796    (   default_module(M, DM),
  797        '$get_predicate_attribute'(DM:Head, defined, 1)
  798    ->  (   '$get_predicate_attribute'(DM:Head, imported, ImportM)
  799        ->  IM = ImportM
  800        ;   IM = M
  801        )
  802    ;   \+ current_prolog_flag(M:unknown, fail),
  803        goal_name_arity(Head, Name, Arity),
  804        '$find_library'(_, Name, Arity, LoadModule, _File)
  805    ->  IM = LoadModule
  806    ;   M = IM
  807    ).
  808property_predicate(iso, _:Head) :-
  809    callable(Head),
  810    !,
  811    goal_name_arity(Head, Name, Arity),
  812    current_predicate(system:Name/Arity),
  813    '$predicate_property'(iso, system:Head).
  814property_predicate(built_in, Module:Head) :-
  815    callable(Head),
  816    !,
  817    goal_name_arity(Head, Name, Arity),
  818    current_predicate(Module:Name/Arity),
  819    '$predicate_property'(built_in, Module:Head).
  820property_predicate(Property, Pred) :-
  821    define_or_generate(Pred),
  822    '$predicate_property'(Property, Pred).
  823
  824goal_name_arity(Head, Name, Arity) :-
  825    compound(Head),
  826    !,
  827    compound_name_arity(Head, Name, Arity).
  828goal_name_arity(Head, Head, 0).
  829
  830
  831%!  define_or_generate(+Head) is semidet.
  832%!  define_or_generate(-Head) is nondet.
  833%
  834%   If the predicate is known, try to resolve it. Otherwise generate
  835%   the known predicate, but do not try to (auto)load the predicate.
  836
  837define_or_generate(M:Head) :-
  838    callable(Head),
  839    atom(M),
  840    '$get_predicate_attribute'(M:Head, defined, 1),
  841    !.
  842define_or_generate(M:Head) :-
  843    callable(Head),
  844    nonvar(M), M \== system,
  845    !,
  846    '$define_predicate'(M:Head).
  847define_or_generate(Pred) :-
  848    current_predicate(_, Pred),
  849    '$define_predicate'(Pred).
  850
  851
  852'$predicate_property'(interpreted, Pred) :-
  853    '$get_predicate_attribute'(Pred, foreign, 0).
  854'$predicate_property'(visible, Pred) :-
  855    '$get_predicate_attribute'(Pred, defined, 1).
  856'$predicate_property'(built_in, Pred) :-
  857    '$get_predicate_attribute'(Pred, system, 1).
  858'$predicate_property'(exported, Pred) :-
  859    '$get_predicate_attribute'(Pred, exported, 1).
  860'$predicate_property'(public, Pred) :-
  861    '$get_predicate_attribute'(Pred, public, 1).
  862'$predicate_property'(non_terminal, Pred) :-
  863    '$get_predicate_attribute'(Pred, non_terminal, 1).
  864'$predicate_property'(foreign, Pred) :-
  865    '$get_predicate_attribute'(Pred, foreign, 1).
  866'$predicate_property'((dynamic), Pred) :-
  867    '$get_predicate_attribute'(Pred, (dynamic), 1).
  868'$predicate_property'((static), Pred) :-
  869    '$get_predicate_attribute'(Pred, (dynamic), 0).
  870'$predicate_property'((volatile), Pred) :-
  871    '$get_predicate_attribute'(Pred, (volatile), 1).
  872'$predicate_property'((thread_local), Pred) :-
  873    '$get_predicate_attribute'(Pred, (thread_local), 1).
  874'$predicate_property'((multifile), Pred) :-
  875    '$get_predicate_attribute'(Pred, (multifile), 1).
  876'$predicate_property'(imported_from(Module), Pred) :-
  877    '$get_predicate_attribute'(Pred, imported, Module).
  878'$predicate_property'(transparent, Pred) :-
  879    '$get_predicate_attribute'(Pred, transparent, 1).
  880'$predicate_property'(meta_predicate(Pattern), Pred) :-
  881    '$get_predicate_attribute'(Pred, meta_predicate, Pattern).
  882'$predicate_property'(file(File), Pred) :-
  883    '$get_predicate_attribute'(Pred, file, File).
  884'$predicate_property'(line_count(LineNumber), Pred) :-
  885    '$get_predicate_attribute'(Pred, line_count, LineNumber).
  886'$predicate_property'(notrace, Pred) :-
  887    '$get_predicate_attribute'(Pred, trace, 0).
  888'$predicate_property'(nodebug, Pred) :-
  889    '$get_predicate_attribute'(Pred, hide_childs, 1).
  890'$predicate_property'(spying, Pred) :-
  891    '$get_predicate_attribute'(Pred, spy, 1).
  892'$predicate_property'(number_of_clauses(N), Pred) :-
  893    '$get_predicate_attribute'(Pred, number_of_clauses, N).
  894'$predicate_property'(number_of_rules(N), Pred) :-
  895    '$get_predicate_attribute'(Pred, number_of_rules, N).
  896'$predicate_property'(last_modified_generation(Gen), Pred) :-
  897    '$get_predicate_attribute'(Pred, last_modified_generation, Gen).
  898'$predicate_property'(indexed(Indices), Pred) :-
  899    '$get_predicate_attribute'(Pred, indexed, Indices).
  900'$predicate_property'(noprofile, Pred) :-
  901    '$get_predicate_attribute'(Pred, noprofile, 1).
  902'$predicate_property'(ssu, Pred) :-
  903    '$get_predicate_attribute'(Pred, ssu, 1).
  904'$predicate_property'(iso, Pred) :-
  905    '$get_predicate_attribute'(Pred, iso, 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(user:prolog_exception_hook/4).
  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            functor(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                 *            DLOPEN            *
 1294                 *******************************/
 1295
 1296%!  open_shared_object(+File, -Handle) is det.
 1297%!  open_shared_object(+File, -Handle, +Flags) is det.
 1298%
 1299%   Open a shared object or DLL file. Flags  is a list of flags. The
 1300%   following flags are recognised. Note   however  that these flags
 1301%   may have no affect on the target platform.
 1302%
 1303%       * =now=
 1304%       Resolve all symbols in the file now instead of lazily.
 1305%       * =global=
 1306%       Make new symbols globally known.
 1307
 1308open_shared_object(File, Handle) :-
 1309    open_shared_object(File, Handle, []). % use pl-load.c defaults
 1310
 1311open_shared_object(File, Handle, Flags) :-
 1312    (   is_list(Flags)
 1313    ->  true
 1314    ;   throw(error(type_error(list, Flags), _))
 1315    ),
 1316    map_dlflags(Flags, Mask),
 1317    '$open_shared_object'(File, Handle, Mask).
 1318
 1319dlopen_flag(now,        2'01).          % see pl-load.c for these constants
 1320dlopen_flag(global,     2'10).          % Solaris only
 1321
 1322map_dlflags([], 0).
 1323map_dlflags([F|T], M) :-
 1324    map_dlflags(T, M0),
 1325    (   dlopen_flag(F, I)
 1326    ->  true
 1327    ;   throw(error(domain_error(dlopen_flag, F), _))
 1328    ),
 1329    M is M0 \/ I.
 1330
 1331
 1332                 /*******************************
 1333                 *             I/O              *
 1334                 *******************************/
 1335
 1336format(Fmt) :-
 1337    format(Fmt, []).
 1338
 1339                 /*******************************
 1340                 *            FILES             *
 1341                 *******************************/
 1342
 1343%!  absolute_file_name(+Term, -AbsoluteFile)
 1344
 1345absolute_file_name(Name, Abs) :-
 1346    atomic(Name),
 1347    !,
 1348    '$absolute_file_name'(Name, Abs).
 1349absolute_file_name(Term, Abs) :-
 1350    '$chk_file'(Term, [''], [access(read)], true, File),
 1351    !,
 1352    '$absolute_file_name'(File, Abs).
 1353absolute_file_name(Term, Abs) :-
 1354    '$chk_file'(Term, [''], [], true, File),
 1355    !,
 1356    '$absolute_file_name'(File, Abs).
 1357
 1358%!  tmp_file_stream(-File, -Stream, +Options) is det.
 1359%!  tmp_file_stream(+Encoding, -File, -Stream) is det.
 1360%
 1361%   Create a temporary file and open it   atomically. The second mode is
 1362%   for compatibility reasons.
 1363
 1364tmp_file_stream(Enc, File, Stream) :-
 1365    atom(Enc), var(File), var(Stream),
 1366    !,
 1367    '$tmp_file_stream'('', Enc, File, Stream).
 1368tmp_file_stream(File, Stream, Options) :-
 1369    current_prolog_flag(encoding, DefEnc),
 1370    '$option'(encoding(Enc), Options, DefEnc),
 1371    '$option'(extension(Ext), Options, ''),
 1372    '$tmp_file_stream'(Ext, Enc, File, Stream),
 1373    set_stream(Stream, file_name(File)).
 1374
 1375
 1376                /********************************
 1377                *        MEMORY MANAGEMENT      *
 1378                *********************************/
 1379
 1380%!  garbage_collect is det.
 1381%
 1382%   Invoke the garbage collector.  The   argument  of the underlying
 1383%   '$garbage_collect'/1  is  the  debugging  level  to  use  during
 1384%   garbage collection. This only works if   the  system is compiled
 1385%   with the -DODEBUG cpp flag. Only to simplify maintenance.
 1386
 1387garbage_collect :-
 1388    '$garbage_collect'(0).
 1389
 1390%!  set_prolog_stack(+Name, +Option) is det.
 1391%
 1392%   Set a parameter for one of the Prolog stacks.
 1393
 1394set_prolog_stack(Stack, Option) :-
 1395    Option =.. [Name,Value0],
 1396    Value is Value0,
 1397    '$set_prolog_stack'(Stack, Name, _Old, Value).
 1398
 1399%!  prolog_stack_property(?Stack, ?Property) is nondet.
 1400%
 1401%   Examine stack properties.
 1402
 1403prolog_stack_property(Stack, Property) :-
 1404    stack_property(P),
 1405    stack_name(Stack),
 1406    Property =.. [P,Value],
 1407    '$set_prolog_stack'(Stack, P, Value, Value).
 1408
 1409stack_name(local).
 1410stack_name(global).
 1411stack_name(trail).
 1412
 1413stack_property(limit).
 1414stack_property(spare).
 1415stack_property(min_free).
 1416stack_property(low).
 1417stack_property(factor).
 1418
 1419
 1420		 /*******************************
 1421		 *            CLAUSE		*
 1422		 *******************************/
 1423
 1424%!  rule(:Head, -Rule) is nondet.
 1425%!  rule(:Head, -Rule, Ref) is nondet.
 1426%
 1427%   Similar to clause/2,3. but deals with clauses   that do not use `:-`
 1428%   as _neck_.
 1429
 1430rule(Head, Rule) :-
 1431    '$rule'(Head, Rule0),
 1432    conditional_rule(Rule0, Rule1),
 1433    Rule = Rule1.
 1434rule(Head, Rule, Ref) :-
 1435    '$rule'(Head, Rule0, Ref),
 1436    conditional_rule(Rule0, Rule1),
 1437    Rule = Rule1.
 1438
 1439conditional_rule(?=>(Head, Body0), (Head,Cond=>Body)) :-
 1440    split_on_cut(Body0, Cond, Body),
 1441    !.
 1442conditional_rule(Rule, Rule).
 1443
 1444split_on_cut(Var, _, _) :-
 1445    var(Var),
 1446    !,
 1447    fail.
 1448split_on_cut((Cond,!,Body), Cond, Body) :-
 1449    !.
 1450split_on_cut((A,B), (A,Cond), Body) :-
 1451    split_on_cut(B, Cond, Body).
 1452
 1453
 1454
 1455                 /*******************************
 1456                 *             TERM             *
 1457                 *******************************/
 1458
 1459:- '$iso'((numbervars/3)). 1460
 1461%!  numbervars(+Term, +StartIndex, -EndIndex) is det.
 1462%
 1463%   Number all unbound variables in Term   using  '$VAR'(N), where the
 1464%   first N is StartIndex and EndIndex is  unified to the index that
 1465%   will be given to the next variable.
 1466
 1467numbervars(Term, From, To) :-
 1468    numbervars(Term, From, To, []).
 1469
 1470
 1471                 /*******************************
 1472                 *            STRING            *
 1473                 *******************************/
 1474
 1475%!  term_string(?Term, ?String, +Options)
 1476%
 1477%   Parse/write a term from/to a string using Options.
 1478
 1479term_string(Term, String, Options) :-
 1480    nonvar(String),
 1481    !,
 1482    read_term_from_atom(String, Term, Options).
 1483term_string(Term, String, Options) :-
 1484    (   '$option'(quoted(_), Options)
 1485    ->  Options1 = Options
 1486    ;   '$merge_options'(_{quoted:true}, Options, Options1)
 1487    ),
 1488    format(string(String), '~W', [Term, Options1]).
 1489
 1490
 1491                 /*******************************
 1492                 *             GVAR             *
 1493                 *******************************/
 1494
 1495%!  nb_setval(+Name, +Value) is det.
 1496%
 1497%   Bind the non-backtrackable variable Name with a copy of Value
 1498
 1499nb_setval(Name, Value) :-
 1500    duplicate_term(Value, Copy),
 1501    nb_linkval(Name, Copy).
 1502
 1503
 1504		 /*******************************
 1505		 *            THREADS		*
 1506		 *******************************/
 1507
 1508:- meta_predicate
 1509    thread_create(0, -). 1510
 1511%!  thread_create(:Goal, -Id)
 1512%
 1513%   Shorthand for thread_create(Goal, Id, []).
 1514
 1515thread_create(Goal, Id) :-
 1516    thread_create(Goal, Id, []).
 1517
 1518%!  thread_join(+Id)
 1519%
 1520%   Join a thread and raise an error of the thread did not succeed.
 1521%
 1522%   @error  thread_error(Status),  where  Status  is    the   result  of
 1523%   thread_join/2.
 1524
 1525thread_join(Id) :-
 1526    thread_join(Id, Status),
 1527    (   Status == true
 1528    ->  true
 1529    ;   throw(error(thread_error(Id, Status), _))
 1530    ).
 1531
 1532%!  set_prolog_gc_thread(+Status)
 1533%
 1534%   Control the GC thread.  Status is one of
 1535%
 1536%     - false
 1537%     Disable the separate GC thread, running atom and clause
 1538%     garbage collection in the triggering thread.
 1539%     - true
 1540%     Enable the separate GC thread.  All implicit atom and clause
 1541%     garbage collection is executed by the thread `gc`.
 1542%     - stop
 1543%     Stop the `gc` thread if it is running.  The thread is recreated
 1544%     on the next implicit atom or clause garbage collection.  Used
 1545%     by fork/1 to avoid forking a multi-threaded application.
 1546
 1547set_prolog_gc_thread(Status) :-
 1548    var(Status),
 1549    !,
 1550    '$instantiation_error'(Status).
 1551set_prolog_gc_thread(false) :-
 1552    !,
 1553    set_prolog_flag(gc_thread, false),
 1554    (   current_prolog_flag(threads, true)
 1555    ->  (   '$gc_stop'
 1556        ->  thread_join(gc)
 1557        ;   true
 1558        )
 1559    ;   true
 1560    ).
 1561set_prolog_gc_thread(true) :-
 1562    !,
 1563    set_prolog_flag(gc_thread, true).
 1564set_prolog_gc_thread(stop) :-
 1565    !,
 1566    (   current_prolog_flag(threads, true)
 1567    ->  (   '$gc_stop'
 1568        ->  thread_join(gc)
 1569        ;   true
 1570        )
 1571    ;   true
 1572    ).
 1573set_prolog_gc_thread(Status) :-
 1574    '$domain_error'(gc_thread, Status).
 1575
 1576%!  transaction(:Goal).
 1577%!  transaction(:Goal, +Options).
 1578%!  transaction(:Goal, :Constraint, +Mutex).
 1579%!  snapshot(:Goal).
 1580%
 1581%   Wrappers to guarantee clean Module:Goal terms.
 1582
 1583transaction(Goal) :-
 1584    '$transaction'(Goal, []).
 1585transaction(Goal, Options) :-
 1586    '$transaction'(Goal, Options).
 1587transaction(Goal, Constraint, Mutex) :-
 1588    '$transaction'(Goal, Constraint, Mutex).
 1589snapshot(Goal) :-
 1590    '$snapshot'(Goal).
 1591
 1592
 1593%!  '$wrap_predicate'(:Head, +Name, -Closure, -Wrapped, +Body) is det.
 1594%
 1595%   Would be nicer to have this   from library(prolog_wrap), but we need
 1596%   it for tabling, so it must be a system predicate.
 1597
 1598:- meta_predicate
 1599    '$wrap_predicate'(:, +, -, -, +). 1600
 1601'$wrap_predicate'(M:Head, WName, Closure, call(Wrapped), Body) :-
 1602    callable_name_arguments(Head, PName, Args),
 1603    callable_name_arity(Head, PName, Arity),
 1604    (   is_most_general_term(Head)
 1605    ->  true
 1606    ;   '$domain_error'(most_general_term, Head)
 1607    ),
 1608    atomic_list_concat(['$wrap$', PName], WrapName),
 1609    volatile(M:WrapName/Arity),
 1610    module_transparent(M:WrapName/Arity),
 1611    WHead =.. [WrapName|Args],
 1612    '$c_wrap_predicate'(M:Head, WName, Closure, Wrapped, M:(WHead :- Body)).
 1613
 1614callable_name_arguments(Head, PName, Args) :-
 1615    atom(Head),
 1616    !,
 1617    PName = Head,
 1618    Args = [].
 1619callable_name_arguments(Head, PName, Args) :-
 1620    compound_name_arguments(Head, PName, Args).
 1621
 1622callable_name_arity(Head, PName, Arity) :-
 1623    atom(Head),
 1624    !,
 1625    PName = Head,
 1626    Arity = 0.
 1627callable_name_arity(Head, PName, Arity) :-
 1628    compound_name_arity(Head, PName, Arity)