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