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