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', [])).
 memberchk(?E, ?List) is semidet
Semantically equivalent to once(member(E,List)). Implemented in C. If List is partial though we need to do the work in Prolog to get the proper constraint behavior. Needs to be defined early as the boot code uses it.
   76memberchk(E, List) :-
   77    '$memberchk'(E, List, Tail),
   78    (   nonvar(Tail)
   79    ->  true
   80    ;   Tail = [_|_],
   81        memberchk(E, Tail)
   82    ).
   83
   84                /********************************
   85                *          DIRECTIVES           *
   86                *********************************/
   87
   88:- meta_predicate
   89    dynamic(:),
   90    multifile(:),
   91    public(:),
   92    module_transparent(:),
   93    discontiguous(:),
   94    volatile(:),
   95    thread_local(:),
   96    noprofile(:),
   97    non_terminal(:),
   98    '$clausable'(:),
   99    '$iso'(:),
  100    '$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.
  132dynamic(Spec)            :- '$set_pattr'(Spec, pred, dynamic(true)).
  133multifile(Spec)          :- '$set_pattr'(Spec, pred, multifile(true)).
  134module_transparent(Spec) :- '$set_pattr'(Spec, pred, transparent(true)).
  135discontiguous(Spec)      :- '$set_pattr'(Spec, pred, discontiguous(true)).
  136volatile(Spec)           :- '$set_pattr'(Spec, pred, volatile(true)).
  137thread_local(Spec)       :- '$set_pattr'(Spec, pred, thread_local(true)).
  138noprofile(Spec)          :- '$set_pattr'(Spec, pred, noprofile(true)).
  139public(Spec)             :- '$set_pattr'(Spec, pred, public(true)).
  140non_terminal(Spec)       :- '$set_pattr'(Spec, pred, non_terminal(true)).
  141det(Spec)                :- '$set_pattr'(Spec, pred, det(true)).
  142'$iso'(Spec)             :- '$set_pattr'(Spec, pred, iso(true)).
  143'$clausable'(Spec)       :- '$set_pattr'(Spec, pred, clausable(true)).
  144'$hide'(Spec)            :- '$set_pattr'(Spec, pred, trace(false)).
  145
  146'$set_pattr'(M:Pred, How, Attr) :-
  147    '$set_pattr'(Pred, M, How, Attr).
 $set_pattr(+Spec, +Module, +From, +Attr)
Set predicate attributes. From is one of pred or directive.
  153'$set_pattr'(X, _, _, _) :-
  154    var(X),
  155    '$uninstantiation_error'(X).
  156'$set_pattr'(as(Spec,Options), M, How, Attr0) :-
  157    !,
  158    '$attr_options'(Options, Attr0, Attr),
  159    '$set_pattr'(Spec, M, How, Attr).
  160'$set_pattr'([], _, _, _) :- !.
  161'$set_pattr'([H|T], M, How, Attr) :-           % ISO
  162    !,
  163    '$set_pattr'(H, M, How, Attr),
  164    '$set_pattr'(T, M, How, Attr).
  165'$set_pattr'((A,B), M, How, Attr) :-           % ISO and traditional
  166    !,
  167    '$set_pattr'(A, M, How, Attr),
  168    '$set_pattr'(B, M, How, Attr).
  169'$set_pattr'(M:T, _, How, Attr) :-
  170    !,
  171    '$set_pattr'(T, M, How, Attr).
  172'$set_pattr'(PI, M, _, []) :-
  173    !,
  174    '$pi_head'(M:PI, Pred),
  175    '$set_table_wrappers'(Pred).
  176'$set_pattr'(A, M, How, [O|OT]) :-
  177    !,
  178    '$set_pattr'(A, M, How, O),
  179    '$set_pattr'(A, M, How, OT).
  180'$set_pattr'(A, M, pred, Attr) :-
  181    !,
  182    Attr =.. [Name,Val],
  183    '$set_pi_attr'(M:A, Name, Val).
  184'$set_pattr'(A, M, directive, Attr) :-
  185    !,
  186    Attr =.. [Name,Val],
  187    catch('$set_pi_attr'(M:A, Name, Val),
  188          error(E, _),
  189          print_message(error, error(E, context((Name)/1,_)))).
  190
  191'$set_pi_attr'(PI, Name, Val) :-
  192    '$pi_head'(PI, Head),
  193    '$set_predicate_attribute'(Head, Name, Val).
  194
  195'$attr_options'(Var, _, _) :-
  196    var(Var),
  197    !,
  198    '$uninstantiation_error'(Var).
  199'$attr_options'((A,B), Attr0, Attr) :-
  200    !,
  201    '$attr_options'(A, Attr0, Attr1),
  202    '$attr_options'(B, Attr1, Attr).
  203'$attr_options'(Opt, Attr0, Attrs) :-
  204    '$must_be'(ground, Opt),
  205    (   '$attr_option'(Opt, AttrX)
  206    ->  (   is_list(Attr0)
  207        ->  '$join_attrs'(AttrX, Attr0, Attrs)
  208        ;   '$join_attrs'(AttrX, [Attr0], Attrs)
  209        )
  210    ;   '$domain_error'(predicate_option, Opt)
  211    ).
  212
  213'$join_attrs'([], Attrs, Attrs) :-
  214    !.
  215'$join_attrs'([H|T], Attrs0, Attrs) :-
  216    !,
  217    '$join_attrs'(H, Attrs0, Attrs1),
  218    '$join_attrs'(T, Attrs1, Attrs).
  219'$join_attrs'(Attr, Attrs, Attrs) :-
  220    memberchk(Attr, Attrs),
  221    !.
  222'$join_attrs'(Attr, Attrs, Attrs) :-
  223    Attr =.. [Name,Value],
  224    Gen =.. [Name,Existing],
  225    memberchk(Gen, Attrs),
  226    !,
  227    throw(error(conflict_error(Name, Value, Existing), _)).
  228'$join_attrs'(Attr, Attrs0, Attrs) :-
  229    '$append'(Attrs0, [Attr], Attrs).
  230
  231'$attr_option'(incremental, [incremental(true),opaque(false)]).
  232'$attr_option'(monotonic, monotonic(true)).
  233'$attr_option'(lazy, lazy(true)).
  234'$attr_option'(opaque, [incremental(false),opaque(true)]).
  235'$attr_option'(abstract(Level0), abstract(Level)) :-
  236    '$table_option'(Level0, Level).
  237'$attr_option'(subgoal_abstract(Level0), subgoal_abstract(Level)) :-
  238    '$table_option'(Level0, Level).
  239'$attr_option'(answer_abstract(Level0), answer_abstract(Level)) :-
  240    '$table_option'(Level0, Level).
  241'$attr_option'(max_answers(Level0), max_answers(Level)) :-
  242    '$table_option'(Level0, Level).
  243'$attr_option'(volatile, volatile(true)).
  244'$attr_option'(multifile, multifile(true)).
  245'$attr_option'(discontiguous, discontiguous(true)).
  246'$attr_option'(shared, thread_local(false)).
  247'$attr_option'(local, thread_local(true)).
  248'$attr_option'(private, thread_local(true)).
  249
  250'$table_option'(Value0, _Value) :-
  251    var(Value0),
  252    !,
  253    '$instantiation_error'(Value0).
  254'$table_option'(Value0, Value) :-
  255    integer(Value0),
  256    Value0 >= 0,
  257    !,
  258    Value = Value0.
  259'$table_option'(off, -1) :-
  260    !.
  261'$table_option'(false, -1) :-
  262    !.
  263'$table_option'(infinite, -1) :-
  264    !.
  265'$table_option'(Value, _) :-
  266    '$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.
  276'$pattr_directive'(dynamic(Spec), M) :-
  277    '$set_pattr'(Spec, M, directive, dynamic(true)).
  278'$pattr_directive'(multifile(Spec), M) :-
  279    '$set_pattr'(Spec, M, directive, multifile(true)).
  280'$pattr_directive'(module_transparent(Spec), M) :-
  281    '$set_pattr'(Spec, M, directive, transparent(true)).
  282'$pattr_directive'(discontiguous(Spec), M) :-
  283    '$set_pattr'(Spec, M, directive, discontiguous(true)).
  284'$pattr_directive'(volatile(Spec), M) :-
  285    '$set_pattr'(Spec, M, directive, volatile(true)).
  286'$pattr_directive'(thread_local(Spec), M) :-
  287    '$set_pattr'(Spec, M, directive, thread_local(true)).
  288'$pattr_directive'(noprofile(Spec), M) :-
  289    '$set_pattr'(Spec, M, directive, noprofile(true)).
  290'$pattr_directive'(public(Spec), M) :-
  291    '$set_pattr'(Spec, M, directive, public(true)).
  292'$pattr_directive'(det(Spec), M) :-
  293    '$set_pattr'(Spec, M, directive, det(true)).
 $pi_head(?PI, ?Head)
  297'$pi_head'(PI, Head) :-
  298    var(PI),
  299    var(Head),
  300    '$instantiation_error'([PI,Head]).
  301'$pi_head'(M:PI, M:Head) :-
  302    !,
  303    '$pi_head'(PI, Head).
  304'$pi_head'(Name/Arity, Head) :-
  305    !,
  306    '$head_name_arity'(Head, Name, Arity).
  307'$pi_head'(Name//DCGArity, Head) :-
  308    !,
  309    (   nonvar(DCGArity)
  310    ->  Arity is DCGArity+2,
  311        '$head_name_arity'(Head, Name, Arity)
  312    ;   '$head_name_arity'(Head, Name, Arity),
  313        DCGArity is Arity - 2
  314    ).
  315'$pi_head'(PI, _) :-
  316    '$type_error'(predicate_indicator, PI).
 $head_name_arity(+Goal, -Name, -Arity)
$head_name_arity(-Goal, +Name, +Arity)
  321'$head_name_arity'(Goal, Name, Arity) :-
  322    (   atom(Goal)
  323    ->  Name = Goal, Arity = 0
  324    ;   compound(Goal)
  325    ->  compound_name_arity(Goal, Name, Arity)
  326    ;   var(Goal)
  327    ->  (   Arity == 0
  328        ->  (   atom(Name)
  329            ->  Goal = Name
  330            ;   Name == []
  331            ->  Goal = Name
  332            ;   blob(Name, closure)
  333            ->  Goal = Name
  334            ;   '$type_error'(atom, Name)
  335            )
  336        ;   compound_name_arity(Goal, Name, Arity)
  337        )
  338    ;   '$type_error'(callable, Goal)
  339    ).
  340
  341:- '$iso'(((dynamic)/1, (multifile)/1, (discontiguous)/1)).  342
  343
  344                /********************************
  345                *       CALLING, CONTROL        *
  346                *********************************/
  347
  348:- noprofile((call/1,
  349              catch/3,
  350              once/1,
  351              ignore/1,
  352              call_cleanup/2,
  353              call_cleanup/3,
  354              setup_call_cleanup/3,
  355              setup_call_catcher_cleanup/4)).  356
  357:- meta_predicate
  358    ';'(0,0),
  359    ','(0,0),
  360    @(0,+),
  361    call(0),
  362    call(1,?),
  363    call(2,?,?),
  364    call(3,?,?,?),
  365    call(4,?,?,?,?),
  366    call(5,?,?,?,?,?),
  367    call(6,?,?,?,?,?,?),
  368    call(7,?,?,?,?,?,?,?),
  369    not(0),
  370    \+(0),
  371    $(0),
  372    '->'(0,0),
  373    '*->'(0,0),
  374    once(0),
  375    ignore(0),
  376    catch(0,?,0),
  377    reset(0,?,-),
  378    setup_call_cleanup(0,0,0),
  379    setup_call_catcher_cleanup(0,0,?,0),
  380    call_cleanup(0,0),
  381    call_cleanup(0,?,0),
  382    catch_with_backtrace(0,?,0),
  383    '$meta_call'(0).  384
  385:- '$iso'((call/1, (\+)/1, once/1, (;)/2, (',')/2, (->)/2, catch/3)).  386
  387% The control structures are always compiled, both   if they appear in a
  388% clause body and if they are handed  to   call/1.  The only way to call
  389% these predicates is by means of  call/2..   In  that case, we call the
  390% hole control structure again to get it compiled by call/1 and properly
  391% deal  with  !,  etc.  Another  reason  for  having  these  things   as
  392% predicates is to be able to define   properties for them, helping code
  393% analyzers.
  394
  395(M0:If ; M0:Then) :- !, call(M0:(If ; Then)).
  396(M1:If ; M2:Then) :-    call(M1:(If ; M2:Then)).
  397(G1   , G2)       :-    call((G1   , G2)).
  398(If  -> Then)     :-    call((If  -> Then)).
  399(If *-> Then)     :-    call((If *-> Then)).
  400@(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.

  414'$meta_call'(M:G) :-
  415    prolog_current_choice(Ch),
  416    '$meta_call'(G, M, Ch).
  417
  418'$meta_call'(Var, _, _) :-
  419    var(Var),
  420    !,
  421    '$instantiation_error'(Var).
  422'$meta_call'((A,B), M, Ch) :-
  423    !,
  424    '$meta_call'(A, M, Ch),
  425    '$meta_call'(B, M, Ch).
  426'$meta_call'((I->T;E), M, Ch) :-
  427    !,
  428    (   prolog_current_choice(Ch2),
  429        '$meta_call'(I, M, Ch2)
  430    ->  '$meta_call'(T, M, Ch)
  431    ;   '$meta_call'(E, M, Ch)
  432    ).
  433'$meta_call'((I*->T;E), M, Ch) :-
  434    !,
  435    (   prolog_current_choice(Ch2),
  436        '$meta_call'(I, M, Ch2)
  437    *-> '$meta_call'(T, M, Ch)
  438    ;   '$meta_call'(E, M, Ch)
  439    ).
  440'$meta_call'((I->T), M, Ch) :-
  441    !,
  442    (   prolog_current_choice(Ch2),
  443        '$meta_call'(I, M, Ch2)
  444    ->  '$meta_call'(T, M, Ch)
  445    ).
  446'$meta_call'((I*->T), M, Ch) :-
  447    !,
  448    prolog_current_choice(Ch2),
  449    '$meta_call'(I, M, Ch2),
  450    '$meta_call'(T, M, Ch).
  451'$meta_call'((A;B), M, Ch) :-
  452    !,
  453    (   '$meta_call'(A, M, Ch)
  454    ;   '$meta_call'(B, M, Ch)
  455    ).
  456'$meta_call'(\+(G), M, _) :-
  457    !,
  458    prolog_current_choice(Ch),
  459    \+ '$meta_call'(G, M, Ch).
  460'$meta_call'($(G), M, _) :-
  461    !,
  462    prolog_current_choice(Ch),
  463    $('$meta_call'(G, M, Ch)).
  464'$meta_call'(call(G), M, _) :-
  465    !,
  466    prolog_current_choice(Ch),
  467    '$meta_call'(G, M, Ch).
  468'$meta_call'(M:G, _, Ch) :-
  469    !,
  470    '$meta_call'(G, M, Ch).
  471'$meta_call'(!, _, Ch) :-
  472    prolog_cut_to(Ch).
  473'$meta_call'(G, M, _Ch) :-
  474    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..
  490:- '$iso'((call/2,
  491           call/3,
  492           call/4,
  493           call/5,
  494           call/6,
  495           call/7,
  496           call/8)).  497
  498call(Goal) :-                           % make these available as predicates
  499    Goal.
  500call(Goal, A) :-
  501    call(Goal, A).
  502call(Goal, A, B) :-
  503    call(Goal, A, B).
  504call(Goal, A, B, C) :-
  505    call(Goal, A, B, C).
  506call(Goal, A, B, C, D) :-
  507    call(Goal, A, B, C, D).
  508call(Goal, A, B, C, D, E) :-
  509    call(Goal, A, B, C, D, E).
  510call(Goal, A, B, C, D, E, F) :-
  511    call(Goal, A, B, C, D, E, F).
  512call(Goal, A, B, C, D, E, F, G) :-
  513    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.
  520not(Goal) :-
  521    \+ Goal.
 \+ :Goal is semidet
Predicate version that allows for meta-calling.
  527\+ Goal :-
  528    \+ Goal.
 once(:Goal) is semidet
ISO predicate, acting as call((Goal, !)).
  534once(Goal) :-
  535    Goal,
  536    !.
 ignore(:Goal) is det
Call Goal, cut choice-points on success and succeed on failure. intended for calling side-effects and proceed on failure.
  543ignore(Goal) :-
  544    Goal,
  545    !.
  546ignore(_Goal).
  547
  548:- '$iso'((false/0)).
 false
Synonym for fail/0, providing a declarative reading.
  554false :-
  555    fail.
 catch(:Goal, +Catcher, :Recover)
ISO compliant exception handling.
  561catch(_Goal, _Catcher, _Recover) :-
  562    '$catch'.                       % Maps to I_CATCH, I_EXITCATCH
 prolog_cut_to(+Choice)
Cut all choice points after Choice
  568prolog_cut_to(_Choice) :-
  569    '$cut'.                         % Maps to I_CUTCHP
 $ is det
Declare that from now on this predicate succeeds deterministically.
  575'$' :- '$'.
 $ :Goal is det
Declare that Goal must succeed deterministically.
  581$(Goal) :- $(Goal).
 reset(:Goal, ?Ball, -Continue)
Delimited continuation support.
  587reset(_Goal, _Ball, _Cont) :-
  588    '$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.
  597shift(Ball) :-
  598    '$shift'(Ball).
  599
  600shift_for_copy(Ball) :-
  601    '$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.

  615call_continuation([]).
  616call_continuation([TB|Rest]) :-
  617    (   Rest == []
  618    ->  '$call_continuation'(TB)
  619    ;   '$call_continuation'(TB),
  620        call_continuation(Rest)
  621    ).
 catch_with_backtrace(:Goal, ?Ball, :Recover)
As catch/3, but tell library(prolog_stack) to record a backtrace in case of an exception.
  628catch_with_backtrace(Goal, Ball, Recover) :-
  629    catch(Goal, Ball, Recover),
  630    '$no_lco'.
  631
  632'$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.
  642:- public '$recover_and_rethrow'/2.  643
  644'$recover_and_rethrow'(Goal, Exception) :-
  645    call_cleanup(Goal, throw(Exception)),
  646    !.
 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.
  661setup_call_catcher_cleanup(Setup, _Goal, _Catcher, _Cleanup) :-
  662    sig_atomic(Setup),
  663    '$call_cleanup'.
  664
  665setup_call_cleanup(Setup, Goal, Cleanup) :-
  666    setup_call_catcher_cleanup(Setup, Goal, _Catcher, Cleanup).
  667
  668call_cleanup(Goal, Cleanup) :-
  669    setup_call_catcher_cleanup(true, Goal, _Catcher, Cleanup).
  670
  671call_cleanup(Goal, Catcher, Cleanup) :-
  672    setup_call_catcher_cleanup(true, Goal, Catcher, Cleanup).
  673
  674                 /*******************************
  675                 *       INITIALIZATION         *
  676                 *******************************/
  677
  678:- meta_predicate
  679    initialization(0, +).  680
  681:- multifile '$init_goal'/3.  682:- 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.

  708initialization(Goal, When) :-
  709    '$must_be'(oneof(atom, initialization_type,
  710                     [ now,
  711                       after_load,
  712                       restore,
  713                       restore_state,
  714                       prepare_state,
  715                       program,
  716                       main
  717                     ]), When),
  718    '$initialization_context'(Source, Ctx),
  719    '$initialization'(When, Goal, Source, Ctx).
  720
  721'$initialization'(now, Goal, _Source, Ctx) :-
  722    '$run_init_goal'(Goal, Ctx),
  723    '$compile_init_goal'(-, Goal, Ctx).
  724'$initialization'(after_load, Goal, Source, Ctx) :-
  725    (   Source \== (-)
  726    ->  '$compile_init_goal'(Source, Goal, Ctx)
  727    ;   throw(error(context_error(nodirective,
  728                                  initialization(Goal, after_load)),
  729                    _))
  730    ).
  731'$initialization'(restore, Goal, Source, Ctx) :- % deprecated
  732    '$initialization'(restore_state, Goal, Source, Ctx).
  733'$initialization'(restore_state, Goal, _Source, Ctx) :-
  734    (   \+ current_prolog_flag(sandboxed_load, true)
  735    ->  '$compile_init_goal'(-, Goal, Ctx)
  736    ;   '$permission_error'(register, initialization(restore), Goal)
  737    ).
  738'$initialization'(prepare_state, Goal, _Source, Ctx) :-
  739    (   \+ current_prolog_flag(sandboxed_load, true)
  740    ->  '$compile_init_goal'(when(prepare_state), Goal, Ctx)
  741    ;   '$permission_error'(register, initialization(restore), Goal)
  742    ).
  743'$initialization'(program, Goal, _Source, Ctx) :-
  744    (   \+ current_prolog_flag(sandboxed_load, true)
  745    ->  '$compile_init_goal'(when(program), Goal, Ctx)
  746    ;   '$permission_error'(register, initialization(restore), Goal)
  747    ).
  748'$initialization'(main, Goal, _Source, Ctx) :-
  749    (   \+ current_prolog_flag(sandboxed_load, true)
  750    ->  '$compile_init_goal'(when(main), Goal, Ctx)
  751    ;   '$permission_error'(register, initialization(restore), Goal)
  752    ).
  753
  754
  755'$compile_init_goal'(Source, Goal, Ctx) :-
  756    atom(Source),
  757    Source \== (-),
  758    !,
  759    '$store_admin_clause'(system:'$init_goal'(Source, Goal, Ctx),
  760                          _Layout, Source, Ctx).
  761'$compile_init_goal'(Source, Goal, Ctx) :-
  762    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.
  774'$run_initialization'(_, loaded, _) :- !.
  775'$run_initialization'(File, _Action, Options) :-
  776    '$run_initialization'(File, Options).
  777
  778'$run_initialization'(File, Options) :-
  779    setup_call_cleanup(
  780        '$start_run_initialization'(Options, Restore),
  781        '$run_initialization_2'(File),
  782        '$end_run_initialization'(Restore)).
  783
  784'$start_run_initialization'(Options, OldSandBoxed) :-
  785    '$push_input_context'(initialization),
  786    '$set_sandboxed_load'(Options, OldSandBoxed).
  787'$end_run_initialization'(OldSandBoxed) :-
  788    set_prolog_flag(sandboxed_load, OldSandBoxed),
  789    '$pop_input_context'.
  790
  791'$run_initialization_2'(File) :-
  792    (   '$init_goal'(File, Goal, Ctx),
  793        File \= when(_),
  794        '$run_init_goal'(Goal, Ctx),
  795        fail
  796    ;   true
  797    ).
  798
  799'$run_init_goal'(Goal, Ctx) :-
  800    (   catch_with_backtrace('$run_init_goal'(Goal), E,
  801                             '$initialization_error'(E, Goal, Ctx))
  802    ->  true
  803    ;   '$initialization_failure'(Goal, Ctx)
  804    ).
  805
  806:- multifile prolog:sandbox_allowed_goal/1.  807
  808'$run_init_goal'(Goal) :-
  809    current_prolog_flag(sandboxed_load, false),
  810    !,
  811    call(Goal).
  812'$run_init_goal'(Goal) :-
  813    prolog:sandbox_allowed_goal(Goal),
  814    call(Goal).
  815
  816'$initialization_context'(Source, Ctx) :-
  817    (   source_location(File, Line)
  818    ->  Ctx = File:Line,
  819        '$input_context'(Context),
  820        '$top_file'(Context, File, Source)
  821    ;   Ctx = (-),
  822        File = (-)
  823    ).
  824
  825'$top_file'([input(include, F1, _, _)|T], _, F) :-
  826    !,
  827    '$top_file'(T, F1, F).
  828'$top_file'(_, F, F).
  829
  830
  831'$initialization_error'(E, Goal, Ctx) :-
  832    print_message(error, initialization_error(Goal, E, Ctx)).
  833
  834'$initialization_failure'(Goal, Ctx) :-
  835    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
  843:- public '$clear_source_admin'/1.  844
  845'$clear_source_admin'(File) :-
  846    retractall('$init_goal'(_, _, File:_)),
  847    retractall('$load_context_module'(File, _, _)),
  848    retractall('$resolved_source_path_db'(_, _, File)).
  849
  850
  851                 /*******************************
  852                 *            STREAM            *
  853                 *******************************/
  854
  855:- '$iso'(stream_property/2).  856stream_property(Stream, Property) :-
  857    nonvar(Stream),
  858    nonvar(Property),
  859    !,
  860    '$stream_property'(Stream, Property).
  861stream_property(Stream, Property) :-
  862    nonvar(Stream),
  863    !,
  864    '$stream_properties'(Stream, Properties),
  865    '$member'(Property, Properties).
  866stream_property(Stream, Property) :-
  867    nonvar(Property),
  868    !,
  869    (   Property = alias(Alias),
  870        atom(Alias)
  871    ->  '$alias_stream'(Alias, Stream)
  872    ;   '$streams_properties'(Property, Pairs),
  873        '$member'(Stream-Property, Pairs)
  874    ).
  875stream_property(Stream, Property) :-
  876    '$streams_properties'(Property, Pairs),
  877    '$member'(Stream-Properties, Pairs),
  878    '$member'(Property, Properties).
  879
  880
  881                /********************************
  882                *            MODULES            *
  883                *********************************/
  884
  885%       '$prefix_module'(+Module, +Context, +Term, -Prefixed)
  886%       Tags `Term' with `Module:' if `Module' is not the context module.
  887
  888'$prefix_module'(Module, Module, Head, Head) :- !.
  889'$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'.
  895default_module(Me, Super) :-
  896    (   atom(Me)
  897    ->  (   var(Super)
  898        ->  '$default_module'(Me, Super)
  899        ;   '$default_module'(Me, Super), !
  900        )
  901    ;   '$type_error'(module, Me)
  902    ).
  903
  904'$default_module'(Me, Me).
  905'$default_module'(Me, Super) :-
  906    import_module(Me, S),
  907    '$default_module'(S, Super).
  908
  909
  910                /********************************
  911                *      TRACE AND EXCEPTIONS     *
  912                *********************************/
  913
  914:- dynamic   user:exception/3.  915:- multifile user:exception/3.  916:- '$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.
  925:- public
  926    '$undefined_procedure'/4.  927
  928'$undefined_procedure'(Module, Name, Arity, Action) :-
  929    '$prefix_module'(Module, user, Name/Arity, Pred),
  930    user:exception(undefined_predicate, Pred, Action0),
  931    !,
  932    Action = Action0.
  933'$undefined_procedure'(Module, Name, Arity, Action) :-
  934    \+ current_prolog_flag(autoload, false),
  935    '$autoload'(Module:Name/Arity),
  936    !,
  937    Action = retry.
  938'$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.
  950'$loading'(Library) :-
  951    current_prolog_flag(threads, true),
  952    (   '$loading_file'(Library, _Queue, _LoadThread)
  953    ->  true
  954    ;   '$loading_file'(FullFile, _Queue, _LoadThread),
  955        file_name_extension(Library, _, FullFile)
  956    ->  true
  957    ).
  958
  959%        handle debugger 'w', 'p' and <N> depth options.
  960
  961'$set_debugger_write_options'(write) :-
  962    !,
  963    create_prolog_flag(debugger_write_options,
  964                       [ quoted(true),
  965                         attributes(dots),
  966                         spacing(next_argument)
  967                       ], []).
  968'$set_debugger_write_options'(print) :-
  969    !,
  970    create_prolog_flag(debugger_write_options,
  971                       [ quoted(true),
  972                         portray(true),
  973                         max_depth(10),
  974                         attributes(portray),
  975                         spacing(next_argument)
  976                       ], []).
  977'$set_debugger_write_options'(Depth) :-
  978    current_prolog_flag(debugger_write_options, Options0),
  979    (   '$select'(max_depth(_), Options0, Options)
  980    ->  true
  981    ;   Options = Options0
  982    ),
  983    create_prolog_flag(debugger_write_options,
  984                       [max_depth(Depth)|Options], []).
  985
  986
  987                /********************************
  988                *        SYSTEM MESSAGES        *
  989                *********************************/
 $confirm(Spec)
Ask the user to confirm a question. Spec is a term as used for print_message/2.
  996'$confirm'(Spec) :-
  997    print_message(query, Spec),
  998    between(0, 5, _),
  999        get_single_char(Answer),
 1000        (   '$in_reply'(Answer, 'yYjJ \n')
 1001        ->  !,
 1002            print_message(query, if_tty([yes-[]]))
 1003        ;   '$in_reply'(Answer, 'nN')
 1004        ->  !,
 1005            print_message(query, if_tty([no-[]])),
 1006            fail
 1007        ;   print_message(help, query(confirm)),
 1008            fail
 1009        ).
 1010
 1011'$in_reply'(Code, Atom) :-
 1012    char_code(Char, Code),
 1013    sub_atom(Atom, _, _, _, Char),
 1014    !.
 1015
 1016:- dynamic
 1017    user:portray/1. 1018:- multifile
 1019    user:portray/1. 1020
 1021
 1022                 /*******************************
 1023                 *       FILE_SEARCH_PATH       *
 1024                 *******************************/
 1025
 1026:- dynamic
 1027    user:file_search_path/2,
 1028    user:library_directory/1. 1029:- multifile
 1030    user:file_search_path/2,
 1031    user:library_directory/1. 1032
 1033user:(file_search_path(library, Dir) :-
 1034        library_directory(Dir)).
 1035user:file_search_path(swi, Home) :-
 1036    current_prolog_flag(home, Home).
 1037user:file_search_path(swi, Home) :-
 1038    current_prolog_flag(shared_home, Home).
 1039user:file_search_path(library, app_config(lib)).
 1040user:file_search_path(library, swi(library)).
 1041user:file_search_path(library, swi(library/clp)).
 1042user:file_search_path(foreign, swi(ArchLib)) :-
 1043    current_prolog_flag(apple_universal_binary, true),
 1044    ArchLib = 'lib/fat-darwin'.
 1045user:file_search_path(foreign, swi(ArchLib)) :-
 1046    \+ current_prolog_flag(windows, true),
 1047    current_prolog_flag(arch, Arch),
 1048    atom_concat('lib/', Arch, ArchLib).
 1049user:file_search_path(foreign, swi(SoLib)) :-
 1050    (   current_prolog_flag(windows, true)
 1051    ->  SoLib = bin
 1052    ;   SoLib = lib
 1053    ).
 1054user:file_search_path(path, Dir) :-
 1055    getenv('PATH', Path),
 1056    (   current_prolog_flag(windows, true)
 1057    ->  atomic_list_concat(Dirs, (;), Path)
 1058    ;   atomic_list_concat(Dirs, :, Path)
 1059    ),
 1060    '$member'(Dir, Dirs).
 1061user:file_search_path(user_app_data, Dir) :-
 1062    '$xdg_prolog_directory'(data, Dir).
 1063user:file_search_path(common_app_data, Dir) :-
 1064    '$xdg_prolog_directory'(common_data, Dir).
 1065user:file_search_path(user_app_config, Dir) :-
 1066    '$xdg_prolog_directory'(config, Dir).
 1067user:file_search_path(common_app_config, Dir) :-
 1068    '$xdg_prolog_directory'(common_config, Dir).
 1069user:file_search_path(app_data, user_app_data('.')).
 1070user:file_search_path(app_data, common_app_data('.')).
 1071user:file_search_path(app_config, user_app_config('.')).
 1072user:file_search_path(app_config, common_app_config('.')).
 1073% backward compatibility
 1074user:file_search_path(app_preferences, user_app_config('.')).
 1075user:file_search_path(user_profile, app_preferences('.')).
 1076
 1077'$xdg_prolog_directory'(Which, Dir) :-
 1078    '$xdg_directory'(Which, XDGDir),
 1079    '$make_config_dir'(XDGDir),
 1080    '$ensure_slash'(XDGDir, XDGDirS),
 1081    atom_concat(XDGDirS, 'swi-prolog', Dir),
 1082    '$make_config_dir'(Dir).
 1083
 1084% config
 1085'$xdg_directory'(config, Home) :-
 1086    current_prolog_flag(windows, true),
 1087    catch(win_folder(appdata, Home), _, fail),
 1088    !.
 1089'$xdg_directory'(config, Home) :-
 1090    getenv('XDG_CONFIG_HOME', Home).
 1091'$xdg_directory'(config, Home) :-
 1092    expand_file_name('~/.config', [Home]).
 1093% data
 1094'$xdg_directory'(data, Home) :-
 1095    current_prolog_flag(windows, true),
 1096    catch(win_folder(local_appdata, Home), _, fail),
 1097    !.
 1098'$xdg_directory'(data, Home) :-
 1099    getenv('XDG_DATA_HOME', Home).
 1100'$xdg_directory'(data, Home) :-
 1101    expand_file_name('~/.local', [Local]),
 1102    '$make_config_dir'(Local),
 1103    atom_concat(Local, '/share', Home),
 1104    '$make_config_dir'(Home).
 1105% common data
 1106'$xdg_directory'(common_data, Dir) :-
 1107    current_prolog_flag(windows, true),
 1108    catch(win_folder(common_appdata, Dir), _, fail),
 1109    !.
 1110'$xdg_directory'(common_data, Dir) :-
 1111    '$existing_dir_from_env_path'('XDG_DATA_DIRS',
 1112                                  [ '/usr/local/share',
 1113                                    '/usr/share'
 1114                                  ],
 1115                                  Dir).
 1116% common config
 1117'$xdg_directory'(common_config, Dir) :-
 1118    current_prolog_flag(windows, true),
 1119    catch(win_folder(common_appdata, Dir), _, fail),
 1120    !.
 1121'$xdg_directory'(common_config, Dir) :-
 1122    '$existing_dir_from_env_path'('XDG_CONFIG_DIRS', ['/etc/xdg'], Dir).
 1123
 1124'$existing_dir_from_env_path'(Env, Defaults, Dir) :-
 1125    (   getenv(Env, Path)
 1126    ->  '$path_sep'(Sep),
 1127        atomic_list_concat(Dirs, Sep, Path)
 1128    ;   Dirs = Defaults
 1129    ),
 1130    '$member'(Dir, Dirs),
 1131    Dir \== '',
 1132    exists_directory(Dir).
 1133
 1134'$path_sep'(Char) :-
 1135    (   current_prolog_flag(windows, true)
 1136    ->  Char = ';'
 1137    ;   Char = ':'
 1138    ).
 1139
 1140'$make_config_dir'(Dir) :-
 1141    exists_directory(Dir),
 1142    !.
 1143'$make_config_dir'(Dir) :-
 1144    nb_current('$create_search_directories', true),
 1145    file_directory_name(Dir, Parent),
 1146    '$my_file'(Parent),
 1147    catch(make_directory(Dir), _, fail).
 1148
 1149'$ensure_slash'(Dir, DirS) :-
 1150    (   sub_atom(Dir, _, _, 0, /)
 1151    ->  DirS = Dir
 1152    ;   atom_concat(Dir, /, DirS)
 1153    ).
 $expand_file_search_path(+Spec, -Expanded, +Cond) is nondet
 1158'$expand_file_search_path'(Spec, Expanded, Cond) :-
 1159    '$option'(access(Access), Cond),
 1160    memberchk(Access, [write,append]),
 1161    !,
 1162    setup_call_cleanup(
 1163        nb_setval('$create_search_directories', true),
 1164        expand_file_search_path(Spec, Expanded),
 1165        nb_delete('$create_search_directories')).
 1166'$expand_file_search_path'(Spec, Expanded, _Cond) :-
 1167    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?
 1175expand_file_search_path(Spec, Expanded) :-
 1176    catch('$expand_file_search_path'(Spec, Expanded, 0, []),
 1177          loop(Used),
 1178          throw(error(loop_error(Spec), file_search(Used)))).
 1179
 1180'$expand_file_search_path'(Spec, Expanded, N, Used) :-
 1181    functor(Spec, Alias, 1),
 1182    !,
 1183    user:file_search_path(Alias, Exp0),
 1184    NN is N + 1,
 1185    (   NN > 16
 1186    ->  throw(loop(Used))
 1187    ;   true
 1188    ),
 1189    '$expand_file_search_path'(Exp0, Exp1, NN, [Alias=Exp0|Used]),
 1190    arg(1, Spec, Segments),
 1191    '$segments_to_atom'(Segments, File),
 1192    '$make_path'(Exp1, File, Expanded).
 1193'$expand_file_search_path'(Spec, Path, _, _) :-
 1194    '$segments_to_atom'(Spec, Path).
 1195
 1196'$make_path'(Dir, '.', Path) :-
 1197    !,
 1198    Path = Dir.
 1199'$make_path'(Dir, File, Path) :-
 1200    sub_atom(Dir, _, _, 0, /),
 1201    !,
 1202    atom_concat(Dir, File, Path).
 1203'$make_path'(Dir, File, Path) :-
 1204    atomic_list_concat([Dir, /, File], Path).
 1205
 1206
 1207                /********************************
 1208                *         FILE CHECKING         *
 1209                *********************************/
 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.
 1220absolute_file_name(Spec, Options, Path) :-
 1221    '$is_options'(Options),
 1222    \+ '$is_options'(Path),
 1223    !,
 1224    absolute_file_name(Spec, Path, Options).
 1225absolute_file_name(Spec, Path, Options) :-
 1226    '$must_be'(options, Options),
 1227                    % get the valid extensions
 1228    (   '$select_option'(extensions(Exts), Options, Options1)
 1229    ->  '$must_be'(list, Exts)
 1230    ;   '$option'(file_type(Type), Options)
 1231    ->  '$must_be'(atom, Type),
 1232        '$file_type_extensions'(Type, Exts),
 1233        Options1 = Options
 1234    ;   Options1 = Options,
 1235        Exts = ['']
 1236    ),
 1237    '$canonicalise_extensions'(Exts, Extensions),
 1238                    % unless specified otherwise, ask regular file
 1239    (   (   nonvar(Type)
 1240        ;   '$option'(access(none), Options, none)
 1241        )
 1242    ->  Options2 = Options1
 1243    ;   '$merge_options'(_{file_type:regular}, Options1, Options2)
 1244    ),
 1245                    % Det or nondet?
 1246    (   '$select_option'(solutions(Sols), Options2, Options3)
 1247    ->  '$must_be'(oneof(atom, solutions, [first,all]), Sols)
 1248    ;   Sols = first,
 1249        Options3 = Options2
 1250    ),
 1251                    % Errors or not?
 1252    (   '$select_option'(file_errors(FileErrors), Options3, Options4)
 1253    ->  '$must_be'(oneof(atom, file_errors, [error,fail]), FileErrors)
 1254    ;   FileErrors = error,
 1255        Options4 = Options3
 1256    ),
 1257                    % Expand shell patterns?
 1258    (   atomic(Spec),
 1259        '$select_option'(expand(Expand), Options4, Options5),
 1260        '$must_be'(boolean, Expand)
 1261    ->  expand_file_name(Spec, List),
 1262        '$member'(Spec1, List)
 1263    ;   Spec1 = Spec,
 1264        Options5 = Options4
 1265    ),
 1266                    % Search for files
 1267    (   Sols == first
 1268    ->  (   '$chk_file'(Spec1, Extensions, Options5, true, Path)
 1269        ->  !       % also kill choice point of expand_file_name/2
 1270        ;   (   FileErrors == fail
 1271            ->  fail
 1272            ;   '$current_module'('$bags', _File),
 1273                findall(P,
 1274                        '$chk_file'(Spec1, Extensions, [access(exist)],
 1275                                    false, P),
 1276                        Candidates),
 1277                '$abs_file_error'(Spec, Candidates, Options5)
 1278            )
 1279        )
 1280    ;   '$chk_file'(Spec1, Extensions, Options5, false, Path)
 1281    ).
 1282
 1283'$abs_file_error'(Spec, Candidates, Conditions) :-
 1284    '$member'(F, Candidates),
 1285    '$member'(C, Conditions),
 1286    '$file_condition'(C),
 1287    '$file_error'(C, Spec, F, E, Comment),
 1288    !,
 1289    throw(error(E, context(_, Comment))).
 1290'$abs_file_error'(Spec, _, _) :-
 1291    '$existence_error'(source_sink, Spec).
 1292
 1293'$file_error'(file_type(directory), Spec, File, Error, Comment) :-
 1294    \+ exists_directory(File),
 1295    !,
 1296    Error = existence_error(directory, Spec),
 1297    Comment = not_a_directory(File).
 1298'$file_error'(file_type(_), Spec, File, Error, Comment) :-
 1299    exists_directory(File),
 1300    !,
 1301    Error = existence_error(file, Spec),
 1302    Comment = directory(File).
 1303'$file_error'(access(OneOrList), Spec, File, Error, _) :-
 1304    '$one_or_member'(Access, OneOrList),
 1305    \+ access_file(File, Access),
 1306    Error = permission_error(Access, source_sink, Spec).
 1307
 1308'$one_or_member'(Elem, List) :-
 1309    is_list(List),
 1310    !,
 1311    '$member'(Elem, List).
 1312'$one_or_member'(Elem, Elem).
 1313
 1314
 1315'$file_type_extensions'(source, Exts) :-       % SICStus 3.9 compatibility
 1316    !,
 1317    '$file_type_extensions'(prolog, Exts).
 1318'$file_type_extensions'(Type, Exts) :-
 1319    '$current_module'('$bags', _File),
 1320    !,
 1321    findall(Ext, user:prolog_file_type(Ext, Type), Exts0),
 1322    (   Exts0 == [],
 1323        \+ '$ft_no_ext'(Type)
 1324    ->  '$domain_error'(file_type, Type)
 1325    ;   true
 1326    ),
 1327    '$append'(Exts0, [''], Exts).
 1328'$file_type_extensions'(prolog, [pl, '']). % findall is not yet defined ...
 1329
 1330'$ft_no_ext'(txt).
 1331'$ft_no_ext'(executable).
 1332'$ft_no_ext'(directory).
 1333'$ft_no_ext'(regular).
 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.

 1346:- multifile(user:prolog_file_type/2). 1347:- dynamic(user:prolog_file_type/2). 1348
 1349user:prolog_file_type(pl,       prolog).
 1350user:prolog_file_type(prolog,   prolog).
 1351user:prolog_file_type(qlf,      prolog).
 1352user:prolog_file_type(qlf,      qlf).
 1353user:prolog_file_type(Ext,      executable) :-
 1354    current_prolog_flag(shared_object_extension, Ext).
 1355user:prolog_file_type(dylib,    executable) :-
 1356    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.
 1363'$chk_file'(Spec, _Extensions, _Cond, _Cache, _FullName) :-
 1364    \+ ground(Spec),
 1365    !,
 1366    '$instantiation_error'(Spec).
 1367'$chk_file'(Spec, Extensions, Cond, Cache, FullName) :-
 1368    compound(Spec),
 1369    functor(Spec, _, 1),
 1370    !,
 1371    '$relative_to'(Cond, cwd, CWD),
 1372    '$chk_alias_file'(Spec, Extensions, Cond, Cache, CWD, FullName).
 1373'$chk_file'(Segments, Ext, Cond, Cache, FullName) :-    % allow a/b/...
 1374    \+ atomic(Segments),
 1375    !,
 1376    '$segments_to_atom'(Segments, Atom),
 1377    '$chk_file'(Atom, Ext, Cond, Cache, FullName).
 1378'$chk_file'(File, Exts, Cond, _, FullName) :-
 1379    is_absolute_file_name(File),
 1380    !,
 1381    '$extend_file'(File, Exts, Extended),
 1382    '$file_conditions'(Cond, Extended),
 1383    '$absolute_file_name'(Extended, FullName).
 1384'$chk_file'(File, Exts, Cond, _, FullName) :-
 1385    '$relative_to'(Cond, source, Dir),
 1386    atomic_list_concat([Dir, /, File], AbsFile),
 1387    '$extend_file'(AbsFile, Exts, Extended),
 1388    '$file_conditions'(Cond, Extended),
 1389    !,
 1390    '$absolute_file_name'(Extended, FullName).
 1391'$chk_file'(File, Exts, Cond, _, FullName) :-
 1392    '$extend_file'(File, Exts, Extended),
 1393    '$file_conditions'(Cond, Extended),
 1394    '$absolute_file_name'(Extended, FullName).
 1395
 1396'$segments_to_atom'(Atom, Atom) :-
 1397    atomic(Atom),
 1398    !.
 1399'$segments_to_atom'(Segments, Atom) :-
 1400    '$segments_to_list'(Segments, List, []),
 1401    !,
 1402    atomic_list_concat(List, /, Atom).
 1403
 1404'$segments_to_list'(A/B, H, T) :-
 1405    '$segments_to_list'(A, H, T0),
 1406    '$segments_to_list'(B, T0, T).
 1407'$segments_to_list'(A, [A|T], T) :-
 1408    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.
 1418'$relative_to'(Conditions, Default, Dir) :-
 1419    (   '$option'(relative_to(FileOrDir), Conditions)
 1420    *-> (   exists_directory(FileOrDir)
 1421        ->  Dir = FileOrDir
 1422        ;   atom_concat(Dir, /, FileOrDir)
 1423        ->  true
 1424        ;   file_directory_name(FileOrDir, Dir)
 1425        )
 1426    ;   Default == cwd
 1427    ->  '$cwd'(Dir)
 1428    ;   Default == source
 1429    ->  source_location(ContextFile, _Line),
 1430        file_directory_name(ContextFile, Dir)
 1431    ).
 $chk_alias_file(+Spec, +Exts, +Cond, +Cache, +CWD, -FullFile) is nondet
 1436:- dynamic
 1437    '$search_path_file_cache'/3,    % SHA1, Time, Path
 1438    '$search_path_gc_time'/1.       % Time
 1439:- volatile
 1440    '$search_path_file_cache'/3,
 1441    '$search_path_gc_time'/1. 1442
 1443:- create_prolog_flag(file_search_cache_time, 10, []). 1444
 1445'$chk_alias_file'(Spec, Exts, Cond, true, CWD, FullFile) :-
 1446    !,
 1447    findall(Exp, '$expand_file_search_path'(Spec, Exp, Cond), Expansions),
 1448    current_prolog_flag(emulated_dialect, Dialect),
 1449    Cache = cache(Exts, Cond, CWD, Expansions, Dialect),
 1450    variant_sha1(Spec+Cache, SHA1),
 1451    get_time(Now),
 1452    current_prolog_flag(file_search_cache_time, TimeOut),
 1453    (   '$search_path_file_cache'(SHA1, CachedTime, FullFile),
 1454        CachedTime > Now - TimeOut,
 1455        '$file_conditions'(Cond, FullFile)
 1456    ->  '$search_message'(file_search(cache(Spec, Cond), FullFile))
 1457    ;   '$member'(Expanded, Expansions),
 1458        '$extend_file'(Expanded, Exts, LibFile),
 1459        (   '$file_conditions'(Cond, LibFile),
 1460            '$absolute_file_name'(LibFile, FullFile),
 1461            '$cache_file_found'(SHA1, Now, TimeOut, FullFile)
 1462        ->  '$search_message'(file_search(found(Spec, Cond), FullFile))
 1463        ;   '$search_message'(file_search(tried(Spec, Cond), LibFile)),
 1464            fail
 1465        )
 1466    ).
 1467'$chk_alias_file'(Spec, Exts, Cond, false, _CWD, FullFile) :-
 1468    '$expand_file_search_path'(Spec, Expanded, Cond),
 1469    '$extend_file'(Expanded, Exts, LibFile),
 1470    '$file_conditions'(Cond, LibFile),
 1471    '$absolute_file_name'(LibFile, FullFile).
 1472
 1473'$cache_file_found'(_, _, TimeOut, _) :-
 1474    TimeOut =:= 0,
 1475    !.
 1476'$cache_file_found'(SHA1, Now, TimeOut, FullFile) :-
 1477    '$search_path_file_cache'(SHA1, Saved, FullFile),
 1478    !,
 1479    (   Now - Saved < TimeOut/2
 1480    ->  true
 1481    ;   retractall('$search_path_file_cache'(SHA1, _, _)),
 1482        asserta('$search_path_file_cache'(SHA1, Now, FullFile))
 1483    ).
 1484'$cache_file_found'(SHA1, Now, TimeOut, FullFile) :-
 1485    'gc_file_search_cache'(TimeOut),
 1486    asserta('$search_path_file_cache'(SHA1, Now, FullFile)).
 1487
 1488'gc_file_search_cache'(TimeOut) :-
 1489    get_time(Now),
 1490    '$search_path_gc_time'(Last),
 1491    Now-Last < TimeOut/2,
 1492    !.
 1493'gc_file_search_cache'(TimeOut) :-
 1494    get_time(Now),
 1495    retractall('$search_path_gc_time'(_)),
 1496    assertz('$search_path_gc_time'(Now)),
 1497    Before is Now - TimeOut,
 1498    (   '$search_path_file_cache'(SHA1, Cached, FullFile),
 1499        Cached < Before,
 1500        retractall('$search_path_file_cache'(SHA1, Cached, FullFile)),
 1501        fail
 1502    ;   true
 1503    ).
 1504
 1505
 1506'$search_message'(Term) :-
 1507    current_prolog_flag(verbose_file_search, true),
 1508    !,
 1509    print_message(informational, Term).
 1510'$search_message'(_).
 $file_conditions(+Condition, +Path)
Verify Path satisfies Condition.
 1517'$file_conditions'(List, File) :-
 1518    is_list(List),
 1519    !,
 1520    \+ ( '$member'(C, List),
 1521         '$file_condition'(C),
 1522         \+ '$file_condition'(C, File)
 1523       ).
 1524'$file_conditions'(Map, File) :-
 1525    \+ (  get_dict(Key, Map, Value),
 1526          C =.. [Key,Value],
 1527          '$file_condition'(C),
 1528         \+ '$file_condition'(C, File)
 1529       ).
 1530
 1531'$file_condition'(file_type(directory), File) :-
 1532    !,
 1533    exists_directory(File).
 1534'$file_condition'(file_type(_), File) :-
 1535    !,
 1536    \+ exists_directory(File).
 1537'$file_condition'(access(Accesses), File) :-
 1538    !,
 1539    \+ (  '$one_or_member'(Access, Accesses),
 1540          \+ access_file(File, Access)
 1541       ).
 1542
 1543'$file_condition'(exists).
 1544'$file_condition'(file_type(_)).
 1545'$file_condition'(access(_)).
 1546
 1547'$extend_file'(File, Exts, FileEx) :-
 1548    '$ensure_extensions'(Exts, File, Fs),
 1549    '$list_to_set'(Fs, FsSet),
 1550    '$member'(FileEx, FsSet).
 1551
 1552'$ensure_extensions'([], _, []).
 1553'$ensure_extensions'([E|E0], F, [FE|E1]) :-
 1554    file_name_extension(F, E, FE),
 1555    '$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).
 1562'$list_to_set'(List, Set) :-
 1563    '$number_list'(List, 1, Numbered),
 1564    sort(1, @=<, Numbered, ONum),
 1565    '$remove_dup_keys'(ONum, NumSet),
 1566    sort(2, @=<, NumSet, ONumSet),
 1567    '$pairs_keys'(ONumSet, Set).
 1568
 1569'$number_list'([], _, []).
 1570'$number_list'([H|T0], N, [H-N|T]) :-
 1571    N1 is N+1,
 1572    '$number_list'(T0, N1, T).
 1573
 1574'$remove_dup_keys'([], []).
 1575'$remove_dup_keys'([H|T0], [H|T]) :-
 1576    H = V-_,
 1577    '$remove_same_key'(T0, V, T1),
 1578    '$remove_dup_keys'(T1, T).
 1579
 1580'$remove_same_key'([V1-_|T0], V, T) :-
 1581    V1 == V,
 1582    !,
 1583    '$remove_same_key'(T0, V, T).
 1584'$remove_same_key'(L, _, L).
 1585
 1586'$pairs_keys'([], []).
 1587'$pairs_keys'([K-_|T0], [K|T]) :-
 1588    '$pairs_keys'(T0, T).
 1589
 1590
 1591/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
 1592Canonicalise the extension list. Old SWI-Prolog   require  `.pl', etc, which
 1593the Quintus compatibility  requests  `pl'.   This  layer  canonicalises  all
 1594extensions to .ext
 1595- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
 1596
 1597'$canonicalise_extensions'([], []) :- !.
 1598'$canonicalise_extensions'([H|T], [CH|CT]) :-
 1599    !,
 1600    '$must_be'(atom, H),
 1601    '$canonicalise_extension'(H, CH),
 1602    '$canonicalise_extensions'(T, CT).
 1603'$canonicalise_extensions'(E, [CE]) :-
 1604    '$canonicalise_extension'(E, CE).
 1605
 1606'$canonicalise_extension'('', '') :- !.
 1607'$canonicalise_extension'(DotAtom, DotAtom) :-
 1608    sub_atom(DotAtom, 0, _, _, '.'),
 1609    !.
 1610'$canonicalise_extension'(Atom, DotAtom) :-
 1611    atom_concat('.', Atom, DotAtom).
 1612
 1613
 1614                /********************************
 1615                *            CONSULT            *
 1616                *********************************/
 1617
 1618:- dynamic
 1619    user:library_directory/1,
 1620    user:prolog_load_file/2. 1621:- multifile
 1622    user:library_directory/1,
 1623    user:prolog_load_file/2. 1624
 1625:- prompt(_, '|: '). 1626
 1627:- thread_local
 1628    '$compilation_mode_store'/1,    % database, wic, qlf
 1629    '$directive_mode_store'/1.      % database, wic, qlf
 1630:- volatile
 1631    '$compilation_mode_store'/1,
 1632    '$directive_mode_store'/1. 1633
 1634'$compilation_mode'(Mode) :-
 1635    (   '$compilation_mode_store'(Val)
 1636    ->  Mode = Val
 1637    ;   Mode = database
 1638    ).
 1639
 1640'$set_compilation_mode'(Mode) :-
 1641    retractall('$compilation_mode_store'(_)),
 1642    assertz('$compilation_mode_store'(Mode)).
 1643
 1644'$compilation_mode'(Old, New) :-
 1645    '$compilation_mode'(Old),
 1646    (   New == Old
 1647    ->  true
 1648    ;   '$set_compilation_mode'(New)
 1649    ).
 1650
 1651'$directive_mode'(Mode) :-
 1652    (   '$directive_mode_store'(Val)
 1653    ->  Mode = Val
 1654    ;   Mode = database
 1655    ).
 1656
 1657'$directive_mode'(Old, New) :-
 1658    '$directive_mode'(Old),
 1659    (   New == Old
 1660    ->  true
 1661    ;   '$set_directive_mode'(New)
 1662    ).
 1663
 1664'$set_directive_mode'(Mode) :-
 1665    retractall('$directive_mode_store'(_)),
 1666    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.
 1674'$compilation_level'(Level) :-
 1675    '$input_context'(Stack),
 1676    '$compilation_level'(Stack, Level).
 1677
 1678'$compilation_level'([], 0).
 1679'$compilation_level'([Input|T], Level) :-
 1680    (   arg(1, Input, see)
 1681    ->  '$compilation_level'(T, Level)
 1682    ;   '$compilation_level'(T, Level0),
 1683        Level is Level0+1
 1684    ).
 compiling
Is true if SWI-Prolog is generating a state or qlf file or executes a `call' directive while doing this.
 1692compiling :-
 1693    \+ (   '$compilation_mode'(database),
 1694           '$directive_mode'(database)
 1695       ).
 1696
 1697:- meta_predicate
 1698    '$ifcompiling'(0). 1699
 1700'$ifcompiling'(G) :-
 1701    (   '$compilation_mode'(database)
 1702    ->  true
 1703    ;   call(G)
 1704    ).
 1705
 1706                /********************************
 1707                *         READ SOURCE           *
 1708                *********************************/
 $load_msg_level(+Action, +NestingLevel, -StartVerbose, -EndVerbose)
 1712'$load_msg_level'(Action, Nesting, Start, Done) :-
 1713    '$update_autoload_level'([], 0),
 1714    !,
 1715    current_prolog_flag(verbose_load, Type0),
 1716    '$load_msg_compat'(Type0, Type),
 1717    (   '$load_msg_level'(Action, Nesting, Type, Start, Done)
 1718    ->  true
 1719    ).
 1720'$load_msg_level'(_, _, silent, silent).
 1721
 1722'$load_msg_compat'(true, normal) :- !.
 1723'$load_msg_compat'(false, silent) :- !.
 1724'$load_msg_compat'(X, X).
 1725
 1726'$load_msg_level'(load_file,    _, full,   informational, informational).
 1727'$load_msg_level'(include_file, _, full,   informational, informational).
 1728'$load_msg_level'(load_file,    _, normal, silent,        informational).
 1729'$load_msg_level'(include_file, _, normal, silent,        silent).
 1730'$load_msg_level'(load_file,    0, brief,  silent,        informational).
 1731'$load_msg_level'(load_file,    _, brief,  silent,        silent).
 1732'$load_msg_level'(include_file, _, brief,  silent,        silent).
 1733'$load_msg_level'(load_file,    _, silent, silent,        silent).
 1734'$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)
 1757'$source_term'(From, Read, RLayout, Term, TLayout, Stream, Options) :-
 1758    '$source_term'(From, Read, RLayout, Term, TLayout, Stream, [], Options),
 1759    (   Term == end_of_file
 1760    ->  !, fail
 1761    ;   Term \== begin_of_file
 1762    ).
 1763
 1764'$source_term'(Input, _,_,_,_,_,_,_) :-
 1765    \+ ground(Input),
 1766    !,
 1767    '$instantiation_error'(Input).
 1768'$source_term'(stream(Id, In, Opts),
 1769               Read, RLayout, Term, TLayout, Stream, Parents, Options) :-
 1770    !,
 1771    '$record_included'(Parents, Id, Id, 0.0, Message),
 1772    setup_call_cleanup(
 1773        '$open_source'(stream(Id, In, Opts), In, State, Parents, Options),
 1774        '$term_in_file'(In, Read, RLayout, Term, TLayout, Stream,
 1775                        [Id|Parents], Options),
 1776        '$close_source'(State, Message)).
 1777'$source_term'(File,
 1778               Read, RLayout, Term, TLayout, Stream, Parents, Options) :-
 1779    absolute_file_name(File, Path,
 1780                       [ file_type(prolog),
 1781                         access(read)
 1782                       ]),
 1783    time_file(Path, Time),
 1784    '$record_included'(Parents, File, Path, Time, Message),
 1785    setup_call_cleanup(
 1786        '$open_source'(Path, In, State, Parents, Options),
 1787        '$term_in_file'(In, Read, RLayout, Term, TLayout, Stream,
 1788                        [Path|Parents], Options),
 1789        '$close_source'(State, Message)).
 1790
 1791:- thread_local
 1792    '$load_input'/2. 1793:- volatile
 1794    '$load_input'/2. 1795
 1796'$open_source'(stream(Id, In, Opts), In,
 1797               restore(In, StreamState, Id, Ref, Opts), Parents, _Options) :-
 1798    !,
 1799    '$context_type'(Parents, ContextType),
 1800    '$push_input_context'(ContextType),
 1801    '$prepare_load_stream'(In, Id, StreamState),
 1802    asserta('$load_input'(stream(Id), In), Ref).
 1803'$open_source'(Path, In, close(In, Path, Ref), Parents, Options) :-
 1804    '$context_type'(Parents, ContextType),
 1805    '$push_input_context'(ContextType),
 1806    '$open_source'(Path, In, Options),
 1807    '$set_encoding'(In, Options),
 1808    asserta('$load_input'(Path, In), Ref).
 1809
 1810'$context_type'([], load_file) :- !.
 1811'$context_type'(_, include).
 1812
 1813:- multifile prolog:open_source_hook/3. 1814
 1815'$open_source'(Path, In, Options) :-
 1816    prolog:open_source_hook(Path, In, Options),
 1817    !.
 1818'$open_source'(Path, In, _Options) :-
 1819    open(Path, read, In).
 1820
 1821'$close_source'(close(In, _Id, Ref), Message) :-
 1822    erase(Ref),
 1823    call_cleanup(
 1824        close(In),
 1825        '$pop_input_context'),
 1826    '$close_message'(Message).
 1827'$close_source'(restore(In, StreamState, _Id, Ref, Opts), Message) :-
 1828    erase(Ref),
 1829    call_cleanup(
 1830        '$restore_load_stream'(In, StreamState, Opts),
 1831        '$pop_input_context'),
 1832    '$close_message'(Message).
 1833
 1834'$close_message'(message(Level, Msg)) :-
 1835    !,
 1836    '$print_message'(Level, Msg).
 1837'$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.
 1849'$term_in_file'(In, Read, RLayout, Term, TLayout, Stream, Parents, Options) :-
 1850    Parents \= [_,_|_],
 1851    (   '$load_input'(_, Input)
 1852    ->  stream_property(Input, file_name(File))
 1853    ),
 1854    '$set_source_location'(File, 0),
 1855    '$expanded_term'(In,
 1856                     begin_of_file, 0-0, Read, RLayout, Term, TLayout,
 1857                     Stream, Parents, Options).
 1858'$term_in_file'(In, Read, RLayout, Term, TLayout, Stream, Parents, Options) :-
 1859    '$skip_script_line'(In, Options),
 1860    '$read_clause_options'(Options, ReadOptions),
 1861    repeat,
 1862      read_clause(In, Raw,
 1863                  [ variable_names(Bindings),
 1864                    term_position(Pos),
 1865                    subterm_positions(RawLayout)
 1866                  | ReadOptions
 1867                  ]),
 1868      b_setval('$term_position', Pos),
 1869      b_setval('$variable_names', Bindings),
 1870      (   Raw == end_of_file
 1871      ->  !,
 1872          (   Parents = [_,_|_]     % Included file
 1873          ->  fail
 1874          ;   '$expanded_term'(In,
 1875                               Raw, RawLayout, Read, RLayout, Term, TLayout,
 1876                               Stream, Parents, Options)
 1877          )
 1878      ;   '$expanded_term'(In, Raw, RawLayout, Read, RLayout, Term, TLayout,
 1879                           Stream, Parents, Options)
 1880      ).
 1881
 1882'$read_clause_options'([], []).
 1883'$read_clause_options'([H|T0], List) :-
 1884    (   '$read_clause_option'(H)
 1885    ->  List = [H|T]
 1886    ;   List = T
 1887    ),
 1888    '$read_clause_options'(T0, T).
 1889
 1890'$read_clause_option'(syntax_errors(_)).
 1891'$read_clause_option'(term_position(_)).
 1892'$read_clause_option'(process_comment(_)).
 1893
 1894'$expanded_term'(In, Raw, RawLayout, Read, RLayout, Term, TLayout,
 1895                 Stream, Parents, Options) :-
 1896    E = error(_,_),
 1897    catch('$expand_term'(Raw, RawLayout, Expanded, ExpandedLayout), E,
 1898          '$print_message_fail'(E)),
 1899    (   Expanded \== []
 1900    ->  '$expansion_member'(Expanded, ExpandedLayout, Term1, Layout1)
 1901    ;   Term1 = Expanded,
 1902        Layout1 = ExpandedLayout
 1903    ),
 1904    (   nonvar(Term1), Term1 = (:-Directive), nonvar(Directive)
 1905    ->  (   Directive = include(File),
 1906            '$current_source_module'(Module),
 1907            '$valid_directive'(Module:include(File))
 1908        ->  stream_property(In, encoding(Enc)),
 1909            '$add_encoding'(Enc, Options, Options1),
 1910            '$source_term'(File, Read, RLayout, Term, TLayout,
 1911                           Stream, Parents, Options1)
 1912        ;   Directive = encoding(Enc)
 1913        ->  set_stream(In, encoding(Enc)),
 1914            fail
 1915        ;   Term = Term1,
 1916            Stream = In,
 1917            Read = Raw
 1918        )
 1919    ;   Term = Term1,
 1920        TLayout = Layout1,
 1921        Stream = In,
 1922        Read = Raw,
 1923        RLayout = RawLayout
 1924    ).
 1925
 1926'$expansion_member'(Var, Layout, Var, Layout) :-
 1927    var(Var),
 1928    !.
 1929'$expansion_member'([], _, _, _) :- !, fail.
 1930'$expansion_member'(List, ListLayout, Term, Layout) :-
 1931    is_list(List),
 1932    !,
 1933    (   var(ListLayout)
 1934    ->  '$member'(Term, List)
 1935    ;   is_list(ListLayout)
 1936    ->  '$member_rep2'(Term, Layout, List, ListLayout)
 1937    ;   Layout = ListLayout,
 1938        '$member'(Term, List)
 1939    ).
 1940'$expansion_member'(X, Layout, X, Layout).
 1941
 1942% pairwise member, repeating last element of the second
 1943% list.
 1944
 1945'$member_rep2'(H1, H2, [H1|_], [H2|_]).
 1946'$member_rep2'(H1, H2, [_|T1], [T2]) :-
 1947    !,
 1948    '$member_rep2'(H1, H2, T1, [T2]).
 1949'$member_rep2'(H1, H2, [_|T1], [_|T2]) :-
 1950    '$member_rep2'(H1, H2, T1, T2).
 $add_encoding(+Enc, +Options0, -Options)
 1954'$add_encoding'(Enc, Options0, Options) :-
 1955    (   Options0 = [encoding(Enc)|_]
 1956    ->  Options = Options0
 1957    ;   Options = [encoding(Enc)|Options0]
 1958    ).
 1959
 1960
 1961:- multifile
 1962    '$included'/4.                  % Into, Line, File, LastModified
 1963:- dynamic
 1964    '$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'.

 1978'$record_included'([Parent|Parents], File, Path, Time,
 1979                   message(DoneMsgLevel,
 1980                           include_file(done(Level, file(File, Path))))) :-
 1981    source_location(SrcFile, Line),
 1982    !,
 1983    '$compilation_level'(Level),
 1984    '$load_msg_level'(include_file, Level, StartMsgLevel, DoneMsgLevel),
 1985    '$print_message'(StartMsgLevel,
 1986                     include_file(start(Level,
 1987                                        file(File, Path)))),
 1988    '$last'([Parent|Parents], Owner),
 1989    (   (   '$compilation_mode'(database)
 1990        ;   '$qlf_current_source'(Owner)
 1991        )
 1992    ->  '$store_admin_clause'(
 1993            system:'$included'(Parent, Line, Path, Time),
 1994            _, Owner, SrcFile:Line)
 1995    ;   '$qlf_include'(Owner, Parent, Line, Path, Time)
 1996    ).
 1997'$record_included'(_, _, _, _, true).
 $master_file(+File, -MasterFile)
Find the primary load file from included files.
 2003'$master_file'(File, MasterFile) :-
 2004    '$included'(MasterFile0, _Line, File, _Time),
 2005    !,
 2006    '$master_file'(MasterFile0, MasterFile).
 2007'$master_file'(File, File).
 2008
 2009
 2010'$skip_script_line'(_In, Options) :-
 2011    '$option'(check_script(false), Options),
 2012    !.
 2013'$skip_script_line'(In, _Options) :-
 2014    (   peek_char(In, #)
 2015    ->  skip(In, 10)
 2016    ;   true
 2017    ).
 2018
 2019'$set_encoding'(Stream, Options) :-
 2020    '$option'(encoding(Enc), Options),
 2021    !,
 2022    Enc \== default,
 2023    set_stream(Stream, encoding(Enc)).
 2024'$set_encoding'(_, _).
 2025
 2026
 2027'$prepare_load_stream'(In, Id, state(HasName,HasPos)) :-
 2028    (   stream_property(In, file_name(_))
 2029    ->  HasName = true,
 2030        (   stream_property(In, position(_))
 2031        ->  HasPos = true
 2032        ;   HasPos = false,
 2033            set_stream(In, record_position(true))
 2034        )
 2035    ;   HasName = false,
 2036        set_stream(In, file_name(Id)),
 2037        (   stream_property(In, position(_))
 2038        ->  HasPos = true
 2039        ;   HasPos = false,
 2040            set_stream(In, record_position(true))
 2041        )
 2042    ).
 2043
 2044'$restore_load_stream'(In, _State, Options) :-
 2045    memberchk(close(true), Options),
 2046    !,
 2047    close(In).
 2048'$restore_load_stream'(In, state(HasName, HasPos), _Options) :-
 2049    (   HasName == false
 2050    ->  set_stream(In, file_name(''))
 2051    ;   true
 2052    ),
 2053    (   HasPos == false
 2054    ->  set_stream(In, record_position(false))
 2055    ;   true
 2056    ).
 2057
 2058
 2059                 /*******************************
 2060                 *          DERIVED FILES       *
 2061                 *******************************/
 2062
 2063:- dynamic
 2064    '$derived_source_db'/3.         % Loaded, DerivedFrom, Time
 2065
 2066'$register_derived_source'(_, '-') :- !.
 2067'$register_derived_source'(Loaded, DerivedFrom) :-
 2068    retractall('$derived_source_db'(Loaded, _, _)),
 2069    time_file(DerivedFrom, Time),
 2070    assert('$derived_source_db'(Loaded, DerivedFrom, Time)).
 2071
 2072%       Auto-importing dynamic predicates is not very elegant and
 2073%       leads to problems with qsave_program/[1,2]
 2074
 2075'$derived_source'(Loaded, DerivedFrom, Time) :-
 2076    '$derived_source_db'(Loaded, DerivedFrom, Time).
 2077
 2078
 2079                /********************************
 2080                *       LOAD PREDICATES         *
 2081                *********************************/
 2082
 2083:- meta_predicate
 2084    ensure_loaded(:),
 2085    [:|+],
 2086    consult(:),
 2087    use_module(:),
 2088    use_module(:, +),
 2089    reexport(:),
 2090    reexport(:, +),
 2091    load_files(:),
 2092    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.
 2100ensure_loaded(Files) :-
 2101    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.
 2110use_module(Files) :-
 2111    load_files(Files, [ if(not_loaded),
 2112                        must_be_module(true)
 2113                      ]).
 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.
 2120use_module(File, Import) :-
 2121    load_files(File, [ if(not_loaded),
 2122                       must_be_module(true),
 2123                       imports(Import)
 2124                     ]).
 reexport(+Files)
As use_module/1, exporting all imported predicates.
 2130reexport(Files) :-
 2131    load_files(Files, [ if(not_loaded),
 2132                        must_be_module(true),
 2133                        reexport(true)
 2134                      ]).
 reexport(+File, +ImportList)
As use_module/1, re-exporting all imported predicates.
 2140reexport(File, Import) :-
 2141    load_files(File, [ if(not_loaded),
 2142                       must_be_module(true),
 2143                       imports(Import),
 2144                       reexport(true)
 2145                     ]).
 2146
 2147
 2148[X] :-
 2149    !,
 2150    consult(X).
 2151[M:F|R] :-
 2152    consult(M:[F|R]).
 2153
 2154consult(M:X) :-
 2155    X == user,
 2156    !,
 2157    flag('$user_consult', N, N+1),
 2158    NN is N + 1,
 2159    atom_concat('user://', NN, Id),
 2160    load_files(M:Id, [stream(user_input), check_script(false), silent(false)]).
 2161consult(List) :-
 2162    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.
 2169load_files(Files) :-
 2170    load_files(Files, []).
 2171load_files(Module:Files, Options) :-
 2172    '$must_be'(list, Options),
 2173    '$load_files'(Files, Module, Options).
 2174
 2175'$load_files'(X, _, _) :-
 2176    var(X),
 2177    !,
 2178    '$instantiation_error'(X).
 2179'$load_files'([], _, _) :- !.
 2180'$load_files'(Id, Module, Options) :-   % load_files(foo, [stream(In)])
 2181    '$option'(stream(_), Options),
 2182    !,
 2183    (   atom(Id)
 2184    ->  '$load_file'(Id, Module, Options)
 2185    ;   throw(error(type_error(atom, Id), _))
 2186    ).
 2187'$load_files'(List, Module, Options) :-
 2188    List = [_|_],
 2189    !,
 2190    '$must_be'(list, List),
 2191    '$load_file_list'(List, Module, Options).
 2192'$load_files'(File, Module, Options) :-
 2193    '$load_one_file'(File, Module, Options).
 2194
 2195'$load_file_list'([], _, _).
 2196'$load_file_list'([File|Rest], Module, Options) :-
 2197    E = error(_,_),
 2198    catch('$load_one_file'(File, Module, Options), E,
 2199          '$print_message'(error, E)),
 2200    '$load_file_list'(Rest, Module, Options).
 2201
 2202
 2203'$load_one_file'(Spec, Module, Options) :-
 2204    atomic(Spec),
 2205    '$option'(expand(Expand), Options, false),
 2206    Expand == true,
 2207    !,
 2208    expand_file_name(Spec, Expanded),
 2209    (   Expanded = [Load]
 2210    ->  true
 2211    ;   Load = Expanded
 2212    ),
 2213    '$load_files'(Load, Module, [expand(false)|Options]).
 2214'$load_one_file'(File, Module, Options) :-
 2215    strip_module(Module:File, Into, PlainFile),
 2216    '$load_file'(PlainFile, Into, Options).
 $noload(+Condition, +FullFile, +Options) is semidet
True of FullFile should not be loaded.
 2223'$noload'(true, _, _) :-
 2224    !,
 2225    fail.
 2226'$noload'(_, FullFile, _Options) :-
 2227    '$time_source_file'(FullFile, Time, system),
 2228    Time > 0.0,
 2229    !.
 2230'$noload'(not_loaded, FullFile, _) :-
 2231    source_file(FullFile),
 2232    !.
 2233'$noload'(changed, Derived, _) :-
 2234    '$derived_source'(_FullFile, Derived, LoadTime),
 2235    time_file(Derived, Modified),
 2236    Modified @=< LoadTime,
 2237    !.
 2238'$noload'(changed, FullFile, Options) :-
 2239    '$time_source_file'(FullFile, LoadTime, user),
 2240    '$modified_id'(FullFile, Modified, Options),
 2241    Modified @=< LoadTime,
 2242    !.
 $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.
 2261'$qlf_file'(Spec, _, Spec, stream, Options) :-
 2262    '$option'(stream(_), Options),      % stream: no choice
 2263    !.
 2264'$qlf_file'(Spec, FullFile, FullFile, compile, _) :-
 2265    '$spec_extension'(Spec, Ext),       % user explicitly specified
 2266    user:prolog_file_type(Ext, prolog),
 2267    !.
 2268'$qlf_file'(Spec, FullFile, LoadFile, Mode, Options) :-
 2269    '$compilation_mode'(database),
 2270    file_name_extension(Base, PlExt, FullFile),
 2271    user:prolog_file_type(PlExt, prolog),
 2272    user:prolog_file_type(QlfExt, qlf),
 2273    file_name_extension(Base, QlfExt, QlfFile),
 2274    (   access_file(QlfFile, read),
 2275        (   '$qlf_out_of_date'(FullFile, QlfFile, Why)
 2276        ->  (   access_file(QlfFile, write)
 2277            ->  print_message(informational,
 2278                              qlf(recompile(Spec, FullFile, QlfFile, Why))),
 2279                Mode = qcompile,
 2280                LoadFile = FullFile
 2281            ;   Why == old,
 2282                (   current_prolog_flag(home, PlHome),
 2283                    sub_atom(FullFile, 0, _, _, PlHome)
 2284                ;   sub_atom(QlfFile, 0, _, _, 'res://')
 2285                )
 2286            ->  print_message(silent,
 2287                              qlf(system_lib_out_of_date(Spec, QlfFile))),
 2288                Mode = qload,
 2289                LoadFile = QlfFile
 2290            ;   print_message(warning,
 2291                              qlf(can_not_recompile(Spec, QlfFile, Why))),
 2292                Mode = compile,
 2293                LoadFile = FullFile
 2294            )
 2295        ;   Mode = qload,
 2296            LoadFile = QlfFile
 2297        )
 2298    ->  !
 2299    ;   '$qlf_auto'(FullFile, QlfFile, Options)
 2300    ->  !, Mode = qcompile,
 2301        LoadFile = FullFile
 2302    ).
 2303'$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.
 2311'$qlf_out_of_date'(PlFile, QlfFile, Why) :-
 2312    (   access_file(PlFile, read)
 2313    ->  time_file(PlFile, PlTime),
 2314        time_file(QlfFile, QlfTime),
 2315        (   PlTime > QlfTime
 2316        ->  Why = old                   % PlFile is newer
 2317        ;   Error = error(Formal,_),
 2318            catch('$qlf_info'(QlfFile, _CVer, _MLVer,
 2319                              _FVer, _CSig, _FSig),
 2320                  Error, true),
 2321            nonvar(Formal)              % QlfFile is incompatible
 2322        ->  Why = Error
 2323        ;   fail                        % QlfFile is up-to-date and ok
 2324        )
 2325    ;   fail                            % can not read .pl; try .qlf
 2326    ).
 $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.
 2334:- create_prolog_flag(qcompile, false, [type(atom)]). 2335
 2336'$qlf_auto'(PlFile, QlfFile, Options) :-
 2337    (   memberchk(qcompile(QlfMode), Options)
 2338    ->  true
 2339    ;   current_prolog_flag(qcompile, QlfMode),
 2340        \+ '$in_system_dir'(PlFile)
 2341    ),
 2342    (   QlfMode == auto
 2343    ->  true
 2344    ;   QlfMode == large,
 2345        size_file(PlFile, Size),
 2346        Size > 100000
 2347    ),
 2348    access_file(QlfFile, write).
 2349
 2350'$in_system_dir'(PlFile) :-
 2351    current_prolog_flag(home, Home),
 2352    sub_atom(PlFile, 0, _, _, Home).
 2353
 2354'$spec_extension'(File, Ext) :-
 2355    atom(File),
 2356    file_name_extension(_, Ext, File).
 2357'$spec_extension'(Spec, Ext) :-
 2358    compound(Spec),
 2359    arg(1, Spec, Arg),
 2360    '$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:
 2372:- dynamic
 2373    '$resolved_source_path_db'/3.                % ?Spec, ?Dialect, ?Path
 2374
 2375'$load_file'(File, Module, Options) :-
 2376    '$error_count'(E0, W0),
 2377    '$load_file_e'(File, Module, Options),
 2378    '$error_count'(E1, W1),
 2379    Errors is E1-E0,
 2380    Warnings is W1-W0,
 2381    (   Errors+Warnings =:= 0
 2382    ->  true
 2383    ;   '$print_message'(silent, load_file_errors(File, Errors, Warnings))
 2384    ).
 2385
 2386'$error_count'(Errors, Warnings) :-
 2387    current_prolog_flag(threads, true),
 2388    !,
 2389    thread_self(Me),
 2390    thread_statistics(Me, errors, Errors),
 2391    thread_statistics(Me, warnings, Warnings).
 2392'$error_count'(Errors, Warnings) :-
 2393    statistics(errors, Errors),
 2394    statistics(warnings, Warnings).
 2395
 2396'$load_file_e'(File, Module, Options) :-
 2397    \+ memberchk(stream(_), Options),
 2398    user:prolog_load_file(Module:File, Options),
 2399    !.
 2400'$load_file_e'(File, Module, Options) :-
 2401    memberchk(stream(_), Options),
 2402    !,
 2403    '$assert_load_context_module'(File, Module, Options),
 2404    '$qdo_load_file'(File, File, Module, Options).
 2405'$load_file_e'(File, Module, Options) :-
 2406    (   '$resolved_source_path'(File, FullFile, Options)
 2407    ->  true
 2408    ;   '$resolve_source_path'(File, FullFile, Options)
 2409    ),
 2410    '$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.
 2416'$resolved_source_path'(File, FullFile, Options) :-
 2417    current_prolog_flag(emulated_dialect, Dialect),
 2418    '$resolved_source_path_db'(File, Dialect, FullFile),
 2419    (   '$source_file_property'(FullFile, from_state, true)
 2420    ;   '$source_file_property'(FullFile, resource, true)
 2421    ;   '$option'(if(If), Options, true),
 2422        '$noload'(If, FullFile, Options)
 2423    ),
 2424    !.
 $resolve_source_path(+File, -FullFile, Options) is det
Resolve a source file specification to an absolute path. May throw existence and other errors.
 2431'$resolve_source_path'(File, FullFile, _Options) :-
 2432    absolute_file_name(File, FullFile,
 2433                       [ file_type(prolog),
 2434                         access(read)
 2435                       ]),
 2436    '$register_resolved_source_path'(File, FullFile).
 2437
 2438
 2439'$register_resolved_source_path'(File, FullFile) :-
 2440    (   compound(File)
 2441    ->  current_prolog_flag(emulated_dialect, Dialect),
 2442        (   '$resolved_source_path_db'(File, Dialect, FullFile)
 2443        ->  true
 2444        ;   asserta('$resolved_source_path_db'(File, Dialect, FullFile))
 2445        )
 2446    ;   true
 2447    ).
 $translated_source(+Old, +New) is det
Called from loading a QLF state when source files are being renamed.
 2453:- public '$translated_source'/2. 2454'$translated_source'(Old, New) :-
 2455    forall(retract('$resolved_source_path_db'(File, Dialect, Old)),
 2456           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.
 2463'$register_resource_file'(FullFile) :-
 2464    (   sub_atom(FullFile, 0, _, _, 'res://'),
 2465        \+ file_name_extension(_, qlf, FullFile)
 2466    ->  '$set_source_file'(FullFile, resource, true)
 2467    ;   true
 2468    ).
 $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.
 2481'$already_loaded'(_File, FullFile, Module, Options) :-
 2482    '$assert_load_context_module'(FullFile, Module, Options),
 2483    '$current_module'(LoadModules, FullFile),
 2484    !,
 2485    (   atom(LoadModules)
 2486    ->  LoadModule = LoadModules
 2487    ;   LoadModules = [LoadModule|_]
 2488    ),
 2489    '$import_from_loaded_module'(LoadModule, Module, Options).
 2490'$already_loaded'(_, _, user, _) :- !.
 2491'$already_loaded'(File, FullFile, Module, Options) :-
 2492    (   '$load_context_module'(FullFile, Module, CtxOptions),
 2493        '$load_ctx_options'(Options, CtxOptions)
 2494    ->  true
 2495    ;   '$load_file'(File, Module, [if(true)|Options])
 2496    ).
 $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.

 2511:- dynamic
 2512    '$loading_file'/3.              % File, Queue, Thread
 2513:- volatile
 2514    '$loading_file'/3. 2515
 2516'$mt_load_file'(File, FullFile, Module, Options) :-
 2517    current_prolog_flag(threads, true),
 2518    !,
 2519    sig_atomic(setup_call_cleanup(
 2520                   with_mutex('$load_file',
 2521                              '$mt_start_load'(FullFile, Loading, Options)),
 2522                   '$mt_do_load'(Loading, File, FullFile, Module, Options),
 2523                   '$mt_end_load'(Loading))).
 2524'$mt_load_file'(File, FullFile, Module, Options) :-
 2525    '$option'(if(If), Options, true),
 2526    '$noload'(If, FullFile, Options),
 2527    !,
 2528    '$already_loaded'(File, FullFile, Module, Options).
 2529'$mt_load_file'(File, FullFile, Module, Options) :-
 2530    sig_atomic('$qdo_load_file'(File, FullFile, Module, Options)).
 2531
 2532'$mt_start_load'(FullFile, queue(Queue), _) :-
 2533    '$loading_file'(FullFile, Queue, LoadThread),
 2534    \+ thread_self(LoadThread),
 2535    !.
 2536'$mt_start_load'(FullFile, already_loaded, Options) :-
 2537    '$option'(if(If), Options, true),
 2538    '$noload'(If, FullFile, Options),
 2539    !.
 2540'$mt_start_load'(FullFile, Ref, _) :-
 2541    thread_self(Me),
 2542    message_queue_create(Queue),
 2543    assertz('$loading_file'(FullFile, Queue, Me), Ref).
 2544
 2545'$mt_do_load'(queue(Queue), File, FullFile, Module, Options) :-
 2546    !,
 2547    catch(thread_get_message(Queue, _), error(_,_), true),
 2548    '$already_loaded'(File, FullFile, Module, Options).
 2549'$mt_do_load'(already_loaded, File, FullFile, Module, Options) :-
 2550    !,
 2551    '$already_loaded'(File, FullFile, Module, Options).
 2552'$mt_do_load'(_Ref, File, FullFile, Module, Options) :-
 2553    '$assert_load_context_module'(FullFile, Module, Options),
 2554    '$qdo_load_file'(File, FullFile, Module, Options).
 2555
 2556'$mt_end_load'(queue(_)) :- !.
 2557'$mt_end_load'(already_loaded) :- !.
 2558'$mt_end_load'(Ref) :-
 2559    clause('$loading_file'(_, Queue, _), _, Ref),
 2560    erase(Ref),
 2561    thread_send_message(Queue, done),
 2562    message_queue_destroy(Queue).
 $qdo_load_file(+Spec, +FullFile, +ContextModule, +Options) is det
Switch to qcompile mode if requested by the option '$qlf'(+Out)
 2569'$qdo_load_file'(File, FullFile, Module, Options) :-
 2570    '$qdo_load_file2'(File, FullFile, Module, Action, Options),
 2571    '$register_resource_file'(FullFile),
 2572    '$run_initialization'(FullFile, Action, Options).
 2573
 2574'$qdo_load_file2'(File, FullFile, Module, Action, Options) :-
 2575    memberchk('$qlf'(QlfOut), Options),
 2576    '$stage_file'(QlfOut, StageQlf),
 2577    !,
 2578    setup_call_catcher_cleanup(
 2579        '$qstart'(StageQlf, Module, State),
 2580        '$do_load_file'(File, FullFile, Module, Action, Options),
 2581        Catcher,
 2582        '$qend'(State, Catcher, StageQlf, QlfOut)).
 2583'$qdo_load_file2'(File, FullFile, Module, Action, Options) :-
 2584    '$do_load_file'(File, FullFile, Module, Action, Options).
 2585
 2586'$qstart'(Qlf, Module, state(OldMode, OldModule)) :-
 2587    '$qlf_open'(Qlf),
 2588    '$compilation_mode'(OldMode, qlf),
 2589    '$set_source_module'(OldModule, Module).
 2590
 2591'$qend'(state(OldMode, OldModule), Catcher, StageQlf, QlfOut) :-
 2592    '$set_source_module'(_, OldModule),
 2593    '$set_compilation_mode'(OldMode),
 2594    '$qlf_close',
 2595    '$install_staged_file'(Catcher, StageQlf, QlfOut, warn).
 2596
 2597'$set_source_module'(OldModule, Module) :-
 2598    '$current_source_module'(OldModule),
 2599    '$set_source_module'(Module).
 $do_load_file(+Spec, +FullFile, +ContextModule, -Action, +Options) is det
Perform the actual loading.
 2606'$do_load_file'(File, FullFile, Module, Action, Options) :-
 2607    '$option'(derived_from(DerivedFrom), Options, -),
 2608    '$register_derived_source'(FullFile, DerivedFrom),
 2609    '$qlf_file'(File, FullFile, Absolute, Mode, Options),
 2610    (   Mode == qcompile
 2611    ->  qcompile(Module:File, Options)
 2612    ;   '$do_load_file_2'(File, Absolute, Module, Action, Options)
 2613    ).
 2614
 2615'$do_load_file_2'(File, Absolute, Module, Action, Options) :-
 2616    '$source_file_property'(Absolute, number_of_clauses, OldClauses),
 2617    statistics(cputime, OldTime),
 2618
 2619    '$setup_load'(ScopedFlags, OldSandBoxed, OldVerbose, OldAutoLevel, OldXRef,
 2620                  Options),
 2621
 2622    '$compilation_level'(Level),
 2623    '$load_msg_level'(load_file, Level, StartMsgLevel, DoneMsgLevel),
 2624    '$print_message'(StartMsgLevel,
 2625                     load_file(start(Level,
 2626                                     file(File, Absolute)))),
 2627
 2628    (   memberchk(stream(FromStream), Options)
 2629    ->  Input = stream
 2630    ;   Input = source
 2631    ),
 2632
 2633    (   Input == stream,
 2634        (   '$option'(format(qlf), Options, source)
 2635        ->  set_stream(FromStream, file_name(Absolute)),
 2636            '$qload_stream'(FromStream, Module, Action, LM, Options)
 2637        ;   '$consult_file'(stream(Absolute, FromStream, []),
 2638                            Module, Action, LM, Options)
 2639        )
 2640    ->  true
 2641    ;   Input == source,
 2642        file_name_extension(_, Ext, Absolute),
 2643        (   user:prolog_file_type(Ext, qlf),
 2644            E = error(_,_),
 2645            catch('$qload_file'(Absolute, Module, Action, LM, Options),
 2646                  E,
 2647                  print_message(warning, E))
 2648        ->  true
 2649        ;   '$consult_file'(Absolute, Module, Action, LM, Options)
 2650        )
 2651    ->  true
 2652    ;   '$print_message'(error, load_file(failed(File))),
 2653        fail
 2654    ),
 2655
 2656    '$import_from_loaded_module'(LM, Module, Options),
 2657
 2658    '$source_file_property'(Absolute, number_of_clauses, NewClauses),
 2659    statistics(cputime, Time),
 2660    ClausesCreated is NewClauses - OldClauses,
 2661    TimeUsed is Time - OldTime,
 2662
 2663    '$print_message'(DoneMsgLevel,
 2664                     load_file(done(Level,
 2665                                    file(File, Absolute),
 2666                                    Action,
 2667                                    LM,
 2668                                    TimeUsed,
 2669                                    ClausesCreated))),
 2670
 2671    '$restore_load'(ScopedFlags, OldSandBoxed, OldVerbose, OldAutoLevel, OldXRef).
 2672
 2673'$setup_load'(ScopedFlags, OldSandBoxed, OldVerbose, OldAutoLevel, OldXRef,
 2674              Options) :-
 2675    '$save_file_scoped_flags'(ScopedFlags),
 2676    '$set_sandboxed_load'(Options, OldSandBoxed),
 2677    '$set_verbose_load'(Options, OldVerbose),
 2678    '$set_optimise_load'(Options),
 2679    '$update_autoload_level'(Options, OldAutoLevel),
 2680    '$set_no_xref'(OldXRef).
 2681
 2682'$restore_load'(ScopedFlags, OldSandBoxed, OldVerbose, OldAutoLevel, OldXRef) :-
 2683    '$set_autoload_level'(OldAutoLevel),
 2684    set_prolog_flag(xref, OldXRef),
 2685    set_prolog_flag(verbose_load, OldVerbose),
 2686    set_prolog_flag(sandboxed_load, OldSandBoxed),
 2687    '$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.
 2695'$save_file_scoped_flags'(State) :-
 2696    current_predicate(findall/3),          % Not when doing boot compile
 2697    !,
 2698    findall(SavedFlag, '$save_file_scoped_flag'(SavedFlag), State).
 2699'$save_file_scoped_flags'([]).
 2700
 2701'$save_file_scoped_flag'(Flag-Value) :-
 2702    '$file_scoped_flag'(Flag, Default),
 2703    (   current_prolog_flag(Flag, Value)
 2704    ->  true
 2705    ;   Value = Default
 2706    ).
 2707
 2708'$file_scoped_flag'(generate_debug_info, true).
 2709'$file_scoped_flag'(optimise,            false).
 2710'$file_scoped_flag'(xref,                false).
 2711
 2712'$restore_file_scoped_flags'([]).
 2713'$restore_file_scoped_flags'([Flag-Value|T]) :-
 2714    set_prolog_flag(Flag, Value),
 2715    '$restore_file_scoped_flags'(T).
 $import_from_loaded_module(LoadedModule, Module, Options) is det
Import public predicates from LoadedModule into Module
 2722'$import_from_loaded_module'(LoadedModule, Module, Options) :-
 2723    LoadedModule \== Module,
 2724    atom(LoadedModule),
 2725    !,
 2726    '$option'(imports(Import), Options, all),
 2727    '$option'(reexport(Reexport), Options, false),
 2728    '$import_list'(Module, LoadedModule, Import, Reexport).
 2729'$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.
 2737'$set_verbose_load'(Options, Old) :-
 2738    current_prolog_flag(verbose_load, Old),
 2739    (   memberchk(silent(Silent), Options)
 2740    ->  (   '$negate'(Silent, Level0)
 2741        ->  '$load_msg_compat'(Level0, Level)
 2742        ;   Level = Silent
 2743        ),
 2744        set_prolog_flag(verbose_load, Level)
 2745    ;   true
 2746    ).
 2747
 2748'$negate'(true, false).
 2749'$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, -)
 2758'$set_sandboxed_load'(Options, Old) :-
 2759    current_prolog_flag(sandboxed_load, Old),
 2760    (   memberchk(sandboxed(SandBoxed), Options),
 2761        '$enter_sandboxed'(Old, SandBoxed, New),
 2762        New \== Old
 2763    ->  set_prolog_flag(sandboxed_load, New)
 2764    ;   true
 2765    ).
 2766
 2767'$enter_sandboxed'(Old, New, SandBoxed) :-
 2768    (   Old == false, New == true
 2769    ->  SandBoxed = true,
 2770        '$ensure_loaded_library_sandbox'
 2771    ;   Old == true, New == false
 2772    ->  throw(error(permission_error(leave, sandbox, -), _))
 2773    ;   SandBoxed = Old
 2774    ).
 2775'$enter_sandboxed'(false, true, true).
 2776
 2777'$ensure_loaded_library_sandbox' :-
 2778    source_file_property(library(sandbox), module(sandbox)),
 2779    !.
 2780'$ensure_loaded_library_sandbox' :-
 2781    load_files(library(sandbox), [if(not_loaded), silent(true)]).
 2782
 2783'$set_optimise_load'(Options) :-
 2784    (   '$option'(optimise(Optimise), Options)
 2785    ->  set_prolog_flag(optimise, Optimise)
 2786    ;   true
 2787    ).
 2788
 2789'$set_no_xref'(OldXRef) :-
 2790    (   current_prolog_flag(xref, OldXRef)
 2791    ->  true
 2792    ;   OldXRef = false
 2793    ),
 2794    set_prolog_flag(xref, false).
 $update_autoload_level(+Options, -OldLevel)
Update the '$autoload_nesting' and return the old value.
 2801:- thread_local
 2802    '$autoload_nesting'/1. 2803
 2804'$update_autoload_level'(Options, AutoLevel) :-
 2805    '$option'(autoload(Autoload), Options, false),
 2806    (   '$autoload_nesting'(CurrentLevel)
 2807    ->  AutoLevel = CurrentLevel
 2808    ;   AutoLevel = 0
 2809    ),
 2810    (   Autoload == false
 2811    ->  true
 2812    ;   NewLevel is AutoLevel + 1,
 2813        '$set_autoload_level'(NewLevel)
 2814    ).
 2815
 2816'$set_autoload_level'(New) :-
 2817    retractall('$autoload_nesting'(_)),
 2818    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.
 2826'$print_message'(Level, Term) :-
 2827    current_predicate(system:print_message/2),
 2828    !,
 2829    print_message(Level, Term).
 2830'$print_message'(warning, Term) :-
 2831    source_location(File, Line),
 2832    !,
 2833    format(user_error, 'WARNING: ~w:~w: ~p~n', [File, Line, Term]).
 2834'$print_message'(error, Term) :-
 2835    !,
 2836    source_location(File, Line),
 2837    !,
 2838    format(user_error, 'ERROR: ~w:~w: ~p~n', [File, Line, Term]).
 2839'$print_message'(_Level, _Term).
 2840
 2841'$print_message_fail'(E) :-
 2842    '$print_message'(error, E),
 2843    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.
 2851'$consult_file'(Absolute, Module, What, LM, Options) :-
 2852    '$current_source_module'(Module),   % same module
 2853    !,
 2854    '$consult_file_2'(Absolute, Module, What, LM, Options).
 2855'$consult_file'(Absolute, Module, What, LM, Options) :-
 2856    '$set_source_module'(OldModule, Module),
 2857    '$ifcompiling'('$qlf_start_sub_module'(Module)),
 2858    '$consult_file_2'(Absolute, Module, What, LM, Options),
 2859    '$ifcompiling'('$qlf_end_part'),
 2860    '$set_source_module'(OldModule).
 2861
 2862'$consult_file_2'(Absolute, Module, What, LM, Options) :-
 2863    '$set_source_module'(OldModule, Module),
 2864    '$load_id'(Absolute, Id, Modified, Options),
 2865    '$compile_type'(What),
 2866    '$save_lex_state'(LexState, Options),
 2867    '$set_dialect'(Options),
 2868    setup_call_cleanup(
 2869        '$start_consult'(Id, Modified),
 2870        '$load_file'(Absolute, Id, LM, Options),
 2871        '$end_consult'(Id, LexState, OldModule)).
 2872
 2873'$end_consult'(Id, LexState, OldModule) :-
 2874    '$end_consult'(Id),
 2875    '$restore_lex_state'(LexState),
 2876    '$set_source_module'(OldModule).
 2877
 2878
 2879:- create_prolog_flag(emulated_dialect, swi, [type(atom)]).
 $save_lex_state(-LexState, +Options) is det
 2883'$save_lex_state'(State, Options) :-
 2884    memberchk(scope_settings(false), Options),
 2885    !,
 2886    State = (-).
 2887'$save_lex_state'(lexstate(Style, Dialect), _) :-
 2888    '$style_check'(Style, Style),
 2889    current_prolog_flag(emulated_dialect, Dialect).
 2890
 2891'$restore_lex_state'(-) :- !.
 2892'$restore_lex_state'(lexstate(Style, Dialect)) :-
 2893    '$style_check'(_, Style),
 2894    set_prolog_flag(emulated_dialect, Dialect).
 2895
 2896'$set_dialect'(Options) :-
 2897    memberchk(dialect(Dialect), Options),
 2898    !,
 2899    '$expects_dialect'(Dialect).
 2900'$set_dialect'(_).
 2901
 2902'$load_id'(stream(Id, _, _), Id, Modified, Options) :-
 2903    !,
 2904    '$modified_id'(Id, Modified, Options).
 2905'$load_id'(Id, Id, Modified, Options) :-
 2906    '$modified_id'(Id, Modified, Options).
 2907
 2908'$modified_id'(_, Modified, Options) :-
 2909    '$option'(modified(Stamp), Options, Def),
 2910    Stamp \== Def,
 2911    !,
 2912    Modified = Stamp.
 2913'$modified_id'(Id, Modified, _) :-
 2914    catch(time_file(Id, Modified),
 2915          error(_, _),
 2916          fail),
 2917    !.
 2918'$modified_id'(_, 0.0, _).
 2919
 2920
 2921'$compile_type'(What) :-
 2922    '$compilation_mode'(How),
 2923    (   How == database
 2924    ->  What = compiled
 2925    ;   How == qlf
 2926    ->  What = '*qcompiled*'
 2927    ;   What = 'boot compiled'
 2928    ).
 $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.
 2938:- dynamic
 2939    '$load_context_module'/3. 2940:- multifile
 2941    '$load_context_module'/3. 2942
 2943'$assert_load_context_module'(_, _, Options) :-
 2944    memberchk(register(false), Options),
 2945    !.
 2946'$assert_load_context_module'(File, Module, Options) :-
 2947    source_location(FromFile, Line),
 2948    !,
 2949    '$master_file'(FromFile, MasterFile),
 2950    '$check_load_non_module'(File, Module),
 2951    '$add_dialect'(Options, Options1),
 2952    '$load_ctx_options'(Options1, Options2),
 2953    '$store_admin_clause'(
 2954        system:'$load_context_module'(File, Module, Options2),
 2955        _Layout, MasterFile, FromFile:Line).
 2956'$assert_load_context_module'(File, Module, Options) :-
 2957    '$check_load_non_module'(File, Module),
 2958    '$add_dialect'(Options, Options1),
 2959    '$load_ctx_options'(Options1, Options2),
 2960    (   clause('$load_context_module'(File, Module, _), true, Ref),
 2961        \+ clause_property(Ref, file(_)),
 2962        erase(Ref)
 2963    ->  true
 2964    ;   true
 2965    ),
 2966    assertz('$load_context_module'(File, Module, Options2)).
 2967
 2968'$add_dialect'(Options0, Options) :-
 2969    current_prolog_flag(emulated_dialect, Dialect), Dialect \== swi,
 2970    !,
 2971    Options = [dialect(Dialect)|Options0].
 2972'$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.
 2979'$load_ctx_options'(Options, CtxOptions) :-
 2980    '$load_ctx_options2'(Options, CtxOptions0),
 2981    sort(CtxOptions0, CtxOptions).
 2982
 2983'$load_ctx_options2'([], []).
 2984'$load_ctx_options2'([H|T0], [H|T]) :-
 2985    '$load_ctx_option'(H),
 2986    !,
 2987    '$load_ctx_options2'(T0, T).
 2988'$load_ctx_options2'([_|T0], T) :-
 2989    '$load_ctx_options2'(T0, T).
 2990
 2991'$load_ctx_option'(derived_from(_)).
 2992'$load_ctx_option'(dialect(_)).
 2993'$load_ctx_option'(encoding(_)).
 2994'$load_ctx_option'(imports(_)).
 2995'$load_ctx_option'(reexport(_)).
 $check_load_non_module(+File) is det
Test that a non-module file is not loaded into multiple contexts.
 3003'$check_load_non_module'(File, _) :-
 3004    '$current_module'(_, File),
 3005    !.          % File is a module file
 3006'$check_load_non_module'(File, Module) :-
 3007    '$load_context_module'(File, OldModule, _),
 3008    Module \== OldModule,
 3009    !,
 3010    format(atom(Msg),
 3011           'Non-module file already loaded into module ~w; \c
 3012               trying to load into ~w',
 3013           [OldModule, Module]),
 3014    throw(error(permission_error(load, source, File),
 3015                context(load_files/2, Msg))).
 3016'$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)

 3029'$load_file'(Path, Id, Module, Options) :-
 3030    State = state(true, _, true, false, Id, -),
 3031    (   '$source_term'(Path, _Read, _Layout, Term, Layout,
 3032                       _Stream, Options),
 3033        '$valid_term'(Term),
 3034        (   arg(1, State, true)
 3035        ->  '$first_term'(Term, Layout, Id, State, Options),
 3036            nb_setarg(1, State, false)
 3037        ;   '$compile_term'(Term, Layout, Id)
 3038        ),
 3039        arg(4, State, true)
 3040    ;   '$fixup_reconsult'(Id),
 3041        '$end_load_file'(State)
 3042    ),
 3043    !,
 3044    arg(2, State, Module).
 3045
 3046'$valid_term'(Var) :-
 3047    var(Var),
 3048    !,
 3049    print_message(error, error(instantiation_error, _)).
 3050'$valid_term'(Term) :-
 3051    Term \== [].
 3052
 3053'$end_load_file'(State) :-
 3054    arg(1, State, true),           % empty file
 3055    !,
 3056    nb_setarg(2, State, Module),
 3057    arg(5, State, Id),
 3058    '$current_source_module'(Module),
 3059    '$ifcompiling'('$qlf_start_file'(Id)),
 3060    '$ifcompiling'('$qlf_end_part').
 3061'$end_load_file'(State) :-
 3062    arg(3, State, End),
 3063    '$end_load_file'(End, State).
 3064
 3065'$end_load_file'(true, _).
 3066'$end_load_file'(end_module, State) :-
 3067    arg(2, State, Module),
 3068    '$check_export'(Module),
 3069    '$ifcompiling'('$qlf_end_part').
 3070'$end_load_file'(end_non_module, _State) :-
 3071    '$ifcompiling'('$qlf_end_part').
 3072
 3073
 3074'$first_term'(?-(Directive), Layout, Id, State, Options) :-
 3075    !,
 3076    '$first_term'(:-(Directive), Layout, Id, State, Options).
 3077'$first_term'(:-(Directive), _Layout, Id, State, Options) :-
 3078    nonvar(Directive),
 3079    (   (   Directive = module(Name, Public)
 3080        ->  Imports = []
 3081        ;   Directive = module(Name, Public, Imports)
 3082        )
 3083    ->  !,
 3084        '$module_name'(Name, Id, Module, Options),
 3085        '$start_module'(Module, Public, State, Options),
 3086        '$module3'(Imports)
 3087    ;   Directive = expects_dialect(Dialect)
 3088    ->  !,
 3089        '$set_dialect'(Dialect, State),
 3090        fail                        % Still consider next term as first
 3091    ).
 3092'$first_term'(Term, Layout, Id, State, Options) :-
 3093    '$start_non_module'(Id, Term, State, Options),
 3094    '$compile_term'(Term, Layout, Id).
 3095
 3096'$compile_term'(Term, Layout, Id) :-
 3097    '$compile_term'(Term, Layout, Id, -).
 3098
 3099'$compile_term'(Var, _Layout, _Id, _Src) :-
 3100    var(Var),
 3101    !,
 3102    '$instantiation_error'(Var).
 3103'$compile_term'((?-Directive), _Layout, Id, _) :-
 3104    !,
 3105    '$execute_directive'(Directive, Id).
 3106'$compile_term'((:-Directive), _Layout, Id, _) :-
 3107    !,
 3108    '$execute_directive'(Directive, Id).
 3109'$compile_term'('$source_location'(File, Line):Term, Layout, Id, _) :-
 3110    !,
 3111    '$compile_term'(Term, Layout, Id, File:Line).
 3112'$compile_term'(Clause, Layout, Id, SrcLoc) :-
 3113    E = error(_,_),
 3114    catch('$store_clause'(Clause, Layout, Id, SrcLoc), E,
 3115          '$print_message'(error, E)).
 3116
 3117'$start_non_module'(_Id, Term, _State, Options) :-
 3118    '$option'(must_be_module(true), Options, false),
 3119    !,
 3120    '$domain_error'(module_header, Term).
 3121'$start_non_module'(Id, _Term, State, _Options) :-
 3122    '$current_source_module'(Module),
 3123    '$ifcompiling'('$qlf_start_file'(Id)),
 3124    '$qset_dialect'(State),
 3125    nb_setarg(2, State, Module),
 3126    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.

 3139'$set_dialect'(Dialect, State) :-
 3140    '$compilation_mode'(qlf, database),
 3141    !,
 3142    '$expects_dialect'(Dialect),
 3143    '$compilation_mode'(_, qlf),
 3144    nb_setarg(6, State, Dialect).
 3145'$set_dialect'(Dialect, _) :-
 3146    '$expects_dialect'(Dialect).
 3147
 3148'$qset_dialect'(State) :-
 3149    '$compilation_mode'(qlf),
 3150    arg(6, State, Dialect), Dialect \== (-),
 3151    !,
 3152    '$add_directive_wic'('$expects_dialect'(Dialect)).
 3153'$qset_dialect'(_).
 3154
 3155'$expects_dialect'(Dialect) :-
 3156    Dialect == swi,
 3157    !,
 3158    set_prolog_flag(emulated_dialect, Dialect).
 3159'$expects_dialect'(Dialect) :-
 3160    current_predicate(expects_dialect/1),
 3161    !,
 3162    expects_dialect(Dialect).
 3163'$expects_dialect'(Dialect) :-
 3164    use_module(library(dialect), [expects_dialect/1]),
 3165    expects_dialect(Dialect).
 3166
 3167
 3168                 /*******************************
 3169                 *           MODULES            *
 3170                 *******************************/
 3171
 3172'$start_module'(Module, _Public, State, _Options) :-
 3173    '$current_module'(Module, OldFile),
 3174    source_location(File, _Line),
 3175    OldFile \== File, OldFile \== [],
 3176    same_file(OldFile, File),
 3177    !,
 3178    nb_setarg(2, State, Module),
 3179    nb_setarg(4, State, true).      % Stop processing
 3180'$start_module'(Module, Public, State, Options) :-
 3181    arg(5, State, File),
 3182    nb_setarg(2, State, Module),
 3183    source_location(_File, Line),
 3184    '$option'(redefine_module(Action), Options, false),
 3185    '$module_class'(File, Class, Super),
 3186    '$reset_dialect'(File, Class),
 3187    '$redefine_module'(Module, File, Action),
 3188    '$declare_module'(Module, Class, Super, File, Line, false),
 3189    '$export_list'(Public, Module, Ops),
 3190    '$ifcompiling'('$qlf_start_module'(Module)),
 3191    '$export_ops'(Ops, Module, File),
 3192    '$qset_dialect'(State),
 3193    nb_setarg(3, State, end_module).
 $reset_dialect(+File, +Class) is det
Load .pl files from the SWI-Prolog distribution always in swi dialect.
 3200'$reset_dialect'(File, library) :-
 3201    file_name_extension(_, pl, File),
 3202    !,
 3203    set_prolog_flag(emulated_dialect, swi).
 3204'$reset_dialect'(_, _).
 $module3(+Spec) is det
Handle the 3th argument of a module declartion.
 3211'$module3'(Var) :-
 3212    var(Var),
 3213    !,
 3214    '$instantiation_error'(Var).
 3215'$module3'([]) :- !.
 3216'$module3'([H|T]) :-
 3217    !,
 3218    '$module3'(H),
 3219    '$module3'(T).
 3220'$module3'(Id) :-
 3221    use_module(library(dialect/Id)).
 $module_name(?Name, +Id, -Module, +Options) is semidet
Determine the module name. There are some cases:
 3235'$module_name'(_, _, Module, Options) :-
 3236    '$option'(module(Module), Options),
 3237    !,
 3238    '$current_source_module'(Context),
 3239    Context \== Module.                     % cause '$first_term'/5 to fail.
 3240'$module_name'(Var, Id, Module, Options) :-
 3241    var(Var),
 3242    !,
 3243    file_base_name(Id, File),
 3244    file_name_extension(Var, _, File),
 3245    '$module_name'(Var, Id, Module, Options).
 3246'$module_name'(Reserved, _, _, _) :-
 3247    '$reserved_module'(Reserved),
 3248    !,
 3249    throw(error(permission_error(load, module, Reserved), _)).
 3250'$module_name'(Module, _Id, Module, _).
 3251
 3252
 3253'$reserved_module'(system).
 3254'$reserved_module'(user).
 $redefine_module(+Module, +File, -Redefine)
 3259'$redefine_module'(_Module, _, false) :- !.
 3260'$redefine_module'(Module, File, true) :-
 3261    !,
 3262    (   module_property(Module, file(OldFile)),
 3263        File \== OldFile
 3264    ->  unload_file(OldFile)
 3265    ;   true
 3266    ).
 3267'$redefine_module'(Module, File, ask) :-
 3268    (   stream_property(user_input, tty(true)),
 3269        module_property(Module, file(OldFile)),
 3270        File \== OldFile,
 3271        '$rdef_response'(Module, OldFile, File, true)
 3272    ->  '$redefine_module'(Module, File, true)
 3273    ;   true
 3274    ).
 3275
 3276'$rdef_response'(Module, OldFile, File, Ok) :-
 3277    repeat,
 3278    print_message(query, redefine_module(Module, OldFile, File)),
 3279    get_single_char(Char),
 3280    '$rdef_response'(Char, Ok0),
 3281    !,
 3282    Ok = Ok0.
 3283
 3284'$rdef_response'(Char, true) :-
 3285    memberchk(Char, `yY`),
 3286    format(user_error, 'yes~n', []).
 3287'$rdef_response'(Char, false) :-
 3288    memberchk(Char, `nN`),
 3289    format(user_error, 'no~n', []).
 3290'$rdef_response'(Char, _) :-
 3291    memberchk(Char, `a`),
 3292    format(user_error, 'abort~n', []),
 3293    abort.
 3294'$rdef_response'(_, _) :-
 3295    print_message(help, redefine_module_reply),
 3296    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.
 3306'$module_class'(File, Class, system) :-
 3307    current_prolog_flag(home, Home),
 3308    sub_atom(File, 0, Len, _, Home),
 3309    (   sub_atom(File, Len, _, _, '/boot/')
 3310    ->  Class = system
 3311    ;   '$lib_prefix'(Prefix),
 3312        sub_atom(File, Len, _, _, Prefix)
 3313    ->  Class = library
 3314    ;   file_directory_name(File, Home),
 3315        file_name_extension(_, rc, File)
 3316    ->  Class = library
 3317    ),
 3318    !.
 3319'$module_class'(_, user, user).
 3320
 3321'$lib_prefix'('/library').
 3322'$lib_prefix'('/xpce/prolog/').
 3323
 3324'$check_export'(Module) :-
 3325    '$undefined_export'(Module, UndefList),
 3326    (   '$member'(Undef, UndefList),
 3327        strip_module(Undef, _, Local),
 3328        print_message(error,
 3329                      undefined_export(Module, Local)),
 3330        fail
 3331    ;   true
 3332    ).
 $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).
 3341'$import_list'(_, _, Var, _) :-
 3342    var(Var),
 3343    !,
 3344    throw(error(instantitation_error, _)).
 3345'$import_list'(Target, Source, all, Reexport) :-
 3346    !,
 3347    '$exported_ops'(Source, Import, Predicates),
 3348    '$module_property'(Source, exports(Predicates)),
 3349    '$import_all'(Import, Target, Source, Reexport, weak).
 3350'$import_list'(Target, Source, except(Spec), Reexport) :-
 3351    !,
 3352    '$exported_ops'(Source, Export, Predicates),
 3353    '$module_property'(Source, exports(Predicates)),
 3354    (   is_list(Spec)
 3355    ->  true
 3356    ;   throw(error(type_error(list, Spec), _))
 3357    ),
 3358    '$import_except'(Spec, Export, Import),
 3359    '$import_all'(Import, Target, Source, Reexport, weak).
 3360'$import_list'(Target, Source, Import, Reexport) :-
 3361    !,
 3362    is_list(Import),
 3363    !,
 3364    '$import_all'(Import, Target, Source, Reexport, strong).
 3365'$import_list'(_, _, Import, _) :-
 3366    throw(error(type_error(import_specifier, Import))).
 3367
 3368
 3369'$import_except'([], List, List).
 3370'$import_except'([H|T], List0, List) :-
 3371    '$import_except_1'(H, List0, List1),
 3372    '$import_except'(T, List1, List).
 3373
 3374'$import_except_1'(Var, _, _) :-
 3375    var(Var),
 3376    !,
 3377    throw(error(instantitation_error, _)).
 3378'$import_except_1'(PI as N, List0, List) :-
 3379    '$pi'(PI), atom(N),
 3380    !,
 3381    '$canonical_pi'(PI, CPI),
 3382    '$import_as'(CPI, N, List0, List).
 3383'$import_except_1'(op(P,A,N), List0, List) :-
 3384    !,
 3385    '$remove_ops'(List0, op(P,A,N), List).
 3386'$import_except_1'(PI, List0, List) :-
 3387    '$pi'(PI),
 3388    !,
 3389    '$canonical_pi'(PI, CPI),
 3390    '$select'(P, List0, List),
 3391    '$canonical_pi'(CPI, P),
 3392    !.
 3393'$import_except_1'(Except, _, _) :-
 3394    throw(error(type_error(import_specifier, Except), _)).
 3395
 3396'$import_as'(CPI, N, [PI2|T], [CPI as N|T]) :-
 3397    '$canonical_pi'(PI2, CPI),
 3398    !.
 3399'$import_as'(PI, N, [H|T0], [H|T]) :-
 3400    !,
 3401    '$import_as'(PI, N, T0, T).
 3402'$import_as'(PI, _, _, _) :-
 3403    throw(error(existence_error(export, PI), _)).
 3404
 3405'$pi'(N/A) :- atom(N), integer(A), !.
 3406'$pi'(N//A) :- atom(N), integer(A).
 3407
 3408'$canonical_pi'(N//A0, N/A) :-
 3409    A is A0 + 2.
 3410'$canonical_pi'(PI, PI).
 3411
 3412'$remove_ops'([], _, []).
 3413'$remove_ops'([Op|T0], Pattern, T) :-
 3414    subsumes_term(Pattern, Op),
 3415    !,
 3416    '$remove_ops'(T0, Pattern, T).
 3417'$remove_ops'([H|T0], Pattern, [H|T]) :-
 3418    '$remove_ops'(T0, Pattern, T).
 $import_all(+Import, +Context, +Source, +Reexport, +Strength)
 3423'$import_all'(Import, Context, Source, Reexport, Strength) :-
 3424    '$import_all2'(Import, Context, Source, Imported, ImpOps, Strength),
 3425    (   Reexport == true,
 3426        (   '$list_to_conj'(Imported, Conj)
 3427        ->  export(Context:Conj),
 3428            '$ifcompiling'('$add_directive_wic'(export(Context:Conj)))
 3429        ;   true
 3430        ),
 3431        source_location(File, _Line),
 3432        '$export_ops'(ImpOps, Context, File)
 3433    ;   true
 3434    ).
 $import_all2(+Imports, +Context, +Source, -Imported, -ImpOps, +Strength)
 3438'$import_all2'([], _, _, [], [], _).
 3439'$import_all2'([PI as NewName|Rest], Context, Source,
 3440               [NewName/Arity|Imported], ImpOps, Strength) :-
 3441    !,
 3442    '$canonical_pi'(PI, Name/Arity),
 3443    length(Args, Arity),
 3444    Head =.. [Name|Args],
 3445    NewHead =.. [NewName|Args],
 3446    (   '$get_predicate_attribute'(Source:Head, transparent, 1)
 3447    ->  '$set_predicate_attribute'(Context:NewHead, transparent, true)
 3448    ;   true
 3449    ),
 3450    (   source_location(File, Line)
 3451    ->  E = error(_,_),
 3452        catch('$store_admin_clause'((NewHead :- Source:Head),
 3453                                    _Layout, File, File:Line),
 3454              E, '$print_message'(error, E))
 3455    ;   assertz((NewHead :- !, Source:Head)) % ! avoids problems with
 3456    ),                                       % duplicate load
 3457    '$import_all2'(Rest, Context, Source, Imported, ImpOps, Strength).
 3458'$import_all2'([op(P,A,N)|Rest], Context, Source, Imported,
 3459               [op(P,A,N)|ImpOps], Strength) :-
 3460    !,
 3461    '$import_ops'(Context, Source, op(P,A,N)),
 3462    '$import_all2'(Rest, Context, Source, Imported, ImpOps, Strength).
 3463'$import_all2'([Pred|Rest], Context, Source, [Pred|Imported], ImpOps, Strength) :-
 3464    Error = error(_,_),
 3465    catch(Context:'$import'(Source:Pred, Strength), Error,
 3466          print_message(error, Error)),
 3467    '$ifcompiling'('$import_wic'(Source, Pred, Strength)),
 3468    '$import_all2'(Rest, Context, Source, Imported, ImpOps, Strength).
 3469
 3470
 3471'$list_to_conj'([One], One) :- !.
 3472'$list_to_conj'([H|T], (H,Rest)) :-
 3473    '$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.
 3480'$exported_ops'(Module, Ops, Tail) :-
 3481    '$c_current_predicate'(_, Module:'$exported_op'(_,_,_)),
 3482    !,
 3483    findall(op(P,A,N), Module:'$exported_op'(P,A,N), Ops, Tail).
 3484'$exported_ops'(_, Ops, Ops).
 3485
 3486'$exported_op'(Module, P, A, N) :-
 3487    '$c_current_predicate'(_, Module:'$exported_op'(_,_,_)),
 3488    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.
 3495'$import_ops'(To, From, Pattern) :-
 3496    ground(Pattern),
 3497    !,
 3498    Pattern = op(P,A,N),
 3499    op(P,A,To:N),
 3500    (   '$exported_op'(From, P, A, N)
 3501    ->  true
 3502    ;   print_message(warning, no_exported_op(From, Pattern))
 3503    ).
 3504'$import_ops'(To, From, Pattern) :-
 3505    (   '$exported_op'(From, Pri, Assoc, Name),
 3506        Pattern = op(Pri, Assoc, Name),
 3507        op(Pri, Assoc, To:Name),
 3508        fail
 3509    ;   true
 3510    ).
 $export_list(+Declarations, +Module, -Ops)
Handle the export list of the module declaration for Module associated to File.
 3518'$export_list'(Decls, Module, Ops) :-
 3519    is_list(Decls),
 3520    !,
 3521    '$do_export_list'(Decls, Module, Ops).
 3522'$export_list'(Decls, _, _) :-
 3523    var(Decls),
 3524    throw(error(instantiation_error, _)).
 3525'$export_list'(Decls, _, _) :-
 3526    throw(error(type_error(list, Decls), _)).
 3527
 3528'$do_export_list'([], _, []) :- !.
 3529'$do_export_list'([H|T], Module, Ops) :-
 3530    !,
 3531    E = error(_,_),
 3532    catch('$export1'(H, Module, Ops, Ops1),
 3533          E, ('$print_message'(error, E), Ops = Ops1)),
 3534    '$do_export_list'(T, Module, Ops1).
 3535
 3536'$export1'(Var, _, _, _) :-
 3537    var(Var),
 3538    !,
 3539    throw(error(instantiation_error, _)).
 3540'$export1'(Op, _, [Op|T], T) :-
 3541    Op = op(_,_,_),
 3542    !.
 3543'$export1'(PI0, Module, Ops, Ops) :-
 3544    strip_module(Module:PI0, M, PI),
 3545    (   PI = (_//_)
 3546    ->  non_terminal(M:PI)
 3547    ;   true
 3548    ),
 3549    export(M:PI).
 3550
 3551'$export_ops'([op(Pri, Assoc, Name)|T], Module, File) :-
 3552    E = error(_,_),
 3553    catch(( '$execute_directive'(op(Pri, Assoc, Module:Name), File),
 3554            '$export_op'(Pri, Assoc, Name, Module, File)
 3555          ),
 3556          E, '$print_message'(error, E)),
 3557    '$export_ops'(T, Module, File).
 3558'$export_ops'([], _, _).
 3559
 3560'$export_op'(Pri, Assoc, Name, Module, File) :-
 3561    (   '$get_predicate_attribute'(Module:'$exported_op'(_,_,_), defined, 1)
 3562    ->  true
 3563    ;   '$execute_directive'(discontiguous(Module:'$exported_op'/3), File)
 3564    ),
 3565    '$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.
 3571'$execute_directive'(Goal, F) :-
 3572    '$execute_directive_2'(Goal, F).
 3573
 3574'$execute_directive_2'(encoding(Encoding), _F) :-
 3575    !,
 3576    (   '$load_input'(_F, S)
 3577    ->  set_stream(S, encoding(Encoding))
 3578    ).
 3579'$execute_directive_2'(Goal, _) :-
 3580    \+ '$compilation_mode'(database),
 3581    !,
 3582    '$add_directive_wic2'(Goal, Type),
 3583    (   Type == call                % suspend compiling into .qlf file
 3584    ->  '$compilation_mode'(Old, database),
 3585        setup_call_cleanup(
 3586            '$directive_mode'(OldDir, Old),
 3587            '$execute_directive_3'(Goal),
 3588            ( '$set_compilation_mode'(Old),
 3589              '$set_directive_mode'(OldDir)
 3590            ))
 3591    ;   '$execute_directive_3'(Goal)
 3592    ).
 3593'$execute_directive_2'(Goal, _) :-
 3594    '$execute_directive_3'(Goal).
 3595
 3596'$execute_directive_3'(Goal) :-
 3597    '$current_source_module'(Module),
 3598    '$valid_directive'(Module:Goal),
 3599    !,
 3600    (   '$pattr_directive'(Goal, Module)
 3601    ->  true
 3602    ;   Term = error(_,_),
 3603        catch(Module:Goal, Term, '$exception_in_directive'(Term))
 3604    ->  true
 3605    ;   '$print_message'(warning, goal_failed(directive, Module:Goal)),
 3606        fail
 3607    ).
 3608'$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.
 3617:- multifile prolog:sandbox_allowed_directive/1. 3618:- multifile prolog:sandbox_allowed_clause/1. 3619:- meta_predicate '$valid_directive'(:). 3620
 3621'$valid_directive'(_) :-
 3622    current_prolog_flag(sandboxed_load, false),
 3623    !.
 3624'$valid_directive'(Goal) :-
 3625    Error = error(Formal, _),
 3626    catch(prolog:sandbox_allowed_directive(Goal), Error, true),
 3627    !,
 3628    (   var(Formal)
 3629    ->  true
 3630    ;   print_message(error, Error),
 3631        fail
 3632    ).
 3633'$valid_directive'(Goal) :-
 3634    print_message(error,
 3635                  error(permission_error(execute,
 3636                                         sandboxed_directive,
 3637                                         Goal), _)),
 3638    fail.
 3639
 3640'$exception_in_directive'(Term) :-
 3641    '$print_message'(error, Term),
 3642    fail.
 3643
 3644%       Note that the list, consult and ensure_loaded directives are already
 3645%       handled at compile time and therefore should not go into the
 3646%       intermediate code file.
 3647
 3648'$add_directive_wic2'(Goal, Type) :-
 3649    '$common_goal_type'(Goal, Type),
 3650    !,
 3651    (   Type == load
 3652    ->  true
 3653    ;   '$current_source_module'(Module),
 3654        '$add_directive_wic'(Module:Goal)
 3655    ).
 3656'$add_directive_wic2'(Goal, _) :-
 3657    (   '$compilation_mode'(qlf)    % no problem for qlf files
 3658    ->  true
 3659    ;   print_message(error, mixed_directive(Goal))
 3660    ).
 3661
 3662'$common_goal_type'((A,B), Type) :-
 3663    !,
 3664    '$common_goal_type'(A, Type),
 3665    '$common_goal_type'(B, Type).
 3666'$common_goal_type'((A;B), Type) :-
 3667    !,
 3668    '$common_goal_type'(A, Type),
 3669    '$common_goal_type'(B, Type).
 3670'$common_goal_type'((A->B), Type) :-
 3671    !,
 3672    '$common_goal_type'(A, Type),
 3673    '$common_goal_type'(B, Type).
 3674'$common_goal_type'(Goal, Type) :-
 3675    '$goal_type'(Goal, Type).
 3676
 3677'$goal_type'(Goal, Type) :-
 3678    (   '$load_goal'(Goal)
 3679    ->  Type = load
 3680    ;   Type = call
 3681    ).
 3682
 3683'$load_goal'([_|_]).
 3684'$load_goal'(consult(_)).
 3685'$load_goal'(load_files(_)).
 3686'$load_goal'(load_files(_,Options)) :-
 3687    memberchk(qcompile(QlfMode), Options),
 3688    '$qlf_part_mode'(QlfMode).
 3689'$load_goal'(ensure_loaded(_)) :- '$compilation_mode'(wic).
 3690'$load_goal'(use_module(_))    :- '$compilation_mode'(wic).
 3691'$load_goal'(use_module(_, _)) :- '$compilation_mode'(wic).
 3692
 3693'$qlf_part_mode'(part).
 3694'$qlf_part_mode'(true).                 % compatibility
 3695
 3696
 3697                /********************************
 3698                *        COMPILE A CLAUSE       *
 3699                *********************************/
 $store_admin_clause(+Clause, ?Layout, +Owner, +SrcLoc) is det
Store a clause into the database for administrative purposes. This bypasses sanity checking.
 3706'$store_admin_clause'(Clause, Layout, Owner, SrcLoc) :-
 3707    Owner \== (-),
 3708    !,
 3709    setup_call_cleanup(
 3710        '$start_aux'(Owner, Context),
 3711        '$store_admin_clause2'(Clause, Layout, Owner, SrcLoc),
 3712        '$end_aux'(Owner, Context)).
 3713'$store_admin_clause'(Clause, Layout, File, SrcLoc) :-
 3714    '$store_admin_clause2'(Clause, Layout, File, SrcLoc).
 3715
 3716'$store_admin_clause2'(Clause, _Layout, File, SrcLoc) :-
 3717    (   '$compilation_mode'(database)
 3718    ->  '$record_clause'(Clause, File, SrcLoc)
 3719    ;   '$record_clause'(Clause, File, SrcLoc, Ref),
 3720        '$qlf_assert_clause'(Ref, development)
 3721    ).
 $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.
 3731'$store_clause'((_, _), _, _, _) :-
 3732    !,
 3733    print_message(error, cannot_redefine_comma),
 3734    fail.
 3735'$store_clause'((Pre => Body), _Layout, File, SrcLoc) :-
 3736    nonvar(Pre),
 3737    Pre = (Head,Cond),
 3738    !,
 3739    (   '$is_true'(Cond), current_prolog_flag(optimise, true)
 3740    ->  '$store_clause'((Head=>Body), _Layout, File, SrcLoc)
 3741    ;   '$store_clause'(?=>(Head,(Cond,!,Body)), _Layout, File, SrcLoc)
 3742    ).
 3743'$store_clause'(Clause, _Layout, File, SrcLoc) :-
 3744    '$valid_clause'(Clause),
 3745    !,
 3746    (   '$compilation_mode'(database)
 3747    ->  '$record_clause'(Clause, File, SrcLoc)
 3748    ;   '$record_clause'(Clause, File, SrcLoc, Ref),
 3749        '$qlf_assert_clause'(Ref, development)
 3750    ).
 3751
 3752'$is_true'(true)  => true.
 3753'$is_true'((A,B)) => '$is_true'(A), '$is_true'(B).
 3754'$is_true'(_)     => fail.
 3755
 3756'$valid_clause'(_) :-
 3757    current_prolog_flag(sandboxed_load, false),
 3758    !.
 3759'$valid_clause'(Clause) :-
 3760    \+ '$cross_module_clause'(Clause),
 3761    !.
 3762'$valid_clause'(Clause) :-
 3763    Error = error(Formal, _),
 3764    catch(prolog:sandbox_allowed_clause(Clause), Error, true),
 3765    !,
 3766    (   var(Formal)
 3767    ->  true
 3768    ;   print_message(error, Error),
 3769        fail
 3770    ).
 3771'$valid_clause'(Clause) :-
 3772    print_message(error,
 3773                  error(permission_error(assert,
 3774                                         sandboxed_clause,
 3775                                         Clause), _)),
 3776    fail.
 3777
 3778'$cross_module_clause'(Clause) :-
 3779    '$head_module'(Clause, Module),
 3780    \+ '$current_source_module'(Module).
 3781
 3782'$head_module'(Var, _) :-
 3783    var(Var), !, fail.
 3784'$head_module'((Head :- _), Module) :-
 3785    '$head_module'(Head, Module).
 3786'$head_module'(Module:_, Module).
 3787
 3788'$clause_source'('$source_location'(File,Line):Clause, Clause, File:Line) :- !.
 3789'$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.
 3796:- public
 3797    '$store_clause'/2. 3798
 3799'$store_clause'(Term, Id) :-
 3800    '$clause_source'(Term, Clause, SrcLoc),
 3801    '$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?
 3822compile_aux_clauses(_Clauses) :-
 3823    current_prolog_flag(xref, true),
 3824    !.
 3825compile_aux_clauses(Clauses) :-
 3826    source_location(File, _Line),
 3827    '$compile_aux_clauses'(Clauses, File).
 3828
 3829'$compile_aux_clauses'(Clauses, File) :-
 3830    setup_call_cleanup(
 3831        '$start_aux'(File, Context),
 3832        '$store_aux_clauses'(Clauses, File),
 3833        '$end_aux'(File, Context)).
 3834
 3835'$store_aux_clauses'(Clauses, File) :-
 3836    is_list(Clauses),
 3837    !,
 3838    forall('$member'(C,Clauses),
 3839           '$compile_term'(C, _Layout, File)).
 3840'$store_aux_clauses'(Clause, File) :-
 3841    '$compile_term'(Clause, _Layout, File).
 3842
 3843
 3844		 /*******************************
 3845		 *            STAGING		*
 3846		 *******************************/
 $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.
 3856'$stage_file'(Target, Stage) :-
 3857    file_directory_name(Target, Dir),
 3858    file_base_name(Target, File),
 3859    current_prolog_flag(pid, Pid),
 3860    format(atom(Stage), '~w/.~w.~d', [Dir,File,Pid]).
 3861
 3862'$install_staged_file'(exit, Staged, Target, error) :-
 3863    !,
 3864    rename_file(Staged, Target).
 3865'$install_staged_file'(exit, Staged, Target, OnError) :-
 3866    !,
 3867    InstallError = error(_,_),
 3868    catch(rename_file(Staged, Target),
 3869          InstallError,
 3870          '$install_staged_error'(OnError, InstallError, Staged, Target)).
 3871'$install_staged_file'(_, Staged, _, _OnError) :-
 3872    E = error(_,_),
 3873    catch(delete_file(Staged), E, true).
 3874
 3875'$install_staged_error'(OnError, Error, Staged, _Target) :-
 3876    E = error(_,_),
 3877    catch(delete_file(Staged), E, true),
 3878    (   OnError = silent
 3879    ->  true
 3880    ;   OnError = fail
 3881    ->  fail
 3882    ;   print_message(warning, Error)
 3883    ).
 3884
 3885
 3886                 /*******************************
 3887                 *             READING          *
 3888                 *******************************/
 3889
 3890:- multifile
 3891    prolog:comment_hook/3.                  % hook for read_clause/3
 3892
 3893
 3894                 /*******************************
 3895                 *       FOREIGN INTERFACE      *
 3896                 *******************************/
 3897
 3898%       call-back from PL_register_foreign().  First argument is the module
 3899%       into which the foreign predicate is loaded and second is a term
 3900%       describing the arguments.
 3901
 3902:- dynamic
 3903    '$foreign_registered'/2. 3904
 3905                 /*******************************
 3906                 *   TEMPORARY TERM EXPANSION   *
 3907                 *******************************/
 3908
 3909% Provide temporary definitions for the boot-loader.  These are replaced
 3910% by the real thing in load.pl
 3911
 3912:- dynamic
 3913    '$expand_goal'/2,
 3914    '$expand_term'/4. 3915
 3916'$expand_goal'(In, In).
 3917'$expand_term'(In, Layout, In, Layout).
 3918
 3919
 3920                 /*******************************
 3921                 *         TYPE SUPPORT         *
 3922                 *******************************/
 3923
 3924'$type_error'(Type, Value) :-
 3925    (   var(Value)
 3926    ->  throw(error(instantiation_error, _))
 3927    ;   throw(error(type_error(Type, Value), _))
 3928    ).
 3929
 3930'$domain_error'(Type, Value) :-
 3931    throw(error(domain_error(Type, Value), _)).
 3932
 3933'$existence_error'(Type, Object) :-
 3934    throw(error(existence_error(Type, Object), _)).
 3935
 3936'$permission_error'(Action, Type, Term) :-
 3937    throw(error(permission_error(Action, Type, Term), _)).
 3938
 3939'$instantiation_error'(_Var) :-
 3940    throw(error(instantiation_error, _)).
 3941
 3942'$uninstantiation_error'(NonVar) :-
 3943    throw(error(uninstantiation_error(NonVar), _)).
 3944
 3945'$must_be'(list, X) :- !,
 3946    '$skip_list'(_, X, Tail),
 3947    (   Tail == []
 3948    ->  true
 3949    ;   '$type_error'(list, Tail)
 3950    ).
 3951'$must_be'(options, X) :- !,
 3952    (   '$is_options'(X)
 3953    ->  true
 3954    ;   '$type_error'(options, X)
 3955    ).
 3956'$must_be'(atom, X) :- !,
 3957    (   atom(X)
 3958    ->  true
 3959    ;   '$type_error'(atom, X)
 3960    ).
 3961'$must_be'(integer, X) :- !,
 3962    (   integer(X)
 3963    ->  true
 3964    ;   '$type_error'(integer, X)
 3965    ).
 3966'$must_be'(between(Low,High), X) :- !,
 3967    (   integer(X)
 3968    ->  (   between(Low, High, X)
 3969        ->  true
 3970        ;   '$domain_error'(between(Low,High), X)
 3971        )
 3972    ;   '$type_error'(integer, X)
 3973    ).
 3974'$must_be'(callable, X) :- !,
 3975    (   callable(X)
 3976    ->  true
 3977    ;   '$type_error'(callable, X)
 3978    ).
 3979'$must_be'(acyclic, X) :- !,
 3980    (   acyclic_term(X)
 3981    ->  true
 3982    ;   '$domain_error'(acyclic_term, X)
 3983    ).
 3984'$must_be'(oneof(Type, Domain, List), X) :- !,
 3985    '$must_be'(Type, X),
 3986    (   memberchk(X, List)
 3987    ->  true
 3988    ;   '$domain_error'(Domain, X)
 3989    ).
 3990'$must_be'(boolean, X) :- !,
 3991    (   (X == true ; X == false)
 3992    ->  true
 3993    ;   '$type_error'(boolean, X)
 3994    ).
 3995'$must_be'(ground, X) :- !,
 3996    (   ground(X)
 3997    ->  true
 3998    ;   '$instantiation_error'(X)
 3999    ).
 4000'$must_be'(filespec, X) :- !,
 4001    (   (   atom(X)
 4002        ;   string(X)
 4003        ;   compound(X),
 4004            compound_name_arity(X, _, 1)
 4005        )
 4006    ->  true
 4007    ;   '$type_error'(filespec, X)
 4008    ).
 4009
 4010% Use for debugging
 4011%'$must_be'(Type, _X) :- format('Unknown $must_be type: ~q~n', [Type]).
 4012
 4013
 4014                /********************************
 4015                *       LIST PROCESSING         *
 4016                *********************************/
 4017
 4018'$member'(El, [H|T]) :-
 4019    '$member_'(T, El, H).
 4020
 4021'$member_'(_, El, El).
 4022'$member_'([H|T], El, _) :-
 4023    '$member_'(T, El, H).
 4024
 4025'$append'([], L, L).
 4026'$append'([H|T], L, [H|R]) :-
 4027    '$append'(T, L, R).
 4028
 4029'$append'(ListOfLists, List) :-
 4030    '$must_be'(list, ListOfLists),
 4031    '$append_'(ListOfLists, List).
 4032
 4033'$append_'([], []).
 4034'$append_'([L|Ls], As) :-
 4035    '$append'(L, Ws, As),
 4036    '$append_'(Ls, Ws).
 4037
 4038'$select'(X, [X|Tail], Tail).
 4039'$select'(Elem, [Head|Tail], [Head|Rest]) :-
 4040    '$select'(Elem, Tail, Rest).
 4041
 4042'$reverse'(L1, L2) :-
 4043    '$reverse'(L1, [], L2).
 4044
 4045'$reverse'([], List, List).
 4046'$reverse'([Head|List1], List2, List3) :-
 4047    '$reverse'(List1, [Head|List2], List3).
 4048
 4049'$delete'([], _, []) :- !.
 4050'$delete'([Elem|Tail], Elem, Result) :-
 4051    !,
 4052    '$delete'(Tail, Elem, Result).
 4053'$delete'([Head|Tail], Elem, [Head|Rest]) :-
 4054    '$delete'(Tail, Elem, Rest).
 4055
 4056'$last'([H|T], Last) :-
 4057    '$last'(T, H, Last).
 4058
 4059'$last'([], Last, Last).
 4060'$last'([H|T], _, Last) :-
 4061    '$last'(T, H, Last).
 length(?List, ?N)
Is true when N is the length of List.
 4068:- '$iso'((length/2)). 4069
 4070length(List, Length) :-
 4071    var(Length),
 4072    !,
 4073    '$skip_list'(Length0, List, Tail),
 4074    (   Tail == []
 4075    ->  Length = Length0                    % +,-
 4076    ;   var(Tail)
 4077    ->  Tail \== Length,                    % avoid length(L,L)
 4078        '$length3'(Tail, Length, Length0)   % -,-
 4079    ;   throw(error(type_error(list, List),
 4080                    context(length/2, _)))
 4081    ).
 4082length(List, Length) :-
 4083    integer(Length),
 4084    Length >= 0,
 4085    !,
 4086    '$skip_list'(Length0, List, Tail),
 4087    (   Tail == []                          % proper list
 4088    ->  Length = Length0
 4089    ;   var(Tail)
 4090    ->  Extra is Length-Length0,
 4091        '$length'(Tail, Extra)
 4092    ;   throw(error(type_error(list, List),
 4093                    context(length/2, _)))
 4094    ).
 4095length(_, Length) :-
 4096    integer(Length),
 4097    !,
 4098    throw(error(domain_error(not_less_than_zero, Length),
 4099                context(length/2, _))).
 4100length(_, Length) :-
 4101    throw(error(type_error(integer, Length),
 4102                context(length/2, _))).
 4103
 4104'$length3'([], N, N).
 4105'$length3'([_|List], N, N0) :-
 4106    N1 is N0+1,
 4107    '$length3'(List, N, N1).
 4108
 4109
 4110                 /*******************************
 4111                 *       OPTION PROCESSING      *
 4112                 *******************************/
 $is_options(@Term) is semidet
True if Term looks like it provides options.
 4118'$is_options'(Map) :-
 4119    is_dict(Map, _),
 4120    !.
 4121'$is_options'(List) :-
 4122    is_list(List),
 4123    (   List == []
 4124    ->  true
 4125    ;   List = [H|_],
 4126        '$is_option'(H, _, _)
 4127    ).
 4128
 4129'$is_option'(Var, _, _) :-
 4130    var(Var), !, fail.
 4131'$is_option'(F, Name, Value) :-
 4132    functor(F, _, 1),
 4133    !,
 4134    F =.. [Name,Value].
 4135'$is_option'(Name=Value, Name, Value).
 $option(?Opt, +Options) is semidet
 4139'$option'(Opt, Options) :-
 4140    is_dict(Options),
 4141    !,
 4142    [Opt] :< Options.
 4143'$option'(Opt, Options) :-
 4144    memberchk(Opt, Options).
 $option(?Opt, +Options, +Default) is det
 4148'$option'(Term, Options, Default) :-
 4149    arg(1, Term, Value),
 4150    functor(Term, Name, 1),
 4151    (   is_dict(Options)
 4152    ->  (   get_dict(Name, Options, GVal)
 4153        ->  Value = GVal
 4154        ;   Value = Default
 4155        )
 4156    ;   functor(Gen, Name, 1),
 4157        arg(1, Gen, GVal),
 4158        (   memberchk(Gen, Options)
 4159        ->  Value = GVal
 4160        ;   Value = Default
 4161        )
 4162    ).
 $select_option(?Opt, +Options, -Rest) is semidet
Select an option from Options.
Arguments:
Rest- is always a map.
 4170'$select_option'(Opt, Options, Rest) :-
 4171    select_dict([Opt], Options, Rest).
 $merge_options(+New, +Default, -Merged) is det
Add/replace options specified in New.
Arguments:
Merged- is always a map.
 4179'$merge_options'(New, Old, Merged) :-
 4180    put_dict(New, Old, Merged).
 4181
 4182
 4183                 /*******************************
 4184                 *   HANDLE TRACER 'L'-COMMAND  *
 4185                 *******************************/
 4186
 4187:- public '$prolog_list_goal'/1. 4188
 4189:- multifile
 4190    user:prolog_list_goal/1. 4191
 4192'$prolog_list_goal'(Goal) :-
 4193    user:prolog_list_goal(Goal),
 4194    !.
 4195'$prolog_list_goal'(Goal) :-
 4196    use_module(library(listing), [listing/1]),
 4197    @(listing(Goal), user).
 4198
 4199
 4200                 /*******************************
 4201                 *             HALT             *
 4202                 *******************************/
 4203
 4204:- '$iso'((halt/0)). 4205
 4206halt :-
 4207    '$exit_code'(Code),
 4208    (   Code == 0
 4209    ->  true
 4210    ;   print_message(warning, on_error(halt(1)))
 4211    ),
 4212    halt(Code).
 $exit_code(Code)
Determine the exit code baed on the on_error and on_warning flags. Also used by qsave_toplevel/0.
 4219'$exit_code'(Code) :-
 4220    (   (   current_prolog_flag(on_error, status),
 4221            statistics(errors, Count),
 4222            Count > 0
 4223        ;   current_prolog_flag(on_warning, status),
 4224            statistics(warnings, Count),
 4225            Count > 0
 4226        )
 4227    ->  Code = 1
 4228    ;   Code = 0
 4229    ).
 at_halt(:Goal)
Register Goal to be called if the system halts.
To be done
- : get location into the error message
 4238:- meta_predicate at_halt(0). 4239:- dynamic        system:term_expansion/2, '$at_halt'/2. 4240:- multifile      system:term_expansion/2, '$at_halt'/2. 4241
 4242system:term_expansion((:- at_halt(Goal)),
 4243                      system:'$at_halt'(Module:Goal, File:Line)) :-
 4244    \+ current_prolog_flag(xref, true),
 4245    source_location(File, Line),
 4246    '$current_source_module'(Module).
 4247
 4248at_halt(Goal) :-
 4249    asserta('$at_halt'(Goal, (-):0)).
 4250
 4251:- public '$run_at_halt'/0. 4252
 4253'$run_at_halt' :-
 4254    forall(clause('$at_halt'(Goal, Src), true, Ref),
 4255           ( '$call_at_halt'(Goal, Src),
 4256             erase(Ref)
 4257           )).
 4258
 4259'$call_at_halt'(Goal, _Src) :-
 4260    catch(Goal, E, true),
 4261    !,
 4262    (   var(E)
 4263    ->  true
 4264    ;   subsumes_term(cancel_halt(_), E)
 4265    ->  '$print_message'(informational, E),
 4266        fail
 4267    ;   '$print_message'(error, E)
 4268    ).
 4269'$call_at_halt'(Goal, _Src) :-
 4270    '$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.
 4278cancel_halt(Reason) :-
 4279    throw(cancel_halt(Reason)).
 4280
 4281
 4282                /********************************
 4283                *      LOAD OTHER MODULES       *
 4284                *********************************/
 4285
 4286:- meta_predicate
 4287    '$load_wic_files'(:). 4288
 4289'$load_wic_files'(Files) :-
 4290    Files = Module:_,
 4291    '$execute_directive'('$set_source_module'(OldM, Module), []),
 4292    '$save_lex_state'(LexState, []),
 4293    '$style_check'(_, 0xC7),                % see style_name/2 in syspred.pl
 4294    '$compilation_mode'(OldC, wic),
 4295    consult(Files),
 4296    '$execute_directive'('$set_source_module'(OldM), []),
 4297    '$execute_directive'('$restore_lex_state'(LexState), []),
 4298    '$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.
 4306:- public '$load_additional_boot_files'/0. 4307
 4308'$load_additional_boot_files' :-
 4309    current_prolog_flag(argv, Argv),
 4310    '$get_files_argv'(Argv, Files),
 4311    (   Files \== []
 4312    ->  format('Loading additional boot files~n'),
 4313        '$load_wic_files'(user:Files),
 4314        format('additional boot files loaded~n')
 4315    ;   true
 4316    ).
 4317
 4318'$get_files_argv'([], []) :- !.
 4319'$get_files_argv'(['-c'|Files], Files) :- !.
 4320'$get_files_argv'([_|Rest], Files) :-
 4321    '$get_files_argv'(Rest, Files).
 4322
 4323'$:-'(('$boot_message'('Loading Prolog startup files~n', []),
 4324       source_location(File, _Line),
 4325       file_directory_name(File, Dir),
 4326       atom_concat(Dir, '/load.pl', LoadFile),
 4327       '$load_wic_files'(system:[LoadFile]),
 4328       (   current_prolog_flag(windows, true)
 4329       ->  atom_concat(Dir, '/menu.pl', MenuFile),
 4330           '$load_wic_files'(system:[MenuFile])
 4331       ;   true
 4332       ),
 4333       '$boot_message'('SWI-Prolog boot files loaded~n', []),
 4334       '$compilation_mode'(OldC, wic),
 4335       '$execute_directive'('$set_source_module'(user), []),
 4336       '$set_compilation_mode'(OldC)
 4337      ))