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-2019, University of Amsterdam
    7                              VU University Amsterdam
    8                              CWI, Amsterdam
    9    All rights reserved.
   10
   11    Redistribution and use in source and binary forms, with or without
   12    modification, are permitted provided that the following conditions
   13    are met:
   14
   15    1. Redistributions of source code must retain the above copyright
   16       notice, this list of conditions and the following disclaimer.
   17
   18    2. Redistributions in binary form must reproduce the above copyright
   19       notice, this list of conditions and the following disclaimer in
   20       the documentation and/or other materials provided with the
   21       distribution.
   22
   23    THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
   24    "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
   25    LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS
   26    FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE
   27    COPYRIGHT OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT,
   28    INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING,
   29    BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES;
   30    LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER
   31    CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
   32    LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN
   33    ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
   34    POSSIBILITY OF SUCH DAMAGE.
   35*/
   36
   37/*
   38Consult, derivates and basic things.   This  module  is  loaded  by  the
   39C-written  bootstrap  compiler.
   40
   41The $:- directive  is  executed  by  the  bootstrap  compiler,  but  not
   42inserted  in  the  intermediate  code  file.   Used  to print diagnostic
   43messages and start the Prolog defined compiler for  the  remaining  boot
   44modules.
   45
   46If you want  to  debug  this  module,  put  a  '$:-'(trace).   directive
   47somewhere.   The  tracer will work properly under boot compilation as it
   48will use the C defined write predicate  to  print  goals  and  does  not
   49attempt to call the Prolog defined trace interceptor.
   50*/
   51
   52                /********************************
   53                *    LOAD INTO MODULE SYSTEM    *
   54                ********************************/
   55
   56:- '$set_source_module'(system).   57
   58'$boot_message'(_Format, _Args) :-
   59    current_prolog_flag(verbose, silent),
   60    !.
   61'$boot_message'(Format, Args) :-
   62    format(Format, Args),
   63    !.
   64
   65'$:-'('$boot_message'('Loading boot file ...~n', [])).
   66
   67
   68                /********************************
   69                *          DIRECTIVES           *
   70                *********************************/
   71
   72:- meta_predicate
   73    dynamic(:),
   74    multifile(:),
   75    public(:),
   76    module_transparent(:),
   77    discontiguous(:),
   78    volatile(:),
   79    thread_local(:),
   80    noprofile(:),
   81    non_terminal(:),
   82    '$clausable'(:),
   83    '$iso'(:),
   84    '$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.
  116dynamic(Spec)            :- '$set_pattr'(Spec, pred, dynamic(true)).
  117multifile(Spec)          :- '$set_pattr'(Spec, pred, multifile(true)).
  118module_transparent(Spec) :- '$set_pattr'(Spec, pred, transparent(true)).
  119discontiguous(Spec)      :- '$set_pattr'(Spec, pred, discontiguous(true)).
  120volatile(Spec)           :- '$set_pattr'(Spec, pred, volatile(true)).
  121thread_local(Spec)       :- '$set_pattr'(Spec, pred, thread_local(true)).
  122noprofile(Spec)          :- '$set_pattr'(Spec, pred, noprofile(true)).
  123public(Spec)             :- '$set_pattr'(Spec, pred, public(true)).
  124non_terminal(Spec)       :- '$set_pattr'(Spec, pred, non_terminal(true)).
  125'$iso'(Spec)             :- '$set_pattr'(Spec, pred, iso(true)).
  126'$clausable'(Spec)       :- '$set_pattr'(Spec, pred, clausable(true)).
  127'$hide'(Spec)            :- '$set_pattr'(Spec, pred, trace(false)).
  128
  129'$set_pattr'(M:Pred, How, Attr) :-
  130    '$set_pattr'(Pred, M, How, Attr).
 $set_pattr(+Spec, +Module, +From, +Attr)
Set predicate attributes. From is one of pred or directive.
  136'$set_pattr'(X, _, _, _) :-
  137    var(X),
  138    '$uninstantiation_error'(X).
  139'$set_pattr'(as(Spec,Options), M, How, Attr0) :-
  140    !,
  141    '$attr_options'(Options, Attr0, Attr),
  142    '$set_pattr'(Spec, M, How, Attr).
  143'$set_pattr'([], _, _, _) :- !.
  144'$set_pattr'([H|T], M, How, Attr) :-           % ISO
  145    !,
  146    '$set_pattr'(H, M, How, Attr),
  147    '$set_pattr'(T, M, How, Attr).
  148'$set_pattr'((A,B), M, How, Attr) :-           % ISO and traditional
  149    !,
  150    '$set_pattr'(A, M, How, Attr),
  151    '$set_pattr'(B, M, How, Attr).
  152'$set_pattr'(M:T, _, How, Attr) :-
  153    !,
  154    '$set_pattr'(T, M, How, Attr).
  155'$set_pattr'(PI, M, _, []) :-
  156    !,
  157    '$pi_head'(M:PI, Pred),
  158    (   '$get_predicate_attribute'(Pred, incremental, 1)
  159    ->  '$wrap_incremental'(Pred)
  160    ;   '$unwrap_incremental'(Pred)
  161    ).
  162'$set_pattr'(A, M, How, [O|OT]) :-
  163    !,
  164    '$set_pattr'(A, M, How, O),
  165    '$set_pattr'(A, M, How, OT).
  166'$set_pattr'(A, M, pred, Attr) :-
  167    !,
  168    Attr =.. [Name,Val],
  169    '$set_predicate_attribute'(M:A, Name, Val).
  170'$set_pattr'(A, M, directive, Attr) :-
  171    !,
  172    Attr =.. [Name,Val],
  173    catch('$set_predicate_attribute'(M:A, Name, Val),
  174          error(E, _),
  175          print_message(error, error(E, context((Name)/1,_)))).
  176
  177'$attr_options'(Var, _, _) :-
  178    var(Var),
  179    !,
  180    '$uninstantiation_error'(Var).
  181'$attr_options'((A,B), Attr0, Attr) :-
  182    !,
  183    '$attr_options'(A, Attr0, Attr1),
  184    '$attr_options'(B, Attr1, Attr).
  185'$attr_options'(Opt, Attr0, Attrs) :-
  186    '$must_be'(ground, Opt),
  187    (   '$attr_option'(Opt, AttrX)
  188    ->  (   is_list(Attr0)
  189        ->  '$join_attrs'(AttrX, Attr0, Attrs)
  190        ;   '$join_attrs'(AttrX, [Attr0], Attrs)
  191        )
  192    ;   '$domain_error'(predicate_option, Opt)
  193    ).
  194
  195'$join_attrs'(Attr, Attrs, Attrs) :-
  196    memberchk(Attr, Attrs),
  197    !.
  198'$join_attrs'(Attr, Attrs, Attrs) :-
  199    Attr =.. [Name,Value],
  200    Gen =.. [Name,Existing],
  201    memberchk(Gen, Attrs),
  202    !,
  203    throw(error(conflict_error(Name, Value, Existing), _)).
  204'$join_attrs'(Attr, Attrs0, Attrs) :-
  205    '$append'(Attrs0, [Attr], Attrs).
  206
  207'$attr_option'(incremental, incremental(true)).
  208'$attr_option'(opaque, incremental(false)).
  209'$attr_option'(abstract(Level), abstract(true)) :-
  210    '$must_be'(between(0,0), Level).
  211'$attr_option'(volatile, volatile(true)).
  212'$attr_option'(multifile, multifile(true)).
  213'$attr_option'(discontiguous, discontiguous(true)).
  214'$attr_option'(shared, thread_local(false)).
  215'$attr_option'(local, thread_local(true)).
  216'$attr_option'(private, thread_local(true)).
 $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.
  225'$pattr_directive'(dynamic(Spec), M) :-
  226    '$set_pattr'(Spec, M, directive, dynamic(true)).
  227'$pattr_directive'(multifile(Spec), M) :-
  228    '$set_pattr'(Spec, M, directive, multifile(true)).
  229'$pattr_directive'(module_transparent(Spec), M) :-
  230    '$set_pattr'(Spec, M, directive, transparent(true)).
  231'$pattr_directive'(discontiguous(Spec), M) :-
  232    '$set_pattr'(Spec, M, directive, discontiguous(true)).
  233'$pattr_directive'(volatile(Spec), M) :-
  234    '$set_pattr'(Spec, M, directive, volatile(true)).
  235'$pattr_directive'(thread_local(Spec), M) :-
  236    '$set_pattr'(Spec, M, directive, thread_local(true)).
  237'$pattr_directive'(noprofile(Spec), M) :-
  238    '$set_pattr'(Spec, M, directive, noprofile(true)).
  239'$pattr_directive'(public(Spec), M) :-
  240    '$set_pattr'(Spec, M, directive, public(true)).
  241
  242:- '$iso'(((dynamic)/1, (multifile)/1, (discontiguous)/1)).  243
  244
  245                /********************************
  246                *       CALLING, CONTROL        *
  247                *********************************/
  248
  249:- noprofile((call/1,
  250              catch/3,
  251              once/1,
  252              ignore/1,
  253              call_cleanup/2,
  254              call_cleanup/3,
  255              setup_call_cleanup/3,
  256              setup_call_catcher_cleanup/4)).  257
  258:- meta_predicate
  259    ';'(0,0),
  260    ','(0,0),
  261    @(0,+),
  262    call(0),
  263    call(1,?),
  264    call(2,?,?),
  265    call(3,?,?,?),
  266    call(4,?,?,?,?),
  267    call(5,?,?,?,?,?),
  268    call(6,?,?,?,?,?,?),
  269    call(7,?,?,?,?,?,?,?),
  270    not(0),
  271    \+(0),
  272    '->'(0,0),
  273    '*->'(0,0),
  274    once(0),
  275    ignore(0),
  276    catch(0,?,0),
  277    reset(0,?,-),
  278    setup_call_cleanup(0,0,0),
  279    setup_call_catcher_cleanup(0,0,?,0),
  280    call_cleanup(0,0),
  281    call_cleanup(0,?,0),
  282    catch_with_backtrace(0,?,0),
  283    '$meta_call'(0).  284
  285:- '$iso'((call/1, (\+)/1, once/1, (;)/2, (',')/2, (->)/2, catch/3)).  286
  287% The control structures are always compiled, both   if they appear in a
  288% clause body and if they are handed  to   call/1.  The only way to call
  289% these predicates is by means of  call/2..   In  that case, we call the
  290% hole control structure again to get it compiled by call/1 and properly
  291% deal  with  !,  etc.  Another  reason  for  having  these  things   as
  292% predicates is to be able to define   properties for them, helping code
  293% analyzers.
  294
  295(M0:If ; M0:Then) :- !, call(M0:(If ; Then)).
  296(M1:If ; M2:Then) :-    call(M1:(If ; M2:Then)).
  297(G1   , G2)       :-    call((G1   , G2)).
  298(If  -> Then)     :-    call((If  -> Then)).
  299(If *-> Then)     :-    call((If *-> Then)).
  300@(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.

  314'$meta_call'(M:G) :-
  315    prolog_current_choice(Ch),
  316    '$meta_call'(G, M, Ch).
  317
  318'$meta_call'(Var, _, _) :-
  319    var(Var),
  320    !,
  321    '$instantiation_error'(Var).
  322'$meta_call'((A,B), M, Ch) :-
  323    !,
  324    '$meta_call'(A, M, Ch),
  325    '$meta_call'(B, M, Ch).
  326'$meta_call'((I->T;E), M, Ch) :-
  327    !,
  328    (   prolog_current_choice(Ch2),
  329        '$meta_call'(I, M, Ch2)
  330    ->  '$meta_call'(T, M, Ch)
  331    ;   '$meta_call'(E, M, Ch)
  332    ).
  333'$meta_call'((I*->T;E), M, Ch) :-
  334    !,
  335    (   prolog_current_choice(Ch2),
  336        '$meta_call'(I, M, Ch2)
  337    *-> '$meta_call'(T, M, Ch)
  338    ;   '$meta_call'(E, M, Ch)
  339    ).
  340'$meta_call'((I->T), M, Ch) :-
  341    !,
  342    (   prolog_current_choice(Ch2),
  343        '$meta_call'(I, M, Ch2)
  344    ->  '$meta_call'(T, M, Ch)
  345    ).
  346'$meta_call'((I*->T), M, Ch) :-
  347    !,
  348    prolog_current_choice(Ch2),
  349    '$meta_call'(I, M, Ch2),
  350    '$meta_call'(T, M, Ch).
  351'$meta_call'((A;B), M, Ch) :-
  352    !,
  353    (   '$meta_call'(A, M, Ch)
  354    ;   '$meta_call'(B, M, Ch)
  355    ).
  356'$meta_call'(\+(G), M, _) :-
  357    !,
  358    prolog_current_choice(Ch),
  359    \+ '$meta_call'(G, M, Ch).
  360'$meta_call'(call(G), M, _) :-
  361    !,
  362    prolog_current_choice(Ch),
  363    '$meta_call'(G, M, Ch).
  364'$meta_call'(M:G, _, Ch) :-
  365    !,
  366    '$meta_call'(G, M, Ch).
  367'$meta_call'(!, _, Ch) :-
  368    prolog_cut_to(Ch).
  369'$meta_call'(G, M, _Ch) :-
  370    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..
  386:- '$iso'((call/2,
  387           call/3,
  388           call/4,
  389           call/5,
  390           call/6,
  391           call/7,
  392           call/8)).  393
  394call(Goal) :-                           % make these available as predicates
  395    Goal.
  396call(Goal, A) :-
  397    call(Goal, A).
  398call(Goal, A, B) :-
  399    call(Goal, A, B).
  400call(Goal, A, B, C) :-
  401    call(Goal, A, B, C).
  402call(Goal, A, B, C, D) :-
  403    call(Goal, A, B, C, D).
  404call(Goal, A, B, C, D, E) :-
  405    call(Goal, A, B, C, D, E).
  406call(Goal, A, B, C, D, E, F) :-
  407    call(Goal, A, B, C, D, E, F).
  408call(Goal, A, B, C, D, E, F, G) :-
  409    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.
  416not(Goal) :-
  417    \+ Goal.
 \+ :Goal is semidet
Predicate version that allows for meta-calling.
  423\+ Goal :-
  424    \+ Goal.
 once(:Goal) is semidet
ISO predicate, acting as call((Goal, !)).
  430once(Goal) :-
  431    Goal,
  432    !.
 ignore(:Goal) is det
Call Goal, cut choice-points on success and succeed on failure. intended for calling side-effects and proceed on failure.
  439ignore(Goal) :-
  440    Goal,
  441    !.
  442ignore(_Goal).
  443
  444:- '$iso'((false/0)).
 false
Synonym for fail/0, providing a declarative reading.
  450false :-
  451    fail.
 catch(:Goal, +Catcher, :Recover)
ISO compliant exception handling.
  457catch(_Goal, _Catcher, _Recover) :-
  458    '$catch'.                       % Maps to I_CATCH, I_EXITCATCH
 prolog_cut_to(+Choice)
Cut all choice points after Choice
  464prolog_cut_to(_Choice) :-
  465    '$cut'.                         % Maps to I_CUTCHP
 reset(:Goal, ?Ball, -Continue)
Delimited continuation support.
  471reset(_Goal, _Ball, _Cont) :-
  472    '$reset'.
 shift(+Ball)
Shift control back to the enclosing reset/3
  478shift(Ball) :-
  479    '$shift'(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.

  493call_continuation([]).
  494call_continuation([TB|Rest]) :-
  495    (   Rest == []
  496    ->  '$call_continuation'(TB)
  497    ;   '$call_continuation'(TB),
  498        call_continuation(Rest)
  499    ).
 catch_with_backtrace(:Goal, ?Ball, :Recover)
As catch/3, but tell library(prolog_stack) to record a backtrace in case of an exception.
  506catch_with_backtrace(Goal, Ball, Recover) :-
  507    catch(Goal, Ball, Recover),
  508    '$no_lco'.
  509
  510'$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.
  520:- public '$recover_and_rethrow'/2.  521
  522'$recover_and_rethrow'(Goal, Exception) :-
  523    call_cleanup(Goal, throw(Exception)),
  524    !.
 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.
  539setup_call_catcher_cleanup(Setup, _Goal, _Catcher, _Cleanup) :-
  540    '$sig_atomic'(Setup),
  541    '$call_cleanup'.
  542
  543setup_call_cleanup(Setup, Goal, Cleanup) :-
  544    setup_call_catcher_cleanup(Setup, Goal, _Catcher, Cleanup).
  545
  546call_cleanup(Goal, Cleanup) :-
  547    setup_call_catcher_cleanup(true, Goal, _Catcher, Cleanup).
  548
  549call_cleanup(Goal, Catcher, Cleanup) :-
  550    setup_call_catcher_cleanup(true, Goal, Catcher, Cleanup).
  551
  552                 /*******************************
  553                 *       INITIALIZATION         *
  554                 *******************************/
  555
  556:- meta_predicate
  557    initialization(0, +).  558
  559:- multifile '$init_goal'/3.  560:- 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.

  586initialization(Goal, When) :-
  587    '$must_be'(oneof(atom, initialization_type,
  588                     [ now,
  589                       after_load,
  590                       restore,
  591                       restore_state,
  592                       prepare_state,
  593                       program,
  594                       main
  595                     ]), When),
  596    '$initialization_context'(Source, Ctx),
  597    '$initialization'(When, Goal, Source, Ctx).
  598
  599'$initialization'(now, Goal, _Source, Ctx) :-
  600    '$run_init_goal'(Goal, Ctx),
  601    '$compile_init_goal'(-, Goal, Ctx).
  602'$initialization'(after_load, Goal, Source, Ctx) :-
  603    (   Source \== (-)
  604    ->  '$compile_init_goal'(Source, Goal, Ctx)
  605    ;   throw(error(context_error(nodirective,
  606                                  initialization(Goal, after_load)),
  607                    _))
  608    ).
  609'$initialization'(restore, Goal, Source, Ctx) :- % deprecated
  610    '$initialization'(restore_state, Goal, Source, Ctx).
  611'$initialization'(restore_state, Goal, _Source, Ctx) :-
  612    (   \+ current_prolog_flag(sandboxed_load, true)
  613    ->  '$compile_init_goal'(-, Goal, Ctx)
  614    ;   '$permission_error'(register, initialization(restore), Goal)
  615    ).
  616'$initialization'(prepare_state, Goal, _Source, Ctx) :-
  617    (   \+ current_prolog_flag(sandboxed_load, true)
  618    ->  '$compile_init_goal'(when(prepare_state), Goal, Ctx)
  619    ;   '$permission_error'(register, initialization(restore), Goal)
  620    ).
  621'$initialization'(program, Goal, _Source, Ctx) :-
  622    (   \+ current_prolog_flag(sandboxed_load, true)
  623    ->  '$compile_init_goal'(when(program), Goal, Ctx)
  624    ;   '$permission_error'(register, initialization(restore), Goal)
  625    ).
  626'$initialization'(main, Goal, _Source, Ctx) :-
  627    (   \+ current_prolog_flag(sandboxed_load, true)
  628    ->  '$compile_init_goal'(when(main), Goal, Ctx)
  629    ;   '$permission_error'(register, initialization(restore), Goal)
  630    ).
  631
  632
  633'$compile_init_goal'(Source, Goal, Ctx) :-
  634    atom(Source),
  635    Source \== (-),
  636    !,
  637    '$store_admin_clause'(system:'$init_goal'(Source, Goal, Ctx),
  638                          _Layout, Source, Ctx).
  639'$compile_init_goal'(Source, Goal, Ctx) :-
  640    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.
  652'$run_initialization'(_, loaded, _) :- !.
  653'$run_initialization'(File, _Action, Options) :-
  654    '$run_initialization'(File, Options).
  655
  656'$run_initialization'(File, Options) :-
  657    setup_call_cleanup(
  658        '$start_run_initialization'(Options, Restore),
  659        '$run_initialization_2'(File),
  660        '$end_run_initialization'(Restore)).
  661
  662'$start_run_initialization'(Options, OldSandBoxed) :-
  663    '$push_input_context'(initialization),
  664    '$set_sandboxed_load'(Options, OldSandBoxed).
  665'$end_run_initialization'(OldSandBoxed) :-
  666    set_prolog_flag(sandboxed_load, OldSandBoxed),
  667    '$pop_input_context'.
  668
  669'$run_initialization_2'(File) :-
  670    (   '$init_goal'(File, Goal, Ctx),
  671        File \= when(_),
  672        '$run_init_goal'(Goal, Ctx),
  673        fail
  674    ;   true
  675    ).
  676
  677'$run_init_goal'(Goal, Ctx) :-
  678    (   catch_with_backtrace('$run_init_goal'(Goal), E,
  679                             '$initialization_error'(E, Goal, Ctx))
  680    ->  true
  681    ;   '$initialization_failure'(Goal, Ctx)
  682    ).
  683
  684:- multifile prolog:sandbox_allowed_goal/1.  685
  686'$run_init_goal'(Goal) :-
  687    current_prolog_flag(sandboxed_load, false),
  688    !,
  689    call(Goal).
  690'$run_init_goal'(Goal) :-
  691    prolog:sandbox_allowed_goal(Goal),
  692    call(Goal).
  693
  694'$initialization_context'(Source, Ctx) :-
  695    (   source_location(File, Line)
  696    ->  Ctx = File:Line,
  697        '$input_context'(Context),
  698        '$top_file'(Context, File, Source)
  699    ;   Ctx = (-),
  700        File = (-)
  701    ).
  702
  703'$top_file'([input(include, F1, _, _)|T], _, F) :-
  704    !,
  705    '$top_file'(T, F1, F).
  706'$top_file'(_, F, F).
  707
  708
  709'$initialization_error'(E, Goal, Ctx) :-
  710    print_message(error, initialization_error(Goal, E, Ctx)).
  711
  712'$initialization_failure'(Goal, Ctx) :-
  713    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
  721:- public '$clear_source_admin'/1.  722
  723'$clear_source_admin'(File) :-
  724    retractall('$init_goal'(_, _, File:_)),
  725    retractall('$load_context_module'(File, _, _)),
  726    retractall('$resolved_source_path'(_, File)).
  727
  728
  729                 /*******************************
  730                 *            STREAM            *
  731                 *******************************/
  732
  733:- '$iso'(stream_property/2).  734stream_property(Stream, Property) :-
  735    nonvar(Stream),
  736    nonvar(Property),
  737    !,
  738    '$stream_property'(Stream, Property).
  739stream_property(Stream, Property) :-
  740    nonvar(Stream),
  741    !,
  742    '$stream_properties'(Stream, Properties),
  743    '$member'(Property, Properties).
  744stream_property(Stream, Property) :-
  745    nonvar(Property),
  746    !,
  747    (   Property = alias(Alias),
  748        atom(Alias)
  749    ->  '$alias_stream'(Alias, Stream)
  750    ;   '$streams_properties'(Property, Pairs),
  751        '$member'(Stream-Property, Pairs)
  752    ).
  753stream_property(Stream, Property) :-
  754    '$streams_properties'(Property, Pairs),
  755    '$member'(Stream-Properties, Pairs),
  756    '$member'(Property, Properties).
  757
  758
  759                /********************************
  760                *            MODULES            *
  761                *********************************/
  762
  763%       '$prefix_module'(+Module, +Context, +Term, -Prefixed)
  764%       Tags `Term' with `Module:' if `Module' is not the context module.
  765
  766'$prefix_module'(Module, Module, Head, Head) :- !.
  767'$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'.
  773default_module(Me, Super) :-
  774    (   atom(Me)
  775    ->  (   var(Super)
  776        ->  '$default_module'(Me, Super)
  777        ;   '$default_module'(Me, Super), !
  778        )
  779    ;   '$type_error'(module, Me)
  780    ).
  781
  782'$default_module'(Me, Me).
  783'$default_module'(Me, Super) :-
  784    import_module(Me, S),
  785    '$default_module'(S, Super).
  786
  787
  788                /********************************
  789                *      TRACE AND EXCEPTIONS     *
  790                *********************************/
  791
  792:- dynamic   user:exception/3.  793:- multifile 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.
  802:- public
  803    '$undefined_procedure'/4.  804
  805'$undefined_procedure'(Module, Name, Arity, Action) :-
  806    '$prefix_module'(Module, user, Name/Arity, Pred),
  807    user:exception(undefined_predicate, Pred, Action0),
  808    !,
  809    Action = Action0.
  810'$undefined_procedure'(Module, Name, Arity, Action) :-
  811    current_prolog_flag(autoload, true),
  812    '$autoload'(Module, Name, Arity),
  813    !,
  814    Action = retry.
  815'$undefined_procedure'(_, _, _, error).
  816
  817'$autoload'(Module, Name, Arity) :-
  818    source_location(File, _Line),
  819    !,
  820    setup_call_cleanup(
  821        '$start_aux'(File, Context),
  822        '$autoload2'(Module, Name, Arity),
  823        '$end_aux'(File, Context)).
  824'$autoload'(Module, Name, Arity) :-
  825    '$autoload2'(Module, Name, Arity).
  826
  827'$autoload2'(Module, Name, Arity) :-
  828    '$find_library'(Module, Name, Arity, LoadModule, Library),
  829    functor(Head, Name, Arity),
  830    '$update_autoload_level'([autoload(true)], Old),
  831    (   current_prolog_flag(verbose_autoload, true)
  832    ->  Level = informational
  833    ;   Level = silent
  834    ),
  835    print_message(Level, autoload(Module:Name/Arity, Library)),
  836    '$compilation_mode'(OldComp, database),
  837    (   Module == LoadModule
  838    ->  ensure_loaded(Module:Library)
  839    ;   (   '$get_predicate_attribute'(LoadModule:Head, defined, 1),
  840            \+ '$loading'(Library)
  841        ->  Module:import(LoadModule:Name/Arity)
  842        ;   use_module(Module:Library, [Name/Arity])
  843        )
  844    ),
  845    '$set_compilation_mode'(OldComp),
  846    '$set_autoload_level'(Old),
  847    '$c_current_predicate'(_, Module:Head).
 $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.
  858'$loading'(Library) :-
  859    current_prolog_flag(threads, true),
  860    '$loading_file'(FullFile, _Queue, _LoadThread),
  861    file_name_extension(Library, _, FullFile),
  862    !.
  863
  864%        handle debugger 'w', 'p' and <N> depth options.
  865
  866'$set_debugger_write_options'(write) :-
  867    !,
  868    create_prolog_flag(debugger_write_options,
  869                       [ quoted(true),
  870                         attributes(dots),
  871                         spacing(next_argument)
  872                       ], []).
  873'$set_debugger_write_options'(print) :-
  874    !,
  875    create_prolog_flag(debugger_write_options,
  876                       [ quoted(true),
  877                         portray(true),
  878                         max_depth(10),
  879                         attributes(portray),
  880                         spacing(next_argument)
  881                       ], []).
  882'$set_debugger_write_options'(Depth) :-
  883    current_prolog_flag(debugger_write_options, Options0),
  884    (   '$select'(max_depth(_), Options0, Options)
  885    ->  true
  886    ;   Options = Options0
  887    ),
  888    create_prolog_flag(debugger_write_options,
  889                       [max_depth(Depth)|Options], []).
  890
  891
  892                /********************************
  893                *        SYSTEM MESSAGES        *
  894                *********************************/
 $confirm(Spec)
Ask the user to confirm a question. Spec is a term as used for print_message/2.
  901'$confirm'(Spec) :-
  902    print_message(query, Spec),
  903    between(0, 5, _),
  904        get_single_char(Answer),
  905        (   '$in_reply'(Answer, 'yYjJ \n')
  906        ->  !,
  907            print_message(query, if_tty([yes-[]]))
  908        ;   '$in_reply'(Answer, 'nN')
  909        ->  !,
  910            print_message(query, if_tty([no-[]])),
  911            fail
  912        ;   print_message(help, query(confirm)),
  913            fail
  914        ).
  915
  916'$in_reply'(Code, Atom) :-
  917    char_code(Char, Code),
  918    sub_atom(Atom, _, _, _, Char),
  919    !.
  920
  921:- dynamic
  922    user:portray/1.  923:- multifile
  924    user:portray/1.  925
  926
  927                 /*******************************
  928                 *       FILE_SEARCH_PATH       *
  929                 *******************************/
  930
  931:- dynamic user:file_search_path/2.  932:- multifile user:file_search_path/2.  933
  934user:(file_search_path(library, Dir) :-
  935        library_directory(Dir)).
  936user:file_search_path(swi, Home) :-
  937    current_prolog_flag(home, Home).
  938user:file_search_path(foreign, swi(ArchLib)) :-
  939    current_prolog_flag(arch, Arch),
  940    atom_concat('lib/', Arch, ArchLib).
  941user:file_search_path(foreign, swi(SoLib)) :-
  942    (   current_prolog_flag(windows, true)
  943    ->  SoLib = bin
  944    ;   SoLib = lib
  945    ).
  946user:file_search_path(path, Dir) :-
  947    getenv('PATH', Path),
  948    (   current_prolog_flag(windows, true)
  949    ->  atomic_list_concat(Dirs, (;), Path)
  950    ;   atomic_list_concat(Dirs, :, Path)
  951    ),
  952    '$member'(Dir, Dirs),
  953    '$no-null-bytes'(Dir).
  954
  955'$no-null-bytes'(Dir) :-
  956    sub_atom(Dir, _, _, _, '\u0000'),
  957    !,
  958    print_message(warning, null_byte_in_path(Dir)),
  959    fail.
  960'$no-null-bytes'(_).
 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?
  968expand_file_search_path(Spec, Expanded) :-
  969    catch('$expand_file_search_path'(Spec, Expanded, 0, []),
  970          loop(Used),
  971          throw(error(loop_error(Spec), file_search(Used)))).
  972
  973'$expand_file_search_path'(Spec, Expanded, N, Used) :-
  974    functor(Spec, Alias, 1),
  975    !,
  976    user:file_search_path(Alias, Exp0),
  977    NN is N + 1,
  978    (   NN > 16
  979    ->  throw(loop(Used))
  980    ;   true
  981    ),
  982    '$expand_file_search_path'(Exp0, Exp1, NN, [Alias=Exp0|Used]),
  983    arg(1, Spec, Segments),
  984    '$segments_to_atom'(Segments, File),
  985    '$make_path'(Exp1, File, Expanded).
  986'$expand_file_search_path'(Spec, Path, _, _) :-
  987    '$segments_to_atom'(Spec, Path).
  988
  989'$make_path'(Dir, '.', Path) :-
  990    !,
  991    Path = Dir.
  992'$make_path'(Dir, File, Path) :-
  993    sub_atom(Dir, _, _, 0, /),
  994    !,
  995    atom_concat(Dir, File, Path).
  996'$make_path'(Dir, File, Path) :-
  997    atomic_list_concat([Dir, /, File], Path).
  998
  999
 1000                /********************************
 1001                *         FILE CHECKING         *
 1002                *********************************/
 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.
 1013absolute_file_name(Spec, Options, Path) :-
 1014    '$is_options'(Options),
 1015    \+ '$is_options'(Path),
 1016    !,
 1017    absolute_file_name(Spec, Path, Options).
 1018absolute_file_name(Spec, Path, Options) :-
 1019    '$must_be'(options, Options),
 1020                    % get the valid extensions
 1021    (   '$select_option'(extensions(Exts), Options, Options1)
 1022    ->  '$must_be'(list, Exts)
 1023    ;   '$option'(file_type(Type), Options)
 1024    ->  '$must_be'(atom, Type),
 1025        '$file_type_extensions'(Type, Exts),
 1026        Options1 = Options
 1027    ;   Options1 = Options,
 1028        Exts = ['']
 1029    ),
 1030    '$canonicalise_extensions'(Exts, Extensions),
 1031                    % unless specified otherwise, ask regular file
 1032    (   nonvar(Type)
 1033    ->  Options2 = Options1
 1034    ;   '$merge_options'(_{file_type:regular}, Options1, Options2)
 1035    ),
 1036                    % Det or nondet?
 1037    (   '$select_option'(solutions(Sols), Options2, Options3)
 1038    ->  '$must_be'(oneof(atom, solutions, [first,all]), Sols)
 1039    ;   Sols = first,
 1040        Options3 = Options2
 1041    ),
 1042                    % Errors or not?
 1043    (   '$select_option'(file_errors(FileErrors), Options3, Options4)
 1044    ->  '$must_be'(oneof(atom, file_errors, [error,fail]), FileErrors)
 1045    ;   FileErrors = error,
 1046        Options4 = Options3
 1047    ),
 1048                    % Expand shell patterns?
 1049    (   atomic(Spec),
 1050        '$select_option'(expand(Expand), Options4, Options5),
 1051        '$must_be'(boolean, Expand)
 1052    ->  expand_file_name(Spec, List),
 1053        '$member'(Spec1, List)
 1054    ;   Spec1 = Spec,
 1055        Options5 = Options4
 1056    ),
 1057                    % Search for files
 1058    (   Sols == first
 1059    ->  (   '$chk_file'(Spec1, Extensions, Options5, true, Path)
 1060        ->  !       % also kill choice point of expand_file_name/2
 1061        ;   (   FileErrors == fail
 1062            ->  fail
 1063            ;   '$current_module'('$bags', _File),
 1064                findall(P,
 1065                        '$chk_file'(Spec1, Extensions, [access(exist)],
 1066                                    false, P),
 1067                        Candidates),
 1068                '$abs_file_error'(Spec, Candidates, Options5)
 1069            )
 1070        )
 1071    ;   '$chk_file'(Spec1, Extensions, Options5, false, Path)
 1072    ).
 1073
 1074'$abs_file_error'(Spec, Candidates, Conditions) :-
 1075    '$member'(F, Candidates),
 1076    '$member'(C, Conditions),
 1077    '$file_condition'(C),
 1078    '$file_error'(C, Spec, F, E, Comment),
 1079    !,
 1080    throw(error(E, context(_, Comment))).
 1081'$abs_file_error'(Spec, _, _) :-
 1082    '$existence_error'(source_sink, Spec).
 1083
 1084'$file_error'(file_type(directory), Spec, File, Error, Comment) :-
 1085    \+ exists_directory(File),
 1086    !,
 1087    Error = existence_error(directory, Spec),
 1088    Comment = not_a_directory(File).
 1089'$file_error'(file_type(_), Spec, File, Error, Comment) :-
 1090    exists_directory(File),
 1091    !,
 1092    Error = existence_error(file, Spec),
 1093    Comment = directory(File).
 1094'$file_error'(access(OneOrList), Spec, File, Error, _) :-
 1095    '$one_or_member'(Access, OneOrList),
 1096    \+ access_file(File, Access),
 1097    Error = permission_error(Access, source_sink, Spec).
 1098
 1099'$one_or_member'(Elem, List) :-
 1100    is_list(List),
 1101    !,
 1102    '$member'(Elem, List).
 1103'$one_or_member'(Elem, Elem).
 1104
 1105
 1106'$file_type_extensions'(source, Exts) :-       % SICStus 3.9 compatibility
 1107    !,
 1108    '$file_type_extensions'(prolog, Exts).
 1109'$file_type_extensions'(Type, Exts) :-
 1110    '$current_module'('$bags', _File),
 1111    !,
 1112    findall(Ext, user:prolog_file_type(Ext, Type), Exts0),
 1113    (   Exts0 == [],
 1114        \+ '$ft_no_ext'(Type)
 1115    ->  '$domain_error'(file_type, Type)
 1116    ;   true
 1117    ),
 1118    '$append'(Exts0, [''], Exts).
 1119'$file_type_extensions'(prolog, [pl, '']). % findall is not yet defined ...
 1120
 1121'$ft_no_ext'(txt).
 1122'$ft_no_ext'(executable).
 1123'$ft_no_ext'(directory).
 user:prolog_file_type(?Extension, ?Type)
Define type of file based on the extension. This is used by absolute_file_name/3 and may be used to extend the list of extensions used for some type.

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

 1136:- multifile(user:prolog_file_type/2). 1137:- dynamic(user:prolog_file_type/2). 1138
 1139user:prolog_file_type(pl,       prolog).
 1140user:prolog_file_type(prolog,   prolog).
 1141user:prolog_file_type(qlf,      prolog).
 1142user:prolog_file_type(qlf,      qlf).
 1143user:prolog_file_type(Ext,      executable) :-
 1144    current_prolog_flag(shared_object_extension, Ext).
 1145user:prolog_file_type(dylib,    executable) :-
 1146    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.
 1153'$chk_file'(Spec, _Extensions, _Cond, _Cache, _FullName) :-
 1154    \+ ground(Spec),
 1155    !,
 1156    '$instantiation_error'(Spec).
 1157'$chk_file'(Spec, Extensions, Cond, Cache, FullName) :-
 1158    compound(Spec),
 1159    functor(Spec, _, 1),
 1160    !,
 1161    '$relative_to'(Cond, cwd, CWD),
 1162    '$chk_alias_file'(Spec, Extensions, Cond, Cache, CWD, FullName).
 1163'$chk_file'(Segments, Ext, Cond, Cache, FullName) :-    % allow a/b/...
 1164    \+ atomic(Segments),
 1165    !,
 1166    '$segments_to_atom'(Segments, Atom),
 1167    '$chk_file'(Atom, Ext, Cond, Cache, FullName).
 1168'$chk_file'(File, Exts, Cond, _, FullName) :-
 1169    is_absolute_file_name(File),
 1170    !,
 1171    '$extend_file'(File, Exts, Extended),
 1172    '$file_conditions'(Cond, Extended),
 1173    '$absolute_file_name'(Extended, FullName).
 1174'$chk_file'(File, Exts, Cond, _, FullName) :-
 1175    '$relative_to'(Cond, source, Dir),
 1176    atomic_list_concat([Dir, /, File], AbsFile),
 1177    '$extend_file'(AbsFile, Exts, Extended),
 1178    '$file_conditions'(Cond, Extended),
 1179    !,
 1180    '$absolute_file_name'(Extended, FullName).
 1181'$chk_file'(File, Exts, Cond, _, FullName) :-
 1182    '$extend_file'(File, Exts, Extended),
 1183    '$file_conditions'(Cond, Extended),
 1184    '$absolute_file_name'(Extended, FullName).
 1185
 1186'$segments_to_atom'(Atom, Atom) :-
 1187    atomic(Atom),
 1188    !.
 1189'$segments_to_atom'(Segments, Atom) :-
 1190    '$segments_to_list'(Segments, List, []),
 1191    !,
 1192    atomic_list_concat(List, /, Atom).
 1193
 1194'$segments_to_list'(A/B, H, T) :-
 1195    '$segments_to_list'(A, H, T0),
 1196    '$segments_to_list'(B, T0, T).
 1197'$segments_to_list'(A, [A|T], T) :-
 1198    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.
 1208'$relative_to'(Conditions, Default, Dir) :-
 1209    (   '$option'(relative_to(FileOrDir), Conditions)
 1210    *-> (   exists_directory(FileOrDir)
 1211        ->  Dir = FileOrDir
 1212        ;   atom_concat(Dir, /, FileOrDir)
 1213        ->  true
 1214        ;   file_directory_name(FileOrDir, Dir)
 1215        )
 1216    ;   Default == cwd
 1217    ->  '$cwd'(Dir)
 1218    ;   Default == source
 1219    ->  source_location(ContextFile, _Line),
 1220        file_directory_name(ContextFile, Dir)
 1221    ).
 $chk_alias_file(+Spec, +Exts, +Cond, +Cache, +CWD, -FullFile) is nondet
 1226:- dynamic
 1227    '$search_path_file_cache'/3,    % SHA1, Time, Path
 1228    '$search_path_gc_time'/1.       % Time
 1229:- volatile
 1230    '$search_path_file_cache'/3,
 1231    '$search_path_gc_time'/1. 1232
 1233:- create_prolog_flag(file_search_cache_time, 10, []). 1234
 1235'$chk_alias_file'(Spec, Exts, Cond, true, CWD, FullFile) :-
 1236    !,
 1237    findall(Exp, expand_file_search_path(Spec, Exp), Expansions),
 1238    Cache = cache(Exts, Cond, CWD, Expansions),
 1239    variant_sha1(Spec+Cache, SHA1),
 1240    get_time(Now),
 1241    current_prolog_flag(file_search_cache_time, TimeOut),
 1242    (   '$search_path_file_cache'(SHA1, CachedTime, FullFile),
 1243        CachedTime > Now - TimeOut,
 1244        '$file_conditions'(Cond, FullFile)
 1245    ->  '$search_message'(file_search(cache(Spec, Cond), FullFile))
 1246    ;   '$member'(Expanded, Expansions),
 1247        '$extend_file'(Expanded, Exts, LibFile),
 1248        (   '$file_conditions'(Cond, LibFile),
 1249            '$absolute_file_name'(LibFile, FullFile),
 1250            '$cache_file_found'(SHA1, Now, TimeOut, FullFile)
 1251        ->  '$search_message'(file_search(found(Spec, Cond), FullFile))
 1252        ;   '$search_message'(file_search(tried(Spec, Cond), LibFile)),
 1253            fail
 1254        )
 1255    ).
 1256'$chk_alias_file'(Spec, Exts, Cond, false, _CWD, FullFile) :-
 1257    expand_file_search_path(Spec, Expanded),
 1258    '$extend_file'(Expanded, Exts, LibFile),
 1259    '$file_conditions'(Cond, LibFile),
 1260    '$absolute_file_name'(LibFile, FullFile).
 1261
 1262'$cache_file_found'(_, _, TimeOut, _) :-
 1263    TimeOut =:= 0,
 1264    !.
 1265'$cache_file_found'(SHA1, Now, TimeOut, FullFile) :-
 1266    '$search_path_file_cache'(SHA1, Saved, FullFile),
 1267    !,
 1268    (   Now - Saved < TimeOut/2
 1269    ->  true
 1270    ;   retractall('$search_path_file_cache'(SHA1, _, _)),
 1271        asserta('$search_path_file_cache'(SHA1, Now, FullFile))
 1272    ).
 1273'$cache_file_found'(SHA1, Now, TimeOut, FullFile) :-
 1274    'gc_file_search_cache'(TimeOut),
 1275    asserta('$search_path_file_cache'(SHA1, Now, FullFile)).
 1276
 1277'gc_file_search_cache'(TimeOut) :-
 1278    get_time(Now),
 1279    '$search_path_gc_time'(Last),
 1280    Now-Last < TimeOut/2,
 1281    !.
 1282'gc_file_search_cache'(TimeOut) :-
 1283    get_time(Now),
 1284    retractall('$search_path_gc_time'(_)),
 1285    assertz('$search_path_gc_time'(Now)),
 1286    Before is Now - TimeOut,
 1287    (   '$search_path_file_cache'(SHA1, Cached, FullFile),
 1288        Cached < Before,
 1289        retractall('$search_path_file_cache'(SHA1, Cached, FullFile)),
 1290        fail
 1291    ;   true
 1292    ).
 1293
 1294
 1295'$search_message'(Term) :-
 1296    current_prolog_flag(verbose_file_search, true),
 1297    !,
 1298    print_message(informational, Term).
 1299'$search_message'(_).
 $file_conditions(+Condition, +Path)
Verify Path satisfies Condition.
 1306'$file_conditions'(List, File) :-
 1307    is_list(List),
 1308    !,
 1309    \+ ( '$member'(C, List),
 1310         '$file_condition'(C),
 1311         \+ '$file_condition'(C, File)
 1312       ).
 1313'$file_conditions'(Map, File) :-
 1314    \+ (  get_dict(Key, Map, Value),
 1315          C =.. [Key,Value],
 1316          '$file_condition'(C),
 1317         \+ '$file_condition'(C, File)
 1318       ).
 1319
 1320'$file_condition'(file_type(directory), File) :-
 1321    !,
 1322    exists_directory(File).
 1323'$file_condition'(file_type(_), File) :-
 1324    !,
 1325    \+ exists_directory(File).
 1326'$file_condition'(access(Accesses), File) :-
 1327    !,
 1328    \+ (  '$one_or_member'(Access, Accesses),
 1329          \+ access_file(File, Access)
 1330       ).
 1331
 1332'$file_condition'(exists).
 1333'$file_condition'(file_type(_)).
 1334'$file_condition'(access(_)).
 1335
 1336'$extend_file'(File, Exts, FileEx) :-
 1337    '$ensure_extensions'(Exts, File, Fs),
 1338    '$list_to_set'(Fs, FsSet),
 1339    '$member'(FileEx, FsSet).
 1340
 1341'$ensure_extensions'([], _, []).
 1342'$ensure_extensions'([E|E0], F, [FE|E1]) :-
 1343    file_name_extension(F, E, FE),
 1344    '$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. Note that library(lists) provides an O(N*log(N)) version, but sets of file name extensions should be short enough for this not to matter.
 1353'$list_to_set'(List, Set) :-
 1354    '$list_to_set'(List, [], Set).
 1355
 1356'$list_to_set'([], _, []).
 1357'$list_to_set'([H|T], Seen, R) :-
 1358    memberchk(H, Seen),
 1359    !,
 1360    '$list_to_set'(T, R).
 1361'$list_to_set'([H|T], Seen, [H|R]) :-
 1362    '$list_to_set'(T, [H|Seen], R).
 1363
 1364/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
 1365Canonicalise the extension list. Old SWI-Prolog   require  `.pl', etc, which
 1366the Quintus compatibility  requests  `pl'.   This  layer  canonicalises  all
 1367extensions to .ext
 1368- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
 1369
 1370'$canonicalise_extensions'([], []) :- !.
 1371'$canonicalise_extensions'([H|T], [CH|CT]) :-
 1372    !,
 1373    '$must_be'(atom, H),
 1374    '$canonicalise_extension'(H, CH),
 1375    '$canonicalise_extensions'(T, CT).
 1376'$canonicalise_extensions'(E, [CE]) :-
 1377    '$canonicalise_extension'(E, CE).
 1378
 1379'$canonicalise_extension'('', '') :- !.
 1380'$canonicalise_extension'(DotAtom, DotAtom) :-
 1381    sub_atom(DotAtom, 0, _, _, '.'),
 1382    !.
 1383'$canonicalise_extension'(Atom, DotAtom) :-
 1384    atom_concat('.', Atom, DotAtom).
 1385
 1386
 1387                /********************************
 1388                *            CONSULT            *
 1389                *********************************/
 1390
 1391:- dynamic
 1392    user:library_directory/1,
 1393    user:prolog_load_file/2. 1394:- multifile
 1395    user:library_directory/1,
 1396    user:prolog_load_file/2. 1397
 1398:- prompt(_, '|: '). 1399
 1400:- thread_local
 1401    '$compilation_mode_store'/1,    % database, wic, qlf
 1402    '$directive_mode_store'/1.      % database, wic, qlf
 1403:- volatile
 1404    '$compilation_mode_store'/1,
 1405    '$directive_mode_store'/1. 1406
 1407'$compilation_mode'(Mode) :-
 1408    (   '$compilation_mode_store'(Val)
 1409    ->  Mode = Val
 1410    ;   Mode = database
 1411    ).
 1412
 1413'$set_compilation_mode'(Mode) :-
 1414    retractall('$compilation_mode_store'(_)),
 1415    assertz('$compilation_mode_store'(Mode)).
 1416
 1417'$compilation_mode'(Old, New) :-
 1418    '$compilation_mode'(Old),
 1419    (   New == Old
 1420    ->  true
 1421    ;   '$set_compilation_mode'(New)
 1422    ).
 1423
 1424'$directive_mode'(Mode) :-
 1425    (   '$directive_mode_store'(Val)
 1426    ->  Mode = Val
 1427    ;   Mode = database
 1428    ).
 1429
 1430'$directive_mode'(Old, New) :-
 1431    '$directive_mode'(Old),
 1432    (   New == Old
 1433    ->  true
 1434    ;   '$set_directive_mode'(New)
 1435    ).
 1436
 1437'$set_directive_mode'(Mode) :-
 1438    retractall('$directive_mode_store'(_)),
 1439    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.
 1447'$compilation_level'(Level) :-
 1448    '$input_context'(Stack),
 1449    '$compilation_level'(Stack, Level).
 1450
 1451'$compilation_level'([], 0).
 1452'$compilation_level'([Input|T], Level) :-
 1453    (   arg(1, Input, see)
 1454    ->  '$compilation_level'(T, Level)
 1455    ;   '$compilation_level'(T, Level0),
 1456        Level is Level0+1
 1457    ).
 compiling
Is true if SWI-Prolog is generating a state or qlf file or executes a `call' directive while doing this.
 1465compiling :-
 1466    \+ (   '$compilation_mode'(database),
 1467           '$directive_mode'(database)
 1468       ).
 1469
 1470:- meta_predicate
 1471    '$ifcompiling'(0). 1472
 1473'$ifcompiling'(G) :-
 1474    (   '$compilation_mode'(database)
 1475    ->  true
 1476    ;   call(G)
 1477    ).
 1478
 1479                /********************************
 1480                *         READ SOURCE           *
 1481                *********************************/
 $load_msg_level(+Action, +NestingLevel, -StartVerbose, -EndVerbose)
 1485'$load_msg_level'(Action, Nesting, Start, Done) :-
 1486    '$update_autoload_level'([], 0),
 1487    !,
 1488    current_prolog_flag(verbose_load, Type0),
 1489    '$load_msg_compat'(Type0, Type),
 1490    (   '$load_msg_level'(Action, Nesting, Type, Start, Done)
 1491    ->  true
 1492    ).
 1493'$load_msg_level'(_, _, silent, silent).
 1494
 1495'$load_msg_compat'(true, normal) :- !.
 1496'$load_msg_compat'(false, silent) :- !.
 1497'$load_msg_compat'(X, X).
 1498
 1499'$load_msg_level'(load_file,    _, full,   informational, informational).
 1500'$load_msg_level'(include_file, _, full,   informational, informational).
 1501'$load_msg_level'(load_file,    _, normal, silent,        informational).
 1502'$load_msg_level'(include_file, _, normal, silent,        silent).
 1503'$load_msg_level'(load_file,    0, brief,  silent,        informational).
 1504'$load_msg_level'(load_file,    _, brief,  silent,        silent).
 1505'$load_msg_level'(include_file, _, brief,  silent,        silent).
 1506'$load_msg_level'(load_file,    _, silent, silent,        silent).
 1507'$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)
 1530'$source_term'(From, Read, RLayout, Term, TLayout, Stream, Options) :-
 1531    '$source_term'(From, Read, RLayout, Term, TLayout, Stream, [], Options),
 1532    (   Term == end_of_file
 1533    ->  !, fail
 1534    ;   Term \== begin_of_file
 1535    ).
 1536
 1537'$source_term'(Input, _,_,_,_,_,_,_) :-
 1538    \+ ground(Input),
 1539    !,
 1540    '$instantiation_error'(Input).
 1541'$source_term'(stream(Id, In, Opts),
 1542               Read, RLayout, Term, TLayout, Stream, Parents, Options) :-
 1543    !,
 1544    '$record_included'(Parents, Id, Id, 0.0, Message),
 1545    setup_call_cleanup(
 1546        '$open_source'(stream(Id, In, Opts), In, State, Parents, Options),
 1547        '$term_in_file'(In, Read, RLayout, Term, TLayout, Stream,
 1548                        [Id|Parents], Options),
 1549        '$close_source'(State, Message)).
 1550'$source_term'(File,
 1551               Read, RLayout, Term, TLayout, Stream, Parents, Options) :-
 1552    absolute_file_name(File, Path,
 1553                       [ file_type(prolog),
 1554                         access(read)
 1555                       ]),
 1556    time_file(Path, Time),
 1557    '$record_included'(Parents, File, Path, Time, Message),
 1558    setup_call_cleanup(
 1559        '$open_source'(Path, In, State, Parents, Options),
 1560        '$term_in_file'(In, Read, RLayout, Term, TLayout, Stream,
 1561                        [Path|Parents], Options),
 1562        '$close_source'(State, Message)).
 1563
 1564:- thread_local
 1565    '$load_input'/2. 1566:- volatile
 1567    '$load_input'/2. 1568
 1569'$open_source'(stream(Id, In, Opts), In,
 1570               restore(In, StreamState, Id, Ref, Opts), Parents, Options) :-
 1571    !,
 1572    '$context_type'(Parents, ContextType),
 1573    '$push_input_context'(ContextType),
 1574    '$set_encoding'(In, Options),
 1575    '$prepare_load_stream'(In, Id, StreamState),
 1576    asserta('$load_input'(stream(Id), In), Ref).
 1577'$open_source'(Path, In, close(In, Path, Ref), Parents, Options) :-
 1578    '$context_type'(Parents, ContextType),
 1579    '$push_input_context'(ContextType),
 1580    open(Path, read, In),
 1581    '$set_encoding'(In, Options),
 1582    asserta('$load_input'(Path, In), Ref).
 1583
 1584'$context_type'([], load_file) :- !.
 1585'$context_type'(_, include).
 1586
 1587'$close_source'(close(In, Id, Ref), Message) :-
 1588    erase(Ref),
 1589    '$end_consult'(Id),
 1590    call_cleanup(
 1591        close(In),
 1592        '$pop_input_context'),
 1593    '$close_message'(Message).
 1594'$close_source'(restore(In, StreamState, Id, Ref, Opts), Message) :-
 1595    erase(Ref),
 1596    '$end_consult'(Id),
 1597    call_cleanup(
 1598        '$restore_load_stream'(In, StreamState, Opts),
 1599        '$pop_input_context'),
 1600    '$close_message'(Message).
 1601
 1602'$close_message'(message(Level, Msg)) :-
 1603    !,
 1604    '$print_message'(Level, Msg).
 1605'$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.
 1617'$term_in_file'(In, Read, RLayout, Term, TLayout, Stream, Parents, Options) :-
 1618    Parents \= [_,_|_],
 1619    (   '$load_input'(_, Input)
 1620    ->  stream_property(Input, file_name(File))
 1621    ),
 1622    '$set_source_location'(File, 0),
 1623    '$expanded_term'(In,
 1624                     begin_of_file, 0-0, Read, RLayout, Term, TLayout,
 1625                     Stream, Parents, Options).
 1626'$term_in_file'(In, Read, RLayout, Term, TLayout, Stream, Parents, Options) :-
 1627    '$skip_script_line'(In, Options),
 1628    '$read_clause_options'(Options, ReadOptions),
 1629    repeat,
 1630      read_clause(In, Raw,
 1631                  [ variable_names(Bindings),
 1632                    term_position(Pos),
 1633                    subterm_positions(RawLayout)
 1634                  | ReadOptions
 1635                  ]),
 1636      b_setval('$term_position', Pos),
 1637      b_setval('$variable_names', Bindings),
 1638      (   Raw == end_of_file
 1639      ->  !,
 1640          (   Parents = [_,_|_]     % Included file
 1641          ->  fail
 1642          ;   '$expanded_term'(In,
 1643                               Raw, RawLayout, Read, RLayout, Term, TLayout,
 1644                               Stream, Parents, Options)
 1645          )
 1646      ;   '$expanded_term'(In, Raw, RawLayout, Read, RLayout, Term, TLayout,
 1647                           Stream, Parents, Options)
 1648      ).
 1649
 1650'$read_clause_options'([], []).
 1651'$read_clause_options'([H|T0], List) :-
 1652    (   '$read_clause_option'(H)
 1653    ->  List = [H|T]
 1654    ;   List = T
 1655    ),
 1656    '$read_clause_options'(T0, T).
 1657
 1658'$read_clause_option'(syntax_errors(_)).
 1659'$read_clause_option'(term_position(_)).
 1660'$read_clause_option'(process_comment(_)).
 1661
 1662'$expanded_term'(In, Raw, RawLayout, Read, RLayout, Term, TLayout,
 1663                 Stream, Parents, Options) :-
 1664    E = error(_,_),
 1665    catch('$expand_term'(Raw, RawLayout, Expanded, ExpandedLayout), E,
 1666          '$print_message_fail'(E)),
 1667    (   Expanded \== []
 1668    ->  '$expansion_member'(Expanded, ExpandedLayout, Term1, Layout1)
 1669    ;   Term1 = Expanded,
 1670        Layout1 = ExpandedLayout
 1671    ),
 1672    (   nonvar(Term1), Term1 = (:-Directive), nonvar(Directive)
 1673    ->  (   Directive = include(File),
 1674            '$current_source_module'(Module),
 1675            '$valid_directive'(Module:include(File))
 1676        ->  stream_property(In, encoding(Enc)),
 1677            '$add_encoding'(Enc, Options, Options1),
 1678            '$source_term'(File, Read, RLayout, Term, TLayout,
 1679                           Stream, Parents, Options1)
 1680        ;   Directive = encoding(Enc)
 1681        ->  set_stream(In, encoding(Enc)),
 1682            fail
 1683        ;   Term = Term1,
 1684            Stream = In,
 1685            Read = Raw
 1686        )
 1687    ;   Term = Term1,
 1688        TLayout = Layout1,
 1689        Stream = In,
 1690        Read = Raw,
 1691        RLayout = RawLayout
 1692    ).
 1693
 1694'$expansion_member'(Var, Layout, Var, Layout) :-
 1695    var(Var),
 1696    !.
 1697'$expansion_member'([], _, _, _) :- !, fail.
 1698'$expansion_member'(List, ListLayout, Term, Layout) :-
 1699    is_list(List),
 1700    !,
 1701    (   var(ListLayout)
 1702    ->  '$member'(Term, List)
 1703    ;   is_list(ListLayout)
 1704    ->  '$member_rep2'(Term, Layout, List, ListLayout)
 1705    ;   Layout = ListLayout,
 1706        '$member'(Term, List)
 1707    ).
 1708'$expansion_member'(X, Layout, X, Layout).
 1709
 1710% pairwise member, repeating last element of the second
 1711% list.
 1712
 1713'$member_rep2'(H1, H2, [H1|_], [H2|_]).
 1714'$member_rep2'(H1, H2, [_|T1], [T2]) :-
 1715    !,
 1716    '$member_rep2'(H1, H2, T1, [T2]).
 1717'$member_rep2'(H1, H2, [_|T1], [_|T2]) :-
 1718    '$member_rep2'(H1, H2, T1, T2).
 $add_encoding(+Enc, +Options0, -Options)
 1722'$add_encoding'(Enc, Options0, Options) :-
 1723    (   Options0 = [encoding(Enc)|_]
 1724    ->  Options = Options0
 1725    ;   Options = [encoding(Enc)|Options0]
 1726    ).
 1727
 1728
 1729:- multifile
 1730    '$included'/4.                  % Into, Line, File, LastModified
 1731:- dynamic
 1732    '$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'.

 1746'$record_included'([Parent|Parents], File, Path, Time,
 1747                   message(DoneMsgLevel,
 1748                           include_file(done(Level, file(File, Path))))) :-
 1749    source_location(SrcFile, Line),
 1750    !,
 1751    '$compilation_level'(Level),
 1752    '$load_msg_level'(include_file, Level, StartMsgLevel, DoneMsgLevel),
 1753    '$print_message'(StartMsgLevel,
 1754                     include_file(start(Level,
 1755                                        file(File, Path)))),
 1756    '$last'([Parent|Parents], Owner),
 1757    (   (   '$compilation_mode'(database)
 1758        ;   '$qlf_current_source'(Owner)
 1759        )
 1760    ->  '$store_admin_clause'(
 1761            system:'$included'(Parent, Line, Path, Time),
 1762            _, Owner, SrcFile:Line)
 1763    ;   '$qlf_include'(Owner, Parent, Line, Path, Time)
 1764    ).
 1765'$record_included'(_, _, _, _, true).
 $master_file(+File, -MasterFile)
Find the primary load file from included files.
 1771'$master_file'(File, MasterFile) :-
 1772    '$included'(MasterFile0, _Line, File, _Time),
 1773    !,
 1774    '$master_file'(MasterFile0, MasterFile).
 1775'$master_file'(File, File).
 1776
 1777
 1778'$skip_script_line'(_In, Options) :-
 1779    '$option'(check_script(false), Options),
 1780    !.
 1781'$skip_script_line'(In, _Options) :-
 1782    (   peek_char(In, #)
 1783    ->  skip(In, 10)
 1784    ;   true
 1785    ).
 1786
 1787'$set_encoding'(Stream, Options) :-
 1788    '$option'(encoding(Enc), Options),
 1789    !,
 1790    Enc \== default,
 1791    set_stream(Stream, encoding(Enc)).
 1792'$set_encoding'(_, _).
 1793
 1794
 1795'$prepare_load_stream'(In, Id, state(HasName,HasPos)) :-
 1796    (   stream_property(In, file_name(_))
 1797    ->  HasName = true,
 1798        (   stream_property(In, position(_))
 1799        ->  HasPos = true
 1800        ;   HasPos = false,
 1801            set_stream(In, record_position(true))
 1802        )
 1803    ;   HasName = false,
 1804        set_stream(In, file_name(Id)),
 1805        (   stream_property(In, position(_))
 1806        ->  HasPos = true
 1807        ;   HasPos = false,
 1808            set_stream(In, record_position(true))
 1809        )
 1810    ).
 1811
 1812'$restore_load_stream'(In, _State, Options) :-
 1813    memberchk(close(true), Options),
 1814    !,
 1815    close(In).
 1816'$restore_load_stream'(In, state(HasName, HasPos), _Options) :-
 1817    (   HasName == false
 1818    ->  set_stream(In, file_name(''))
 1819    ;   true
 1820    ),
 1821    (   HasPos == false
 1822    ->  set_stream(In, record_position(false))
 1823    ;   true
 1824    ).
 1825
 1826
 1827                 /*******************************
 1828                 *          DERIVED FILES       *
 1829                 *******************************/
 1830
 1831:- dynamic
 1832    '$derived_source_db'/3.         % Loaded, DerivedFrom, Time
 1833
 1834'$register_derived_source'(_, '-') :- !.
 1835'$register_derived_source'(Loaded, DerivedFrom) :-
 1836    retractall('$derived_source_db'(Loaded, _, _)),
 1837    time_file(DerivedFrom, Time),
 1838    assert('$derived_source_db'(Loaded, DerivedFrom, Time)).
 1839
 1840%       Auto-importing dynamic predicates is not very elegant and
 1841%       leads to problems with qsave_program/[1,2]
 1842
 1843'$derived_source'(Loaded, DerivedFrom, Time) :-
 1844    '$derived_source_db'(Loaded, DerivedFrom, Time).
 1845
 1846
 1847                /********************************
 1848                *       LOAD PREDICATES         *
 1849                *********************************/
 1850
 1851:- meta_predicate
 1852    ensure_loaded(:),
 1853    [:|+],
 1854    consult(:),
 1855    use_module(:),
 1856    use_module(:, +),
 1857    reexport(:),
 1858    reexport(:, +),
 1859    load_files(:),
 1860    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.
 1868ensure_loaded(Files) :-
 1869    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.
 1878use_module(Files) :-
 1879    load_files(Files, [ if(not_loaded),
 1880                        must_be_module(true)
 1881                      ]).
 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.
 1888use_module(File, Import) :-
 1889    load_files(File, [ if(not_loaded),
 1890                       must_be_module(true),
 1891                       imports(Import)
 1892                     ]).
 reexport(+Files)
As use_module/1, exporting all imported predicates.
 1898reexport(Files) :-
 1899    load_files(Files, [ if(not_loaded),
 1900                        must_be_module(true),
 1901                        reexport(true)
 1902                      ]).
 reexport(+File, +ImportList)
As use_module/1, re-exporting all imported predicates.
 1908reexport(File, Import) :-
 1909    load_files(File, [ if(not_loaded),
 1910                       must_be_module(true),
 1911                       imports(Import),
 1912                       reexport(true)
 1913                     ]).
 1914
 1915
 1916[X] :-
 1917    !,
 1918    consult(X).
 1919[M:F|R] :-
 1920    consult(M:[F|R]).
 1921
 1922consult(M:X) :-
 1923    X == user,
 1924    !,
 1925    flag('$user_consult', N, N+1),
 1926    NN is N + 1,
 1927    atom_concat('user://', NN, Id),
 1928    load_files(M:Id, [stream(user_input), check_script(false), silent(false)]).
 1929consult(List) :-
 1930    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.
 1937load_files(Files) :-
 1938    load_files(Files, []).
 1939load_files(Module:Files, Options) :-
 1940    '$must_be'(list, Options),
 1941    '$load_files'(Files, Module, Options).
 1942
 1943'$load_files'(X, _, _) :-
 1944    var(X),
 1945    !,
 1946    '$instantiation_error'(X).
 1947'$load_files'([], _, _) :- !.
 1948'$load_files'(Id, Module, Options) :-   % load_files(foo, [stream(In)])
 1949    '$option'(stream(_), Options),
 1950    !,
 1951    (   atom(Id)
 1952    ->  '$load_file'(Id, Module, Options)
 1953    ;   throw(error(type_error(atom, Id), _))
 1954    ).
 1955'$load_files'(List, Module, Options) :-
 1956    List = [_|_],
 1957    !,
 1958    '$must_be'(list, List),
 1959    '$load_file_list'(List, Module, Options).
 1960'$load_files'(File, Module, Options) :-
 1961    '$load_one_file'(File, Module, Options).
 1962
 1963'$load_file_list'([], _, _).
 1964'$load_file_list'([File|Rest], Module, Options) :-
 1965    E = error(_,_),
 1966    catch('$load_one_file'(File, Module, Options), E,
 1967          '$print_message'(error, E)),
 1968    '$load_file_list'(Rest, Module, Options).
 1969
 1970
 1971'$load_one_file'(Spec, Module, Options) :-
 1972    atomic(Spec),
 1973    '$option'(expand(Expand), Options, false),
 1974    Expand == true,
 1975    !,
 1976    expand_file_name(Spec, Expanded),
 1977    (   Expanded = [Load]
 1978    ->  true
 1979    ;   Load = Expanded
 1980    ),
 1981    '$load_files'(Load, Module, [expand(false)|Options]).
 1982'$load_one_file'(File, Module, Options) :-
 1983    strip_module(Module:File, Into, PlainFile),
 1984    '$load_file'(PlainFile, Into, Options).
 $noload(+Condition, +FullFile, +Options) is semidet
True of FullFile should not be loaded.
 1991'$noload'(true, _, _) :-
 1992    !,
 1993    fail.
 1994'$noload'(not_loaded, FullFile, _) :-
 1995    source_file(FullFile),
 1996    !.
 1997'$noload'(changed, Derived, _) :-
 1998    '$derived_source'(_FullFile, Derived, LoadTime),
 1999    time_file(Derived, Modified),
 2000    Modified @=< LoadTime,
 2001    !.
 2002'$noload'(changed, FullFile, Options) :-
 2003    '$time_source_file'(FullFile, LoadTime, user),
 2004    '$modified_id'(FullFile, Modified, Options),
 2005    Modified @=< LoadTime,
 2006    !.
 $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.
 2025'$qlf_file'(Spec, _, Spec, stream, Options) :-
 2026    '$option'(stream(_), Options),      % stream: no choice
 2027    !.
 2028'$qlf_file'(Spec, FullFile, FullFile, compile, _) :-
 2029    '$spec_extension'(Spec, Ext),       % user explicitly specified
 2030    user:prolog_file_type(Ext, prolog),
 2031    !.
 2032'$qlf_file'(Spec, FullFile, LoadFile, Mode, Options) :-
 2033    '$compilation_mode'(database),
 2034    file_name_extension(Base, PlExt, FullFile),
 2035    user:prolog_file_type(PlExt, prolog),
 2036    user:prolog_file_type(QlfExt, qlf),
 2037    file_name_extension(Base, QlfExt, QlfFile),
 2038    (   access_file(QlfFile, read),
 2039        (   '$qlf_out_of_date'(FullFile, QlfFile, Why)
 2040        ->  (   access_file(QlfFile, write)
 2041            ->  print_message(informational,
 2042                              qlf(recompile(Spec, FullFile, QlfFile, Why))),
 2043                Mode = qcompile,
 2044                LoadFile = FullFile
 2045            ;   Why == old,
 2046                current_prolog_flag(home, PlHome),
 2047                sub_atom(FullFile, 0, _, _, PlHome)
 2048            ->  print_message(silent,
 2049                              qlf(system_lib_out_of_date(Spec, QlfFile))),
 2050                Mode = qload,
 2051                LoadFile = QlfFile
 2052            ;   print_message(warning,
 2053                              qlf(can_not_recompile(Spec, QlfFile, Why))),
 2054                Mode = compile,
 2055                LoadFile = FullFile
 2056            )
 2057        ;   Mode = qload,
 2058            LoadFile = QlfFile
 2059        )
 2060    ->  !
 2061    ;   '$qlf_auto'(FullFile, QlfFile, Options)
 2062    ->  !, Mode = qcompile,
 2063        LoadFile = FullFile
 2064    ).
 2065'$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.
 2073'$qlf_out_of_date'(PlFile, QlfFile, Why) :-
 2074    (   access_file(PlFile, read)
 2075    ->  time_file(PlFile, PlTime),
 2076        time_file(QlfFile, QlfTime),
 2077        (   PlTime > QlfTime
 2078        ->  Why = old                   % PlFile is newer
 2079        ;   Error = error(Formal,_),
 2080            catch('$qlf_sources'(QlfFile, _Files), Error, true),
 2081            nonvar(Formal)              % QlfFile is incompatible
 2082        ->  Why = Error
 2083        ;   fail                        % QlfFile is up-to-date and ok
 2084        )
 2085    ;   fail                            % can not read .pl; try .qlf
 2086    ).
 $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.
 2094:- create_prolog_flag(qcompile, false, [type(atom)]). 2095
 2096'$qlf_auto'(PlFile, QlfFile, Options) :-
 2097    (   memberchk(qcompile(QlfMode), Options)
 2098    ->  true
 2099    ;   current_prolog_flag(qcompile, QlfMode),
 2100        \+ '$in_system_dir'(PlFile)
 2101    ),
 2102    (   QlfMode == auto
 2103    ->  true
 2104    ;   QlfMode == large,
 2105        size_file(PlFile, Size),
 2106        Size > 100000
 2107    ),
 2108    access_file(QlfFile, write).
 2109
 2110'$in_system_dir'(PlFile) :-
 2111    current_prolog_flag(home, Home),
 2112    sub_atom(PlFile, 0, _, _, Home).
 2113
 2114'$spec_extension'(File, Ext) :-
 2115    atom(File),
 2116    file_name_extension(_, Ext, File).
 2117'$spec_extension'(Spec, Ext) :-
 2118    compound(Spec),
 2119    arg(1, Spec, Arg),
 2120    '$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:
 2132:- dynamic
 2133    '$resolved_source_path'/2.                  % ?Spec, ?Path
 2134
 2135'$load_file'(File, Module, Options) :-
 2136    \+ memberchk(stream(_), Options),
 2137    user:prolog_load_file(Module:File, Options),
 2138    !.
 2139'$load_file'(File, Module, Options) :-
 2140    memberchk(stream(_), Options),
 2141    !,
 2142    '$assert_load_context_module'(File, Module, Options),
 2143    '$qdo_load_file'(File, File, Module, Action, Options),
 2144    '$run_initialization'(File, Action, Options).
 2145'$load_file'(File, Module, Options) :-
 2146    '$resolved_source_path'(File, FullFile),
 2147    (   '$source_file_property'(FullFile, from_state, true)
 2148    ;   '$source_file_property'(FullFile, resource, true)
 2149    ;   '$option'(if(If), Options, true),
 2150        '$noload'(If, FullFile, Options)
 2151    ),
 2152    !,
 2153    '$already_loaded'(File, FullFile, Module, Options).
 2154'$load_file'(File, Module, Options) :-
 2155    absolute_file_name(File, FullFile,
 2156                       [ file_type(prolog),
 2157                         access(read)
 2158                       ]),
 2159    '$register_resolved_source_path'(File, FullFile),
 2160    '$mt_load_file'(File, FullFile, Module, Options),
 2161    '$register_resource_file'(FullFile).
 2162
 2163'$register_resolved_source_path'(File, FullFile) :-
 2164    '$resolved_source_path'(File, FullFile),
 2165    !.
 2166'$register_resolved_source_path'(File, FullFile) :-
 2167    compound(File),
 2168    !,
 2169    asserta('$resolved_source_path'(File, FullFile)).
 2170'$register_resolved_source_path'(_, _).
 $translated_source(+Old, +New) is det
Called from loading a QLF state when source files are being renamed.
 2176:- public '$translated_source'/2. 2177'$translated_source'(Old, New) :-
 2178    forall(retract('$resolved_source_path'(File, Old)),
 2179           assertz('$resolved_source_path'(File, 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.
 2186'$register_resource_file'(FullFile) :-
 2187    (   sub_atom(FullFile, 0, _, _, 'res://')
 2188    ->  '$set_source_file'(FullFile, resource, true)
 2189    ;   true
 2190    ).
 $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.
 2203'$already_loaded'(_File, FullFile, Module, Options) :-
 2204    '$assert_load_context_module'(FullFile, Module, Options),
 2205    '$current_module'(LoadModules, FullFile),
 2206    !,
 2207    (   atom(LoadModules)
 2208    ->  LoadModule = LoadModules
 2209    ;   LoadModules = [LoadModule|_]
 2210    ),
 2211    '$import_from_loaded_module'(LoadModule, Module, Options).
 2212'$already_loaded'(_, _, user, _) :- !.
 2213'$already_loaded'(File, _, Module, Options) :-
 2214    '$load_file'(File, Module, [if(true)|Options]).
 $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.

 2229:- dynamic
 2230    '$loading_file'/3.              % File, Queue, Thread
 2231:- volatile
 2232    '$loading_file'/3. 2233
 2234'$mt_load_file'(File, FullFile, Module, Options) :-
 2235    current_prolog_flag(threads, true),
 2236    !,
 2237    setup_call_cleanup(
 2238        with_mutex('$load_file',
 2239                   '$mt_start_load'(FullFile, Loading, Options)),
 2240        '$mt_do_load'(Loading, File, FullFile, Module, Options),
 2241        '$mt_end_load'(Loading)).
 2242'$mt_load_file'(File, FullFile, Module, Options) :-
 2243    '$option'(if(If), Options, true),
 2244    '$noload'(If, FullFile, Options),
 2245    !,
 2246    '$already_loaded'(File, FullFile, Module, Options).
 2247'$mt_load_file'(File, FullFile, Module, Options) :-
 2248    '$qdo_load_file'(File, FullFile, Module, Action, Options),
 2249    '$run_initialization'(FullFile, Action, Options).
 2250
 2251'$mt_start_load'(FullFile, queue(Queue), _) :-
 2252    '$loading_file'(FullFile, Queue, LoadThread),
 2253    \+ thread_self(LoadThread),
 2254    !.
 2255'$mt_start_load'(FullFile, already_loaded, Options) :-
 2256    '$option'(if(If), Options, true),
 2257    '$noload'(If, FullFile, Options),
 2258    !.
 2259'$mt_start_load'(FullFile, Ref, _) :-
 2260    thread_self(Me),
 2261    message_queue_create(Queue),
 2262    assertz('$loading_file'(FullFile, Queue, Me), Ref).
 2263
 2264'$mt_do_load'(queue(Queue), File, FullFile, Module, Options) :-
 2265    !,
 2266    catch(thread_get_message(Queue, _), error(_,_), true),
 2267    '$already_loaded'(File, FullFile, Module, Options).
 2268'$mt_do_load'(already_loaded, File, FullFile, Module, Options) :-
 2269    !,
 2270    '$already_loaded'(File, FullFile, Module, Options).
 2271'$mt_do_load'(_Ref, File, FullFile, Module, Options) :-
 2272    '$assert_load_context_module'(FullFile, Module, Options),
 2273    '$qdo_load_file'(File, FullFile, Module, Action, Options),
 2274    '$run_initialization'(FullFile, Action, Options).
 2275
 2276'$mt_end_load'(queue(_)) :- !.
 2277'$mt_end_load'(already_loaded) :- !.
 2278'$mt_end_load'(Ref) :-
 2279    clause('$loading_file'(_, Queue, _), _, Ref),
 2280    erase(Ref),
 2281    thread_send_message(Queue, done),
 2282    message_queue_destroy(Queue).
 $qdo_load_file(+Spec, +FullFile, +ContextModule, +Options) is det
Switch to qcompile mode if requested by the option '$qlf'(+Out)
 2289'$qdo_load_file'(File, FullFile, Module, Action, Options) :-
 2290    memberchk('$qlf'(QlfOut), Options),
 2291    '$stage_file'(QlfOut, StageQlf),
 2292    !,
 2293    setup_call_catcher_cleanup(
 2294        '$qstart'(StageQlf, Module, State),
 2295        '$do_load_file'(File, FullFile, Module, Action, Options),
 2296        Catcher,
 2297        '$qend'(State, Catcher, StageQlf, QlfOut)).
 2298'$qdo_load_file'(File, FullFile, Module, Action, Options) :-
 2299    '$do_load_file'(File, FullFile, Module, Action, Options).
 2300
 2301'$qstart'(Qlf, Module, state(OldMode, OldModule)) :-
 2302    '$qlf_open'(Qlf),
 2303    '$compilation_mode'(OldMode, qlf),
 2304    '$set_source_module'(OldModule, Module).
 2305
 2306'$qend'(state(OldMode, OldModule), Catcher, StageQlf, QlfOut) :-
 2307    '$set_source_module'(_, OldModule),
 2308    '$set_compilation_mode'(OldMode),
 2309    '$qlf_close',
 2310    '$install_staged_file'(Catcher, StageQlf, QlfOut, warn).
 2311
 2312'$set_source_module'(OldModule, Module) :-
 2313    '$current_source_module'(OldModule),
 2314    '$set_source_module'(Module).
 $do_load_file(+Spec, +FullFile, +ContextModule, -Action, +Options) is det
Perform the actual loading.
 2321'$do_load_file'(File, FullFile, Module, Action, Options) :-
 2322    '$option'(derived_from(DerivedFrom), Options, -),
 2323    '$register_derived_source'(FullFile, DerivedFrom),
 2324    '$qlf_file'(File, FullFile, Absolute, Mode, Options),
 2325    (   Mode == qcompile
 2326    ->  qcompile(Module:File, Options)
 2327    ;   '$do_load_file_2'(File, Absolute, Module, Action, Options)
 2328    ).
 2329
 2330'$do_load_file_2'(File, Absolute, Module, Action, Options) :-
 2331    '$source_file_property'(Absolute, number_of_clauses, OldClauses),
 2332    statistics(cputime, OldTime),
 2333
 2334    '$setup_load'(ScopedFlags, OldSandBoxed, OldVerbose, OldAutoLevel, OldXRef,
 2335                  Options),
 2336
 2337    '$compilation_level'(Level),
 2338    '$load_msg_level'(load_file, Level, StartMsgLevel, DoneMsgLevel),
 2339    '$print_message'(StartMsgLevel,
 2340                     load_file(start(Level,
 2341                                     file(File, Absolute)))),
 2342
 2343    (   memberchk(stream(FromStream), Options)
 2344    ->  Input = stream
 2345    ;   Input = source
 2346    ),
 2347
 2348    (   Input == stream,
 2349        (   '$option'(format(qlf), Options, source)
 2350        ->  set_stream(FromStream, file_name(Absolute)),
 2351            '$qload_stream'(FromStream, Module, Action, LM, Options)
 2352        ;   '$consult_file'(stream(Absolute, FromStream, []),
 2353                            Module, Action, LM, Options)
 2354        )
 2355    ->  true
 2356    ;   Input == source,
 2357        file_name_extension(_, Ext, Absolute),
 2358        (   user:prolog_file_type(Ext, qlf),
 2359            E = error(_,_),
 2360            catch('$qload_file'(Absolute, Module, Action, LM, Options),
 2361                  E,
 2362                  print_message(warning, E))
 2363        ->  true
 2364        ;   '$consult_file'(Absolute, Module, Action, LM, Options)
 2365        )
 2366    ->  true
 2367    ;   '$print_message'(error, load_file(failed(File))),
 2368        fail
 2369    ),
 2370
 2371    '$import_from_loaded_module'(LM, Module, Options),
 2372
 2373    '$source_file_property'(Absolute, number_of_clauses, NewClauses),
 2374    statistics(cputime, Time),
 2375    ClausesCreated is NewClauses - OldClauses,
 2376    TimeUsed is Time - OldTime,
 2377
 2378    '$print_message'(DoneMsgLevel,
 2379                     load_file(done(Level,
 2380                                    file(File, Absolute),
 2381                                    Action,
 2382                                    LM,
 2383                                    TimeUsed,
 2384                                    ClausesCreated))),
 2385
 2386    '$restore_load'(ScopedFlags, OldSandBoxed, OldVerbose, OldAutoLevel, OldXRef).
 2387
 2388'$setup_load'(ScopedFlags, OldSandBoxed, OldVerbose, OldAutoLevel, OldXRef,
 2389              Options) :-
 2390    '$save_file_scoped_flags'(ScopedFlags),
 2391    '$set_sandboxed_load'(Options, OldSandBoxed),
 2392    '$set_verbose_load'(Options, OldVerbose),
 2393    '$set_optimise_load'(Options),
 2394    '$update_autoload_level'(Options, OldAutoLevel),
 2395    '$set_no_xref'(OldXRef).
 2396
 2397'$restore_load'(ScopedFlags, OldSandBoxed, OldVerbose, OldAutoLevel, OldXRef) :-
 2398    '$set_autoload_level'(OldAutoLevel),
 2399    set_prolog_flag(xref, OldXRef),
 2400    set_prolog_flag(verbose_load, OldVerbose),
 2401    set_prolog_flag(sandboxed_load, OldSandBoxed),
 2402    '$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.
 2410'$save_file_scoped_flags'(State) :-
 2411    current_predicate(findall/3),          % Not when doing boot compile
 2412    !,
 2413    findall(SavedFlag, '$save_file_scoped_flag'(SavedFlag), State).
 2414'$save_file_scoped_flags'([]).
 2415
 2416'$save_file_scoped_flag'(Flag-Value) :-
 2417    '$file_scoped_flag'(Flag, Default),
 2418    (   current_prolog_flag(Flag, Value)
 2419    ->  true
 2420    ;   Value = Default
 2421    ).
 2422
 2423'$file_scoped_flag'(generate_debug_info, true).
 2424'$file_scoped_flag'(optimise,            false).
 2425'$file_scoped_flag'(xref,                false).
 2426
 2427'$restore_file_scoped_flags'([]).
 2428'$restore_file_scoped_flags'([Flag-Value|T]) :-
 2429    set_prolog_flag(Flag, Value),
 2430    '$restore_file_scoped_flags'(T).
 $import_from_loaded_module(LoadedModule, Module, Options) is det
Import public predicates from LoadedModule into Module
 2437'$import_from_loaded_module'(LoadedModule, Module, Options) :-
 2438    LoadedModule \== Module,
 2439    atom(LoadedModule),
 2440    !,
 2441    '$option'(imports(Import), Options, all),
 2442    '$option'(reexport(Reexport), Options, false),
 2443    '$import_list'(Module, LoadedModule, Import, Reexport).
 2444'$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.
 2452'$set_verbose_load'(Options, Old) :-
 2453    current_prolog_flag(verbose_load, Old),
 2454    (   memberchk(silent(Silent), Options)
 2455    ->  (   '$negate'(Silent, Level0)
 2456        ->  '$load_msg_compat'(Level0, Level)
 2457        ;   Level = Silent
 2458        ),
 2459        set_prolog_flag(verbose_load, Level)
 2460    ;   true
 2461    ).
 2462
 2463'$negate'(true, false).
 2464'$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, -)
 2473'$set_sandboxed_load'(Options, Old) :-
 2474    current_prolog_flag(sandboxed_load, Old),
 2475    (   memberchk(sandboxed(SandBoxed), Options),
 2476        '$enter_sandboxed'(Old, SandBoxed, New),
 2477        New \== Old
 2478    ->  set_prolog_flag(sandboxed_load, New)
 2479    ;   true
 2480    ).
 2481
 2482'$enter_sandboxed'(Old, New, SandBoxed) :-
 2483    (   Old == false, New == true
 2484    ->  SandBoxed = true,
 2485        '$ensure_loaded_library_sandbox'
 2486    ;   Old == true, New == false
 2487    ->  throw(error(permission_error(leave, sandbox, -), _))
 2488    ;   SandBoxed = Old
 2489    ).
 2490'$enter_sandboxed'(false, true, true).
 2491
 2492'$ensure_loaded_library_sandbox' :-
 2493    source_file_property(library(sandbox), module(sandbox)),
 2494    !.
 2495'$ensure_loaded_library_sandbox' :-
 2496    load_files(library(sandbox), [if(not_loaded), silent(true)]).
 2497
 2498'$set_optimise_load'(Options) :-
 2499    (   '$option'(optimise(Optimise), Options)
 2500    ->  set_prolog_flag(optimise, Optimise)
 2501    ;   true
 2502    ).
 2503
 2504'$set_no_xref'(OldXRef) :-
 2505    (   current_prolog_flag(xref, OldXRef)
 2506    ->  true
 2507    ;   OldXRef = false
 2508    ),
 2509    set_prolog_flag(xref, false).
 $update_autoload_level(+Options, -OldLevel)
Update the '$autoload_nesting' and return the old value.
 2516:- thread_local
 2517    '$autoload_nesting'/1. 2518
 2519'$update_autoload_level'(Options, AutoLevel) :-
 2520    '$option'(autoload(Autoload), Options, false),
 2521    (   '$autoload_nesting'(CurrentLevel)
 2522    ->  AutoLevel = CurrentLevel
 2523    ;   AutoLevel = 0
 2524    ),
 2525    (   Autoload == false
 2526    ->  true
 2527    ;   NewLevel is AutoLevel + 1,
 2528        '$set_autoload_level'(NewLevel)
 2529    ).
 2530
 2531'$set_autoload_level'(New) :-
 2532    retractall('$autoload_nesting'(_)),
 2533    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.
 2541'$print_message'(Level, Term) :-
 2542    current_predicate(system:print_message/2),
 2543    !,
 2544    print_message(Level, Term).
 2545'$print_message'(warning, Term) :-
 2546    source_location(File, Line),
 2547    !,
 2548    format(user_error, 'WARNING: ~w:~w: ~p~n', [File, Line, Term]).
 2549'$print_message'(error, Term) :-
 2550    !,
 2551    source_location(File, Line),
 2552    !,
 2553    format(user_error, 'ERROR: ~w:~w: ~p~n', [File, Line, Term]).
 2554'$print_message'(_Level, _Term).
 2555
 2556'$print_message_fail'(E) :-
 2557    '$print_message'(error, E),
 2558    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.
 2566'$consult_file'(Absolute, Module, What, LM, Options) :-
 2567    '$current_source_module'(Module),   % same module
 2568    !,
 2569    '$consult_file_2'(Absolute, Module, What, LM, Options).
 2570'$consult_file'(Absolute, Module, What, LM, Options) :-
 2571    '$set_source_module'(OldModule, Module),
 2572    '$ifcompiling'('$qlf_start_sub_module'(Module)),
 2573    '$consult_file_2'(Absolute, Module, What, LM, Options),
 2574    '$ifcompiling'('$qlf_end_part'),
 2575    '$set_source_module'(OldModule).
 2576
 2577'$consult_file_2'(Absolute, Module, What, LM, Options) :-
 2578    '$set_source_module'(OldModule, Module),
 2579    '$load_id'(Absolute, Id, Modified, Options),
 2580    '$start_consult'(Id, Modified),
 2581    (   '$derived_source'(Absolute, DerivedFrom, _)
 2582    ->  '$modified_id'(DerivedFrom, DerivedModified, Options),
 2583        '$start_consult'(DerivedFrom, DerivedModified)
 2584    ;   true
 2585    ),
 2586    '$compile_type'(What),
 2587    '$save_lex_state'(LexState, Options),
 2588    '$set_dialect'(Options),
 2589    call_cleanup('$load_file'(Absolute, Id, LM, Options),
 2590                 '$end_consult'(LexState, OldModule)).
 2591
 2592'$end_consult'(LexState, OldModule) :-
 2593    '$restore_lex_state'(LexState),
 2594    '$set_source_module'(OldModule).
 2595
 2596
 2597:- create_prolog_flag(emulated_dialect, swi, [type(atom)]).
 $save_lex_state(-LexState, +Options) is det
 2601'$save_lex_state'(State, Options) :-
 2602    memberchk(scope_settings(false), Options),
 2603    !,
 2604    State = (-).
 2605'$save_lex_state'(lexstate(Style, Dialect), _) :-
 2606    '$style_check'(Style, Style),
 2607    current_prolog_flag(emulated_dialect, Dialect).
 2608
 2609'$restore_lex_state'(-) :- !.
 2610'$restore_lex_state'(lexstate(Style, Dialect)) :-
 2611    '$style_check'(_, Style),
 2612    set_prolog_flag(emulated_dialect, Dialect).
 2613
 2614'$set_dialect'(Options) :-
 2615    memberchk(dialect(Dialect), Options),
 2616    !,
 2617    expects_dialect(Dialect).               % Autoloaded from library
 2618'$set_dialect'(_).
 2619
 2620'$load_id'(stream(Id, _, _), Id, Modified, Options) :-
 2621    !,
 2622    '$modified_id'(Id, Modified, Options).
 2623'$load_id'(Id, Id, Modified, Options) :-
 2624    '$modified_id'(Id, Modified, Options).
 2625
 2626'$modified_id'(_, Modified, Options) :-
 2627    '$option'(modified(Stamp), Options, Def),
 2628    Stamp \== Def,
 2629    !,
 2630    Modified = Stamp.
 2631'$modified_id'(Id, Modified, _) :-
 2632    catch(time_file(Id, Modified),
 2633          error(_, _),
 2634          fail),
 2635    !.
 2636'$modified_id'(_, 0.0, _).
 2637
 2638
 2639'$compile_type'(What) :-
 2640    '$compilation_mode'(How),
 2641    (   How == database
 2642    ->  What = compiled
 2643    ;   How == qlf
 2644    ->  What = '*qcompiled*'
 2645    ;   What = 'boot compiled'
 2646    ).
 $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.
 2656:- dynamic
 2657    '$load_context_module'/3. 2658:- multifile
 2659    '$load_context_module'/3. 2660
 2661'$assert_load_context_module'(_, _, Options) :-
 2662    memberchk(register(false), Options),
 2663    !.
 2664'$assert_load_context_module'(File, Module, Options) :-
 2665    source_location(FromFile, Line),
 2666    !,
 2667    '$master_file'(FromFile, MasterFile),
 2668    '$check_load_non_module'(File, Module),
 2669    '$add_dialect'(Options, Options1),
 2670    '$load_ctx_options'(Options1, Options2),
 2671    '$store_admin_clause'(
 2672        system:'$load_context_module'(File, Module, Options2),
 2673        _Layout, MasterFile, FromFile:Line).
 2674'$assert_load_context_module'(File, Module, Options) :-
 2675    '$check_load_non_module'(File, Module),
 2676    '$add_dialect'(Options, Options1),
 2677    '$load_ctx_options'(Options1, Options2),
 2678    (   clause('$load_context_module'(File, Module, _), true, Ref),
 2679        \+ clause_property(Ref, file(_)),
 2680        erase(Ref)
 2681    ->  true
 2682    ;   true
 2683    ),
 2684    assertz('$load_context_module'(File, Module, Options2)).
 2685
 2686'$add_dialect'(Options0, Options) :-
 2687    current_prolog_flag(emulated_dialect, Dialect), Dialect \== swi,
 2688    !,
 2689    Options = [dialect(Dialect)|Options0].
 2690'$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.
 2697'$load_ctx_options'([], []).
 2698'$load_ctx_options'([H|T0], [H|T]) :-
 2699    '$load_ctx_option'(H),
 2700    !,
 2701    '$load_ctx_options'(T0, T).
 2702'$load_ctx_options'([_|T0], T) :-
 2703    '$load_ctx_options'(T0, T).
 2704
 2705'$load_ctx_option'(derived_from(_)).
 2706'$load_ctx_option'(dialect(_)).
 2707'$load_ctx_option'(encoding(_)).
 2708'$load_ctx_option'(imports(_)).
 2709'$load_ctx_option'(reexport(_)).
 $check_load_non_module(+File) is det
Test that a non-module file is not loaded into multiple contexts.
 2717'$check_load_non_module'(File, _) :-
 2718    '$current_module'(_, File),
 2719    !.          % File is a module file
 2720'$check_load_non_module'(File, Module) :-
 2721    '$load_context_module'(File, OldModule, _),
 2722    Module \== OldModule,
 2723    !,
 2724    format(atom(Msg),
 2725           'Non-module file already loaded into module ~w; \c
 2726               trying to load into ~w',
 2727           [OldModule, Module]),
 2728    throw(error(permission_error(load, source, File),
 2729                context(load_files/2, Msg))).
 2730'$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)
 2743'$load_file'(Path, Id, Module, Options) :-
 2744    State = state(true, _, true, false, Id, -),
 2745    (   '$source_term'(Path, _Read, _Layout, Term, Layout,
 2746                       _Stream, Options),
 2747        '$valid_term'(Term),
 2748        (   arg(1, State, true)
 2749        ->  '$first_term'(Term, Layout, Id, State, Options),
 2750            nb_setarg(1, State, false)
 2751        ;   '$compile_term'(Term, Layout, Id)
 2752        ),
 2753        arg(4, State, true)
 2754    ;   '$end_load_file'(State)
 2755    ),
 2756    !,
 2757    arg(2, State, Module).
 2758
 2759'$valid_term'(Var) :-
 2760    var(Var),
 2761    !,
 2762    print_message(error, error(instantiation_error, _)).
 2763'$valid_term'(Term) :-
 2764    Term \== [].
 2765
 2766'$end_load_file'(State) :-
 2767    arg(1, State, true),           % empty file
 2768    !,
 2769    nb_setarg(2, State, Module),
 2770    arg(5, State, Id),
 2771    '$current_source_module'(Module),
 2772    '$ifcompiling'('$qlf_start_file'(Id)),
 2773    '$ifcompiling'('$qlf_end_part').
 2774'$end_load_file'(State) :-
 2775    arg(3, State, End),
 2776    '$end_load_file'(End, State).
 2777
 2778'$end_load_file'(true, _).
 2779'$end_load_file'(end_module, State) :-
 2780    arg(2, State, Module),
 2781    '$check_export'(Module),
 2782    '$ifcompiling'('$qlf_end_part').
 2783'$end_load_file'(end_non_module, _State) :-
 2784    '$ifcompiling'('$qlf_end_part').
 2785
 2786
 2787'$first_term'(?-(Directive), Layout, Id, State, Options) :-
 2788    !,
 2789    '$first_term'(:-(Directive), Layout, Id, State, Options).
 2790'$first_term'(:-(Directive), _Layout, Id, State, Options) :-
 2791    nonvar(Directive),
 2792    (   (   Directive = module(Name, Public)
 2793        ->  Imports = []
 2794        ;   Directive = module(Name, Public, Imports)
 2795        )
 2796    ->  !,
 2797        '$module_name'(Name, Id, Module, Options),
 2798        '$start_module'(Module, Public, State, Options),
 2799        '$module3'(Imports)
 2800    ;   Directive = expects_dialect(Dialect)
 2801    ->  !,
 2802        '$set_dialect'(Dialect, State),
 2803        fail                        % Still consider next term as first
 2804    ).
 2805'$first_term'(Term, Layout, Id, State, Options) :-
 2806    '$start_non_module'(Id, State, Options),
 2807    '$compile_term'(Term, Layout, Id).
 2808
 2809'$compile_term'(Term, Layout, Id) :-
 2810    '$compile_term'(Term, Layout, Id, -).
 2811
 2812'$compile_term'(Var, _Layout, _Id, _Src) :-
 2813    var(Var),
 2814    !,
 2815    '$instantiation_error'(Var).
 2816'$compile_term'((?-Directive), _Layout, Id, _) :-
 2817    !,
 2818    '$execute_directive'(Directive, Id).
 2819'$compile_term'((:-Directive), _Layout, Id, _) :-
 2820    !,
 2821    '$execute_directive'(Directive, Id).
 2822'$compile_term'('$source_location'(File, Line):Term, Layout, Id, _) :-
 2823    !,
 2824    '$compile_term'(Term, Layout, Id, File:Line).
 2825'$compile_term'(Clause, Layout, Id, SrcLoc) :-
 2826    E = error(_,_),
 2827    catch('$store_clause'(Clause, Layout, Id, SrcLoc), E,
 2828          '$print_message'(error, E)).
 2829
 2830'$start_non_module'(Id, _State, Options) :-
 2831    '$option'(must_be_module(true), Options, false),
 2832    !,
 2833    throw(error(domain_error(module_file, Id), _)).
 2834'$start_non_module'(Id, State, _Options) :-
 2835    '$current_source_module'(Module),
 2836    '$ifcompiling'('$qlf_start_file'(Id)),
 2837    '$qset_dialect'(State),
 2838    nb_setarg(2, State, Module),
 2839    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.

 2852'$set_dialect'(Dialect, State) :-
 2853    '$compilation_mode'(qlf, database),
 2854    !,
 2855    expects_dialect(Dialect),
 2856    '$compilation_mode'(_, qlf),
 2857    nb_setarg(6, State, Dialect).
 2858'$set_dialect'(Dialect, _) :-
 2859    expects_dialect(Dialect).
 2860
 2861'$qset_dialect'(State) :-
 2862    '$compilation_mode'(qlf),
 2863    arg(6, State, Dialect), Dialect \== (-),
 2864    !,
 2865    '$add_directive_wic'(expects_dialect(Dialect)).
 2866'$qset_dialect'(_).
 2867
 2868
 2869                 /*******************************
 2870                 *           MODULES            *
 2871                 *******************************/
 2872
 2873'$start_module'(Module, _Public, State, _Options) :-
 2874    '$current_module'(Module, OldFile),
 2875    source_location(File, _Line),
 2876    OldFile \== File, OldFile \== [],
 2877    same_file(OldFile, File),
 2878    !,
 2879    nb_setarg(2, State, Module),
 2880    nb_setarg(4, State, true).      % Stop processing
 2881'$start_module'(Module, Public, State, Options) :-
 2882    arg(5, State, File),
 2883    nb_setarg(2, State, Module),
 2884    source_location(_File, Line),
 2885    '$option'(redefine_module(Action), Options, false),
 2886    '$module_class'(File, Class, Super),
 2887    '$redefine_module'(Module, File, Action),
 2888    '$declare_module'(Module, Class, Super, File, Line, false),
 2889    '$export_list'(Public, Module, Ops),
 2890    '$ifcompiling'('$qlf_start_module'(Module)),
 2891    '$export_ops'(Ops, Module, File),
 2892    '$qset_dialect'(State),
 2893    nb_setarg(3, State, end_module).
 $module3(+Spec) is det
Handle the 3th argument of a module declartion.
 2900'$module3'(Var) :-
 2901    var(Var),
 2902    !,
 2903    '$instantiation_error'(Var).
 2904'$module3'([]) :- !.
 2905'$module3'([H|T]) :-
 2906    !,
 2907    '$module3'(H),
 2908    '$module3'(T).
 2909'$module3'(Id) :-
 2910    use_module(library(dialect/Id)).
 $module_name(?Name, +Id, -Module, +Options) is semidet
Determine the module name. There are some cases:
 2924'$module_name'(_, _, Module, Options) :-
 2925    '$option'(module(Module), Options),
 2926    !,
 2927    '$current_source_module'(Context),
 2928    Context \== Module.                     % cause '$first_term'/5 to fail.
 2929'$module_name'(Var, Id, Module, Options) :-
 2930    var(Var),
 2931    !,
 2932    file_base_name(Id, File),
 2933    file_name_extension(Var, _, File),
 2934    '$module_name'(Var, Id, Module, Options).
 2935'$module_name'(Reserved, _, _, _) :-
 2936    '$reserved_module'(Reserved),
 2937    !,
 2938    throw(error(permission_error(load, module, Reserved), _)).
 2939'$module_name'(Module, _Id, Module, _).
 2940
 2941
 2942'$reserved_module'(system).
 2943'$reserved_module'(user).
 $redefine_module(+Module, +File, -Redefine)
 2948'$redefine_module'(_Module, _, false) :- !.
 2949'$redefine_module'(Module, File, true) :-
 2950    !,
 2951    (   module_property(Module, file(OldFile)),
 2952        File \== OldFile
 2953    ->  unload_file(OldFile)
 2954    ;   true
 2955    ).
 2956'$redefine_module'(Module, File, ask) :-
 2957    (   stream_property(user_input, tty(true)),
 2958        module_property(Module, file(OldFile)),
 2959        File \== OldFile,
 2960        '$rdef_response'(Module, OldFile, File, true)
 2961    ->  '$redefine_module'(Module, File, true)
 2962    ;   true
 2963    ).
 2964
 2965'$rdef_response'(Module, OldFile, File, Ok) :-
 2966    repeat,
 2967    print_message(query, redefine_module(Module, OldFile, File)),
 2968    get_single_char(Char),
 2969    '$rdef_response'(Char, Ok0),
 2970    !,
 2971    Ok = Ok0.
 2972
 2973'$rdef_response'(Char, true) :-
 2974    memberchk(Char, `yY`),
 2975    format(user_error, 'yes~n', []).
 2976'$rdef_response'(Char, false) :-
 2977    memberchk(Char, `nN`),
 2978    format(user_error, 'no~n', []).
 2979'$rdef_response'(Char, _) :-
 2980    memberchk(Char, `a`),
 2981    format(user_error, 'abort~n', []),
 2982    abort.
 2983'$rdef_response'(_, _) :-
 2984    print_message(help, redefine_module_reply),
 2985    fail.
 $module_class(+File, -Class, -Super) is det
Determine the initial module from which I inherit. All system and library modules inherit from system, while all normal user modules inherit from user.
 2994'$module_class'(File, Class, system) :-
 2995    current_prolog_flag(home, Home),
 2996    sub_atom(File, 0, Len, _, Home),
 2997    !,
 2998    (   sub_atom(File, Len, _, _, '/boot/')
 2999    ->  Class = system
 3000    ;   Class = library
 3001    ).
 3002'$module_class'(_, user, user).
 3003
 3004'$check_export'(Module) :-
 3005    '$undefined_export'(Module, UndefList),
 3006    (   '$member'(Undef, UndefList),
 3007        strip_module(Undef, _, Local),
 3008        print_message(error,
 3009                      undefined_export(Module, Local)),
 3010        fail
 3011    ;   true
 3012    ).
 $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).
 3021'$import_list'(_, _, Var, _) :-
 3022    var(Var),
 3023    !,
 3024    throw(error(instantitation_error, _)).
 3025'$import_list'(Target, Source, all, Reexport) :-
 3026    !,
 3027    '$exported_ops'(Source, Import, Predicates),
 3028    '$module_property'(Source, exports(Predicates)),
 3029    '$import_all'(Import, Target, Source, Reexport, weak).
 3030'$import_list'(Target, Source, except(Spec), Reexport) :-
 3031    !,
 3032    '$exported_ops'(Source, Export, Predicates),
 3033    '$module_property'(Source, exports(Predicates)),
 3034    (   is_list(Spec)
 3035    ->  true
 3036    ;   throw(error(type_error(list, Spec), _))
 3037    ),
 3038    '$import_except'(Spec, Export, Import),
 3039    '$import_all'(Import, Target, Source, Reexport, weak).
 3040'$import_list'(Target, Source, Import, Reexport) :-
 3041    !,
 3042    is_list(Import),
 3043    !,
 3044    '$import_all'(Import, Target, Source, Reexport, strong).
 3045'$import_list'(_, _, Import, _) :-
 3046    throw(error(type_error(import_specifier, Import))).
 3047
 3048
 3049'$import_except'([], List, List).
 3050'$import_except'([H|T], List0, List) :-
 3051    '$import_except_1'(H, List0, List1),
 3052    '$import_except'(T, List1, List).
 3053
 3054'$import_except_1'(Var, _, _) :-
 3055    var(Var),
 3056    !,
 3057    throw(error(instantitation_error, _)).
 3058'$import_except_1'(PI as N, List0, List) :-
 3059    '$pi'(PI), atom(N),
 3060    !,
 3061    '$canonical_pi'(PI, CPI),
 3062    '$import_as'(CPI, N, List0, List).
 3063'$import_except_1'(op(P,A,N), List0, List) :-
 3064    !,
 3065    '$remove_ops'(List0, op(P,A,N), List).
 3066'$import_except_1'(PI, List0, List) :-
 3067    '$pi'(PI),
 3068    !,
 3069    '$canonical_pi'(PI, CPI),
 3070    '$select'(P, List0, List),
 3071    '$canonical_pi'(CPI, P),
 3072    !.
 3073'$import_except_1'(Except, _, _) :-
 3074    throw(error(type_error(import_specifier, Except), _)).
 3075
 3076'$import_as'(CPI, N, [PI2|T], [CPI as N|T]) :-
 3077    '$canonical_pi'(PI2, CPI),
 3078    !.
 3079'$import_as'(PI, N, [H|T0], [H|T]) :-
 3080    !,
 3081    '$import_as'(PI, N, T0, T).
 3082'$import_as'(PI, _, _, _) :-
 3083    throw(error(existence_error(export, PI), _)).
 3084
 3085'$pi'(N/A) :- atom(N), integer(A), !.
 3086'$pi'(N//A) :- atom(N), integer(A).
 3087
 3088'$canonical_pi'(N//A0, N/A) :-
 3089    A is A0 + 2.
 3090'$canonical_pi'(PI, PI).
 3091
 3092'$remove_ops'([], _, []).
 3093'$remove_ops'([Op|T0], Pattern, T) :-
 3094    subsumes_term(Pattern, Op),
 3095    !,
 3096    '$remove_ops'(T0, Pattern, T).
 3097'$remove_ops'([H|T0], Pattern, [H|T]) :-
 3098    '$remove_ops'(T0, Pattern, T).
 $import_all(+Import, +Context, +Source, +Reexport, +Strength)
 3103'$import_all'(Import, Context, Source, Reexport, Strength) :-
 3104    '$import_all2'(Import, Context, Source, Imported, ImpOps, Strength),
 3105    (   Reexport == true,
 3106        (   '$list_to_conj'(Imported, Conj)
 3107        ->  export(Context:Conj),
 3108            '$ifcompiling'('$add_directive_wic'(export(Context:Conj)))
 3109        ;   true
 3110        ),
 3111        source_location(File, _Line),
 3112        '$export_ops'(ImpOps, Context, File)
 3113    ;   true
 3114    ).
 $import_all2(+Imports, +Context, +Source, -Imported, -ImpOps, +Strength)
 3118'$import_all2'([], _, _, [], [], _).
 3119'$import_all2'([PI as NewName|Rest], Context, Source,
 3120               [NewName/Arity|Imported], ImpOps, Strength) :-
 3121    !,
 3122    '$canonical_pi'(PI, Name/Arity),
 3123    length(Args, Arity),
 3124    Head =.. [Name|Args],
 3125    NewHead =.. [NewName|Args],
 3126    (   '$get_predicate_attribute'(Source:Head, transparent, 1)
 3127    ->  '$set_predicate_attribute'(Context:NewHead, transparent, true)
 3128    ;   true
 3129    ),
 3130    (   source_location(File, Line)
 3131    ->  E = error(_,_),
 3132        catch('$store_admin_clause'((NewHead :- Source:Head),
 3133                                    _Layout, File, File:Line),
 3134              E, '$print_message'(error, E))
 3135    ;   assertz((NewHead :- !, Source:Head)) % ! avoids problems with
 3136    ),                                       % duplicate load
 3137    '$import_all2'(Rest, Context, Source, Imported, ImpOps, Strength).
 3138'$import_all2'([op(P,A,N)|Rest], Context, Source, Imported,
 3139               [op(P,A,N)|ImpOps], Strength) :-
 3140    !,
 3141    '$import_ops'(Context, Source, op(P,A,N)),
 3142    '$import_all2'(Rest, Context, Source, Imported, ImpOps, Strength).
 3143'$import_all2'([Pred|Rest], Context, Source, [Pred|Imported], ImpOps, Strength) :-
 3144    Error = error(_,_),
 3145    catch(Context:'$import'(Source:Pred, Strength), Error,
 3146          print_message(error, Error)),
 3147    '$ifcompiling'('$import_wic'(Source, Pred, Strength)),
 3148    '$import_all2'(Rest, Context, Source, Imported, ImpOps, Strength).
 3149
 3150
 3151'$list_to_conj'([One], One) :- !.
 3152'$list_to_conj'([H|T], (H,Rest)) :-
 3153    '$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.
 3160'$exported_ops'(Module, Ops, Tail) :-
 3161    '$c_current_predicate'(_, Module:'$exported_op'(_,_,_)),
 3162    !,
 3163    findall(op(P,A,N), Module:'$exported_op'(P,A,N), Ops, Tail).
 3164'$exported_ops'(_, Ops, Ops).
 3165
 3166'$exported_op'(Module, P, A, N) :-
 3167    '$c_current_predicate'(_, Module:'$exported_op'(_,_,_)),
 3168    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.
 3175'$import_ops'(To, From, Pattern) :-
 3176    ground(Pattern),
 3177    !,
 3178    Pattern = op(P,A,N),
 3179    op(P,A,To:N),
 3180    (   '$exported_op'(From, P, A, N)
 3181    ->  true
 3182    ;   print_message(warning, no_exported_op(From, Pattern))
 3183    ).
 3184'$import_ops'(To, From, Pattern) :-
 3185    (   '$exported_op'(From, Pri, Assoc, Name),
 3186        Pattern = op(Pri, Assoc, Name),
 3187        op(Pri, Assoc, To:Name),
 3188        fail
 3189    ;   true
 3190    ).
 $export_list(+Declarations, +Module, -Ops)
Handle the export list of the module declaration for Module associated to File.
 3198'$export_list'(Decls, Module, Ops) :-
 3199    is_list(Decls),
 3200    !,
 3201    '$do_export_list'(Decls, Module, Ops).
 3202'$export_list'(Decls, _, _) :-
 3203    var(Decls),
 3204    throw(error(instantiation_error, _)).
 3205'$export_list'(Decls, _, _) :-
 3206    throw(error(type_error(list, Decls), _)).
 3207
 3208'$do_export_list'([], _, []) :- !.
 3209'$do_export_list'([H|T], Module, Ops) :-
 3210    !,
 3211    E = error(_,_),
 3212    catch('$export1'(H, Module, Ops, Ops1),
 3213          E, ('$print_message'(error, E), Ops = Ops1)),
 3214    '$do_export_list'(T, Module, Ops1).
 3215
 3216'$export1'(Var, _, _, _) :-
 3217    var(Var),
 3218    !,
 3219    throw(error(instantiation_error, _)).
 3220'$export1'(Op, _, [Op|T], T) :-
 3221    Op = op(_,_,_),
 3222    !.
 3223'$export1'(PI0, Module, Ops, Ops) :-
 3224    strip_module(Module:PI0, M, PI),
 3225    (   PI = (_//_)
 3226    ->  non_terminal(M:PI)
 3227    ;   true
 3228    ),
 3229    export(M:PI).
 3230
 3231'$export_ops'([op(Pri, Assoc, Name)|T], Module, File) :-
 3232    E = error(_,_),
 3233    catch(( '$execute_directive'(op(Pri, Assoc, Module:Name), File),
 3234            '$export_op'(Pri, Assoc, Name, Module, File)
 3235          ),
 3236          E, '$print_message'(error, E)),
 3237    '$export_ops'(T, Module, File).
 3238'$export_ops'([], _, _).
 3239
 3240'$export_op'(Pri, Assoc, Name, Module, File) :-
 3241    (   '$get_predicate_attribute'(Module:'$exported_op'(_,_,_), defined, 1)
 3242    ->  true
 3243    ;   '$execute_directive'(discontiguous(Module:'$exported_op'/3), File)
 3244    ),
 3245    '$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.
 3251'$execute_directive'(Goal, F) :-
 3252    '$execute_directive_2'(Goal, F).
 3253
 3254'$execute_directive_2'(encoding(Encoding), _F) :-
 3255    !,
 3256    (   '$load_input'(_F, S)
 3257    ->  set_stream(S, encoding(Encoding))
 3258    ).
 3259'$execute_directive_2'(Goal, _) :-
 3260    \+ '$compilation_mode'(database),
 3261    !,
 3262    '$add_directive_wic2'(Goal, Type),
 3263    (   Type == call                % suspend compiling into .qlf file
 3264    ->  '$compilation_mode'(Old, database),
 3265        setup_call_cleanup(
 3266            '$directive_mode'(OldDir, Old),
 3267            '$execute_directive_3'(Goal),
 3268            ( '$set_compilation_mode'(Old),
 3269              '$set_directive_mode'(OldDir)
 3270            ))
 3271    ;   '$execute_directive_3'(Goal)
 3272    ).
 3273'$execute_directive_2'(Goal, _) :-
 3274    '$execute_directive_3'(Goal).
 3275
 3276'$execute_directive_3'(Goal) :-
 3277    '$current_source_module'(Module),
 3278    '$valid_directive'(Module:Goal),
 3279    !,
 3280    (   '$pattr_directive'(Goal, Module)
 3281    ->  true
 3282    ;   Term = error(_,_),
 3283        catch(Module:Goal, Term, '$exception_in_directive'(Term))
 3284    ->  true
 3285    ;   '$print_message'(warning, goal_failed(directive, Module:Goal)),
 3286        fail
 3287    ).
 3288'$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.
 3297:- multifile prolog:sandbox_allowed_directive/1. 3298:- multifile prolog:sandbox_allowed_clause/1. 3299:- meta_predicate '$valid_directive'(:). 3300
 3301'$valid_directive'(_) :-
 3302    current_prolog_flag(sandboxed_load, false),
 3303    !.
 3304'$valid_directive'(Goal) :-
 3305    Error = error(Formal, _),
 3306    catch(prolog:sandbox_allowed_directive(Goal), Error, true),
 3307    !,
 3308    (   var(Formal)
 3309    ->  true
 3310    ;   print_message(error, Error),
 3311        fail
 3312    ).
 3313'$valid_directive'(Goal) :-
 3314    print_message(error,
 3315                  error(permission_error(execute,
 3316                                         sandboxed_directive,
 3317                                         Goal), _)),
 3318    fail.
 3319
 3320'$exception_in_directive'(Term) :-
 3321    '$print_message'(error, Term),
 3322    fail.
 3323
 3324%       Note that the list, consult and ensure_loaded directives are already
 3325%       handled at compile time and therefore should not go into the
 3326%       intermediate code file.
 3327
 3328'$add_directive_wic2'(Goal, Type) :-
 3329    '$common_goal_type'(Goal, Type),
 3330    !,
 3331    (   Type == load
 3332    ->  true
 3333    ;   '$current_source_module'(Module),
 3334        '$add_directive_wic'(Module:Goal)
 3335    ).
 3336'$add_directive_wic2'(Goal, _) :-
 3337    (   '$compilation_mode'(qlf)    % no problem for qlf files
 3338    ->  true
 3339    ;   print_message(error, mixed_directive(Goal))
 3340    ).
 3341
 3342'$common_goal_type'((A,B), Type) :-
 3343    !,
 3344    '$common_goal_type'(A, Type),
 3345    '$common_goal_type'(B, Type).
 3346'$common_goal_type'((A;B), Type) :-
 3347    !,
 3348    '$common_goal_type'(A, Type),
 3349    '$common_goal_type'(B, Type).
 3350'$common_goal_type'((A->B), Type) :-
 3351    !,
 3352    '$common_goal_type'(A, Type),
 3353    '$common_goal_type'(B, Type).
 3354'$common_goal_type'(Goal, Type) :-
 3355    '$goal_type'(Goal, Type).
 3356
 3357'$goal_type'(Goal, Type) :-
 3358    (   '$load_goal'(Goal)
 3359    ->  Type = load
 3360    ;   Type = call
 3361    ).
 3362
 3363'$load_goal'([_|_]).
 3364'$load_goal'(consult(_)).
 3365'$load_goal'(load_files(_)).
 3366'$load_goal'(load_files(_,Options)) :-
 3367    memberchk(qcompile(QlfMode), Options),
 3368    '$qlf_part_mode'(QlfMode).
 3369'$load_goal'(ensure_loaded(_)) :- '$compilation_mode'(wic).
 3370'$load_goal'(use_module(_))    :- '$compilation_mode'(wic).
 3371'$load_goal'(use_module(_, _)) :- '$compilation_mode'(wic).
 3372
 3373'$qlf_part_mode'(part).
 3374'$qlf_part_mode'(true).                 % compatibility
 3375
 3376
 3377                /********************************
 3378                *        COMPILE A CLAUSE       *
 3379                *********************************/
 $store_admin_clause(+Clause, ?Layout, +Owner, +SrcLoc) is det
Store a clause into the database for administrative purposes. This bypasses sanity checking.
 3386'$store_admin_clause'(Clause, Layout, Owner, SrcLoc) :-
 3387    Owner \== (-),
 3388    !,
 3389    setup_call_cleanup(
 3390        '$start_aux'(Owner, Context),
 3391        '$store_admin_clause2'(Clause, Layout, Owner, SrcLoc),
 3392        '$end_aux'(Owner, Context)).
 3393'$store_admin_clause'(Clause, Layout, File, SrcLoc) :-
 3394    '$store_admin_clause2'(Clause, Layout, File, SrcLoc).
 3395
 3396'$store_admin_clause2'(Clause, _Layout, File, SrcLoc) :-
 3397    (   '$compilation_mode'(database)
 3398    ->  '$record_clause'(Clause, File, SrcLoc)
 3399    ;   '$record_clause'(Clause, File, SrcLoc, Ref),
 3400        '$qlf_assert_clause'(Ref, development)
 3401    ).
 $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.
 3411'$store_clause'((_, _), _, _, _) :-
 3412    !,
 3413    print_message(error, cannot_redefine_comma),
 3414    fail.
 3415'$store_clause'(Clause, _Layout, File, SrcLoc) :-
 3416    '$valid_clause'(Clause),
 3417    !,
 3418    (   '$compilation_mode'(database)
 3419    ->  '$record_clause'(Clause, File, SrcLoc)
 3420    ;   '$record_clause'(Clause, File, SrcLoc, Ref),
 3421        '$qlf_assert_clause'(Ref, development)
 3422    ).
 3423
 3424'$valid_clause'(_) :-
 3425    current_prolog_flag(sandboxed_load, false),
 3426    !.
 3427'$valid_clause'(Clause) :-
 3428    \+ '$cross_module_clause'(Clause),
 3429    !.
 3430'$valid_clause'(Clause) :-
 3431    Error = error(Formal, _),
 3432    catch(prolog:sandbox_allowed_clause(Clause), Error, true),
 3433    !,
 3434    (   var(Formal)
 3435    ->  true
 3436    ;   print_message(error, Error),
 3437        fail
 3438    ).
 3439'$valid_clause'(Clause) :-
 3440    print_message(error,
 3441                  error(permission_error(assert,
 3442                                         sandboxed_clause,
 3443                                         Clause), _)),
 3444    fail.
 3445
 3446'$cross_module_clause'(Clause) :-
 3447    '$head_module'(Clause, Module),
 3448    \+ '$current_source_module'(Module).
 3449
 3450'$head_module'(Var, _) :-
 3451    var(Var), !, fail.
 3452'$head_module'((Head :- _), Module) :-
 3453    '$head_module'(Head, Module).
 3454'$head_module'(Module:_, Module).
 3455
 3456'$clause_source'('$source_location'(File,Line):Clause, Clause, File:Line) :- !.
 3457'$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.
 3464:- public
 3465    '$store_clause'/2. 3466
 3467'$store_clause'(Term, Id) :-
 3468    '$clause_source'(Term, Clause, SrcLoc),
 3469    '$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?
 3490compile_aux_clauses(_Clauses) :-
 3491    current_prolog_flag(xref, true),
 3492    !.
 3493compile_aux_clauses(Clauses) :-
 3494    source_location(File, _Line),
 3495    '$compile_aux_clauses'(Clauses, File).
 3496
 3497'$compile_aux_clauses'(Clauses, File) :-
 3498    setup_call_cleanup(
 3499        '$start_aux'(File, Context),
 3500        '$store_aux_clauses'(Clauses, File),
 3501        '$end_aux'(File, Context)).
 3502
 3503'$store_aux_clauses'(Clauses, File) :-
 3504    is_list(Clauses),
 3505    !,
 3506    forall('$member'(C,Clauses),
 3507           '$compile_term'(C, _Layout, File)).
 3508'$store_aux_clauses'(Clause, File) :-
 3509    '$compile_term'(Clause, _Layout, File).
 3510
 3511
 3512		 /*******************************
 3513		 *            STAGING		*
 3514		 *******************************/
 $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.
 3524'$stage_file'(Target, Stage) :-
 3525    file_directory_name(Target, Dir),
 3526    file_base_name(Target, File),
 3527    current_prolog_flag(pid, Pid),
 3528    format(atom(Stage), '~w/.~w.~d', [Dir,File,Pid]).
 3529
 3530'$install_staged_file'(exit, Staged, Target, error) :-
 3531    !,
 3532    rename_file(Staged, Target).
 3533'$install_staged_file'(exit, Staged, Target, OnError) :-
 3534    !,
 3535    InstallError = error(_,_),
 3536    catch(rename_file(Staged, Target),
 3537          InstallError,
 3538          '$install_staged_error'(OnError, InstallError, Staged, Target)).
 3539'$install_staged_file'(_, Staged, _, _OnError) :-
 3540    E = error(_,_),
 3541    catch(delete_file(Staged), E, true).
 3542
 3543'$install_staged_error'(OnError, Error, Staged, _Target) :-
 3544    E = error(_,_),
 3545    catch(delete_file(Staged), E, true),
 3546    (   OnError = silent
 3547    ->  true
 3548    ;   OnError = fail
 3549    ->  fail
 3550    ;   print_message(warning, Error)
 3551    ).
 3552
 3553
 3554                 /*******************************
 3555                 *             READING          *
 3556                 *******************************/
 3557
 3558:- multifile
 3559    prolog:comment_hook/3.                  % hook for read_clause/3
 3560
 3561
 3562                 /*******************************
 3563                 *       FOREIGN INTERFACE      *
 3564                 *******************************/
 3565
 3566%       call-back from PL_register_foreign().  First argument is the module
 3567%       into which the foreign predicate is loaded and second is a term
 3568%       describing the arguments.
 3569
 3570:- dynamic
 3571    '$foreign_registered'/2. 3572
 3573                 /*******************************
 3574                 *   TEMPORARY TERM EXPANSION   *
 3575                 *******************************/
 3576
 3577% Provide temporary definitions for the boot-loader.  These are replaced
 3578% by the real thing in load.pl
 3579
 3580:- dynamic
 3581    '$expand_goal'/2,
 3582    '$expand_term'/4. 3583
 3584'$expand_goal'(In, In).
 3585'$expand_term'(In, Layout, In, Layout).
 3586
 3587
 3588                 /*******************************
 3589                 *         TYPE SUPPORT         *
 3590                 *******************************/
 3591
 3592'$type_error'(Type, Value) :-
 3593    (   var(Value)
 3594    ->  throw(error(instantiation_error, _))
 3595    ;   throw(error(type_error(Type, Value), _))
 3596    ).
 3597
 3598'$domain_error'(Type, Value) :-
 3599    throw(error(domain_error(Type, Value), _)).
 3600
 3601'$existence_error'(Type, Object) :-
 3602    throw(error(existence_error(Type, Object), _)).
 3603
 3604'$permission_error'(Action, Type, Term) :-
 3605    throw(error(permission_error(Action, Type, Term), _)).
 3606
 3607'$instantiation_error'(_Var) :-
 3608    throw(error(instantiation_error, _)).
 3609
 3610'$uninstantiation_error'(NonVar) :-
 3611    throw(error(uninstantiation_error(NonVar), _)).
 3612
 3613'$must_be'(list, X) :- !,
 3614    '$skip_list'(_, X, Tail),
 3615    (   Tail == []
 3616    ->  true
 3617    ;   '$type_error'(list, Tail)
 3618    ).
 3619'$must_be'(options, X) :- !,
 3620    (   '$is_options'(X)
 3621    ->  true
 3622    ;   '$type_error'(options, X)
 3623    ).
 3624'$must_be'(atom, X) :- !,
 3625    (   atom(X)
 3626    ->  true
 3627    ;   '$type_error'(atom, X)
 3628    ).
 3629'$must_be'(integer, X) :- !,
 3630    (   integer(X)
 3631    ->  true
 3632    ;   '$type_error'(integer, X)
 3633    ).
 3634'$must_be'(between(Low,High), X) :- !,
 3635    (   integer(X)
 3636    ->  (   between(Low, High, X)
 3637        ->  true
 3638        ;   '$domain_error'(between(Low,High), X)
 3639        )
 3640    ;   '$type_error'(integer, X)
 3641    ).
 3642'$must_be'(callable, X) :- !,
 3643    (   callable(X)
 3644    ->  true
 3645    ;   '$type_error'(callable, X)
 3646    ).
 3647'$must_be'(oneof(Type, Domain, List), X) :- !,
 3648    '$must_be'(Type, X),
 3649    (   memberchk(X, List)
 3650    ->  true
 3651    ;   '$domain_error'(Domain, X)
 3652    ).
 3653'$must_be'(boolean, X) :- !,
 3654    (   (X == true ; X == false)
 3655    ->  true
 3656    ;   '$type_error'(boolean, X)
 3657    ).
 3658'$must_be'(ground, X) :- !,
 3659    (   ground(X)
 3660    ->  true
 3661    ;   '$instantiation_error'(X)
 3662    ).
 3663% Use for debugging
 3664%'$must_be'(Type, _X) :- format('Unknown $must_be type: ~q~n', [Type]).
 3665
 3666
 3667                /********************************
 3668                *       LIST PROCESSING         *
 3669                *********************************/
 3670
 3671'$member'(El, [H|T]) :-
 3672    '$member_'(T, El, H).
 3673
 3674'$member_'(_, El, El).
 3675'$member_'([H|T], El, _) :-
 3676    '$member_'(T, El, H).
 3677
 3678
 3679'$append'([], L, L).
 3680'$append'([H|T], L, [H|R]) :-
 3681    '$append'(T, L, R).
 3682
 3683'$select'(X, [X|Tail], Tail).
 3684'$select'(Elem, [Head|Tail], [Head|Rest]) :-
 3685    '$select'(Elem, Tail, Rest).
 3686
 3687'$reverse'(L1, L2) :-
 3688    '$reverse'(L1, [], L2).
 3689
 3690'$reverse'([], List, List).
 3691'$reverse'([Head|List1], List2, List3) :-
 3692    '$reverse'(List1, [Head|List2], List3).
 3693
 3694'$delete'([], _, []) :- !.
 3695'$delete'([Elem|Tail], Elem, Result) :-
 3696    !,
 3697    '$delete'(Tail, Elem, Result).
 3698'$delete'([Head|Tail], Elem, [Head|Rest]) :-
 3699    '$delete'(Tail, Elem, Rest).
 3700
 3701'$last'([H|T], Last) :-
 3702    '$last'(T, H, Last).
 3703
 3704'$last'([], Last, Last).
 3705'$last'([H|T], _, Last) :-
 3706    '$last'(T, H, Last).
 length(?List, ?N)
Is true when N is the length of List.
 3713:- '$iso'((length/2)). 3714
 3715length(List, Length) :-
 3716    var(Length),
 3717    !,
 3718    '$skip_list'(Length0, List, Tail),
 3719    (   Tail == []
 3720    ->  Length = Length0                    % +,-
 3721    ;   var(Tail)
 3722    ->  Tail \== Length,                    % avoid length(L,L)
 3723        '$length3'(Tail, Length, Length0)   % -,-
 3724    ;   throw(error(type_error(list, List),
 3725                    context(length/2, _)))
 3726    ).
 3727length(List, Length) :-
 3728    integer(Length),
 3729    Length >= 0,
 3730    !,
 3731    '$skip_list'(Length0, List, Tail),
 3732    (   Tail == []                          % proper list
 3733    ->  Length = Length0
 3734    ;   var(Tail)
 3735    ->  Extra is Length-Length0,
 3736        '$length'(Tail, Extra)
 3737    ;   throw(error(type_error(list, List),
 3738                    context(length/2, _)))
 3739    ).
 3740length(_, Length) :-
 3741    integer(Length),
 3742    !,
 3743    throw(error(domain_error(not_less_than_zero, Length),
 3744                context(length/2, _))).
 3745length(_, Length) :-
 3746    throw(error(type_error(integer, Length),
 3747                context(length/2, _))).
 3748
 3749'$length3'([], N, N).
 3750'$length3'([_|List], N, N0) :-
 3751    N1 is N0+1,
 3752    '$length3'(List, N, N1).
 3753
 3754
 3755                 /*******************************
 3756                 *       OPTION PROCESSING      *
 3757                 *******************************/
 $is_options(@Term) is semidet
True if Term looks like it provides options.
 3763'$is_options'(Map) :-
 3764    is_dict(Map, _),
 3765    !.
 3766'$is_options'(List) :-
 3767    is_list(List),
 3768    (   List == []
 3769    ->  true
 3770    ;   List = [H|_],
 3771        '$is_option'(H, _, _)
 3772    ).
 3773
 3774'$is_option'(Var, _, _) :-
 3775    var(Var), !, fail.
 3776'$is_option'(F, Name, Value) :-
 3777    functor(F, _, 1),
 3778    !,
 3779    F =.. [Name,Value].
 3780'$is_option'(Name=Value, Name, Value).
 $option(?Opt, +Options) is semidet
 3784'$option'(Opt, Options) :-
 3785    is_dict(Options),
 3786    !,
 3787    [Opt] :< Options.
 3788'$option'(Opt, Options) :-
 3789    memberchk(Opt, Options).
 $option(?Opt, +Options, +Default) is det
 3793'$option'(Term, Options, Default) :-
 3794    arg(1, Term, Value),
 3795    functor(Term, Name, 1),
 3796    (   is_dict(Options)
 3797    ->  (   get_dict(Name, Options, GVal)
 3798        ->  Value = GVal
 3799        ;   Value = Default
 3800        )
 3801    ;   functor(Gen, Name, 1),
 3802        arg(1, Gen, GVal),
 3803        (   memberchk(Gen, Options)
 3804        ->  Value = GVal
 3805        ;   Value = Default
 3806        )
 3807    ).
 $select_option(?Opt, +Options, -Rest) is semidet
Select an option from Options.
Arguments:
Rest- is always a map.
 3815'$select_option'(Opt, Options, Rest) :-
 3816    select_dict([Opt], Options, Rest).
 $merge_options(+New, +Default, -Merged) is det
Add/replace options specified in New.
Arguments:
Merged- is always a map.
 3824'$merge_options'(New, Old, Merged) :-
 3825    put_dict(New, Old, Merged).
 3826
 3827
 3828                 /*******************************
 3829                 *   HANDLE TRACER 'L'-COMMAND  *
 3830                 *******************************/
 3831
 3832:- public '$prolog_list_goal'/1. 3833
 3834:- multifile
 3835    user:prolog_list_goal/1. 3836
 3837'$prolog_list_goal'(Goal) :-
 3838    user:prolog_list_goal(Goal),
 3839    !.
 3840'$prolog_list_goal'(Goal) :-
 3841    user:listing(Goal).
 3842
 3843		 /*******************************
 3844		 *              MISC		*
 3845		 *******************************/
 3846
 3847'$pi_head'(PI, Head) :-
 3848    var(PI),
 3849    var(Head),
 3850    '$instantiation_error'([PI,Head]).
 3851'$pi_head'(M:PI, M:Head) :-
 3852    !,
 3853    '$pi_head'(PI, Head).
 3854'$pi_head'(Name/Arity, Head) :-
 3855    !,
 3856    functor(Head, Name, Arity).
 3857'$pi_head'(Name//DCGArity, Head) :-
 3858    !,
 3859    (   nonvar(DCGArity)
 3860    ->  Arity is DCGArity+2,
 3861        functor(Head, Name, Arity)
 3862    ;   functor(Head, Name, Arity),
 3863        DCGArity is Arity - 2
 3864    ).
 3865
 3866
 3867                 /*******************************
 3868                 *             HALT             *
 3869                 *******************************/
 3870
 3871:- '$iso'((halt/0)). 3872
 3873halt :-
 3874    halt(0).
 at_halt(:Goal)
Register Goal to be called if the system halts.
To be done
- : get location into the error message
 3883:- meta_predicate at_halt(0). 3884:- dynamic        system:term_expansion/2, '$at_halt'/2. 3885:- multifile      system:term_expansion/2, '$at_halt'/2. 3886
 3887system:term_expansion((:- at_halt(Goal)),
 3888                      system:'$at_halt'(Module:Goal, File:Line)) :-
 3889    \+ current_prolog_flag(xref, true),
 3890    source_location(File, Line),
 3891    '$current_source_module'(Module).
 3892
 3893at_halt(Goal) :-
 3894    asserta('$at_halt'(Goal, (-):0)).
 3895
 3896:- public '$run_at_halt'/0. 3897
 3898'$run_at_halt' :-
 3899    forall(clause('$at_halt'(Goal, Src), true, Ref),
 3900           ( '$call_at_halt'(Goal, Src),
 3901             erase(Ref)
 3902           )).
 3903
 3904'$call_at_halt'(Goal, _Src) :-
 3905    catch(Goal, E, true),
 3906    !,
 3907    (   var(E)
 3908    ->  true
 3909    ;   subsumes_term(cancel_halt(_), E)
 3910    ->  '$print_message'(informational, E),
 3911        fail
 3912    ;   '$print_message'(error, E)
 3913    ).
 3914'$call_at_halt'(Goal, _Src) :-
 3915    '$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.
 3923cancel_halt(Reason) :-
 3924    throw(cancel_halt(Reason)).
 3925
 3926
 3927                /********************************
 3928                *      LOAD OTHER MODULES       *
 3929                *********************************/
 3930
 3931:- meta_predicate
 3932    '$load_wic_files'(:). 3933
 3934'$load_wic_files'(Files) :-
 3935    Files = Module:_,
 3936    '$execute_directive'('$set_source_module'(OldM, Module), []),
 3937    '$save_lex_state'(LexState, []),
 3938    '$style_check'(_, 0xC7),                % see style_name/2 in syspred.pl
 3939    '$compilation_mode'(OldC, wic),
 3940    consult(Files),
 3941    '$execute_directive'('$set_source_module'(OldM), []),
 3942    '$execute_directive'('$restore_lex_state'(LexState), []),
 3943    '$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.
 3951:- public '$load_additional_boot_files'/0. 3952
 3953'$load_additional_boot_files' :-
 3954    current_prolog_flag(argv, Argv),
 3955    '$get_files_argv'(Argv, Files),
 3956    (   Files \== []
 3957    ->  format('Loading additional boot files~n'),
 3958        '$load_wic_files'(user:Files),
 3959        format('additional boot files loaded~n')
 3960    ;   true
 3961    ).
 3962
 3963'$get_files_argv'([], []) :- !.
 3964'$get_files_argv'(['-c'|Files], Files) :- !.
 3965'$get_files_argv'([_|Rest], Files) :-
 3966    '$get_files_argv'(Rest, Files).
 3967
 3968'$:-'(('$boot_message'('Loading Prolog startup files~n', []),
 3969       source_location(File, _Line),
 3970       file_directory_name(File, Dir),
 3971       atom_concat(Dir, '/load.pl', LoadFile),
 3972       '$load_wic_files'(system:[LoadFile]),
 3973       (   current_prolog_flag(windows, true)
 3974       ->  atom_concat(Dir, '/menu.pl', MenuFile),
 3975           '$load_wic_files'(system:[MenuFile])
 3976       ;   true
 3977       ),
 3978       '$boot_message'('SWI-Prolog boot files loaded~n', []),
 3979       '$compilation_mode'(OldC, wic),
 3980       '$execute_directive'('$set_source_module'(user), []),
 3981       '$set_compilation_mode'(OldC)
 3982      ))