View source with raw comments or as raw
    1/*  Part of SWI-Prolog
    2
    3    Author:        Jan Wielemaker
    4    E-mail:        J.Wielemaker@vu.nl
    5    WWW:           http://www.swi-prolog.org
    6    Copyright (c)  1985-2019, University of Amsterdam
    7                              VU University Amsterdam
    8                              CWI, Amsterdam
    9    All rights reserved.
   10
   11    Redistribution and use in source and binary forms, with or without
   12    modification, are permitted provided that the following conditions
   13    are met:
   14
   15    1. Redistributions of source code must retain the above copyright
   16       notice, this list of conditions and the following disclaimer.
   17
   18    2. Redistributions in binary form must reproduce the above copyright
   19       notice, this list of conditions and the following disclaimer in
   20       the documentation and/or other materials provided with the
   21       distribution.
   22
   23    THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
   24    "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
   25    LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS
   26    FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE
   27    COPYRIGHT OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT,
   28    INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING,
   29    BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES;
   30    LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER
   31    CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
   32    LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN
   33    ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
   34    POSSIBILITY OF SUCH DAMAGE.
   35*/
   36
   37/*
   38Consult, derivates and basic things.   This  module  is  loaded  by  the
   39C-written  bootstrap  compiler.
   40
   41The $:- directive  is  executed  by  the  bootstrap  compiler,  but  not
   42inserted  in  the  intermediate  code  file.   Used  to print diagnostic
   43messages and start the Prolog defined compiler for  the  remaining  boot
   44modules.
   45
   46If you want  to  debug  this  module,  put  a  '$:-'(trace).   directive
   47somewhere.   The  tracer will work properly under boot compilation as it
   48will use the C defined write predicate  to  print  goals  and  does  not
   49attempt to call the Prolog defined trace interceptor.
   50*/
   51
   52                /********************************
   53                *    LOAD INTO MODULE SYSTEM    *
   54                ********************************/
   55
   56:- '$set_source_module'(system).   57
   58'$boot_message'(_Format, _Args) :-
   59    current_prolog_flag(verbose, silent),
   60    !.
   61'$boot_message'(Format, Args) :-
   62    format(Format, Args),
   63    !.
   64
   65'$:-'('$boot_message'('Loading boot file ...~n', [])).
   66
   67
   68                /********************************
   69                *          DIRECTIVES           *
   70                *********************************/
   71
   72:- meta_predicate
   73    dynamic(:),
   74    multifile(:),
   75    public(:),
   76    module_transparent(:),
   77    discontiguous(:),
   78    volatile(:),
   79    thread_local(:),
   80    noprofile(:),
   81    non_terminal(:),
   82    '$clausable'(:),
   83    '$iso'(:),
   84    '$hide'(:).
 dynamic +Spec is det
 multifile +Spec is det
 module_transparent +Spec is det
 discontiguous +Spec is det
 volatile +Spec is det
 thread_local +Spec is det
 noprofile(+Spec) is det
 public +Spec is det
 non_terminal(+Spec) is det
Predicate versions of standard directives that set predicate attributes. These predicates bail out with an error on the first failure (typically permission errors).
  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:- '$iso'(((dynamic)/1, (multifile)/1, (discontiguous)/1)).  172
  173
  174                /********************************
  175                *       CALLING, CONTROL        *
  176                *********************************/
  177
  178:- noprofile((call/1,
  179              catch/3,
  180              once/1,
  181              ignore/1,
  182              call_cleanup/2,
  183              call_cleanup/3,
  184              setup_call_cleanup/3,
  185              setup_call_catcher_cleanup/4)).  186
  187:- meta_predicate
  188    ';'(0,0),
  189    ','(0,0),
  190    @(0,+),
  191    call(0),
  192    call(1,?),
  193    call(2,?,?),
  194    call(3,?,?,?),
  195    call(4,?,?,?,?),
  196    call(5,?,?,?,?,?),
  197    call(6,?,?,?,?,?,?),
  198    call(7,?,?,?,?,?,?,?),
  199    not(0),
  200    \+(0),
  201    '->'(0,0),
  202    '*->'(0,0),
  203    once(0),
  204    ignore(0),
  205    catch(0,?,0),
  206    reset(0,?,-),
  207    setup_call_cleanup(0,0,0),
  208    setup_call_catcher_cleanup(0,0,?,0),
  209    call_cleanup(0,0),
  210    call_cleanup(0,?,0),
  211    catch_with_backtrace(0,?,0),
  212    '$meta_call'(0).  213
  214:- '$iso'((call/1, (\+)/1, once/1, (;)/2, (',')/2, (->)/2, catch/3)).  215
  216% The control structures are always compiled, both   if they appear in a
  217% clause body and if they are handed  to   call/1.  The only way to call
  218% these predicates is by means of  call/2..   In  that case, we call the
  219% hole control structure again to get it compiled by call/1 and properly
  220% deal  with  !,  etc.  Another  reason  for  having  these  things   as
  221% predicates is to be able to define   properties for them, helping code
  222% analyzers.
  223
  224(M0:If ; M0:Then) :- !, call(M0:(If ; Then)).
  225(M1:If ; M2:Then) :-    call(M1:(If ; M2:Then)).
  226(G1   , G2)       :-    call((G1   , G2)).
  227(If  -> Then)     :-    call((If  -> Then)).
  228(If *-> Then)     :-    call((If *-> Then)).
  229@(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.

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

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

  515initialization(Goal, When) :-
  516    '$must_be'(oneof(atom, initialization_type,
  517                     [ now,
  518                       after_load,
  519                       restore,
  520                       restore_state,
  521                       prepare_state,
  522                       program,
  523                       main
  524                     ]), When),
  525    '$initialization_context'(Source, Ctx),
  526    '$initialization'(When, Goal, Source, Ctx).
  527
  528'$initialization'(now, Goal, _Source, Ctx) :-
  529    '$run_init_goal'(Goal, Ctx),
  530    '$compile_init_goal'(-, Goal, Ctx).
  531'$initialization'(after_load, Goal, Source, Ctx) :-
  532    (   Source \== (-)
  533    ->  '$compile_init_goal'(Source, Goal, Ctx)
  534    ;   throw(error(context_error(nodirective,
  535                                  initialization(Goal, after_load)),
  536                    _))
  537    ).
  538'$initialization'(restore, Goal, Source, Ctx) :- % deprecated
  539    '$initialization'(restore_state, Goal, Source, Ctx).
  540'$initialization'(restore_state, Goal, _Source, Ctx) :-
  541    (   \+ current_prolog_flag(sandboxed_load, true)
  542    ->  '$compile_init_goal'(-, Goal, Ctx)
  543    ;   '$permission_error'(register, initialization(restore), Goal)
  544    ).
  545'$initialization'(prepare_state, Goal, _Source, Ctx) :-
  546    (   \+ current_prolog_flag(sandboxed_load, true)
  547    ->  '$compile_init_goal'(when(prepare_state), Goal, Ctx)
  548    ;   '$permission_error'(register, initialization(restore), Goal)
  549    ).
  550'$initialization'(program, Goal, _Source, Ctx) :-
  551    (   \+ current_prolog_flag(sandboxed_load, true)
  552    ->  '$compile_init_goal'(when(program), Goal, Ctx)
  553    ;   '$permission_error'(register, initialization(restore), Goal)
  554    ).
  555'$initialization'(main, Goal, _Source, Ctx) :-
  556    (   \+ current_prolog_flag(sandboxed_load, true)
  557    ->  '$compile_init_goal'(when(main), Goal, Ctx)
  558    ;   '$permission_error'(register, initialization(restore), Goal)
  559    ).
  560
  561
  562'$compile_init_goal'(Source, Goal, Ctx) :-
  563    atom(Source),
  564    Source \== (-),
  565    !,
  566    '$store_admin_clause'(system:'$init_goal'(Source, Goal, Ctx),
  567                          _Layout, Source, Ctx).
  568'$compile_init_goal'(Source, Goal, Ctx) :-
  569    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.
  581'$run_initialization'(_, loaded, _) :- !.
  582'$run_initialization'(File, _Action, Options) :-
  583    '$run_initialization'(File, Options).
  584
  585'$run_initialization'(File, Options) :-
  586    setup_call_cleanup(
  587        '$start_run_initialization'(Options, Restore),
  588        '$run_initialization_2'(File),
  589        '$end_run_initialization'(Restore)).
  590
  591'$start_run_initialization'(Options, OldSandBoxed) :-
  592    '$push_input_context'(initialization),
  593    '$set_sandboxed_load'(Options, OldSandBoxed).
  594'$end_run_initialization'(OldSandBoxed) :-
  595    set_prolog_flag(sandboxed_load, OldSandBoxed),
  596    '$pop_input_context'.
  597
  598'$run_initialization_2'(File) :-
  599    (   '$init_goal'(File, Goal, Ctx),
  600        File \= when(_),
  601        '$run_init_goal'(Goal, Ctx),
  602        fail
  603    ;   true
  604    ).
  605
  606'$run_init_goal'(Goal, Ctx) :-
  607    (   catch_with_backtrace('$run_init_goal'(Goal), E,
  608                             '$initialization_error'(E, Goal, Ctx))
  609    ->  true
  610    ;   '$initialization_failure'(Goal, Ctx)
  611    ).
  612
  613:- multifile prolog:sandbox_allowed_goal/1.  614
  615'$run_init_goal'(Goal) :-
  616    current_prolog_flag(sandboxed_load, false),
  617    !,
  618    call(Goal).
  619'$run_init_goal'(Goal) :-
  620    prolog:sandbox_allowed_goal(Goal),
  621    call(Goal).
  622
  623'$initialization_context'(Source, Ctx) :-
  624    (   source_location(File, Line)
  625    ->  Ctx = File:Line,
  626        '$input_context'(Context),
  627        '$top_file'(Context, File, Source)
  628    ;   Ctx = (-),
  629        File = (-)
  630    ).
  631
  632'$top_file'([input(include, F1, _, _)|T], _, F) :-
  633    !,
  634    '$top_file'(T, F1, F).
  635'$top_file'(_, F, F).
  636
  637
  638'$initialization_error'(E, Goal, Ctx) :-
  639    print_message(error, initialization_error(Goal, E, Ctx)).
  640
  641'$initialization_failure'(Goal, Ctx) :-
  642    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
  650:- public '$clear_source_admin'/1.  651
  652'$clear_source_admin'(File) :-
  653    retractall('$init_goal'(_, _, File:_)),
  654    retractall('$load_context_module'(File, _, _)),
  655    retractall('$resolved_source_path'(_, File)).
  656
  657
  658                 /*******************************
  659                 *            STREAM            *
  660                 *******************************/
  661
  662:- '$iso'(stream_property/2).  663stream_property(Stream, Property) :-
  664    nonvar(Stream),
  665    nonvar(Property),
  666    !,
  667    '$stream_property'(Stream, Property).
  668stream_property(Stream, Property) :-
  669    nonvar(Stream),
  670    !,
  671    '$stream_properties'(Stream, Properties),
  672    '$member'(Property, Properties).
  673stream_property(Stream, Property) :-
  674    nonvar(Property),
  675    !,
  676    (   Property = alias(Alias),
  677        atom(Alias)
  678    ->  '$alias_stream'(Alias, Stream)
  679    ;   '$streams_properties'(Property, Pairs),
  680        '$member'(Stream-Property, Pairs)
  681    ).
  682stream_property(Stream, Property) :-
  683    '$streams_properties'(Property, Pairs),
  684    '$member'(Stream-Properties, Pairs),
  685    '$member'(Property, Properties).
  686
  687
  688                /********************************
  689                *            MODULES            *
  690                *********************************/
  691
  692%       '$prefix_module'(+Module, +Context, +Term, -Prefixed)
  693%       Tags `Term' with `Module:' if `Module' is not the context module.
  694
  695'$prefix_module'(Module, Module, Head, Head) :- !.
  696'$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'.
  702default_module(Me, Super) :-
  703    (   atom(Me)
  704    ->  (   var(Super)
  705        ->  '$default_module'(Me, Super)
  706        ;   '$default_module'(Me, Super), !
  707        )
  708    ;   '$type_error'(module, Me)
  709    ).
  710
  711'$default_module'(Me, Me).
  712'$default_module'(Me, Super) :-
  713    import_module(Me, S),
  714    '$default_module'(S, Super).
  715
  716
  717                /********************************
  718                *      TRACE AND EXCEPTIONS     *
  719                *********************************/
  720
  721:- dynamic   user:exception/3.  722:- multifile user:exception/3.
 $undefined_procedure(+Module, +Name, +Arity, -Action) is det
This predicate is called from C on undefined predicates. First allows the user to take care of it using exception/3. Else try to give a DWIM warning. Otherwise fail. C will print an error message.
  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    ;   Term \== begin_of_file
 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    Parents \= [_,_|_],
 1548    (   '$load_input'(_, Input)
 1549    ->  stream_property(Input, file_name(File))
 1550    ),
 1551    '$set_source_location'(File, 0),
 1552    '$expanded_term'(In,
 1553                     begin_of_file, 0-0, Read, RLayout, Term, TLayout,
 1554                     Stream, Parents, Options).
 1555'$term_in_file'(In, Read, RLayout, Term, TLayout, Stream, Parents, Options) :-
 1556    '$skip_script_line'(In, Options),
 1557    '$read_clause_options'(Options, ReadOptions),
 1558    repeat,
 1559      read_clause(In, Raw,
 1560                  [ variable_names(Bindings),
 1561                    term_position(Pos),
 1562                    subterm_positions(RawLayout)
 1563                  | ReadOptions
 1564                  ]),
 1565      b_setval('$term_position', Pos),
 1566      b_setval('$variable_names', Bindings),
 1567      (   Raw == end_of_file
 1568      ->  !,
 1569          (   Parents = [_,_|_]     % Included file
 1570          ->  fail
 1571          ;   '$expanded_term'(In,
 1572                               Raw, RawLayout, Read, RLayout, Term, TLayout,
 1573                               Stream, Parents, Options)
 1574          )
 1575      ;   '$expanded_term'(In, Raw, RawLayout, Read, RLayout, Term, TLayout,
 1576                           Stream, Parents, Options)
 1577      ).
 1578
 1579'$read_clause_options'([], []).
 1580'$read_clause_options'([H|T0], List) :-
 1581    (   '$read_clause_option'(H)
 1582    ->  List = [H|T]
 1583    ;   List = T
 1584    ),
 1585    '$read_clause_options'(T0, T).
 1586
 1587'$read_clause_option'(syntax_errors(_)).
 1588'$read_clause_option'(term_position(_)).
 1589'$read_clause_option'(process_comment(_)).
 1590
 1591'$expanded_term'(In, Raw, RawLayout, Read, RLayout, Term, TLayout,
 1592                 Stream, Parents, Options) :-
 1593    E = error(_,_),
 1594    catch('$expand_term'(Raw, RawLayout, Expanded, ExpandedLayout), E,
 1595          '$print_message_fail'(E)),
 1596    (   Expanded \== []
 1597    ->  '$expansion_member'(Expanded, ExpandedLayout, Term1, Layout1)
 1598    ;   Term1 = Expanded,
 1599        Layout1 = ExpandedLayout
 1600    ),
 1601    (   nonvar(Term1), Term1 = (:-Directive), nonvar(Directive)
 1602    ->  (   Directive = include(File),
 1603            '$current_source_module'(Module),
 1604            '$valid_directive'(Module:include(File))
 1605        ->  stream_property(In, encoding(Enc)),
 1606            '$add_encoding'(Enc, Options, Options1),
 1607            '$source_term'(File, Read, RLayout, Term, TLayout,
 1608                           Stream, Parents, Options1)
 1609        ;   Directive = encoding(Enc)
 1610        ->  set_stream(In, encoding(Enc)),
 1611            fail
 1612        ;   Term = Term1,
 1613            Stream = In,
 1614            Read = Raw
 1615        )
 1616    ;   Term = Term1,
 1617        TLayout = Layout1,
 1618        Stream = In,
 1619        Read = Raw,
 1620        RLayout = RawLayout
 1621    ).
 1622
 1623'$expansion_member'(Var, Layout, Var, Layout) :-
 1624    var(Var),
 1625    !.
 1626'$expansion_member'([], _, _, _) :- !, fail.
 1627'$expansion_member'(List, ListLayout, Term, Layout) :-
 1628    is_list(List),
 1629    !,
 1630    (   var(ListLayout)
 1631    ->  '$member'(Term, List)
 1632    ;   is_list(ListLayout)
 1633    ->  '$member_rep2'(Term, Layout, List, ListLayout)
 1634    ;   Layout = ListLayout,
 1635        '$member'(Term, List)
 1636    ).
 1637'$expansion_member'(X, Layout, X, Layout).
 1638
 1639% pairwise member, repeating last element of the second
 1640% list.
 1641
 1642'$member_rep2'(H1, H2, [H1|_], [H2|_]).
 1643'$member_rep2'(H1, H2, [_|T1], [T2]) :-
 1644    !,
 1645    '$member_rep2'(H1, H2, T1, [T2]).
 1646'$member_rep2'(H1, H2, [_|T1], [_|T2]) :-
 1647    '$member_rep2'(H1, H2, T1, T2).
 $add_encoding(+Enc, +Options0, -Options)
 1651'$add_encoding'(Enc, Options0, Options) :-
 1652    (   Options0 = [encoding(Enc)|_]
 1653    ->  Options = Options0
 1654    ;   Options = [encoding(Enc)|Options0]
 1655    ).
 1656
 1657
 1658:- multifile
 1659    '$included'/4.                  % Into, Line, File, LastModified
 1660:- dynamic
 1661    '$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'.

 1675'$record_included'([Parent|Parents], File, Path, Time,
 1676                   message(DoneMsgLevel,
 1677                           include_file(done(Level, file(File, Path))))) :-
 1678    source_location(SrcFile, Line),
 1679    !,
 1680    '$compilation_level'(Level),
 1681    '$load_msg_level'(include_file, Level, StartMsgLevel, DoneMsgLevel),
 1682    '$print_message'(StartMsgLevel,
 1683                     include_file(start(Level,
 1684                                        file(File, Path)))),
 1685    '$last'([Parent|Parents], Owner),
 1686    (   (   '$compilation_mode'(database)
 1687        ;   '$qlf_current_source'(Owner)
 1688        )
 1689    ->  '$store_admin_clause'(
 1690            system:'$included'(Parent, Line, Path, Time),
 1691            _, Owner, SrcFile:Line)
 1692    ;   '$qlf_include'(Owner, Parent, Line, Path, Time)
 1693    ).
 1694'$record_included'(_, _, _, _, true).
 $master_file(+File, -MasterFile)
Find the primary load file from included files.
 1700'$master_file'(File, MasterFile) :-
 1701    '$included'(MasterFile0, _Line, File, _Time),
 1702    !,
 1703    '$master_file'(MasterFile0, MasterFile).
 1704'$master_file'(File, File).
 1705
 1706
 1707'$skip_script_line'(_In, Options) :-
 1708    '$option'(check_script(false), Options),
 1709    !.
 1710'$skip_script_line'(In, _Options) :-
 1711    (   peek_char(In, #)
 1712    ->  skip(In, 10)
 1713    ;   true
 1714    ).
 1715
 1716'$set_encoding'(Stream, Options) :-
 1717    '$option'(encoding(Enc), Options),
 1718    !,
 1719    Enc \== default,
 1720    set_stream(Stream, encoding(Enc)).
 1721'$set_encoding'(_, _).
 1722
 1723
 1724'$prepare_load_stream'(In, Id, state(HasName,HasPos)) :-
 1725    (   stream_property(In, file_name(_))
 1726    ->  HasName = true,
 1727        (   stream_property(In, position(_))
 1728        ->  HasPos = true
 1729        ;   HasPos = false,
 1730            set_stream(In, record_position(true))
 1731        )
 1732    ;   HasName = false,
 1733        set_stream(In, file_name(Id)),
 1734        (   stream_property(In, position(_))
 1735        ->  HasPos = true
 1736        ;   HasPos = false,
 1737            set_stream(In, record_position(true))
 1738        )
 1739    ).
 1740
 1741'$restore_load_stream'(In, _State, Options) :-
 1742    memberchk(close(true), Options),
 1743    !,
 1744    close(In).
 1745'$restore_load_stream'(In, state(HasName, HasPos), _Options) :-
 1746    (   HasName == false
 1747    ->  set_stream(In, file_name(''))
 1748    ;   true
 1749    ),
 1750    (   HasPos == false
 1751    ->  set_stream(In, record_position(false))
 1752    ;   true
 1753    ).
 1754
 1755
 1756                 /*******************************
 1757                 *          DERIVED FILES       *
 1758                 *******************************/
 1759
 1760:- dynamic
 1761    '$derived_source_db'/3.         % Loaded, DerivedFrom, Time
 1762
 1763'$register_derived_source'(_, '-') :- !.
 1764'$register_derived_source'(Loaded, DerivedFrom) :-
 1765    retractall('$derived_source_db'(Loaded, _, _)),
 1766    time_file(DerivedFrom, Time),
 1767    assert('$derived_source_db'(Loaded, DerivedFrom, Time)).
 1768
 1769%       Auto-importing dynamic predicates is not very elegant and
 1770%       leads to problems with qsave_program/[1,2]
 1771
 1772'$derived_source'(Loaded, DerivedFrom, Time) :-
 1773    '$derived_source_db'(Loaded, DerivedFrom, Time).
 1774
 1775
 1776                /********************************
 1777                *       LOAD PREDICATES         *
 1778                *********************************/
 1779
 1780:- meta_predicate
 1781    ensure_loaded(:),
 1782    [:|+],
 1783    consult(:),
 1784    use_module(:),
 1785    use_module(:, +),
 1786    reexport(:),
 1787    reexport(:, +),
 1788    load_files(:),
 1789    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.
 1797ensure_loaded(Files) :-
 1798    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.
 1807use_module(Files) :-
 1808    load_files(Files, [ if(not_loaded),
 1809                        must_be_module(true)
 1810                      ]).
 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.
 1817use_module(File, Import) :-
 1818    load_files(File, [ if(not_loaded),
 1819                       must_be_module(true),
 1820                       imports(Import)
 1821                     ]).
 reexport(+Files)
As use_module/1, exporting all imported predicates.
 1827reexport(Files) :-
 1828    load_files(Files, [ if(not_loaded),
 1829                        must_be_module(true),
 1830                        reexport(true)
 1831                      ]).
 reexport(+File, +ImportList)
As use_module/1, re-exporting all imported predicates.
 1837reexport(File, Import) :-
 1838    load_files(File, [ if(not_loaded),
 1839                       must_be_module(true),
 1840                       imports(Import),
 1841                       reexport(true)
 1842                     ]).
 1843
 1844
 1845[X] :-
 1846    !,
 1847    consult(X).
 1848[M:F|R] :-
 1849    consult(M:[F|R]).
 1850
 1851consult(M:X) :-
 1852    X == user,
 1853    !,
 1854    flag('$user_consult', N, N+1),
 1855    NN is N + 1,
 1856    atom_concat('user://', NN, Id),
 1857    load_files(M:Id, [stream(user_input), check_script(false), silent(false)]).
 1858consult(List) :-
 1859    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.
 1866load_files(Files) :-
 1867    load_files(Files, []).
 1868load_files(Module:Files, Options) :-
 1869    '$must_be'(list, Options),
 1870    '$load_files'(Files, Module, Options).
 1871
 1872'$load_files'(X, _, _) :-
 1873    var(X),
 1874    !,
 1875    '$instantiation_error'(X).
 1876'$load_files'([], _, _) :- !.
 1877'$load_files'(Id, Module, Options) :-   % load_files(foo, [stream(In)])
 1878    '$option'(stream(_), Options),
 1879    !,
 1880    (   atom(Id)
 1881    ->  '$load_file'(Id, Module, Options)
 1882    ;   throw(error(type_error(atom, Id), _))
 1883    ).
 1884'$load_files'(List, Module, Options) :-
 1885    List = [_|_],
 1886    !,
 1887    '$must_be'(list, List),
 1888    '$load_file_list'(List, Module, Options).
 1889'$load_files'(File, Module, Options) :-
 1890    '$load_one_file'(File, Module, Options).
 1891
 1892'$load_file_list'([], _, _).
 1893'$load_file_list'([File|Rest], Module, Options) :-
 1894    E = error(_,_),
 1895    catch('$load_one_file'(File, Module, Options), E,
 1896          '$print_message'(error, E)),
 1897    '$load_file_list'(Rest, Module, Options).
 1898
 1899
 1900'$load_one_file'(Spec, Module, Options) :-
 1901    atomic(Spec),
 1902    '$option'(expand(Expand), Options, false),
 1903    Expand == true,
 1904    !,
 1905    expand_file_name(Spec, Expanded),
 1906    (   Expanded = [Load]
 1907    ->  true
 1908    ;   Load = Expanded
 1909    ),
 1910    '$load_files'(Load, Module, [expand(false)|Options]).
 1911'$load_one_file'(File, Module, Options) :-
 1912    strip_module(Module:File, Into, PlainFile),
 1913    '$load_file'(PlainFile, Into, Options).
 $noload(+Condition, +FullFile, +Options) is semidet
True of FullFile should not be loaded.
 1920'$noload'(true, _, _) :-
 1921    !,
 1922    fail.
 1923'$noload'(not_loaded, FullFile, _) :-
 1924    source_file(FullFile),
 1925    !.
 1926'$noload'(changed, Derived, _) :-
 1927    '$derived_source'(_FullFile, Derived, LoadTime),
 1928    time_file(Derived, Modified),
 1929    Modified @=< LoadTime,
 1930    !.
 1931'$noload'(changed, FullFile, Options) :-
 1932    '$time_source_file'(FullFile, LoadTime, user),
 1933    '$modified_id'(FullFile, Modified, Options),
 1934    Modified @=< LoadTime,
 1935    !.
 $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.
 1954'$qlf_file'(Spec, _, Spec, stream, Options) :-
 1955    '$option'(stream(_), Options),      % stream: no choice
 1956    !.
 1957'$qlf_file'(Spec, FullFile, FullFile, compile, _) :-
 1958    '$spec_extension'(Spec, Ext),       % user explicitly specified
 1959    user:prolog_file_type(Ext, prolog),
 1960    !.
 1961'$qlf_file'(Spec, FullFile, LoadFile, Mode, Options) :-
 1962    '$compilation_mode'(database),
 1963    file_name_extension(Base, PlExt, FullFile),
 1964    user:prolog_file_type(PlExt, prolog),
 1965    user:prolog_file_type(QlfExt, qlf),
 1966    file_name_extension(Base, QlfExt, QlfFile),
 1967    (   access_file(QlfFile, read),
 1968        (   '$qlf_out_of_date'(FullFile, QlfFile, Why)
 1969        ->  (   access_file(QlfFile, write)
 1970            ->  print_message(informational,
 1971                              qlf(recompile(Spec, FullFile, QlfFile, Why))),
 1972                Mode = qcompile,
 1973                LoadFile = FullFile
 1974            ;   Why == old,
 1975                current_prolog_flag(home, PlHome),
 1976                sub_atom(FullFile, 0, _, _, PlHome)
 1977            ->  print_message(silent,
 1978                              qlf(system_lib_out_of_date(Spec, QlfFile))),
 1979                Mode = qload,
 1980                LoadFile = QlfFile
 1981            ;   print_message(warning,
 1982                              qlf(can_not_recompile(Spec, QlfFile, Why))),
 1983                Mode = compile,
 1984                LoadFile = FullFile
 1985            )
 1986        ;   Mode = qload,
 1987            LoadFile = QlfFile
 1988        )
 1989    ->  !
 1990    ;   '$qlf_auto'(FullFile, QlfFile, Options)
 1991    ->  !, Mode = qcompile,
 1992        LoadFile = FullFile
 1993    ).
 1994'$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.
 2002'$qlf_out_of_date'(PlFile, QlfFile, Why) :-
 2003    (   access_file(PlFile, read)
 2004    ->  time_file(PlFile, PlTime),
 2005        time_file(QlfFile, QlfTime),
 2006        (   PlTime > QlfTime
 2007        ->  Why = old                   % PlFile is newer
 2008        ;   Error = error(Formal,_),
 2009            catch('$qlf_sources'(QlfFile, _Files), Error, true),
 2010            nonvar(Formal)              % QlfFile is incompatible
 2011        ->  Why = Error
 2012        ;   fail                        % QlfFile is up-to-date and ok
 2013        )
 2014    ;   fail                            % can not read .pl; try .qlf
 2015    ).
 $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.
 2023:- create_prolog_flag(qcompile, false, [type(atom)]). 2024
 2025'$qlf_auto'(PlFile, QlfFile, Options) :-
 2026    (   memberchk(qcompile(QlfMode), Options)
 2027    ->  true
 2028    ;   current_prolog_flag(qcompile, QlfMode),
 2029        \+ '$in_system_dir'(PlFile)
 2030    ),
 2031    (   QlfMode == auto
 2032    ->  true
 2033    ;   QlfMode == large,
 2034        size_file(PlFile, Size),
 2035        Size > 100000
 2036    ),
 2037    access_file(QlfFile, write).
 2038
 2039'$in_system_dir'(PlFile) :-
 2040    current_prolog_flag(home, Home),
 2041    sub_atom(PlFile, 0, _, _, Home).
 2042
 2043'$spec_extension'(File, Ext) :-
 2044    atom(File),
 2045    file_name_extension(_, Ext, File).
 2046'$spec_extension'(Spec, Ext) :-
 2047    compound(Spec),
 2048    arg(1, Spec, Arg),
 2049    '$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:
 2061:- dynamic
 2062    '$resolved_source_path'/2.                  % ?Spec, ?Path
 2063
 2064'$load_file'(File, Module, Options) :-
 2065    \+ memberchk(stream(_), Options),
 2066    user:prolog_load_file(Module:File, Options),
 2067    !.
 2068'$load_file'(File, Module, Options) :-
 2069    memberchk(stream(_), Options),
 2070    !,
 2071    '$assert_load_context_module'(File, Module, Options),
 2072    '$qdo_load_file'(File, File, Module, Action, Options),
 2073    '$run_initialization'(File, Action, Options).
 2074'$load_file'(File, Module, Options) :-
 2075    '$resolved_source_path'(File, FullFile),
 2076    (   '$source_file_property'(FullFile, from_state, true)
 2077    ;   '$source_file_property'(FullFile, resource, true)
 2078    ;   '$option'(if(If), Options, true),
 2079        '$noload'(If, FullFile, Options)
 2080    ),
 2081    !,
 2082    '$already_loaded'(File, FullFile, Module, Options).
 2083'$load_file'(File, Module, Options) :-
 2084    absolute_file_name(File, FullFile,
 2085                       [ file_type(prolog),
 2086                         access(read)
 2087                       ]),
 2088    '$register_resolved_source_path'(File, FullFile),
 2089    '$mt_load_file'(File, FullFile, Module, Options),
 2090    '$register_resource_file'(FullFile).
 2091
 2092'$register_resolved_source_path'(File, FullFile) :-
 2093    '$resolved_source_path'(File, FullFile),
 2094    !.
 2095'$register_resolved_source_path'(File, FullFile) :-
 2096    compound(File),
 2097    !,
 2098    asserta('$resolved_source_path'(File, FullFile)).
 2099'$register_resolved_source_path'(_, _).
 $translated_source(+Old, +New) is det
Called from loading a QLF state when source files are being renamed.
 2105:- public '$translated_source'/2. 2106'$translated_source'(Old, New) :-
 2107    forall(retract('$resolved_source_path'(File, Old)),
 2108           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.
 2115'$register_resource_file'(FullFile) :-
 2116    (   sub_atom(FullFile, 0, _, _, 'res://')
 2117    ->  '$set_source_file'(FullFile, resource, true)
 2118    ;   true
 2119    ).
 $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.
 2132'$already_loaded'(_File, FullFile, Module, Options) :-
 2133    '$assert_load_context_module'(FullFile, Module, Options),
 2134    '$current_module'(LoadModules, FullFile),
 2135    !,
 2136    (   atom(LoadModules)
 2137    ->  LoadModule = LoadModules
 2138    ;   LoadModules = [LoadModule|_]
 2139    ),
 2140    '$import_from_loaded_module'(LoadModule, Module, Options).
 2141'$already_loaded'(_, _, user, _) :- !.
 2142'$already_loaded'(File, _, Module, Options) :-
 2143    '$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.

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

 2781'$set_dialect'(Dialect, State) :-
 2782    '$compilation_mode'(qlf, database),
 2783    !,
 2784    expects_dialect(Dialect),
 2785    '$compilation_mode'(_, qlf),
 2786    nb_setarg(6, State, Dialect).
 2787'$set_dialect'(Dialect, _) :-
 2788    expects_dialect(Dialect).
 2789
 2790'$qset_dialect'(State) :-
 2791    '$compilation_mode'(qlf),
 2792    arg(6, State, Dialect), Dialect \== (-),
 2793    !,
 2794    '$add_directive_wic'(expects_dialect(Dialect)).
 2795'$qset_dialect'(_).
 2796
 2797
 2798                 /*******************************
 2799                 *           MODULES            *
 2800                 *******************************/
 2801
 2802'$start_module'(Module, _Public, State, _Options) :-
 2803    '$current_module'(Module, OldFile),
 2804    source_location(File, _Line),
 2805    OldFile \== File, OldFile \== [],
 2806    same_file(OldFile, File),
 2807    !,
 2808    nb_setarg(2, State, Module),
 2809    nb_setarg(4, State, true).      % Stop processing
 2810'$start_module'(Module, Public, State, Options) :-
 2811    arg(5, State, File),
 2812    nb_setarg(2, State, Module),
 2813    source_location(_File, Line),
 2814    '$option'(redefine_module(Action), Options, false),
 2815    '$module_class'(File, Class, Super),
 2816    '$redefine_module'(Module, File, Action),
 2817    '$declare_module'(Module, Class, Super, File, Line, false),
 2818    '$export_list'(Public, Module, Ops),
 2819    '$ifcompiling'('$qlf_start_module'(Module)),
 2820    '$export_ops'(Ops, Module, File),
 2821    '$qset_dialect'(State),
 2822    nb_setarg(3, State, end_module).
 $module3(+Spec) is det
Handle the 3th argument of a module declartion.
 2829'$module3'(Var) :-
 2830    var(Var),
 2831    !,
 2832    '$instantiation_error'(Var).
 2833'$module3'([]) :- !.
 2834'$module3'([H|T]) :-
 2835    !,
 2836    '$module3'(H),
 2837    '$module3'(T).
 2838'$module3'(Id) :-
 2839    use_module(library(dialect/Id)).
 $module_name(?Name, +Id, -Module, +Options) is semidet
Determine the module name. There are some cases:
 2853'$module_name'(_, _, Module, Options) :-
 2854    '$option'(module(Module), Options),
 2855    !,
 2856    '$current_source_module'(Context),
 2857    Context \== Module.                     % cause '$first_term'/5 to fail.
 2858'$module_name'(Var, Id, Module, Options) :-
 2859    var(Var),
 2860    !,
 2861    file_base_name(Id, File),
 2862    file_name_extension(Var, _, File),
 2863    '$module_name'(Var, Id, Module, Options).
 2864'$module_name'(Reserved, _, _, _) :-
 2865    '$reserved_module'(Reserved),
 2866    !,
 2867    throw(error(permission_error(load, module, Reserved), _)).
 2868'$module_name'(Module, _Id, Module, _).
 2869
 2870
 2871'$reserved_module'(system).
 2872'$reserved_module'(user).
 $redefine_module(+Module, +File, -Redefine)
 2877'$redefine_module'(_Module, _, false) :- !.
 2878'$redefine_module'(Module, File, true) :-
 2879    !,
 2880    (   module_property(Module, file(OldFile)),
 2881        File \== OldFile
 2882    ->  unload_file(OldFile)
 2883    ;   true
 2884    ).
 2885'$redefine_module'(Module, File, ask) :-
 2886    (   stream_property(user_input, tty(true)),
 2887        module_property(Module, file(OldFile)),
 2888        File \== OldFile,
 2889        '$rdef_response'(Module, OldFile, File, true)
 2890    ->  '$redefine_module'(Module, File, true)
 2891    ;   true
 2892    ).
 2893
 2894'$rdef_response'(Module, OldFile, File, Ok) :-
 2895    repeat,
 2896    print_message(query, redefine_module(Module, OldFile, File)),
 2897    get_single_char(Char),
 2898    '$rdef_response'(Char, Ok0),
 2899    !,
 2900    Ok = Ok0.
 2901
 2902'$rdef_response'(Char, true) :-
 2903    memberchk(Char, `yY`),
 2904    format(user_error, 'yes~n', []).
 2905'$rdef_response'(Char, false) :-
 2906    memberchk(Char, `nN`),
 2907    format(user_error, 'no~n', []).
 2908'$rdef_response'(Char, _) :-
 2909    memberchk(Char, `a`),
 2910    format(user_error, 'abort~n', []),
 2911    abort.
 2912'$rdef_response'(_, _) :-
 2913    print_message(help, redefine_module_reply),
 2914    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.
 2923'$module_class'(File, Class, system) :-
 2924    current_prolog_flag(home, Home),
 2925    sub_atom(File, 0, Len, _, Home),
 2926    !,
 2927    (   sub_atom(File, Len, _, _, '/boot/')
 2928    ->  Class = system
 2929    ;   Class = library
 2930    ).
 2931'$module_class'(_, user, user).
 2932
 2933'$check_export'(Module) :-
 2934    '$undefined_export'(Module, UndefList),
 2935    (   '$member'(Undef, UndefList),
 2936        strip_module(Undef, _, Local),
 2937        print_message(error,
 2938                      undefined_export(Module, Local)),
 2939        fail
 2940    ;   true
 2941    ).
 $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).
 2950'$import_list'(_, _, Var, _) :-
 2951    var(Var),
 2952    !,
 2953    throw(error(instantitation_error, _)).
 2954'$import_list'(Target, Source, all, Reexport) :-
 2955    !,
 2956    '$exported_ops'(Source, Import, Predicates),
 2957    '$module_property'(Source, exports(Predicates)),
 2958    '$import_all'(Import, Target, Source, Reexport, weak).
 2959'$import_list'(Target, Source, except(Spec), Reexport) :-
 2960    !,
 2961    '$exported_ops'(Source, Export, Predicates),
 2962    '$module_property'(Source, exports(Predicates)),
 2963    (   is_list(Spec)
 2964    ->  true
 2965    ;   throw(error(type_error(list, Spec), _))
 2966    ),
 2967    '$import_except'(Spec, Export, Import),
 2968    '$import_all'(Import, Target, Source, Reexport, weak).
 2969'$import_list'(Target, Source, Import, Reexport) :-
 2970    !,
 2971    is_list(Import),
 2972    !,
 2973    '$import_all'(Import, Target, Source, Reexport, strong).
 2974'$import_list'(_, _, Import, _) :-
 2975    throw(error(type_error(import_specifier, Import))).
 2976
 2977
 2978'$import_except'([], List, List).
 2979'$import_except'([H|T], List0, List) :-
 2980    '$import_except_1'(H, List0, List1),
 2981    '$import_except'(T, List1, List).
 2982
 2983'$import_except_1'(Var, _, _) :-
 2984    var(Var),
 2985    !,
 2986    throw(error(instantitation_error, _)).
 2987'$import_except_1'(PI as N, List0, List) :-
 2988    '$pi'(PI), atom(N),
 2989    !,
 2990    '$canonical_pi'(PI, CPI),
 2991    '$import_as'(CPI, N, List0, List).
 2992'$import_except_1'(op(P,A,N), List0, List) :-
 2993    !,
 2994    '$remove_ops'(List0, op(P,A,N), List).
 2995'$import_except_1'(PI, List0, List) :-
 2996    '$pi'(PI),
 2997    !,
 2998    '$canonical_pi'(PI, CPI),
 2999    '$select'(P, List0, List),
 3000    '$canonical_pi'(CPI, P),
 3001    !.
 3002'$import_except_1'(Except, _, _) :-
 3003    throw(error(type_error(import_specifier, Except), _)).
 3004
 3005'$import_as'(CPI, N, [PI2|T], [CPI as N|T]) :-
 3006    '$canonical_pi'(PI2, CPI),
 3007    !.
 3008'$import_as'(PI, N, [H|T0], [H|T]) :-
 3009    !,
 3010    '$import_as'(PI, N, T0, T).
 3011'$import_as'(PI, _, _, _) :-
 3012    throw(error(existence_error(export, PI), _)).
 3013
 3014'$pi'(N/A) :- atom(N), integer(A), !.
 3015'$pi'(N//A) :- atom(N), integer(A).
 3016
 3017'$canonical_pi'(N//A0, N/A) :-
 3018    A is A0 + 2.
 3019'$canonical_pi'(PI, PI).
 3020
 3021'$remove_ops'([], _, []).
 3022'$remove_ops'([Op|T0], Pattern, T) :-
 3023    subsumes_term(Pattern, Op),
 3024    !,
 3025    '$remove_ops'(T0, Pattern, T).
 3026'$remove_ops'([H|T0], Pattern, [H|T]) :-
 3027    '$remove_ops'(T0, Pattern, T).
 $import_all(+Import, +Context, +Source, +Reexport, +Strength)
 3032'$import_all'(Import, Context, Source, Reexport, Strength) :-
 3033    '$import_all2'(Import, Context, Source, Imported, ImpOps, Strength),
 3034    (   Reexport == true,
 3035        (   '$list_to_conj'(Imported, Conj)
 3036        ->  export(Context:Conj),
 3037            '$ifcompiling'('$add_directive_wic'(export(Context:Conj)))
 3038        ;   true
 3039        ),
 3040        source_location(File, _Line),
 3041        '$export_ops'(ImpOps, Context, File)
 3042    ;   true
 3043    ).
 $import_all2(+Imports, +Context, +Source, -Imported, -ImpOps, +Strength)
 3047'$import_all2'([], _, _, [], [], _).
 3048'$import_all2'([PI as NewName|Rest], Context, Source,
 3049               [NewName/Arity|Imported], ImpOps, Strength) :-
 3050    !,
 3051    '$canonical_pi'(PI, Name/Arity),
 3052    length(Args, Arity),
 3053    Head =.. [Name|Args],
 3054    NewHead =.. [NewName|Args],
 3055    (   '$get_predicate_attribute'(Source:Head, transparent, 1)
 3056    ->  '$set_predicate_attribute'(Context:NewHead, transparent, true)
 3057    ;   true
 3058    ),
 3059    (   source_location(File, Line)
 3060    ->  E = error(_,_),
 3061        catch('$store_admin_clause'((NewHead :- Source:Head),
 3062                                    _Layout, File, File:Line),
 3063              E, '$print_message'(error, E))
 3064    ;   assertz((NewHead :- !, Source:Head)) % ! avoids problems with
 3065    ),                                       % duplicate load
 3066    '$import_all2'(Rest, Context, Source, Imported, ImpOps, Strength).
 3067'$import_all2'([op(P,A,N)|Rest], Context, Source, Imported,
 3068               [op(P,A,N)|ImpOps], Strength) :-
 3069    !,
 3070    '$import_ops'(Context, Source, op(P,A,N)),
 3071    '$import_all2'(Rest, Context, Source, Imported, ImpOps, Strength).
 3072'$import_all2'([Pred|Rest], Context, Source, [Pred|Imported], ImpOps, Strength) :-
 3073    Error = error(_,_),
 3074    catch(Context:'$import'(Source:Pred, Strength), Error,
 3075          print_message(error, Error)),
 3076    '$ifcompiling'('$import_wic'(Source, Pred, Strength)),
 3077    '$import_all2'(Rest, Context, Source, Imported, ImpOps, Strength).
 3078
 3079
 3080'$list_to_conj'([One], One) :- !.
 3081'$list_to_conj'([H|T], (H,Rest)) :-
 3082    '$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.
 3089'$exported_ops'(Module, Ops, Tail) :-
 3090    '$c_current_predicate'(_, Module:'$exported_op'(_,_,_)),
 3091    !,
 3092    findall(op(P,A,N), Module:'$exported_op'(P,A,N), Ops, Tail).
 3093'$exported_ops'(_, Ops, Ops).
 3094
 3095'$exported_op'(Module, P, A, N) :-
 3096    '$c_current_predicate'(_, Module:'$exported_op'(_,_,_)),
 3097    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.
 3104'$import_ops'(To, From, Pattern) :-
 3105    ground(Pattern),
 3106    !,
 3107    Pattern = op(P,A,N),
 3108    op(P,A,To:N),
 3109    (   '$exported_op'(From, P, A, N)
 3110    ->  true
 3111    ;   print_message(warning, no_exported_op(From, Pattern))
 3112    ).
 3113'$import_ops'(To, From, Pattern) :-
 3114    (   '$exported_op'(From, Pri, Assoc, Name),
 3115        Pattern = op(Pri, Assoc, Name),
 3116        op(Pri, Assoc, To:Name),
 3117        fail
 3118    ;   true
 3119    ).
 $export_list(+Declarations, +Module, -Ops)
Handle the export list of the module declaration for Module associated to File.
 3127'$export_list'(Decls, Module, Ops) :-
 3128    is_list(Decls),
 3129    !,
 3130    '$do_export_list'(Decls, Module, Ops).
 3131'$export_list'(Decls, _, _) :-
 3132    var(Decls),
 3133    throw(error(instantiation_error, _)).
 3134'$export_list'(Decls, _, _) :-
 3135    throw(error(type_error(list, Decls), _)).
 3136
 3137'$do_export_list'([], _, []) :- !.
 3138'$do_export_list'([H|T], Module, Ops) :-
 3139    !,
 3140    E = error(_,_),
 3141    catch('$export1'(H, Module, Ops, Ops1),
 3142          E, ('$print_message'(error, E), Ops = Ops1)),
 3143    '$do_export_list'(T, Module, Ops1).
 3144
 3145'$export1'(Var, _, _, _) :-
 3146    var(Var),
 3147    !,
 3148    throw(error(instantiation_error, _)).
 3149'$export1'(Op, _, [Op|T], T) :-
 3150    Op = op(_,_,_),
 3151    !.
 3152'$export1'(PI0, Module, Ops, Ops) :-
 3153    strip_module(Module:PI0, M, PI),
 3154    (   PI = (_//_)
 3155    ->  non_terminal(M:PI)
 3156    ;   true
 3157    ),
 3158    export(M:PI).
 3159
 3160'$export_ops'([op(Pri, Assoc, Name)|T], Module, File) :-
 3161    E = error(_,_),
 3162    catch(( '$execute_directive'(op(Pri, Assoc, Module:Name), File),
 3163            '$export_op'(Pri, Assoc, Name, Module, File)
 3164          ),
 3165          E, '$print_message'(error, E)),
 3166    '$export_ops'(T, Module, File).
 3167'$export_ops'([], _, _).
 3168
 3169'$export_op'(Pri, Assoc, Name, Module, File) :-
 3170    (   '$get_predicate_attribute'(Module:'$exported_op'(_,_,_), defined, 1)
 3171    ->  true
 3172    ;   '$execute_directive'(discontiguous(Module:'$exported_op'/3), File)
 3173    ),
 3174    '$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.
 3180'$execute_directive'(Goal, F) :-
 3181    '$execute_directive_2'(Goal, F).
 3182
 3183'$execute_directive_2'(encoding(Encoding), _F) :-
 3184    !,
 3185    (   '$load_input'(_F, S)
 3186    ->  set_stream(S, encoding(Encoding))
 3187    ).
 3188'$execute_directive_2'(Goal, _) :-
 3189    \+ '$compilation_mode'(database),
 3190    !,
 3191    '$add_directive_wic2'(Goal, Type),
 3192    (   Type == call                % suspend compiling into .qlf file
 3193    ->  '$compilation_mode'(Old, database),
 3194        setup_call_cleanup(
 3195            '$directive_mode'(OldDir, Old),
 3196            '$execute_directive_3'(Goal),
 3197            ( '$set_compilation_mode'(Old),
 3198              '$set_directive_mode'(OldDir)
 3199            ))
 3200    ;   '$execute_directive_3'(Goal)
 3201    ).
 3202'$execute_directive_2'(Goal, _) :-
 3203    '$execute_directive_3'(Goal).
 3204
 3205'$execute_directive_3'(Goal) :-
 3206    '$current_source_module'(Module),
 3207    '$valid_directive'(Module:Goal),
 3208    !,
 3209    (   '$pattr_directive'(Goal, Module)
 3210    ->  true
 3211    ;   Term = error(_,_),
 3212        catch(Module:Goal, Term, '$exception_in_directive'(Term))
 3213    ->  true
 3214    ;   '$print_message'(warning, goal_failed(directive, Module:Goal)),
 3215        fail
 3216    ).
 3217'$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.
 3226:- multifile prolog:sandbox_allowed_directive/1. 3227:- multifile prolog:sandbox_allowed_clause/1. 3228:- meta_predicate '$valid_directive'(:). 3229
 3230'$valid_directive'(_) :-
 3231    current_prolog_flag(sandboxed_load, false),
 3232    !.
 3233'$valid_directive'(Goal) :-
 3234    Error = error(Formal, _),
 3235    catch(prolog:sandbox_allowed_directive(Goal), Error, true),
 3236    !,
 3237    (   var(Formal)
 3238    ->  true
 3239    ;   print_message(error, Error),
 3240        fail
 3241    ).
 3242'$valid_directive'(Goal) :-
 3243    print_message(error,
 3244                  error(permission_error(execute,
 3245                                         sandboxed_directive,
 3246                                         Goal), _)),
 3247    fail.
 3248
 3249'$exception_in_directive'(Term) :-
 3250    '$print_message'(error, Term),
 3251    fail.
 3252
 3253%       Note that the list, consult and ensure_loaded directives are already
 3254%       handled at compile time and therefore should not go into the
 3255%       intermediate code file.
 3256
 3257'$add_directive_wic2'(Goal, Type) :-
 3258    '$common_goal_type'(Goal, Type),
 3259    !,
 3260    (   Type == load
 3261    ->  true
 3262    ;   '$current_source_module'(Module),
 3263        '$add_directive_wic'(Module:Goal)
 3264    ).
 3265'$add_directive_wic2'(Goal, _) :-
 3266    (   '$compilation_mode'(qlf)    % no problem for qlf files
 3267    ->  true
 3268    ;   print_message(error, mixed_directive(Goal))
 3269    ).
 3270
 3271'$common_goal_type'((A,B), Type) :-
 3272    !,
 3273    '$common_goal_type'(A, Type),
 3274    '$common_goal_type'(B, Type).
 3275'$common_goal_type'((A;B), Type) :-
 3276    !,
 3277    '$common_goal_type'(A, Type),
 3278    '$common_goal_type'(B, Type).
 3279'$common_goal_type'((A->B), Type) :-
 3280    !,
 3281    '$common_goal_type'(A, Type),
 3282    '$common_goal_type'(B, Type).
 3283'$common_goal_type'(Goal, Type) :-
 3284    '$goal_type'(Goal, Type).
 3285
 3286'$goal_type'(Goal, Type) :-
 3287    (   '$load_goal'(Goal)
 3288    ->  Type = load
 3289    ;   Type = call
 3290    ).
 3291
 3292'$load_goal'([_|_]).
 3293'$load_goal'(consult(_)).
 3294'$load_goal'(load_files(_)).
 3295'$load_goal'(load_files(_,Options)) :-
 3296    memberchk(qcompile(QlfMode), Options),
 3297    '$qlf_part_mode'(QlfMode).
 3298'$load_goal'(ensure_loaded(_)) :- '$compilation_mode'(wic).
 3299'$load_goal'(use_module(_))    :- '$compilation_mode'(wic).
 3300'$load_goal'(use_module(_, _)) :- '$compilation_mode'(wic).
 3301
 3302'$qlf_part_mode'(part).
 3303'$qlf_part_mode'(true).                 % compatibility
 3304
 3305
 3306                /********************************
 3307                *        COMPILE A CLAUSE       *
 3308                *********************************/
 $store_admin_clause(+Clause, ?Layout, +Owner, +SrcLoc) is det
Store a clause into the database for administrative purposes. This bypasses sanity checking.
 3315'$store_admin_clause'(Clause, Layout, Owner, SrcLoc) :-
 3316    Owner \== (-),
 3317    !,
 3318    setup_call_cleanup(
 3319        '$start_aux'(Owner, Context),
 3320        '$store_admin_clause2'(Clause, Layout, Owner, SrcLoc),
 3321        '$end_aux'(Owner, Context)).
 3322'$store_admin_clause'(Clause, Layout, File, SrcLoc) :-
 3323    '$store_admin_clause2'(Clause, Layout, File, SrcLoc).
 3324
 3325'$store_admin_clause2'(Clause, _Layout, File, SrcLoc) :-
 3326    (   '$compilation_mode'(database)
 3327    ->  '$record_clause'(Clause, File, SrcLoc)
 3328    ;   '$record_clause'(Clause, File, SrcLoc, Ref),
 3329        '$qlf_assert_clause'(Ref, development)
 3330    ).
 $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.
 3340'$store_clause'((_, _), _, _, _) :-
 3341    !,
 3342    print_message(error, cannot_redefine_comma),
 3343    fail.
 3344'$store_clause'(Clause, _Layout, File, SrcLoc) :-
 3345    '$valid_clause'(Clause),
 3346    !,
 3347    (   '$compilation_mode'(database)
 3348    ->  '$record_clause'(Clause, File, SrcLoc)
 3349    ;   '$record_clause'(Clause, File, SrcLoc, Ref),
 3350        '$qlf_assert_clause'(Ref, development)
 3351    ).
 3352
 3353'$valid_clause'(_) :-
 3354    current_prolog_flag(sandboxed_load, false),
 3355    !.
 3356'$valid_clause'(Clause) :-
 3357    \+ '$cross_module_clause'(Clause),
 3358    !.
 3359'$valid_clause'(Clause) :-
 3360    Error = error(Formal, _),
 3361    catch(prolog:sandbox_allowed_clause(Clause), Error, true),
 3362    !,
 3363    (   var(Formal)
 3364    ->  true
 3365    ;   print_message(error, Error),
 3366        fail
 3367    ).
 3368'$valid_clause'(Clause) :-
 3369    print_message(error,
 3370                  error(permission_error(assert,
 3371                                         sandboxed_clause,
 3372                                         Clause), _)),
 3373    fail.
 3374
 3375'$cross_module_clause'(Clause) :-
 3376    '$head_module'(Clause, Module),
 3377    \+ '$current_source_module'(Module).
 3378
 3379'$head_module'(Var, _) :-
 3380    var(Var), !, fail.
 3381'$head_module'((Head :- _), Module) :-
 3382    '$head_module'(Head, Module).
 3383'$head_module'(Module:_, Module).
 3384
 3385'$clause_source'('$source_location'(File,Line):Clause, Clause, File:Line) :- !.
 3386'$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.
 3393:- public
 3394    '$store_clause'/2. 3395
 3396'$store_clause'(Term, Id) :-
 3397    '$clause_source'(Term, Clause, SrcLoc),
 3398    '$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?
 3419compile_aux_clauses(_Clauses) :-
 3420    current_prolog_flag(xref, true),
 3421    !.
 3422compile_aux_clauses(Clauses) :-
 3423    source_location(File, _Line),
 3424    '$compile_aux_clauses'(Clauses, File).
 3425
 3426'$compile_aux_clauses'(Clauses, File) :-
 3427    setup_call_cleanup(
 3428        '$start_aux'(File, Context),
 3429        '$store_aux_clauses'(Clauses, File),
 3430        '$end_aux'(File, Context)).
 3431
 3432'$store_aux_clauses'(Clauses, File) :-
 3433    is_list(Clauses),
 3434    !,
 3435    forall('$member'(C,Clauses),
 3436           '$compile_term'(C, _Layout, File)).
 3437'$store_aux_clauses'(Clause, File) :-
 3438    '$compile_term'(Clause, _Layout, File).
 3439
 3440
 3441		 /*******************************
 3442		 *            STAGING		*
 3443		 *******************************/
 $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.
 3453'$stage_file'(Target, Stage) :-
 3454    file_directory_name(Target, Dir),
 3455    file_base_name(Target, File),
 3456    current_prolog_flag(pid, Pid),
 3457    format(atom(Stage), '~w/.~w.~d', [Dir,File,Pid]).
 3458
 3459'$install_staged_file'(exit, Staged, Target, error) :-
 3460    !,
 3461    rename_file(Staged, Target).
 3462'$install_staged_file'(exit, Staged, Target, OnError) :-
 3463    !,
 3464    InstallError = error(_,_),
 3465    catch(rename_file(Staged, Target),
 3466          InstallError,
 3467          '$install_staged_error'(OnError, InstallError, Staged, Target)).
 3468'$install_staged_file'(_, Staged, _, _OnError) :-
 3469    E = error(_,_),
 3470    catch(delete_file(Staged), E, true).
 3471
 3472'$install_staged_error'(OnError, Error, Staged, _Target) :-
 3473    E = error(_,_),
 3474    catch(delete_file(Staged), E, true),
 3475    (   OnError = silent
 3476    ->  true
 3477    ;   OnError = fail
 3478    ->  fail
 3479    ;   print_message(warning, Error)
 3480    ).
 3481
 3482
 3483                 /*******************************
 3484                 *             READING          *
 3485                 *******************************/
 3486
 3487:- multifile
 3488    prolog:comment_hook/3.                  % hook for read_clause/3
 3489
 3490
 3491                 /*******************************
 3492                 *       FOREIGN INTERFACE      *
 3493                 *******************************/
 3494
 3495%       call-back from PL_register_foreign().  First argument is the module
 3496%       into which the foreign predicate is loaded and second is a term
 3497%       describing the arguments.
 3498
 3499:- dynamic
 3500    '$foreign_registered'/2. 3501
 3502                 /*******************************
 3503                 *   TEMPORARY TERM EXPANSION   *
 3504                 *******************************/
 3505
 3506% Provide temporary definitions for the boot-loader.  These are replaced
 3507% by the real thing in load.pl
 3508
 3509:- dynamic
 3510    '$expand_goal'/2,
 3511    '$expand_term'/4. 3512
 3513'$expand_goal'(In, In).
 3514'$expand_term'(In, Layout, In, Layout).
 3515
 3516
 3517                 /*******************************
 3518                 *         TYPE SUPPORT         *
 3519                 *******************************/
 3520
 3521'$type_error'(Type, Value) :-
 3522    (   var(Value)
 3523    ->  throw(error(instantiation_error, _))
 3524    ;   throw(error(type_error(Type, Value), _))
 3525    ).
 3526
 3527'$domain_error'(Type, Value) :-
 3528    throw(error(domain_error(Type, Value), _)).
 3529
 3530'$existence_error'(Type, Object) :-
 3531    throw(error(existence_error(Type, Object), _)).
 3532
 3533'$permission_error'(Action, Type, Term) :-
 3534    throw(error(permission_error(Action, Type, Term), _)).
 3535
 3536'$instantiation_error'(_Var) :-
 3537    throw(error(instantiation_error, _)).
 3538
 3539'$uninstantiation_error'(NonVar) :-
 3540    throw(error(uninstantiation_error(NonVar), _)).
 3541
 3542'$must_be'(list, X) :- !,
 3543    '$skip_list'(_, X, Tail),
 3544    (   Tail == []
 3545    ->  true
 3546    ;   '$type_error'(list, Tail)
 3547    ).
 3548'$must_be'(options, X) :- !,
 3549    (   '$is_options'(X)
 3550    ->  true
 3551    ;   '$type_error'(options, X)
 3552    ).
 3553'$must_be'(atom, X) :- !,
 3554    (   atom(X)
 3555    ->  true
 3556    ;   '$type_error'(atom, X)
 3557    ).
 3558'$must_be'(integer, X) :- !,
 3559    (   integer(X)
 3560    ->  true
 3561    ;   '$type_error'(integer, X)
 3562    ).
 3563'$must_be'(between(Low,High), X) :- !,
 3564    (   integer(X)
 3565    ->  (   between(Low, High, X)
 3566        ->  true
 3567        ;   '$domain_error'(between(Low,High), X)
 3568        )
 3569    ;   '$type_error'(integer, X)
 3570    ).
 3571'$must_be'(callable, X) :- !,
 3572    (   callable(X)
 3573    ->  true
 3574    ;   '$type_error'(callable, X)
 3575    ).
 3576'$must_be'(oneof(Type, Domain, List), X) :- !,
 3577    '$must_be'(Type, X),
 3578    (   memberchk(X, List)
 3579    ->  true
 3580    ;   '$domain_error'(Domain, X)
 3581    ).
 3582'$must_be'(boolean, X) :- !,
 3583    (   (X == true ; X == false)
 3584    ->  true
 3585    ;   '$type_error'(boolean, X)
 3586    ).
 3587% Use for debugging
 3588%'$must_be'(Type, _X) :- format('Unknown $must_be type: ~q~n', [Type]).
 3589
 3590
 3591                /********************************
 3592                *       LIST PROCESSING         *
 3593                *********************************/
 3594
 3595'$member'(El, [H|T]) :-
 3596    '$member_'(T, El, H).
 3597
 3598'$member_'(_, El, El).
 3599'$member_'([H|T], El, _) :-
 3600    '$member_'(T, El, H).
 3601
 3602
 3603'$append'([], L, L).
 3604'$append'([H|T], L, [H|R]) :-
 3605    '$append'(T, L, R).
 3606
 3607'$select'(X, [X|Tail], Tail).
 3608'$select'(Elem, [Head|Tail], [Head|Rest]) :-
 3609    '$select'(Elem, Tail, Rest).
 3610
 3611'$reverse'(L1, L2) :-
 3612    '$reverse'(L1, [], L2).
 3613
 3614'$reverse'([], List, List).
 3615'$reverse'([Head|List1], List2, List3) :-
 3616    '$reverse'(List1, [Head|List2], List3).
 3617
 3618'$delete'([], _, []) :- !.
 3619'$delete'([Elem|Tail], Elem, Result) :-
 3620    !,
 3621    '$delete'(Tail, Elem, Result).
 3622'$delete'([Head|Tail], Elem, [Head|Rest]) :-
 3623    '$delete'(Tail, Elem, Rest).
 3624
 3625'$last'([H|T], Last) :-
 3626    '$last'(T, H, Last).
 3627
 3628'$last'([], Last, Last).
 3629'$last'([H|T], _, Last) :-
 3630    '$last'(T, H, Last).
 length(?List, ?N)
Is true when N is the length of List.
 3637:- '$iso'((length/2)). 3638
 3639length(List, Length) :-
 3640    var(Length),
 3641    !,
 3642    '$skip_list'(Length0, List, Tail),
 3643    (   Tail == []
 3644    ->  Length = Length0                    % +,-
 3645    ;   var(Tail)
 3646    ->  Tail \== Length,                    % avoid length(L,L)
 3647        '$length3'(Tail, Length, Length0)   % -,-
 3648    ;   throw(error(type_error(list, List),
 3649                    context(length/2, _)))
 3650    ).
 3651length(List, Length) :-
 3652    integer(Length),
 3653    Length >= 0,
 3654    !,
 3655    '$skip_list'(Length0, List, Tail),
 3656    (   Tail == []                          % proper list
 3657    ->  Length = Length0
 3658    ;   var(Tail)
 3659    ->  Extra is Length-Length0,
 3660        '$length'(Tail, Extra)
 3661    ;   throw(error(type_error(list, List),
 3662                    context(length/2, _)))
 3663    ).
 3664length(_, Length) :-
 3665    integer(Length),
 3666    !,
 3667    throw(error(domain_error(not_less_than_zero, Length),
 3668                context(length/2, _))).
 3669length(_, Length) :-
 3670    throw(error(type_error(integer, Length),
 3671                context(length/2, _))).
 3672
 3673'$length3'([], N, N).
 3674'$length3'([_|List], N, N0) :-
 3675    N1 is N0+1,
 3676    '$length3'(List, N, N1).
 3677
 3678
 3679                 /*******************************
 3680                 *       OPTION PROCESSING      *
 3681                 *******************************/
 $is_options(@Term) is semidet
True if Term looks like it provides options.
 3687'$is_options'(Map) :-
 3688    is_dict(Map, _),
 3689    !.
 3690'$is_options'(List) :-
 3691    is_list(List),
 3692    (   List == []
 3693    ->  true
 3694    ;   List = [H|_],
 3695        '$is_option'(H, _, _)
 3696    ).
 3697
 3698'$is_option'(Var, _, _) :-
 3699    var(Var), !, fail.
 3700'$is_option'(F, Name, Value) :-
 3701    functor(F, _, 1),
 3702    !,
 3703    F =.. [Name,Value].
 3704'$is_option'(Name=Value, Name, Value).
 $option(?Opt, +Options) is semidet
 3708'$option'(Opt, Options) :-
 3709    is_dict(Options),
 3710    !,
 3711    [Opt] :< Options.
 3712'$option'(Opt, Options) :-
 3713    memberchk(Opt, Options).
 $option(?Opt, +Options, +Default) is det
 3717'$option'(Term, Options, Default) :-
 3718    arg(1, Term, Value),
 3719    functor(Term, Name, 1),
 3720    (   is_dict(Options)
 3721    ->  (   get_dict(Name, Options, GVal)
 3722        ->  Value = GVal
 3723        ;   Value = Default
 3724        )
 3725    ;   functor(Gen, Name, 1),
 3726        arg(1, Gen, GVal),
 3727        (   memberchk(Gen, Options)
 3728        ->  Value = GVal
 3729        ;   Value = Default
 3730        )
 3731    ).
 $select_option(?Opt, +Options, -Rest) is semidet
Select an option from Options.
Arguments:
Rest- is always a map.
 3739'$select_option'(Opt, Options, Rest) :-
 3740    select_dict([Opt], Options, Rest).
 $merge_options(+New, +Default, -Merged) is det
Add/replace options specified in New.
Arguments:
Merged- is always a map.
 3748'$merge_options'(New, Old, Merged) :-
 3749    put_dict(New, Old, Merged).
 3750
 3751
 3752                 /*******************************
 3753                 *   HANDLE TRACER 'L'-COMMAND  *
 3754                 *******************************/
 3755
 3756:- public '$prolog_list_goal'/1. 3757
 3758:- multifile
 3759    user:prolog_list_goal/1. 3760
 3761'$prolog_list_goal'(Goal) :-
 3762    user:prolog_list_goal(Goal),
 3763    !.
 3764'$prolog_list_goal'(Goal) :-
 3765    user:listing(Goal).
 3766
 3767		 /*******************************
 3768		 *              MISC		*
 3769		 *******************************/
 3770
 3771'$pi_head'(PI, Head) :-
 3772    var(PI),
 3773    var(Head),
 3774    '$instantiation_error'([PI,Head]).
 3775'$pi_head'(M:PI, M:Head) :-
 3776    !,
 3777    '$pi_head'(PI, Head).
 3778'$pi_head'(Name/Arity, Head) :-
 3779    !,
 3780    functor(Head, Name, Arity).
 3781'$pi_head'(Name//DCGArity, Head) :-
 3782    !,
 3783    (   nonvar(DCGArity)
 3784    ->  Arity is DCGArity+2,
 3785        functor(Head, Name, Arity)
 3786    ;   functor(Head, Name, Arity),
 3787        DCGArity is Arity - 2
 3788    ).
 3789
 3790
 3791                 /*******************************
 3792                 *             HALT             *
 3793                 *******************************/
 3794
 3795:- '$iso'((halt/0)). 3796
 3797halt :-
 3798    halt(0).
 at_halt(:Goal)
Register Goal to be called if the system halts.
To be done
- : get location into the error message
 3807:- meta_predicate at_halt(0). 3808:- dynamic        system:term_expansion/2, '$at_halt'/2. 3809:- multifile      system:term_expansion/2, '$at_halt'/2. 3810
 3811system:term_expansion((:- at_halt(Goal)),
 3812                      system:'$at_halt'(Module:Goal, File:Line)) :-
 3813    \+ current_prolog_flag(xref, true),
 3814    source_location(File, Line),
 3815    '$current_source_module'(Module).
 3816
 3817at_halt(Goal) :-
 3818    asserta('$at_halt'(Goal, (-):0)).
 3819
 3820:- public '$run_at_halt'/0. 3821
 3822'$run_at_halt' :-
 3823    forall(clause('$at_halt'(Goal, Src), true, Ref),
 3824           ( '$call_at_halt'(Goal, Src),
 3825             erase(Ref)
 3826           )).
 3827
 3828'$call_at_halt'(Goal, _Src) :-
 3829    catch(Goal, E, true),
 3830    !,
 3831    (   var(E)
 3832    ->  true
 3833    ;   subsumes_term(cancel_halt(_), E)
 3834    ->  '$print_message'(informational, E),
 3835        fail
 3836    ;   '$print_message'(error, E)
 3837    ).
 3838'$call_at_halt'(Goal, _Src) :-
 3839    '$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.
 3847cancel_halt(Reason) :-
 3848    throw(cancel_halt(Reason)).
 3849
 3850
 3851                /********************************
 3852                *      LOAD OTHER MODULES       *
 3853                *********************************/
 3854
 3855:- meta_predicate
 3856    '$load_wic_files'(:). 3857
 3858'$load_wic_files'(Files) :-
 3859    Files = Module:_,
 3860    '$execute_directive'('$set_source_module'(OldM, Module), []),
 3861    '$save_lex_state'(LexState, []),
 3862    '$style_check'(_, 0xC7),                % see style_name/2 in syspred.pl
 3863    '$compilation_mode'(OldC, wic),
 3864    consult(Files),
 3865    '$execute_directive'('$set_source_module'(OldM), []),
 3866    '$execute_directive'('$restore_lex_state'(LexState), []),
 3867    '$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.
 3875:- public '$load_additional_boot_files'/0. 3876
 3877'$load_additional_boot_files' :-
 3878    current_prolog_flag(argv, Argv),
 3879    '$get_files_argv'(Argv, Files),
 3880    (   Files \== []
 3881    ->  format('Loading additional boot files~n'),
 3882        '$load_wic_files'(user:Files),
 3883        format('additional boot files loaded~n')
 3884    ;   true
 3885    ).
 3886
 3887'$get_files_argv'([], []) :- !.
 3888'$get_files_argv'(['-c'|Files], Files) :- !.
 3889'$get_files_argv'([_|Rest], Files) :-
 3890    '$get_files_argv'(Rest, Files).
 3891
 3892'$:-'(('$boot_message'('Loading Prolog startup files~n', []),
 3893       source_location(File, _Line),
 3894       file_directory_name(File, Dir),
 3895       atom_concat(Dir, '/load.pl', LoadFile),
 3896       '$load_wic_files'(system:[LoadFile]),
 3897       (   current_prolog_flag(windows, true)
 3898       ->  atom_concat(Dir, '/menu.pl', MenuFile),
 3899           '$load_wic_files'(system:[MenuFile])
 3900       ;   true
 3901       ),
 3902       '$boot_message'('SWI-Prolog boot files loaded~n', []),
 3903       '$compilation_mode'(OldC, wic),
 3904       '$execute_directive'('$set_source_module'(user), []),
 3905       '$set_compilation_mode'(OldC)
 3906      ))