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