View source with raw 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-2021, University of Amsterdam
    7                              VU University Amsterdam
    8                              CWI, Amsterdam
    9                              SWI-Prolog Solutions b.v.
   10    All rights reserved.
   11
   12    Redistribution and use in source and binary forms, with or without
   13    modification, are permitted provided that the following conditions
   14    are met:
   15
   16    1. Redistributions of source code must retain the above copyright
   17       notice, this list of conditions and the following disclaimer.
   18
   19    2. Redistributions in binary form must reproduce the above copyright
   20       notice, this list of conditions and the following disclaimer in
   21       the documentation and/or other materials provided with the
   22       distribution.
   23
   24    THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
   25    "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
   26    LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS
   27    FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE
   28    COPYRIGHT OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT,
   29    INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING,
   30    BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES;
   31    LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER
   32    CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
   33    LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN
   34    ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
   35    POSSIBILITY OF SUCH DAMAGE.
   36*/
   37
   38/*
   39Consult, derivates and basic things.   This  module  is  loaded  by  the
   40C-written  bootstrap  compiler.
   41
   42The $:- directive  is  executed  by  the  bootstrap  compiler,  but  not
   43inserted  in  the  intermediate  code  file.   Used  to print diagnostic
   44messages and start the Prolog defined compiler for  the  remaining  boot
   45modules.
   46
   47If you want  to  debug  this  module,  put  a  '$:-'(trace).   directive
   48somewhere.   The  tracer will work properly under boot compilation as it
   49will use the C defined write predicate  to  print  goals  and  does  not
   50attempt to call the Prolog defined trace interceptor.
   51*/
   52
   53                /********************************
   54                *    LOAD INTO MODULE SYSTEM    *
   55                ********************************/
   56
   57:- '$set_source_module'(system).   58
   59'$boot_message'(_Format, _Args) :-
   60    current_prolog_flag(verbose, silent),
   61    !.
   62'$boot_message'(Format, Args) :-
   63    format(Format, Args),
   64    !.
   65
   66'$:-'('$boot_message'('Loading boot file ...~n', [])).
   67
   68
   69                /********************************
   70                *          DIRECTIVES           *
   71                *********************************/
   72
   73:- meta_predicate
   74    dynamic(:),
   75    multifile(:),
   76    public(:),
   77    module_transparent(:),
   78    discontiguous(:),
   79    volatile(:),
   80    thread_local(:),
   81    noprofile(:),
   82    non_terminal(:),
   83    '$clausable'(:),
   84    '$iso'(:),
   85    '$hide'(:).
 dynamic +Spec is det
 multifile +Spec is det
 module_transparent +Spec is det
 discontiguous +Spec is det
 volatile +Spec is det
 thread_local +Spec is det
 noprofile(+Spec) is det
 public +Spec is det
 non_terminal(+Spec) is det
Predicate versions of standard directives that set predicate attributes. These predicates bail out with an error on the first failure (typically permission errors).
 $iso(+Spec) is det
Set the ISO flag. This defines that the predicate cannot be redefined inside a module.
 $clausable(+Spec) is det
Specify that we can run clause/2 on a predicate, even if it is static. ISO specifies that public also plays this role. in SWI, public means that the predicate can be called, even if we cannot find a reference to it.
 $hide(+Spec) is det
Specify that the predicate cannot be seen in the debugger.
  117dynamic(Spec)            :- '$set_pattr'(Spec, pred, dynamic(true)).
  118multifile(Spec)          :- '$set_pattr'(Spec, pred, multifile(true)).
  119module_transparent(Spec) :- '$set_pattr'(Spec, pred, transparent(true)).
  120discontiguous(Spec)      :- '$set_pattr'(Spec, pred, discontiguous(true)).
  121volatile(Spec)           :- '$set_pattr'(Spec, pred, volatile(true)).
  122thread_local(Spec)       :- '$set_pattr'(Spec, pred, thread_local(true)).
  123noprofile(Spec)          :- '$set_pattr'(Spec, pred, noprofile(true)).
  124public(Spec)             :- '$set_pattr'(Spec, pred, public(true)).
  125non_terminal(Spec)       :- '$set_pattr'(Spec, pred, non_terminal(true)).
  126det(Spec)                :- '$set_pattr'(Spec, pred, det(true)).
  127'$iso'(Spec)             :- '$set_pattr'(Spec, pred, iso(true)).
  128'$clausable'(Spec)       :- '$set_pattr'(Spec, pred, clausable(true)).
  129'$hide'(Spec)            :- '$set_pattr'(Spec, pred, trace(false)).
  130
  131'$set_pattr'(M:Pred, How, Attr) :-
  132    '$set_pattr'(Pred, M, How, Attr).
 $set_pattr(+Spec, +Module, +From, +Attr)
Set predicate attributes. From is one of pred or directive.
  138'$set_pattr'(X, _, _, _) :-
  139    var(X),
  140    '$uninstantiation_error'(X).
  141'$set_pattr'(as(Spec,Options), M, How, Attr0) :-
  142    !,
  143    '$attr_options'(Options, Attr0, Attr),
  144    '$set_pattr'(Spec, M, How, Attr).
  145'$set_pattr'([], _, _, _) :- !.
  146'$set_pattr'([H|T], M, How, Attr) :-           % ISO
  147    !,
  148    '$set_pattr'(H, M, How, Attr),
  149    '$set_pattr'(T, M, How, Attr).
  150'$set_pattr'((A,B), M, How, Attr) :-           % ISO and traditional
  151    !,
  152    '$set_pattr'(A, M, How, Attr),
  153    '$set_pattr'(B, M, How, Attr).
  154'$set_pattr'(M:T, _, How, Attr) :-
  155    !,
  156    '$set_pattr'(T, M, How, Attr).
  157'$set_pattr'(PI, M, _, []) :-
  158    !,
  159    '$pi_head'(M:PI, Pred),
  160    '$set_table_wrappers'(Pred).
  161'$set_pattr'(A, M, How, [O|OT]) :-
  162    !,
  163    '$set_pattr'(A, M, How, O),
  164    '$set_pattr'(A, M, How, OT).
  165'$set_pattr'(A, M, pred, Attr) :-
  166    !,
  167    Attr =.. [Name,Val],
  168    '$set_pi_attr'(M:A, Name, Val).
  169'$set_pattr'(A, M, directive, Attr) :-
  170    !,
  171    Attr =.. [Name,Val],
  172    catch('$set_pi_attr'(M:A, Name, Val),
  173          error(E, _),
  174          print_message(error, error(E, context((Name)/1,_)))).
  175
  176'$set_pi_attr'(PI, Name, Val) :-
  177    '$pi_head'(PI, Head),
  178    '$set_predicate_attribute'(Head, Name, Val).
  179
  180'$attr_options'(Var, _, _) :-
  181    var(Var),
  182    !,
  183    '$uninstantiation_error'(Var).
  184'$attr_options'((A,B), Attr0, Attr) :-
  185    !,
  186    '$attr_options'(A, Attr0, Attr1),
  187    '$attr_options'(B, Attr1, Attr).
  188'$attr_options'(Opt, Attr0, Attrs) :-
  189    '$must_be'(ground, Opt),
  190    (   '$attr_option'(Opt, AttrX)
  191    ->  (   is_list(Attr0)
  192        ->  '$join_attrs'(AttrX, Attr0, Attrs)
  193        ;   '$join_attrs'(AttrX, [Attr0], Attrs)
  194        )
  195    ;   '$domain_error'(predicate_option, Opt)
  196    ).
  197
  198'$join_attrs'([], Attrs, Attrs) :-
  199    !.
  200'$join_attrs'([H|T], Attrs0, Attrs) :-
  201    !,
  202    '$join_attrs'(H, Attrs0, Attrs1),
  203    '$join_attrs'(T, Attrs1, Attrs).
  204'$join_attrs'(Attr, Attrs, Attrs) :-
  205    memberchk(Attr, Attrs),
  206    !.
  207'$join_attrs'(Attr, Attrs, Attrs) :-
  208    Attr =.. [Name,Value],
  209    Gen =.. [Name,Existing],
  210    memberchk(Gen, Attrs),
  211    !,
  212    throw(error(conflict_error(Name, Value, Existing), _)).
  213'$join_attrs'(Attr, Attrs0, Attrs) :-
  214    '$append'(Attrs0, [Attr], Attrs).
  215
  216'$attr_option'(incremental, [incremental(true),opaque(false)]).
  217'$attr_option'(monotonic, monotonic(true)).
  218'$attr_option'(lazy, lazy(true)).
  219'$attr_option'(opaque, [incremental(false),opaque(true)]).
  220'$attr_option'(abstract(Level0), abstract(Level)) :-
  221    '$table_option'(Level0, Level).
  222'$attr_option'(subgoal_abstract(Level0), subgoal_abstract(Level)) :-
  223    '$table_option'(Level0, Level).
  224'$attr_option'(answer_abstract(Level0), answer_abstract(Level)) :-
  225    '$table_option'(Level0, Level).
  226'$attr_option'(max_answers(Level0), max_answers(Level)) :-
  227    '$table_option'(Level0, Level).
  228'$attr_option'(volatile, volatile(true)).
  229'$attr_option'(multifile, multifile(true)).
  230'$attr_option'(discontiguous, discontiguous(true)).
  231'$attr_option'(shared, thread_local(false)).
  232'$attr_option'(local, thread_local(true)).
  233'$attr_option'(private, thread_local(true)).
  234
  235'$table_option'(Value0, _Value) :-
  236    var(Value0),
  237    !,
  238    '$instantiation_error'(Value0).
  239'$table_option'(Value0, Value) :-
  240    integer(Value0),
  241    Value0 >= 0,
  242    !,
  243    Value = Value0.
  244'$table_option'(off, -1) :-
  245    !.
  246'$table_option'(false, -1) :-
  247    !.
  248'$table_option'(infinite, -1) :-
  249    !.
  250'$table_option'(Value, _) :-
  251    '$domain_error'(nonneg_or_false, Value).
 $pattr_directive(+Spec, +Module) is det
This implements the directive version of dynamic/1, multifile/1, etc. This version catches and prints errors. If the directive specifies multiple predicates, processing after an error continues with the remaining predicates.
  261'$pattr_directive'(dynamic(Spec), M) :-
  262    '$set_pattr'(Spec, M, directive, dynamic(true)).
  263'$pattr_directive'(multifile(Spec), M) :-
  264    '$set_pattr'(Spec, M, directive, multifile(true)).
  265'$pattr_directive'(module_transparent(Spec), M) :-
  266    '$set_pattr'(Spec, M, directive, transparent(true)).
  267'$pattr_directive'(discontiguous(Spec), M) :-
  268    '$set_pattr'(Spec, M, directive, discontiguous(true)).
  269'$pattr_directive'(volatile(Spec), M) :-
  270    '$set_pattr'(Spec, M, directive, volatile(true)).
  271'$pattr_directive'(thread_local(Spec), M) :-
  272    '$set_pattr'(Spec, M, directive, thread_local(true)).
  273'$pattr_directive'(noprofile(Spec), M) :-
  274    '$set_pattr'(Spec, M, directive, noprofile(true)).
  275'$pattr_directive'(public(Spec), M) :-
  276    '$set_pattr'(Spec, M, directive, public(true)).
  277'$pattr_directive'(det(Spec), M) :-
  278    '$set_pattr'(Spec, M, directive, det(true)).
 $pi_head(?PI, ?Head)
  282'$pi_head'(PI, Head) :-
  283    var(PI),
  284    var(Head),
  285    '$instantiation_error'([PI,Head]).
  286'$pi_head'(M:PI, M:Head) :-
  287    !,
  288    '$pi_head'(PI, Head).
  289'$pi_head'(Name/Arity, Head) :-
  290    !,
  291    '$head_name_arity'(Head, Name, Arity).
  292'$pi_head'(Name//DCGArity, Head) :-
  293    !,
  294    (   nonvar(DCGArity)
  295    ->  Arity is DCGArity+2,
  296        '$head_name_arity'(Head, Name, Arity)
  297    ;   '$head_name_arity'(Head, Name, Arity),
  298        DCGArity is Arity - 2
  299    ).
  300'$pi_head'(PI, _) :-
  301    '$type_error'(predicate_indicator, PI).
 $head_name_arity(+Goal, -Name, -Arity)
$head_name_arity(-Goal, +Name, +Arity)
  306'$head_name_arity'(Goal, Name, Arity) :-
  307    (   atom(Goal)
  308    ->  Name = Goal, Arity = 0
  309    ;   compound(Goal)
  310    ->  compound_name_arity(Goal, Name, Arity)
  311    ;   var(Goal)
  312    ->  (   Arity == 0
  313        ->  (   atom(Name)
  314            ->  Goal = Name
  315            ;   Name == []
  316            ->  Goal = Name
  317            ;   blob(Name, closure)
  318            ->  Goal = Name
  319            ;   '$type_error'(atom, Name)
  320            )
  321        ;   compound_name_arity(Goal, Name, Arity)
  322        )
  323    ;   '$type_error'(callable, Goal)
  324    ).
  325
  326:- '$iso'(((dynamic)/1, (multifile)/1, (discontiguous)/1)).  327
  328
  329                /********************************
  330                *       CALLING, CONTROL        *
  331                *********************************/
  332
  333:- noprofile((call/1,
  334              catch/3,
  335              once/1,
  336              ignore/1,
  337              call_cleanup/2,
  338              call_cleanup/3,
  339              setup_call_cleanup/3,
  340              setup_call_catcher_cleanup/4)).  341
  342:- meta_predicate
  343    ';'(0,0),
  344    ','(0,0),
  345    @(0,+),
  346    call(0),
  347    call(1,?),
  348    call(2,?,?),
  349    call(3,?,?,?),
  350    call(4,?,?,?,?),
  351    call(5,?,?,?,?,?),
  352    call(6,?,?,?,?,?,?),
  353    call(7,?,?,?,?,?,?,?),
  354    not(0),
  355    \+(0),
  356    $(0),
  357    '->'(0,0),
  358    '*->'(0,0),
  359    once(0),
  360    ignore(0),
  361    catch(0,?,0),
  362    reset(0,?,-),
  363    setup_call_cleanup(0,0,0),
  364    setup_call_catcher_cleanup(0,0,?,0),
  365    call_cleanup(0,0),
  366    call_cleanup(0,?,0),
  367    catch_with_backtrace(0,?,0),
  368    '$meta_call'(0).  369
  370:- '$iso'((call/1, (\+)/1, once/1, (;)/2, (',')/2, (->)/2, catch/3)).  371
  372% The control structures are always compiled, both   if they appear in a
  373% clause body and if they are handed  to   call/1.  The only way to call
  374% these predicates is by means of  call/2..   In  that case, we call the
  375% hole control structure again to get it compiled by call/1 and properly
  376% deal  with  !,  etc.  Another  reason  for  having  these  things   as
  377% predicates is to be able to define   properties for them, helping code
  378% analyzers.
  379
  380(M0:If ; M0:Then) :- !, call(M0:(If ; Then)).
  381(M1:If ; M2:Then) :-    call(M1:(If ; M2:Then)).
  382(G1   , G2)       :-    call((G1   , G2)).
  383(If  -> Then)     :-    call((If  -> Then)).
  384(If *-> Then)     :-    call((If *-> Then)).
  385@(Goal,Module)    :-    @(Goal,Module).
 $meta_call(:Goal)
Interpreted meta-call implementation. By default, call/1 compiles its argument into a temporary clause. This realises better performance if the (complex) goal does a lot of backtracking because this interpreted version needs to re-interpret the remainder of the goal after backtracking.

This implementation is used by reset/3 because the continuation cannot be captured if it contains a such a compiled temporary clause.

  399'$meta_call'(M:G) :-
  400    prolog_current_choice(Ch),
  401    '$meta_call'(G, M, Ch).
  402
  403'$meta_call'(Var, _, _) :-
  404    var(Var),
  405    !,
  406    '$instantiation_error'(Var).
  407'$meta_call'((A,B), M, Ch) :-
  408    !,
  409    '$meta_call'(A, M, Ch),
  410    '$meta_call'(B, M, Ch).
  411'$meta_call'((I->T;E), M, Ch) :-
  412    !,
  413    (   prolog_current_choice(Ch2),
  414        '$meta_call'(I, M, Ch2)
  415    ->  '$meta_call'(T, M, Ch)
  416    ;   '$meta_call'(E, M, Ch)
  417    ).
  418'$meta_call'((I*->T;E), M, Ch) :-
  419    !,
  420    (   prolog_current_choice(Ch2),
  421        '$meta_call'(I, M, Ch2)
  422    *-> '$meta_call'(T, M, Ch)
  423    ;   '$meta_call'(E, M, Ch)
  424    ).
  425'$meta_call'((I->T), M, Ch) :-
  426    !,
  427    (   prolog_current_choice(Ch2),
  428        '$meta_call'(I, M, Ch2)
  429    ->  '$meta_call'(T, M, Ch)
  430    ).
  431'$meta_call'((I*->T), M, Ch) :-
  432    !,
  433    prolog_current_choice(Ch2),
  434    '$meta_call'(I, M, Ch2),
  435    '$meta_call'(T, M, Ch).
  436'$meta_call'((A;B), M, Ch) :-
  437    !,
  438    (   '$meta_call'(A, M, Ch)
  439    ;   '$meta_call'(B, M, Ch)
  440    ).
  441'$meta_call'(\+(G), M, _) :-
  442    !,
  443    prolog_current_choice(Ch),
  444    \+ '$meta_call'(G, M, Ch).
  445'$meta_call'($(G), M, _) :-
  446    !,
  447    prolog_current_choice(Ch),
  448    $('$meta_call'(G, M, Ch)).
  449'$meta_call'(call(G), M, _) :-
  450    !,
  451    prolog_current_choice(Ch),
  452    '$meta_call'(G, M, Ch).
  453'$meta_call'(M:G, _, Ch) :-
  454    !,
  455    '$meta_call'(G, M, Ch).
  456'$meta_call'(!, _, Ch) :-
  457    prolog_cut_to(Ch).
  458'$meta_call'(G, M, _Ch) :-
  459    call(M:G).
 call(:Closure, ?A)
 call(:Closure, ?A1, ?A2)
 call(:Closure, ?A1, ?A2, ?A3)
 call(:Closure, ?A1, ?A2, ?A3, ?A4)
 call(:Closure, ?A1, ?A2, ?A3, ?A4, ?A5)
 call(:Closure, ?A1, ?A2, ?A3, ?A4, ?A5, ?A6)
 call(:Closure, ?A1, ?A2, ?A3, ?A4, ?A5, ?A6, ?A7)
Arity 2..8 is demanded by the ISO standard. Higher arities are supported, but handled by the compiler. This implies they are not backed up by predicates and analyzers thus cannot ask for their properties. Analyzers should hard-code handling of call/2..
  475:- '$iso'((call/2,
  476           call/3,
  477           call/4,
  478           call/5,
  479           call/6,
  480           call/7,
  481           call/8)).  482
  483call(Goal) :-                           % make these available as predicates
  484    Goal.
  485call(Goal, A) :-
  486    call(Goal, A).
  487call(Goal, A, B) :-
  488    call(Goal, A, B).
  489call(Goal, A, B, C) :-
  490    call(Goal, A, B, C).
  491call(Goal, A, B, C, D) :-
  492    call(Goal, A, B, C, D).
  493call(Goal, A, B, C, D, E) :-
  494    call(Goal, A, B, C, D, E).
  495call(Goal, A, B, C, D, E, F) :-
  496    call(Goal, A, B, C, D, E, F).
  497call(Goal, A, B, C, D, E, F, G) :-
  498    call(Goal, A, B, C, D, E, F, G).
 not(:Goal) is semidet
Pre-ISO version of \+/1. Note that some systems define not/1 as a logically more sound version of \+/1.
  505not(Goal) :-
  506    \+ Goal.
 \+ :Goal is semidet
Predicate version that allows for meta-calling.
  512\+ Goal :-
  513    \+ Goal.
 once(:Goal) is semidet
ISO predicate, acting as call((Goal, !)).
  519once(Goal) :-
  520    Goal,
  521    !.
 ignore(:Goal) is det
Call Goal, cut choice-points on success and succeed on failure. intended for calling side-effects and proceed on failure.
  528ignore(Goal) :-
  529    Goal,
  530    !.
  531ignore(_Goal).
  532
  533:- '$iso'((false/0)).
 false
Synonym for fail/0, providing a declarative reading.
  539false :-
  540    fail.
 catch(:Goal, +Catcher, :Recover)
ISO compliant exception handling.
  546catch(_Goal, _Catcher, _Recover) :-
  547    '$catch'.                       % Maps to I_CATCH, I_EXITCATCH
 prolog_cut_to(+Choice)
Cut all choice points after Choice
  553prolog_cut_to(_Choice) :-
  554    '$cut'.                         % Maps to I_CUTCHP
 $ is det
Declare that from now on this predicate succeeds deterministically.
  560'$' :- '$'.
 $ :Goal is det
Declare that Goal must succeed deterministically.
  566$(Goal) :- $(Goal).
 reset(:Goal, ?Ball, -Continue)
Delimited continuation support.
  572reset(_Goal, _Ball, _Cont) :-
  573    '$reset'.
 shift(+Ball)
 shift_for_copy(+Ball)
Shift control back to the enclosing reset/3. The second version assumes the continuation will be saved to be reused in a different context.
  582shift(Ball) :-
  583    '$shift'(Ball).
  584
  585shift_for_copy(Ball) :-
  586    '$shift_for_copy'(Ball).
 call_continuation(+Continuation:list)
Call a continuation as created by shift/1. The continuation is a list of '$cont$'(Clause, PC, EnvironmentArg, ...) structures. The predicate '$call_one_tail_body'/1 creates a frame from the continuation and calls this.

Note that we can technically also push the entire continuation onto the environment and call it. Doing it incrementally as below exploits last-call optimization and therefore possible quadratic expansion of the continuation.

  600call_continuation([]).
  601call_continuation([TB|Rest]) :-
  602    (   Rest == []
  603    ->  '$call_continuation'(TB)
  604    ;   '$call_continuation'(TB),
  605        call_continuation(Rest)
  606    ).
 catch_with_backtrace(:Goal, ?Ball, :Recover)
As catch/3, but tell library(prolog_stack) to record a backtrace in case of an exception.
  613catch_with_backtrace(Goal, Ball, Recover) :-
  614    catch(Goal, Ball, Recover),
  615    '$no_lco'.
  616
  617'$no_lco'.
 $recover_and_rethrow(:Goal, +Term)
This goal is used to wrap the catch/3 recover handler if the exception is not supposed to be `catchable'. An example of an uncachable exception is '$aborted', used by abort/0. Note that we cut to ensure that the exception is not delayed forever because the recover handler leaves a choicepoint.
  627:- public '$recover_and_rethrow'/2.  628
  629'$recover_and_rethrow'(Goal, Exception) :-
  630    call_cleanup(Goal, throw(Exception)),
  631    !.
 setup_call_cleanup(:Setup, :Goal, :Cleanup)
 setup_call_catcher_cleanup(:Setup, :Goal, +Catcher, :Cleanup)
 call_cleanup(:Goal, :Cleanup)
 call_cleanup(:Goal, +Catcher, :Cleanup)
Call Cleanup once after Goal is finished (deterministic success, failure, exception or cut). The call to '$call_cleanup' is translated to I_CALLCLEANUP. This instruction relies on the exact stack layout left by setup_call_catcher_cleanup/4. Also the predicate name is used by the kernel cleanup mechanism and can only be changed together with the kernel.
  646setup_call_catcher_cleanup(Setup, _Goal, _Catcher, _Cleanup) :-
  647    '$sig_atomic'(Setup),
  648    '$call_cleanup'.
  649
  650setup_call_cleanup(Setup, Goal, Cleanup) :-
  651    setup_call_catcher_cleanup(Setup, Goal, _Catcher, Cleanup).
  652
  653call_cleanup(Goal, Cleanup) :-
  654    setup_call_catcher_cleanup(true, Goal, _Catcher, Cleanup).
  655
  656call_cleanup(Goal, Catcher, Cleanup) :-
  657    setup_call_catcher_cleanup(true, Goal, Catcher, Cleanup).
  658
  659                 /*******************************
  660                 *       INITIALIZATION         *
  661                 *******************************/
  662
  663:- meta_predicate
  664    initialization(0, +).  665
  666:- multifile '$init_goal'/3.  667:- dynamic   '$init_goal'/3.
 initialization(:Goal, +When)
Register Goal to be executed if a saved state is restored. In addition, the goal is executed depending on When:
now
Execute immediately
after_load
Execute after loading the file in which it appears. This is initialization/1.
restore_state
Do not execute immediately, but only when restoring the state. Not allowed in a sandboxed environment.
prepare_state
Called before saving a state. Can be used to clean the environment (see also volatile/1) or eagerly execute goals that are normally executed lazily.
program
Works as -g goal goals.
main
Starts the application. Only last declaration is used.

Note that all goals are executed when a program is restored.

  693initialization(Goal, When) :-
  694    '$must_be'(oneof(atom, initialization_type,
  695                     [ now,
  696                       after_load,
  697                       restore,
  698                       restore_state,
  699                       prepare_state,
  700                       program,
  701                       main
  702                     ]), When),
  703    '$initialization_context'(Source, Ctx),
  704    '$initialization'(When, Goal, Source, Ctx).
  705
  706'$initialization'(now, Goal, _Source, Ctx) :-
  707    '$run_init_goal'(Goal, Ctx),
  708    '$compile_init_goal'(-, Goal, Ctx).
  709'$initialization'(after_load, Goal, Source, Ctx) :-
  710    (   Source \== (-)
  711    ->  '$compile_init_goal'(Source, Goal, Ctx)
  712    ;   throw(error(context_error(nodirective,
  713                                  initialization(Goal, after_load)),
  714                    _))
  715    ).
  716'$initialization'(restore, Goal, Source, Ctx) :- % deprecated
  717    '$initialization'(restore_state, Goal, Source, Ctx).
  718'$initialization'(restore_state, Goal, _Source, Ctx) :-
  719    (   \+ current_prolog_flag(sandboxed_load, true)
  720    ->  '$compile_init_goal'(-, Goal, Ctx)
  721    ;   '$permission_error'(register, initialization(restore), Goal)
  722    ).
  723'$initialization'(prepare_state, Goal, _Source, Ctx) :-
  724    (   \+ current_prolog_flag(sandboxed_load, true)
  725    ->  '$compile_init_goal'(when(prepare_state), Goal, Ctx)
  726    ;   '$permission_error'(register, initialization(restore), Goal)
  727    ).
  728'$initialization'(program, Goal, _Source, Ctx) :-
  729    (   \+ current_prolog_flag(sandboxed_load, true)
  730    ->  '$compile_init_goal'(when(program), Goal, Ctx)
  731    ;   '$permission_error'(register, initialization(restore), Goal)
  732    ).
  733'$initialization'(main, Goal, _Source, Ctx) :-
  734    (   \+ current_prolog_flag(sandboxed_load, true)
  735    ->  '$compile_init_goal'(when(main), Goal, Ctx)
  736    ;   '$permission_error'(register, initialization(restore), Goal)
  737    ).
  738
  739
  740'$compile_init_goal'(Source, Goal, Ctx) :-
  741    atom(Source),
  742    Source \== (-),
  743    !,
  744    '$store_admin_clause'(system:'$init_goal'(Source, Goal, Ctx),
  745                          _Layout, Source, Ctx).
  746'$compile_init_goal'(Source, Goal, Ctx) :-
  747    assertz('$init_goal'(Source, Goal, Ctx)).
 $run_initialization(?File, +Options) is det
 $run_initialization(?File, +Action, +Options) is det
Run initialization directives for all files if File is unbound, or for a specified file. Note that '$run_initialization'/2 is called from runInitialization() in pl-wic.c for .qlf files. The '$run_initialization'/3 is called with Action set to loaded when called for a QLF file.
  759'$run_initialization'(_, loaded, _) :- !.
  760'$run_initialization'(File, _Action, Options) :-
  761    '$run_initialization'(File, Options).
  762
  763'$run_initialization'(File, Options) :-
  764    setup_call_cleanup(
  765        '$start_run_initialization'(Options, Restore),
  766        '$run_initialization_2'(File),
  767        '$end_run_initialization'(Restore)).
  768
  769'$start_run_initialization'(Options, OldSandBoxed) :-
  770    '$push_input_context'(initialization),
  771    '$set_sandboxed_load'(Options, OldSandBoxed).
  772'$end_run_initialization'(OldSandBoxed) :-
  773    set_prolog_flag(sandboxed_load, OldSandBoxed),
  774    '$pop_input_context'.
  775
  776'$run_initialization_2'(File) :-
  777    (   '$init_goal'(File, Goal, Ctx),
  778        File \= when(_),
  779        '$run_init_goal'(Goal, Ctx),
  780        fail
  781    ;   true
  782    ).
  783
  784'$run_init_goal'(Goal, Ctx) :-
  785    (   catch_with_backtrace('$run_init_goal'(Goal), E,
  786                             '$initialization_error'(E, Goal, Ctx))
  787    ->  true
  788    ;   '$initialization_failure'(Goal, Ctx)
  789    ).
  790
  791:- multifile prolog:sandbox_allowed_goal/1.  792
  793'$run_init_goal'(Goal) :-
  794    current_prolog_flag(sandboxed_load, false),
  795    !,
  796    call(Goal).
  797'$run_init_goal'(Goal) :-
  798    prolog:sandbox_allowed_goal(Goal),
  799    call(Goal).
  800
  801'$initialization_context'(Source, Ctx) :-
  802    (   source_location(File, Line)
  803    ->  Ctx = File:Line,
  804        '$input_context'(Context),
  805        '$top_file'(Context, File, Source)
  806    ;   Ctx = (-),
  807        File = (-)
  808    ).
  809
  810'$top_file'([input(include, F1, _, _)|T], _, F) :-
  811    !,
  812    '$top_file'(T, F1, F).
  813'$top_file'(_, F, F).
  814
  815
  816'$initialization_error'(E, Goal, Ctx) :-
  817    print_message(error, initialization_error(Goal, E, Ctx)).
  818
  819'$initialization_failure'(Goal, Ctx) :-
  820    print_message(warning, initialization_failure(Goal, Ctx)).
 $clear_source_admin(+File) is det
Removes source adminstration related to File
See also
- Called from destroySourceFile() in pl-proc.c
  828:- public '$clear_source_admin'/1.  829
  830'$clear_source_admin'(File) :-
  831    retractall('$init_goal'(_, _, File:_)),
  832    retractall('$load_context_module'(File, _, _)),
  833    retractall('$resolved_source_path_db'(_, _, File)).
  834
  835
  836                 /*******************************
  837                 *            STREAM            *
  838                 *******************************/
  839
  840:- '$iso'(stream_property/2).  841stream_property(Stream, Property) :-
  842    nonvar(Stream),
  843    nonvar(Property),
  844    !,
  845    '$stream_property'(Stream, Property).
  846stream_property(Stream, Property) :-
  847    nonvar(Stream),
  848    !,
  849    '$stream_properties'(Stream, Properties),
  850    '$member'(Property, Properties).
  851stream_property(Stream, Property) :-
  852    nonvar(Property),
  853    !,
  854    (   Property = alias(Alias),
  855        atom(Alias)
  856    ->  '$alias_stream'(Alias, Stream)
  857    ;   '$streams_properties'(Property, Pairs),
  858        '$member'(Stream-Property, Pairs)
  859    ).
  860stream_property(Stream, Property) :-
  861    '$streams_properties'(Property, Pairs),
  862    '$member'(Stream-Properties, Pairs),
  863    '$member'(Property, Properties).
  864
  865
  866                /********************************
  867                *            MODULES            *
  868                *********************************/
  869
  870%       '$prefix_module'(+Module, +Context, +Term, -Prefixed)
  871%       Tags `Term' with `Module:' if `Module' is not the context module.
  872
  873'$prefix_module'(Module, Module, Head, Head) :- !.
  874'$prefix_module'(Module, _, Head, Module:Head).
 default_module(+Me, -Super) is multi
Is true if `Super' is `Me' or a super (auto import) module of `Me'.
  880default_module(Me, Super) :-
  881    (   atom(Me)
  882    ->  (   var(Super)
  883        ->  '$default_module'(Me, Super)
  884        ;   '$default_module'(Me, Super), !
  885        )
  886    ;   '$type_error'(module, Me)
  887    ).
  888
  889'$default_module'(Me, Me).
  890'$default_module'(Me, Super) :-
  891    import_module(Me, S),
  892    '$default_module'(S, Super).
  893
  894
  895                /********************************
  896                *      TRACE AND EXCEPTIONS     *
  897                *********************************/
  898
  899:- dynamic   user:exception/3.  900:- multifile user:exception/3.  901:- '$hide'(user:exception/3).
 $undefined_procedure(+Module, +Name, +Arity, -Action) is det
This predicate is called from C on undefined predicates. First allows the user to take care of it using exception/3. Else try to give a DWIM warning. Otherwise fail. C will print an error message.
  910:- public
  911    '$undefined_procedure'/4.  912
  913'$undefined_procedure'(Module, Name, Arity, Action) :-
  914    '$prefix_module'(Module, user, Name/Arity, Pred),
  915    user:exception(undefined_predicate, Pred, Action0),
  916    !,
  917    Action = Action0.
  918'$undefined_procedure'(Module, Name, Arity, Action) :-
  919    \+ current_prolog_flag(autoload, false),
  920    '$autoload'(Module:Name/Arity),
  921    !,
  922    Action = retry.
  923'$undefined_procedure'(_, _, _, error).
 $loading(+Library)
True if the library is being loaded. Just testing that the predicate is defined is not good enough as the file may be partly loaded. Calling use_module/2 at any time has two drawbacks: it queries the filesystem, causing slowdown and it stops libraries being autoloaded from a saved state where the library is already loaded, but the source may not be accessible.
  935'$loading'(Library) :-
  936    current_prolog_flag(threads, true),
  937    (   '$loading_file'(Library, _Queue, _LoadThread)
  938    ->  true
  939    ;   '$loading_file'(FullFile, _Queue, _LoadThread),
  940        file_name_extension(Library, _, FullFile)
  941    ->  true
  942    ).
  943
  944%        handle debugger 'w', 'p' and <N> depth options.
  945
  946'$set_debugger_write_options'(write) :-
  947    !,
  948    create_prolog_flag(debugger_write_options,
  949                       [ quoted(true),
  950                         attributes(dots),
  951                         spacing(next_argument)
  952                       ], []).
  953'$set_debugger_write_options'(print) :-
  954    !,
  955    create_prolog_flag(debugger_write_options,
  956                       [ quoted(true),
  957                         portray(true),
  958                         max_depth(10),
  959                         attributes(portray),
  960                         spacing(next_argument)
  961                       ], []).
  962'$set_debugger_write_options'(Depth) :-
  963    current_prolog_flag(debugger_write_options, Options0),
  964    (   '$select'(max_depth(_), Options0, Options)
  965    ->  true
  966    ;   Options = Options0
  967    ),
  968    create_prolog_flag(debugger_write_options,
  969                       [max_depth(Depth)|Options], []).
  970
  971
  972                /********************************
  973                *        SYSTEM MESSAGES        *
  974                *********************************/
 $confirm(Spec)
Ask the user to confirm a question. Spec is a term as used for print_message/2.
  981'$confirm'(Spec) :-
  982    print_message(query, Spec),
  983    between(0, 5, _),
  984        get_single_char(Answer),
  985        (   '$in_reply'(Answer, 'yYjJ \n')
  986        ->  !,
  987            print_message(query, if_tty([yes-[]]))
  988        ;   '$in_reply'(Answer, 'nN')
  989        ->  !,
  990            print_message(query, if_tty([no-[]])),
  991            fail
  992        ;   print_message(help, query(confirm)),
  993            fail
  994        ).
  995
  996'$in_reply'(Code, Atom) :-
  997    char_code(Char, Code),
  998    sub_atom(Atom, _, _, _, Char),
  999    !.
 1000
 1001:- dynamic
 1002    user:portray/1. 1003:- multifile
 1004    user:portray/1. 1005
 1006
 1007                 /*******************************
 1008                 *       FILE_SEARCH_PATH       *
 1009                 *******************************/
 1010
 1011:- dynamic
 1012    user:file_search_path/2,
 1013    user:library_directory/1. 1014:- multifile
 1015    user:file_search_path/2,
 1016    user:library_directory/1. 1017
 1018user:(file_search_path(library, Dir) :-
 1019        library_directory(Dir)).
 1020user:file_search_path(swi, Home) :-
 1021    current_prolog_flag(home, Home).
 1022user:file_search_path(swi, Home) :-
 1023    current_prolog_flag(shared_home, Home).
 1024user:file_search_path(library, app_config(lib)).
 1025user:file_search_path(library, swi(library)).
 1026user:file_search_path(library, swi(library/clp)).
 1027user:file_search_path(foreign, swi(ArchLib)) :-
 1028    \+ current_prolog_flag(windows, true),
 1029    current_prolog_flag(arch, Arch),
 1030    atom_concat('lib/', Arch, ArchLib).
 1031user:file_search_path(foreign, swi(SoLib)) :-
 1032    (   current_prolog_flag(windows, true)
 1033    ->  SoLib = bin
 1034    ;   SoLib = lib
 1035    ).
 1036user:file_search_path(path, Dir) :-
 1037    getenv('PATH', Path),
 1038    (   current_prolog_flag(windows, true)
 1039    ->  atomic_list_concat(Dirs, (;), Path)
 1040    ;   atomic_list_concat(Dirs, :, Path)
 1041    ),
 1042    '$member'(Dir, Dirs).
 1043user:file_search_path(user_app_data, Dir) :-
 1044    '$xdg_prolog_directory'(data, Dir).
 1045user:file_search_path(common_app_data, Dir) :-
 1046    '$xdg_prolog_directory'(common_data, Dir).
 1047user:file_search_path(user_app_config, Dir) :-
 1048    '$xdg_prolog_directory'(config, Dir).
 1049user:file_search_path(common_app_config, Dir) :-
 1050    '$xdg_prolog_directory'(common_config, Dir).
 1051user:file_search_path(app_data, user_app_data('.')).
 1052user:file_search_path(app_data, common_app_data('.')).
 1053user:file_search_path(app_config, user_app_config('.')).
 1054user:file_search_path(app_config, common_app_config('.')).
 1055% backward compatibility
 1056user:file_search_path(app_preferences, user_app_config('.')).
 1057user:file_search_path(user_profile, app_preferences('.')).
 1058
 1059'$xdg_prolog_directory'(Which, Dir) :-
 1060    '$xdg_directory'(Which, XDGDir),
 1061    '$make_config_dir'(XDGDir),
 1062    '$ensure_slash'(XDGDir, XDGDirS),
 1063    atom_concat(XDGDirS, 'swi-prolog', Dir),
 1064    '$make_config_dir'(Dir).
 1065
 1066% config
 1067'$xdg_directory'(config, Home) :-
 1068    current_prolog_flag(windows, true),
 1069    catch(win_folder(appdata, Home), _, fail),
 1070    !.
 1071'$xdg_directory'(config, Home) :-
 1072    getenv('XDG_CONFIG_HOME', Home).
 1073'$xdg_directory'(config, Home) :-
 1074    expand_file_name('~/.config', [Home]).
 1075% data
 1076'$xdg_directory'(data, Home) :-
 1077    current_prolog_flag(windows, true),
 1078    catch(win_folder(local_appdata, Home), _, fail),
 1079    !.
 1080'$xdg_directory'(data, Home) :-
 1081    getenv('XDG_DATA_HOME', Home).
 1082'$xdg_directory'(data, Home) :-
 1083    expand_file_name('~/.local', [Local]),
 1084    '$make_config_dir'(Local),
 1085    atom_concat(Local, '/share', Home),
 1086    '$make_config_dir'(Home).
 1087% common data
 1088'$xdg_directory'(common_data, Dir) :-
 1089    current_prolog_flag(windows, true),
 1090    catch(win_folder(common_appdata, Dir), _, fail),
 1091    !.
 1092'$xdg_directory'(common_data, Dir) :-
 1093    '$existing_dir_from_env_path'('XDG_DATA_DIRS',
 1094                                  [ '/usr/local/share',
 1095                                    '/usr/share'
 1096                                  ],
 1097                                  Dir).
 1098% common config
 1099'$xdg_directory'(common_config, Dir) :-
 1100    current_prolog_flag(windows, true),
 1101    catch(win_folder(common_appdata, Dir), _, fail),
 1102    !.
 1103'$xdg_directory'(common_config, Dir) :-
 1104    '$existing_dir_from_env_path'('XDG_CONFIG_DIRS', ['/etc/xdg'], Dir).
 1105
 1106'$existing_dir_from_env_path'(Env, Defaults, Dir) :-
 1107    (   getenv(Env, Path)
 1108    ->  '$path_sep'(Sep),
 1109        atomic_list_concat(Dirs, Sep, Path)
 1110    ;   Dirs = Defaults
 1111    ),
 1112    '$member'(Dir, Dirs),
 1113    Dir \== '',
 1114    exists_directory(Dir).
 1115
 1116'$path_sep'(Char) :-
 1117    (   current_prolog_flag(windows, true)
 1118    ->  Char = ';'
 1119    ;   Char = ':'
 1120    ).
 1121
 1122'$make_config_dir'(Dir) :-
 1123    exists_directory(Dir),
 1124    !.
 1125'$make_config_dir'(Dir) :-
 1126    nb_current('$create_search_directories', true),
 1127    file_directory_name(Dir, Parent),
 1128    '$my_file'(Parent),
 1129    catch(make_directory(Dir), _, fail).
 1130
 1131'$ensure_slash'(Dir, DirS) :-
 1132    (   sub_atom(Dir, _, _, 0, /)
 1133    ->  DirS = Dir
 1134    ;   atom_concat(Dir, /, DirS)
 1135    ).
 $expand_file_search_path(+Spec, -Expanded, +Cond) is nondet
 1140'$expand_file_search_path'(Spec, Expanded, Cond) :-
 1141    '$option'(access(Access), Cond),
 1142    memberchk(Access, [write,append]),
 1143    !,
 1144    setup_call_cleanup(
 1145        nb_setval('$create_search_directories', true),
 1146        expand_file_search_path(Spec, Expanded),
 1147        nb_delete('$create_search_directories')).
 1148'$expand_file_search_path'(Spec, Expanded, _Cond) :-
 1149    expand_file_search_path(Spec, Expanded).
 expand_file_search_path(+Spec, -Expanded) is nondet
Expand a search path. The system uses depth-first search upto a specified depth. If this depth is exceeded an exception is raised. TBD: bread-first search?
 1157expand_file_search_path(Spec, Expanded) :-
 1158    catch('$expand_file_search_path'(Spec, Expanded, 0, []),
 1159          loop(Used),
 1160          throw(error(loop_error(Spec), file_search(Used)))).
 1161
 1162'$expand_file_search_path'(Spec, Expanded, N, Used) :-
 1163    functor(Spec, Alias, 1),
 1164    !,
 1165    user:file_search_path(Alias, Exp0),
 1166    NN is N + 1,
 1167    (   NN > 16
 1168    ->  throw(loop(Used))
 1169    ;   true
 1170    ),
 1171    '$expand_file_search_path'(Exp0, Exp1, NN, [Alias=Exp0|Used]),
 1172    arg(1, Spec, Segments),
 1173    '$segments_to_atom'(Segments, File),
 1174    '$make_path'(Exp1, File, Expanded).
 1175'$expand_file_search_path'(Spec, Path, _, _) :-
 1176    '$segments_to_atom'(Spec, Path).
 1177
 1178'$make_path'(Dir, '.', Path) :-
 1179    !,
 1180    Path = Dir.
 1181'$make_path'(Dir, File, Path) :-
 1182    sub_atom(Dir, _, _, 0, /),
 1183    !,
 1184    atom_concat(Dir, File, Path).
 1185'$make_path'(Dir, File, Path) :-
 1186    atomic_list_concat([Dir, /, File], Path).
 1187
 1188
 1189                /********************************
 1190                *         FILE CHECKING         *
 1191                *********************************/
 absolute_file_name(+Term, -AbsoluteFile, +Options) is nondet
Translate path-specifier into a full path-name. This predicate originates from Quintus was introduced in SWI-Prolog very early and has re-appeared in SICStus 3.9.0, where they changed argument order and added some options. We addopted the SICStus argument order, but still accept the original argument order for compatibility reasons.
 1202absolute_file_name(Spec, Options, Path) :-
 1203    '$is_options'(Options),
 1204    \+ '$is_options'(Path),
 1205    !,
 1206    absolute_file_name(Spec, Path, Options).
 1207absolute_file_name(Spec, Path, Options) :-
 1208    '$must_be'(options, Options),
 1209                    % get the valid extensions
 1210    (   '$select_option'(extensions(Exts), Options, Options1)
 1211    ->  '$must_be'(list, Exts)
 1212    ;   '$option'(file_type(Type), Options)
 1213    ->  '$must_be'(atom, Type),
 1214        '$file_type_extensions'(Type, Exts),
 1215        Options1 = Options
 1216    ;   Options1 = Options,
 1217        Exts = ['']
 1218    ),
 1219    '$canonicalise_extensions'(Exts, Extensions),
 1220                    % unless specified otherwise, ask regular file
 1221    (   nonvar(Type)
 1222    ->  Options2 = Options1
 1223    ;   '$merge_options'(_{file_type:regular}, Options1, Options2)
 1224    ),
 1225                    % Det or nondet?
 1226    (   '$select_option'(solutions(Sols), Options2, Options3)
 1227    ->  '$must_be'(oneof(atom, solutions, [first,all]), Sols)
 1228    ;   Sols = first,
 1229        Options3 = Options2
 1230    ),
 1231                    % Errors or not?
 1232    (   '$select_option'(file_errors(FileErrors), Options3, Options4)
 1233    ->  '$must_be'(oneof(atom, file_errors, [error,fail]), FileErrors)
 1234    ;   FileErrors = error,
 1235        Options4 = Options3
 1236    ),
 1237                    % Expand shell patterns?
 1238    (   atomic(Spec),
 1239        '$select_option'(expand(Expand), Options4, Options5),
 1240        '$must_be'(boolean, Expand)
 1241    ->  expand_file_name(Spec, List),
 1242        '$member'(Spec1, List)
 1243    ;   Spec1 = Spec,
 1244        Options5 = Options4
 1245    ),
 1246                    % Search for files
 1247    (   Sols == first
 1248    ->  (   '$chk_file'(Spec1, Extensions, Options5, true, Path)
 1249        ->  !       % also kill choice point of expand_file_name/2
 1250        ;   (   FileErrors == fail
 1251            ->  fail
 1252            ;   '$current_module'('$bags', _File),
 1253                findall(P,
 1254                        '$chk_file'(Spec1, Extensions, [access(exist)],
 1255                                    false, P),
 1256                        Candidates),
 1257                '$abs_file_error'(Spec, Candidates, Options5)
 1258            )
 1259        )
 1260    ;   '$chk_file'(Spec1, Extensions, Options5, false, Path)
 1261    ).
 1262
 1263'$abs_file_error'(Spec, Candidates, Conditions) :-
 1264    '$member'(F, Candidates),
 1265    '$member'(C, Conditions),
 1266    '$file_condition'(C),
 1267    '$file_error'(C, Spec, F, E, Comment),
 1268    !,
 1269    throw(error(E, context(_, Comment))).
 1270'$abs_file_error'(Spec, _, _) :-
 1271    '$existence_error'(source_sink, Spec).
 1272
 1273'$file_error'(file_type(directory), Spec, File, Error, Comment) :-
 1274    \+ exists_directory(File),
 1275    !,
 1276    Error = existence_error(directory, Spec),
 1277    Comment = not_a_directory(File).
 1278'$file_error'(file_type(_), Spec, File, Error, Comment) :-
 1279    exists_directory(File),
 1280    !,
 1281    Error = existence_error(file, Spec),
 1282    Comment = directory(File).
 1283'$file_error'(access(OneOrList), Spec, File, Error, _) :-
 1284    '$one_or_member'(Access, OneOrList),
 1285    \+ access_file(File, Access),
 1286    Error = permission_error(Access, source_sink, Spec).
 1287
 1288'$one_or_member'(Elem, List) :-
 1289    is_list(List),
 1290    !,
 1291    '$member'(Elem, List).
 1292'$one_or_member'(Elem, Elem).
 1293
 1294
 1295'$file_type_extensions'(source, Exts) :-       % SICStus 3.9 compatibility
 1296    !,
 1297    '$file_type_extensions'(prolog, Exts).
 1298'$file_type_extensions'(Type, Exts) :-
 1299    '$current_module'('$bags', _File),
 1300    !,
 1301    findall(Ext, user:prolog_file_type(Ext, Type), Exts0),
 1302    (   Exts0 == [],
 1303        \+ '$ft_no_ext'(Type)
 1304    ->  '$domain_error'(file_type, Type)
 1305    ;   true
 1306    ),
 1307    '$append'(Exts0, [''], Exts).
 1308'$file_type_extensions'(prolog, [pl, '']). % findall is not yet defined ...
 1309
 1310'$ft_no_ext'(txt).
 1311'$ft_no_ext'(executable).
 1312'$ft_no_ext'(directory).
 user:prolog_file_type(?Extension, ?Type)
Define type of file based on the extension. This is used by absolute_file_name/3 and may be used to extend the list of extensions used for some type.

Note that qlf must be last when searching for Prolog files. Otherwise use_module/1 will consider the file as not-loaded because the .qlf file is not the loaded file. Must be fixed elsewhere.

 1325:- multifile(user:prolog_file_type/2). 1326:- dynamic(user:prolog_file_type/2). 1327
 1328user:prolog_file_type(pl,       prolog).
 1329user:prolog_file_type(prolog,   prolog).
 1330user:prolog_file_type(qlf,      prolog).
 1331user:prolog_file_type(qlf,      qlf).
 1332user:prolog_file_type(Ext,      executable) :-
 1333    current_prolog_flag(shared_object_extension, Ext).
 1334user:prolog_file_type(dylib,    executable) :-
 1335    current_prolog_flag(apple,  true).
 $chk_file(+Spec, +Extensions, +Cond, +UseCache, -FullName)
File is a specification of a Prolog source file. Return the full path of the file.
 1342'$chk_file'(Spec, _Extensions, _Cond, _Cache, _FullName) :-
 1343    \+ ground(Spec),
 1344    !,
 1345    '$instantiation_error'(Spec).
 1346'$chk_file'(Spec, Extensions, Cond, Cache, FullName) :-
 1347    compound(Spec),
 1348    functor(Spec, _, 1),
 1349    !,
 1350    '$relative_to'(Cond, cwd, CWD),
 1351    '$chk_alias_file'(Spec, Extensions, Cond, Cache, CWD, FullName).
 1352'$chk_file'(Segments, Ext, Cond, Cache, FullName) :-    % allow a/b/...
 1353    \+ atomic(Segments),
 1354    !,
 1355    '$segments_to_atom'(Segments, Atom),
 1356    '$chk_file'(Atom, Ext, Cond, Cache, FullName).
 1357'$chk_file'(File, Exts, Cond, _, FullName) :-
 1358    is_absolute_file_name(File),
 1359    !,
 1360    '$extend_file'(File, Exts, Extended),
 1361    '$file_conditions'(Cond, Extended),
 1362    '$absolute_file_name'(Extended, FullName).
 1363'$chk_file'(File, Exts, Cond, _, FullName) :-
 1364    '$relative_to'(Cond, source, Dir),
 1365    atomic_list_concat([Dir, /, File], AbsFile),
 1366    '$extend_file'(AbsFile, Exts, Extended),
 1367    '$file_conditions'(Cond, Extended),
 1368    !,
 1369    '$absolute_file_name'(Extended, FullName).
 1370'$chk_file'(File, Exts, Cond, _, FullName) :-
 1371    '$extend_file'(File, Exts, Extended),
 1372    '$file_conditions'(Cond, Extended),
 1373    '$absolute_file_name'(Extended, FullName).
 1374
 1375'$segments_to_atom'(Atom, Atom) :-
 1376    atomic(Atom),
 1377    !.
 1378'$segments_to_atom'(Segments, Atom) :-
 1379    '$segments_to_list'(Segments, List, []),
 1380    !,
 1381    atomic_list_concat(List, /, Atom).
 1382
 1383'$segments_to_list'(A/B, H, T) :-
 1384    '$segments_to_list'(A, H, T0),
 1385    '$segments_to_list'(B, T0, T).
 1386'$segments_to_list'(A, [A|T], T) :-
 1387    atomic(A).
 $relative_to(+Condition, +Default, -Dir)
Determine the directory to work from. This can be specified explicitely using one or more relative_to(FileOrDir) options or implicitely relative to the working directory or current source-file.
 1397'$relative_to'(Conditions, Default, Dir) :-
 1398    (   '$option'(relative_to(FileOrDir), Conditions)
 1399    *-> (   exists_directory(FileOrDir)
 1400        ->  Dir = FileOrDir
 1401        ;   atom_concat(Dir, /, FileOrDir)
 1402        ->  true
 1403        ;   file_directory_name(FileOrDir, Dir)
 1404        )
 1405    ;   Default == cwd
 1406    ->  '$cwd'(Dir)
 1407    ;   Default == source
 1408    ->  source_location(ContextFile, _Line),
 1409        file_directory_name(ContextFile, Dir)
 1410    ).
 $chk_alias_file(+Spec, +Exts, +Cond, +Cache, +CWD, -FullFile) is nondet
 1415:- dynamic
 1416    '$search_path_file_cache'/3,    % SHA1, Time, Path
 1417    '$search_path_gc_time'/1.       % Time
 1418:- volatile
 1419    '$search_path_file_cache'/3,
 1420    '$search_path_gc_time'/1. 1421
 1422:- create_prolog_flag(file_search_cache_time, 10, []). 1423
 1424'$chk_alias_file'(Spec, Exts, Cond, true, CWD, FullFile) :-
 1425    !,
 1426    findall(Exp, '$expand_file_search_path'(Spec, Exp, Cond), Expansions),
 1427    current_prolog_flag(emulated_dialect, Dialect),
 1428    Cache = cache(Exts, Cond, CWD, Expansions, Dialect),
 1429    variant_sha1(Spec+Cache, SHA1),
 1430    get_time(Now),
 1431    current_prolog_flag(file_search_cache_time, TimeOut),
 1432    (   '$search_path_file_cache'(SHA1, CachedTime, FullFile),
 1433        CachedTime > Now - TimeOut,
 1434        '$file_conditions'(Cond, FullFile)
 1435    ->  '$search_message'(file_search(cache(Spec, Cond), FullFile))
 1436    ;   '$member'(Expanded, Expansions),
 1437        '$extend_file'(Expanded, Exts, LibFile),
 1438        (   '$file_conditions'(Cond, LibFile),
 1439            '$absolute_file_name'(LibFile, FullFile),
 1440            '$cache_file_found'(SHA1, Now, TimeOut, FullFile)
 1441        ->  '$search_message'(file_search(found(Spec, Cond), FullFile))
 1442        ;   '$search_message'(file_search(tried(Spec, Cond), LibFile)),
 1443            fail
 1444        )
 1445    ).
 1446'$chk_alias_file'(Spec, Exts, Cond, false, _CWD, FullFile) :-
 1447    '$expand_file_search_path'(Spec, Expanded, Cond),
 1448    '$extend_file'(Expanded, Exts, LibFile),
 1449    '$file_conditions'(Cond, LibFile),
 1450    '$absolute_file_name'(LibFile, FullFile).
 1451
 1452'$cache_file_found'(_, _, TimeOut, _) :-
 1453    TimeOut =:= 0,
 1454    !.
 1455'$cache_file_found'(SHA1, Now, TimeOut, FullFile) :-
 1456    '$search_path_file_cache'(SHA1, Saved, FullFile),
 1457    !,
 1458    (   Now - Saved < TimeOut/2
 1459    ->  true
 1460    ;   retractall('$search_path_file_cache'(SHA1, _, _)),
 1461        asserta('$search_path_file_cache'(SHA1, Now, FullFile))
 1462    ).
 1463'$cache_file_found'(SHA1, Now, TimeOut, FullFile) :-
 1464    'gc_file_search_cache'(TimeOut),
 1465    asserta('$search_path_file_cache'(SHA1, Now, FullFile)).
 1466
 1467'gc_file_search_cache'(TimeOut) :-
 1468    get_time(Now),
 1469    '$search_path_gc_time'(Last),
 1470    Now-Last < TimeOut/2,
 1471    !.
 1472'gc_file_search_cache'(TimeOut) :-
 1473    get_time(Now),
 1474    retractall('$search_path_gc_time'(_)),
 1475    assertz('$search_path_gc_time'(Now)),
 1476    Before is Now - TimeOut,
 1477    (   '$search_path_file_cache'(SHA1, Cached, FullFile),
 1478        Cached < Before,
 1479        retractall('$search_path_file_cache'(SHA1, Cached, FullFile)),
 1480        fail
 1481    ;   true
 1482    ).
 1483
 1484
 1485'$search_message'(Term) :-
 1486    current_prolog_flag(verbose_file_search, true),
 1487    !,
 1488    print_message(informational, Term).
 1489'$search_message'(_).
 $file_conditions(+Condition, +Path)
Verify Path satisfies Condition.
 1496'$file_conditions'(List, File) :-
 1497    is_list(List),
 1498    !,
 1499    \+ ( '$member'(C, List),
 1500         '$file_condition'(C),
 1501         \+ '$file_condition'(C, File)
 1502       ).
 1503'$file_conditions'(Map, File) :-
 1504    \+ (  get_dict(Key, Map, Value),
 1505          C =.. [Key,Value],
 1506          '$file_condition'(C),
 1507         \+ '$file_condition'(C, File)
 1508       ).
 1509
 1510'$file_condition'(file_type(directory), File) :-
 1511    !,
 1512    exists_directory(File).
 1513'$file_condition'(file_type(_), File) :-
 1514    !,
 1515    \+ exists_directory(File).
 1516'$file_condition'(access(Accesses), File) :-
 1517    !,
 1518    \+ (  '$one_or_member'(Access, Accesses),
 1519          \+ access_file(File, Access)
 1520       ).
 1521
 1522'$file_condition'(exists).
 1523'$file_condition'(file_type(_)).
 1524'$file_condition'(access(_)).
 1525
 1526'$extend_file'(File, Exts, FileEx) :-
 1527    '$ensure_extensions'(Exts, File, Fs),
 1528    '$list_to_set'(Fs, FsSet),
 1529    '$member'(FileEx, FsSet).
 1530
 1531'$ensure_extensions'([], _, []).
 1532'$ensure_extensions'([E|E0], F, [FE|E1]) :-
 1533    file_name_extension(F, E, FE),
 1534    '$ensure_extensions'(E0, F, E1).
 $list_to_set(+List, -Set) is det
Turn list into a set, keeping the left-most copy of duplicate elements. Copied from library(lists).
 1541'$list_to_set'(List, Set) :-
 1542    '$number_list'(List, 1, Numbered),
 1543    sort(1, @=<, Numbered, ONum),
 1544    '$remove_dup_keys'(ONum, NumSet),
 1545    sort(2, @=<, NumSet, ONumSet),
 1546    '$pairs_keys'(ONumSet, Set).
 1547
 1548'$number_list'([], _, []).
 1549'$number_list'([H|T0], N, [H-N|T]) :-
 1550    N1 is N+1,
 1551    '$number_list'(T0, N1, T).
 1552
 1553'$remove_dup_keys'([], []).
 1554'$remove_dup_keys'([H|T0], [H|T]) :-
 1555    H = V-_,
 1556    '$remove_same_key'(T0, V, T1),
 1557    '$remove_dup_keys'(T1, T).
 1558
 1559'$remove_same_key'([V1-_|T0], V, T) :-
 1560    V1 == V,
 1561    !,
 1562    '$remove_same_key'(T0, V, T).
 1563'$remove_same_key'(L, _, L).
 1564
 1565'$pairs_keys'([], []).
 1566'$pairs_keys'([K-_|T0], [K|T]) :-
 1567    '$pairs_keys'(T0, T).
 1568
 1569
 1570/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
 1571Canonicalise the extension list. Old SWI-Prolog   require  `.pl', etc, which
 1572the Quintus compatibility  requests  `pl'.   This  layer  canonicalises  all
 1573extensions to .ext
 1574- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
 1575
 1576'$canonicalise_extensions'([], []) :- !.
 1577'$canonicalise_extensions'([H|T], [CH|CT]) :-
 1578    !,
 1579    '$must_be'(atom, H),
 1580    '$canonicalise_extension'(H, CH),
 1581    '$canonicalise_extensions'(T, CT).
 1582'$canonicalise_extensions'(E, [CE]) :-
 1583    '$canonicalise_extension'(E, CE).
 1584
 1585'$canonicalise_extension'('', '') :- !.
 1586'$canonicalise_extension'(DotAtom, DotAtom) :-
 1587    sub_atom(DotAtom, 0, _, _, '.'),
 1588    !.
 1589'$canonicalise_extension'(Atom, DotAtom) :-
 1590    atom_concat('.', Atom, DotAtom).
 1591
 1592
 1593                /********************************
 1594                *            CONSULT            *
 1595                *********************************/
 1596
 1597:- dynamic
 1598    user:library_directory/1,
 1599    user:prolog_load_file/2. 1600:- multifile
 1601    user:library_directory/1,
 1602    user:prolog_load_file/2. 1603
 1604:- prompt(_, '|: '). 1605
 1606:- thread_local
 1607    '$compilation_mode_store'/1,    % database, wic, qlf
 1608    '$directive_mode_store'/1.      % database, wic, qlf
 1609:- volatile
 1610    '$compilation_mode_store'/1,
 1611    '$directive_mode_store'/1. 1612
 1613'$compilation_mode'(Mode) :-
 1614    (   '$compilation_mode_store'(Val)
 1615    ->  Mode = Val
 1616    ;   Mode = database
 1617    ).
 1618
 1619'$set_compilation_mode'(Mode) :-
 1620    retractall('$compilation_mode_store'(_)),
 1621    assertz('$compilation_mode_store'(Mode)).
 1622
 1623'$compilation_mode'(Old, New) :-
 1624    '$compilation_mode'(Old),
 1625    (   New == Old
 1626    ->  true
 1627    ;   '$set_compilation_mode'(New)
 1628    ).
 1629
 1630'$directive_mode'(Mode) :-
 1631    (   '$directive_mode_store'(Val)
 1632    ->  Mode = Val
 1633    ;   Mode = database
 1634    ).
 1635
 1636'$directive_mode'(Old, New) :-
 1637    '$directive_mode'(Old),
 1638    (   New == Old
 1639    ->  true
 1640    ;   '$set_directive_mode'(New)
 1641    ).
 1642
 1643'$set_directive_mode'(Mode) :-
 1644    retractall('$directive_mode_store'(_)),
 1645    assertz('$directive_mode_store'(Mode)).
 $compilation_level(-Level) is det
True when Level reflects the nesting in files compiling other files. 0 if no files are being loaded.
 1653'$compilation_level'(Level) :-
 1654    '$input_context'(Stack),
 1655    '$compilation_level'(Stack, Level).
 1656
 1657'$compilation_level'([], 0).
 1658'$compilation_level'([Input|T], Level) :-
 1659    (   arg(1, Input, see)
 1660    ->  '$compilation_level'(T, Level)
 1661    ;   '$compilation_level'(T, Level0),
 1662        Level is Level0+1
 1663    ).
 compiling
Is true if SWI-Prolog is generating a state or qlf file or executes a `call' directive while doing this.
 1671compiling :-
 1672    \+ (   '$compilation_mode'(database),
 1673           '$directive_mode'(database)
 1674       ).
 1675
 1676:- meta_predicate
 1677    '$ifcompiling'(0). 1678
 1679'$ifcompiling'(G) :-
 1680    (   '$compilation_mode'(database)
 1681    ->  true
 1682    ;   call(G)
 1683    ).
 1684
 1685                /********************************
 1686                *         READ SOURCE           *
 1687                *********************************/
 $load_msg_level(+Action, +NestingLevel, -StartVerbose, -EndVerbose)
 1691'$load_msg_level'(Action, Nesting, Start, Done) :-
 1692    '$update_autoload_level'([], 0),
 1693    !,
 1694    current_prolog_flag(verbose_load, Type0),
 1695    '$load_msg_compat'(Type0, Type),
 1696    (   '$load_msg_level'(Action, Nesting, Type, Start, Done)
 1697    ->  true
 1698    ).
 1699'$load_msg_level'(_, _, silent, silent).
 1700
 1701'$load_msg_compat'(true, normal) :- !.
 1702'$load_msg_compat'(false, silent) :- !.
 1703'$load_msg_compat'(X, X).
 1704
 1705'$load_msg_level'(load_file,    _, full,   informational, informational).
 1706'$load_msg_level'(include_file, _, full,   informational, informational).
 1707'$load_msg_level'(load_file,    _, normal, silent,        informational).
 1708'$load_msg_level'(include_file, _, normal, silent,        silent).
 1709'$load_msg_level'(load_file,    0, brief,  silent,        informational).
 1710'$load_msg_level'(load_file,    _, brief,  silent,        silent).
 1711'$load_msg_level'(include_file, _, brief,  silent,        silent).
 1712'$load_msg_level'(load_file,    _, silent, silent,        silent).
 1713'$load_msg_level'(include_file, _, silent, silent,        silent).
 $source_term(+From, -Read, -RLayout, -Term, -TLayout, -Stream, +Options) is nondet
Read Prolog terms from the input From. Terms are returned on backtracking. Associated resources (i.e., streams) are closed due to setup_call_cleanup/3.
Arguments:
From- is either a term stream(Id, Stream) or a file specification.
Read- is the raw term as read from the input.
Term- is the term after term-expansion. If a term is expanded into the empty list, this is returned too. This is required to be able to return the raw term in Read
Stream- is the stream from which Read is read
Options- provides additional options:
encoding(Enc)
Encoding used to open From
syntax_errors(+ErrorMode)
process_comments(+Boolean)
term_position(-Pos)
 1736'$source_term'(From, Read, RLayout, Term, TLayout, Stream, Options) :-
 1737    '$source_term'(From, Read, RLayout, Term, TLayout, Stream, [], Options),
 1738    (   Term == end_of_file
 1739    ->  !, fail
 1740    ;   Term \== begin_of_file
 1741    ).
 1742
 1743'$source_term'(Input, _,_,_,_,_,_,_) :-
 1744    \+ ground(Input),
 1745    !,
 1746    '$instantiation_error'(Input).
 1747'$source_term'(stream(Id, In, Opts),
 1748               Read, RLayout, Term, TLayout, Stream, Parents, Options) :-
 1749    !,
 1750    '$record_included'(Parents, Id, Id, 0.0, Message),
 1751    setup_call_cleanup(
 1752        '$open_source'(stream(Id, In, Opts), In, State, Parents, Options),
 1753        '$term_in_file'(In, Read, RLayout, Term, TLayout, Stream,
 1754                        [Id|Parents], Options),
 1755        '$close_source'(State, Message)).
 1756'$source_term'(File,
 1757               Read, RLayout, Term, TLayout, Stream, Parents, Options) :-
 1758    absolute_file_name(File, Path,
 1759                       [ file_type(prolog),
 1760                         access(read)
 1761                       ]),
 1762    time_file(Path, Time),
 1763    '$record_included'(Parents, File, Path, Time, Message),
 1764    setup_call_cleanup(
 1765        '$open_source'(Path, In, State, Parents, Options),
 1766        '$term_in_file'(In, Read, RLayout, Term, TLayout, Stream,
 1767                        [Path|Parents], Options),
 1768        '$close_source'(State, Message)).
 1769
 1770:- thread_local
 1771    '$load_input'/2. 1772:- volatile
 1773    '$load_input'/2. 1774
 1775'$open_source'(stream(Id, In, Opts), In,
 1776               restore(In, StreamState, Id, Ref, Opts), Parents, _Options) :-
 1777    !,
 1778    '$context_type'(Parents, ContextType),
 1779    '$push_input_context'(ContextType),
 1780    '$prepare_load_stream'(In, Id, StreamState),
 1781    asserta('$load_input'(stream(Id), In), Ref).
 1782'$open_source'(Path, In, close(In, Path, Ref), Parents, Options) :-
 1783    '$context_type'(Parents, ContextType),
 1784    '$push_input_context'(ContextType),
 1785    '$open_source'(Path, In, Options),
 1786    '$set_encoding'(In, Options),
 1787    asserta('$load_input'(Path, In), Ref).
 1788
 1789'$context_type'([], load_file) :- !.
 1790'$context_type'(_, include).
 1791
 1792:- multifile prolog:open_source_hook/3. 1793
 1794'$open_source'(Path, In, Options) :-
 1795    prolog:open_source_hook(Path, In, Options),
 1796    !.
 1797'$open_source'(Path, In, _Options) :-
 1798    open(Path, read, In).
 1799
 1800'$close_source'(close(In, _Id, Ref), Message) :-
 1801    erase(Ref),
 1802    call_cleanup(
 1803        close(In),
 1804        '$pop_input_context'),
 1805    '$close_message'(Message).
 1806'$close_source'(restore(In, StreamState, _Id, Ref, Opts), Message) :-
 1807    erase(Ref),
 1808    call_cleanup(
 1809        '$restore_load_stream'(In, StreamState, Opts),
 1810        '$pop_input_context'),
 1811    '$close_message'(Message).
 1812
 1813'$close_message'(message(Level, Msg)) :-
 1814    !,
 1815    '$print_message'(Level, Msg).
 1816'$close_message'(_).
 $term_in_file(+In, -Read, -RLayout, -Term, -TLayout, -Stream, +Parents, +Options) is multi
True when Term is an expanded term from In. Read is a raw term (before term-expansion). Stream is the actual stream, which starts at In, but may change due to processing included files.
See also
- '$source_term'/8 for details.
 1828'$term_in_file'(In, Read, RLayout, Term, TLayout, Stream, Parents, Options) :-
 1829    Parents \= [_,_|_],
 1830    (   '$load_input'(_, Input)
 1831    ->  stream_property(Input, file_name(File))
 1832    ),
 1833    '$set_source_location'(File, 0),
 1834    '$expanded_term'(In,
 1835                     begin_of_file, 0-0, Read, RLayout, Term, TLayout,
 1836                     Stream, Parents, Options).
 1837'$term_in_file'(In, Read, RLayout, Term, TLayout, Stream, Parents, Options) :-
 1838    '$skip_script_line'(In, Options),
 1839    '$read_clause_options'(Options, ReadOptions),
 1840    repeat,
 1841      read_clause(In, Raw,
 1842                  [ variable_names(Bindings),
 1843                    term_position(Pos),
 1844                    subterm_positions(RawLayout)
 1845                  | ReadOptions
 1846                  ]),
 1847      b_setval('$term_position', Pos),
 1848      b_setval('$variable_names', Bindings),
 1849      (   Raw == end_of_file
 1850      ->  !,
 1851          (   Parents = [_,_|_]     % Included file
 1852          ->  fail
 1853          ;   '$expanded_term'(In,
 1854                               Raw, RawLayout, Read, RLayout, Term, TLayout,
 1855                               Stream, Parents, Options)
 1856          )
 1857      ;   '$expanded_term'(In, Raw, RawLayout, Read, RLayout, Term, TLayout,
 1858                           Stream, Parents, Options)
 1859      ).
 1860
 1861'$read_clause_options'([], []).
 1862'$read_clause_options'([H|T0], List) :-
 1863    (   '$read_clause_option'(H)
 1864    ->  List = [H|T]
 1865    ;   List = T
 1866    ),
 1867    '$read_clause_options'(T0, T).
 1868
 1869'$read_clause_option'(syntax_errors(_)).
 1870'$read_clause_option'(term_position(_)).
 1871'$read_clause_option'(process_comment(_)).
 1872
 1873'$expanded_term'(In, Raw, RawLayout, Read, RLayout, Term, TLayout,
 1874                 Stream, Parents, Options) :-
 1875    E = error(_,_),
 1876    catch('$expand_term'(Raw, RawLayout, Expanded, ExpandedLayout), E,
 1877          '$print_message_fail'(E)),
 1878    (   Expanded \== []
 1879    ->  '$expansion_member'(Expanded, ExpandedLayout, Term1, Layout1)
 1880    ;   Term1 = Expanded,
 1881        Layout1 = ExpandedLayout
 1882    ),
 1883    (   nonvar(Term1), Term1 = (:-Directive), nonvar(Directive)
 1884    ->  (   Directive = include(File),
 1885            '$current_source_module'(Module),
 1886            '$valid_directive'(Module:include(File))
 1887        ->  stream_property(In, encoding(Enc)),
 1888            '$add_encoding'(Enc, Options, Options1),
 1889            '$source_term'(File, Read, RLayout, Term, TLayout,
 1890                           Stream, Parents, Options1)
 1891        ;   Directive = encoding(Enc)
 1892        ->  set_stream(In, encoding(Enc)),
 1893            fail
 1894        ;   Term = Term1,
 1895            Stream = In,
 1896            Read = Raw
 1897        )
 1898    ;   Term = Term1,
 1899        TLayout = Layout1,
 1900        Stream = In,
 1901        Read = Raw,
 1902        RLayout = RawLayout
 1903    ).
 1904
 1905'$expansion_member'(Var, Layout, Var, Layout) :-
 1906    var(Var),
 1907    !.
 1908'$expansion_member'([], _, _, _) :- !, fail.
 1909'$expansion_member'(List, ListLayout, Term, Layout) :-
 1910    is_list(List),
 1911    !,
 1912    (   var(ListLayout)
 1913    ->  '$member'(Term, List)
 1914    ;   is_list(ListLayout)
 1915    ->  '$member_rep2'(Term, Layout, List, ListLayout)
 1916    ;   Layout = ListLayout,
 1917        '$member'(Term, List)
 1918    ).
 1919'$expansion_member'(X, Layout, X, Layout).
 1920
 1921% pairwise member, repeating last element of the second
 1922% list.
 1923
 1924'$member_rep2'(H1, H2, [H1|_], [H2|_]).
 1925'$member_rep2'(H1, H2, [_|T1], [T2]) :-
 1926    !,
 1927    '$member_rep2'(H1, H2, T1, [T2]).
 1928'$member_rep2'(H1, H2, [_|T1], [_|T2]) :-
 1929    '$member_rep2'(H1, H2, T1, T2).
 $add_encoding(+Enc, +Options0, -Options)
 1933'$add_encoding'(Enc, Options0, Options) :-
 1934    (   Options0 = [encoding(Enc)|_]
 1935    ->  Options = Options0
 1936    ;   Options = [encoding(Enc)|Options0]
 1937    ).
 1938
 1939
 1940:- multifile
 1941    '$included'/4.                  % Into, Line, File, LastModified
 1942:- dynamic
 1943    '$included'/4.
 $record_included(+Parents, +File, +Path, +Time, -Message) is det
Record that we included File into the head of Parents. This is troublesome when creating a QLF file because this may happen before we opened the QLF file (and we do not yet know how to open the file because we do not yet know whether this is a module file or not).

I think that the only sensible solution is to have a special statement for this, that may appear both inside and outside QLF `parts'.

 1957'$record_included'([Parent|Parents], File, Path, Time,
 1958                   message(DoneMsgLevel,
 1959                           include_file(done(Level, file(File, Path))))) :-
 1960    source_location(SrcFile, Line),
 1961    !,
 1962    '$compilation_level'(Level),
 1963    '$load_msg_level'(include_file, Level, StartMsgLevel, DoneMsgLevel),
 1964    '$print_message'(StartMsgLevel,
 1965                     include_file(start(Level,
 1966                                        file(File, Path)))),
 1967    '$last'([Parent|Parents], Owner),
 1968    (   (   '$compilation_mode'(database)
 1969        ;   '$qlf_current_source'(Owner)
 1970        )
 1971    ->  '$store_admin_clause'(
 1972            system:'$included'(Parent, Line, Path, Time),
 1973            _, Owner, SrcFile:Line)
 1974    ;   '$qlf_include'(Owner, Parent, Line, Path, Time)
 1975    ).
 1976'$record_included'(_, _, _, _, true).
 $master_file(+File, -MasterFile)
Find the primary load file from included files.
 1982'$master_file'(File, MasterFile) :-
 1983    '$included'(MasterFile0, _Line, File, _Time),
 1984    !,
 1985    '$master_file'(MasterFile0, MasterFile).
 1986'$master_file'(File, File).
 1987
 1988
 1989'$skip_script_line'(_In, Options) :-
 1990    '$option'(check_script(false), Options),
 1991    !.
 1992'$skip_script_line'(In, _Options) :-
 1993    (   peek_char(In, #)
 1994    ->  skip(In, 10)
 1995    ;   true
 1996    ).
 1997
 1998'$set_encoding'(Stream, Options) :-
 1999    '$option'(encoding(Enc), Options),
 2000    !,
 2001    Enc \== default,
 2002    set_stream(Stream, encoding(Enc)).
 2003'$set_encoding'(_, _).
 2004
 2005
 2006'$prepare_load_stream'(In, Id, state(HasName,HasPos)) :-
 2007    (   stream_property(In, file_name(_))
 2008    ->  HasName = true,
 2009        (   stream_property(In, position(_))
 2010        ->  HasPos = true
 2011        ;   HasPos = false,
 2012            set_stream(In, record_position(true))
 2013        )
 2014    ;   HasName = false,
 2015        set_stream(In, file_name(Id)),
 2016        (   stream_property(In, position(_))
 2017        ->  HasPos = true
 2018        ;   HasPos = false,
 2019            set_stream(In, record_position(true))
 2020        )
 2021    ).
 2022
 2023'$restore_load_stream'(In, _State, Options) :-
 2024    memberchk(close(true), Options),
 2025    !,
 2026    close(In).
 2027'$restore_load_stream'(In, state(HasName, HasPos), _Options) :-
 2028    (   HasName == false
 2029    ->  set_stream(In, file_name(''))
 2030    ;   true
 2031    ),
 2032    (   HasPos == false
 2033    ->  set_stream(In, record_position(false))
 2034    ;   true
 2035    ).
 2036
 2037
 2038                 /*******************************
 2039                 *          DERIVED FILES       *
 2040                 *******************************/
 2041
 2042:- dynamic
 2043    '$derived_source_db'/3.         % Loaded, DerivedFrom, Time
 2044
 2045'$register_derived_source'(_, '-') :- !.
 2046'$register_derived_source'(Loaded, DerivedFrom) :-
 2047    retractall('$derived_source_db'(Loaded, _, _)),
 2048    time_file(DerivedFrom, Time),
 2049    assert('$derived_source_db'(Loaded, DerivedFrom, Time)).
 2050
 2051%       Auto-importing dynamic predicates is not very elegant and
 2052%       leads to problems with qsave_program/[1,2]
 2053
 2054'$derived_source'(Loaded, DerivedFrom, Time) :-
 2055    '$derived_source_db'(Loaded, DerivedFrom, Time).
 2056
 2057
 2058                /********************************
 2059                *       LOAD PREDICATES         *
 2060                *********************************/
 2061
 2062:- meta_predicate
 2063    ensure_loaded(:),
 2064    [:|+],
 2065    consult(:),
 2066    use_module(:),
 2067    use_module(:, +),
 2068    reexport(:),
 2069    reexport(:, +),
 2070    load_files(:),
 2071    load_files(:, +).
 ensure_loaded(+FileOrListOfFiles)
Load specified files, provided they where not loaded before. If the file is a module file import the public predicates into the context module.
 2079ensure_loaded(Files) :-
 2080    load_files(Files, [if(not_loaded)]).
 use_module(+FileOrListOfFiles)
Very similar to ensure_loaded/1, but insists on the loaded file to be a module file. If the file is already imported, but the public predicates are not yet imported into the context module, then do so.
 2089use_module(Files) :-
 2090    load_files(Files, [ if(not_loaded),
 2091                        must_be_module(true)
 2092                      ]).
 use_module(+File, +ImportList)
As use_module/1, but takes only one file argument and imports only the specified predicates rather than all public predicates.
 2099use_module(File, Import) :-
 2100    load_files(File, [ if(not_loaded),
 2101                       must_be_module(true),
 2102                       imports(Import)
 2103                     ]).
 reexport(+Files)
As use_module/1, exporting all imported predicates.
 2109reexport(Files) :-
 2110    load_files(Files, [ if(not_loaded),
 2111                        must_be_module(true),
 2112                        reexport(true)
 2113                      ]).
 reexport(+File, +ImportList)
As use_module/1, re-exporting all imported predicates.
 2119reexport(File, Import) :-
 2120    load_files(File, [ if(not_loaded),
 2121                       must_be_module(true),
 2122                       imports(Import),
 2123                       reexport(true)
 2124                     ]).
 2125
 2126
 2127[X] :-
 2128    !,
 2129    consult(X).
 2130[M:F|R] :-
 2131    consult(M:[F|R]).
 2132
 2133consult(M:X) :-
 2134    X == user,
 2135    !,
 2136    flag('$user_consult', N, N+1),
 2137    NN is N + 1,
 2138    atom_concat('user://', NN, Id),
 2139    load_files(M:Id, [stream(user_input), check_script(false), silent(false)]).
 2140consult(List) :-
 2141    load_files(List, [expand(true)]).
 load_files(:File, +Options)
Common entry for all the consult derivates. File is the raw user specified file specification, possibly tagged with the module.
 2148load_files(Files) :-
 2149    load_files(Files, []).
 2150load_files(Module:Files, Options) :-
 2151    '$must_be'(list, Options),
 2152    '$load_files'(Files, Module, Options).
 2153
 2154'$load_files'(X, _, _) :-
 2155    var(X),
 2156    !,
 2157    '$instantiation_error'(X).
 2158'$load_files'([], _, _) :- !.
 2159'$load_files'(Id, Module, Options) :-   % load_files(foo, [stream(In)])
 2160    '$option'(stream(_), Options),
 2161    !,
 2162    (   atom(Id)
 2163    ->  '$load_file'(Id, Module, Options)
 2164    ;   throw(error(type_error(atom, Id), _))
 2165    ).
 2166'$load_files'(List, Module, Options) :-
 2167    List = [_|_],
 2168    !,
 2169    '$must_be'(list, List),
 2170    '$load_file_list'(List, Module, Options).
 2171'$load_files'(File, Module, Options) :-
 2172    '$load_one_file'(File, Module, Options).
 2173
 2174'$load_file_list'([], _, _).
 2175'$load_file_list'([File|Rest], Module, Options) :-
 2176    E = error(_,_),
 2177    catch('$load_one_file'(File, Module, Options), E,
 2178          '$print_message'(error, E)),
 2179    '$load_file_list'(Rest, Module, Options).
 2180
 2181
 2182'$load_one_file'(Spec, Module, Options) :-
 2183    atomic(Spec),
 2184    '$option'(expand(Expand), Options, false),
 2185    Expand == true,
 2186    !,
 2187    expand_file_name(Spec, Expanded),
 2188    (   Expanded = [Load]
 2189    ->  true
 2190    ;   Load = Expanded
 2191    ),
 2192    '$load_files'(Load, Module, [expand(false)|Options]).
 2193'$load_one_file'(File, Module, Options) :-
 2194    strip_module(Module:File, Into, PlainFile),
 2195    '$load_file'(PlainFile, Into, Options).
 $noload(+Condition, +FullFile, +Options) is semidet
True of FullFile should not be loaded.
 2202'$noload'(true, _, _) :-
 2203    !,
 2204    fail.
 2205'$noload'(_, FullFile, _Options) :-
 2206    '$time_source_file'(FullFile, Time, system),
 2207    Time > 0.0,
 2208    !.
 2209'$noload'(not_loaded, FullFile, _) :-
 2210    source_file(FullFile),
 2211    !.
 2212'$noload'(changed, Derived, _) :-
 2213    '$derived_source'(_FullFile, Derived, LoadTime),
 2214    time_file(Derived, Modified),
 2215    Modified @=< LoadTime,
 2216    !.
 2217'$noload'(changed, FullFile, Options) :-
 2218    '$time_source_file'(FullFile, LoadTime, user),
 2219    '$modified_id'(FullFile, Modified, Options),
 2220    Modified @=< LoadTime,
 2221    !.
 $qlf_file(+Spec, +PlFile, -LoadFile, -Mode, +Options) is det
Determine how to load the source. LoadFile is the file to be loaded, Mode is how to load it. Mode is one of
compile
Normal source compilation
qcompile
Compile from source, creating a QLF file in the process
qload
Load from QLF file.
stream
Load from a stream. Content can be a source or QLF file.
Arguments:
Spec- is the original search specification
PlFile- is the resolved absolute path to the Prolog file.
 2240'$qlf_file'(Spec, _, Spec, stream, Options) :-
 2241    '$option'(stream(_), Options),      % stream: no choice
 2242    !.
 2243'$qlf_file'(Spec, FullFile, FullFile, compile, _) :-
 2244    '$spec_extension'(Spec, Ext),       % user explicitly specified
 2245    user:prolog_file_type(Ext, prolog),
 2246    !.
 2247'$qlf_file'(Spec, FullFile, LoadFile, Mode, Options) :-
 2248    '$compilation_mode'(database),
 2249    file_name_extension(Base, PlExt, FullFile),
 2250    user:prolog_file_type(PlExt, prolog),
 2251    user:prolog_file_type(QlfExt, qlf),
 2252    file_name_extension(Base, QlfExt, QlfFile),
 2253    (   access_file(QlfFile, read),
 2254        (   '$qlf_out_of_date'(FullFile, QlfFile, Why)
 2255        ->  (   access_file(QlfFile, write)
 2256            ->  print_message(informational,
 2257                              qlf(recompile(Spec, FullFile, QlfFile, Why))),
 2258                Mode = qcompile,
 2259                LoadFile = FullFile
 2260            ;   Why == old,
 2261                current_prolog_flag(home, PlHome),
 2262                sub_atom(FullFile, 0, _, _, PlHome)
 2263            ->  print_message(silent,
 2264                              qlf(system_lib_out_of_date(Spec, QlfFile))),
 2265                Mode = qload,
 2266                LoadFile = QlfFile
 2267            ;   print_message(warning,
 2268                              qlf(can_not_recompile(Spec, QlfFile, Why))),
 2269                Mode = compile,
 2270                LoadFile = FullFile
 2271            )
 2272        ;   Mode = qload,
 2273            LoadFile = QlfFile
 2274        )
 2275    ->  !
 2276    ;   '$qlf_auto'(FullFile, QlfFile, Options)
 2277    ->  !, Mode = qcompile,
 2278        LoadFile = FullFile
 2279    ).
 2280'$qlf_file'(_, FullFile, FullFile, compile, _).
 $qlf_out_of_date(+PlFile, +QlfFile, -Why) is semidet
True if the QlfFile file is out-of-date because of Why. This predicate is the negation such that we can return the reason.
 2288'$qlf_out_of_date'(PlFile, QlfFile, Why) :-
 2289    (   access_file(PlFile, read)
 2290    ->  time_file(PlFile, PlTime),
 2291        time_file(QlfFile, QlfTime),
 2292        (   PlTime > QlfTime
 2293        ->  Why = old                   % PlFile is newer
 2294        ;   Error = error(Formal,_),
 2295            catch('$qlf_sources'(QlfFile, _Files), Error, true),
 2296            nonvar(Formal)              % QlfFile is incompatible
 2297        ->  Why = Error
 2298        ;   fail                        % QlfFile is up-to-date and ok
 2299        )
 2300    ;   fail                            % can not read .pl; try .qlf
 2301    ).
 $qlf_auto(+PlFile, +QlfFile, +Options) is semidet
True if we create QlfFile using qcompile/2. This is determined by the option qcompile(QlfMode) or, if this is not present, by the prolog_flag qcompile.
 2309:- create_prolog_flag(qcompile, false, [type(atom)]). 2310
 2311'$qlf_auto'(PlFile, QlfFile, Options) :-
 2312    (   memberchk(qcompile(QlfMode), Options)
 2313    ->  true
 2314    ;   current_prolog_flag(qcompile, QlfMode),
 2315        \+ '$in_system_dir'(PlFile)
 2316    ),
 2317    (   QlfMode == auto
 2318    ->  true
 2319    ;   QlfMode == large,
 2320        size_file(PlFile, Size),
 2321        Size > 100000
 2322    ),
 2323    access_file(QlfFile, write).
 2324
 2325'$in_system_dir'(PlFile) :-
 2326    current_prolog_flag(home, Home),
 2327    sub_atom(PlFile, 0, _, _, Home).
 2328
 2329'$spec_extension'(File, Ext) :-
 2330    atom(File),
 2331    file_name_extension(_, Ext, File).
 2332'$spec_extension'(Spec, Ext) :-
 2333    compound(Spec),
 2334    arg(1, Spec, Arg),
 2335    '$spec_extension'(Arg, Ext).
 $load_file(+Spec, +ContextModule, +Options) is det
Load the file Spec into ContextModule controlled by Options. This wrapper deals with two cases before proceeding to the real loader:
 2347:- dynamic
 2348    '$resolved_source_path_db'/3.                % ?Spec, ?Dialect, ?Path
 2349
 2350'$load_file'(File, Module, Options) :-
 2351    \+ memberchk(stream(_), Options),
 2352    user:prolog_load_file(Module:File, Options),
 2353    !.
 2354'$load_file'(File, Module, Options) :-
 2355    memberchk(stream(_), Options),
 2356    !,
 2357    '$assert_load_context_module'(File, Module, Options),
 2358    '$qdo_load_file'(File, File, Module, Options).
 2359'$load_file'(File, Module, Options) :-
 2360    (   '$resolved_source_path'(File, FullFile, Options)
 2361    ->  true
 2362    ;   '$resolve_source_path'(File, FullFile, Options)
 2363    ),
 2364    '$mt_load_file'(File, FullFile, Module, Options).
 $resolved_source_path(+File, -FullFile, +Options) is semidet
True when File has already been resolved to an absolute path.
 2370'$resolved_source_path'(File, FullFile, Options) :-
 2371    current_prolog_flag(emulated_dialect, Dialect),
 2372    '$resolved_source_path_db'(File, Dialect, FullFile),
 2373    (   '$source_file_property'(FullFile, from_state, true)
 2374    ;   '$source_file_property'(FullFile, resource, true)
 2375    ;   '$option'(if(If), Options, true),
 2376        '$noload'(If, FullFile, Options)
 2377    ),
 2378    !.
 $resolve_source_path(+File, -FullFile, Options) is det
Resolve a source file specification to an absolute path. May throw existence and other errors.
 2385'$resolve_source_path'(File, FullFile, _Options) :-
 2386    absolute_file_name(File, FullFile,
 2387                       [ file_type(prolog),
 2388                         access(read)
 2389                       ]),
 2390    '$register_resolved_source_path'(File, FullFile).
 2391
 2392
 2393'$register_resolved_source_path'(File, FullFile) :-
 2394    (   compound(File)
 2395    ->  current_prolog_flag(emulated_dialect, Dialect),
 2396        (   '$resolved_source_path_db'(File, Dialect, FullFile)
 2397        ->  true
 2398        ;   asserta('$resolved_source_path_db'(File, Dialect, FullFile))
 2399        )
 2400    ;   true
 2401    ).
 $translated_source(+Old, +New) is det
Called from loading a QLF state when source files are being renamed.
 2407:- public '$translated_source'/2. 2408'$translated_source'(Old, New) :-
 2409    forall(retract('$resolved_source_path_db'(File, Dialect, Old)),
 2410           assertz('$resolved_source_path_db'(File, Dialect, New))).
 $register_resource_file(+FullFile) is det
If we load a file from a resource we lock it, so we never have to check the modification again.
 2417'$register_resource_file'(FullFile) :-
 2418    (   sub_atom(FullFile, 0, _, _, 'res://')
 2419    ->  '$set_source_file'(FullFile, resource, true)
 2420    ;   true
 2421    ).
 $already_loaded(+File, +FullFile, +Module, +Options) is det
Called if File is already loaded. If this is a module-file, the module must be imported into the context Module. If it is not a module file, it must be reloaded.
bug
- A file may be associated with multiple modules. How do we find the `main export module'? Currently there is no good way to find out which module is associated to the file as a result of the first :- module/2 term.
 2434'$already_loaded'(_File, FullFile, Module, Options) :-
 2435    '$assert_load_context_module'(FullFile, Module, Options),
 2436    '$current_module'(LoadModules, FullFile),
 2437    !,
 2438    (   atom(LoadModules)
 2439    ->  LoadModule = LoadModules
 2440    ;   LoadModules = [LoadModule|_]
 2441    ),
 2442    '$import_from_loaded_module'(LoadModule, Module, Options).
 2443'$already_loaded'(_, _, user, _) :- !.
 2444'$already_loaded'(File, FullFile, Module, Options) :-
 2445    (   '$load_context_module'(FullFile, Module, CtxOptions),
 2446        '$load_ctx_options'(Options, CtxOptions)
 2447    ->  true
 2448    ;   '$load_file'(File, Module, [if(true)|Options])
 2449    ).
 $mt_load_file(+File, +FullFile, +Module, +Options) is det
Deal with multi-threaded loading of files. The thread that wishes to load the thread first will do so, while other threads will wait until the leader finished and than act as if the file is already loaded.

Synchronisation is handled using a message queue that exists while the file is being loaded. This synchronisation relies on the fact that thread_get_message/1 throws an existence_error if the message queue is destroyed. This is hacky. Events or condition variables would have made a cleaner design.

 2464:- dynamic
 2465    '$loading_file'/3.              % File, Queue, Thread
 2466:- volatile
 2467    '$loading_file'/3. 2468
 2469'$mt_load_file'(File, FullFile, Module, Options) :-
 2470    current_prolog_flag(threads, true),
 2471    !,
 2472    '$sig_atomic'(setup_call_cleanup(
 2473                      with_mutex('$load_file',
 2474                                 '$mt_start_load'(FullFile, Loading, Options)),
 2475                      '$mt_do_load'(Loading, File, FullFile, Module, Options),
 2476                      '$mt_end_load'(Loading))).
 2477'$mt_load_file'(File, FullFile, Module, Options) :-
 2478    '$option'(if(If), Options, true),
 2479    '$noload'(If, FullFile, Options),
 2480    !,
 2481    '$already_loaded'(File, FullFile, Module, Options).
 2482'$mt_load_file'(File, FullFile, Module, Options) :-
 2483    '$sig_atomic'('$qdo_load_file'(File, FullFile, Module, Options)).
 2484
 2485'$mt_start_load'(FullFile, queue(Queue), _) :-
 2486    '$loading_file'(FullFile, Queue, LoadThread),
 2487    \+ thread_self(LoadThread),
 2488    !.
 2489'$mt_start_load'(FullFile, already_loaded, Options) :-
 2490    '$option'(if(If), Options, true),
 2491    '$noload'(If, FullFile, Options),
 2492    !.
 2493'$mt_start_load'(FullFile, Ref, _) :-
 2494    thread_self(Me),
 2495    message_queue_create(Queue),
 2496    assertz('$loading_file'(FullFile, Queue, Me), Ref).
 2497
 2498'$mt_do_load'(queue(Queue), File, FullFile, Module, Options) :-
 2499    !,
 2500    catch(thread_get_message(Queue, _), error(_,_), true),
 2501    '$already_loaded'(File, FullFile, Module, Options).
 2502'$mt_do_load'(already_loaded, File, FullFile, Module, Options) :-
 2503    !,
 2504    '$already_loaded'(File, FullFile, Module, Options).
 2505'$mt_do_load'(_Ref, File, FullFile, Module, Options) :-
 2506    '$assert_load_context_module'(FullFile, Module, Options),
 2507    '$qdo_load_file'(File, FullFile, Module, Options).
 2508
 2509'$mt_end_load'(queue(_)) :- !.
 2510'$mt_end_load'(already_loaded) :- !.
 2511'$mt_end_load'(Ref) :-
 2512    clause('$loading_file'(_, Queue, _), _, Ref),
 2513    erase(Ref),
 2514    thread_send_message(Queue, done),
 2515    message_queue_destroy(Queue).
 $qdo_load_file(+Spec, +FullFile, +ContextModule, +Options) is det
Switch to qcompile mode if requested by the option '$qlf'(+Out)
 2522'$qdo_load_file'(File, FullFile, Module, Options) :-
 2523    '$qdo_load_file2'(File, FullFile, Module, Action, Options),
 2524    '$register_resource_file'(FullFile),
 2525    '$run_initialization'(FullFile, Action, Options).
 2526
 2527'$qdo_load_file2'(File, FullFile, Module, Action, Options) :-
 2528    memberchk('$qlf'(QlfOut), Options),
 2529    '$stage_file'(QlfOut, StageQlf),
 2530    !,
 2531    setup_call_catcher_cleanup(
 2532        '$qstart'(StageQlf, Module, State),
 2533        '$do_load_file'(File, FullFile, Module, Action, Options),
 2534        Catcher,
 2535        '$qend'(State, Catcher, StageQlf, QlfOut)).
 2536'$qdo_load_file2'(File, FullFile, Module, Action, Options) :-
 2537    '$do_load_file'(File, FullFile, Module, Action, Options).
 2538
 2539'$qstart'(Qlf, Module, state(OldMode, OldModule)) :-
 2540    '$qlf_open'(Qlf),
 2541    '$compilation_mode'(OldMode, qlf),
 2542    '$set_source_module'(OldModule, Module).
 2543
 2544'$qend'(state(OldMode, OldModule), Catcher, StageQlf, QlfOut) :-
 2545    '$set_source_module'(_, OldModule),
 2546    '$set_compilation_mode'(OldMode),
 2547    '$qlf_close',
 2548    '$install_staged_file'(Catcher, StageQlf, QlfOut, warn).
 2549
 2550'$set_source_module'(OldModule, Module) :-
 2551    '$current_source_module'(OldModule),
 2552    '$set_source_module'(Module).
 $do_load_file(+Spec, +FullFile, +ContextModule, -Action, +Options) is det
Perform the actual loading.
 2559'$do_load_file'(File, FullFile, Module, Action, Options) :-
 2560    '$option'(derived_from(DerivedFrom), Options, -),
 2561    '$register_derived_source'(FullFile, DerivedFrom),
 2562    '$qlf_file'(File, FullFile, Absolute, Mode, Options),
 2563    (   Mode == qcompile
 2564    ->  qcompile(Module:File, Options)
 2565    ;   '$do_load_file_2'(File, Absolute, Module, Action, Options)
 2566    ).
 2567
 2568'$do_load_file_2'(File, Absolute, Module, Action, Options) :-
 2569    '$source_file_property'(Absolute, number_of_clauses, OldClauses),
 2570    statistics(cputime, OldTime),
 2571
 2572    '$setup_load'(ScopedFlags, OldSandBoxed, OldVerbose, OldAutoLevel, OldXRef,
 2573                  Options),
 2574
 2575    '$compilation_level'(Level),
 2576    '$load_msg_level'(load_file, Level, StartMsgLevel, DoneMsgLevel),
 2577    '$print_message'(StartMsgLevel,
 2578                     load_file(start(Level,
 2579                                     file(File, Absolute)))),
 2580
 2581    (   memberchk(stream(FromStream), Options)
 2582    ->  Input = stream
 2583    ;   Input = source
 2584    ),
 2585
 2586    (   Input == stream,
 2587        (   '$option'(format(qlf), Options, source)
 2588        ->  set_stream(FromStream, file_name(Absolute)),
 2589            '$qload_stream'(FromStream, Module, Action, LM, Options)
 2590        ;   '$consult_file'(stream(Absolute, FromStream, []),
 2591                            Module, Action, LM, Options)
 2592        )
 2593    ->  true
 2594    ;   Input == source,
 2595        file_name_extension(_, Ext, Absolute),
 2596        (   user:prolog_file_type(Ext, qlf),
 2597            E = error(_,_),
 2598            catch('$qload_file'(Absolute, Module, Action, LM, Options),
 2599                  E,
 2600                  print_message(warning, E))
 2601        ->  true
 2602        ;   '$consult_file'(Absolute, Module, Action, LM, Options)
 2603        )
 2604    ->  true
 2605    ;   '$print_message'(error, load_file(failed(File))),
 2606        fail
 2607    ),
 2608
 2609    '$import_from_loaded_module'(LM, Module, Options),
 2610
 2611    '$source_file_property'(Absolute, number_of_clauses, NewClauses),
 2612    statistics(cputime, Time),
 2613    ClausesCreated is NewClauses - OldClauses,
 2614    TimeUsed is Time - OldTime,
 2615
 2616    '$print_message'(DoneMsgLevel,
 2617                     load_file(done(Level,
 2618                                    file(File, Absolute),
 2619                                    Action,
 2620                                    LM,
 2621                                    TimeUsed,
 2622                                    ClausesCreated))),
 2623
 2624    '$restore_load'(ScopedFlags, OldSandBoxed, OldVerbose, OldAutoLevel, OldXRef).
 2625
 2626'$setup_load'(ScopedFlags, OldSandBoxed, OldVerbose, OldAutoLevel, OldXRef,
 2627              Options) :-
 2628    '$save_file_scoped_flags'(ScopedFlags),
 2629    '$set_sandboxed_load'(Options, OldSandBoxed),
 2630    '$set_verbose_load'(Options, OldVerbose),
 2631    '$set_optimise_load'(Options),
 2632    '$update_autoload_level'(Options, OldAutoLevel),
 2633    '$set_no_xref'(OldXRef).
 2634
 2635'$restore_load'(ScopedFlags, OldSandBoxed, OldVerbose, OldAutoLevel, OldXRef) :-
 2636    '$set_autoload_level'(OldAutoLevel),
 2637    set_prolog_flag(xref, OldXRef),
 2638    set_prolog_flag(verbose_load, OldVerbose),
 2639    set_prolog_flag(sandboxed_load, OldSandBoxed),
 2640    '$restore_file_scoped_flags'(ScopedFlags).
 $save_file_scoped_flags(-State) is det
 $restore_file_scoped_flags(-State) is det
Save/restore flags that are scoped to a compilation unit.
 2648'$save_file_scoped_flags'(State) :-
 2649    current_predicate(findall/3),          % Not when doing boot compile
 2650    !,
 2651    findall(SavedFlag, '$save_file_scoped_flag'(SavedFlag), State).
 2652'$save_file_scoped_flags'([]).
 2653
 2654'$save_file_scoped_flag'(Flag-Value) :-
 2655    '$file_scoped_flag'(Flag, Default),
 2656    (   current_prolog_flag(Flag, Value)
 2657    ->  true
 2658    ;   Value = Default
 2659    ).
 2660
 2661'$file_scoped_flag'(generate_debug_info, true).
 2662'$file_scoped_flag'(optimise,            false).
 2663'$file_scoped_flag'(xref,                false).
 2664
 2665'$restore_file_scoped_flags'([]).
 2666'$restore_file_scoped_flags'([Flag-Value|T]) :-
 2667    set_prolog_flag(Flag, Value),
 2668    '$restore_file_scoped_flags'(T).
 $import_from_loaded_module(LoadedModule, Module, Options) is det
Import public predicates from LoadedModule into Module
 2675'$import_from_loaded_module'(LoadedModule, Module, Options) :-
 2676    LoadedModule \== Module,
 2677    atom(LoadedModule),
 2678    !,
 2679    '$option'(imports(Import), Options, all),
 2680    '$option'(reexport(Reexport), Options, false),
 2681    '$import_list'(Module, LoadedModule, Import, Reexport).
 2682'$import_from_loaded_module'(_, _, _).
 $set_verbose_load(+Options, -Old) is det
Set the verbose_load flag according to Options and unify Old with the old value.
 2690'$set_verbose_load'(Options, Old) :-
 2691    current_prolog_flag(verbose_load, Old),
 2692    (   memberchk(silent(Silent), Options)
 2693    ->  (   '$negate'(Silent, Level0)
 2694        ->  '$load_msg_compat'(Level0, Level)
 2695        ;   Level = Silent
 2696        ),
 2697        set_prolog_flag(verbose_load, Level)
 2698    ;   true
 2699    ).
 2700
 2701'$negate'(true, false).
 2702'$negate'(false, true).
 $set_sandboxed_load(+Options, -Old) is det
Update the Prolog flag sandboxed_load from Options. Old is unified with the old flag.
Errors
- permission_error(leave, sandbox, -)
 2711'$set_sandboxed_load'(Options, Old) :-
 2712    current_prolog_flag(sandboxed_load, Old),
 2713    (   memberchk(sandboxed(SandBoxed), Options),
 2714        '$enter_sandboxed'(Old, SandBoxed, New),
 2715        New \== Old
 2716    ->  set_prolog_flag(sandboxed_load, New)
 2717    ;   true
 2718    ).
 2719
 2720'$enter_sandboxed'(Old, New, SandBoxed) :-
 2721    (   Old == false, New == true
 2722    ->  SandBoxed = true,
 2723        '$ensure_loaded_library_sandbox'
 2724    ;   Old == true, New == false
 2725    ->  throw(error(permission_error(leave, sandbox, -), _))
 2726    ;   SandBoxed = Old
 2727    ).
 2728'$enter_sandboxed'(false, true, true).
 2729
 2730'$ensure_loaded_library_sandbox' :-
 2731    source_file_property(library(sandbox), module(sandbox)),
 2732    !.
 2733'$ensure_loaded_library_sandbox' :-
 2734    load_files(library(sandbox), [if(not_loaded), silent(true)]).
 2735
 2736'$set_optimise_load'(Options) :-
 2737    (   '$option'(optimise(Optimise), Options)
 2738    ->  set_prolog_flag(optimise, Optimise)
 2739    ;   true
 2740    ).
 2741
 2742'$set_no_xref'(OldXRef) :-
 2743    (   current_prolog_flag(xref, OldXRef)
 2744    ->  true
 2745    ;   OldXRef = false
 2746    ),
 2747    set_prolog_flag(xref, false).
 $update_autoload_level(+Options, -OldLevel)
Update the '$autoload_nesting' and return the old value.
 2754:- thread_local
 2755    '$autoload_nesting'/1. 2756
 2757'$update_autoload_level'(Options, AutoLevel) :-
 2758    '$option'(autoload(Autoload), Options, false),
 2759    (   '$autoload_nesting'(CurrentLevel)
 2760    ->  AutoLevel = CurrentLevel
 2761    ;   AutoLevel = 0
 2762    ),
 2763    (   Autoload == false
 2764    ->  true
 2765    ;   NewLevel is AutoLevel + 1,
 2766        '$set_autoload_level'(NewLevel)
 2767    ).
 2768
 2769'$set_autoload_level'(New) :-
 2770    retractall('$autoload_nesting'(_)),
 2771    asserta('$autoload_nesting'(New)).
 $print_message(+Level, +Term) is det
As print_message/2, but deal with the fact that the message system might not yet be loaded.
 2779'$print_message'(Level, Term) :-
 2780    current_predicate(system:print_message/2),
 2781    !,
 2782    print_message(Level, Term).
 2783'$print_message'(warning, Term) :-
 2784    source_location(File, Line),
 2785    !,
 2786    format(user_error, 'WARNING: ~w:~w: ~p~n', [File, Line, Term]).
 2787'$print_message'(error, Term) :-
 2788    !,
 2789    source_location(File, Line),
 2790    !,
 2791    format(user_error, 'ERROR: ~w:~w: ~p~n', [File, Line, Term]).
 2792'$print_message'(_Level, _Term).
 2793
 2794'$print_message_fail'(E) :-
 2795    '$print_message'(error, E),
 2796    fail.
 $consult_file(+Path, +Module, -Action, -LoadedIn, +Options)
Called from '$do_load_file'/4 using the goal returned by '$consult_goal'/2. This means that the calling conventions must be kept synchronous with '$qload_file'/6.
 2804'$consult_file'(Absolute, Module, What, LM, Options) :-
 2805    '$current_source_module'(Module),   % same module
 2806    !,
 2807    '$consult_file_2'(Absolute, Module, What, LM, Options).
 2808'$consult_file'(Absolute, Module, What, LM, Options) :-
 2809    '$set_source_module'(OldModule, Module),
 2810    '$ifcompiling'('$qlf_start_sub_module'(Module)),
 2811    '$consult_file_2'(Absolute, Module, What, LM, Options),
 2812    '$ifcompiling'('$qlf_end_part'),
 2813    '$set_source_module'(OldModule).
 2814
 2815'$consult_file_2'(Absolute, Module, What, LM, Options) :-
 2816    '$set_source_module'(OldModule, Module),
 2817    '$load_id'(Absolute, Id, Modified, Options),
 2818    '$compile_type'(What),
 2819    '$save_lex_state'(LexState, Options),
 2820    '$set_dialect'(Options),
 2821    setup_call_cleanup(
 2822        '$start_consult'(Id, Modified),
 2823        '$load_file'(Absolute, Id, LM, Options),
 2824        '$end_consult'(Id, LexState, OldModule)).
 2825
 2826'$end_consult'(Id, LexState, OldModule) :-
 2827    '$end_consult'(Id),
 2828    '$restore_lex_state'(LexState),
 2829    '$set_source_module'(OldModule).
 2830
 2831
 2832:- create_prolog_flag(emulated_dialect, swi, [type(atom)]).
 $save_lex_state(-LexState, +Options) is det
 2836'$save_lex_state'(State, Options) :-
 2837    memberchk(scope_settings(false), Options),
 2838    !,
 2839    State = (-).
 2840'$save_lex_state'(lexstate(Style, Dialect), _) :-
 2841    '$style_check'(Style, Style),
 2842    current_prolog_flag(emulated_dialect, Dialect).
 2843
 2844'$restore_lex_state'(-) :- !.
 2845'$restore_lex_state'(lexstate(Style, Dialect)) :-
 2846    '$style_check'(_, Style),
 2847    set_prolog_flag(emulated_dialect, Dialect).
 2848
 2849'$set_dialect'(Options) :-
 2850    memberchk(dialect(Dialect), Options),
 2851    !,
 2852    '$expects_dialect'(Dialect).
 2853'$set_dialect'(_).
 2854
 2855'$load_id'(stream(Id, _, _), Id, Modified, Options) :-
 2856    !,
 2857    '$modified_id'(Id, Modified, Options).
 2858'$load_id'(Id, Id, Modified, Options) :-
 2859    '$modified_id'(Id, Modified, Options).
 2860
 2861'$modified_id'(_, Modified, Options) :-
 2862    '$option'(modified(Stamp), Options, Def),
 2863    Stamp \== Def,
 2864    !,
 2865    Modified = Stamp.
 2866'$modified_id'(Id, Modified, _) :-
 2867    catch(time_file(Id, Modified),
 2868          error(_, _),
 2869          fail),
 2870    !.
 2871'$modified_id'(_, 0.0, _).
 2872
 2873
 2874'$compile_type'(What) :-
 2875    '$compilation_mode'(How),
 2876    (   How == database
 2877    ->  What = compiled
 2878    ;   How == qlf
 2879    ->  What = '*qcompiled*'
 2880    ;   What = 'boot compiled'
 2881    ).
 $assert_load_context_module(+File, -Module, -Options)
Record the module a file was loaded from (see make/0). The first clause deals with loading from another file. On reload, this clause will be discarded by $start_consult/1. The second clause deals with reload from the toplevel. Here we avoid creating a duplicate dynamic (i.e., not related to a source) clause.
 2891:- dynamic
 2892    '$load_context_module'/3. 2893:- multifile
 2894    '$load_context_module'/3. 2895
 2896'$assert_load_context_module'(_, _, Options) :-
 2897    memberchk(register(false), Options),
 2898    !.
 2899'$assert_load_context_module'(File, Module, Options) :-
 2900    source_location(FromFile, Line),
 2901    !,
 2902    '$master_file'(FromFile, MasterFile),
 2903    '$check_load_non_module'(File, Module),
 2904    '$add_dialect'(Options, Options1),
 2905    '$load_ctx_options'(Options1, Options2),
 2906    '$store_admin_clause'(
 2907        system:'$load_context_module'(File, Module, Options2),
 2908        _Layout, MasterFile, FromFile:Line).
 2909'$assert_load_context_module'(File, Module, Options) :-
 2910    '$check_load_non_module'(File, Module),
 2911    '$add_dialect'(Options, Options1),
 2912    '$load_ctx_options'(Options1, Options2),
 2913    (   clause('$load_context_module'(File, Module, _), true, Ref),
 2914        \+ clause_property(Ref, file(_)),
 2915        erase(Ref)
 2916    ->  true
 2917    ;   true
 2918    ),
 2919    assertz('$load_context_module'(File, Module, Options2)).
 2920
 2921'$add_dialect'(Options0, Options) :-
 2922    current_prolog_flag(emulated_dialect, Dialect), Dialect \== swi,
 2923    !,
 2924    Options = [dialect(Dialect)|Options0].
 2925'$add_dialect'(Options, Options).
 $load_ctx_options(+Options, -CtxOptions) is det
Select the load options that determine the load semantics to perform a proper reload. Delete the others.
 2932'$load_ctx_options'(Options, CtxOptions) :-
 2933    '$load_ctx_options2'(Options, CtxOptions0),
 2934    sort(CtxOptions0, CtxOptions).
 2935
 2936'$load_ctx_options2'([], []).
 2937'$load_ctx_options2'([H|T0], [H|T]) :-
 2938    '$load_ctx_option'(H),
 2939    !,
 2940    '$load_ctx_options2'(T0, T).
 2941'$load_ctx_options2'([_|T0], T) :-
 2942    '$load_ctx_options2'(T0, T).
 2943
 2944'$load_ctx_option'(derived_from(_)).
 2945'$load_ctx_option'(dialect(_)).
 2946'$load_ctx_option'(encoding(_)).
 2947'$load_ctx_option'(imports(_)).
 2948'$load_ctx_option'(reexport(_)).
 $check_load_non_module(+File) is det
Test that a non-module file is not loaded into multiple contexts.
 2956'$check_load_non_module'(File, _) :-
 2957    '$current_module'(_, File),
 2958    !.          % File is a module file
 2959'$check_load_non_module'(File, Module) :-
 2960    '$load_context_module'(File, OldModule, _),
 2961    Module \== OldModule,
 2962    !,
 2963    format(atom(Msg),
 2964           'Non-module file already loaded into module ~w; \c
 2965               trying to load into ~w',
 2966           [OldModule, Module]),
 2967    throw(error(permission_error(load, source, File),
 2968                context(load_files/2, Msg))).
 2969'$check_load_non_module'(_, _).
 $load_file(+Path, +Id, -Module, +Options)
'$load_file'/4 does the actual loading.

state(FirstTerm:boolean, Module:atom, AtEnd:atom, Stop:boolean, Id:atom, Dialect:atom)

 2982'$load_file'(Path, Id, Module, Options) :-
 2983    State = state(true, _, true, false, Id, -),
 2984    (   '$source_term'(Path, _Read, _Layout, Term, Layout,
 2985                       _Stream, Options),
 2986        '$valid_term'(Term),
 2987        (   arg(1, State, true)
 2988        ->  '$first_term'(Term, Layout, Id, State, Options),
 2989            nb_setarg(1, State, false)
 2990        ;   '$compile_term'(Term, Layout, Id)
 2991        ),
 2992        arg(4, State, true)
 2993    ;   '$fixup_reconsult'(Id),
 2994        '$end_load_file'(State)
 2995    ),
 2996    !,
 2997    arg(2, State, Module).
 2998
 2999'$valid_term'(Var) :-
 3000    var(Var),
 3001    !,
 3002    print_message(error, error(instantiation_error, _)).
 3003'$valid_term'(Term) :-
 3004    Term \== [].
 3005
 3006'$end_load_file'(State) :-
 3007    arg(1, State, true),           % empty file
 3008    !,
 3009    nb_setarg(2, State, Module),
 3010    arg(5, State, Id),
 3011    '$current_source_module'(Module),
 3012    '$ifcompiling'('$qlf_start_file'(Id)),
 3013    '$ifcompiling'('$qlf_end_part').
 3014'$end_load_file'(State) :-
 3015    arg(3, State, End),
 3016    '$end_load_file'(End, State).
 3017
 3018'$end_load_file'(true, _).
 3019'$end_load_file'(end_module, State) :-
 3020    arg(2, State, Module),
 3021    '$check_export'(Module),
 3022    '$ifcompiling'('$qlf_end_part').
 3023'$end_load_file'(end_non_module, _State) :-
 3024    '$ifcompiling'('$qlf_end_part').
 3025
 3026
 3027'$first_term'(?-(Directive), Layout, Id, State, Options) :-
 3028    !,
 3029    '$first_term'(:-(Directive), Layout, Id, State, Options).
 3030'$first_term'(:-(Directive), _Layout, Id, State, Options) :-
 3031    nonvar(Directive),
 3032    (   (   Directive = module(Name, Public)
 3033        ->  Imports = []
 3034        ;   Directive = module(Name, Public, Imports)
 3035        )
 3036    ->  !,
 3037        '$module_name'(Name, Id, Module, Options),
 3038        '$start_module'(Module, Public, State, Options),
 3039        '$module3'(Imports)
 3040    ;   Directive = expects_dialect(Dialect)
 3041    ->  !,
 3042        '$set_dialect'(Dialect, State),
 3043        fail                        % Still consider next term as first
 3044    ).
 3045'$first_term'(Term, Layout, Id, State, Options) :-
 3046    '$start_non_module'(Id, Term, State, Options),
 3047    '$compile_term'(Term, Layout, Id).
 3048
 3049'$compile_term'(Term, Layout, Id) :-
 3050    '$compile_term'(Term, Layout, Id, -).
 3051
 3052'$compile_term'(Var, _Layout, _Id, _Src) :-
 3053    var(Var),
 3054    !,
 3055    '$instantiation_error'(Var).
 3056'$compile_term'((?-Directive), _Layout, Id, _) :-
 3057    !,
 3058    '$execute_directive'(Directive, Id).
 3059'$compile_term'((:-Directive), _Layout, Id, _) :-
 3060    !,
 3061    '$execute_directive'(Directive, Id).
 3062'$compile_term'('$source_location'(File, Line):Term, Layout, Id, _) :-
 3063    !,
 3064    '$compile_term'(Term, Layout, Id, File:Line).
 3065'$compile_term'(Clause, Layout, Id, SrcLoc) :-
 3066    E = error(_,_),
 3067    catch('$store_clause'(Clause, Layout, Id, SrcLoc), E,
 3068          '$print_message'(error, E)).
 3069
 3070'$start_non_module'(_Id, Term, _State, Options) :-
 3071    '$option'(must_be_module(true), Options, false),
 3072    !,
 3073    '$domain_error'(module_header, Term).
 3074'$start_non_module'(Id, _Term, State, _Options) :-
 3075    '$current_source_module'(Module),
 3076    '$ifcompiling'('$qlf_start_file'(Id)),
 3077    '$qset_dialect'(State),
 3078    nb_setarg(2, State, Module),
 3079    nb_setarg(3, State, end_non_module).
 $set_dialect(+Dialect, +State)
Sets the expected dialect. This is difficult if we are compiling a .qlf file using qcompile/1 because the file is already open, while we are looking for the first term to decide wether this is a module or not. We save the dialect and set it after opening the file or module.

Note that expects_dialect/1 itself may be autoloaded from the library.

 3092'$set_dialect'(Dialect, State) :-
 3093    '$compilation_mode'(qlf, database),
 3094    !,
 3095    '$expects_dialect'(Dialect),
 3096    '$compilation_mode'(_, qlf),
 3097    nb_setarg(6, State, Dialect).
 3098'$set_dialect'(Dialect, _) :-
 3099    '$expects_dialect'(Dialect).
 3100
 3101'$qset_dialect'(State) :-
 3102    '$compilation_mode'(qlf),
 3103    arg(6, State, Dialect), Dialect \== (-),
 3104    !,
 3105    '$add_directive_wic'('$expects_dialect'(Dialect)).
 3106'$qset_dialect'(_).
 3107
 3108'$expects_dialect'(Dialect) :-
 3109    Dialect == swi,
 3110    !,
 3111    set_prolog_flag(emulated_dialect, Dialect).
 3112'$expects_dialect'(Dialect) :-
 3113    current_predicate(expects_dialect/1),
 3114    !,
 3115    expects_dialect(Dialect).
 3116'$expects_dialect'(Dialect) :-
 3117    use_module(library(dialect), [expects_dialect/1]),
 3118    expects_dialect(Dialect).
 3119
 3120
 3121                 /*******************************
 3122                 *           MODULES            *
 3123                 *******************************/
 3124
 3125'$start_module'(Module, _Public, State, _Options) :-
 3126    '$current_module'(Module, OldFile),
 3127    source_location(File, _Line),
 3128    OldFile \== File, OldFile \== [],
 3129    same_file(OldFile, File),
 3130    !,
 3131    nb_setarg(2, State, Module),
 3132    nb_setarg(4, State, true).      % Stop processing
 3133'$start_module'(Module, Public, State, Options) :-
 3134    arg(5, State, File),
 3135    nb_setarg(2, State, Module),
 3136    source_location(_File, Line),
 3137    '$option'(redefine_module(Action), Options, false),
 3138    '$module_class'(File, Class, Super),
 3139    '$reset_dialect'(File, Class),
 3140    '$redefine_module'(Module, File, Action),
 3141    '$declare_module'(Module, Class, Super, File, Line, false),
 3142    '$export_list'(Public, Module, Ops),
 3143    '$ifcompiling'('$qlf_start_module'(Module)),
 3144    '$export_ops'(Ops, Module, File),
 3145    '$qset_dialect'(State),
 3146    nb_setarg(3, State, end_module).
 $reset_dialect(+File, +Class) is det
Load .pl files from the SWI-Prolog distribution always in swi dialect.
 3153'$reset_dialect'(File, library) :-
 3154    file_name_extension(_, pl, File),
 3155    !,
 3156    set_prolog_flag(emulated_dialect, swi).
 3157'$reset_dialect'(_, _).
 $module3(+Spec) is det
Handle the 3th argument of a module declartion.
 3164'$module3'(Var) :-
 3165    var(Var),
 3166    !,
 3167    '$instantiation_error'(Var).
 3168'$module3'([]) :- !.
 3169'$module3'([H|T]) :-
 3170    !,
 3171    '$module3'(H),
 3172    '$module3'(T).
 3173'$module3'(Id) :-
 3174    use_module(library(dialect/Id)).
 $module_name(?Name, +Id, -Module, +Options) is semidet
Determine the module name. There are some cases:
 3188'$module_name'(_, _, Module, Options) :-
 3189    '$option'(module(Module), Options),
 3190    !,
 3191    '$current_source_module'(Context),
 3192    Context \== Module.                     % cause '$first_term'/5 to fail.
 3193'$module_name'(Var, Id, Module, Options) :-
 3194    var(Var),
 3195    !,
 3196    file_base_name(Id, File),
 3197    file_name_extension(Var, _, File),
 3198    '$module_name'(Var, Id, Module, Options).
 3199'$module_name'(Reserved, _, _, _) :-
 3200    '$reserved_module'(Reserved),
 3201    !,
 3202    throw(error(permission_error(load, module, Reserved), _)).
 3203'$module_name'(Module, _Id, Module, _).
 3204
 3205
 3206'$reserved_module'(system).
 3207'$reserved_module'(user).
 $redefine_module(+Module, +File, -Redefine)
 3212'$redefine_module'(_Module, _, false) :- !.
 3213'$redefine_module'(Module, File, true) :-
 3214    !,
 3215    (   module_property(Module, file(OldFile)),
 3216        File \== OldFile
 3217    ->  unload_file(OldFile)
 3218    ;   true
 3219    ).
 3220'$redefine_module'(Module, File, ask) :-
 3221    (   stream_property(user_input, tty(true)),
 3222        module_property(Module, file(OldFile)),
 3223        File \== OldFile,
 3224        '$rdef_response'(Module, OldFile, File, true)
 3225    ->  '$redefine_module'(Module, File, true)
 3226    ;   true
 3227    ).
 3228
 3229'$rdef_response'(Module, OldFile, File, Ok) :-
 3230    repeat,
 3231    print_message(query, redefine_module(Module, OldFile, File)),
 3232    get_single_char(Char),
 3233    '$rdef_response'(Char, Ok0),
 3234    !,
 3235    Ok = Ok0.
 3236
 3237'$rdef_response'(Char, true) :-
 3238    memberchk(Char, `yY`),
 3239    format(user_error, 'yes~n', []).
 3240'$rdef_response'(Char, false) :-
 3241    memberchk(Char, `nN`),
 3242    format(user_error, 'no~n', []).
 3243'$rdef_response'(Char, _) :-
 3244    memberchk(Char, `a`),
 3245    format(user_error, 'abort~n', []),
 3246    abort.
 3247'$rdef_response'(_, _) :-
 3248    print_message(help, redefine_module_reply),
 3249    fail.
 $module_class(+File, -Class, -Super) is det
Determine the file class and initial module from which File inherits. All boot and library modules as well as the -F script files inherit from system, while all normal user modules inherit from user.
 3259'$module_class'(File, Class, system) :-
 3260    current_prolog_flag(home, Home),
 3261    sub_atom(File, 0, Len, _, Home),
 3262    (   sub_atom(File, Len, _, _, '/boot/')
 3263    ->  Class = system
 3264    ;   '$lib_prefix'(Prefix),
 3265        sub_atom(File, Len, _, _, Prefix)
 3266    ->  Class = library
 3267    ;   file_directory_name(File, Home),
 3268        file_name_extension(_, rc, File)
 3269    ->  Class = library
 3270    ),
 3271    !.
 3272'$module_class'(_, user, user).
 3273
 3274'$lib_prefix'('/library').
 3275'$lib_prefix'('/xpce/prolog/').
 3276
 3277'$check_export'(Module) :-
 3278    '$undefined_export'(Module, UndefList),
 3279    (   '$member'(Undef, UndefList),
 3280        strip_module(Undef, _, Local),
 3281        print_message(error,
 3282                      undefined_export(Module, Local)),
 3283        fail
 3284    ;   true
 3285    ).
 $import_list(+TargetModule, +FromModule, +Import, +Reexport) is det
Import from FromModule to TargetModule. Import is one of all, a list of optionally mapped predicate indicators or a term except(Import).
 3294'$import_list'(_, _, Var, _) :-
 3295    var(Var),
 3296    !,
 3297    throw(error(instantitation_error, _)).
 3298'$import_list'(Target, Source, all, Reexport) :-
 3299    !,
 3300    '$exported_ops'(Source, Import, Predicates),
 3301    '$module_property'(Source, exports(Predicates)),
 3302    '$import_all'(Import, Target, Source, Reexport, weak).
 3303'$import_list'(Target, Source, except(Spec), Reexport) :-
 3304    !,
 3305    '$exported_ops'(Source, Export, Predicates),
 3306    '$module_property'(Source, exports(Predicates)),
 3307    (   is_list(Spec)
 3308    ->  true
 3309    ;   throw(error(type_error(list, Spec), _))
 3310    ),
 3311    '$import_except'(Spec, Export, Import),
 3312    '$import_all'(Import, Target, Source, Reexport, weak).
 3313'$import_list'(Target, Source, Import, Reexport) :-
 3314    !,
 3315    is_list(Import),
 3316    !,
 3317    '$import_all'(Import, Target, Source, Reexport, strong).
 3318'$import_list'(_, _, Import, _) :-
 3319    throw(error(type_error(import_specifier, Import))).
 3320
 3321
 3322'$import_except'([], List, List).
 3323'$import_except'([H|T], List0, List) :-
 3324    '$import_except_1'(H, List0, List1),
 3325    '$import_except'(T, List1, List).
 3326
 3327'$import_except_1'(Var, _, _) :-
 3328    var(Var),
 3329    !,
 3330    throw(error(instantitation_error, _)).
 3331'$import_except_1'(PI as N, List0, List) :-
 3332    '$pi'(PI), atom(N),
 3333    !,
 3334    '$canonical_pi'(PI, CPI),
 3335    '$import_as'(CPI, N, List0, List).
 3336'$import_except_1'(op(P,A,N), List0, List) :-
 3337    !,
 3338    '$remove_ops'(List0, op(P,A,N), List).
 3339'$import_except_1'(PI, List0, List) :-
 3340    '$pi'(PI),
 3341    !,
 3342    '$canonical_pi'(PI, CPI),
 3343    '$select'(P, List0, List),
 3344    '$canonical_pi'(CPI, P),
 3345    !.
 3346'$import_except_1'(Except, _, _) :-
 3347    throw(error(type_error(import_specifier, Except), _)).
 3348
 3349'$import_as'(CPI, N, [PI2|T], [CPI as N|T]) :-
 3350    '$canonical_pi'(PI2, CPI),
 3351    !.
 3352'$import_as'(PI, N, [H|T0], [H|T]) :-
 3353    !,
 3354    '$import_as'(PI, N, T0, T).
 3355'$import_as'(PI, _, _, _) :-
 3356    throw(error(existence_error(export, PI), _)).
 3357
 3358'$pi'(N/A) :- atom(N), integer(A), !.
 3359'$pi'(N//A) :- atom(N), integer(A).
 3360
 3361'$canonical_pi'(N//A0, N/A) :-
 3362    A is A0 + 2.
 3363'$canonical_pi'(PI, PI).
 3364
 3365'$remove_ops'([], _, []).
 3366'$remove_ops'([Op|T0], Pattern, T) :-
 3367    subsumes_term(Pattern, Op),
 3368    !,
 3369    '$remove_ops'(T0, Pattern, T).
 3370'$remove_ops'([H|T0], Pattern, [H|T]) :-
 3371    '$remove_ops'(T0, Pattern, T).
 $import_all(+Import, +Context, +Source, +Reexport, +Strength)
 3376'$import_all'(Import, Context, Source, Reexport, Strength) :-
 3377    '$import_all2'(Import, Context, Source, Imported, ImpOps, Strength),
 3378    (   Reexport == true,
 3379        (   '$list_to_conj'(Imported, Conj)
 3380        ->  export(Context:Conj),
 3381            '$ifcompiling'('$add_directive_wic'(export(Context:Conj)))
 3382        ;   true
 3383        ),
 3384        source_location(File, _Line),
 3385        '$export_ops'(ImpOps, Context, File)
 3386    ;   true
 3387    ).
 $import_all2(+Imports, +Context, +Source, -Imported, -ImpOps, +Strength)
 3391'$import_all2'([], _, _, [], [], _).
 3392'$import_all2'([PI as NewName|Rest], Context, Source,
 3393               [NewName/Arity|Imported], ImpOps, Strength) :-
 3394    !,
 3395    '$canonical_pi'(PI, Name/Arity),
 3396    length(Args, Arity),
 3397    Head =.. [Name|Args],
 3398    NewHead =.. [NewName|Args],
 3399    (   '$get_predicate_attribute'(Source:Head, transparent, 1)
 3400    ->  '$set_predicate_attribute'(Context:NewHead, transparent, true)
 3401    ;   true
 3402    ),
 3403    (   source_location(File, Line)
 3404    ->  E = error(_,_),
 3405        catch('$store_admin_clause'((NewHead :- Source:Head),
 3406                                    _Layout, File, File:Line),
 3407              E, '$print_message'(error, E))
 3408    ;   assertz((NewHead :- !, Source:Head)) % ! avoids problems with
 3409    ),                                       % duplicate load
 3410    '$import_all2'(Rest, Context, Source, Imported, ImpOps, Strength).
 3411'$import_all2'([op(P,A,N)|Rest], Context, Source, Imported,
 3412               [op(P,A,N)|ImpOps], Strength) :-
 3413    !,
 3414    '$import_ops'(Context, Source, op(P,A,N)),
 3415    '$import_all2'(Rest, Context, Source, Imported, ImpOps, Strength).
 3416'$import_all2'([Pred|Rest], Context, Source, [Pred|Imported], ImpOps, Strength) :-
 3417    Error = error(_,_),
 3418    catch(Context:'$import'(Source:Pred, Strength), Error,
 3419          print_message(error, Error)),
 3420    '$ifcompiling'('$import_wic'(Source, Pred, Strength)),
 3421    '$import_all2'(Rest, Context, Source, Imported, ImpOps, Strength).
 3422
 3423
 3424'$list_to_conj'([One], One) :- !.
 3425'$list_to_conj'([H|T], (H,Rest)) :-
 3426    '$list_to_conj'(T, Rest).
 $exported_ops(+Module, -Ops, ?Tail) is det
Ops is a list of op(P,A,N) terms representing the operators exported from Module.
 3433'$exported_ops'(Module, Ops, Tail) :-
 3434    '$c_current_predicate'(_, Module:'$exported_op'(_,_,_)),
 3435    !,
 3436    findall(op(P,A,N), Module:'$exported_op'(P,A,N), Ops, Tail).
 3437'$exported_ops'(_, Ops, Ops).
 3438
 3439'$exported_op'(Module, P, A, N) :-
 3440    '$c_current_predicate'(_, Module:'$exported_op'(_,_,_)),
 3441    Module:'$exported_op'(P, A, N).
 $import_ops(+Target, +Source, +Pattern)
Import the operators export from Source into the module table of Target. We only import operators that unify with Pattern.
 3448'$import_ops'(To, From, Pattern) :-
 3449    ground(Pattern),
 3450    !,
 3451    Pattern = op(P,A,N),
 3452    op(P,A,To:N),
 3453    (   '$exported_op'(From, P, A, N)
 3454    ->  true
 3455    ;   print_message(warning, no_exported_op(From, Pattern))
 3456    ).
 3457'$import_ops'(To, From, Pattern) :-
 3458    (   '$exported_op'(From, Pri, Assoc, Name),
 3459        Pattern = op(Pri, Assoc, Name),
 3460        op(Pri, Assoc, To:Name),
 3461        fail
 3462    ;   true
 3463    ).
 $export_list(+Declarations, +Module, -Ops)
Handle the export list of the module declaration for Module associated to File.
 3471'$export_list'(Decls, Module, Ops) :-
 3472    is_list(Decls),
 3473    !,
 3474    '$do_export_list'(Decls, Module, Ops).
 3475'$export_list'(Decls, _, _) :-
 3476    var(Decls),
 3477    throw(error(instantiation_error, _)).
 3478'$export_list'(Decls, _, _) :-
 3479    throw(error(type_error(list, Decls), _)).
 3480
 3481'$do_export_list'([], _, []) :- !.
 3482'$do_export_list'([H|T], Module, Ops) :-
 3483    !,
 3484    E = error(_,_),
 3485    catch('$export1'(H, Module, Ops, Ops1),
 3486          E, ('$print_message'(error, E), Ops = Ops1)),
 3487    '$do_export_list'(T, Module, Ops1).
 3488
 3489'$export1'(Var, _, _, _) :-
 3490    var(Var),
 3491    !,
 3492    throw(error(instantiation_error, _)).
 3493'$export1'(Op, _, [Op|T], T) :-
 3494    Op = op(_,_,_),
 3495    !.
 3496'$export1'(PI0, Module, Ops, Ops) :-
 3497    strip_module(Module:PI0, M, PI),
 3498    (   PI = (_//_)
 3499    ->  non_terminal(M:PI)
 3500    ;   true
 3501    ),
 3502    export(M:PI).
 3503
 3504'$export_ops'([op(Pri, Assoc, Name)|T], Module, File) :-
 3505    E = error(_,_),
 3506    catch(( '$execute_directive'(op(Pri, Assoc, Module:Name), File),
 3507            '$export_op'(Pri, Assoc, Name, Module, File)
 3508          ),
 3509          E, '$print_message'(error, E)),
 3510    '$export_ops'(T, Module, File).
 3511'$export_ops'([], _, _).
 3512
 3513'$export_op'(Pri, Assoc, Name, Module, File) :-
 3514    (   '$get_predicate_attribute'(Module:'$exported_op'(_,_,_), defined, 1)
 3515    ->  true
 3516    ;   '$execute_directive'(discontiguous(Module:'$exported_op'/3), File)
 3517    ),
 3518    '$store_admin_clause'('$exported_op'(Pri, Assoc, Name), _Layout, File, -).
 $execute_directive(:Goal, +File) is det
Execute the argument of :- or ?- while loading a file.
 3524'$execute_directive'(Goal, F) :-
 3525    '$execute_directive_2'(Goal, F).
 3526
 3527'$execute_directive_2'(encoding(Encoding), _F) :-
 3528    !,
 3529    (   '$load_input'(_F, S)
 3530    ->  set_stream(S, encoding(Encoding))
 3531    ).
 3532'$execute_directive_2'(Goal, _) :-
 3533    \+ '$compilation_mode'(database),
 3534    !,
 3535    '$add_directive_wic2'(Goal, Type),
 3536    (   Type == call                % suspend compiling into .qlf file
 3537    ->  '$compilation_mode'(Old, database),
 3538        setup_call_cleanup(
 3539            '$directive_mode'(OldDir, Old),
 3540            '$execute_directive_3'(Goal),
 3541            ( '$set_compilation_mode'(Old),
 3542              '$set_directive_mode'(OldDir)
 3543            ))
 3544    ;   '$execute_directive_3'(Goal)
 3545    ).
 3546'$execute_directive_2'(Goal, _) :-
 3547    '$execute_directive_3'(Goal).
 3548
 3549'$execute_directive_3'(Goal) :-
 3550    '$current_source_module'(Module),
 3551    '$valid_directive'(Module:Goal),
 3552    !,
 3553    (   '$pattr_directive'(Goal, Module)
 3554    ->  true
 3555    ;   Term = error(_,_),
 3556        catch(Module:Goal, Term, '$exception_in_directive'(Term))
 3557    ->  true
 3558    ;   '$print_message'(warning, goal_failed(directive, Module:Goal)),
 3559        fail
 3560    ).
 3561'$execute_directive_3'(_).
 $valid_directive(:Directive) is det
If the flag sandboxed_load is true, this calls prolog:sandbox_allowed_directive/1. This call can deny execution of the directive by throwing an exception.
 3570:- multifile prolog:sandbox_allowed_directive/1. 3571:- multifile prolog:sandbox_allowed_clause/1. 3572:- meta_predicate '$valid_directive'(:). 3573
 3574'$valid_directive'(_) :-
 3575    current_prolog_flag(sandboxed_load, false),
 3576    !.
 3577'$valid_directive'(Goal) :-
 3578    Error = error(Formal, _),
 3579    catch(prolog:sandbox_allowed_directive(Goal), Error, true),
 3580    !,
 3581    (   var(Formal)
 3582    ->  true
 3583    ;   print_message(error, Error),
 3584        fail
 3585    ).
 3586'$valid_directive'(Goal) :-
 3587    print_message(error,
 3588                  error(permission_error(execute,
 3589                                         sandboxed_directive,
 3590                                         Goal), _)),
 3591    fail.
 3592
 3593'$exception_in_directive'(Term) :-
 3594    '$print_message'(error, Term),
 3595    fail.
 3596
 3597%       Note that the list, consult and ensure_loaded directives are already
 3598%       handled at compile time and therefore should not go into the
 3599%       intermediate code file.
 3600
 3601'$add_directive_wic2'(Goal, Type) :-
 3602    '$common_goal_type'(Goal, Type),
 3603    !,
 3604    (   Type == load
 3605    ->  true
 3606    ;   '$current_source_module'(Module),
 3607        '$add_directive_wic'(Module:Goal)
 3608    ).
 3609'$add_directive_wic2'(Goal, _) :-
 3610    (   '$compilation_mode'(qlf)    % no problem for qlf files
 3611    ->  true
 3612    ;   print_message(error, mixed_directive(Goal))
 3613    ).
 3614
 3615'$common_goal_type'((A,B), Type) :-
 3616    !,
 3617    '$common_goal_type'(A, Type),
 3618    '$common_goal_type'(B, Type).
 3619'$common_goal_type'((A;B), Type) :-
 3620    !,
 3621    '$common_goal_type'(A, Type),
 3622    '$common_goal_type'(B, Type).
 3623'$common_goal_type'((A->B), Type) :-
 3624    !,
 3625    '$common_goal_type'(A, Type),
 3626    '$common_goal_type'(B, Type).
 3627'$common_goal_type'(Goal, Type) :-
 3628    '$goal_type'(Goal, Type).
 3629
 3630'$goal_type'(Goal, Type) :-
 3631    (   '$load_goal'(Goal)
 3632    ->  Type = load
 3633    ;   Type = call
 3634    ).
 3635
 3636'$load_goal'([_|_]).
 3637'$load_goal'(consult(_)).
 3638'$load_goal'(load_files(_)).
 3639'$load_goal'(load_files(_,Options)) :-
 3640    memberchk(qcompile(QlfMode), Options),
 3641    '$qlf_part_mode'(QlfMode).
 3642'$load_goal'(ensure_loaded(_)) :- '$compilation_mode'(wic).
 3643'$load_goal'(use_module(_))    :- '$compilation_mode'(wic).
 3644'$load_goal'(use_module(_, _)) :- '$compilation_mode'(wic).
 3645
 3646'$qlf_part_mode'(part).
 3647'$qlf_part_mode'(true).                 % compatibility
 3648
 3649
 3650                /********************************
 3651                *        COMPILE A CLAUSE       *
 3652                *********************************/
 $store_admin_clause(+Clause, ?Layout, +Owner, +SrcLoc) is det
Store a clause into the database for administrative purposes. This bypasses sanity checking.
 3659'$store_admin_clause'(Clause, Layout, Owner, SrcLoc) :-
 3660    Owner \== (-),
 3661    !,
 3662    setup_call_cleanup(
 3663        '$start_aux'(Owner, Context),
 3664        '$store_admin_clause2'(Clause, Layout, Owner, SrcLoc),
 3665        '$end_aux'(Owner, Context)).
 3666'$store_admin_clause'(Clause, Layout, File, SrcLoc) :-
 3667    '$store_admin_clause2'(Clause, Layout, File, SrcLoc).
 3668
 3669'$store_admin_clause2'(Clause, _Layout, File, SrcLoc) :-
 3670    (   '$compilation_mode'(database)
 3671    ->  '$record_clause'(Clause, File, SrcLoc)
 3672    ;   '$record_clause'(Clause, File, SrcLoc, Ref),
 3673        '$qlf_assert_clause'(Ref, development)
 3674    ).
 $store_clause(+Clause, ?Layout, +Owner, +SrcLoc) is det
Store a clause into the database.
Arguments:
Owner- is the file-id that owns the clause
SrcLoc- is the file:line term where the clause originates from.
 3684'$store_clause'((_, _), _, _, _) :-
 3685    !,
 3686    print_message(error, cannot_redefine_comma),
 3687    fail.
 3688'$store_clause'((Pre => Body), _Layout, File, SrcLoc) :-
 3689    nonvar(Pre),
 3690    Pre = (Head,Cond),
 3691    !,
 3692    (   '$is_true'(Cond), current_prolog_flag(optimise, true)
 3693    ->  '$store_clause'((Head=>Body), _Layout, File, SrcLoc)
 3694    ;   '$store_clause'(?=>(Head,(Cond,!,Body)), _Layout, File, SrcLoc)
 3695    ).
 3696'$store_clause'(Clause, _Layout, File, SrcLoc) :-
 3697    '$valid_clause'(Clause),
 3698    !,
 3699    (   '$compilation_mode'(database)
 3700    ->  '$record_clause'(Clause, File, SrcLoc)
 3701    ;   '$record_clause'(Clause, File, SrcLoc, Ref),
 3702        '$qlf_assert_clause'(Ref, development)
 3703    ).
 3704
 3705'$is_true'(true)  => true.
 3706'$is_true'((A,B)) => '$is_true'(A), '$is_true'(B).
 3707'$is_true'(_)     => fail.
 3708
 3709'$valid_clause'(_) :-
 3710    current_prolog_flag(sandboxed_load, false),
 3711    !.
 3712'$valid_clause'(Clause) :-
 3713    \+ '$cross_module_clause'(Clause),
 3714    !.
 3715'$valid_clause'(Clause) :-
 3716    Error = error(Formal, _),
 3717    catch(prolog:sandbox_allowed_clause(Clause), Error, true),
 3718    !,
 3719    (   var(Formal)
 3720    ->  true
 3721    ;   print_message(error, Error),
 3722        fail
 3723    ).
 3724'$valid_clause'(Clause) :-
 3725    print_message(error,
 3726                  error(permission_error(assert,
 3727                                         sandboxed_clause,
 3728                                         Clause), _)),
 3729    fail.
 3730
 3731'$cross_module_clause'(Clause) :-
 3732    '$head_module'(Clause, Module),
 3733    \+ '$current_source_module'(Module).
 3734
 3735'$head_module'(Var, _) :-
 3736    var(Var), !, fail.
 3737'$head_module'((Head :- _), Module) :-
 3738    '$head_module'(Head, Module).
 3739'$head_module'(Module:_, Module).
 3740
 3741'$clause_source'('$source_location'(File,Line):Clause, Clause, File:Line) :- !.
 3742'$clause_source'(Clause, Clause, -).
 $store_clause(+Term, +Id) is det
This interface is used by PlDoc (and who knows). Kept for to avoid compatibility issues.
 3749:- public
 3750    '$store_clause'/2. 3751
 3752'$store_clause'(Term, Id) :-
 3753    '$clause_source'(Term, Clause, SrcLoc),
 3754    '$store_clause'(Clause, _, Id, SrcLoc).
 compile_aux_clauses(+Clauses) is det
Compile clauses given the current source location but do not change the notion of the current procedure such that discontiguous warnings are not issued. The clauses are associated with the current file and therefore wiped out if the file is reloaded.

If the cross-referencer is active, we should not (re-)assert the clauses. Actually, we should make them known to the cross-referencer. How do we do that? Maybe we need a different API, such as in:

expand_term_aux(Goal, NewGoal, Clauses)
To be done
- Deal with source code layout?
 3775compile_aux_clauses(_Clauses) :-
 3776    current_prolog_flag(xref, true),
 3777    !.
 3778compile_aux_clauses(Clauses) :-
 3779    source_location(File, _Line),
 3780    '$compile_aux_clauses'(Clauses, File).
 3781
 3782'$compile_aux_clauses'(Clauses, File) :-
 3783    setup_call_cleanup(
 3784        '$start_aux'(File, Context),
 3785        '$store_aux_clauses'(Clauses, File),
 3786        '$end_aux'(File, Context)).
 3787
 3788'$store_aux_clauses'(Clauses, File) :-
 3789    is_list(Clauses),
 3790    !,
 3791    forall('$member'(C,Clauses),
 3792           '$compile_term'(C, _Layout, File)).
 3793'$store_aux_clauses'(Clause, File) :-
 3794    '$compile_term'(Clause, _Layout, File).
 3795
 3796
 3797		 /*******************************
 3798		 *            STAGING		*
 3799		 *******************************/
 $stage_file(+Target, -Stage) is det
 $install_staged_file(+Catcher, +Staged, +Target, +OnError)
Create files using staging, where we first write a temporary file and move it to Target if the file was created successfully. This provides an atomic transition, preventing customers from reading an incomplete file.
 3809'$stage_file'(Target, Stage) :-
 3810    file_directory_name(Target, Dir),
 3811    file_base_name(Target, File),
 3812    current_prolog_flag(pid, Pid),
 3813    format(atom(Stage), '~w/.~w.~d', [Dir,File,Pid]).
 3814
 3815'$install_staged_file'(exit, Staged, Target, error) :-
 3816    !,
 3817    rename_file(Staged, Target).
 3818'$install_staged_file'(exit, Staged, Target, OnError) :-
 3819    !,
 3820    InstallError = error(_,_),
 3821    catch(rename_file(Staged, Target),
 3822          InstallError,
 3823          '$install_staged_error'(OnError, InstallError, Staged, Target)).
 3824'$install_staged_file'(_, Staged, _, _OnError) :-
 3825    E = error(_,_),
 3826    catch(delete_file(Staged), E, true).
 3827
 3828'$install_staged_error'(OnError, Error, Staged, _Target) :-
 3829    E = error(_,_),
 3830    catch(delete_file(Staged), E, true),
 3831    (   OnError = silent
 3832    ->  true
 3833    ;   OnError = fail
 3834    ->  fail
 3835    ;   print_message(warning, Error)
 3836    ).
 3837
 3838
 3839                 /*******************************
 3840                 *             READING          *
 3841                 *******************************/
 3842
 3843:- multifile
 3844    prolog:comment_hook/3.                  % hook for read_clause/3
 3845
 3846
 3847                 /*******************************
 3848                 *       FOREIGN INTERFACE      *
 3849                 *******************************/
 3850
 3851%       call-back from PL_register_foreign().  First argument is the module
 3852%       into which the foreign predicate is loaded and second is a term
 3853%       describing the arguments.
 3854
 3855:- dynamic
 3856    '$foreign_registered'/2. 3857
 3858                 /*******************************
 3859                 *   TEMPORARY TERM EXPANSION   *
 3860                 *******************************/
 3861
 3862% Provide temporary definitions for the boot-loader.  These are replaced
 3863% by the real thing in load.pl
 3864
 3865:- dynamic
 3866    '$expand_goal'/2,
 3867    '$expand_term'/4. 3868
 3869'$expand_goal'(In, In).
 3870'$expand_term'(In, Layout, In, Layout).
 3871
 3872
 3873                 /*******************************
 3874                 *         TYPE SUPPORT         *
 3875                 *******************************/
 3876
 3877'$type_error'(Type, Value) :-
 3878    (   var(Value)
 3879    ->  throw(error(instantiation_error, _))
 3880    ;   throw(error(type_error(Type, Value), _))
 3881    ).
 3882
 3883'$domain_error'(Type, Value) :-
 3884    throw(error(domain_error(Type, Value), _)).
 3885
 3886'$existence_error'(Type, Object) :-
 3887    throw(error(existence_error(Type, Object), _)).
 3888
 3889'$permission_error'(Action, Type, Term) :-
 3890    throw(error(permission_error(Action, Type, Term), _)).
 3891
 3892'$instantiation_error'(_Var) :-
 3893    throw(error(instantiation_error, _)).
 3894
 3895'$uninstantiation_error'(NonVar) :-
 3896    throw(error(uninstantiation_error(NonVar), _)).
 3897
 3898'$must_be'(list, X) :- !,
 3899    '$skip_list'(_, X, Tail),
 3900    (   Tail == []
 3901    ->  true
 3902    ;   '$type_error'(list, Tail)
 3903    ).
 3904'$must_be'(options, X) :- !,
 3905    (   '$is_options'(X)
 3906    ->  true
 3907    ;   '$type_error'(options, X)
 3908    ).
 3909'$must_be'(atom, X) :- !,
 3910    (   atom(X)
 3911    ->  true
 3912    ;   '$type_error'(atom, X)
 3913    ).
 3914'$must_be'(integer, X) :- !,
 3915    (   integer(X)
 3916    ->  true
 3917    ;   '$type_error'(integer, X)
 3918    ).
 3919'$must_be'(between(Low,High), X) :- !,
 3920    (   integer(X)
 3921    ->  (   between(Low, High, X)
 3922        ->  true
 3923        ;   '$domain_error'(between(Low,High), X)
 3924        )
 3925    ;   '$type_error'(integer, X)
 3926    ).
 3927'$must_be'(callable, X) :- !,
 3928    (   callable(X)
 3929    ->  true
 3930    ;   '$type_error'(callable, X)
 3931    ).
 3932'$must_be'(acyclic, X) :- !,
 3933    (   acyclic_term(X)
 3934    ->  true
 3935    ;   '$domain_error'(acyclic_term, X)
 3936    ).
 3937'$must_be'(oneof(Type, Domain, List), X) :- !,
 3938    '$must_be'(Type, X),
 3939    (   memberchk(X, List)
 3940    ->  true
 3941    ;   '$domain_error'(Domain, X)
 3942    ).
 3943'$must_be'(boolean, X) :- !,
 3944    (   (X == true ; X == false)
 3945    ->  true
 3946    ;   '$type_error'(boolean, X)
 3947    ).
 3948'$must_be'(ground, X) :- !,
 3949    (   ground(X)
 3950    ->  true
 3951    ;   '$instantiation_error'(X)
 3952    ).
 3953'$must_be'(filespec, X) :- !,
 3954    (   (   atom(X)
 3955        ;   string(X)
 3956        ;   compound(X),
 3957            compound_name_arity(X, _, 1)
 3958        )
 3959    ->  true
 3960    ;   '$type_error'(filespec, X)
 3961    ).
 3962
 3963% Use for debugging
 3964%'$must_be'(Type, _X) :- format('Unknown $must_be type: ~q~n', [Type]).
 3965
 3966
 3967                /********************************
 3968                *       LIST PROCESSING         *
 3969                *********************************/
 3970
 3971'$member'(El, [H|T]) :-
 3972    '$member_'(T, El, H).
 3973
 3974'$member_'(_, El, El).
 3975'$member_'([H|T], El, _) :-
 3976    '$member_'(T, El, H).
 3977
 3978
 3979'$append'([], L, L).
 3980'$append'([H|T], L, [H|R]) :-
 3981    '$append'(T, L, R).
 3982
 3983'$select'(X, [X|Tail], Tail).
 3984'$select'(Elem, [Head|Tail], [Head|Rest]) :-
 3985    '$select'(Elem, Tail, Rest).
 3986
 3987'$reverse'(L1, L2) :-
 3988    '$reverse'(L1, [], L2).
 3989
 3990'$reverse'([], List, List).
 3991'$reverse'([Head|List1], List2, List3) :-
 3992    '$reverse'(List1, [Head|List2], List3).
 3993
 3994'$delete'([], _, []) :- !.
 3995'$delete'([Elem|Tail], Elem, Result) :-
 3996    !,
 3997    '$delete'(Tail, Elem, Result).
 3998'$delete'([Head|Tail], Elem, [Head|Rest]) :-
 3999    '$delete'(Tail, Elem, Rest).
 4000
 4001'$last'([H|T], Last) :-
 4002    '$last'(T, H, Last).
 4003
 4004'$last'([], Last, Last).
 4005'$last'([H|T], _, Last) :-
 4006    '$last'(T, H, Last).
 length(?List, ?N)
Is true when N is the length of List.
 4013:- '$iso'((length/2)). 4014
 4015length(List, Length) :-
 4016    var(Length),
 4017    !,
 4018    '$skip_list'(Length0, List, Tail),
 4019    (   Tail == []
 4020    ->  Length = Length0                    % +,-
 4021    ;   var(Tail)
 4022    ->  Tail \== Length,                    % avoid length(L,L)
 4023        '$length3'(Tail, Length, Length0)   % -,-
 4024    ;   throw(error(type_error(list, List),
 4025                    context(length/2, _)))
 4026    ).
 4027length(List, Length) :-
 4028    integer(Length),
 4029    Length >= 0,
 4030    !,
 4031    '$skip_list'(Length0, List, Tail),
 4032    (   Tail == []                          % proper list
 4033    ->  Length = Length0
 4034    ;   var(Tail)
 4035    ->  Extra is Length-Length0,
 4036        '$length'(Tail, Extra)
 4037    ;   throw(error(type_error(list, List),
 4038                    context(length/2, _)))
 4039    ).
 4040length(_, Length) :-
 4041    integer(Length),
 4042    !,
 4043    throw(error(domain_error(not_less_than_zero, Length),
 4044                context(length/2, _))).
 4045length(_, Length) :-
 4046    throw(error(type_error(integer, Length),
 4047                context(length/2, _))).
 4048
 4049'$length3'([], N, N).
 4050'$length3'([_|List], N, N0) :-
 4051    N1 is N0+1,
 4052    '$length3'(List, N, N1).
 4053
 4054
 4055                 /*******************************
 4056                 *       OPTION PROCESSING      *
 4057                 *******************************/
 $is_options(@Term) is semidet
True if Term looks like it provides options.
 4063'$is_options'(Map) :-
 4064    is_dict(Map, _),
 4065    !.
 4066'$is_options'(List) :-
 4067    is_list(List),
 4068    (   List == []
 4069    ->  true
 4070    ;   List = [H|_],
 4071        '$is_option'(H, _, _)
 4072    ).
 4073
 4074'$is_option'(Var, _, _) :-
 4075    var(Var), !, fail.
 4076'$is_option'(F, Name, Value) :-
 4077    functor(F, _, 1),
 4078    !,
 4079    F =.. [Name,Value].
 4080'$is_option'(Name=Value, Name, Value).
 $option(?Opt, +Options) is semidet
 4084'$option'(Opt, Options) :-
 4085    is_dict(Options),
 4086    !,
 4087    [Opt] :< Options.
 4088'$option'(Opt, Options) :-
 4089    memberchk(Opt, Options).
 $option(?Opt, +Options, +Default) is det
 4093'$option'(Term, Options, Default) :-
 4094    arg(1, Term, Value),
 4095    functor(Term, Name, 1),
 4096    (   is_dict(Options)
 4097    ->  (   get_dict(Name, Options, GVal)
 4098        ->  Value = GVal
 4099        ;   Value = Default
 4100        )
 4101    ;   functor(Gen, Name, 1),
 4102        arg(1, Gen, GVal),
 4103        (   memberchk(Gen, Options)
 4104        ->  Value = GVal
 4105        ;   Value = Default
 4106        )
 4107    ).
 $select_option(?Opt, +Options, -Rest) is semidet
Select an option from Options.
Arguments:
Rest- is always a map.
 4115'$select_option'(Opt, Options, Rest) :-
 4116    select_dict([Opt], Options, Rest).
 $merge_options(+New, +Default, -Merged) is det
Add/replace options specified in New.
Arguments:
Merged- is always a map.
 4124'$merge_options'(New, Old, Merged) :-
 4125    put_dict(New, Old, Merged).
 4126
 4127
 4128                 /*******************************
 4129                 *   HANDLE TRACER 'L'-COMMAND  *
 4130                 *******************************/
 4131
 4132:- public '$prolog_list_goal'/1. 4133
 4134:- multifile
 4135    user:prolog_list_goal/1. 4136
 4137'$prolog_list_goal'(Goal) :-
 4138    user:prolog_list_goal(Goal),
 4139    !.
 4140'$prolog_list_goal'(Goal) :-
 4141    use_module(library(listing), [listing/1]),
 4142    @(listing(Goal), user).
 4143
 4144
 4145                 /*******************************
 4146                 *             HALT             *
 4147                 *******************************/
 4148
 4149:- '$iso'((halt/0)). 4150
 4151halt :-
 4152    halt(0).
 at_halt(:Goal)
Register Goal to be called if the system halts.
To be done
- : get location into the error message
 4161:- meta_predicate at_halt(0). 4162:- dynamic        system:term_expansion/2, '$at_halt'/2. 4163:- multifile      system:term_expansion/2, '$at_halt'/2. 4164
 4165system:term_expansion((:- at_halt(Goal)),
 4166                      system:'$at_halt'(Module:Goal, File:Line)) :-
 4167    \+ current_prolog_flag(xref, true),
 4168    source_location(File, Line),
 4169    '$current_source_module'(Module).
 4170
 4171at_halt(Goal) :-
 4172    asserta('$at_halt'(Goal, (-):0)).
 4173
 4174:- public '$run_at_halt'/0. 4175
 4176'$run_at_halt' :-
 4177    forall(clause('$at_halt'(Goal, Src), true, Ref),
 4178           ( '$call_at_halt'(Goal, Src),
 4179             erase(Ref)
 4180           )).
 4181
 4182'$call_at_halt'(Goal, _Src) :-
 4183    catch(Goal, E, true),
 4184    !,
 4185    (   var(E)
 4186    ->  true
 4187    ;   subsumes_term(cancel_halt(_), E)
 4188    ->  '$print_message'(informational, E),
 4189        fail
 4190    ;   '$print_message'(error, E)
 4191    ).
 4192'$call_at_halt'(Goal, _Src) :-
 4193    '$print_message'(warning, goal_failed(at_halt, Goal)).
 cancel_halt(+Reason)
This predicate may be called from at_halt/1 handlers to cancel halting the program. If causes halt/0 to fail rather than terminating the process.
 4201cancel_halt(Reason) :-
 4202    throw(cancel_halt(Reason)).
 4203
 4204
 4205                /********************************
 4206                *      LOAD OTHER MODULES       *
 4207                *********************************/
 4208
 4209:- meta_predicate
 4210    '$load_wic_files'(:). 4211
 4212'$load_wic_files'(Files) :-
 4213    Files = Module:_,
 4214    '$execute_directive'('$set_source_module'(OldM, Module), []),
 4215    '$save_lex_state'(LexState, []),
 4216    '$style_check'(_, 0xC7),                % see style_name/2 in syspred.pl
 4217    '$compilation_mode'(OldC, wic),
 4218    consult(Files),
 4219    '$execute_directive'('$set_source_module'(OldM), []),
 4220    '$execute_directive'('$restore_lex_state'(LexState), []),
 4221    '$set_compilation_mode'(OldC).
 $load_additional_boot_files is det
Called from compileFileList() in pl-wic.c. Gets the files from "-c file ..." and loads them into the module user.
 4229:- public '$load_additional_boot_files'/0. 4230
 4231'$load_additional_boot_files' :-
 4232    current_prolog_flag(argv, Argv),
 4233    '$get_files_argv'(Argv, Files),
 4234    (   Files \== []
 4235    ->  format('Loading additional boot files~n'),
 4236        '$load_wic_files'(user:Files),
 4237        format('additional boot files loaded~n')
 4238    ;   true
 4239    ).
 4240
 4241'$get_files_argv'([], []) :- !.
 4242'$get_files_argv'(['-c'|Files], Files) :- !.
 4243'$get_files_argv'([_|Rest], Files) :-
 4244    '$get_files_argv'(Rest, Files).
 4245
 4246'$:-'(('$boot_message'('Loading Prolog startup files~n', []),
 4247       source_location(File, _Line),
 4248       file_directory_name(File, Dir),
 4249       atom_concat(Dir, '/load.pl', LoadFile),
 4250       '$load_wic_files'(system:[LoadFile]),
 4251       (   current_prolog_flag(windows, true)
 4252       ->  atom_concat(Dir, '/menu.pl', MenuFile),
 4253           '$load_wic_files'(system:[MenuFile])
 4254       ;   true
 4255       ),
 4256       '$boot_message'('SWI-Prolog boot files loaded~n', []),
 4257       '$compilation_mode'(OldC, wic),
 4258       '$execute_directive'('$set_source_module'(user), []),
 4259       '$set_compilation_mode'(OldC)
 4260      ))