View source with raw comments or as raw
    1/*  Part of SWI-Prolog
    2
    3    Author:        Jan Wielemaker
    4    E-mail:        J.Wielemaker@vu.nl
    5    WWW:           http://www.swi-prolog.org
    6    Copyright (c)  1985-2018, University of Amsterdam
    7                              VU University Amsterdam
    8                              CWI, Amsterdam
    9    All rights reserved.
   10
   11    Redistribution and use in source and binary forms, with or without
   12    modification, are permitted provided that the following conditions
   13    are met:
   14
   15    1. Redistributions of source code must retain the above copyright
   16       notice, this list of conditions and the following disclaimer.
   17
   18    2. Redistributions in binary form must reproduce the above copyright
   19       notice, this list of conditions and the following disclaimer in
   20       the documentation and/or other materials provided with the
   21       distribution.
   22
   23    THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
   24    "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
   25    LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS
   26    FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE
   27    COPYRIGHT OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT,
   28    INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING,
   29    BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES;
   30    LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER
   31    CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
   32    LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN
   33    ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
   34    POSSIBILITY OF SUCH DAMAGE.
   35*/
   36
   37/*
   38Consult, derivates and basic things.   This  module  is  loaded  by  the
   39C-written  bootstrap  compiler.
   40
   41The $:- directive  is  executed  by  the  bootstrap  compiler,  but  not
   42inserted  in  the  intermediate  code  file.   Used  to print diagnostic
   43messages and start the Prolog defined compiler for  the  remaining  boot
   44modules.
   45
   46If you want  to  debug  this  module,  put  a  '$:-'(trace).   directive
   47somewhere.   The  tracer will work properly under boot compilation as it
   48will use the C defined write predicate  to  print  goals  and  does  not
   49attempt to call the Prolog defined trace interceptor.
   50*/
   51
   52                /********************************
   53                *    LOAD INTO MODULE SYSTEM    *
   54                ********************************/
   55
   56:- '$set_source_module'(system).   57
   58'$boot_message'(_Format, _Args) :-
   59    current_prolog_flag(verbose, silent),
   60    !.
   61'$boot_message'(Format, Args) :-
   62    format(Format, Args),
   63    !.
   64
   65'$:-'('$boot_message'('Loading boot file ...~n', [])).
   66
   67
   68                /********************************
   69                *          DIRECTIVES           *
   70                *********************************/
   71
   72:- meta_predicate
   73    dynamic(:),
   74    multifile(:),
   75    public(:),
   76    module_transparent(:),
   77    discontiguous(:),
   78    volatile(:),
   79    thread_local(:),
   80    noprofile(:),
   81    non_terminal(:),
   82    '$clausable'(:),
   83    '$iso'(:),
   84    '$hide'(:).
 dynamic +Spec is det
 multifile +Spec is det
 module_transparent +Spec is det
 discontiguous +Spec is det
 volatile +Spec is det
 thread_local +Spec is det
 noprofile(+Spec) is det
 public +Spec is det
 non_terminal(+Spec) is det
Predicate versions of standard directives that set predicate attributes. These predicates bail out with an error on the first failure (typically permission errors).
  100dynamic(Spec)            :- '$set_pattr'(Spec, pred, (dynamic)).
  101multifile(Spec)          :- '$set_pattr'(Spec, pred, (multifile)).
  102module_transparent(Spec) :- '$set_pattr'(Spec, pred, (transparent)).
  103discontiguous(Spec)      :- '$set_pattr'(Spec, pred, (discontiguous)).
  104volatile(Spec)           :- '$set_pattr'(Spec, pred, (volatile)).
  105thread_local(Spec)       :- '$set_pattr'(Spec, pred, (thread_local)).
  106noprofile(Spec)          :- '$set_pattr'(Spec, pred, (noprofile)).
  107public(Spec)             :- '$set_pattr'(Spec, pred, (public)).
  108non_terminal(Spec)       :- '$set_pattr'(Spec, pred, (non_terminal)).
  109'$iso'(Spec)             :- '$set_pattr'(Spec, pred, (iso)).
  110'$clausable'(Spec)       :- '$set_pattr'(Spec, pred, (clausable)).
  111
  112'$set_pattr'(M:Pred, How, Attr) :-
  113    '$set_pattr'(Pred, M, How, Attr).
  114
  115'$set_pattr'(X, _, _, _) :-
  116    var(X),
  117    throw(error(instantiation_error, _)).
  118'$set_pattr'([], _, _, _) :- !.
  119'$set_pattr'([H|T], M, How, Attr) :-           % ISO
  120    !,
  121    '$set_pattr'(H, M, How, Attr),
  122    '$set_pattr'(T, M, How, Attr).
  123'$set_pattr'((A,B), M, How, Attr) :-           % ISO and traditional
  124    !,
  125    '$set_pattr'(A, M, How, Attr),
  126    '$set_pattr'(B, M, How, Attr).
  127'$set_pattr'(M:T, _, How, Attr) :-
  128    !,
  129    '$set_pattr'(T, M, How, Attr).
  130'$set_pattr'(A, M, pred, Attr) :-
  131    !,
  132    '$set_predicate_attribute'(M:A, Attr, true).
  133'$set_pattr'(A, M, directive, Attr) :-
  134    !,
  135    catch('$set_predicate_attribute'(M:A, Attr, true),
  136          error(E, _),
  137          print_message(error, error(E, context((Attr)/1,_)))).
 $pattr_directive(+Spec, +Module) is det
This implements the directive version of dynamic/1, multifile/1, etc. This version catches and prints errors. If the directive specifies multiple predicates, processing after an error continues with the remaining predicates.
  146'$pattr_directive'(dynamic(Spec), M) :-
  147    '$set_pattr'(Spec, M, directive, (dynamic)).
  148'$pattr_directive'(multifile(Spec), M) :-
  149    '$set_pattr'(Spec, M, directive, (multifile)).
  150'$pattr_directive'(module_transparent(Spec), M) :-
  151    '$set_pattr'(Spec, M, directive, (transparent)).
  152'$pattr_directive'(discontiguous(Spec), M) :-
  153    '$set_pattr'(Spec, M, directive, (discontiguous)).
  154'$pattr_directive'(volatile(Spec), M) :-
  155    '$set_pattr'(Spec, M, directive, (volatile)).
  156'$pattr_directive'(thread_local(Spec), M) :-
  157    '$set_pattr'(Spec, M, directive, (thread_local)).
  158'$pattr_directive'(noprofile(Spec), M) :-
  159    '$set_pattr'(Spec, M, directive, (noprofile)).
  160'$pattr_directive'(public(Spec), M) :-
  161    '$set_pattr'(Spec, M, directive, (public)).
 $hide(:PI)
Predicates protected this way are never visible in the tracer.
  168'$hide'(Pred) :-
  169    '$set_predicate_attribute'(Pred, trace, false).
  170
  171:- '$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:- user:dynamic((exception/3,
  722                 prolog_event_hook/1)).  723:- user:multifile((exception/3,
  724                   prolog_event_hook/1)).
 $undefined_procedure(+Module, +Name, +Arity, -Action) is det
This predicate is called from C on undefined predicates. First allows the user to take care of it using exception/3. Else try to give a DWIM warning. Otherwise fail. C will print an error message.
  733:- public
  734    '$undefined_procedure'/4.  735
  736'$undefined_procedure'(Module, Name, Arity, Action) :-
  737    '$prefix_module'(Module, user, Name/Arity, Pred),
  738    user:exception(undefined_predicate, Pred, Action0),
  739    !,
  740    Action = Action0.
  741'$undefined_procedure'(Module, Name, Arity, Action) :-
  742    current_prolog_flag(autoload, true),
  743    '$autoload'(Module, Name, Arity),
  744    !,
  745    Action = retry.
  746'$undefined_procedure'(_, _, _, error).
  747
  748'$autoload'(Module, Name, Arity) :-
  749    source_location(File, _Line),
  750    !,
  751    setup_call_cleanup(
  752        '$start_aux'(File, Context),
  753        '$autoload2'(Module, Name, Arity),
  754        '$end_aux'(File, Context)).
  755'$autoload'(Module, Name, Arity) :-
  756    '$autoload2'(Module, Name, Arity).
  757
  758'$autoload2'(Module, Name, Arity) :-
  759    '$find_library'(Module, Name, Arity, LoadModule, Library),
  760    functor(Head, Name, Arity),
  761    '$update_autoload_level'([autoload(true)], Old),
  762    (   current_prolog_flag(verbose_autoload, true)
  763    ->  Level = informational
  764    ;   Level = silent
  765    ),
  766    print_message(Level, autoload(Module:Name/Arity, Library)),
  767    '$compilation_mode'(OldComp, database),
  768    (   Module == LoadModule
  769    ->  ensure_loaded(Module:Library)
  770    ;   (   '$get_predicate_attribute'(LoadModule:Head, defined, 1),
  771            \+ '$loading'(Library)
  772        ->  Module:import(LoadModule:Name/Arity)
  773        ;   use_module(Module:Library, [Name/Arity])
  774        )
  775    ),
  776    '$set_compilation_mode'(OldComp),
  777    '$set_autoload_level'(Old),
  778    '$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.
  789'$loading'(Library) :-
  790    current_prolog_flag(threads, true),
  791    '$loading_file'(FullFile, _Queue, _LoadThread),
  792    file_name_extension(Library, _, FullFile),
  793    !.
  794
  795%        handle debugger 'w', 'p' and <N> depth options.
  796
  797'$set_debugger_write_options'(write) :-
  798    !,
  799    create_prolog_flag(debugger_write_options,
  800                       [ quoted(true),
  801                         attributes(dots),
  802                         spacing(next_argument)
  803                       ], []).
  804'$set_debugger_write_options'(print) :-
  805    !,
  806    create_prolog_flag(debugger_write_options,
  807                       [ quoted(true),
  808                         portray(true),
  809                         max_depth(10),
  810                         attributes(portray),
  811                         spacing(next_argument)
  812                       ], []).
  813'$set_debugger_write_options'(Depth) :-
  814    current_prolog_flag(debugger_write_options, Options0),
  815    (   '$select'(max_depth(_), Options0, Options)
  816    ->  true
  817    ;   Options = Options0
  818    ),
  819    create_prolog_flag(debugger_write_options,
  820                       [max_depth(Depth)|Options], []).
  821
  822
  823                /********************************
  824                *        SYSTEM MESSAGES        *
  825                *********************************/
 $confirm(Spec)
Ask the user to confirm a question. Spec is a term as used for print_message/2.
  832'$confirm'(Spec) :-
  833    print_message(query, Spec),
  834    between(0, 5, _),
  835        get_single_char(Answer),
  836        (   '$in_reply'(Answer, 'yYjJ \n')
  837        ->  !,
  838            print_message(query, if_tty([yes-[]]))
  839        ;   '$in_reply'(Answer, 'nN')
  840        ->  !,
  841            print_message(query, if_tty([no-[]])),
  842            fail
  843        ;   print_message(help, query(confirm)),
  844            fail
  845        ).
  846
  847'$in_reply'(Code, Atom) :-
  848    char_code(Char, Code),
  849    sub_atom(Atom, _, _, _, Char),
  850    !.
  851
  852:- dynamic
  853    user:portray/1.  854:- multifile
  855    user:portray/1.  856
  857
  858                 /*******************************
  859                 *       FILE_SEARCH_PATH       *
  860                 *******************************/
  861
  862:- dynamic user:file_search_path/2.  863:- multifile user:file_search_path/2.  864
  865user:(file_search_path(library, Dir) :-
  866        library_directory(Dir)).
  867user:file_search_path(swi, Home) :-
  868    current_prolog_flag(home, Home).
  869user:file_search_path(foreign, swi(ArchLib)) :-
  870    current_prolog_flag(arch, Arch),
  871    atom_concat('lib/', Arch, ArchLib).
  872user:file_search_path(foreign, swi(SoLib)) :-
  873    (   current_prolog_flag(windows, true)
  874    ->  SoLib = bin
  875    ;   SoLib = lib
  876    ).
  877user:file_search_path(path, Dir) :-
  878    getenv('PATH', Path),
  879    (   current_prolog_flag(windows, true)
  880    ->  atomic_list_concat(Dirs, (;), Path)
  881    ;   atomic_list_concat(Dirs, :, Path)
  882    ),
  883    '$member'(Dir, Dirs),
  884    '$no-null-bytes'(Dir).
  885
  886'$no-null-bytes'(Dir) :-
  887    sub_atom(Dir, _, _, _, '\u0000'),
  888    !,
  889    print_message(warning, null_byte_in_path(Dir)),
  890    fail.
  891'$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?
  899expand_file_search_path(Spec, Expanded) :-
  900    catch('$expand_file_search_path'(Spec, Expanded, 0, []),
  901          loop(Used),
  902          throw(error(loop_error(Spec), file_search(Used)))).
  903
  904'$expand_file_search_path'(Spec, Expanded, N, Used) :-
  905    functor(Spec, Alias, 1),
  906    !,
  907    user:file_search_path(Alias, Exp0),
  908    NN is N + 1,
  909    (   NN > 16
  910    ->  throw(loop(Used))
  911    ;   true
  912    ),
  913    '$expand_file_search_path'(Exp0, Exp1, NN, [Alias=Exp0|Used]),
  914    arg(1, Spec, Segments),
  915    '$segments_to_atom'(Segments, File),
  916    '$make_path'(Exp1, File, Expanded).
  917'$expand_file_search_path'(Spec, Path, _, _) :-
  918    '$segments_to_atom'(Spec, Path).
  919
  920'$make_path'(Dir, '.', Path) :-
  921    !,
  922    Path = Dir.
  923'$make_path'(Dir, File, Path) :-
  924    sub_atom(Dir, _, _, 0, /),
  925    !,
  926    atom_concat(Dir, File, Path).
  927'$make_path'(Dir, File, Path) :-
  928    atomic_list_concat([Dir, /, File], Path).
  929
  930
  931                /********************************
  932                *         FILE CHECKING         *
  933                *********************************/
 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.
  944absolute_file_name(Spec, Options, Path) :-
  945    '$is_options'(Options),
  946    \+ '$is_options'(Path),
  947    !,
  948    absolute_file_name(Spec, Path, Options).
  949absolute_file_name(Spec, Path, Options) :-
  950    '$must_be'(options, Options),
  951                    % get the valid extensions
  952    (   '$select_option'(extensions(Exts), Options, Options1)
  953    ->  '$must_be'(list, Exts)
  954    ;   '$option'(file_type(Type), Options)
  955    ->  '$must_be'(atom, Type),
  956        '$file_type_extensions'(Type, Exts),
  957        Options1 = Options
  958    ;   Options1 = Options,
  959        Exts = ['']
  960    ),
  961    '$canonicalise_extensions'(Exts, Extensions),
  962                    % unless specified otherwise, ask regular file
  963    (   nonvar(Type)
  964    ->  Options2 = Options1
  965    ;   '$merge_options'(_{file_type:regular}, Options1, Options2)
  966    ),
  967                    % Det or nondet?
  968    (   '$select_option'(solutions(Sols), Options2, Options3)
  969    ->  '$must_be'(oneof(atom, solutions, [first,all]), Sols)
  970    ;   Sols = first,
  971        Options3 = Options2
  972    ),
  973                    % Errors or not?
  974    (   '$select_option'(file_errors(FileErrors), Options3, Options4)
  975    ->  '$must_be'(oneof(atom, file_errors, [error,fail]), FileErrors)
  976    ;   FileErrors = error,
  977        Options4 = Options3
  978    ),
  979                    % Expand shell patterns?
  980    (   atomic(Spec),
  981        '$select_option'(expand(Expand), Options4, Options5),
  982        '$must_be'(boolean, Expand)
  983    ->  expand_file_name(Spec, List),
  984        '$member'(Spec1, List)
  985    ;   Spec1 = Spec,
  986        Options5 = Options4
  987    ),
  988                    % Search for files
  989    (   Sols == first
  990    ->  (   '$chk_file'(Spec1, Extensions, Options5, true, Path)
  991        ->  !       % also kill choice point of expand_file_name/2
  992        ;   (   FileErrors == fail
  993            ->  fail
  994            ;   '$current_module'('$bags', _File),
  995                findall(P,
  996                        '$chk_file'(Spec1, Extensions, [access(exist)],
  997                                    false, P),
  998                        Candidates),
  999                '$abs_file_error'(Spec, Candidates, Options5)
 1000            )
 1001        )
 1002    ;   '$chk_file'(Spec1, Extensions, Options5, false, Path)
 1003    ).
 1004
 1005'$abs_file_error'(Spec, Candidates, Conditions) :-
 1006    '$member'(F, Candidates),
 1007    '$member'(C, Conditions),
 1008    '$file_condition'(C),
 1009    '$file_error'(C, Spec, F, E, Comment),
 1010    !,
 1011    throw(error(E, context(_, Comment))).
 1012'$abs_file_error'(Spec, _, _) :-
 1013    '$existence_error'(source_sink, Spec).
 1014
 1015'$file_error'(file_type(directory), Spec, File, Error, Comment) :-
 1016    \+ exists_directory(File),
 1017    !,
 1018    Error = existence_error(directory, Spec),
 1019    Comment = not_a_directory(File).
 1020'$file_error'(file_type(_), Spec, File, Error, Comment) :-
 1021    exists_directory(File),
 1022    !,
 1023    Error = existence_error(file, Spec),
 1024    Comment = directory(File).
 1025'$file_error'(access(OneOrList), Spec, File, Error, _) :-
 1026    '$one_or_member'(Access, OneOrList),
 1027    \+ access_file(File, Access),
 1028    Error = permission_error(Access, source_sink, Spec).
 1029
 1030'$one_or_member'(Elem, List) :-
 1031    is_list(List),
 1032    !,
 1033    '$member'(Elem, List).
 1034'$one_or_member'(Elem, Elem).
 1035
 1036
 1037'$file_type_extensions'(source, Exts) :-       % SICStus 3.9 compatibility
 1038    !,
 1039    '$file_type_extensions'(prolog, Exts).
 1040'$file_type_extensions'(Type, Exts) :-
 1041    '$current_module'('$bags', _File),
 1042    !,
 1043    findall(Ext, user:prolog_file_type(Ext, Type), Exts0),
 1044    (   Exts0 == [],
 1045        \+ '$ft_no_ext'(Type)
 1046    ->  '$domain_error'(file_type, Type)
 1047    ;   true
 1048    ),
 1049    '$append'(Exts0, [''], Exts).
 1050'$file_type_extensions'(prolog, [pl, '']). % findall is not yet defined ...
 1051
 1052'$ft_no_ext'(txt).
 1053'$ft_no_ext'(executable).
 1054'$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.

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

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

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

 2775'$set_dialect'(Dialect, State) :-
 2776    '$compilation_mode'(qlf, database),
 2777    !,
 2778    expects_dialect(Dialect),
 2779    '$compilation_mode'(_, qlf),
 2780    nb_setarg(6, State, Dialect).
 2781'$set_dialect'(Dialect, _) :-
 2782    expects_dialect(Dialect).
 2783
 2784'$qset_dialect'(State) :-
 2785    '$compilation_mode'(qlf),
 2786    arg(6, State, Dialect), Dialect \== (-),
 2787    !,
 2788    '$add_directive_wic'(expects_dialect(Dialect)).
 2789'$qset_dialect'(_).
 2790
 2791
 2792                 /*******************************
 2793                 *           MODULES            *
 2794                 *******************************/
 2795
 2796'$start_module'(Module, _Public, State, _Options) :-
 2797    '$current_module'(Module, OldFile),
 2798    source_location(File, _Line),
 2799    OldFile \== File, OldFile \== [],
 2800    same_file(OldFile, File),
 2801    !,
 2802    nb_setarg(2, State, Module),
 2803    nb_setarg(4, State, true).      % Stop processing
 2804'$start_module'(Module, Public, State, Options) :-
 2805    arg(5, State, File),
 2806    nb_setarg(2, State, Module),
 2807    source_location(_File, Line),
 2808    '$option'(redefine_module(Action), Options, false),
 2809    '$module_class'(File, Class, Super),
 2810    '$redefine_module'(Module, File, Action),
 2811    '$declare_module'(Module, Class, Super, File, Line, false),
 2812    '$export_list'(Public, Module, Ops),
 2813    '$ifcompiling'('$qlf_start_module'(Module)),
 2814    '$export_ops'(Ops, Module, File),
 2815    '$qset_dialect'(State),
 2816    nb_setarg(3, State, end_module).
 $module3(+Spec) is det
Handle the 3th argument of a module declartion.
 2823'$module3'(Var) :-
 2824    var(Var),
 2825    !,
 2826    '$instantiation_error'(Var).
 2827'$module3'([]) :- !.
 2828'$module3'([H|T]) :-
 2829    !,
 2830    '$module3'(H),
 2831    '$module3'(T).
 2832'$module3'(Id) :-
 2833    use_module(library(dialect/Id)).
 $module_name(?Name, +Id, -Module, +Options) is semidet
Determine the module name. There are some cases:
 2847'$module_name'(_, _, Module, Options) :-
 2848    '$option'(module(Module), Options),
 2849    !,
 2850    '$current_source_module'(Context),
 2851    Context \== Module.                     % cause '$first_term'/5 to fail.
 2852'$module_name'(Var, Id, Module, Options) :-
 2853    var(Var),
 2854    !,
 2855    file_base_name(Id, File),
 2856    file_name_extension(Var, _, File),
 2857    '$module_name'(Var, Id, Module, Options).
 2858'$module_name'(Reserved, _, _, _) :-
 2859    '$reserved_module'(Reserved),
 2860    !,
 2861    throw(error(permission_error(load, module, Reserved), _)).
 2862'$module_name'(Module, _Id, Module, _).
 2863
 2864
 2865'$reserved_module'(system).
 2866'$reserved_module'(user).
 $redefine_module(+Module, +File, -Redefine)
 2871'$redefine_module'(_Module, _, false) :- !.
 2872'$redefine_module'(Module, File, true) :-
 2873    !,
 2874    (   module_property(Module, file(OldFile)),
 2875        File \== OldFile
 2876    ->  unload_file(OldFile)
 2877    ;   true
 2878    ).
 2879'$redefine_module'(Module, File, ask) :-
 2880    (   stream_property(user_input, tty(true)),
 2881        module_property(Module, file(OldFile)),
 2882        File \== OldFile,
 2883        '$rdef_response'(Module, OldFile, File, true)
 2884    ->  '$redefine_module'(Module, File, true)
 2885    ;   true
 2886    ).
 2887
 2888'$rdef_response'(Module, OldFile, File, Ok) :-
 2889    repeat,
 2890    print_message(query, redefine_module(Module, OldFile, File)),
 2891    get_single_char(Char),
 2892    '$rdef_response'(Char, Ok0),
 2893    !,
 2894    Ok = Ok0.
 2895
 2896'$rdef_response'(Char, true) :-
 2897    memberchk(Char, `yY`),
 2898    format(user_error, 'yes~n', []).
 2899'$rdef_response'(Char, false) :-
 2900    memberchk(Char, `nN`),
 2901    format(user_error, 'no~n', []).
 2902'$rdef_response'(Char, _) :-
 2903    memberchk(Char, `a`),
 2904    format(user_error, 'abort~n', []),
 2905    abort.
 2906'$rdef_response'(_, _) :-
 2907    print_message(help, redefine_module_reply),
 2908    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.
 2917'$module_class'(File, Class, system) :-
 2918    current_prolog_flag(home, Home),
 2919    sub_atom(File, 0, Len, _, Home),
 2920    !,
 2921    (   sub_atom(File, Len, _, _, '/boot/')
 2922    ->  Class = system
 2923    ;   Class = library
 2924    ).
 2925'$module_class'(_, user, user).
 2926
 2927'$check_export'(Module) :-
 2928    '$undefined_export'(Module, UndefList),
 2929    (   '$member'(Undef, UndefList),
 2930        strip_module(Undef, _, Local),
 2931        print_message(error,
 2932                      undefined_export(Module, Local)),
 2933        fail
 2934    ;   true
 2935    ).
 $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).
 2944'$import_list'(_, _, Var, _) :-
 2945    var(Var),
 2946    !,
 2947    throw(error(instantitation_error, _)).
 2948'$import_list'(Target, Source, all, Reexport) :-
 2949    !,
 2950    '$exported_ops'(Source, Import, Predicates),
 2951    '$module_property'(Source, exports(Predicates)),
 2952    '$import_all'(Import, Target, Source, Reexport, weak).
 2953'$import_list'(Target, Source, except(Spec), Reexport) :-
 2954    !,
 2955    '$exported_ops'(Source, Export, Predicates),
 2956    '$module_property'(Source, exports(Predicates)),
 2957    (   is_list(Spec)
 2958    ->  true
 2959    ;   throw(error(type_error(list, Spec), _))
 2960    ),
 2961    '$import_except'(Spec, Export, Import),
 2962    '$import_all'(Import, Target, Source, Reexport, weak).
 2963'$import_list'(Target, Source, Import, Reexport) :-
 2964    !,
 2965    is_list(Import),
 2966    !,
 2967    '$import_all'(Import, Target, Source, Reexport, strong).
 2968'$import_list'(_, _, Import, _) :-
 2969    throw(error(type_error(import_specifier, Import))).
 2970
 2971
 2972'$import_except'([], List, List).
 2973'$import_except'([H|T], List0, List) :-
 2974    '$import_except_1'(H, List0, List1),
 2975    '$import_except'(T, List1, List).
 2976
 2977'$import_except_1'(Var, _, _) :-
 2978    var(Var),
 2979    !,
 2980    throw(error(instantitation_error, _)).
 2981'$import_except_1'(PI as N, List0, List) :-
 2982    '$pi'(PI), atom(N),
 2983    !,
 2984    '$canonical_pi'(PI, CPI),
 2985    '$import_as'(CPI, N, List0, List).
 2986'$import_except_1'(op(P,A,N), List0, List) :-
 2987    !,
 2988    '$remove_ops'(List0, op(P,A,N), List).
 2989'$import_except_1'(PI, List0, List) :-
 2990    '$pi'(PI),
 2991    !,
 2992    '$canonical_pi'(PI, CPI),
 2993    '$select'(P, List0, List),
 2994    '$canonical_pi'(CPI, P),
 2995    !.
 2996'$import_except_1'(Except, _, _) :-
 2997    throw(error(type_error(import_specifier, Except), _)).
 2998
 2999'$import_as'(CPI, N, [PI2|T], [CPI as N|T]) :-
 3000    '$canonical_pi'(PI2, CPI),
 3001    !.
 3002'$import_as'(PI, N, [H|T0], [H|T]) :-
 3003    !,
 3004    '$import_as'(PI, N, T0, T).
 3005'$import_as'(PI, _, _, _) :-
 3006    throw(error(existence_error(export, PI), _)).
 3007
 3008'$pi'(N/A) :- atom(N), integer(A), !.
 3009'$pi'(N//A) :- atom(N), integer(A).
 3010
 3011'$canonical_pi'(N//A0, N/A) :-
 3012    A is A0 + 2.
 3013'$canonical_pi'(PI, PI).
 3014
 3015'$remove_ops'([], _, []).
 3016'$remove_ops'([Op|T0], Pattern, T) :-
 3017    subsumes_term(Pattern, Op),
 3018    !,
 3019    '$remove_ops'(T0, Pattern, T).
 3020'$remove_ops'([H|T0], Pattern, [H|T]) :-
 3021    '$remove_ops'(T0, Pattern, T).
 $import_all(+Import, +Context, +Source, +Reexport, +Strength)
 3026'$import_all'(Import, Context, Source, Reexport, Strength) :-
 3027    '$import_all2'(Import, Context, Source, Imported, ImpOps, Strength),
 3028    (   Reexport == true,
 3029        (   '$list_to_conj'(Imported, Conj)
 3030        ->  export(Context:Conj),
 3031            '$ifcompiling'('$add_directive_wic'(export(Context:Conj)))
 3032        ;   true
 3033        ),
 3034        source_location(File, _Line),
 3035        '$export_ops'(ImpOps, Context, File)
 3036    ;   true
 3037    ).
 $import_all2(+Imports, +Context, +Source, -Imported, -ImpOps, +Strength)
 3041'$import_all2'([], _, _, [], [], _).
 3042'$import_all2'([PI as NewName|Rest], Context, Source,
 3043               [NewName/Arity|Imported], ImpOps, Strength) :-
 3044    !,
 3045    '$canonical_pi'(PI, Name/Arity),
 3046    length(Args, Arity),
 3047    Head =.. [Name|Args],
 3048    NewHead =.. [NewName|Args],
 3049    (   '$get_predicate_attribute'(Source:Head, transparent, 1)
 3050    ->  '$set_predicate_attribute'(Context:NewHead, transparent, true)
 3051    ;   true
 3052    ),
 3053    (   source_location(File, Line)
 3054    ->  E = error(_,_),
 3055        catch('$store_admin_clause'((NewHead :- Source:Head),
 3056                                    _Layout, File, File:Line),
 3057              E, '$print_message'(error, E))
 3058    ;   assertz((NewHead :- !, Source:Head)) % ! avoids problems with
 3059    ),                                       % duplicate load
 3060    '$import_all2'(Rest, Context, Source, Imported, ImpOps, Strength).
 3061'$import_all2'([op(P,A,N)|Rest], Context, Source, Imported,
 3062               [op(P,A,N)|ImpOps], Strength) :-
 3063    !,
 3064    '$import_ops'(Context, Source, op(P,A,N)),
 3065    '$import_all2'(Rest, Context, Source, Imported, ImpOps, Strength).
 3066'$import_all2'([Pred|Rest], Context, Source, [Pred|Imported], ImpOps, Strength) :-
 3067    Error = error(_,_),
 3068    catch(Context:'$import'(Source:Pred, Strength), Error,
 3069          print_message(error, Error)),
 3070    '$ifcompiling'('$import_wic'(Source, Pred, Strength)),
 3071    '$import_all2'(Rest, Context, Source, Imported, ImpOps, Strength).
 3072
 3073
 3074'$list_to_conj'([One], One) :- !.
 3075'$list_to_conj'([H|T], (H,Rest)) :-
 3076    '$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.
 3083'$exported_ops'(Module, Ops, Tail) :-
 3084    '$c_current_predicate'(_, Module:'$exported_op'(_,_,_)),
 3085    !,
 3086    findall(op(P,A,N), Module:'$exported_op'(P,A,N), Ops, Tail).
 3087'$exported_ops'(_, Ops, Ops).
 3088
 3089'$exported_op'(Module, P, A, N) :-
 3090    '$c_current_predicate'(_, Module:'$exported_op'(_,_,_)),
 3091    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.
 3098'$import_ops'(To, From, Pattern) :-
 3099    ground(Pattern),
 3100    !,
 3101    Pattern = op(P,A,N),
 3102    op(P,A,To:N),
 3103    (   '$exported_op'(From, P, A, N)
 3104    ->  true
 3105    ;   print_message(warning, no_exported_op(From, Pattern))
 3106    ).
 3107'$import_ops'(To, From, Pattern) :-
 3108    (   '$exported_op'(From, Pri, Assoc, Name),
 3109        Pattern = op(Pri, Assoc, Name),
 3110        op(Pri, Assoc, To:Name),
 3111        fail
 3112    ;   true
 3113    ).
 $export_list(+Declarations, +Module, -Ops)
Handle the export list of the module declaration for Module associated to File.
 3121'$export_list'(Decls, Module, Ops) :-
 3122    is_list(Decls),
 3123    !,
 3124    '$do_export_list'(Decls, Module, Ops).
 3125'$export_list'(Decls, _, _) :-
 3126    var(Decls),
 3127    throw(error(instantiation_error, _)).
 3128'$export_list'(Decls, _, _) :-
 3129    throw(error(type_error(list, Decls), _)).
 3130
 3131'$do_export_list'([], _, []) :- !.
 3132'$do_export_list'([H|T], Module, Ops) :-
 3133    !,
 3134    E = error(_,_),
 3135    catch('$export1'(H, Module, Ops, Ops1),
 3136          E, ('$print_message'(error, E), Ops = Ops1)),
 3137    '$do_export_list'(T, Module, Ops1).
 3138
 3139'$export1'(Var, _, _, _) :-
 3140    var(Var),
 3141    !,
 3142    throw(error(instantiation_error, _)).
 3143'$export1'(Op, _, [Op|T], T) :-
 3144    Op = op(_,_,_),
 3145    !.
 3146'$export1'(PI0, Module, Ops, Ops) :-
 3147    strip_module(Module:PI0, M, PI),
 3148    (   PI = (_//_)
 3149    ->  non_terminal(M:PI)
 3150    ;   true
 3151    ),
 3152    export(M:PI).
 3153
 3154'$export_ops'([op(Pri, Assoc, Name)|T], Module, File) :-
 3155    E = error(_,_),
 3156    catch(( '$execute_directive'(op(Pri, Assoc, Module:Name), File),
 3157            '$export_op'(Pri, Assoc, Name, Module, File)
 3158          ),
 3159          E, '$print_message'(error, E)),
 3160    '$export_ops'(T, Module, File).
 3161'$export_ops'([], _, _).
 3162
 3163'$export_op'(Pri, Assoc, Name, Module, File) :-
 3164    (   '$get_predicate_attribute'(Module:'$exported_op'(_,_,_), defined, 1)
 3165    ->  true
 3166    ;   '$execute_directive'(discontiguous(Module:'$exported_op'/3), File)
 3167    ),
 3168    '$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.
 3174'$execute_directive'(Goal, F) :-
 3175    '$execute_directive_2'(Goal, F).
 3176
 3177'$execute_directive_2'(encoding(Encoding), _F) :-
 3178    !,
 3179    (   '$load_input'(_F, S)
 3180    ->  set_stream(S, encoding(Encoding))
 3181    ).
 3182'$execute_directive_2'(ISO, F) :-
 3183    '$expand_directive'(ISO, Normal),
 3184    !,
 3185    '$execute_directive'(Normal, F).
 3186'$execute_directive_2'(Goal, _) :-
 3187    \+ '$compilation_mode'(database),
 3188    !,
 3189    '$add_directive_wic2'(Goal, Type),
 3190    (   Type == call                % suspend compiling into .qlf file
 3191    ->  '$compilation_mode'(Old, database),
 3192        setup_call_cleanup(
 3193            '$directive_mode'(OldDir, Old),
 3194            '$execute_directive_3'(Goal),
 3195            ( '$set_compilation_mode'(Old),
 3196              '$set_directive_mode'(OldDir)
 3197            ))
 3198    ;   '$execute_directive_3'(Goal)
 3199    ).
 3200'$execute_directive_2'(Goal, _) :-
 3201    '$execute_directive_3'(Goal).
 3202
 3203'$execute_directive_3'(Goal) :-
 3204    '$current_source_module'(Module),
 3205    '$valid_directive'(Module:Goal),
 3206    !,
 3207    (   '$pattr_directive'(Goal, Module)
 3208    ->  true
 3209    ;   Term = error(_,_),
 3210        catch(Module:Goal, Term, '$exception_in_directive'(Term))
 3211    ->  true
 3212    ;   '$print_message'(warning, goal_failed(directive, Module:Goal)),
 3213        fail
 3214    ).
 3215'$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.
 3224:- multifile prolog:sandbox_allowed_directive/1. 3225:- multifile prolog:sandbox_allowed_clause/1. 3226:- meta_predicate '$valid_directive'(:). 3227
 3228'$valid_directive'(_) :-
 3229    current_prolog_flag(sandboxed_load, false),
 3230    !.
 3231'$valid_directive'(Goal) :-
 3232    Error = error(Formal, _),
 3233    catch(prolog:sandbox_allowed_directive(Goal), Error, true),
 3234    !,
 3235    (   var(Formal)
 3236    ->  true
 3237    ;   print_message(error, Error),
 3238        fail
 3239    ).
 3240'$valid_directive'(Goal) :-
 3241    print_message(error,
 3242                  error(permission_error(execute,
 3243                                         sandboxed_directive,
 3244                                         Goal), _)),
 3245    fail.
 3246
 3247'$exception_in_directive'(Term) :-
 3248    '$print_message'(error, Term),
 3249    fail.
 3250
 3251%       This predicate deals with the very odd ISO requirement to allow
 3252%       for :- dynamic(a/2, b/3, c/4) instead of the normally used
 3253%       :- dynamic a/2, b/3, c/4 or, if operators are not desirable,
 3254%       :- dynamic((a/2, b/3, c/4)).
 3255
 3256'$expand_directive'(Directive, Expanded) :-
 3257    functor(Directive, Name, Arity),
 3258    Arity > 1,
 3259    '$iso_property_directive'(Name),
 3260    Directive =.. [Name|Args],
 3261    '$mk_normal_args'(Args, Normal),
 3262    Expanded =.. [Name, Normal].
 3263
 3264'$iso_property_directive'(dynamic).
 3265'$iso_property_directive'(multifile).
 3266'$iso_property_directive'(discontiguous).
 3267
 3268'$mk_normal_args'([One], One).
 3269'$mk_normal_args'([H|T0], (H,T)) :-
 3270    '$mk_normal_args'(T0, T).
 3271
 3272
 3273%       Note that the list, consult and ensure_loaded directives are already
 3274%       handled at compile time and therefore should not go into the
 3275%       intermediate code file.
 3276
 3277'$add_directive_wic2'(Goal, Type) :-
 3278    '$common_goal_type'(Goal, Type),
 3279    !,
 3280    (   Type == load
 3281    ->  true
 3282    ;   '$current_source_module'(Module),
 3283        '$add_directive_wic'(Module:Goal)
 3284    ).
 3285'$add_directive_wic2'(Goal, _) :-
 3286    (   '$compilation_mode'(qlf)    % no problem for qlf files
 3287    ->  true
 3288    ;   print_message(error, mixed_directive(Goal))
 3289    ).
 3290
 3291'$common_goal_type'((A,B), Type) :-
 3292    !,
 3293    '$common_goal_type'(A, Type),
 3294    '$common_goal_type'(B, Type).
 3295'$common_goal_type'((A;B), Type) :-
 3296    !,
 3297    '$common_goal_type'(A, Type),
 3298    '$common_goal_type'(B, Type).
 3299'$common_goal_type'((A->B), Type) :-
 3300    !,
 3301    '$common_goal_type'(A, Type),
 3302    '$common_goal_type'(B, Type).
 3303'$common_goal_type'(Goal, Type) :-
 3304    '$goal_type'(Goal, Type).
 3305
 3306'$goal_type'(Goal, Type) :-
 3307    (   '$load_goal'(Goal)
 3308    ->  Type = load
 3309    ;   Type = call
 3310    ).
 3311
 3312'$load_goal'([_|_]).
 3313'$load_goal'(consult(_)).
 3314'$load_goal'(load_files(_)).
 3315'$load_goal'(load_files(_,Options)) :-
 3316    memberchk(qcompile(QlfMode), Options),
 3317    '$qlf_part_mode'(QlfMode).
 3318'$load_goal'(ensure_loaded(_)) :- '$compilation_mode'(wic).
 3319'$load_goal'(use_module(_))    :- '$compilation_mode'(wic).
 3320'$load_goal'(use_module(_, _)) :- '$compilation_mode'(wic).
 3321
 3322'$qlf_part_mode'(part).
 3323'$qlf_part_mode'(true).                 % compatibility
 3324
 3325
 3326                /********************************
 3327                *        COMPILE A CLAUSE       *
 3328                *********************************/
 $store_admin_clause(+Clause, ?Layout, +Owner, +SrcLoc) is det
Store a clause into the database for administrative purposes. This bypasses sanity checking.
 3335'$store_admin_clause'(Clause, Layout, Owner, SrcLoc) :-
 3336    Owner \== (-),
 3337    !,
 3338    setup_call_cleanup(
 3339        '$start_aux'(Owner, Context),
 3340        '$store_admin_clause2'(Clause, Layout, Owner, SrcLoc),
 3341        '$end_aux'(Owner, Context)).
 3342'$store_admin_clause'(Clause, Layout, File, SrcLoc) :-
 3343    '$store_admin_clause2'(Clause, Layout, File, SrcLoc).
 3344
 3345'$store_admin_clause2'(Clause, _Layout, File, SrcLoc) :-
 3346    (   '$compilation_mode'(database)
 3347    ->  '$record_clause'(Clause, File, SrcLoc)
 3348    ;   '$record_clause'(Clause, File, SrcLoc, Ref),
 3349        '$qlf_assert_clause'(Ref, development)
 3350    ).
 $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.
 3360'$store_clause'((_, _), _, _, _) :-
 3361    !,
 3362    print_message(error, cannot_redefine_comma),
 3363    fail.
 3364'$store_clause'(Clause, _Layout, File, SrcLoc) :-
 3365    '$valid_clause'(Clause),
 3366    !,
 3367    (   '$compilation_mode'(database)
 3368    ->  '$record_clause'(Clause, File, SrcLoc)
 3369    ;   '$record_clause'(Clause, File, SrcLoc, Ref),
 3370        '$qlf_assert_clause'(Ref, development)
 3371    ).
 3372
 3373'$valid_clause'(_) :-
 3374    current_prolog_flag(sandboxed_load, false),
 3375    !.
 3376'$valid_clause'(Clause) :-
 3377    \+ '$cross_module_clause'(Clause),
 3378    !.
 3379'$valid_clause'(Clause) :-
 3380    Error = error(Formal, _),
 3381    catch(prolog:sandbox_allowed_clause(Clause), Error, true),
 3382    !,
 3383    (   var(Formal)
 3384    ->  true
 3385    ;   print_message(error, Error),
 3386        fail
 3387    ).
 3388'$valid_clause'(Clause) :-
 3389    print_message(error,
 3390                  error(permission_error(assert,
 3391                                         sandboxed_clause,
 3392                                         Clause), _)),
 3393    fail.
 3394
 3395'$cross_module_clause'(Clause) :-
 3396    '$head_module'(Clause, Module),
 3397    \+ '$current_source_module'(Module).
 3398
 3399'$head_module'(Var, _) :-
 3400    var(Var), !, fail.
 3401'$head_module'((Head :- _), Module) :-
 3402    '$head_module'(Head, Module).
 3403'$head_module'(Module:_, Module).
 3404
 3405'$clause_source'('$source_location'(File,Line):Clause, Clause, File:Line) :- !.
 3406'$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.
 3413:- public
 3414    '$store_clause'/2. 3415
 3416'$store_clause'(Term, Id) :-
 3417    '$clause_source'(Term, Clause, SrcLoc),
 3418    '$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?
 3439compile_aux_clauses(_Clauses) :-
 3440    current_prolog_flag(xref, true),
 3441    !.
 3442compile_aux_clauses(Clauses) :-
 3443    source_location(File, _Line),
 3444    '$compile_aux_clauses'(Clauses, File).
 3445
 3446'$compile_aux_clauses'(Clauses, File) :-
 3447    setup_call_cleanup(
 3448        '$start_aux'(File, Context),
 3449        '$store_aux_clauses'(Clauses, File),
 3450        '$end_aux'(File, Context)).
 3451
 3452'$store_aux_clauses'(Clauses, File) :-
 3453    is_list(Clauses),
 3454    !,
 3455    forall('$member'(C,Clauses),
 3456           '$compile_term'(C, _Layout, File)).
 3457'$store_aux_clauses'(Clause, File) :-
 3458    '$compile_term'(Clause, _Layout, File).
 3459
 3460
 3461		 /*******************************
 3462		 *            STAGING		*
 3463		 *******************************/
 $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.
 3473'$stage_file'(Target, Stage) :-
 3474    file_directory_name(Target, Dir),
 3475    file_base_name(Target, File),
 3476    current_prolog_flag(pid, Pid),
 3477    format(atom(Stage), '~w/.~w.~d', [Dir,File,Pid]).
 3478
 3479'$install_staged_file'(exit, Staged, Target, error) :-
 3480    !,
 3481    rename_file(Staged, Target).
 3482'$install_staged_file'(exit, Staged, Target, OnError) :-
 3483    !,
 3484    InstallError = error(_,_),
 3485    catch(rename_file(Staged, Target),
 3486          InstallError,
 3487          '$install_staged_error'(OnError, InstallError, Staged, Target)).
 3488'$install_staged_file'(_, Staged, _, _OnError) :-
 3489    E = error(_,_),
 3490    catch(delete_file(Staged), E, true).
 3491
 3492'$install_staged_error'(OnError, Error, Staged, _Target) :-
 3493    E = error(_,_),
 3494    catch(delete_file(Staged), E, true),
 3495    (   OnError = silent
 3496    ->  true
 3497    ;   OnError = fail
 3498    ->  fail
 3499    ;   print_message(warning, Error)
 3500    ).
 3501
 3502
 3503                 /*******************************
 3504                 *             READING          *
 3505                 *******************************/
 3506
 3507:- multifile
 3508    prolog:comment_hook/3.                  % hook for read_clause/3
 3509
 3510
 3511                 /*******************************
 3512                 *       FOREIGN INTERFACE      *
 3513                 *******************************/
 3514
 3515%       call-back from PL_register_foreign().  First argument is the module
 3516%       into which the foreign predicate is loaded and second is a term
 3517%       describing the arguments.
 3518
 3519:- dynamic
 3520    '$foreign_registered'/2. 3521
 3522                 /*******************************
 3523                 *   TEMPORARY TERM EXPANSION   *
 3524                 *******************************/
 3525
 3526% Provide temporary definitions for the boot-loader.  These are replaced
 3527% by the real thing in load.pl
 3528
 3529:- dynamic
 3530    '$expand_goal'/2,
 3531    '$expand_term'/4. 3532
 3533'$expand_goal'(In, In).
 3534'$expand_term'(In, Layout, In, Layout).
 3535
 3536
 3537                 /*******************************
 3538                 *         TYPE SUPPORT         *
 3539                 *******************************/
 3540
 3541'$type_error'(Type, Value) :-
 3542    (   var(Value)
 3543    ->  throw(error(instantiation_error, _))
 3544    ;   throw(error(type_error(Type, Value), _))
 3545    ).
 3546
 3547'$domain_error'(Type, Value) :-
 3548    throw(error(domain_error(Type, Value), _)).
 3549
 3550'$existence_error'(Type, Object) :-
 3551    throw(error(existence_error(Type, Object), _)).
 3552
 3553'$permission_error'(Action, Type, Term) :-
 3554    throw(error(permission_error(Action, Type, Term), _)).
 3555
 3556'$instantiation_error'(_Var) :-
 3557    throw(error(instantiation_error, _)).
 3558
 3559'$uninstantiation_error'(NonVar) :-
 3560    throw(error(uninstantiation_error(NonVar), _)).
 3561
 3562'$must_be'(list, X) :- !,
 3563    '$skip_list'(_, X, Tail),
 3564    (   Tail == []
 3565    ->  true
 3566    ;   '$type_error'(list, Tail)
 3567    ).
 3568'$must_be'(options, X) :- !,
 3569    (   '$is_options'(X)
 3570    ->  true
 3571    ;   '$type_error'(options, X)
 3572    ).
 3573'$must_be'(atom, X) :- !,
 3574    (   atom(X)
 3575    ->  true
 3576    ;   '$type_error'(atom, X)
 3577    ).
 3578'$must_be'(integer, X) :- !,
 3579    (   integer(X)
 3580    ->  true
 3581    ;   '$type_error'(integer, X)
 3582    ).
 3583'$must_be'(callable, X) :- !,
 3584    (   callable(X)
 3585    ->  true
 3586    ;   '$type_error'(callable, X)
 3587    ).
 3588'$must_be'(oneof(Type, Domain, List), X) :- !,
 3589    '$must_be'(Type, X),
 3590    (   memberchk(X, List)
 3591    ->  true
 3592    ;   '$domain_error'(Domain, X)
 3593    ).
 3594'$must_be'(boolean, X) :- !,
 3595    (   (X == true ; X == false)
 3596    ->  true
 3597    ;   '$type_error'(boolean, X)
 3598    ).
 3599% Use for debugging
 3600%'$must_be'(Type, _X) :- format('Unknown $must_be type: ~q~n', [Type]).
 3601
 3602
 3603                /********************************
 3604                *       LIST PROCESSING         *
 3605                *********************************/
 3606
 3607'$member'(El, [H|T]) :-
 3608    '$member_'(T, El, H).
 3609
 3610'$member_'(_, El, El).
 3611'$member_'([H|T], El, _) :-
 3612    '$member_'(T, El, H).
 3613
 3614
 3615'$append'([], L, L).
 3616'$append'([H|T], L, [H|R]) :-
 3617    '$append'(T, L, R).
 3618
 3619'$select'(X, [X|Tail], Tail).
 3620'$select'(Elem, [Head|Tail], [Head|Rest]) :-
 3621    '$select'(Elem, Tail, Rest).
 3622
 3623'$reverse'(L1, L2) :-
 3624    '$reverse'(L1, [], L2).
 3625
 3626'$reverse'([], List, List).
 3627'$reverse'([Head|List1], List2, List3) :-
 3628    '$reverse'(List1, [Head|List2], List3).
 3629
 3630'$delete'([], _, []) :- !.
 3631'$delete'([Elem|Tail], Elem, Result) :-
 3632    !,
 3633    '$delete'(Tail, Elem, Result).
 3634'$delete'([Head|Tail], Elem, [Head|Rest]) :-
 3635    '$delete'(Tail, Elem, Rest).
 3636
 3637'$last'([H|T], Last) :-
 3638    '$last'(T, H, Last).
 3639
 3640'$last'([], Last, Last).
 3641'$last'([H|T], _, Last) :-
 3642    '$last'(T, H, Last).
 length(?List, ?N)
Is true when N is the length of List.
 3649:- '$iso'((length/2)). 3650
 3651length(List, Length) :-
 3652    var(Length),
 3653    !,
 3654    '$skip_list'(Length0, List, Tail),
 3655    (   Tail == []
 3656    ->  Length = Length0                    % +,-
 3657    ;   var(Tail)
 3658    ->  Tail \== Length,                    % avoid length(L,L)
 3659        '$length3'(Tail, Length, Length0)   % -,-
 3660    ;   throw(error(type_error(list, List),
 3661                    context(length/2, _)))
 3662    ).
 3663length(List, Length) :-
 3664    integer(Length),
 3665    Length >= 0,
 3666    !,
 3667    '$skip_list'(Length0, List, Tail),
 3668    (   Tail == []                          % proper list
 3669    ->  Length = Length0
 3670    ;   var(Tail)
 3671    ->  Extra is Length-Length0,
 3672        '$length'(Tail, Extra)
 3673    ;   throw(error(type_error(list, List),
 3674                    context(length/2, _)))
 3675    ).
 3676length(_, Length) :-
 3677    integer(Length),
 3678    !,
 3679    throw(error(domain_error(not_less_than_zero, Length),
 3680                context(length/2, _))).
 3681length(_, Length) :-
 3682    throw(error(type_error(integer, Length),
 3683                context(length/2, _))).
 3684
 3685'$length3'([], N, N).
 3686'$length3'([_|List], N, N0) :-
 3687    N1 is N0+1,
 3688    '$length3'(List, N, N1).
 3689
 3690
 3691                 /*******************************
 3692                 *       OPTION PROCESSING      *
 3693                 *******************************/
 $is_options(@Term) is semidet
True if Term looks like it provides options.
 3699'$is_options'(Map) :-
 3700    is_dict(Map, _),
 3701    !.
 3702'$is_options'(List) :-
 3703    is_list(List),
 3704    (   List == []
 3705    ->  true
 3706    ;   List = [H|_],
 3707        '$is_option'(H, _, _)
 3708    ).
 3709
 3710'$is_option'(Var, _, _) :-
 3711    var(Var), !, fail.
 3712'$is_option'(F, Name, Value) :-
 3713    functor(F, _, 1),
 3714    !,
 3715    F =.. [Name,Value].
 3716'$is_option'(Name=Value, Name, Value).
 $option(?Opt, +Options) is semidet
 3720'$option'(Opt, Options) :-
 3721    is_dict(Options),
 3722    !,
 3723    [Opt] :< Options.
 3724'$option'(Opt, Options) :-
 3725    memberchk(Opt, Options).
 $option(?Opt, +Options, +Default) is det
 3729'$option'(Term, Options, Default) :-
 3730    arg(1, Term, Value),
 3731    functor(Term, Name, 1),
 3732    (   is_dict(Options)
 3733    ->  (   get_dict(Name, Options, GVal)
 3734        ->  Value = GVal
 3735        ;   Value = Default
 3736        )
 3737    ;   functor(Gen, Name, 1),
 3738        arg(1, Gen, GVal),
 3739        (   memberchk(Gen, Options)
 3740        ->  Value = GVal
 3741        ;   Value = Default
 3742        )
 3743    ).
 $select_option(?Opt, +Options, -Rest) is semidet
Select an option from Options.
Arguments:
Rest- is always a map.
 3751'$select_option'(Opt, Options, Rest) :-
 3752    select_dict([Opt], Options, Rest).
 $merge_options(+New, +Default, -Merged) is det
Add/replace options specified in New.
Arguments:
Merged- is always a map.
 3760'$merge_options'(New, Old, Merged) :-
 3761    put_dict(New, Old, Merged).
 3762
 3763
 3764                 /*******************************
 3765                 *   HANDLE TRACER 'L'-COMMAND  *
 3766                 *******************************/
 3767
 3768:- public '$prolog_list_goal'/1. 3769
 3770:- multifile
 3771    user:prolog_list_goal/1. 3772
 3773'$prolog_list_goal'(Goal) :-
 3774    user:prolog_list_goal(Goal),
 3775    !.
 3776'$prolog_list_goal'(Goal) :-
 3777    user:listing(Goal).
 3778
 3779
 3780                 /*******************************
 3781                 *             HALT             *
 3782                 *******************************/
 3783
 3784:- '$iso'((halt/0)). 3785
 3786halt :-
 3787    halt(0).
 at_halt(:Goal)
Register Goal to be called if the system halts.
To be done
- : get location into the error message
 3796:- meta_predicate at_halt(0). 3797:- dynamic        system:term_expansion/2, '$at_halt'/2. 3798:- multifile      system:term_expansion/2, '$at_halt'/2. 3799
 3800system:term_expansion((:- at_halt(Goal)),
 3801                      system:'$at_halt'(Module:Goal, File:Line)) :-
 3802    \+ current_prolog_flag(xref, true),
 3803    source_location(File, Line),
 3804    '$current_source_module'(Module).
 3805
 3806at_halt(Goal) :-
 3807    asserta('$at_halt'(Goal, (-):0)).
 3808
 3809:- public '$run_at_halt'/0. 3810
 3811'$run_at_halt' :-
 3812    forall(clause('$at_halt'(Goal, Src), true, Ref),
 3813           ( '$call_at_halt'(Goal, Src),
 3814             erase(Ref)
 3815           )).
 3816
 3817'$call_at_halt'(Goal, _Src) :-
 3818    catch(Goal, E, true),
 3819    !,
 3820    (   var(E)
 3821    ->  true
 3822    ;   subsumes_term(cancel_halt(_), E)
 3823    ->  '$print_message'(informational, E),
 3824        fail
 3825    ;   '$print_message'(error, E)
 3826    ).
 3827'$call_at_halt'(Goal, _Src) :-
 3828    '$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.
 3836cancel_halt(Reason) :-
 3837    throw(cancel_halt(Reason)).
 3838
 3839
 3840                /********************************
 3841                *      LOAD OTHER MODULES       *
 3842                *********************************/
 3843
 3844:- meta_predicate
 3845    '$load_wic_files'(:). 3846
 3847'$load_wic_files'(Files) :-
 3848    Files = Module:_,
 3849    '$execute_directive'('$set_source_module'(OldM, Module), []),
 3850    '$save_lex_state'(LexState, []),
 3851    '$style_check'(_, 0xC7),                % see style_name/2 in syspred.pl
 3852    '$compilation_mode'(OldC, wic),
 3853    consult(Files),
 3854    '$execute_directive'('$set_source_module'(OldM), []),
 3855    '$execute_directive'('$restore_lex_state'(LexState), []),
 3856    '$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.
 3864:- public '$load_additional_boot_files'/0. 3865
 3866'$load_additional_boot_files' :-
 3867    current_prolog_flag(argv, Argv),
 3868    '$get_files_argv'(Argv, Files),
 3869    (   Files \== []
 3870    ->  format('Loading additional boot files~n'),
 3871        '$load_wic_files'(user:Files),
 3872        format('additional boot files loaded~n')
 3873    ;   true
 3874    ).
 3875
 3876'$get_files_argv'([], []) :- !.
 3877'$get_files_argv'(['-c'|Files], Files) :- !.
 3878'$get_files_argv'([_|Rest], Files) :-
 3879    '$get_files_argv'(Rest, Files).
 3880
 3881'$:-'(('$boot_message'('Loading Prolog startup files~n', []),
 3882       source_location(File, _Line),
 3883       file_directory_name(File, Dir),
 3884       atom_concat(Dir, '/load.pl', LoadFile),
 3885       '$load_wic_files'(system:[LoadFile]),
 3886       (   current_prolog_flag(windows, true)
 3887       ->  atom_concat(Dir, '/menu.pl', MenuFile),
 3888           '$load_wic_files'(system:[MenuFile])
 3889       ;   true
 3890       ),
 3891       '$boot_message'('SWI-Prolog boot files loaded~n', []),
 3892       '$compilation_mode'(OldC, wic),
 3893       '$execute_directive'('$set_source_module'(user), []),
 3894       '$set_compilation_mode'(OldC)
 3895      ))