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