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-2018, 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).
  100dynamic(Spec)            :- '$set_pattr'(Spec, pred, (dynamic)).
  101multifile(Spec)          :- '$set_pattr'(Spec, pred, (multifile)).
  102module_transparent(Spec) :- '$set_pattr'(Spec, pred, (transparent)).
  103discontiguous(Spec)      :- '$set_pattr'(Spec, pred, (discontiguous)).
  104volatile(Spec)           :- '$set_pattr'(Spec, pred, (volatile)).
  105thread_local(Spec)       :- '$set_pattr'(Spec, pred, (thread_local)).
  106noprofile(Spec)          :- '$set_pattr'(Spec, pred, (noprofile)).
  107public(Spec)             :- '$set_pattr'(Spec, pred, (public)).
  108non_terminal(Spec)       :- '$set_pattr'(Spec, pred, (non_terminal)).
  109'$iso'(Spec)             :- '$set_pattr'(Spec, pred, (iso)).
  110'$clausable'(Spec)       :- '$set_pattr'(Spec, pred, (clausable)).
  111
  112'$set_pattr'(M:Pred, How, Attr) :-
  113    '$set_pattr'(Pred, M, How, Attr).
  114
  115'$set_pattr'(X, _, _, _) :-
  116    var(X),
  117    throw(error(instantiation_error, _)).
  118'$set_pattr'([], _, _, _) :- !.
  119'$set_pattr'([H|T], M, How, Attr) :-           % ISO
  120    !,
  121    '$set_pattr'(H, M, How, Attr),
  122    '$set_pattr'(T, M, How, Attr).
  123'$set_pattr'((A,B), M, How, Attr) :-           % ISO and traditional
  124    !,
  125    '$set_pattr'(A, M, How, Attr),
  126    '$set_pattr'(B, M, How, Attr).
  127'$set_pattr'(M:T, _, How, Attr) :-
  128    !,
  129    '$set_pattr'(T, M, How, Attr).
  130'$set_pattr'(A, M, pred, Attr) :-
  131    !,
  132    '$set_predicate_attribute'(M:A, Attr, true).
  133'$set_pattr'(A, M, directive, Attr) :-
  134    !,
  135    catch('$set_predicate_attribute'(M:A, Attr, true),
  136          error(E, _),
  137          print_message(error, error(E, context((Attr)/1,_)))).
 $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.
  146'$pattr_directive'(dynamic(Spec), M) :-
  147    '$set_pattr'(Spec, M, directive, (dynamic)).
  148'$pattr_directive'(multifile(Spec), M) :-
  149    '$set_pattr'(Spec, M, directive, (multifile)).
  150'$pattr_directive'(module_transparent(Spec), M) :-
  151    '$set_pattr'(Spec, M, directive, (transparent)).
  152'$pattr_directive'(discontiguous(Spec), M) :-
  153    '$set_pattr'(Spec, M, directive, (discontiguous)).
  154'$pattr_directive'(volatile(Spec), M) :-
  155    '$set_pattr'(Spec, M, directive, (volatile)).
  156'$pattr_directive'(thread_local(Spec), M) :-
  157    '$set_pattr'(Spec, M, directive, (thread_local)).
  158'$pattr_directive'(noprofile(Spec), M) :-
  159    '$set_pattr'(Spec, M, directive, (noprofile)).
  160'$pattr_directive'(public(Spec), M) :-
  161    '$set_pattr'(Spec, M, directive, (public)).
 $hide(:PI)
Predicates protected this way are never visible in the tracer.
  168'$hide'(Pred) :-
  169    '$set_predicate_attribute'(Pred, trace, false).
  170
  171
  172                /********************************
  173                *       CALLING, CONTROL        *
  174                *********************************/
  175
  176:- noprofile((call/1,
  177              catch/3,
  178              once/1,
  179              ignore/1,
  180              call_cleanup/2,
  181              call_cleanup/3,
  182              setup_call_cleanup/3,
  183              setup_call_catcher_cleanup/4)).  184
  185:- meta_predicate
  186    ';'(0,0),
  187    ','(0,0),
  188    @(0,+),
  189    call(0),
  190    call(1,?),
  191    call(2,?,?),
  192    call(3,?,?,?),
  193    call(4,?,?,?,?),
  194    call(5,?,?,?,?,?),
  195    call(6,?,?,?,?,?,?),
  196    call(7,?,?,?,?,?,?,?),
  197    not(0),
  198    \+(0),
  199    '->'(0,0),
  200    '*->'(0,0),
  201    once(0),
  202    ignore(0),
  203    catch(0,?,0),
  204    reset(0,?,-),
  205    setup_call_cleanup(0,0,0),
  206    setup_call_catcher_cleanup(0,0,?,0),
  207    call_cleanup(0,0),
  208    call_cleanup(0,?,0),
  209    catch_with_backtrace(0,?,0),
  210    '$meta_call'(0).  211
  212:- '$iso'((call/1, (\+)/1, once/1, (;)/2, (',')/2, (->)/2, catch/3)).  213
  214% The control structures are always compiled, both   if they appear in a
  215% clause body and if they are handed  to   call/1.  The only way to call
  216% these predicates is by means of  call/2..   In  that case, we call the
  217% hole control structure again to get it compiled by call/1 and properly
  218% deal  with  !,  etc.  Another  reason  for  having  these  things   as
  219% predicates is to be able to define   properties for them, helping code
  220% analyzers.
  221
  222(M0:If ; M0:Then) :- !, call(M0:(If ; Then)).
  223(M1:If ; M2:Then) :-    call(M1:(If ; M2:Then)).
  224(G1   , G2)       :-    call((G1   , G2)).
  225(If  -> Then)     :-    call((If  -> Then)).
  226(If *-> Then)     :-    call((If *-> Then)).
  227@(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.

  241'$meta_call'(M:G) :-
  242    prolog_current_choice(Ch),
  243    '$meta_call'(G, M, Ch).
  244
  245'$meta_call'(Var, _, _) :-
  246    var(Var),
  247    !,
  248    '$instantiation_error'(Var).
  249'$meta_call'((A,B), M, Ch) :-
  250    !,
  251    '$meta_call'(A, M, Ch),
  252    '$meta_call'(B, M, Ch).
  253'$meta_call'((I->T;E), M, Ch) :-
  254    !,
  255    (   prolog_current_choice(Ch2),
  256        '$meta_call'(I, M, Ch2)
  257    ->  '$meta_call'(T, M, Ch)
  258    ;   '$meta_call'(E, M, Ch)
  259    ).
  260'$meta_call'((I*->T;E), M, Ch) :-
  261    !,
  262    (   prolog_current_choice(Ch2),
  263        '$meta_call'(I, M, Ch2)
  264    *-> '$meta_call'(T, M, Ch)
  265    ;   '$meta_call'(E, M, Ch)
  266    ).
  267'$meta_call'((I->T), M, Ch) :-
  268    !,
  269    (   prolog_current_choice(Ch2),
  270        '$meta_call'(I, M, Ch2)
  271    ->  '$meta_call'(T, M, Ch)
  272    ).
  273'$meta_call'((I*->T), M, Ch) :-
  274    !,
  275    prolog_current_choice(Ch2),
  276    '$meta_call'(I, M, Ch2),
  277    '$meta_call'(T, M, Ch).
  278'$meta_call'((A;B), M, Ch) :-
  279    !,
  280    (   '$meta_call'(A, M, Ch)
  281    ;   '$meta_call'(B, M, Ch)
  282    ).
  283'$meta_call'(\+(G), M, _) :-
  284    !,
  285    prolog_current_choice(Ch),
  286    \+ '$meta_call'(G, M, Ch).
  287'$meta_call'(call(G), M, _) :-
  288    !,
  289    prolog_current_choice(Ch),
  290    '$meta_call'(G, M, Ch).
  291'$meta_call'(M:G, _, Ch) :-
  292    !,
  293    '$meta_call'(G, M, Ch).
  294'$meta_call'(!, _, Ch) :-
  295    prolog_cut_to(Ch).
  296'$meta_call'(G, M, _Ch) :-
  297    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..
  313:- '$iso'((call/2,
  314           call/3,
  315           call/4,
  316           call/5,
  317           call/6,
  318           call/7,
  319           call/8)).  320
  321call(Goal) :-                           % make these available as predicates
  322    Goal.
  323call(Goal, A) :-
  324    call(Goal, A).
  325call(Goal, A, B) :-
  326    call(Goal, A, B).
  327call(Goal, A, B, C) :-
  328    call(Goal, A, B, C).
  329call(Goal, A, B, C, D) :-
  330    call(Goal, A, B, C, D).
  331call(Goal, A, B, C, D, E) :-
  332    call(Goal, A, B, C, D, E).
  333call(Goal, A, B, C, D, E, F) :-
  334    call(Goal, A, B, C, D, E, F).
  335call(Goal, A, B, C, D, E, F, G) :-
  336    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.
  343not(Goal) :-
  344    \+ Goal.
 \+ :Goal is semidet
Predicate version that allows for meta-calling.
  350\+ Goal :-
  351    \+ Goal.
 once(:Goal) is semidet
ISO predicate, acting as call((Goal, !)).
  357once(Goal) :-
  358    Goal,
  359    !.
 ignore(:Goal) is det
Call Goal, cut choice-points on success and succeed on failure. intended for calling side-effects and proceed on failure.
  366ignore(Goal) :-
  367    Goal,
  368    !.
  369ignore(_Goal).
  370
  371:- '$iso'((false/0)).
 false
Synonym for fail/0, providing a declarative reading.
  377false :-
  378    fail.
 catch(:Goal, +Catcher, :Recover)
ISO compliant exception handling.
  384catch(_Goal, _Catcher, _Recover) :-
  385    '$catch'.                       % Maps to I_CATCH, I_EXITCATCH
 prolog_cut_to(+Choice)
Cut all choice points after Choice
  391prolog_cut_to(_Choice) :-
  392    '$cut'.                         % Maps to I_CUTCHP
 reset(:Goal, ?Ball, -Continue)
Delimited continuation support.
  398reset(_Goal, _Ball, _Cont) :-
  399    '$reset'.
 shift(+Ball)
Shift control back to the enclosing reset/3
  405shift(Ball) :-
  406    '$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.

  420call_continuation([]).
  421call_continuation([TB|Rest]) :-
  422    (   Rest == []
  423    ->  '$call_continuation'(TB)
  424    ;   '$call_continuation'(TB),
  425        call_continuation(Rest)
  426    ).
 catch_with_backtrace(:Goal, ?Ball, :Recover)
As catch/3, but tell library(prolog_stack) to record a backtrace in case of an exception.
  433catch_with_backtrace(Goal, Ball, Recover) :-
  434    catch(Goal, Ball, Recover),
  435    '$no_lco'.
  436
  437'$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.
  447:- public '$recover_and_rethrow'/2.  448
  449'$recover_and_rethrow'(Goal, Exception) :-
  450    call_cleanup(Goal, throw(Exception)),
  451    !.
 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.
  466setup_call_catcher_cleanup(Setup, _Goal, _Catcher, _Cleanup) :-
  467    '$sig_atomic'(Setup),
  468    '$call_cleanup'.
  469
  470setup_call_cleanup(Setup, Goal, Cleanup) :-
  471    setup_call_catcher_cleanup(Setup, Goal, _Catcher, Cleanup).
  472
  473call_cleanup(Goal, Cleanup) :-
  474    setup_call_catcher_cleanup(true, Goal, _Catcher, Cleanup).
  475
  476call_cleanup(Goal, Catcher, Cleanup) :-
  477    setup_call_catcher_cleanup(true, Goal, Catcher, Cleanup).
  478
  479                 /*******************************
  480                 *       INITIALIZATION         *
  481                 *******************************/
  482
  483:- meta_predicate
  484    initialization(0, +).  485
  486:- multifile '$init_goal'/3.  487:- 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.

  513initialization(Goal, When) :-
  514    '$must_be'(oneof(atom, initialization_type,
  515                     [ now,
  516                       after_load,
  517                       restore,
  518                       restore_state,
  519                       prepare_state,
  520                       program,
  521                       main
  522                     ]), When),
  523    '$initialization_context'(Source, Ctx),
  524    '$initialization'(When, Goal, Source, Ctx).
  525
  526'$initialization'(now, Goal, _Source, Ctx) :-
  527    '$run_init_goal'(Goal, Ctx),
  528    '$compile_init_goal'(-, Goal, Ctx).
  529'$initialization'(after_load, Goal, Source, Ctx) :-
  530    (   Source \== (-)
  531    ->  '$compile_init_goal'(Source, Goal, Ctx)
  532    ;   throw(error(context_error(nodirective,
  533                                  initialization(Goal, after_load)),
  534                    _))
  535    ).
  536'$initialization'(restore, Goal, Source, Ctx) :- % deprecated
  537    '$initialization'(restore_state, Goal, Source, Ctx).
  538'$initialization'(restore_state, Goal, _Source, Ctx) :-
  539    (   \+ current_prolog_flag(sandboxed_load, true)
  540    ->  '$compile_init_goal'(-, Goal, Ctx)
  541    ;   '$permission_error'(register, initialization(restore), Goal)
  542    ).
  543'$initialization'(prepare_state, Goal, _Source, Ctx) :-
  544    (   \+ current_prolog_flag(sandboxed_load, true)
  545    ->  '$compile_init_goal'(when(prepare_state), Goal, Ctx)
  546    ;   '$permission_error'(register, initialization(restore), Goal)
  547    ).
  548'$initialization'(program, Goal, _Source, Ctx) :-
  549    (   \+ current_prolog_flag(sandboxed_load, true)
  550    ->  '$compile_init_goal'(when(program), Goal, Ctx)
  551    ;   '$permission_error'(register, initialization(restore), Goal)
  552    ).
  553'$initialization'(main, Goal, _Source, Ctx) :-
  554    (   \+ current_prolog_flag(sandboxed_load, true)
  555    ->  '$compile_init_goal'(when(main), Goal, Ctx)
  556    ;   '$permission_error'(register, initialization(restore), Goal)
  557    ).
  558
  559
  560'$compile_init_goal'(Source, Goal, Ctx) :-
  561    atom(Source),
  562    Source \== (-),
  563    !,
  564    '$store_admin_clause'(system:'$init_goal'(Source, Goal, Ctx),
  565                          _Layout, Source, Ctx).
  566'$compile_init_goal'(Source, Goal, Ctx) :-
  567    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.
  579'$run_initialization'(_, loaded, _) :- !.
  580'$run_initialization'(File, _Action, Options) :-
  581    '$run_initialization'(File, Options).
  582
  583'$run_initialization'(File, Options) :-
  584    setup_call_cleanup(
  585        '$start_run_initialization'(Options, Restore),
  586        '$run_initialization_2'(File),
  587        '$end_run_initialization'(Restore)).
  588
  589'$start_run_initialization'(Options, OldSandBoxed) :-
  590    '$push_input_context'(initialization),
  591    '$set_sandboxed_load'(Options, OldSandBoxed).
  592'$end_run_initialization'(OldSandBoxed) :-
  593    set_prolog_flag(sandboxed_load, OldSandBoxed),
  594    '$pop_input_context'.
  595
  596'$run_initialization_2'(File) :-
  597    (   '$init_goal'(File, Goal, Ctx),
  598        File \= when(_),
  599        '$run_init_goal'(Goal, Ctx),
  600        fail
  601    ;   true
  602    ).
  603
  604'$run_init_goal'(Goal, Ctx) :-
  605    (   catch_with_backtrace('$run_init_goal'(Goal), E,
  606                             '$initialization_error'(E, Goal, Ctx))
  607    ->  true
  608    ;   '$initialization_failure'(Goal, Ctx)
  609    ).
  610
  611:- multifile prolog:sandbox_allowed_goal/1.  612
  613'$run_init_goal'(Goal) :-
  614    current_prolog_flag(sandboxed_load, false),
  615    !,
  616    call(Goal).
  617'$run_init_goal'(Goal) :-
  618    prolog:sandbox_allowed_goal(Goal),
  619    call(Goal).
  620
  621'$initialization_context'(Source, Ctx) :-
  622    (   source_location(File, Line)
  623    ->  Ctx = File:Line,
  624        '$input_context'(Context),
  625        '$top_file'(Context, File, Source)
  626    ;   Ctx = (-),
  627        File = (-)
  628    ).
  629
  630'$top_file'([input(include, F1, _, _)|T], _, F) :-
  631    !,
  632    '$top_file'(T, F1, F).
  633'$top_file'(_, F, F).
  634
  635
  636'$initialization_error'(E, Goal, Ctx) :-
  637    print_message(error, initialization_error(Goal, E, Ctx)).
  638
  639'$initialization_failure'(Goal, Ctx) :-
  640    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
  648:- public '$clear_source_admin'/1.  649
  650'$clear_source_admin'(File) :-
  651    retractall('$init_goal'(_, _, File:_)),
  652    retractall('$load_context_module'(File, _, _)),
  653    retractall('$resolved_source_path'(_, File)).
  654
  655
  656                 /*******************************
  657                 *            STREAM            *
  658                 *******************************/
  659
  660:- '$iso'(stream_property/2).  661stream_property(Stream, Property) :-
  662    nonvar(Stream),
  663    nonvar(Property),
  664    !,
  665    '$stream_property'(Stream, Property).
  666stream_property(Stream, Property) :-
  667    nonvar(Stream),
  668    !,
  669    '$stream_properties'(Stream, Properties),
  670    '$member'(Property, Properties).
  671stream_property(Stream, Property) :-
  672    nonvar(Property),
  673    !,
  674    (   Property = alias(Alias),
  675        atom(Alias)
  676    ->  '$alias_stream'(Alias, Stream)
  677    ;   '$streams_properties'(Property, Pairs),
  678        '$member'(Stream-Property, Pairs)
  679    ).
  680stream_property(Stream, Property) :-
  681    '$streams_properties'(Property, Pairs),
  682    '$member'(Stream-Properties, Pairs),
  683    '$member'(Property, Properties).
  684
  685
  686                /********************************
  687                *            MODULES            *
  688                *********************************/
  689
  690%       '$prefix_module'(+Module, +Context, +Term, -Prefixed)
  691%       Tags `Term' with `Module:' if `Module' is not the context module.
  692
  693'$prefix_module'(Module, Module, Head, Head) :- !.
  694'$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'.
  700default_module(Me, Super) :-
  701    (   atom(Me)
  702    ->  (   var(Super)
  703        ->  '$default_module'(Me, Super)
  704        ;   '$default_module'(Me, Super), !
  705        )
  706    ;   '$type_error'(module, Me)
  707    ).
  708
  709'$default_module'(Me, Me).
  710'$default_module'(Me, Super) :-
  711    import_module(Me, S),
  712    '$default_module'(S, Super).
  713
  714
  715                /********************************
  716                *      TRACE AND EXCEPTIONS     *
  717                *********************************/
  718
  719:- user:dynamic((exception/3,
  720                 prolog_event_hook/1)).  721:- user:multifile((exception/3,
  722                   prolog_event_hook/1)).
 $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.
  731:- public
  732    '$undefined_procedure'/4.  733
  734'$undefined_procedure'(Module, Name, Arity, Action) :-
  735    '$prefix_module'(Module, user, Name/Arity, Pred),
  736    user:exception(undefined_predicate, Pred, Action0),
  737    !,
  738    Action = Action0.
  739'$undefined_procedure'(Module, Name, Arity, Action) :-
  740    current_prolog_flag(autoload, true),
  741    '$autoload'(Module, Name, Arity),
  742    !,
  743    Action = retry.
  744'$undefined_procedure'(_, _, _, error).
  745
  746'$autoload'(Module, Name, Arity) :-
  747    source_location(File, _Line),
  748    !,
  749    setup_call_cleanup(
  750        '$start_aux'(File, Context),
  751        '$autoload2'(Module, Name, Arity),
  752        '$end_aux'(File, Context)).
  753'$autoload'(Module, Name, Arity) :-
  754    '$autoload2'(Module, Name, Arity).
  755
  756'$autoload2'(Module, Name, Arity) :-
  757    '$find_library'(Module, Name, Arity, LoadModule, Library),
  758    functor(Head, Name, Arity),
  759    '$update_autoload_level'([autoload(true)], Old),
  760    (   current_prolog_flag(verbose_autoload, true)
  761    ->  Level = informational
  762    ;   Level = silent
  763    ),
  764    print_message(Level, autoload(Module:Name/Arity, Library)),
  765    '$compilation_mode'(OldComp, database),
  766    (   Module == LoadModule
  767    ->  ensure_loaded(Module:Library)
  768    ;   (   '$get_predicate_attribute'(LoadModule:Head, defined, 1),
  769            \+ '$loading'(Library)
  770        ->  Module:import(LoadModule:Name/Arity)
  771        ;   use_module(Module:Library, [Name/Arity])
  772        )
  773    ),
  774    '$set_compilation_mode'(OldComp),
  775    '$set_autoload_level'(Old),
  776    '$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.
  787'$loading'(Library) :-
  788    current_prolog_flag(threads, true),
  789    '$loading_file'(FullFile, _Queue, _LoadThread),
  790    file_name_extension(Library, _, FullFile),
  791    !.
  792
  793%        handle debugger 'w', 'p' and <N> depth options.
  794
  795'$set_debugger_write_options'(write) :-
  796    !,
  797    create_prolog_flag(debugger_write_options,
  798                       [ quoted(true),
  799                         attributes(dots),
  800                         spacing(next_argument)
  801                       ], []).
  802'$set_debugger_write_options'(print) :-
  803    !,
  804    create_prolog_flag(debugger_write_options,
  805                       [ quoted(true),
  806                         portray(true),
  807                         max_depth(10),
  808                         attributes(portray),
  809                         spacing(next_argument)
  810                       ], []).
  811'$set_debugger_write_options'(Depth) :-
  812    current_prolog_flag(debugger_write_options, Options0),
  813    (   '$select'(max_depth(_), Options0, Options)
  814    ->  true
  815    ;   Options = Options0
  816    ),
  817    create_prolog_flag(debugger_write_options,
  818                       [max_depth(Depth)|Options], []).
  819
  820
  821                /********************************
  822                *        SYSTEM MESSAGES        *
  823                *********************************/
 $confirm(Spec)
Ask the user to confirm a question. Spec is a term as used for print_message/2.
  830'$confirm'(Spec) :-
  831    print_message(query, Spec),
  832    between(0, 5, _),
  833        get_single_char(Answer),
  834        (   '$in_reply'(Answer, 'yYjJ \n')
  835        ->  !,
  836            print_message(query, if_tty([yes-[]]))
  837        ;   '$in_reply'(Answer, 'nN')
  838        ->  !,
  839            print_message(query, if_tty([no-[]])),
  840            fail
  841        ;   print_message(help, query(confirm)),
  842            fail
  843        ).
  844
  845'$in_reply'(Code, Atom) :-
  846    char_code(Char, Code),
  847    sub_atom(Atom, _, _, _, Char),
  848    !.
  849
  850:- dynamic
  851    user:portray/1.  852:- multifile
  853    user:portray/1.  854
  855
  856                 /*******************************
  857                 *       FILE_SEARCH_PATH       *
  858                 *******************************/
  859
  860:- dynamic user:file_search_path/2.  861:- multifile user:file_search_path/2.  862
  863user:(file_search_path(library, Dir) :-
  864        library_directory(Dir)).
  865user:file_search_path(swi, Home) :-
  866    current_prolog_flag(home, Home).
  867user:file_search_path(foreign, swi(ArchLib)) :-
  868    current_prolog_flag(arch, Arch),
  869    atom_concat('lib/', Arch, ArchLib).
  870user:file_search_path(foreign, swi(SoLib)) :-
  871    (   current_prolog_flag(windows, true)
  872    ->  SoLib = bin
  873    ;   SoLib = lib
  874    ).
  875user:file_search_path(path, Dir) :-
  876    getenv('PATH', Path),
  877    (   current_prolog_flag(windows, true)
  878    ->  atomic_list_concat(Dirs, (;), Path)
  879    ;   atomic_list_concat(Dirs, :, Path)
  880    ),
  881    '$member'(Dir, Dirs),
  882    '$no-null-bytes'(Dir).
  883
  884'$no-null-bytes'(Dir) :-
  885    sub_atom(Dir, _, _, _, '\u0000'),
  886    !,
  887    print_message(warning, null_byte_in_path(Dir)),
  888    fail.
  889'$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?
  897expand_file_search_path(Spec, Expanded) :-
  898    catch('$expand_file_search_path'(Spec, Expanded, 0, []),
  899          loop(Used),
  900          throw(error(loop_error(Spec), file_search(Used)))).
  901
  902'$expand_file_search_path'(Spec, Expanded, N, Used) :-
  903    functor(Spec, Alias, 1),
  904    !,
  905    user:file_search_path(Alias, Exp0),
  906    NN is N + 1,
  907    (   NN > 16
  908    ->  throw(loop(Used))
  909    ;   true
  910    ),
  911    '$expand_file_search_path'(Exp0, Exp1, NN, [Alias=Exp0|Used]),
  912    arg(1, Spec, Segments),
  913    '$segments_to_atom'(Segments, File),
  914    '$make_path'(Exp1, File, Expanded).
  915'$expand_file_search_path'(Spec, Path, _, _) :-
  916    '$segments_to_atom'(Spec, Path).
  917
  918'$make_path'(Dir, '.', Path) :-
  919    !,
  920    Path = Dir.
  921'$make_path'(Dir, File, Path) :-
  922    sub_atom(Dir, _, _, 0, /),
  923    !,
  924    atom_concat(Dir, File, Path).
  925'$make_path'(Dir, File, Path) :-
  926    atomic_list_concat([Dir, /, File], Path).
  927
  928
  929                /********************************
  930                *         FILE CHECKING         *
  931                *********************************/
 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.
  942absolute_file_name(Spec, Options, Path) :-
  943    '$is_options'(Options),
  944    \+ '$is_options'(Path),
  945    !,
  946    absolute_file_name(Spec, Path, Options).
  947absolute_file_name(Spec, Path, Options) :-
  948    '$must_be'(options, Options),
  949                    % get the valid extensions
  950    (   '$select_option'(extensions(Exts), Options, Options1)
  951    ->  '$must_be'(list, Exts)
  952    ;   '$option'(file_type(Type), Options)
  953    ->  '$must_be'(atom, Type),
  954        '$file_type_extensions'(Type, Exts),
  955        Options1 = Options
  956    ;   Options1 = Options,
  957        Exts = ['']
  958    ),
  959    '$canonicalise_extensions'(Exts, Extensions),
  960                    % unless specified otherwise, ask regular file
  961    (   nonvar(Type)
  962    ->  Options2 = Options1
  963    ;   '$merge_options'(_{file_type:regular}, Options1, Options2)
  964    ),
  965                    % Det or nondet?
  966    (   '$select_option'(solutions(Sols), Options2, Options3)
  967    ->  '$must_be'(oneof(atom, solutions, [first,all]), Sols)
  968    ;   Sols = first,
  969        Options3 = Options2
  970    ),
  971                    % Errors or not?
  972    (   '$select_option'(file_errors(FileErrors), Options3, Options4)
  973    ->  '$must_be'(oneof(atom, file_errors, [error,fail]), FileErrors)
  974    ;   FileErrors = error,
  975        Options4 = Options3
  976    ),
  977                    % Expand shell patterns?
  978    (   atomic(Spec),
  979        '$select_option'(expand(Expand), Options4, Options5),
  980        '$must_be'(boolean, Expand)
  981    ->  expand_file_name(Spec, List),
  982        '$member'(Spec1, List)
  983    ;   Spec1 = Spec,
  984        Options5 = Options4
  985    ),
  986                    % Search for files
  987    (   Sols == first
  988    ->  (   '$chk_file'(Spec1, Extensions, Options5, true, Path)
  989        ->  !       % also kill choice point of expand_file_name/2
  990        ;   (   FileErrors == fail
  991            ->  fail
  992            ;   '$current_module'('$bags', _File),
  993                findall(P,
  994                        '$chk_file'(Spec1, Extensions, [access(exist)],
  995                                    false, P),
  996                        Candidates),
  997                '$abs_file_error'(Spec, Candidates, Options5)
  998            )
  999        )
 1000    ;   '$chk_file'(Spec1, Extensions, Options5, false, Path)
 1001    ).
 1002
 1003'$abs_file_error'(Spec, Candidates, Conditions) :-
 1004    '$member'(F, Candidates),
 1005    '$member'(C, Conditions),
 1006    '$file_condition'(C),
 1007    '$file_error'(C, Spec, F, E, Comment),
 1008    !,
 1009    throw(error(E, context(_, Comment))).
 1010'$abs_file_error'(Spec, _, _) :-
 1011    '$existence_error'(source_sink, Spec).
 1012
 1013'$file_error'(file_type(directory), Spec, File, Error, Comment) :-
 1014    \+ exists_directory(File),
 1015    !,
 1016    Error = existence_error(directory, Spec),
 1017    Comment = not_a_directory(File).
 1018'$file_error'(file_type(_), Spec, File, Error, Comment) :-
 1019    exists_directory(File),
 1020    !,
 1021    Error = existence_error(file, Spec),
 1022    Comment = directory(File).
 1023'$file_error'(access(OneOrList), Spec, File, Error, _) :-
 1024    '$one_or_member'(Access, OneOrList),
 1025    \+ access_file(File, Access),
 1026    Error = permission_error(Access, source_sink, Spec).
 1027
 1028'$one_or_member'(Elem, List) :-
 1029    is_list(List),
 1030    !,
 1031    '$member'(Elem, List).
 1032'$one_or_member'(Elem, Elem).
 1033
 1034
 1035'$file_type_extensions'(source, Exts) :-       % SICStus 3.9 compatibility
 1036    !,
 1037    '$file_type_extensions'(prolog, Exts).
 1038'$file_type_extensions'(Type, Exts) :-
 1039    '$current_module'('$bags', _File),
 1040    !,
 1041    findall(Ext, user:prolog_file_type(Ext, Type), Exts0),
 1042    (   Exts0 == [],
 1043        \+ '$ft_no_ext'(Type)
 1044    ->  '$domain_error'(file_type, Type)
 1045    ;   true
 1046    ),
 1047    '$append'(Exts0, [''], Exts).
 1048'$file_type_extensions'(prolog, [pl, '']). % findall is not yet defined ...
 1049
 1050'$ft_no_ext'(txt).
 1051'$ft_no_ext'(executable).
 1052'$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.

 1065:- multifile(user:prolog_file_type/2). 1066:- dynamic(user:prolog_file_type/2). 1067
 1068user:prolog_file_type(pl,       prolog).
 1069user:prolog_file_type(prolog,   prolog).
 1070user:prolog_file_type(qlf,      prolog).
 1071user:prolog_file_type(qlf,      qlf).
 1072user:prolog_file_type(Ext,      executable) :-
 1073    current_prolog_flag(shared_object_extension, Ext).
 1074user:prolog_file_type(dylib,    executable) :-
 1075    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.
 1082'$chk_file'(Spec, _Extensions, _Cond, _Cache, _FullName) :-
 1083    \+ ground(Spec),
 1084    !,
 1085    '$instantiation_error'(Spec).
 1086'$chk_file'(Spec, Extensions, Cond, Cache, FullName) :-
 1087    compound(Spec),
 1088    functor(Spec, _, 1),
 1089    !,
 1090    '$relative_to'(Cond, cwd, CWD),
 1091    '$chk_alias_file'(Spec, Extensions, Cond, Cache, CWD, FullName).
 1092'$chk_file'(Segments, Ext, Cond, Cache, FullName) :-    % allow a/b/...
 1093    \+ atomic(Segments),
 1094    !,
 1095    '$segments_to_atom'(Segments, Atom),
 1096    '$chk_file'(Atom, Ext, Cond, Cache, FullName).
 1097'$chk_file'(File, Exts, Cond, _, FullName) :-
 1098    is_absolute_file_name(File),
 1099    !,
 1100    '$extend_file'(File, Exts, Extended),
 1101    '$file_conditions'(Cond, Extended),
 1102    '$absolute_file_name'(Extended, FullName).
 1103'$chk_file'(File, Exts, Cond, _, FullName) :-
 1104    '$relative_to'(Cond, source, Dir),
 1105    atomic_list_concat([Dir, /, File], AbsFile),
 1106    '$extend_file'(AbsFile, Exts, Extended),
 1107    '$file_conditions'(Cond, Extended),
 1108    !,
 1109    '$absolute_file_name'(Extended, FullName).
 1110'$chk_file'(File, Exts, Cond, _, FullName) :-
 1111    '$extend_file'(File, Exts, Extended),
 1112    '$file_conditions'(Cond, Extended),
 1113    '$absolute_file_name'(Extended, FullName).
 1114
 1115'$segments_to_atom'(Atom, Atom) :-
 1116    atomic(Atom),
 1117    !.
 1118'$segments_to_atom'(Segments, Atom) :-
 1119    '$segments_to_list'(Segments, List, []),
 1120    !,
 1121    atomic_list_concat(List, /, Atom).
 1122
 1123'$segments_to_list'(A/B, H, T) :-
 1124    '$segments_to_list'(A, H, T0),
 1125    '$segments_to_list'(B, T0, T).
 1126'$segments_to_list'(A, [A|T], T) :-
 1127    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.
 1137'$relative_to'(Conditions, Default, Dir) :-
 1138    (   '$option'(relative_to(FileOrDir), Conditions)
 1139    *-> (   exists_directory(FileOrDir)
 1140        ->  Dir = FileOrDir
 1141        ;   atom_concat(Dir, /, FileOrDir)
 1142        ->  true
 1143        ;   file_directory_name(FileOrDir, Dir)
 1144        )
 1145    ;   Default == cwd
 1146    ->  '$cwd'(Dir)
 1147    ;   Default == source
 1148    ->  source_location(ContextFile, _Line),
 1149        file_directory_name(ContextFile, Dir)
 1150    ).
 $chk_alias_file(+Spec, +Exts, +Cond, +Cache, +CWD, -FullFile) is nondet
 1155:- dynamic
 1156    '$search_path_file_cache'/3,    % SHA1, Time, Path
 1157    '$search_path_gc_time'/1.       % Time
 1158:- volatile
 1159    '$search_path_file_cache'/3,
 1160    '$search_path_gc_time'/1. 1161
 1162:- create_prolog_flag(file_search_cache_time, 10, []). 1163
 1164'$chk_alias_file'(Spec, Exts, Cond, true, CWD, FullFile) :-
 1165    !,
 1166    findall(Exp, expand_file_search_path(Spec, Exp), Expansions),
 1167    Cache = cache(Exts, Cond, CWD, Expansions),
 1168    variant_sha1(Spec+Cache, SHA1),
 1169    get_time(Now),
 1170    current_prolog_flag(file_search_cache_time, TimeOut),
 1171    (   '$search_path_file_cache'(SHA1, CachedTime, FullFile),
 1172        CachedTime > Now - TimeOut,
 1173        '$file_conditions'(Cond, FullFile)
 1174    ->  '$search_message'(file_search(cache(Spec, Cond), FullFile))
 1175    ;   '$member'(Expanded, Expansions),
 1176        '$extend_file'(Expanded, Exts, LibFile),
 1177        (   '$file_conditions'(Cond, LibFile),
 1178            '$absolute_file_name'(LibFile, FullFile),
 1179            '$cache_file_found'(SHA1, Now, TimeOut, FullFile)
 1180        ->  '$search_message'(file_search(found(Spec, Cond), FullFile))
 1181        ;   '$search_message'(file_search(tried(Spec, Cond), LibFile)),
 1182            fail
 1183        )
 1184    ).
 1185'$chk_alias_file'(Spec, Exts, Cond, false, _CWD, FullFile) :-
 1186    expand_file_search_path(Spec, Expanded),
 1187    '$extend_file'(Expanded, Exts, LibFile),
 1188    '$file_conditions'(Cond, LibFile),
 1189    '$absolute_file_name'(LibFile, FullFile).
 1190
 1191'$cache_file_found'(_, _, TimeOut, _) :-
 1192    TimeOut =:= 0,
 1193    !.
 1194'$cache_file_found'(SHA1, Now, TimeOut, FullFile) :-
 1195    '$search_path_file_cache'(SHA1, Saved, FullFile),
 1196    !,
 1197    (   Now - Saved < TimeOut/2
 1198    ->  true
 1199    ;   retractall('$search_path_file_cache'(SHA1, _, _)),
 1200        asserta('$search_path_file_cache'(SHA1, Now, FullFile))
 1201    ).
 1202'$cache_file_found'(SHA1, Now, TimeOut, FullFile) :-
 1203    'gc_file_search_cache'(TimeOut),
 1204    asserta('$search_path_file_cache'(SHA1, Now, FullFile)).
 1205
 1206'gc_file_search_cache'(TimeOut) :-
 1207    get_time(Now),
 1208    '$search_path_gc_time'(Last),
 1209    Now-Last < TimeOut/2,
 1210    !.
 1211'gc_file_search_cache'(TimeOut) :-
 1212    get_time(Now),
 1213    retractall('$search_path_gc_time'(_)),
 1214    assertz('$search_path_gc_time'(Now)),
 1215    Before is Now - TimeOut,
 1216    (   '$search_path_file_cache'(SHA1, Cached, FullFile),
 1217        Cached < Before,
 1218        retractall('$search_path_file_cache'(SHA1, Cached, FullFile)),
 1219        fail
 1220    ;   true
 1221    ).
 1222
 1223
 1224'$search_message'(Term) :-
 1225    current_prolog_flag(verbose_file_search, true),
 1226    !,
 1227    print_message(informational, Term).
 1228'$search_message'(_).
 $file_conditions(+Condition, +Path)
Verify Path satisfies Condition.
 1235'$file_conditions'(List, File) :-
 1236    is_list(List),
 1237    !,
 1238    \+ ( '$member'(C, List),
 1239         '$file_condition'(C),
 1240         \+ '$file_condition'(C, File)
 1241       ).
 1242'$file_conditions'(Map, File) :-
 1243    \+ (  get_dict(Key, Map, Value),
 1244          C =.. [Key,Value],
 1245          '$file_condition'(C),
 1246         \+ '$file_condition'(C, File)
 1247       ).
 1248
 1249'$file_condition'(file_type(directory), File) :-
 1250    !,
 1251    exists_directory(File).
 1252'$file_condition'(file_type(_), File) :-
 1253    !,
 1254    \+ exists_directory(File).
 1255'$file_condition'(access(Accesses), File) :-
 1256    !,
 1257    \+ (  '$one_or_member'(Access, Accesses),
 1258          \+ access_file(File, Access)
 1259       ).
 1260
 1261'$file_condition'(exists).
 1262'$file_condition'(file_type(_)).
 1263'$file_condition'(access(_)).
 1264
 1265'$extend_file'(File, Exts, FileEx) :-
 1266    '$ensure_extensions'(Exts, File, Fs),
 1267    '$list_to_set'(Fs, FsSet),
 1268    '$member'(FileEx, FsSet).
 1269
 1270'$ensure_extensions'([], _, []).
 1271'$ensure_extensions'([E|E0], F, [FE|E1]) :-
 1272    file_name_extension(F, E, FE),
 1273    '$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.
 1282'$list_to_set'(List, Set) :-
 1283    '$list_to_set'(List, [], Set).
 1284
 1285'$list_to_set'([], _, []).
 1286'$list_to_set'([H|T], Seen, R) :-
 1287    memberchk(H, Seen),
 1288    !,
 1289    '$list_to_set'(T, R).
 1290'$list_to_set'([H|T], Seen, [H|R]) :-
 1291    '$list_to_set'(T, [H|Seen], R).
 1292
 1293/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
 1294Canonicalise the extension list. Old SWI-Prolog   require  `.pl', etc, which
 1295the Quintus compatibility  requests  `pl'.   This  layer  canonicalises  all
 1296extensions to .ext
 1297- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
 1298
 1299'$canonicalise_extensions'([], []) :- !.
 1300'$canonicalise_extensions'([H|T], [CH|CT]) :-
 1301    !,
 1302    '$must_be'(atom, H),
 1303    '$canonicalise_extension'(H, CH),
 1304    '$canonicalise_extensions'(T, CT).
 1305'$canonicalise_extensions'(E, [CE]) :-
 1306    '$canonicalise_extension'(E, CE).
 1307
 1308'$canonicalise_extension'('', '') :- !.
 1309'$canonicalise_extension'(DotAtom, DotAtom) :-
 1310    sub_atom(DotAtom, 0, _, _, '.'),
 1311    !.
 1312'$canonicalise_extension'(Atom, DotAtom) :-
 1313    atom_concat('.', Atom, DotAtom).
 1314
 1315
 1316                /********************************
 1317                *            CONSULT            *
 1318                *********************************/
 1319
 1320:- dynamic
 1321    user:library_directory/1,
 1322    user:prolog_load_file/2. 1323:- multifile
 1324    user:library_directory/1,
 1325    user:prolog_load_file/2. 1326
 1327:- prompt(_, '|: '). 1328
 1329:- thread_local
 1330    '$compilation_mode_store'/1,    % database, wic, qlf
 1331    '$directive_mode_store'/1.      % database, wic, qlf
 1332:- volatile
 1333    '$compilation_mode_store'/1,
 1334    '$directive_mode_store'/1. 1335
 1336'$compilation_mode'(Mode) :-
 1337    (   '$compilation_mode_store'(Val)
 1338    ->  Mode = Val
 1339    ;   Mode = database
 1340    ).
 1341
 1342'$set_compilation_mode'(Mode) :-
 1343    retractall('$compilation_mode_store'(_)),
 1344    assertz('$compilation_mode_store'(Mode)).
 1345
 1346'$compilation_mode'(Old, New) :-
 1347    '$compilation_mode'(Old),
 1348    (   New == Old
 1349    ->  true
 1350    ;   '$set_compilation_mode'(New)
 1351    ).
 1352
 1353'$directive_mode'(Mode) :-
 1354    (   '$directive_mode_store'(Val)
 1355    ->  Mode = Val
 1356    ;   Mode = database
 1357    ).
 1358
 1359'$directive_mode'(Old, New) :-
 1360    '$directive_mode'(Old),
 1361    (   New == Old
 1362    ->  true
 1363    ;   '$set_directive_mode'(New)
 1364    ).
 1365
 1366'$set_directive_mode'(Mode) :-
 1367    retractall('$directive_mode_store'(_)),
 1368    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.
 1376'$compilation_level'(Level) :-
 1377    '$input_context'(Stack),
 1378    '$compilation_level'(Stack, Level).
 1379
 1380'$compilation_level'([], 0).
 1381'$compilation_level'([Input|T], Level) :-
 1382    (   arg(1, Input, see)
 1383    ->  '$compilation_level'(T, Level)
 1384    ;   '$compilation_level'(T, Level0),
 1385        Level is Level0+1
 1386    ).
 compiling
Is true if SWI-Prolog is generating a state or qlf file or executes a `call' directive while doing this.
 1394compiling :-
 1395    \+ (   '$compilation_mode'(database),
 1396           '$directive_mode'(database)
 1397       ).
 1398
 1399:- meta_predicate
 1400    '$ifcompiling'(0). 1401
 1402'$ifcompiling'(G) :-
 1403    (   '$compilation_mode'(database)
 1404    ->  true
 1405    ;   call(G)
 1406    ).
 1407
 1408                /********************************
 1409                *         READ SOURCE           *
 1410                *********************************/
 $load_msg_level(+Action, +NestingLevel, -StartVerbose, -EndVerbose)
 1414'$load_msg_level'(Action, Nesting, Start, Done) :-
 1415    '$update_autoload_level'([], 0),
 1416    !,
 1417    current_prolog_flag(verbose_load, Type0),
 1418    '$load_msg_compat'(Type0, Type),
 1419    (   '$load_msg_level'(Action, Nesting, Type, Start, Done)
 1420    ->  true
 1421    ).
 1422'$load_msg_level'(_, _, silent, silent).
 1423
 1424'$load_msg_compat'(true, normal) :- !.
 1425'$load_msg_compat'(false, silent) :- !.
 1426'$load_msg_compat'(X, X).
 1427
 1428'$load_msg_level'(load_file,    _, full,   informational, informational).
 1429'$load_msg_level'(include_file, _, full,   informational, informational).
 1430'$load_msg_level'(load_file,    _, normal, silent,        informational).
 1431'$load_msg_level'(include_file, _, normal, silent,        silent).
 1432'$load_msg_level'(load_file,    0, brief,  silent,        informational).
 1433'$load_msg_level'(load_file,    _, brief,  silent,        silent).
 1434'$load_msg_level'(include_file, _, brief,  silent,        silent).
 1435'$load_msg_level'(load_file,    _, silent, silent,        silent).
 1436'$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)
 1459'$source_term'(From, Read, RLayout, Term, TLayout, Stream, Options) :-
 1460    '$source_term'(From, Read, RLayout, Term, TLayout, Stream, [], Options),
 1461    (   Term == end_of_file
 1462    ->  !, fail
 1463    ;   true
 1464    ).
 1465
 1466'$source_term'(Input, _,_,_,_,_,_,_) :-
 1467    \+ ground(Input),
 1468    !,
 1469    '$instantiation_error'(Input).
 1470'$source_term'(stream(Id, In, Opts),
 1471               Read, RLayout, Term, TLayout, Stream, Parents, Options) :-
 1472    !,
 1473    '$record_included'(Parents, Id, Id, 0.0, Message),
 1474    setup_call_cleanup(
 1475        '$open_source'(stream(Id, In, Opts), In, State, Parents, Options),
 1476        '$term_in_file'(In, Read, RLayout, Term, TLayout, Stream,
 1477                        [Id|Parents], Options),
 1478        '$close_source'(State, Message)).
 1479'$source_term'(File,
 1480               Read, RLayout, Term, TLayout, Stream, Parents, Options) :-
 1481    absolute_file_name(File, Path,
 1482                       [ file_type(prolog),
 1483                         access(read)
 1484                       ]),
 1485    time_file(Path, Time),
 1486    '$record_included'(Parents, File, Path, Time, Message),
 1487    setup_call_cleanup(
 1488        '$open_source'(Path, In, State, Parents, Options),
 1489        '$term_in_file'(In, Read, RLayout, Term, TLayout, Stream,
 1490                        [Path|Parents], Options),
 1491        '$close_source'(State, Message)).
 1492
 1493:- thread_local
 1494    '$load_input'/2. 1495:- volatile
 1496    '$load_input'/2. 1497
 1498'$open_source'(stream(Id, In, Opts), In,
 1499               restore(In, StreamState, Id, Ref, Opts), Parents, Options) :-
 1500    !,
 1501    '$context_type'(Parents, ContextType),
 1502    '$push_input_context'(ContextType),
 1503    '$set_encoding'(In, Options),
 1504    '$prepare_load_stream'(In, Id, StreamState),
 1505    asserta('$load_input'(stream(Id), In), Ref).
 1506'$open_source'(Path, In, close(In, Path, Ref), Parents, Options) :-
 1507    '$context_type'(Parents, ContextType),
 1508    '$push_input_context'(ContextType),
 1509    open(Path, read, In),
 1510    '$set_encoding'(In, Options),
 1511    asserta('$load_input'(Path, In), Ref).
 1512
 1513'$context_type'([], load_file) :- !.
 1514'$context_type'(_, include).
 1515
 1516'$close_source'(close(In, Id, Ref), Message) :-
 1517    erase(Ref),
 1518    '$end_consult'(Id),
 1519    call_cleanup(
 1520        close(In),
 1521        '$pop_input_context'),
 1522    '$close_message'(Message).
 1523'$close_source'(restore(In, StreamState, Id, Ref, Opts), Message) :-
 1524    erase(Ref),
 1525    '$end_consult'(Id),
 1526    call_cleanup(
 1527        '$restore_load_stream'(In, StreamState, Opts),
 1528        '$pop_input_context'),
 1529    '$close_message'(Message).
 1530
 1531'$close_message'(message(Level, Msg)) :-
 1532    !,
 1533    '$print_message'(Level, Msg).
 1534'$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.
 1546'$term_in_file'(In, Read, RLayout, Term, TLayout, Stream, Parents, Options) :-
 1547    '$skip_script_line'(In, Options),
 1548    '$read_clause_options'(Options, ReadOptions),
 1549    repeat,
 1550      read_clause(In, Raw,
 1551                  [ variable_names(Bindings),
 1552                    term_position(Pos),
 1553                    subterm_positions(RawLayout)
 1554                  | ReadOptions
 1555                  ]),
 1556      b_setval('$term_position', Pos),
 1557      b_setval('$variable_names', Bindings),
 1558      (   Raw == end_of_file
 1559      ->  !,
 1560          (   Parents = [_,_|_]     % Included file
 1561          ->  fail
 1562          ;   '$expanded_term'(In,
 1563                               Raw, RawLayout, Read, RLayout, Term, TLayout,
 1564                               Stream, Parents, Options)
 1565          )
 1566      ;   '$expanded_term'(In, Raw, RawLayout, Read, RLayout, Term, TLayout,
 1567                           Stream, Parents, Options)
 1568      ).
 1569
 1570'$read_clause_options'([], []).
 1571'$read_clause_options'([H|T0], List) :-
 1572    (   '$read_clause_option'(H)
 1573    ->  List = [H|T]
 1574    ;   List = T
 1575    ),
 1576    '$read_clause_options'(T0, T).
 1577
 1578'$read_clause_option'(syntax_errors(_)).
 1579'$read_clause_option'(term_position(_)).
 1580'$read_clause_option'(process_comment(_)).
 1581
 1582'$expanded_term'(In, Raw, RawLayout, Read, RLayout, Term, TLayout,
 1583                 Stream, Parents, Options) :-
 1584    E = error(_,_),
 1585    catch('$expand_term'(Raw, RawLayout, Expanded, ExpandedLayout), E,
 1586          '$print_message_fail'(E)),
 1587    (   Expanded \== []
 1588    ->  '$expansion_member'(Expanded, ExpandedLayout, Term1, Layout1)
 1589    ;   Term1 = Expanded,
 1590        Layout1 = ExpandedLayout
 1591    ),
 1592    (   nonvar(Term1), Term1 = (:-Directive), nonvar(Directive)
 1593    ->  (   Directive = include(File),
 1594            '$current_source_module'(Module),
 1595            '$valid_directive'(Module:include(File))
 1596        ->  stream_property(In, encoding(Enc)),
 1597            '$add_encoding'(Enc, Options, Options1),
 1598            '$source_term'(File, Read, RLayout, Term, TLayout,
 1599                           Stream, Parents, Options1)
 1600        ;   Directive = encoding(Enc)
 1601        ->  set_stream(In, encoding(Enc)),
 1602            fail
 1603        ;   Term = Term1,
 1604            Stream = In,
 1605            Read = Raw
 1606        )
 1607    ;   Term = Term1,
 1608        TLayout = Layout1,
 1609        Stream = In,
 1610        Read = Raw,
 1611        RLayout = RawLayout
 1612    ).
 1613
 1614'$expansion_member'(Var, Layout, Var, Layout) :-
 1615    var(Var),
 1616    !.
 1617'$expansion_member'([], _, _, _) :- !, fail.
 1618'$expansion_member'(List, ListLayout, Term, Layout) :-
 1619    is_list(List),
 1620    !,
 1621    (   var(ListLayout)
 1622    ->  '$member'(Term, List)
 1623    ;   is_list(ListLayout)
 1624    ->  '$member_rep2'(Term, Layout, List, ListLayout)
 1625    ;   Layout = ListLayout,
 1626        '$member'(Term, List)
 1627    ).
 1628'$expansion_member'(X, Layout, X, Layout).
 1629
 1630% pairwise member, repeating last element of the second
 1631% list.
 1632
 1633'$member_rep2'(H1, H2, [H1|_], [H2|_]).
 1634'$member_rep2'(H1, H2, [_|T1], [T2]) :-
 1635    !,
 1636    '$member_rep2'(H1, H2, T1, [T2]).
 1637'$member_rep2'(H1, H2, [_|T1], [_|T2]) :-
 1638    '$member_rep2'(H1, H2, T1, T2).
 $add_encoding(+Enc, +Options0, -Options)
 1642'$add_encoding'(Enc, Options0, Options) :-
 1643    (   Options0 = [encoding(Enc)|_]
 1644    ->  Options = Options0
 1645    ;   Options = [encoding(Enc)|Options0]
 1646    ).
 1647
 1648
 1649:- multifile
 1650    '$included'/4.                  % Into, Line, File, LastModified
 1651:- dynamic
 1652    '$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'.

 1666'$record_included'([Parent|Parents], File, Path, Time,
 1667                   message(DoneMsgLevel,
 1668                           include_file(done(Level, file(File, Path))))) :-
 1669    source_location(SrcFile, Line),
 1670    !,
 1671    '$compilation_level'(Level),
 1672    '$load_msg_level'(include_file, Level, StartMsgLevel, DoneMsgLevel),
 1673    '$print_message'(StartMsgLevel,
 1674                     include_file(start(Level,
 1675                                        file(File, Path)))),
 1676    '$last'([Parent|Parents], Owner),
 1677    (   (   '$compilation_mode'(database)
 1678        ;   '$qlf_current_source'(Owner)
 1679        )
 1680    ->  '$store_admin_clause'(
 1681            system:'$included'(Parent, Line, Path, Time),
 1682            _, Owner, SrcFile:Line)
 1683    ;   '$qlf_include'(Owner, Parent, Line, Path, Time)
 1684    ).
 1685'$record_included'(_, _, _, _, true).
 $master_file(+File, -MasterFile)
Find the primary load file from included files.
 1691'$master_file'(File, MasterFile) :-
 1692    '$included'(MasterFile0, _Line, File, _Time),
 1693    !,
 1694    '$master_file'(MasterFile0, MasterFile).
 1695'$master_file'(File, File).
 1696
 1697
 1698'$skip_script_line'(_In, Options) :-
 1699    '$option'(check_script(false), Options),
 1700    !.
 1701'$skip_script_line'(In, _Options) :-
 1702    (   peek_char(In, #)
 1703    ->  skip(In, 10)
 1704    ;   true
 1705    ).
 1706
 1707'$set_encoding'(Stream, Options) :-
 1708    '$option'(encoding(Enc), Options),
 1709    !,
 1710    Enc \== default,
 1711    set_stream(Stream, encoding(Enc)).
 1712'$set_encoding'(_, _).
 1713
 1714
 1715'$prepare_load_stream'(In, Id, state(HasName,HasPos)) :-
 1716    (   stream_property(In, file_name(_))
 1717    ->  HasName = true,
 1718        (   stream_property(In, position(_))
 1719        ->  HasPos = true
 1720        ;   HasPos = false,
 1721            set_stream(In, record_position(true))
 1722        )
 1723    ;   HasName = false,
 1724        set_stream(In, file_name(Id)),
 1725        (   stream_property(In, position(_))
 1726        ->  HasPos = true
 1727        ;   HasPos = false,
 1728            set_stream(In, record_position(true))
 1729        )
 1730    ).
 1731
 1732'$restore_load_stream'(In, _State, Options) :-
 1733    memberchk(close(true), Options),
 1734    !,
 1735    close(In).
 1736'$restore_load_stream'(In, state(HasName, HasPos), _Options) :-
 1737    (   HasName == false
 1738    ->  set_stream(In, file_name(''))
 1739    ;   true
 1740    ),
 1741    (   HasPos == false
 1742    ->  set_stream(In, record_position(false))
 1743    ;   true
 1744    ).
 1745
 1746
 1747                 /*******************************
 1748                 *          DERIVED FILES       *
 1749                 *******************************/
 1750
 1751:- dynamic
 1752    '$derived_source_db'/3.         % Loaded, DerivedFrom, Time
 1753
 1754'$register_derived_source'(_, '-') :- !.
 1755'$register_derived_source'(Loaded, DerivedFrom) :-
 1756    retractall('$derived_source_db'(Loaded, _, _)),
 1757    time_file(DerivedFrom, Time),
 1758    assert('$derived_source_db'(Loaded, DerivedFrom, Time)).
 1759
 1760%       Auto-importing dynamic predicates is not very elegant and
 1761%       leads to problems with qsave_program/[1,2]
 1762
 1763'$derived_source'(Loaded, DerivedFrom, Time) :-
 1764    '$derived_source_db'(Loaded, DerivedFrom, Time).
 1765
 1766
 1767                /********************************
 1768                *       LOAD PREDICATES         *
 1769                *********************************/
 1770
 1771:- meta_predicate
 1772    ensure_loaded(:),
 1773    [:|+],
 1774    consult(:),
 1775    use_module(:),
 1776    use_module(:, +),
 1777    reexport(:),
 1778    reexport(:, +),
 1779    load_files(:),
 1780    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.
 1788ensure_loaded(Files) :-
 1789    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.
 1798use_module(Files) :-
 1799    load_files(Files, [ if(not_loaded),
 1800                        must_be_module(true)
 1801                      ]).
 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.
 1808use_module(File, Import) :-
 1809    load_files(File, [ if(not_loaded),
 1810                       must_be_module(true),
 1811                       imports(Import)
 1812                     ]).
 reexport(+Files)
As use_module/1, exporting all imported predicates.
 1818reexport(Files) :-
 1819    load_files(Files, [ if(not_loaded),
 1820                        must_be_module(true),
 1821                        reexport(true)
 1822                      ]).
 reexport(+File, +ImportList)
As use_module/1, re-exporting all imported predicates.
 1828reexport(File, Import) :-
 1829    load_files(File, [ if(not_loaded),
 1830                       must_be_module(true),
 1831                       imports(Import),
 1832                       reexport(true)
 1833                     ]).
 1834
 1835
 1836[X] :-
 1837    !,
 1838    consult(X).
 1839[M:F|R] :-
 1840    consult(M:[F|R]).
 1841
 1842consult(M:X) :-
 1843    X == user,
 1844    !,
 1845    flag('$user_consult', N, N+1),
 1846    NN is N + 1,
 1847    atom_concat('user://', NN, Id),
 1848    load_files(M:Id, [stream(user_input), check_script(false), silent(false)]).
 1849consult(List) :-
 1850    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.
 1857load_files(Files) :-
 1858    load_files(Files, []).
 1859load_files(Module:Files, Options) :-
 1860    '$must_be'(list, Options),
 1861    '$load_files'(Files, Module, Options).
 1862
 1863'$load_files'(X, _, _) :-
 1864    var(X),
 1865    !,
 1866    '$instantiation_error'(X).
 1867'$load_files'([], _, _) :- !.
 1868'$load_files'(Id, Module, Options) :-   % load_files(foo, [stream(In)])
 1869    '$option'(stream(_), Options),
 1870    !,
 1871    (   atom(Id)
 1872    ->  '$load_file'(Id, Module, Options)
 1873    ;   throw(error(type_error(atom, Id), _))
 1874    ).
 1875'$load_files'(List, Module, Options) :-
 1876    List = [_|_],
 1877    !,
 1878    '$must_be'(list, List),
 1879    '$load_file_list'(List, Module, Options).
 1880'$load_files'(File, Module, Options) :-
 1881    '$load_one_file'(File, Module, Options).
 1882
 1883'$load_file_list'([], _, _).
 1884'$load_file_list'([File|Rest], Module, Options) :-
 1885    E = error(_,_),
 1886    catch('$load_one_file'(File, Module, Options), E,
 1887          '$print_message'(error, E)),
 1888    '$load_file_list'(Rest, Module, Options).
 1889
 1890
 1891'$load_one_file'(Spec, Module, Options) :-
 1892    atomic(Spec),
 1893    '$option'(expand(Expand), Options, false),
 1894    Expand == true,
 1895    !,
 1896    expand_file_name(Spec, Expanded),
 1897    (   Expanded = [Load]
 1898    ->  true
 1899    ;   Load = Expanded
 1900    ),
 1901    '$load_files'(Load, Module, [expand(false)|Options]).
 1902'$load_one_file'(File, Module, Options) :-
 1903    strip_module(Module:File, Into, PlainFile),
 1904    '$load_file'(PlainFile, Into, Options).
 $noload(+Condition, +FullFile, +Options) is semidet
True of FullFile should not be loaded.
 1911'$noload'(true, _, _) :-
 1912    !,
 1913    fail.
 1914'$noload'(not_loaded, FullFile, _) :-
 1915    source_file(FullFile),
 1916    !.
 1917'$noload'(changed, Derived, _) :-
 1918    '$derived_source'(_FullFile, Derived, LoadTime),
 1919    time_file(Derived, Modified),
 1920    Modified @=< LoadTime,
 1921    !.
 1922'$noload'(changed, FullFile, Options) :-
 1923    '$time_source_file'(FullFile, LoadTime, user),
 1924    '$modified_id'(FullFile, Modified, Options),
 1925    Modified @=< LoadTime,
 1926    !.
 $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.
 1945'$qlf_file'(Spec, _, Spec, stream, Options) :-
 1946    '$option'(stream(_), Options),      % stream: no choice
 1947    !.
 1948'$qlf_file'(Spec, FullFile, FullFile, compile, _) :-
 1949    '$spec_extension'(Spec, Ext),       % user explicitly specified
 1950    user:prolog_file_type(Ext, prolog),
 1951    !.
 1952'$qlf_file'(Spec, FullFile, LoadFile, Mode, Options) :-
 1953    '$compilation_mode'(database),
 1954    file_name_extension(Base, PlExt, FullFile),
 1955    user:prolog_file_type(PlExt, prolog),
 1956    user:prolog_file_type(QlfExt, qlf),
 1957    file_name_extension(Base, QlfExt, QlfFile),
 1958    (   access_file(QlfFile, read),
 1959        (   '$qlf_out_of_date'(FullFile, QlfFile, Why)
 1960        ->  (   access_file(QlfFile, write)
 1961            ->  print_message(informational,
 1962                              qlf(recompile(Spec, FullFile, QlfFile, Why))),
 1963                Mode = qcompile
 1964            ;   print_message(warning,
 1965                              qlf(can_not_recompile(Spec, QlfFile, Why))),
 1966                Mode = compile
 1967            ),
 1968            LoadFile = FullFile
 1969        ;   Mode = qload,
 1970            LoadFile = QlfFile
 1971        )
 1972    ->  !
 1973    ;   '$qlf_auto'(FullFile, QlfFile, Options)
 1974    ->  !, Mode = qcompile,
 1975        LoadFile = FullFile
 1976    ).
 1977'$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.
 1985'$qlf_out_of_date'(PlFile, QlfFile, Why) :-
 1986    (   access_file(PlFile, read)
 1987    ->  time_file(PlFile, PlTime),
 1988        time_file(QlfFile, QlfTime),
 1989        (   PlTime > QlfTime
 1990        ->  Why = old                   % PlFile is newer
 1991        ;   Error = error(Formal,_),
 1992            catch('$qlf_sources'(QlfFile, _Files), Error, true),
 1993            nonvar(Formal)              % QlfFile is incompatible
 1994        ->  Why = Error
 1995        ;   fail                        % QlfFile is up-to-date and ok
 1996        )
 1997    ;   fail                            % can not read .pl; try .qlf
 1998    ).
 $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.
 2006:- create_prolog_flag(qcompile, false, [type(atom)]). 2007
 2008'$qlf_auto'(PlFile, QlfFile, Options) :-
 2009    (   memberchk(qcompile(QlfMode), Options)
 2010    ->  true
 2011    ;   current_prolog_flag(qcompile, QlfMode),
 2012        \+ '$in_system_dir'(PlFile)
 2013    ),
 2014    (   QlfMode == auto
 2015    ->  true
 2016    ;   QlfMode == large,
 2017        size_file(PlFile, Size),
 2018        Size > 100000
 2019    ),
 2020    access_file(QlfFile, write).
 2021
 2022'$in_system_dir'(PlFile) :-
 2023    current_prolog_flag(home, Home),
 2024    sub_atom(PlFile, 0, _, _, Home).
 2025
 2026'$spec_extension'(File, Ext) :-
 2027    atom(File),
 2028    file_name_extension(_, Ext, File).
 2029'$spec_extension'(Spec, Ext) :-
 2030    compound(Spec),
 2031    arg(1, Spec, Arg),
 2032    '$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:
 2044:- dynamic
 2045    '$resolved_source_path'/2.                  % ?Spec, ?Path
 2046
 2047'$load_file'(File, Module, Options) :-
 2048    \+ memberchk(stream(_), Options),
 2049    user:prolog_load_file(Module:File, Options),
 2050    !.
 2051'$load_file'(File, Module, Options) :-
 2052    memberchk(stream(_), Options),
 2053    !,
 2054    '$assert_load_context_module'(File, Module, Options),
 2055    '$qdo_load_file'(File, File, Module, Action, Options),
 2056    '$run_initialization'(File, Action, Options).
 2057'$load_file'(File, Module, Options) :-
 2058    '$resolved_source_path'(File, FullFile),
 2059    (   '$source_file_property'(FullFile, from_state, true)
 2060    ;   '$source_file_property'(FullFile, resource, true)
 2061    ;   '$option'(if(If), Options, true),
 2062        '$noload'(If, FullFile, Options)
 2063    ),
 2064    !,
 2065    '$already_loaded'(File, FullFile, Module, Options).
 2066'$load_file'(File, Module, Options) :-
 2067    absolute_file_name(File, FullFile,
 2068                       [ file_type(prolog),
 2069                         access(read)
 2070                       ]),
 2071    '$register_resolved_source_path'(File, FullFile),
 2072    '$mt_load_file'(File, FullFile, Module, Options),
 2073    '$register_resource_file'(FullFile).
 2074
 2075'$register_resolved_source_path'(File, FullFile) :-
 2076    '$resolved_source_path'(File, FullFile),
 2077    !.
 2078'$register_resolved_source_path'(File, FullFile) :-
 2079    compound(File),
 2080    !,
 2081    asserta('$resolved_source_path'(File, FullFile)).
 2082'$register_resolved_source_path'(_, _).
 $translated_source(+Old, +New) is det
Called from loading a QLF state when source files are being renamed.
 2088:- public '$translated_source'/2. 2089'$translated_source'(Old, New) :-
 2090    forall(retract('$resolved_source_path'(File, Old)),
 2091           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.
 2098'$register_resource_file'(FullFile) :-
 2099    (   sub_atom(FullFile, 0, _, _, 'res://')
 2100    ->  '$set_source_file'(FullFile, resource, true)
 2101    ;   true
 2102    ).
 $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.
 2115'$already_loaded'(_File, FullFile, Module, Options) :-
 2116    '$assert_load_context_module'(FullFile, Module, Options),
 2117    '$current_module'(LoadModules, FullFile),
 2118    !,
 2119    (   atom(LoadModules)
 2120    ->  LoadModule = LoadModules
 2121    ;   LoadModules = [LoadModule|_]
 2122    ),
 2123    '$import_from_loaded_module'(LoadModule, Module, Options).
 2124'$already_loaded'(_, _, user, _) :- !.
 2125'$already_loaded'(File, _, Module, Options) :-
 2126    '$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.

 2141:- dynamic
 2142    '$loading_file'/3.              % File, Queue, Thread
 2143:- volatile
 2144    '$loading_file'/3. 2145
 2146'$mt_load_file'(File, FullFile, Module, Options) :-
 2147    current_prolog_flag(threads, true),
 2148    !,
 2149    setup_call_cleanup(
 2150        with_mutex('$load_file',
 2151                   '$mt_start_load'(FullFile, Loading, Options)),
 2152        '$mt_do_load'(Loading, File, FullFile, Module, Options),
 2153        '$mt_end_load'(Loading)).
 2154'$mt_load_file'(File, FullFile, Module, Options) :-
 2155    '$option'(if(If), Options, true),
 2156    '$noload'(If, FullFile, Options),
 2157    !,
 2158    '$already_loaded'(File, FullFile, Module, Options).
 2159'$mt_load_file'(File, FullFile, Module, Options) :-
 2160    '$qdo_load_file'(File, FullFile, Module, Action, Options),
 2161    '$run_initialization'(FullFile, Action, Options).
 2162
 2163'$mt_start_load'(FullFile, queue(Queue), _) :-
 2164    '$loading_file'(FullFile, Queue, LoadThread),
 2165    \+ thread_self(LoadThread),
 2166    !.
 2167'$mt_start_load'(FullFile, already_loaded, Options) :-
 2168    '$option'(if(If), Options, true),
 2169    '$noload'(If, FullFile, Options),
 2170    !.
 2171'$mt_start_load'(FullFile, Ref, _) :-
 2172    thread_self(Me),
 2173    message_queue_create(Queue),
 2174    assertz('$loading_file'(FullFile, Queue, Me), Ref).
 2175
 2176'$mt_do_load'(queue(Queue), File, FullFile, Module, Options) :-
 2177    !,
 2178    catch(thread_get_message(Queue, _), error(_,_), true),
 2179    '$already_loaded'(File, FullFile, Module, Options).
 2180'$mt_do_load'(already_loaded, File, FullFile, Module, Options) :-
 2181    !,
 2182    '$already_loaded'(File, FullFile, Module, Options).
 2183'$mt_do_load'(_Ref, File, FullFile, Module, Options) :-
 2184    '$assert_load_context_module'(FullFile, Module, Options),
 2185    '$qdo_load_file'(File, FullFile, Module, Action, Options),
 2186    '$run_initialization'(FullFile, Action, Options).
 2187
 2188'$mt_end_load'(queue(_)) :- !.
 2189'$mt_end_load'(already_loaded) :- !.
 2190'$mt_end_load'(Ref) :-
 2191    clause('$loading_file'(_, Queue, _), _, Ref),
 2192    erase(Ref),
 2193    thread_send_message(Queue, done),
 2194    message_queue_destroy(Queue).
 $qdo_load_file(+Spec, +FullFile, +ContextModule, +Options) is det
Switch to qcompile mode if requested by the option '$qlf'(+Out)
 2201'$qdo_load_file'(File, FullFile, Module, Action, Options) :-
 2202    memberchk('$qlf'(QlfOut), Options),
 2203    '$stage_file'(QlfOut, StageQlf),
 2204    !,
 2205    setup_call_catcher_cleanup(
 2206        '$qstart'(StageQlf, Module, State),
 2207        '$do_load_file'(File, FullFile, Module, Action, Options),
 2208        Catcher,
 2209        '$qend'(State, Catcher, StageQlf, QlfOut)).
 2210'$qdo_load_file'(File, FullFile, Module, Action, Options) :-
 2211    '$do_load_file'(File, FullFile, Module, Action, Options).
 2212
 2213'$qstart'(Qlf, Module, state(OldMode, OldModule)) :-
 2214    '$qlf_open'(Qlf),
 2215    '$compilation_mode'(OldMode, qlf),
 2216    '$set_source_module'(OldModule, Module).
 2217
 2218'$qend'(state(OldMode, OldModule), Catcher, StageQlf, QlfOut) :-
 2219    '$set_source_module'(_, OldModule),
 2220    '$set_compilation_mode'(OldMode),
 2221    '$qlf_close',
 2222    '$install_staged_file'(Catcher, StageQlf, QlfOut, warn).
 2223
 2224'$set_source_module'(OldModule, Module) :-
 2225    '$current_source_module'(OldModule),
 2226    '$set_source_module'(Module).
 $do_load_file(+Spec, +FullFile, +ContextModule, -Action, +Options) is det
Perform the actual loading.
 2233'$do_load_file'(File, FullFile, Module, Action, Options) :-
 2234    '$option'(derived_from(DerivedFrom), Options, -),
 2235    '$register_derived_source'(FullFile, DerivedFrom),
 2236    '$qlf_file'(File, FullFile, Absolute, Mode, Options),
 2237    (   Mode == qcompile
 2238    ->  qcompile(Module:File, Options)
 2239    ;   '$do_load_file_2'(File, Absolute, Module, Action, Options)
 2240    ).
 2241
 2242'$do_load_file_2'(File, Absolute, Module, Action, Options) :-
 2243    '$source_file_property'(Absolute, number_of_clauses, OldClauses),
 2244    statistics(cputime, OldTime),
 2245
 2246    '$setup_load'(ScopedFlags, OldSandBoxed, OldVerbose, OldAutoLevel, OldXRef,
 2247                  Options),
 2248
 2249    '$compilation_level'(Level),
 2250    '$load_msg_level'(load_file, Level, StartMsgLevel, DoneMsgLevel),
 2251    '$print_message'(StartMsgLevel,
 2252                     load_file(start(Level,
 2253                                     file(File, Absolute)))),
 2254
 2255    (   memberchk(stream(FromStream), Options)
 2256    ->  Input = stream
 2257    ;   Input = source
 2258    ),
 2259
 2260    (   Input == stream,
 2261        (   '$option'(format(qlf), Options, source)
 2262        ->  set_stream(FromStream, file_name(Absolute)),
 2263            '$qload_stream'(FromStream, Module, Action, LM, Options)
 2264        ;   '$consult_file'(stream(Absolute, FromStream, []),
 2265                            Module, Action, LM, Options)
 2266        )
 2267    ->  true
 2268    ;   Input == source,
 2269        file_name_extension(_, Ext, Absolute),
 2270        (   user:prolog_file_type(Ext, qlf),
 2271            E = error(_,_),
 2272            catch('$qload_file'(Absolute, Module, Action, LM, Options),
 2273                  E,
 2274                  print_message(warning, E))
 2275        ->  true
 2276        ;   '$consult_file'(Absolute, Module, Action, LM, Options)
 2277        )
 2278    ->  true
 2279    ;   '$print_message'(error, load_file(failed(File))),
 2280        fail
 2281    ),
 2282
 2283    '$import_from_loaded_module'(LM, Module, Options),
 2284
 2285    '$source_file_property'(Absolute, number_of_clauses, NewClauses),
 2286    statistics(cputime, Time),
 2287    ClausesCreated is NewClauses - OldClauses,
 2288    TimeUsed is Time - OldTime,
 2289
 2290    '$print_message'(DoneMsgLevel,
 2291                     load_file(done(Level,
 2292                                    file(File, Absolute),
 2293                                    Action,
 2294                                    LM,
 2295                                    TimeUsed,
 2296                                    ClausesCreated))),
 2297
 2298    '$restore_load'(ScopedFlags, OldSandBoxed, OldVerbose, OldAutoLevel, OldXRef).
 2299
 2300'$setup_load'(ScopedFlags, OldSandBoxed, OldVerbose, OldAutoLevel, OldXRef,
 2301              Options) :-
 2302    '$save_file_scoped_flags'(ScopedFlags),
 2303    '$set_sandboxed_load'(Options, OldSandBoxed),
 2304    '$set_verbose_load'(Options, OldVerbose),
 2305    '$set_optimise_load'(Options),
 2306    '$update_autoload_level'(Options, OldAutoLevel),
 2307    '$set_no_xref'(OldXRef).
 2308
 2309'$restore_load'(ScopedFlags, OldSandBoxed, OldVerbose, OldAutoLevel, OldXRef) :-
 2310    '$set_autoload_level'(OldAutoLevel),
 2311    set_prolog_flag(xref, OldXRef),
 2312    set_prolog_flag(verbose_load, OldVerbose),
 2313    set_prolog_flag(sandboxed_load, OldSandBoxed),
 2314    '$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.
 2322'$save_file_scoped_flags'(State) :-
 2323    current_predicate(findall/3),          % Not when doing boot compile
 2324    !,
 2325    findall(SavedFlag, '$save_file_scoped_flag'(SavedFlag), State).
 2326'$save_file_scoped_flags'([]).
 2327
 2328'$save_file_scoped_flag'(Flag-Value) :-
 2329    '$file_scoped_flag'(Flag, Default),
 2330    (   current_prolog_flag(Flag, Value)
 2331    ->  true
 2332    ;   Value = Default
 2333    ).
 2334
 2335'$file_scoped_flag'(generate_debug_info, true).
 2336'$file_scoped_flag'(optimise,            false).
 2337'$file_scoped_flag'(xref,                false).
 2338
 2339'$restore_file_scoped_flags'([]).
 2340'$restore_file_scoped_flags'([Flag-Value|T]) :-
 2341    set_prolog_flag(Flag, Value),
 2342    '$restore_file_scoped_flags'(T).
 $import_from_loaded_module(LoadedModule, Module, Options) is det
Import public predicates from LoadedModule into Module
 2349'$import_from_loaded_module'(LoadedModule, Module, Options) :-
 2350    LoadedModule \== Module,
 2351    atom(LoadedModule),
 2352    !,
 2353    '$option'(imports(Import), Options, all),
 2354    '$option'(reexport(Reexport), Options, false),
 2355    '$import_list'(Module, LoadedModule, Import, Reexport).
 2356'$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.
 2364'$set_verbose_load'(Options, Old) :-
 2365    current_prolog_flag(verbose_load, Old),
 2366    (   memberchk(silent(Silent), Options)
 2367    ->  (   '$negate'(Silent, Level0)
 2368        ->  '$load_msg_compat'(Level0, Level)
 2369        ;   Level = Silent
 2370        ),
 2371        set_prolog_flag(verbose_load, Level)
 2372    ;   true
 2373    ).
 2374
 2375'$negate'(true, false).
 2376'$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, -)
 2385'$set_sandboxed_load'(Options, Old) :-
 2386    current_prolog_flag(sandboxed_load, Old),
 2387    (   memberchk(sandboxed(SandBoxed), Options),
 2388        '$enter_sandboxed'(Old, SandBoxed, New),
 2389        New \== Old
 2390    ->  set_prolog_flag(sandboxed_load, New)
 2391    ;   true
 2392    ).
 2393
 2394'$enter_sandboxed'(Old, New, SandBoxed) :-
 2395    (   Old == false, New == true
 2396    ->  SandBoxed = true,
 2397        '$ensure_loaded_library_sandbox'
 2398    ;   Old == true, New == false
 2399    ->  throw(error(permission_error(leave, sandbox, -), _))
 2400    ;   SandBoxed = Old
 2401    ).
 2402'$enter_sandboxed'(false, true, true).
 2403
 2404'$ensure_loaded_library_sandbox' :-
 2405    source_file_property(library(sandbox), module(sandbox)),
 2406    !.
 2407'$ensure_loaded_library_sandbox' :-
 2408    load_files(library(sandbox), [if(not_loaded), silent(true)]).
 2409
 2410'$set_optimise_load'(Options) :-
 2411    (   '$option'(optimise(Optimise), Options)
 2412    ->  set_prolog_flag(optimise, Optimise)
 2413    ;   true
 2414    ).
 2415
 2416'$set_no_xref'(OldXRef) :-
 2417    (   current_prolog_flag(xref, OldXRef)
 2418    ->  true
 2419    ;   OldXRef = false
 2420    ),
 2421    set_prolog_flag(xref, false).
 $update_autoload_level(+Options, -OldLevel)
Update the '$autoload_nesting' and return the old value.
 2428:- thread_local
 2429    '$autoload_nesting'/1. 2430
 2431'$update_autoload_level'(Options, AutoLevel) :-
 2432    '$option'(autoload(Autoload), Options, false),
 2433    (   '$autoload_nesting'(CurrentLevel)
 2434    ->  AutoLevel = CurrentLevel
 2435    ;   AutoLevel = 0
 2436    ),
 2437    (   Autoload == false
 2438    ->  true
 2439    ;   NewLevel is AutoLevel + 1,
 2440        '$set_autoload_level'(NewLevel)
 2441    ).
 2442
 2443'$set_autoload_level'(New) :-
 2444    retractall('$autoload_nesting'(_)),
 2445    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.
 2453'$print_message'(Level, Term) :-
 2454    current_predicate(system:print_message/2),
 2455    !,
 2456    print_message(Level, Term).
 2457'$print_message'(warning, Term) :-
 2458    source_location(File, Line),
 2459    !,
 2460    format(user_error, 'WARNING: ~w:~w: ~p~n', [File, Line, Term]).
 2461'$print_message'(error, Term) :-
 2462    !,
 2463    source_location(File, Line),
 2464    !,
 2465    format(user_error, 'ERROR: ~w:~w: ~p~n', [File, Line, Term]).
 2466'$print_message'(_Level, _Term).
 2467
 2468'$print_message_fail'(E) :-
 2469    '$print_message'(error, E),
 2470    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.
 2478'$consult_file'(Absolute, Module, What, LM, Options) :-
 2479    '$current_source_module'(Module),   % same module
 2480    !,
 2481    '$consult_file_2'(Absolute, Module, What, LM, Options).
 2482'$consult_file'(Absolute, Module, What, LM, Options) :-
 2483    '$set_source_module'(OldModule, Module),
 2484    '$ifcompiling'('$qlf_start_sub_module'(Module)),
 2485    '$consult_file_2'(Absolute, Module, What, LM, Options),
 2486    '$ifcompiling'('$qlf_end_part'),
 2487    '$set_source_module'(OldModule).
 2488
 2489'$consult_file_2'(Absolute, Module, What, LM, Options) :-
 2490    '$set_source_module'(OldModule, Module),
 2491    '$load_id'(Absolute, Id, Modified, Options),
 2492    '$start_consult'(Id, Modified),
 2493    (   '$derived_source'(Absolute, DerivedFrom, _)
 2494    ->  '$modified_id'(DerivedFrom, DerivedModified, Options),
 2495        '$start_consult'(DerivedFrom, DerivedModified)
 2496    ;   true
 2497    ),
 2498    '$compile_type'(What),
 2499    '$save_lex_state'(LexState, Options),
 2500    '$set_dialect'(Options),
 2501    call_cleanup('$load_file'(Absolute, Id, LM, Options),
 2502                 '$end_consult'(LexState, OldModule)).
 2503
 2504'$end_consult'(LexState, OldModule) :-
 2505    '$restore_lex_state'(LexState),
 2506    '$set_source_module'(OldModule).
 2507
 2508
 2509:- create_prolog_flag(emulated_dialect, swi, [type(atom)]).
 $save_lex_state(-LexState, +Options) is det
 2513'$save_lex_state'(State, Options) :-
 2514    memberchk(scope_settings(false), Options),
 2515    !,
 2516    State = (-).
 2517'$save_lex_state'(lexstate(Style, Dialect), _) :-
 2518    '$style_check'(Style, Style),
 2519    current_prolog_flag(emulated_dialect, Dialect).
 2520
 2521'$restore_lex_state'(-) :- !.
 2522'$restore_lex_state'(lexstate(Style, Dialect)) :-
 2523    '$style_check'(_, Style),
 2524    set_prolog_flag(emulated_dialect, Dialect).
 2525
 2526'$set_dialect'(Options) :-
 2527    memberchk(dialect(Dialect), Options),
 2528    !,
 2529    expects_dialect(Dialect).               % Autoloaded from library
 2530'$set_dialect'(_).
 2531
 2532'$load_id'(stream(Id, _, _), Id, Modified, Options) :-
 2533    !,
 2534    '$modified_id'(Id, Modified, Options).
 2535'$load_id'(Id, Id, Modified, Options) :-
 2536    '$modified_id'(Id, Modified, Options).
 2537
 2538'$modified_id'(_, Modified, Options) :-
 2539    '$option'(modified(Stamp), Options, Def),
 2540    Stamp \== Def,
 2541    !,
 2542    Modified = Stamp.
 2543'$modified_id'(Id, Modified, _) :-
 2544    catch(time_file(Id, Modified),
 2545          error(_, _),
 2546          fail),
 2547    !.
 2548'$modified_id'(_, 0.0, _).
 2549
 2550
 2551'$compile_type'(What) :-
 2552    '$compilation_mode'(How),
 2553    (   How == database
 2554    ->  What = compiled
 2555    ;   How == qlf
 2556    ->  What = '*qcompiled*'
 2557    ;   What = 'boot compiled'
 2558    ).
 $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.
 2568:- dynamic
 2569    '$load_context_module'/3. 2570:- multifile
 2571    '$load_context_module'/3. 2572
 2573'$assert_load_context_module'(_, _, Options) :-
 2574    memberchk(register(false), Options),
 2575    !.
 2576'$assert_load_context_module'(File, Module, Options) :-
 2577    source_location(FromFile, Line),
 2578    !,
 2579    '$master_file'(FromFile, MasterFile),
 2580    '$check_load_non_module'(File, Module),
 2581    '$add_dialect'(Options, Options1),
 2582    '$load_ctx_options'(Options1, Options2),
 2583    '$store_admin_clause'(
 2584        system:'$load_context_module'(File, Module, Options2),
 2585        _Layout, MasterFile, FromFile:Line).
 2586'$assert_load_context_module'(File, Module, Options) :-
 2587    '$check_load_non_module'(File, Module),
 2588    '$add_dialect'(Options, Options1),
 2589    '$load_ctx_options'(Options1, Options2),
 2590    (   clause('$load_context_module'(File, Module, _), true, Ref),
 2591        \+ clause_property(Ref, file(_)),
 2592        erase(Ref)
 2593    ->  true
 2594    ;   true
 2595    ),
 2596    assertz('$load_context_module'(File, Module, Options2)).
 2597
 2598'$add_dialect'(Options0, Options) :-
 2599    current_prolog_flag(emulated_dialect, Dialect), Dialect \== swi,
 2600    !,
 2601    Options = [dialect(Dialect)|Options0].
 2602'$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.
 2609'$load_ctx_options'([], []).
 2610'$load_ctx_options'([H|T0], [H|T]) :-
 2611    '$load_ctx_option'(H),
 2612    !,
 2613    '$load_ctx_options'(T0, T).
 2614'$load_ctx_options'([_|T0], T) :-
 2615    '$load_ctx_options'(T0, T).
 2616
 2617'$load_ctx_option'(derived_from(_)).
 2618'$load_ctx_option'(dialect(_)).
 2619'$load_ctx_option'(encoding(_)).
 2620'$load_ctx_option'(imports(_)).
 2621'$load_ctx_option'(reexport(_)).
 $check_load_non_module(+File) is det
Test that a non-module file is not loaded into multiple contexts.
 2629'$check_load_non_module'(File, _) :-
 2630    '$current_module'(_, File),
 2631    !.          % File is a module file
 2632'$check_load_non_module'(File, Module) :-
 2633    '$load_context_module'(File, OldModule, _),
 2634    Module \== OldModule,
 2635    !,
 2636    format(atom(Msg),
 2637           'Non-module file already loaded into module ~w; \c
 2638               trying to load into ~w',
 2639           [OldModule, Module]),
 2640    throw(error(permission_error(load, source, File),
 2641                context(load_files/2, Msg))).
 2642'$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)
 2655'$load_file'(Path, Id, Module, Options) :-
 2656    State = state(true, _, true, false, Id, -),
 2657    (   '$source_term'(Path, _Read, _Layout, Term, Layout,
 2658                       _Stream, Options),
 2659        '$valid_term'(Term),
 2660        (   arg(1, State, true)
 2661        ->  '$first_term'(Term, Layout, Id, State, Options),
 2662            nb_setarg(1, State, false)
 2663        ;   '$compile_term'(Term, Layout, Id)
 2664        ),
 2665        arg(4, State, true)
 2666    ;   '$end_load_file'(State)
 2667    ),
 2668    !,
 2669    arg(2, State, Module).
 2670
 2671'$valid_term'(Var) :-
 2672    var(Var),
 2673    !,
 2674    print_message(error, error(instantiation_error, _)).
 2675'$valid_term'(Term) :-
 2676    Term \== [].
 2677
 2678'$end_load_file'(State) :-
 2679    arg(1, State, true),           % empty file
 2680    !,
 2681    nb_setarg(2, State, Module),
 2682    arg(5, State, Id),
 2683    '$current_source_module'(Module),
 2684    '$ifcompiling'('$qlf_start_file'(Id)),
 2685    '$ifcompiling'('$qlf_end_part').
 2686'$end_load_file'(State) :-
 2687    arg(3, State, End),
 2688    '$end_load_file'(End, State).
 2689
 2690'$end_load_file'(true, _).
 2691'$end_load_file'(end_module, State) :-
 2692    arg(2, State, Module),
 2693    '$check_export'(Module),
 2694    '$ifcompiling'('$qlf_end_part').
 2695'$end_load_file'(end_non_module, _State) :-
 2696    '$ifcompiling'('$qlf_end_part').
 2697
 2698
 2699'$first_term'(?-(Directive), Layout, Id, State, Options) :-
 2700    !,
 2701    '$first_term'(:-(Directive), Layout, Id, State, Options).
 2702'$first_term'(:-(Directive), _Layout, Id, State, Options) :-
 2703    nonvar(Directive),
 2704    (   (   Directive = module(Name, Public)
 2705        ->  Imports = []
 2706        ;   Directive = module(Name, Public, Imports)
 2707        )
 2708    ->  !,
 2709        '$module_name'(Name, Id, Module, Options),
 2710        '$start_module'(Module, Public, State, Options),
 2711        '$module3'(Imports)
 2712    ;   Directive = expects_dialect(Dialect)
 2713    ->  !,
 2714        '$set_dialect'(Dialect, State),
 2715        fail                        % Still consider next term as first
 2716    ).
 2717'$first_term'(Term, Layout, Id, State, Options) :-
 2718    '$start_non_module'(Id, State, Options),
 2719    '$compile_term'(Term, Layout, Id).
 2720
 2721'$compile_term'(Term, Layout, Id) :-
 2722    '$compile_term'(Term, Layout, Id, -).
 2723
 2724'$compile_term'(Var, _Layout, _Id, _Src) :-
 2725    var(Var),
 2726    !,
 2727    '$instantiation_error'(Var).
 2728'$compile_term'((?-Directive), _Layout, Id, _) :-
 2729    !,
 2730    '$execute_directive'(Directive, Id).
 2731'$compile_term'((:-Directive), _Layout, Id, _) :-
 2732    !,
 2733    '$execute_directive'(Directive, Id).
 2734'$compile_term'('$source_location'(File, Line):Term, Layout, Id, _) :-
 2735    !,
 2736    '$compile_term'(Term, Layout, Id, File:Line).
 2737'$compile_term'(Clause, Layout, Id, SrcLoc) :-
 2738    E = error(_,_),
 2739    catch('$store_clause'(Clause, Layout, Id, SrcLoc), E,
 2740          '$print_message'(error, E)).
 2741
 2742'$start_non_module'(Id, _State, Options) :-
 2743    '$option'(must_be_module(true), Options, false),
 2744    !,
 2745    throw(error(domain_error(module_file, Id), _)).
 2746'$start_non_module'(Id, State, _Options) :-
 2747    '$current_source_module'(Module),
 2748    '$ifcompiling'('$qlf_start_file'(Id)),
 2749    '$qset_dialect'(State),
 2750    nb_setarg(2, State, Module),
 2751    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.

 2764'$set_dialect'(Dialect, State) :-
 2765    '$compilation_mode'(qlf, database),
 2766    !,
 2767    expects_dialect(Dialect),
 2768    '$compilation_mode'(_, qlf),
 2769    nb_setarg(6, State, Dialect).
 2770'$set_dialect'(Dialect, _) :-
 2771    expects_dialect(Dialect).
 2772
 2773'$qset_dialect'(State) :-
 2774    '$compilation_mode'(qlf),
 2775    arg(6, State, Dialect), Dialect \== (-),
 2776    !,
 2777    '$add_directive_wic'(expects_dialect(Dialect)).
 2778'$qset_dialect'(_).
 2779
 2780
 2781                 /*******************************
 2782                 *           MODULES            *
 2783                 *******************************/
 2784
 2785'$start_module'(Module, _Public, State, _Options) :-
 2786    '$current_module'(Module, OldFile),
 2787    source_location(File, _Line),
 2788    OldFile \== File, OldFile \== [],
 2789    same_file(OldFile, File),
 2790    !,
 2791    nb_setarg(2, State, Module),
 2792    nb_setarg(4, State, true).      % Stop processing
 2793'$start_module'(Module, Public, State, Options) :-
 2794    arg(5, State, File),
 2795    nb_setarg(2, State, Module),
 2796    source_location(_File, Line),
 2797    '$option'(redefine_module(Action), Options, false),
 2798    '$module_class'(File, Class, Super),
 2799    '$redefine_module'(Module, File, Action),
 2800    '$declare_module'(Module, Class, Super, File, Line, false),
 2801    '$export_list'(Public, Module, Ops),
 2802    '$ifcompiling'('$qlf_start_module'(Module)),
 2803    '$export_ops'(Ops, Module, File),
 2804    '$qset_dialect'(State),
 2805    nb_setarg(3, State, end_module).
 $module3(+Spec) is det
Handle the 3th argument of a module declartion.
 2812'$module3'(Var) :-
 2813    var(Var),
 2814    !,
 2815    '$instantiation_error'(Var).
 2816'$module3'([]) :- !.
 2817'$module3'([H|T]) :-
 2818    !,
 2819    '$module3'(H),
 2820    '$module3'(T).
 2821'$module3'(Id) :-
 2822    use_module(library(dialect/Id)).
 $module_name(?Name, +Id, -Module, +Options) is semidet
Determine the module name. There are some cases:
 2836'$module_name'(_, _, Module, Options) :-
 2837    '$option'(module(Module), Options),
 2838    !,
 2839    '$current_source_module'(Context),
 2840    Context \== Module.                     % cause '$first_term'/5 to fail.
 2841'$module_name'(Var, Id, Module, Options) :-
 2842    var(Var),
 2843    !,
 2844    file_base_name(Id, File),
 2845    file_name_extension(Var, _, File),
 2846    '$module_name'(Var, Id, Module, Options).
 2847'$module_name'(Reserved, _, _, _) :-
 2848    '$reserved_module'(Reserved),
 2849    !,
 2850    throw(error(permission_error(load, module, Reserved), _)).
 2851'$module_name'(Module, _Id, Module, _).
 2852
 2853
 2854'$reserved_module'(system).
 2855'$reserved_module'(user).
 $redefine_module(+Module, +File, -Redefine)
 2860'$redefine_module'(_Module, _, false) :- !.
 2861'$redefine_module'(Module, File, true) :-
 2862    !,
 2863    (   module_property(Module, file(OldFile)),
 2864        File \== OldFile
 2865    ->  unload_file(OldFile)
 2866    ;   true
 2867    ).
 2868'$redefine_module'(Module, File, ask) :-
 2869    (   stream_property(user_input, tty(true)),
 2870        module_property(Module, file(OldFile)),
 2871        File \== OldFile,
 2872        '$rdef_response'(Module, OldFile, File, true)
 2873    ->  '$redefine_module'(Module, File, true)
 2874    ;   true
 2875    ).
 2876
 2877'$rdef_response'(Module, OldFile, File, Ok) :-
 2878    repeat,
 2879    print_message(query, redefine_module(Module, OldFile, File)),
 2880    get_single_char(Char),
 2881    '$rdef_response'(Char, Ok0),
 2882    !,
 2883    Ok = Ok0.
 2884
 2885'$rdef_response'(Char, true) :-
 2886    memberchk(Char, `yY`),
 2887    format(user_error, 'yes~n', []).
 2888'$rdef_response'(Char, false) :-
 2889    memberchk(Char, `nN`),
 2890    format(user_error, 'no~n', []).
 2891'$rdef_response'(Char, _) :-
 2892    memberchk(Char, `a`),
 2893    format(user_error, 'abort~n', []),
 2894    abort.
 2895'$rdef_response'(_, _) :-
 2896    print_message(help, redefine_module_reply),
 2897    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.
 2906'$module_class'(File, Class, system) :-
 2907    current_prolog_flag(home, Home),
 2908    sub_atom(File, 0, Len, _, Home),
 2909    !,
 2910    (   sub_atom(File, Len, _, _, '/boot/')
 2911    ->  Class = system
 2912    ;   Class = library
 2913    ).
 2914'$module_class'(_, user, user).
 2915
 2916'$check_export'(Module) :-
 2917    '$undefined_export'(Module, UndefList),
 2918    (   '$member'(Undef, UndefList),
 2919        strip_module(Undef, _, Local),
 2920        print_message(error,
 2921                      undefined_export(Module, Local)),
 2922        fail
 2923    ;   true
 2924    ).
 $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).
 2933'$import_list'(_, _, Var, _) :-
 2934    var(Var),
 2935    !,
 2936    throw(error(instantitation_error, _)).
 2937'$import_list'(Target, Source, all, Reexport) :-
 2938    !,
 2939    '$exported_ops'(Source, Import, Predicates),
 2940    '$module_property'(Source, exports(Predicates)),
 2941    '$import_all'(Import, Target, Source, Reexport, weak).
 2942'$import_list'(Target, Source, except(Spec), Reexport) :-
 2943    !,
 2944    '$exported_ops'(Source, Export, Predicates),
 2945    '$module_property'(Source, exports(Predicates)),
 2946    (   is_list(Spec)
 2947    ->  true
 2948    ;   throw(error(type_error(list, Spec), _))
 2949    ),
 2950    '$import_except'(Spec, Export, Import),
 2951    '$import_all'(Import, Target, Source, Reexport, weak).
 2952'$import_list'(Target, Source, Import, Reexport) :-
 2953    !,
 2954    is_list(Import),
 2955    !,
 2956    '$import_all'(Import, Target, Source, Reexport, strong).
 2957'$import_list'(_, _, Import, _) :-
 2958    throw(error(type_error(import_specifier, Import))).
 2959
 2960
 2961'$import_except'([], List, List).
 2962'$import_except'([H|T], List0, List) :-
 2963    '$import_except_1'(H, List0, List1),
 2964    '$import_except'(T, List1, List).
 2965
 2966'$import_except_1'(Var, _, _) :-
 2967    var(Var),
 2968    !,
 2969    throw(error(instantitation_error, _)).
 2970'$import_except_1'(PI as N, List0, List) :-
 2971    '$pi'(PI), atom(N),
 2972    !,
 2973    '$canonical_pi'(PI, CPI),
 2974    '$import_as'(CPI, N, List0, List).
 2975'$import_except_1'(op(P,A,N), List0, List) :-
 2976    !,
 2977    '$remove_ops'(List0, op(P,A,N), List).
 2978'$import_except_1'(PI, List0, List) :-
 2979    '$pi'(PI),
 2980    !,
 2981    '$canonical_pi'(PI, CPI),
 2982    '$select'(P, List0, List),
 2983    '$canonical_pi'(CPI, P),
 2984    !.
 2985'$import_except_1'(Except, _, _) :-
 2986    throw(error(type_error(import_specifier, Except), _)).
 2987
 2988'$import_as'(CPI, N, [PI2|T], [CPI as N|T]) :-
 2989    '$canonical_pi'(PI2, CPI),
 2990    !.
 2991'$import_as'(PI, N, [H|T0], [H|T]) :-
 2992    !,
 2993    '$import_as'(PI, N, T0, T).
 2994'$import_as'(PI, _, _, _) :-
 2995    throw(error(existence_error(export, PI), _)).
 2996
 2997'$pi'(N/A) :- atom(N), integer(A), !.
 2998'$pi'(N//A) :- atom(N), integer(A).
 2999
 3000'$canonical_pi'(N//A0, N/A) :-
 3001    A is A0 + 2.
 3002'$canonical_pi'(PI, PI).
 3003
 3004'$remove_ops'([], _, []).
 3005'$remove_ops'([Op|T0], Pattern, T) :-
 3006    subsumes_term(Pattern, Op),
 3007    !,
 3008    '$remove_ops'(T0, Pattern, T).
 3009'$remove_ops'([H|T0], Pattern, [H|T]) :-
 3010    '$remove_ops'(T0, Pattern, T).
 $import_all(+Import, +Context, +Source, +Reexport, +Strength)
 3015'$import_all'(Import, Context, Source, Reexport, Strength) :-
 3016    '$import_all2'(Import, Context, Source, Imported, ImpOps, Strength),
 3017    (   Reexport == true,
 3018        (   '$list_to_conj'(Imported, Conj)
 3019        ->  export(Context:Conj),
 3020            '$ifcompiling'('$add_directive_wic'(export(Context:Conj)))
 3021        ;   true
 3022        ),
 3023        source_location(File, _Line),
 3024        '$export_ops'(ImpOps, Context, File)
 3025    ;   true
 3026    ).
 $import_all2(+Imports, +Context, +Source, -Imported, -ImpOps, +Strength)
 3030'$import_all2'([], _, _, [], [], _).
 3031'$import_all2'([PI as NewName|Rest], Context, Source,
 3032               [NewName/Arity|Imported], ImpOps, Strength) :-
 3033    !,
 3034    '$canonical_pi'(PI, Name/Arity),
 3035    length(Args, Arity),
 3036    Head =.. [Name|Args],
 3037    NewHead =.. [NewName|Args],
 3038    (   '$get_predicate_attribute'(Source:Head, transparent, 1)
 3039    ->  '$set_predicate_attribute'(Context:NewHead, transparent, true)
 3040    ;   true
 3041    ),
 3042    (   source_location(File, Line)
 3043    ->  E = error(_,_),
 3044        catch('$store_admin_clause'((NewHead :- Source:Head),
 3045                                    _Layout, File, File:Line),
 3046              E, '$print_message'(error, E))
 3047    ;   assertz((NewHead :- !, Source:Head)) % ! avoids problems with
 3048    ),                                       % duplicate load
 3049    '$import_all2'(Rest, Context, Source, Imported, ImpOps, Strength).
 3050'$import_all2'([op(P,A,N)|Rest], Context, Source, Imported,
 3051               [op(P,A,N)|ImpOps], Strength) :-
 3052    !,
 3053    '$import_ops'(Context, Source, op(P,A,N)),
 3054    '$import_all2'(Rest, Context, Source, Imported, ImpOps, Strength).
 3055'$import_all2'([Pred|Rest], Context, Source, [Pred|Imported], ImpOps, Strength) :-
 3056    Error = error(_,_),
 3057    catch(Context:'$import'(Source:Pred, Strength), Error,
 3058          print_message(error, Error)),
 3059    '$ifcompiling'('$import_wic'(Source, Pred, Strength)),
 3060    '$import_all2'(Rest, Context, Source, Imported, ImpOps, Strength).
 3061
 3062
 3063'$list_to_conj'([One], One) :- !.
 3064'$list_to_conj'([H|T], (H,Rest)) :-
 3065    '$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.
 3072'$exported_ops'(Module, Ops, Tail) :-
 3073    '$c_current_predicate'(_, Module:'$exported_op'(_,_,_)),
 3074    !,
 3075    findall(op(P,A,N), Module:'$exported_op'(P,A,N), Ops, Tail).
 3076'$exported_ops'(_, Ops, Ops).
 3077
 3078'$exported_op'(Module, P, A, N) :-
 3079    '$c_current_predicate'(_, Module:'$exported_op'(_,_,_)),
 3080    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.
 3087'$import_ops'(To, From, Pattern) :-
 3088    ground(Pattern),
 3089    !,
 3090    Pattern = op(P,A,N),
 3091    op(P,A,To:N),
 3092    (   '$exported_op'(From, P, A, N)
 3093    ->  true
 3094    ;   print_message(warning, no_exported_op(From, Pattern))
 3095    ).
 3096'$import_ops'(To, From, Pattern) :-
 3097    (   '$exported_op'(From, Pri, Assoc, Name),
 3098        Pattern = op(Pri, Assoc, Name),
 3099        op(Pri, Assoc, To:Name),
 3100        fail
 3101    ;   true
 3102    ).
 $export_list(+Declarations, +Module, -Ops)
Handle the export list of the module declaration for Module associated to File.
 3110'$export_list'(Decls, Module, Ops) :-
 3111    is_list(Decls),
 3112    !,
 3113    '$do_export_list'(Decls, Module, Ops).
 3114'$export_list'(Decls, _, _) :-
 3115    var(Decls),
 3116    throw(error(instantiation_error, _)).
 3117'$export_list'(Decls, _, _) :-
 3118    throw(error(type_error(list, Decls), _)).
 3119
 3120'$do_export_list'([], _, []) :- !.
 3121'$do_export_list'([H|T], Module, Ops) :-
 3122    !,
 3123    E = error(_,_),
 3124    catch('$export1'(H, Module, Ops, Ops1),
 3125          E, ('$print_message'(error, E), Ops = Ops1)),
 3126    '$do_export_list'(T, Module, Ops1).
 3127
 3128'$export1'(Var, _, _, _) :-
 3129    var(Var),
 3130    !,
 3131    throw(error(instantiation_error, _)).
 3132'$export1'(Op, _, [Op|T], T) :-
 3133    Op = op(_,_,_),
 3134    !.
 3135'$export1'(PI0, Module, Ops, Ops) :-
 3136    strip_module(Module:PI0, M, PI),
 3137    (   PI = (_//_)
 3138    ->  non_terminal(M:PI)
 3139    ;   true
 3140    ),
 3141    export(M:PI).
 3142
 3143'$export_ops'([op(Pri, Assoc, Name)|T], Module, File) :-
 3144    E = error(_,_),
 3145    catch(( '$execute_directive'(op(Pri, Assoc, Module:Name), File),
 3146            '$export_op'(Pri, Assoc, Name, Module, File)
 3147          ),
 3148          E, '$print_message'(error, E)),
 3149    '$export_ops'(T, Module, File).
 3150'$export_ops'([], _, _).
 3151
 3152'$export_op'(Pri, Assoc, Name, Module, File) :-
 3153    (   '$get_predicate_attribute'(Module:'$exported_op'(_,_,_), defined, 1)
 3154    ->  true
 3155    ;   '$execute_directive'(discontiguous(Module:'$exported_op'/3), File)
 3156    ),
 3157    '$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.
 3163'$execute_directive'(Goal, F) :-
 3164    '$execute_directive_2'(Goal, F).
 3165
 3166'$execute_directive_2'(encoding(Encoding), _F) :-
 3167    !,
 3168    (   '$load_input'(_F, S)
 3169    ->  set_stream(S, encoding(Encoding))
 3170    ).
 3171'$execute_directive_2'(ISO, F) :-
 3172    '$expand_directive'(ISO, Normal),
 3173    !,
 3174    '$execute_directive'(Normal, F).
 3175'$execute_directive_2'(Goal, _) :-
 3176    \+ '$compilation_mode'(database),
 3177    !,
 3178    '$add_directive_wic2'(Goal, Type),
 3179    (   Type == call                % suspend compiling into .qlf file
 3180    ->  '$compilation_mode'(Old, database),
 3181        setup_call_cleanup(
 3182            '$directive_mode'(OldDir, Old),
 3183            '$execute_directive_3'(Goal),
 3184            ( '$set_compilation_mode'(Old),
 3185              '$set_directive_mode'(OldDir)
 3186            ))
 3187    ;   '$execute_directive_3'(Goal)
 3188    ).
 3189'$execute_directive_2'(Goal, _) :-
 3190    '$execute_directive_3'(Goal).
 3191
 3192'$execute_directive_3'(Goal) :-
 3193    '$current_source_module'(Module),
 3194    '$valid_directive'(Module:Goal),
 3195    !,
 3196    (   '$pattr_directive'(Goal, Module)
 3197    ->  true
 3198    ;   Term = error(_,_),
 3199        catch(Module:Goal, Term, '$exception_in_directive'(Term))
 3200    ->  true
 3201    ;   '$print_message'(warning, goal_failed(directive, Module:Goal)),
 3202        fail
 3203    ).
 3204'$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.
 3213:- multifile prolog:sandbox_allowed_directive/1. 3214:- multifile prolog:sandbox_allowed_clause/1. 3215:- meta_predicate '$valid_directive'(:). 3216
 3217'$valid_directive'(_) :-
 3218    current_prolog_flag(sandboxed_load, false),
 3219    !.
 3220'$valid_directive'(Goal) :-
 3221    Error = error(Formal, _),
 3222    catch(prolog:sandbox_allowed_directive(Goal), Error, true),
 3223    !,
 3224    (   var(Formal)
 3225    ->  true
 3226    ;   print_message(error, Error),
 3227        fail
 3228    ).
 3229'$valid_directive'(Goal) :-
 3230    print_message(error,
 3231                  error(permission_error(execute,
 3232                                         sandboxed_directive,
 3233                                         Goal), _)),
 3234    fail.
 3235
 3236'$exception_in_directive'(Term) :-
 3237    '$print_message'(error, Term),
 3238    fail.
 3239
 3240%       This predicate deals with the very odd ISO requirement to allow
 3241%       for :- dynamic(a/2, b/3, c/4) instead of the normally used
 3242%       :- dynamic a/2, b/3, c/4 or, if operators are not desirable,
 3243%       :- dynamic((a/2, b/3, c/4)).
 3244
 3245'$expand_directive'(Directive, Expanded) :-
 3246    functor(Directive, Name, Arity),
 3247    Arity > 1,
 3248    '$iso_property_directive'(Name),
 3249    Directive =.. [Name|Args],
 3250    '$mk_normal_args'(Args, Normal),
 3251    Expanded =.. [Name, Normal].
 3252
 3253'$iso_property_directive'(dynamic).
 3254'$iso_property_directive'(multifile).
 3255'$iso_property_directive'(discontiguous).
 3256
 3257'$mk_normal_args'([One], One).
 3258'$mk_normal_args'([H|T0], (H,T)) :-
 3259    '$mk_normal_args'(T0, T).
 3260
 3261
 3262%       Note that the list, consult and ensure_loaded directives are already
 3263%       handled at compile time and therefore should not go into the
 3264%       intermediate code file.
 3265
 3266'$add_directive_wic2'(Goal, Type) :-
 3267    '$common_goal_type'(Goal, Type),
 3268    !,
 3269    (   Type == load
 3270    ->  true
 3271    ;   '$current_source_module'(Module),
 3272        '$add_directive_wic'(Module:Goal)
 3273    ).
 3274'$add_directive_wic2'(Goal, _) :-
 3275    (   '$compilation_mode'(qlf)    % no problem for qlf files
 3276    ->  true
 3277    ;   print_message(error, mixed_directive(Goal))
 3278    ).
 3279
 3280'$common_goal_type'((A,B), Type) :-
 3281    !,
 3282    '$common_goal_type'(A, Type),
 3283    '$common_goal_type'(B, Type).
 3284'$common_goal_type'((A;B), Type) :-
 3285    !,
 3286    '$common_goal_type'(A, Type),
 3287    '$common_goal_type'(B, Type).
 3288'$common_goal_type'((A->B), Type) :-
 3289    !,
 3290    '$common_goal_type'(A, Type),
 3291    '$common_goal_type'(B, Type).
 3292'$common_goal_type'(Goal, Type) :-
 3293    '$goal_type'(Goal, Type).
 3294
 3295'$goal_type'(Goal, Type) :-
 3296    (   '$load_goal'(Goal)
 3297    ->  Type = load
 3298    ;   Type = call
 3299    ).
 3300
 3301'$load_goal'([_|_]).
 3302'$load_goal'(consult(_)).
 3303'$load_goal'(load_files(_)).
 3304'$load_goal'(load_files(_,Options)) :-
 3305    memberchk(qcompile(QlfMode), Options),
 3306    '$qlf_part_mode'(QlfMode).
 3307'$load_goal'(ensure_loaded(_)) :- '$compilation_mode'(wic).
 3308'$load_goal'(use_module(_))    :- '$compilation_mode'(wic).
 3309'$load_goal'(use_module(_, _)) :- '$compilation_mode'(wic).
 3310
 3311'$qlf_part_mode'(part).
 3312'$qlf_part_mode'(true).                 % compatibility
 3313
 3314
 3315                /********************************
 3316                *        COMPILE A CLAUSE       *
 3317                *********************************/
 $store_admin_clause(+Clause, ?Layout, +Owner, +SrcLoc) is det
Store a clause into the database for administrative purposes. This bypasses sanity checking.
 3324'$store_admin_clause'(Clause, Layout, Owner, SrcLoc) :-
 3325    Owner \== (-),
 3326    !,
 3327    setup_call_cleanup(
 3328        '$start_aux'(Owner, Context),
 3329        '$store_admin_clause2'(Clause, Layout, Owner, SrcLoc),
 3330        '$end_aux'(Owner, Context)).
 3331'$store_admin_clause'(Clause, Layout, File, SrcLoc) :-
 3332    '$store_admin_clause2'(Clause, Layout, File, SrcLoc).
 3333
 3334'$store_admin_clause2'(Clause, _Layout, File, SrcLoc) :-
 3335    (   '$compilation_mode'(database)
 3336    ->  '$record_clause'(Clause, File, SrcLoc)
 3337    ;   '$record_clause'(Clause, File, SrcLoc, Ref),
 3338        '$qlf_assert_clause'(Ref, development)
 3339    ).
 $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.
 3349'$store_clause'((_, _), _, _, _) :-
 3350    !,
 3351    print_message(error, cannot_redefine_comma),
 3352    fail.
 3353'$store_clause'(Clause, _Layout, File, SrcLoc) :-
 3354    '$valid_clause'(Clause),
 3355    !,
 3356    (   '$compilation_mode'(database)
 3357    ->  '$record_clause'(Clause, File, SrcLoc)
 3358    ;   '$record_clause'(Clause, File, SrcLoc, Ref),
 3359        '$qlf_assert_clause'(Ref, development)
 3360    ).
 3361
 3362'$valid_clause'(_) :-
 3363    current_prolog_flag(sandboxed_load, false),
 3364    !.
 3365'$valid_clause'(Clause) :-
 3366    \+ '$cross_module_clause'(Clause),
 3367    !.
 3368'$valid_clause'(Clause) :-
 3369    Error = error(Formal, _),
 3370    catch(prolog:sandbox_allowed_clause(Clause), Error, true),
 3371    !,
 3372    (   var(Formal)
 3373    ->  true
 3374    ;   print_message(error, Error),
 3375        fail
 3376    ).
 3377'$valid_clause'(Clause) :-
 3378    print_message(error,
 3379                  error(permission_error(assert,
 3380                                         sandboxed_clause,
 3381                                         Clause), _)),
 3382    fail.
 3383
 3384'$cross_module_clause'(Clause) :-
 3385    '$head_module'(Clause, Module),
 3386    \+ '$current_source_module'(Module).
 3387
 3388'$head_module'(Var, _) :-
 3389    var(Var), !, fail.
 3390'$head_module'((Head :- _), Module) :-
 3391    '$head_module'(Head, Module).
 3392'$head_module'(Module:_, Module).
 3393
 3394'$clause_source'('$source_location'(File,Line):Clause, Clause, File:Line) :- !.
 3395'$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.
 3402:- public
 3403    '$store_clause'/2. 3404
 3405'$store_clause'(Term, Id) :-
 3406    '$clause_source'(Term, Clause, SrcLoc),
 3407    '$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?
 3428compile_aux_clauses(_Clauses) :-
 3429    current_prolog_flag(xref, true),
 3430    !.
 3431compile_aux_clauses(Clauses) :-
 3432    source_location(File, _Line),
 3433    '$compile_aux_clauses'(Clauses, File).
 3434
 3435'$compile_aux_clauses'(Clauses, File) :-
 3436    setup_call_cleanup(
 3437        '$start_aux'(File, Context),
 3438        '$store_aux_clauses'(Clauses, File),
 3439        '$end_aux'(File, Context)).
 3440
 3441'$store_aux_clauses'(Clauses, File) :-
 3442    is_list(Clauses),
 3443    !,
 3444    forall('$member'(C,Clauses),
 3445           '$compile_term'(C, _Layout, File)).
 3446'$store_aux_clauses'(Clause, File) :-
 3447    '$compile_term'(Clause, _Layout, File).
 3448
 3449
 3450		 /*******************************
 3451		 *            STAGING		*
 3452		 *******************************/
 $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.
 3462'$stage_file'(Target, Stage) :-
 3463    file_directory_name(Target, Dir),
 3464    file_base_name(Target, File),
 3465    current_prolog_flag(pid, Pid),
 3466    format(atom(Stage), '~w/.~w.~d', [Dir,File,Pid]).
 3467
 3468'$install_staged_file'(exit, Staged, Target, error) :-
 3469    !,
 3470    rename_file(Staged, Target).
 3471'$install_staged_file'(exit, Staged, Target, OnError) :-
 3472    !,
 3473    InstallError = error(_,_),
 3474    catch(rename_file(Staged, Target),
 3475          InstallError,
 3476          '$install_staged_error'(OnError, InstallError, Staged, Target)).
 3477'$install_staged_file'(_, Staged, _, _OnError) :-
 3478    E = error(_,_),
 3479    catch(delete_file(Staged), E, true).
 3480
 3481'$install_staged_error'(OnError, Error, Staged, _Target) :-
 3482    E = error(_,_),
 3483    catch(delete_file(Staged), E, true),
 3484    (   OnError = silent
 3485    ->  true
 3486    ;   OnError = fail
 3487    ->  fail
 3488    ;   print_message(warning, Error)
 3489    ).
 3490
 3491
 3492                 /*******************************
 3493                 *             READING          *
 3494                 *******************************/
 3495
 3496:- multifile
 3497    prolog:comment_hook/3.                  % hook for read_clause/3
 3498
 3499
 3500                 /*******************************
 3501                 *       FOREIGN INTERFACE      *
 3502                 *******************************/
 3503
 3504%       call-back from PL_register_foreign().  First argument is the module
 3505%       into which the foreign predicate is loaded and second is a term
 3506%       describing the arguments.
 3507
 3508:- dynamic
 3509    '$foreign_registered'/2. 3510
 3511                 /*******************************
 3512                 *   TEMPORARY TERM EXPANSION   *
 3513                 *******************************/
 3514
 3515% Provide temporary definitions for the boot-loader.  These are replaced
 3516% by the real thing in load.pl
 3517
 3518:- dynamic
 3519    '$expand_goal'/2,
 3520    '$expand_term'/4. 3521
 3522'$expand_goal'(In, In).
 3523'$expand_term'(In, Layout, In, Layout).
 3524
 3525
 3526                /********************************
 3527                *     SAVED STATE GENERATION    *
 3528                *********************************/
 3529
 3530/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
 3531This entry point is called from pl-main.c  if the -c option (compile) is
 3532given. It compiles all files and finally calls qsave_program to create a
 3533saved state.
 3534- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
 3535
 3536:- public '$compile_wic'/0. 3537
 3538'$compile_wic' :-
 3539    use_module(user:library(qsave), [qsave_program/2]),
 3540    current_prolog_flag(os_argv, Argv),
 3541    '$qsave_options'(Argv, Files, Options),
 3542    '$cmd_option_val'(compileout, Out),
 3543    user:consult(Files),
 3544    user:qsave_program(Out, Options).
 3545
 3546'$qsave_options'([], [], []).
 3547'$qsave_options'([--|_], [], []) :-
 3548    !.
 3549'$qsave_options'(['-c'|T0], Files, Options) :-
 3550    !,
 3551    '$argv_files'(T0, T1, Files, FilesT),
 3552    '$qsave_options'(T1, FilesT, Options).
 3553'$qsave_options'([O|T0], Files, [Option|T]) :-
 3554    string_concat("--", Opt, O),
 3555    split_string(Opt, "=", "", [NameS|Rest]),
 3556    atom_string(Name, NameS),
 3557    '$qsave_option'(Name, OptName, Rest, Value),
 3558    !,
 3559    Option =.. [OptName, Value],
 3560    '$qsave_options'(T0, Files, T).
 3561'$qsave_options'([_|T0], Files, T) :-
 3562    '$qsave_options'(T0, Files, T).
 3563
 3564'$argv_files'([], [], Files, Files).
 3565'$argv_files'([H|T], [H|T], Files, Files) :-
 3566    sub_atom(H, 0, _, _, -),
 3567    !.
 3568'$argv_files'([H|T0], T, [H|Files0], Files) :-
 3569    '$argv_files'(T0, T, Files0, Files).
 $qsave_option(+Name, +ValueStrings, -Value) is semidet
 3573'$qsave_option'(Name, Name, [], true) :-
 3574    qsave:save_option(Name, boolean, _),
 3575    !.
 3576'$qsave_option'(NoName, Name, [], false) :-
 3577    atom_concat('no-', Name, NoName),
 3578    qsave:save_option(Name, boolean, _),
 3579    !.
 3580'$qsave_option'(Name, Name, ValueStrings, Value) :-
 3581    qsave:save_option(Name, Type, _),
 3582    !,
 3583    atomics_to_string(ValueStrings, "=", ValueString),
 3584    '$convert_option_value'(Type, ValueString, Value).
 3585'$qsave_option'(Name, Name, _Chars, _Value) :-
 3586    '$existence_error'(save_option, Name).
 3587
 3588'$convert_option_value'(integer, String, Value) :-
 3589    (   number_string(Value, String)
 3590    ->  true
 3591    ;   '$domain_error'(integer, String)
 3592    ).
 3593'$convert_option_value'(callable, String, Value) :-
 3594    term_string(Value, String).
 3595'$convert_option_value'(atom, String, Value) :-
 3596    atom_string(Value, String).
 3597'$convert_option_value'(boolean, String, Value) :-
 3598    atom_string(Value, String).
 3599'$convert_option_value'(oneof(_), String, Value) :-
 3600    atom_string(Value, String).
 3601'$convert_option_value'(ground, String, Value) :-
 3602    atom_string(Value, String).
 3603
 3604
 3605                 /*******************************
 3606                 *         TYPE SUPPORT         *
 3607                 *******************************/
 3608
 3609'$type_error'(Type, Value) :-
 3610    (   var(Value)
 3611    ->  throw(error(instantiation_error, _))
 3612    ;   throw(error(type_error(Type, Value), _))
 3613    ).
 3614
 3615'$domain_error'(Type, Value) :-
 3616    throw(error(domain_error(Type, Value), _)).
 3617
 3618'$existence_error'(Type, Object) :-
 3619    throw(error(existence_error(Type, Object), _)).
 3620
 3621'$permission_error'(Action, Type, Term) :-
 3622    throw(error(permission_error(Action, Type, Term), _)).
 3623
 3624'$instantiation_error'(_Var) :-
 3625    throw(error(instantiation_error, _)).
 3626
 3627'$uninstantiation_error'(NonVar) :-
 3628    throw(error(uninstantiation_error(NonVar), _)).
 3629
 3630'$must_be'(list, X) :- !,
 3631    '$skip_list'(_, X, Tail),
 3632    (   Tail == []
 3633    ->  true
 3634    ;   '$type_error'(list, Tail)
 3635    ).
 3636'$must_be'(options, X) :- !,
 3637    (   '$is_options'(X)
 3638    ->  true
 3639    ;   '$type_error'(options, X)
 3640    ).
 3641'$must_be'(atom, X) :- !,
 3642    (   atom(X)
 3643    ->  true
 3644    ;   '$type_error'(atom, X)
 3645    ).
 3646'$must_be'(integer, X) :- !,
 3647    (   integer(X)
 3648    ->  true
 3649    ;   '$type_error'(integer, X)
 3650    ).
 3651'$must_be'(callable, X) :- !,
 3652    (   callable(X)
 3653    ->  true
 3654    ;   '$type_error'(callable, X)
 3655    ).
 3656'$must_be'(oneof(Type, Domain, List), X) :- !,
 3657    '$must_be'(Type, X),
 3658    (   memberchk(X, List)
 3659    ->  true
 3660    ;   '$domain_error'(Domain, X)
 3661    ).
 3662'$must_be'(boolean, X) :- !,
 3663    (   (X == true ; X == false)
 3664    ->  true
 3665    ;   '$type_error'(boolean, X)
 3666    ).
 3667% Use for debugging
 3668%'$must_be'(Type, _X) :- format('Unknown $must_be type: ~q~n', [Type]).
 3669
 3670
 3671                /********************************
 3672                *       LIST PROCESSING         *
 3673                *********************************/
 3674
 3675'$member'(El, [H|T]) :-
 3676    '$member_'(T, El, H).
 3677
 3678'$member_'(_, El, El).
 3679'$member_'([H|T], El, _) :-
 3680    '$member_'(T, El, H).
 3681
 3682
 3683'$append'([], L, L).
 3684'$append'([H|T], L, [H|R]) :-
 3685    '$append'(T, L, R).
 3686
 3687'$select'(X, [X|Tail], Tail).
 3688'$select'(Elem, [Head|Tail], [Head|Rest]) :-
 3689    '$select'(Elem, Tail, Rest).
 3690
 3691'$reverse'(L1, L2) :-
 3692    '$reverse'(L1, [], L2).
 3693
 3694'$reverse'([], List, List).
 3695'$reverse'([Head|List1], List2, List3) :-
 3696    '$reverse'(List1, [Head|List2], List3).
 3697
 3698'$delete'([], _, []) :- !.
 3699'$delete'([Elem|Tail], Elem, Result) :-
 3700    !,
 3701    '$delete'(Tail, Elem, Result).
 3702'$delete'([Head|Tail], Elem, [Head|Rest]) :-
 3703    '$delete'(Tail, Elem, Rest).
 3704
 3705'$last'([H|T], Last) :-
 3706    '$last'(T, H, Last).
 3707
 3708'$last'([], Last, Last).
 3709'$last'([H|T], _, Last) :-
 3710    '$last'(T, H, Last).
 length(?List, ?N)
Is true when N is the length of List.
 3717:- '$iso'((length/2)). 3718
 3719length(List, Length) :-
 3720    var(Length),
 3721    !,
 3722    '$skip_list'(Length0, List, Tail),
 3723    (   Tail == []
 3724    ->  Length = Length0                    % +,-
 3725    ;   var(Tail)
 3726    ->  Tail \== Length,                    % avoid length(L,L)
 3727        '$length3'(Tail, Length, Length0)   % -,-
 3728    ;   throw(error(type_error(list, List),
 3729                    context(length/2, _)))
 3730    ).
 3731length(List, Length) :-
 3732    integer(Length),
 3733    Length >= 0,
 3734    !,
 3735    '$skip_list'(Length0, List, Tail),
 3736    (   Tail == []                          % proper list
 3737    ->  Length = Length0
 3738    ;   var(Tail)
 3739    ->  Extra is Length-Length0,
 3740        '$length'(Tail, Extra)
 3741    ;   throw(error(type_error(list, List),
 3742                    context(length/2, _)))
 3743    ).
 3744length(_, Length) :-
 3745    integer(Length),
 3746    !,
 3747    throw(error(domain_error(not_less_than_zero, Length),
 3748                context(length/2, _))).
 3749length(_, Length) :-
 3750    throw(error(type_error(integer, Length),
 3751                context(length/2, _))).
 3752
 3753'$length3'([], N, N).
 3754'$length3'([_|List], N, N0) :-
 3755    N1 is N0+1,
 3756    '$length3'(List, N, N1).
 3757
 3758
 3759                 /*******************************
 3760                 *       OPTION PROCESSING      *
 3761                 *******************************/
 $is_options(@Term) is semidet
True if Term looks like it provides options.
 3767'$is_options'(Map) :-
 3768    is_dict(Map, _),
 3769    !.
 3770'$is_options'(List) :-
 3771    is_list(List),
 3772    (   List == []
 3773    ->  true
 3774    ;   List = [H|_],
 3775        '$is_option'(H, _, _)
 3776    ).
 3777
 3778'$is_option'(Var, _, _) :-
 3779    var(Var), !, fail.
 3780'$is_option'(F, Name, Value) :-
 3781    functor(F, _, 1),
 3782    !,
 3783    F =.. [Name,Value].
 3784'$is_option'(Name=Value, Name, Value).
 $option(?Opt, +Options) is semidet
 3788'$option'(Opt, Options) :-
 3789    is_dict(Options),
 3790    !,
 3791    [Opt] :< Options.
 3792'$option'(Opt, Options) :-
 3793    memberchk(Opt, Options).
 $option(?Opt, +Options, +Default) is det
 3797'$option'(Term, Options, Default) :-
 3798    arg(1, Term, Value),
 3799    functor(Term, Name, 1),
 3800    (   is_dict(Options)
 3801    ->  (   get_dict(Name, Options, GVal)
 3802        ->  Value = GVal
 3803        ;   Value = Default
 3804        )
 3805    ;   functor(Gen, Name, 1),
 3806        arg(1, Gen, GVal),
 3807        (   memberchk(Gen, Options)
 3808        ->  Value = GVal
 3809        ;   Value = Default
 3810        )
 3811    ).
 $select_option(?Opt, +Options, -Rest) is semidet
Select an option from Options.
Arguments:
Rest- is always a map.
 3819'$select_option'(Opt, Options, Rest) :-
 3820    select_dict([Opt], Options, Rest).
 $merge_options(+New, +Default, -Merged) is det
Add/replace options specified in New.
Arguments:
Merged- is always a map.
 3828'$merge_options'(New, Old, Merged) :-
 3829    put_dict(New, Old, Merged).
 3830
 3831
 3832                 /*******************************
 3833                 *   HANDLE TRACER 'L'-COMMAND  *
 3834                 *******************************/
 3835
 3836:- public '$prolog_list_goal'/1. 3837
 3838:- multifile
 3839    user:prolog_list_goal/1. 3840
 3841'$prolog_list_goal'(Goal) :-
 3842    user:prolog_list_goal(Goal),
 3843    !.
 3844'$prolog_list_goal'(Goal) :-
 3845    user:listing(Goal).
 3846
 3847
 3848                 /*******************************
 3849                 *             HALT             *
 3850                 *******************************/
 3851
 3852:- '$iso'((halt/0)). 3853
 3854halt :-
 3855    halt(0).
 at_halt(:Goal)
Register Goal to be called if the system halts.
To be done
- : get location into the error message
 3864:- meta_predicate at_halt(0). 3865:- dynamic        system:term_expansion/2, '$at_halt'/2. 3866:- multifile      system:term_expansion/2, '$at_halt'/2. 3867
 3868system:term_expansion((:- at_halt(Goal)),
 3869                      system:'$at_halt'(Module:Goal, File:Line)) :-
 3870    \+ current_prolog_flag(xref, true),
 3871    source_location(File, Line),
 3872    '$current_source_module'(Module).
 3873
 3874at_halt(Goal) :-
 3875    asserta('$at_halt'(Goal, (-):0)).
 3876
 3877:- public '$run_at_halt'/0. 3878
 3879'$run_at_halt' :-
 3880    forall(clause('$at_halt'(Goal, Src), true, Ref),
 3881           ( '$call_at_halt'(Goal, Src),
 3882             erase(Ref)
 3883           )).
 3884
 3885'$call_at_halt'(Goal, _Src) :-
 3886    catch(Goal, E, true),
 3887    !,
 3888    (   var(E)
 3889    ->  true
 3890    ;   subsumes_term(cancel_halt(_), E)
 3891    ->  '$print_message'(informational, E),
 3892        fail
 3893    ;   '$print_message'(error, E)
 3894    ).
 3895'$call_at_halt'(Goal, _Src) :-
 3896    '$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.
 3904cancel_halt(Reason) :-
 3905    throw(cancel_halt(Reason)).
 3906
 3907
 3908                /********************************
 3909                *      LOAD OTHER MODULES       *
 3910                *********************************/
 3911
 3912:- meta_predicate
 3913    '$load_wic_files'(:). 3914
 3915'$load_wic_files'(Files) :-
 3916    Files = Module:_,
 3917    '$execute_directive'('$set_source_module'(OldM, Module), []),
 3918    '$save_lex_state'(LexState, []),
 3919    '$style_check'(_, 0xC7),                % see style_name/2 in syspred.pl
 3920    '$compilation_mode'(OldC, wic),
 3921    consult(Files),
 3922    '$execute_directive'('$set_source_module'(OldM), []),
 3923    '$execute_directive'('$restore_lex_state'(LexState), []),
 3924    '$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.
 3932:- public '$load_additional_boot_files'/0. 3933
 3934'$load_additional_boot_files' :-
 3935    current_prolog_flag(argv, Argv),
 3936    '$get_files_argv'(Argv, Files),
 3937    (   Files \== []
 3938    ->  format('Loading additional boot files~n'),
 3939        '$load_wic_files'(user:Files),
 3940        format('additional boot files loaded~n')
 3941    ;   true
 3942    ).
 3943
 3944'$get_files_argv'([], []) :- !.
 3945'$get_files_argv'(['-c'|Files], Files) :- !.
 3946'$get_files_argv'([_|Rest], Files) :-
 3947    '$get_files_argv'(Rest, Files).
 3948
 3949'$:-'(('$boot_message'('Loading Prolog startup files~n', []),
 3950       source_location(File, _Line),
 3951       file_directory_name(File, Dir),
 3952       atom_concat(Dir, '/load.pl', LoadFile),
 3953       '$load_wic_files'(system:[LoadFile]),
 3954       (   current_prolog_flag(windows, true)
 3955       ->  atom_concat(Dir, '/menu.pl', MenuFile),
 3956           '$load_wic_files'(system:[MenuFile])
 3957       ;   true
 3958       ),
 3959       '$boot_message'('SWI-Prolog boot files loaded~n', []),
 3960       '$compilation_mode'(OldC, wic),
 3961       '$execute_directive'('$set_source_module'(user), []),
 3962       '$set_compilation_mode'(OldC)
 3963      ))