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