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-2020, University of Amsterdam
    7                              VU University Amsterdam
    8                              CWI, Amsterdam
    9    All rights reserved.
   10
   11    Redistribution and use in source and binary forms, with or without
   12    modification, are permitted provided that the following conditions
   13    are met:
   14
   15    1. Redistributions of source code must retain the above copyright
   16       notice, this list of conditions and the following disclaimer.
   17
   18    2. Redistributions in binary form must reproduce the above copyright
   19       notice, this list of conditions and the following disclaimer in
   20       the documentation and/or other materials provided with the
   21       distribution.
   22
   23    THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
   24    "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
   25    LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS
   26    FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE
   27    COPYRIGHT OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT,
   28    INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING,
   29    BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES;
   30    LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER
   31    CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
   32    LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN
   33    ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
   34    POSSIBILITY OF SUCH DAMAGE.
   35*/
   36
   37/*
   38Consult, derivates and basic things.   This  module  is  loaded  by  the
   39C-written  bootstrap  compiler.
   40
   41The $:- directive  is  executed  by  the  bootstrap  compiler,  but  not
   42inserted  in  the  intermediate  code  file.   Used  to print diagnostic
   43messages and start the Prolog defined compiler for  the  remaining  boot
   44modules.
   45
   46If you want  to  debug  this  module,  put  a  '$:-'(trace).   directive
   47somewhere.   The  tracer will work properly under boot compilation as it
   48will use the C defined write predicate  to  print  goals  and  does  not
   49attempt to call the Prolog defined trace interceptor.
   50*/
   51
   52                /********************************
   53                *    LOAD INTO MODULE SYSTEM    *
   54                ********************************/
   55
   56:- '$set_source_module'(system).   57
   58'$boot_message'(_Format, _Args) :-
   59    current_prolog_flag(verbose, silent),
   60    !.
   61'$boot_message'(Format, Args) :-
   62    format(Format, Args),
   63    !.
   64
   65'$:-'('$boot_message'('Loading boot file ...~n', [])).
   66
   67
   68                /********************************
   69                *          DIRECTIVES           *
   70                *********************************/
   71
   72:- meta_predicate
   73    dynamic(:),
   74    multifile(:),
   75    public(:),
   76    module_transparent(:),
   77    discontiguous(:),
   78    volatile(:),
   79    thread_local(:),
   80    noprofile(:),
   81    non_terminal(:),
   82    '$clausable'(:),
   83    '$iso'(:),
   84    '$hide'(:).
 dynamic +Spec is det
 multifile +Spec is det
 module_transparent +Spec is det
 discontiguous +Spec is det
 volatile +Spec is det
 thread_local +Spec is det
 noprofile(+Spec) is det
 public +Spec is det
 non_terminal(+Spec) is det
Predicate versions of standard directives that set predicate attributes. These predicates bail out with an error on the first failure (typically permission errors).
 $iso(+Spec) is det
Set the ISO flag. This defines that the predicate cannot be redefined inside a module.
 $clausable(+Spec) is det
Specify that we can run clause/2 on a predicate, even if it is static. ISO specifies that public also plays this role. in SWI, public means that the predicate can be called, even if we cannot find a reference to it.
 $hide(+Spec) is det
Specify that the predicate cannot be seen in the debugger.
  116dynamic(Spec)            :- '$set_pattr'(Spec, pred, dynamic(true)).
  117multifile(Spec)          :- '$set_pattr'(Spec, pred, multifile(true)).
  118module_transparent(Spec) :- '$set_pattr'(Spec, pred, transparent(true)).
  119discontiguous(Spec)      :- '$set_pattr'(Spec, pred, discontiguous(true)).
  120volatile(Spec)           :- '$set_pattr'(Spec, pred, volatile(true)).
  121thread_local(Spec)       :- '$set_pattr'(Spec, pred, thread_local(true)).
  122noprofile(Spec)          :- '$set_pattr'(Spec, pred, noprofile(true)).
  123public(Spec)             :- '$set_pattr'(Spec, pred, public(true)).
  124non_terminal(Spec)       :- '$set_pattr'(Spec, pred, non_terminal(true)).
  125'$iso'(Spec)             :- '$set_pattr'(Spec, pred, iso(true)).
  126'$clausable'(Spec)       :- '$set_pattr'(Spec, pred, clausable(true)).
  127'$hide'(Spec)            :- '$set_pattr'(Spec, pred, trace(false)).
  128
  129'$set_pattr'(M:Pred, How, Attr) :-
  130    '$set_pattr'(Pred, M, How, Attr).
 $set_pattr(+Spec, +Module, +From, +Attr)
Set predicate attributes. From is one of pred or directive.
  136'$set_pattr'(X, _, _, _) :-
  137    var(X),
  138    '$uninstantiation_error'(X).
  139'$set_pattr'(as(Spec,Options), M, How, Attr0) :-
  140    !,
  141    '$attr_options'(Options, Attr0, Attr),
  142    '$set_pattr'(Spec, M, How, Attr).
  143'$set_pattr'([], _, _, _) :- !.
  144'$set_pattr'([H|T], M, How, Attr) :-           % ISO
  145    !,
  146    '$set_pattr'(H, M, How, Attr),
  147    '$set_pattr'(T, M, How, Attr).
  148'$set_pattr'((A,B), M, How, Attr) :-           % ISO and traditional
  149    !,
  150    '$set_pattr'(A, M, How, Attr),
  151    '$set_pattr'(B, M, How, Attr).
  152'$set_pattr'(M:T, _, How, Attr) :-
  153    !,
  154    '$set_pattr'(T, M, How, Attr).
  155'$set_pattr'(PI, M, _, []) :-
  156    !,
  157    '$pi_head'(M:PI, Pred),
  158    '$set_table_wrappers'(Pred).
  159'$set_pattr'(A, M, How, [O|OT]) :-
  160    !,
  161    '$set_pattr'(A, M, How, O),
  162    '$set_pattr'(A, M, How, OT).
  163'$set_pattr'(A, M, pred, Attr) :-
  164    !,
  165    Attr =.. [Name,Val],
  166    '$set_pi_attr'(M:A, Name, Val).
  167'$set_pattr'(A, M, directive, Attr) :-
  168    !,
  169    Attr =.. [Name,Val],
  170    catch('$set_pi_attr'(M:A, Name, Val),
  171          error(E, _),
  172          print_message(error, error(E, context((Name)/1,_)))).
  173
  174'$set_pi_attr'(PI, Name, Val) :-
  175    '$pi_head'(PI, Head),
  176    '$set_predicate_attribute'(Head, Name, Val).
  177
  178'$attr_options'(Var, _, _) :-
  179    var(Var),
  180    !,
  181    '$uninstantiation_error'(Var).
  182'$attr_options'((A,B), Attr0, Attr) :-
  183    !,
  184    '$attr_options'(A, Attr0, Attr1),
  185    '$attr_options'(B, Attr1, Attr).
  186'$attr_options'(Opt, Attr0, Attrs) :-
  187    '$must_be'(ground, Opt),
  188    (   '$attr_option'(Opt, AttrX)
  189    ->  (   is_list(Attr0)
  190        ->  '$join_attrs'(AttrX, Attr0, Attrs)
  191        ;   '$join_attrs'(AttrX, [Attr0], Attrs)
  192        )
  193    ;   '$domain_error'(predicate_option, Opt)
  194    ).
  195
  196'$join_attrs'([], Attrs, Attrs) :-
  197    !.
  198'$join_attrs'([H|T], Attrs0, Attrs) :-
  199    !,
  200    '$join_attrs'(H, Attrs0, Attrs1),
  201    '$join_attrs'(T, Attrs1, Attrs).
  202'$join_attrs'(Attr, Attrs, Attrs) :-
  203    memberchk(Attr, Attrs),
  204    !.
  205'$join_attrs'(Attr, Attrs, Attrs) :-
  206    Attr =.. [Name,Value],
  207    Gen =.. [Name,Existing],
  208    memberchk(Gen, Attrs),
  209    !,
  210    throw(error(conflict_error(Name, Value, Existing), _)).
  211'$join_attrs'(Attr, Attrs0, Attrs) :-
  212    '$append'(Attrs0, [Attr], Attrs).
  213
  214'$attr_option'(incremental, [incremental(true),opaque(false)]).
  215'$attr_option'(monotonic, monotonic(true)).
  216'$attr_option'(opaque, [incremental(false),opaque(true)]).
  217'$attr_option'(abstract(Level0), abstract(Level)) :-
  218    '$table_option'(Level0, Level).
  219'$attr_option'(subgoal_abstract(Level0), subgoal_abstract(Level)) :-
  220    '$table_option'(Level0, Level).
  221'$attr_option'(answer_abstract(Level0), answer_abstract(Level)) :-
  222    '$table_option'(Level0, Level).
  223'$attr_option'(max_answers(Level0), max_answers(Level)) :-
  224    '$table_option'(Level0, Level).
  225'$attr_option'(volatile, volatile(true)).
  226'$attr_option'(multifile, multifile(true)).
  227'$attr_option'(discontiguous, discontiguous(true)).
  228'$attr_option'(shared, thread_local(false)).
  229'$attr_option'(local, thread_local(true)).
  230'$attr_option'(private, thread_local(true)).
  231
  232'$table_option'(Value0, _Value) :-
  233    var(Value0),
  234    !,
  235    '$instantiation_error'(Value0).
  236'$table_option'(Value0, Value) :-
  237    integer(Value0),
  238    Value0 >= 0,
  239    !,
  240    Value = Value0.
  241'$table_option'(off, -1) :-
  242    !.
  243'$table_option'(false, -1) :-
  244    !.
  245'$table_option'(infinite, -1) :-
  246    !.
  247'$table_option'(Value, _) :-
  248    '$domain_error'(nonneg_or_false, Value).
 $pattr_directive(+Spec, +Module) is det
This implements the directive version of dynamic/1, multifile/1, etc. This version catches and prints errors. If the directive specifies multiple predicates, processing after an error continues with the remaining predicates.
  258'$pattr_directive'(dynamic(Spec), M) :-
  259    '$set_pattr'(Spec, M, directive, dynamic(true)).
  260'$pattr_directive'(multifile(Spec), M) :-
  261    '$set_pattr'(Spec, M, directive, multifile(true)).
  262'$pattr_directive'(module_transparent(Spec), M) :-
  263    '$set_pattr'(Spec, M, directive, transparent(true)).
  264'$pattr_directive'(discontiguous(Spec), M) :-
  265    '$set_pattr'(Spec, M, directive, discontiguous(true)).
  266'$pattr_directive'(volatile(Spec), M) :-
  267    '$set_pattr'(Spec, M, directive, volatile(true)).
  268'$pattr_directive'(thread_local(Spec), M) :-
  269    '$set_pattr'(Spec, M, directive, thread_local(true)).
  270'$pattr_directive'(noprofile(Spec), M) :-
  271    '$set_pattr'(Spec, M, directive, noprofile(true)).
  272'$pattr_directive'(public(Spec), M) :-
  273    '$set_pattr'(Spec, M, directive, public(true)).
 $pi_head(?PI, ?Head)
  277'$pi_head'(PI, Head) :-
  278    var(PI),
  279    var(Head),
  280    '$instantiation_error'([PI,Head]).
  281'$pi_head'(M:PI, M:Head) :-
  282    !,
  283    '$pi_head'(PI, Head).
  284'$pi_head'(Name/Arity, Head) :-
  285    !,
  286    '$head_name_arity'(Head, Name, Arity).
  287'$pi_head'(Name//DCGArity, Head) :-
  288    !,
  289    (   nonvar(DCGArity)
  290    ->  Arity is DCGArity+2,
  291        '$head_name_arity'(Head, Name, Arity)
  292    ;   '$head_name_arity'(Head, Name, Arity),
  293        DCGArity is Arity - 2
  294    ).
  295'$pi_head'(PI, _) :-
  296    '$type_error'(predicate_indicator, PI).
 $head_name_arity(+Goal, -Name, -Arity)
$head_name_arity(-Goal, +Name, +Arity)
  301'$head_name_arity'(Goal, Name, Arity) :-
  302    (   atom(Goal)
  303    ->  Name = Goal, Arity = 0
  304    ;   compound(Goal)
  305    ->  compound_name_arity(Goal, Name, Arity)
  306    ;   var(Goal)
  307    ->  (   Arity == 0
  308        ->  (   atom(Name)
  309            ->  Goal = Name
  310            ;   blob(Name, closure)
  311            ->  Goal = Name
  312            ;   '$type_error'(atom, Name)
  313            )
  314        ;   compound_name_arity(Goal, Name, Arity)
  315        )
  316    ;   '$type_error'(callable, Goal)
  317    ).
  318
  319:- '$iso'(((dynamic)/1, (multifile)/1, (discontiguous)/1)).  320
  321
  322                /********************************
  323                *       CALLING, CONTROL        *
  324                *********************************/
  325
  326:- noprofile((call/1,
  327              catch/3,
  328              once/1,
  329              ignore/1,
  330              call_cleanup/2,
  331              call_cleanup/3,
  332              setup_call_cleanup/3,
  333              setup_call_catcher_cleanup/4)).  334
  335:- meta_predicate
  336    ';'(0,0),
  337    ','(0,0),
  338    @(0,+),
  339    call(0),
  340    call(1,?),
  341    call(2,?,?),
  342    call(3,?,?,?),
  343    call(4,?,?,?,?),
  344    call(5,?,?,?,?,?),
  345    call(6,?,?,?,?,?,?),
  346    call(7,?,?,?,?,?,?,?),
  347    not(0),
  348    \+(0),
  349    '->'(0,0),
  350    '*->'(0,0),
  351    once(0),
  352    ignore(0),
  353    catch(0,?,0),
  354    reset(0,?,-),
  355    setup_call_cleanup(0,0,0),
  356    setup_call_catcher_cleanup(0,0,?,0),
  357    call_cleanup(0,0),
  358    call_cleanup(0,?,0),
  359    catch_with_backtrace(0,?,0),
  360    '$meta_call'(0).  361
  362:- '$iso'((call/1, (\+)/1, once/1, (;)/2, (',')/2, (->)/2, catch/3)).  363
  364% The control structures are always compiled, both   if they appear in a
  365% clause body and if they are handed  to   call/1.  The only way to call
  366% these predicates is by means of  call/2..   In  that case, we call the
  367% hole control structure again to get it compiled by call/1 and properly
  368% deal  with  !,  etc.  Another  reason  for  having  these  things   as
  369% predicates is to be able to define   properties for them, helping code
  370% analyzers.
  371
  372(M0:If ; M0:Then) :- !, call(M0:(If ; Then)).
  373(M1:If ; M2:Then) :-    call(M1:(If ; M2:Then)).
  374(G1   , G2)       :-    call((G1   , G2)).
  375(If  -> Then)     :-    call((If  -> Then)).
  376(If *-> Then)     :-    call((If *-> Then)).
  377@(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.

  391'$meta_call'(M:G) :-
  392    prolog_current_choice(Ch),
  393    '$meta_call'(G, M, Ch).
  394
  395'$meta_call'(Var, _, _) :-
  396    var(Var),
  397    !,
  398    '$instantiation_error'(Var).
  399'$meta_call'((A,B), M, Ch) :-
  400    !,
  401    '$meta_call'(A, M, Ch),
  402    '$meta_call'(B, M, Ch).
  403'$meta_call'((I->T;E), M, Ch) :-
  404    !,
  405    (   prolog_current_choice(Ch2),
  406        '$meta_call'(I, M, Ch2)
  407    ->  '$meta_call'(T, M, Ch)
  408    ;   '$meta_call'(E, M, Ch)
  409    ).
  410'$meta_call'((I*->T;E), M, Ch) :-
  411    !,
  412    (   prolog_current_choice(Ch2),
  413        '$meta_call'(I, M, Ch2)
  414    *-> '$meta_call'(T, M, Ch)
  415    ;   '$meta_call'(E, M, Ch)
  416    ).
  417'$meta_call'((I->T), M, Ch) :-
  418    !,
  419    (   prolog_current_choice(Ch2),
  420        '$meta_call'(I, M, Ch2)
  421    ->  '$meta_call'(T, M, Ch)
  422    ).
  423'$meta_call'((I*->T), M, Ch) :-
  424    !,
  425    prolog_current_choice(Ch2),
  426    '$meta_call'(I, M, Ch2),
  427    '$meta_call'(T, M, Ch).
  428'$meta_call'((A;B), M, Ch) :-
  429    !,
  430    (   '$meta_call'(A, M, Ch)
  431    ;   '$meta_call'(B, M, Ch)
  432    ).
  433'$meta_call'(\+(G), M, _) :-
  434    !,
  435    prolog_current_choice(Ch),
  436    \+ '$meta_call'(G, M, Ch).
  437'$meta_call'(call(G), M, _) :-
  438    !,
  439    prolog_current_choice(Ch),
  440    '$meta_call'(G, M, Ch).
  441'$meta_call'(M:G, _, Ch) :-
  442    !,
  443    '$meta_call'(G, M, Ch).
  444'$meta_call'(!, _, Ch) :-
  445    prolog_cut_to(Ch).
  446'$meta_call'(G, M, _Ch) :-
  447    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..
  463:- '$iso'((call/2,
  464           call/3,
  465           call/4,
  466           call/5,
  467           call/6,
  468           call/7,
  469           call/8)).  470
  471call(Goal) :-                           % make these available as predicates
  472    Goal.
  473call(Goal, A) :-
  474    call(Goal, A).
  475call(Goal, A, B) :-
  476    call(Goal, A, B).
  477call(Goal, A, B, C) :-
  478    call(Goal, A, B, C).
  479call(Goal, A, B, C, D) :-
  480    call(Goal, A, B, C, D).
  481call(Goal, A, B, C, D, E) :-
  482    call(Goal, A, B, C, D, E).
  483call(Goal, A, B, C, D, E, F) :-
  484    call(Goal, A, B, C, D, E, F).
  485call(Goal, A, B, C, D, E, F, G) :-
  486    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.
  493not(Goal) :-
  494    \+ Goal.
 \+ :Goal is semidet
Predicate version that allows for meta-calling.
  500\+ Goal :-
  501    \+ Goal.
 once(:Goal) is semidet
ISO predicate, acting as call((Goal, !)).
  507once(Goal) :-
  508    Goal,
  509    !.
 ignore(:Goal) is det
Call Goal, cut choice-points on success and succeed on failure. intended for calling side-effects and proceed on failure.
  516ignore(Goal) :-
  517    Goal,
  518    !.
  519ignore(_Goal).
  520
  521:- '$iso'((false/0)).
 false
Synonym for fail/0, providing a declarative reading.
  527false :-
  528    fail.
 catch(:Goal, +Catcher, :Recover)
ISO compliant exception handling.
  534catch(_Goal, _Catcher, _Recover) :-
  535    '$catch'.                       % Maps to I_CATCH, I_EXITCATCH
 prolog_cut_to(+Choice)
Cut all choice points after Choice
  541prolog_cut_to(_Choice) :-
  542    '$cut'.                         % Maps to I_CUTCHP
 reset(:Goal, ?Ball, -Continue)
Delimited continuation support.
  548reset(_Goal, _Ball, _Cont) :-
  549    '$reset'.
 shift(+Ball)
Shift control back to the enclosing reset/3
  555shift(Ball) :-
  556    '$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.

  570call_continuation([]).
  571call_continuation([TB|Rest]) :-
  572    (   Rest == []
  573    ->  '$call_continuation'(TB)
  574    ;   '$call_continuation'(TB),
  575        call_continuation(Rest)
  576    ).
 catch_with_backtrace(:Goal, ?Ball, :Recover)
As catch/3, but tell library(prolog_stack) to record a backtrace in case of an exception.
  583catch_with_backtrace(Goal, Ball, Recover) :-
  584    catch(Goal, Ball, Recover),
  585    '$no_lco'.
  586
  587'$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.
  597:- public '$recover_and_rethrow'/2.  598
  599'$recover_and_rethrow'(Goal, Exception) :-
  600    call_cleanup(Goal, throw(Exception)),
  601    !.
 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.
  616setup_call_catcher_cleanup(Setup, _Goal, _Catcher, _Cleanup) :-
  617    '$sig_atomic'(Setup),
  618    '$call_cleanup'.
  619
  620setup_call_cleanup(Setup, Goal, Cleanup) :-
  621    setup_call_catcher_cleanup(Setup, Goal, _Catcher, Cleanup).
  622
  623call_cleanup(Goal, Cleanup) :-
  624    setup_call_catcher_cleanup(true, Goal, _Catcher, Cleanup).
  625
  626call_cleanup(Goal, Catcher, Cleanup) :-
  627    setup_call_catcher_cleanup(true, Goal, Catcher, Cleanup).
  628
  629                 /*******************************
  630                 *       INITIALIZATION         *
  631                 *******************************/
  632
  633:- meta_predicate
  634    initialization(0, +).  635
  636:- multifile '$init_goal'/3.  637:- 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.

  663initialization(Goal, When) :-
  664    '$must_be'(oneof(atom, initialization_type,
  665                     [ now,
  666                       after_load,
  667                       restore,
  668                       restore_state,
  669                       prepare_state,
  670                       program,
  671                       main
  672                     ]), When),
  673    '$initialization_context'(Source, Ctx),
  674    '$initialization'(When, Goal, Source, Ctx).
  675
  676'$initialization'(now, Goal, _Source, Ctx) :-
  677    '$run_init_goal'(Goal, Ctx),
  678    '$compile_init_goal'(-, Goal, Ctx).
  679'$initialization'(after_load, Goal, Source, Ctx) :-
  680    (   Source \== (-)
  681    ->  '$compile_init_goal'(Source, Goal, Ctx)
  682    ;   throw(error(context_error(nodirective,
  683                                  initialization(Goal, after_load)),
  684                    _))
  685    ).
  686'$initialization'(restore, Goal, Source, Ctx) :- % deprecated
  687    '$initialization'(restore_state, Goal, Source, Ctx).
  688'$initialization'(restore_state, Goal, _Source, Ctx) :-
  689    (   \+ current_prolog_flag(sandboxed_load, true)
  690    ->  '$compile_init_goal'(-, Goal, Ctx)
  691    ;   '$permission_error'(register, initialization(restore), Goal)
  692    ).
  693'$initialization'(prepare_state, Goal, _Source, Ctx) :-
  694    (   \+ current_prolog_flag(sandboxed_load, true)
  695    ->  '$compile_init_goal'(when(prepare_state), Goal, Ctx)
  696    ;   '$permission_error'(register, initialization(restore), Goal)
  697    ).
  698'$initialization'(program, Goal, _Source, Ctx) :-
  699    (   \+ current_prolog_flag(sandboxed_load, true)
  700    ->  '$compile_init_goal'(when(program), Goal, Ctx)
  701    ;   '$permission_error'(register, initialization(restore), Goal)
  702    ).
  703'$initialization'(main, Goal, _Source, Ctx) :-
  704    (   \+ current_prolog_flag(sandboxed_load, true)
  705    ->  '$compile_init_goal'(when(main), Goal, Ctx)
  706    ;   '$permission_error'(register, initialization(restore), Goal)
  707    ).
  708
  709
  710'$compile_init_goal'(Source, Goal, Ctx) :-
  711    atom(Source),
  712    Source \== (-),
  713    !,
  714    '$store_admin_clause'(system:'$init_goal'(Source, Goal, Ctx),
  715                          _Layout, Source, Ctx).
  716'$compile_init_goal'(Source, Goal, Ctx) :-
  717    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.
  729'$run_initialization'(_, loaded, _) :- !.
  730'$run_initialization'(File, _Action, Options) :-
  731    '$run_initialization'(File, Options).
  732
  733'$run_initialization'(File, Options) :-
  734    setup_call_cleanup(
  735        '$start_run_initialization'(Options, Restore),
  736        '$run_initialization_2'(File),
  737        '$end_run_initialization'(Restore)).
  738
  739'$start_run_initialization'(Options, OldSandBoxed) :-
  740    '$push_input_context'(initialization),
  741    '$set_sandboxed_load'(Options, OldSandBoxed).
  742'$end_run_initialization'(OldSandBoxed) :-
  743    set_prolog_flag(sandboxed_load, OldSandBoxed),
  744    '$pop_input_context'.
  745
  746'$run_initialization_2'(File) :-
  747    (   '$init_goal'(File, Goal, Ctx),
  748        File \= when(_),
  749        '$run_init_goal'(Goal, Ctx),
  750        fail
  751    ;   true
  752    ).
  753
  754'$run_init_goal'(Goal, Ctx) :-
  755    (   catch_with_backtrace('$run_init_goal'(Goal), E,
  756                             '$initialization_error'(E, Goal, Ctx))
  757    ->  true
  758    ;   '$initialization_failure'(Goal, Ctx)
  759    ).
  760
  761:- multifile prolog:sandbox_allowed_goal/1.  762
  763'$run_init_goal'(Goal) :-
  764    current_prolog_flag(sandboxed_load, false),
  765    !,
  766    call(Goal).
  767'$run_init_goal'(Goal) :-
  768    prolog:sandbox_allowed_goal(Goal),
  769    call(Goal).
  770
  771'$initialization_context'(Source, Ctx) :-
  772    (   source_location(File, Line)
  773    ->  Ctx = File:Line,
  774        '$input_context'(Context),
  775        '$top_file'(Context, File, Source)
  776    ;   Ctx = (-),
  777        File = (-)
  778    ).
  779
  780'$top_file'([input(include, F1, _, _)|T], _, F) :-
  781    !,
  782    '$top_file'(T, F1, F).
  783'$top_file'(_, F, F).
  784
  785
  786'$initialization_error'(E, Goal, Ctx) :-
  787    print_message(error, initialization_error(Goal, E, Ctx)).
  788
  789'$initialization_failure'(Goal, Ctx) :-
  790    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
  798:- public '$clear_source_admin'/1.  799
  800'$clear_source_admin'(File) :-
  801    retractall('$init_goal'(_, _, File:_)),
  802    retractall('$load_context_module'(File, _, _)),
  803    retractall('$resolved_source_path'(_, File)).
  804
  805
  806                 /*******************************
  807                 *            STREAM            *
  808                 *******************************/
  809
  810:- '$iso'(stream_property/2).  811stream_property(Stream, Property) :-
  812    nonvar(Stream),
  813    nonvar(Property),
  814    !,
  815    '$stream_property'(Stream, Property).
  816stream_property(Stream, Property) :-
  817    nonvar(Stream),
  818    !,
  819    '$stream_properties'(Stream, Properties),
  820    '$member'(Property, Properties).
  821stream_property(Stream, Property) :-
  822    nonvar(Property),
  823    !,
  824    (   Property = alias(Alias),
  825        atom(Alias)
  826    ->  '$alias_stream'(Alias, Stream)
  827    ;   '$streams_properties'(Property, Pairs),
  828        '$member'(Stream-Property, Pairs)
  829    ).
  830stream_property(Stream, Property) :-
  831    '$streams_properties'(Property, Pairs),
  832    '$member'(Stream-Properties, Pairs),
  833    '$member'(Property, Properties).
  834
  835
  836                /********************************
  837                *            MODULES            *
  838                *********************************/
  839
  840%       '$prefix_module'(+Module, +Context, +Term, -Prefixed)
  841%       Tags `Term' with `Module:' if `Module' is not the context module.
  842
  843'$prefix_module'(Module, Module, Head, Head) :- !.
  844'$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'.
  850default_module(Me, Super) :-
  851    (   atom(Me)
  852    ->  (   var(Super)
  853        ->  '$default_module'(Me, Super)
  854        ;   '$default_module'(Me, Super), !
  855        )
  856    ;   '$type_error'(module, Me)
  857    ).
  858
  859'$default_module'(Me, Me).
  860'$default_module'(Me, Super) :-
  861    import_module(Me, S),
  862    '$default_module'(S, Super).
  863
  864
  865                /********************************
  866                *      TRACE AND EXCEPTIONS     *
  867                *********************************/
  868
  869:- dynamic   user:exception/3.  870:- multifile user:exception/3.
 $undefined_procedure(+Module, +Name, +Arity, -Action) is det
This predicate is called from C on undefined predicates. First allows the user to take care of it using exception/3. Else try to give a DWIM warning. Otherwise fail. C will print an error message.
  879:- public
  880    '$undefined_procedure'/4.  881
  882'$undefined_procedure'(Module, Name, Arity, Action) :-
  883    '$prefix_module'(Module, user, Name/Arity, Pred),
  884    user:exception(undefined_predicate, Pred, Action0),
  885    !,
  886    Action = Action0.
  887'$undefined_procedure'(Module, Name, Arity, Action) :-
  888    \+ current_prolog_flag(autoload, false),
  889    '$autoload'(Module:Name/Arity),
  890    !,
  891    Action = retry.
  892'$undefined_procedure'(_, _, _, error).
 $loading(+Library)
True if the library is being loaded. Just testing that the predicate is defined is not good enough as the file may be partly loaded. Calling use_module/2 at any time has two drawbacks: it queries the filesystem, causing slowdown and it stops libraries being autoloaded from a saved state where the library is already loaded, but the source may not be accessible.
  904'$loading'(Library) :-
  905    current_prolog_flag(threads, true),
  906    '$loading_file'(FullFile, _Queue, _LoadThread),
  907    file_name_extension(Library, _, FullFile),
  908    !.
  909
  910%        handle debugger 'w', 'p' and <N> depth options.
  911
  912'$set_debugger_write_options'(write) :-
  913    !,
  914    create_prolog_flag(debugger_write_options,
  915                       [ quoted(true),
  916                         attributes(dots),
  917                         spacing(next_argument)
  918                       ], []).
  919'$set_debugger_write_options'(print) :-
  920    !,
  921    create_prolog_flag(debugger_write_options,
  922                       [ quoted(true),
  923                         portray(true),
  924                         max_depth(10),
  925                         attributes(portray),
  926                         spacing(next_argument)
  927                       ], []).
  928'$set_debugger_write_options'(Depth) :-
  929    current_prolog_flag(debugger_write_options, Options0),
  930    (   '$select'(max_depth(_), Options0, Options)
  931    ->  true
  932    ;   Options = Options0
  933    ),
  934    create_prolog_flag(debugger_write_options,
  935                       [max_depth(Depth)|Options], []).
  936
  937
  938                /********************************
  939                *        SYSTEM MESSAGES        *
  940                *********************************/
 $confirm(Spec)
Ask the user to confirm a question. Spec is a term as used for print_message/2.
  947'$confirm'(Spec) :-
  948    print_message(query, Spec),
  949    between(0, 5, _),
  950        get_single_char(Answer),
  951        (   '$in_reply'(Answer, 'yYjJ \n')
  952        ->  !,
  953            print_message(query, if_tty([yes-[]]))
  954        ;   '$in_reply'(Answer, 'nN')
  955        ->  !,
  956            print_message(query, if_tty([no-[]])),
  957            fail
  958        ;   print_message(help, query(confirm)),
  959            fail
  960        ).
  961
  962'$in_reply'(Code, Atom) :-
  963    char_code(Char, Code),
  964    sub_atom(Atom, _, _, _, Char),
  965    !.
  966
  967:- dynamic
  968    user:portray/1.  969:- multifile
  970    user:portray/1.  971
  972
  973                 /*******************************
  974                 *       FILE_SEARCH_PATH       *
  975                 *******************************/
  976
  977:- dynamic
  978    user:file_search_path/2,
  979    user:library_directory/1.  980:- multifile
  981    user:file_search_path/2,
  982    user:library_directory/1.  983
  984user:(file_search_path(library, Dir) :-
  985        library_directory(Dir)).
  986user:file_search_path(swi, Home) :-
  987    current_prolog_flag(home, Home).
  988user:file_search_path(swi, Home) :-
  989    current_prolog_flag(shared_home, Home).
  990user:file_search_path(library, app_config(lib)).
  991user:file_search_path(library, swi(library)).
  992user:file_search_path(library, swi(library/clp)).
  993user:file_search_path(foreign, swi(ArchLib)) :-
  994    \+ current_prolog_flag(windows, true),
  995    current_prolog_flag(arch, Arch),
  996    atom_concat('lib/', Arch, ArchLib).
  997user:file_search_path(foreign, swi(SoLib)) :-
  998    (   current_prolog_flag(windows, true)
  999    ->  SoLib = bin
 1000    ;   SoLib = lib
 1001    ).
 1002user:file_search_path(path, Dir) :-
 1003    getenv('PATH', Path),
 1004    (   current_prolog_flag(windows, true)
 1005    ->  atomic_list_concat(Dirs, (;), Path)
 1006    ;   atomic_list_concat(Dirs, :, Path)
 1007    ),
 1008    '$member'(Dir, Dirs).
 1009user:file_search_path(user_app_data, Dir) :-
 1010    '$xdg_prolog_directory'(data, Dir).
 1011user:file_search_path(common_app_data, Dir) :-
 1012    '$xdg_prolog_directory'(common_data, Dir).
 1013user:file_search_path(user_app_config, Dir) :-
 1014    '$xdg_prolog_directory'(config, Dir).
 1015user:file_search_path(common_app_config, Dir) :-
 1016    '$xdg_prolog_directory'(common_config, Dir).
 1017user:file_search_path(app_data, user_app_data('.')).
 1018user:file_search_path(app_data, common_app_data('.')).
 1019user:file_search_path(app_config, user_app_config('.')).
 1020user:file_search_path(app_config, common_app_config('.')).
 1021% backward compatibility
 1022user:file_search_path(app_preferences, user_app_config('.')).
 1023user:file_search_path(user_profile, app_preferences('.')).
 1024
 1025'$xdg_prolog_directory'(Which, Dir) :-
 1026    '$xdg_directory'(Which, XDGDir),
 1027    '$make_config_dir'(XDGDir),
 1028    '$ensure_slash'(XDGDir, XDGDirS),
 1029    atom_concat(XDGDirS, 'swi-prolog', Dir),
 1030    '$make_config_dir'(Dir).
 1031
 1032% config
 1033'$xdg_directory'(config, Home) :-
 1034    current_prolog_flag(windows, true),
 1035    catch(win_folder(appdata, Home), _, fail),
 1036    !.
 1037'$xdg_directory'(config, Home) :-
 1038    getenv('XDG_CONFIG_HOME', Home).
 1039'$xdg_directory'(config, Home) :-
 1040    expand_file_name('~/.config', [Home]).
 1041% data
 1042'$xdg_directory'(data, Home) :-
 1043    current_prolog_flag(windows, true),
 1044    catch(win_folder(local_appdata, Home), _, fail),
 1045    !.
 1046'$xdg_directory'(data, Home) :-
 1047    getenv('XDG_DATA_HOME', Home).
 1048'$xdg_directory'(data, Home) :-
 1049    expand_file_name('~/.local', [Local]),
 1050    '$make_config_dir'(Local),
 1051    atom_concat(Local, '/share', Home),
 1052    '$make_config_dir'(Home).
 1053% common data
 1054'$xdg_directory'(common_data, Dir) :-
 1055    current_prolog_flag(windows, true),
 1056    catch(win_folder(common_appdata, Dir), _, fail),
 1057    !.
 1058'$xdg_directory'(common_data, Dir) :-
 1059    '$existing_dir_from_env_path'('XDG_DATA_DIRS',
 1060                                  [ '/usr/local/share',
 1061                                    '/usr/share'
 1062                                  ],
 1063                                  Dir).
 1064% common config
 1065'$xdg_directory'(common_config, Dir) :-
 1066    current_prolog_flag(windows, true),
 1067    catch(win_folder(common_appdata, Dir), _, fail),
 1068    !.
 1069'$xdg_directory'(common_config, Dir) :-
 1070    '$existing_dir_from_env_path'('XDG_CONFIG_DIRS', ['/etc/xdg'], Dir).
 1071
 1072'$existing_dir_from_env_path'(Env, Defaults, Dir) :-
 1073    (   getenv(Env, Path)
 1074    ->  '$path_sep'(Sep),
 1075        atomic_list_concat(Dirs, Sep, Path)
 1076    ;   Dirs = Defaults
 1077    ),
 1078    '$member'(Dir, Dirs),
 1079    exists_directory(Dir).
 1080
 1081'$path_sep'(Char) :-
 1082    (   current_prolog_flag(windows, true)
 1083    ->  Char = ';'
 1084    ;   Char = ':'
 1085    ).
 1086
 1087'$make_config_dir'(Dir) :-
 1088    exists_directory(Dir),
 1089    !.
 1090'$make_config_dir'(Dir) :-
 1091    file_directory_name(Dir, Parent),
 1092    '$my_file'(Parent),
 1093    catch(make_directory(Dir), _, fail).
 1094
 1095'$ensure_slash'(Dir, DirS) :-
 1096    (   sub_atom(Dir, _, _, 0, /)
 1097    ->  DirS = Dir
 1098    ;   atom_concat(Dir, /, DirS)
 1099    ).
 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?
 1108expand_file_search_path(Spec, Expanded) :-
 1109    catch('$expand_file_search_path'(Spec, Expanded, 0, []),
 1110          loop(Used),
 1111          throw(error(loop_error(Spec), file_search(Used)))).
 1112
 1113'$expand_file_search_path'(Spec, Expanded, N, Used) :-
 1114    functor(Spec, Alias, 1),
 1115    !,
 1116    user:file_search_path(Alias, Exp0),
 1117    NN is N + 1,
 1118    (   NN > 16
 1119    ->  throw(loop(Used))
 1120    ;   true
 1121    ),
 1122    '$expand_file_search_path'(Exp0, Exp1, NN, [Alias=Exp0|Used]),
 1123    arg(1, Spec, Segments),
 1124    '$segments_to_atom'(Segments, File),
 1125    '$make_path'(Exp1, File, Expanded).
 1126'$expand_file_search_path'(Spec, Path, _, _) :-
 1127    '$segments_to_atom'(Spec, Path).
 1128
 1129'$make_path'(Dir, '.', Path) :-
 1130    !,
 1131    Path = Dir.
 1132'$make_path'(Dir, File, Path) :-
 1133    sub_atom(Dir, _, _, 0, /),
 1134    !,
 1135    atom_concat(Dir, File, Path).
 1136'$make_path'(Dir, File, Path) :-
 1137    atomic_list_concat([Dir, /, File], Path).
 1138
 1139
 1140                /********************************
 1141                *         FILE CHECKING         *
 1142                *********************************/
 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.
 1153absolute_file_name(Spec, Options, Path) :-
 1154    '$is_options'(Options),
 1155    \+ '$is_options'(Path),
 1156    !,
 1157    absolute_file_name(Spec, Path, Options).
 1158absolute_file_name(Spec, Path, Options) :-
 1159    '$must_be'(options, Options),
 1160                    % get the valid extensions
 1161    (   '$select_option'(extensions(Exts), Options, Options1)
 1162    ->  '$must_be'(list, Exts)
 1163    ;   '$option'(file_type(Type), Options)
 1164    ->  '$must_be'(atom, Type),
 1165        '$file_type_extensions'(Type, Exts),
 1166        Options1 = Options
 1167    ;   Options1 = Options,
 1168        Exts = ['']
 1169    ),
 1170    '$canonicalise_extensions'(Exts, Extensions),
 1171                    % unless specified otherwise, ask regular file
 1172    (   nonvar(Type)
 1173    ->  Options2 = Options1
 1174    ;   '$merge_options'(_{file_type:regular}, Options1, Options2)
 1175    ),
 1176                    % Det or nondet?
 1177    (   '$select_option'(solutions(Sols), Options2, Options3)
 1178    ->  '$must_be'(oneof(atom, solutions, [first,all]), Sols)
 1179    ;   Sols = first,
 1180        Options3 = Options2
 1181    ),
 1182                    % Errors or not?
 1183    (   '$select_option'(file_errors(FileErrors), Options3, Options4)
 1184    ->  '$must_be'(oneof(atom, file_errors, [error,fail]), FileErrors)
 1185    ;   FileErrors = error,
 1186        Options4 = Options3
 1187    ),
 1188                    % Expand shell patterns?
 1189    (   atomic(Spec),
 1190        '$select_option'(expand(Expand), Options4, Options5),
 1191        '$must_be'(boolean, Expand)
 1192    ->  expand_file_name(Spec, List),
 1193        '$member'(Spec1, List)
 1194    ;   Spec1 = Spec,
 1195        Options5 = Options4
 1196    ),
 1197                    % Search for files
 1198    (   Sols == first
 1199    ->  (   '$chk_file'(Spec1, Extensions, Options5, true, Path)
 1200        ->  !       % also kill choice point of expand_file_name/2
 1201        ;   (   FileErrors == fail
 1202            ->  fail
 1203            ;   '$current_module'('$bags', _File),
 1204                findall(P,
 1205                        '$chk_file'(Spec1, Extensions, [access(exist)],
 1206                                    false, P),
 1207                        Candidates),
 1208                '$abs_file_error'(Spec, Candidates, Options5)
 1209            )
 1210        )
 1211    ;   '$chk_file'(Spec1, Extensions, Options5, false, Path)
 1212    ).
 1213
 1214'$abs_file_error'(Spec, Candidates, Conditions) :-
 1215    '$member'(F, Candidates),
 1216    '$member'(C, Conditions),
 1217    '$file_condition'(C),
 1218    '$file_error'(C, Spec, F, E, Comment),
 1219    !,
 1220    throw(error(E, context(_, Comment))).
 1221'$abs_file_error'(Spec, _, _) :-
 1222    '$existence_error'(source_sink, Spec).
 1223
 1224'$file_error'(file_type(directory), Spec, File, Error, Comment) :-
 1225    \+ exists_directory(File),
 1226    !,
 1227    Error = existence_error(directory, Spec),
 1228    Comment = not_a_directory(File).
 1229'$file_error'(file_type(_), Spec, File, Error, Comment) :-
 1230    exists_directory(File),
 1231    !,
 1232    Error = existence_error(file, Spec),
 1233    Comment = directory(File).
 1234'$file_error'(access(OneOrList), Spec, File, Error, _) :-
 1235    '$one_or_member'(Access, OneOrList),
 1236    \+ access_file(File, Access),
 1237    Error = permission_error(Access, source_sink, Spec).
 1238
 1239'$one_or_member'(Elem, List) :-
 1240    is_list(List),
 1241    !,
 1242    '$member'(Elem, List).
 1243'$one_or_member'(Elem, Elem).
 1244
 1245
 1246'$file_type_extensions'(source, Exts) :-       % SICStus 3.9 compatibility
 1247    !,
 1248    '$file_type_extensions'(prolog, Exts).
 1249'$file_type_extensions'(Type, Exts) :-
 1250    '$current_module'('$bags', _File),
 1251    !,
 1252    findall(Ext, user:prolog_file_type(Ext, Type), Exts0),
 1253    (   Exts0 == [],
 1254        \+ '$ft_no_ext'(Type)
 1255    ->  '$domain_error'(file_type, Type)
 1256    ;   true
 1257    ),
 1258    '$append'(Exts0, [''], Exts).
 1259'$file_type_extensions'(prolog, [pl, '']). % findall is not yet defined ...
 1260
 1261'$ft_no_ext'(txt).
 1262'$ft_no_ext'(executable).
 1263'$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.

 1276:- multifile(user:prolog_file_type/2). 1277:- dynamic(user:prolog_file_type/2). 1278
 1279user:prolog_file_type(pl,       prolog).
 1280user:prolog_file_type(prolog,   prolog).
 1281user:prolog_file_type(qlf,      prolog).
 1282user:prolog_file_type(qlf,      qlf).
 1283user:prolog_file_type(Ext,      executable) :-
 1284    current_prolog_flag(shared_object_extension, Ext).
 1285user:prolog_file_type(dylib,    executable) :-
 1286    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.
 1293'$chk_file'(Spec, _Extensions, _Cond, _Cache, _FullName) :-
 1294    \+ ground(Spec),
 1295    !,
 1296    '$instantiation_error'(Spec).
 1297'$chk_file'(Spec, Extensions, Cond, Cache, FullName) :-
 1298    compound(Spec),
 1299    functor(Spec, _, 1),
 1300    !,
 1301    '$relative_to'(Cond, cwd, CWD),
 1302    '$chk_alias_file'(Spec, Extensions, Cond, Cache, CWD, FullName).
 1303'$chk_file'(Segments, Ext, Cond, Cache, FullName) :-    % allow a/b/...
 1304    \+ atomic(Segments),
 1305    !,
 1306    '$segments_to_atom'(Segments, Atom),
 1307    '$chk_file'(Atom, Ext, Cond, Cache, FullName).
 1308'$chk_file'(File, Exts, Cond, _, FullName) :-
 1309    is_absolute_file_name(File),
 1310    !,
 1311    '$extend_file'(File, Exts, Extended),
 1312    '$file_conditions'(Cond, Extended),
 1313    '$absolute_file_name'(Extended, FullName).
 1314'$chk_file'(File, Exts, Cond, _, FullName) :-
 1315    '$relative_to'(Cond, source, Dir),
 1316    atomic_list_concat([Dir, /, File], AbsFile),
 1317    '$extend_file'(AbsFile, Exts, Extended),
 1318    '$file_conditions'(Cond, Extended),
 1319    !,
 1320    '$absolute_file_name'(Extended, FullName).
 1321'$chk_file'(File, Exts, Cond, _, FullName) :-
 1322    '$extend_file'(File, Exts, Extended),
 1323    '$file_conditions'(Cond, Extended),
 1324    '$absolute_file_name'(Extended, FullName).
 1325
 1326'$segments_to_atom'(Atom, Atom) :-
 1327    atomic(Atom),
 1328    !.
 1329'$segments_to_atom'(Segments, Atom) :-
 1330    '$segments_to_list'(Segments, List, []),
 1331    !,
 1332    atomic_list_concat(List, /, Atom).
 1333
 1334'$segments_to_list'(A/B, H, T) :-
 1335    '$segments_to_list'(A, H, T0),
 1336    '$segments_to_list'(B, T0, T).
 1337'$segments_to_list'(A, [A|T], T) :-
 1338    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.
 1348'$relative_to'(Conditions, Default, Dir) :-
 1349    (   '$option'(relative_to(FileOrDir), Conditions)
 1350    *-> (   exists_directory(FileOrDir)
 1351        ->  Dir = FileOrDir
 1352        ;   atom_concat(Dir, /, FileOrDir)
 1353        ->  true
 1354        ;   file_directory_name(FileOrDir, Dir)
 1355        )
 1356    ;   Default == cwd
 1357    ->  '$cwd'(Dir)
 1358    ;   Default == source
 1359    ->  source_location(ContextFile, _Line),
 1360        file_directory_name(ContextFile, Dir)
 1361    ).
 $chk_alias_file(+Spec, +Exts, +Cond, +Cache, +CWD, -FullFile) is nondet
 1366:- dynamic
 1367    '$search_path_file_cache'/3,    % SHA1, Time, Path
 1368    '$search_path_gc_time'/1.       % Time
 1369:- volatile
 1370    '$search_path_file_cache'/3,
 1371    '$search_path_gc_time'/1. 1372
 1373:- create_prolog_flag(file_search_cache_time, 10, []). 1374
 1375'$chk_alias_file'(Spec, Exts, Cond, true, CWD, FullFile) :-
 1376    !,
 1377    findall(Exp, expand_file_search_path(Spec, Exp), Expansions),
 1378    Cache = cache(Exts, Cond, CWD, Expansions),
 1379    variant_sha1(Spec+Cache, SHA1),
 1380    get_time(Now),
 1381    current_prolog_flag(file_search_cache_time, TimeOut),
 1382    (   '$search_path_file_cache'(SHA1, CachedTime, FullFile),
 1383        CachedTime > Now - TimeOut,
 1384        '$file_conditions'(Cond, FullFile)
 1385    ->  '$search_message'(file_search(cache(Spec, Cond), FullFile))
 1386    ;   '$member'(Expanded, Expansions),
 1387        '$extend_file'(Expanded, Exts, LibFile),
 1388        (   '$file_conditions'(Cond, LibFile),
 1389            '$absolute_file_name'(LibFile, FullFile),
 1390            '$cache_file_found'(SHA1, Now, TimeOut, FullFile)
 1391        ->  '$search_message'(file_search(found(Spec, Cond), FullFile))
 1392        ;   '$search_message'(file_search(tried(Spec, Cond), LibFile)),
 1393            fail
 1394        )
 1395    ).
 1396'$chk_alias_file'(Spec, Exts, Cond, false, _CWD, FullFile) :-
 1397    expand_file_search_path(Spec, Expanded),
 1398    '$extend_file'(Expanded, Exts, LibFile),
 1399    '$file_conditions'(Cond, LibFile),
 1400    '$absolute_file_name'(LibFile, FullFile).
 1401
 1402'$cache_file_found'(_, _, TimeOut, _) :-
 1403    TimeOut =:= 0,
 1404    !.
 1405'$cache_file_found'(SHA1, Now, TimeOut, FullFile) :-
 1406    '$search_path_file_cache'(SHA1, Saved, FullFile),
 1407    !,
 1408    (   Now - Saved < TimeOut/2
 1409    ->  true
 1410    ;   retractall('$search_path_file_cache'(SHA1, _, _)),
 1411        asserta('$search_path_file_cache'(SHA1, Now, FullFile))
 1412    ).
 1413'$cache_file_found'(SHA1, Now, TimeOut, FullFile) :-
 1414    'gc_file_search_cache'(TimeOut),
 1415    asserta('$search_path_file_cache'(SHA1, Now, FullFile)).
 1416
 1417'gc_file_search_cache'(TimeOut) :-
 1418    get_time(Now),
 1419    '$search_path_gc_time'(Last),
 1420    Now-Last < TimeOut/2,
 1421    !.
 1422'gc_file_search_cache'(TimeOut) :-
 1423    get_time(Now),
 1424    retractall('$search_path_gc_time'(_)),
 1425    assertz('$search_path_gc_time'(Now)),
 1426    Before is Now - TimeOut,
 1427    (   '$search_path_file_cache'(SHA1, Cached, FullFile),
 1428        Cached < Before,
 1429        retractall('$search_path_file_cache'(SHA1, Cached, FullFile)),
 1430        fail
 1431    ;   true
 1432    ).
 1433
 1434
 1435'$search_message'(Term) :-
 1436    current_prolog_flag(verbose_file_search, true),
 1437    !,
 1438    print_message(informational, Term).
 1439'$search_message'(_).
 $file_conditions(+Condition, +Path)
Verify Path satisfies Condition.
 1446'$file_conditions'(List, File) :-
 1447    is_list(List),
 1448    !,
 1449    \+ ( '$member'(C, List),
 1450         '$file_condition'(C),
 1451         \+ '$file_condition'(C, File)
 1452       ).
 1453'$file_conditions'(Map, File) :-
 1454    \+ (  get_dict(Key, Map, Value),
 1455          C =.. [Key,Value],
 1456          '$file_condition'(C),
 1457         \+ '$file_condition'(C, File)
 1458       ).
 1459
 1460'$file_condition'(file_type(directory), File) :-
 1461    !,
 1462    exists_directory(File).
 1463'$file_condition'(file_type(_), File) :-
 1464    !,
 1465    \+ exists_directory(File).
 1466'$file_condition'(access(Accesses), File) :-
 1467    !,
 1468    \+ (  '$one_or_member'(Access, Accesses),
 1469          \+ access_file(File, Access)
 1470       ).
 1471
 1472'$file_condition'(exists).
 1473'$file_condition'(file_type(_)).
 1474'$file_condition'(access(_)).
 1475
 1476'$extend_file'(File, Exts, FileEx) :-
 1477    '$ensure_extensions'(Exts, File, Fs),
 1478    '$list_to_set'(Fs, FsSet),
 1479    '$member'(FileEx, FsSet).
 1480
 1481'$ensure_extensions'([], _, []).
 1482'$ensure_extensions'([E|E0], F, [FE|E1]) :-
 1483    file_name_extension(F, E, FE),
 1484    '$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.
 1493'$list_to_set'(List, Set) :-
 1494    '$list_to_set'(List, [], Set).
 1495
 1496'$list_to_set'([], _, []).
 1497'$list_to_set'([H|T], Seen, R) :-
 1498    memberchk(H, Seen),
 1499    !,
 1500    '$list_to_set'(T, R).
 1501'$list_to_set'([H|T], Seen, [H|R]) :-
 1502    '$list_to_set'(T, [H|Seen], R).
 1503
 1504/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
 1505Canonicalise the extension list. Old SWI-Prolog   require  `.pl', etc, which
 1506the Quintus compatibility  requests  `pl'.   This  layer  canonicalises  all
 1507extensions to .ext
 1508- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
 1509
 1510'$canonicalise_extensions'([], []) :- !.
 1511'$canonicalise_extensions'([H|T], [CH|CT]) :-
 1512    !,
 1513    '$must_be'(atom, H),
 1514    '$canonicalise_extension'(H, CH),
 1515    '$canonicalise_extensions'(T, CT).
 1516'$canonicalise_extensions'(E, [CE]) :-
 1517    '$canonicalise_extension'(E, CE).
 1518
 1519'$canonicalise_extension'('', '') :- !.
 1520'$canonicalise_extension'(DotAtom, DotAtom) :-
 1521    sub_atom(DotAtom, 0, _, _, '.'),
 1522    !.
 1523'$canonicalise_extension'(Atom, DotAtom) :-
 1524    atom_concat('.', Atom, DotAtom).
 1525
 1526
 1527                /********************************
 1528                *            CONSULT            *
 1529                *********************************/
 1530
 1531:- dynamic
 1532    user:library_directory/1,
 1533    user:prolog_load_file/2. 1534:- multifile
 1535    user:library_directory/1,
 1536    user:prolog_load_file/2. 1537
 1538:- prompt(_, '|: '). 1539
 1540:- thread_local
 1541    '$compilation_mode_store'/1,    % database, wic, qlf
 1542    '$directive_mode_store'/1.      % database, wic, qlf
 1543:- volatile
 1544    '$compilation_mode_store'/1,
 1545    '$directive_mode_store'/1. 1546
 1547'$compilation_mode'(Mode) :-
 1548    (   '$compilation_mode_store'(Val)
 1549    ->  Mode = Val
 1550    ;   Mode = database
 1551    ).
 1552
 1553'$set_compilation_mode'(Mode) :-
 1554    retractall('$compilation_mode_store'(_)),
 1555    assertz('$compilation_mode_store'(Mode)).
 1556
 1557'$compilation_mode'(Old, New) :-
 1558    '$compilation_mode'(Old),
 1559    (   New == Old
 1560    ->  true
 1561    ;   '$set_compilation_mode'(New)
 1562    ).
 1563
 1564'$directive_mode'(Mode) :-
 1565    (   '$directive_mode_store'(Val)
 1566    ->  Mode = Val
 1567    ;   Mode = database
 1568    ).
 1569
 1570'$directive_mode'(Old, New) :-
 1571    '$directive_mode'(Old),
 1572    (   New == Old
 1573    ->  true
 1574    ;   '$set_directive_mode'(New)
 1575    ).
 1576
 1577'$set_directive_mode'(Mode) :-
 1578    retractall('$directive_mode_store'(_)),
 1579    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.
 1587'$compilation_level'(Level) :-
 1588    '$input_context'(Stack),
 1589    '$compilation_level'(Stack, Level).
 1590
 1591'$compilation_level'([], 0).
 1592'$compilation_level'([Input|T], Level) :-
 1593    (   arg(1, Input, see)
 1594    ->  '$compilation_level'(T, Level)
 1595    ;   '$compilation_level'(T, Level0),
 1596        Level is Level0+1
 1597    ).
 compiling
Is true if SWI-Prolog is generating a state or qlf file or executes a `call' directive while doing this.
 1605compiling :-
 1606    \+ (   '$compilation_mode'(database),
 1607           '$directive_mode'(database)
 1608       ).
 1609
 1610:- meta_predicate
 1611    '$ifcompiling'(0). 1612
 1613'$ifcompiling'(G) :-
 1614    (   '$compilation_mode'(database)
 1615    ->  true
 1616    ;   call(G)
 1617    ).
 1618
 1619                /********************************
 1620                *         READ SOURCE           *
 1621                *********************************/
 $load_msg_level(+Action, +NestingLevel, -StartVerbose, -EndVerbose)
 1625'$load_msg_level'(Action, Nesting, Start, Done) :-
 1626    '$update_autoload_level'([], 0),
 1627    !,
 1628    current_prolog_flag(verbose_load, Type0),
 1629    '$load_msg_compat'(Type0, Type),
 1630    (   '$load_msg_level'(Action, Nesting, Type, Start, Done)
 1631    ->  true
 1632    ).
 1633'$load_msg_level'(_, _, silent, silent).
 1634
 1635'$load_msg_compat'(true, normal) :- !.
 1636'$load_msg_compat'(false, silent) :- !.
 1637'$load_msg_compat'(X, X).
 1638
 1639'$load_msg_level'(load_file,    _, full,   informational, informational).
 1640'$load_msg_level'(include_file, _, full,   informational, informational).
 1641'$load_msg_level'(load_file,    _, normal, silent,        informational).
 1642'$load_msg_level'(include_file, _, normal, silent,        silent).
 1643'$load_msg_level'(load_file,    0, brief,  silent,        informational).
 1644'$load_msg_level'(load_file,    _, brief,  silent,        silent).
 1645'$load_msg_level'(include_file, _, brief,  silent,        silent).
 1646'$load_msg_level'(load_file,    _, silent, silent,        silent).
 1647'$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)
 1670'$source_term'(From, Read, RLayout, Term, TLayout, Stream, Options) :-
 1671    '$source_term'(From, Read, RLayout, Term, TLayout, Stream, [], Options),
 1672    (   Term == end_of_file
 1673    ->  !, fail
 1674    ;   Term \== begin_of_file
 1675    ).
 1676
 1677'$source_term'(Input, _,_,_,_,_,_,_) :-
 1678    \+ ground(Input),
 1679    !,
 1680    '$instantiation_error'(Input).
 1681'$source_term'(stream(Id, In, Opts),
 1682               Read, RLayout, Term, TLayout, Stream, Parents, Options) :-
 1683    !,
 1684    '$record_included'(Parents, Id, Id, 0.0, Message),
 1685    setup_call_cleanup(
 1686        '$open_source'(stream(Id, In, Opts), In, State, Parents, Options),
 1687        '$term_in_file'(In, Read, RLayout, Term, TLayout, Stream,
 1688                        [Id|Parents], Options),
 1689        '$close_source'(State, Message)).
 1690'$source_term'(File,
 1691               Read, RLayout, Term, TLayout, Stream, Parents, Options) :-
 1692    absolute_file_name(File, Path,
 1693                       [ file_type(prolog),
 1694                         access(read)
 1695                       ]),
 1696    time_file(Path, Time),
 1697    '$record_included'(Parents, File, Path, Time, Message),
 1698    setup_call_cleanup(
 1699        '$open_source'(Path, In, State, Parents, Options),
 1700        '$term_in_file'(In, Read, RLayout, Term, TLayout, Stream,
 1701                        [Path|Parents], Options),
 1702        '$close_source'(State, Message)).
 1703
 1704:- thread_local
 1705    '$load_input'/2. 1706:- volatile
 1707    '$load_input'/2. 1708
 1709'$open_source'(stream(Id, In, Opts), In,
 1710               restore(In, StreamState, Id, Ref, Opts), Parents, _Options) :-
 1711    !,
 1712    '$context_type'(Parents, ContextType),
 1713    '$push_input_context'(ContextType),
 1714    '$prepare_load_stream'(In, Id, StreamState),
 1715    asserta('$load_input'(stream(Id), In), Ref).
 1716'$open_source'(Path, In, close(In, Path, Ref), Parents, Options) :-
 1717    '$context_type'(Parents, ContextType),
 1718    '$push_input_context'(ContextType),
 1719    '$open_source'(Path, In, Options),
 1720    '$set_encoding'(In, Options),
 1721    asserta('$load_input'(Path, In), Ref).
 1722
 1723'$context_type'([], load_file) :- !.
 1724'$context_type'(_, include).
 1725
 1726:- multifile prolog:open_source_hook/3. 1727
 1728'$open_source'(Path, In, Options) :-
 1729    prolog:open_source_hook(Path, In, Options),
 1730    !.
 1731'$open_source'(Path, In, _Options) :-
 1732    open(Path, read, In).
 1733
 1734'$close_source'(close(In, _Id, Ref), Message) :-
 1735    erase(Ref),
 1736    call_cleanup(
 1737        close(In),
 1738        '$pop_input_context'),
 1739    '$close_message'(Message).
 1740'$close_source'(restore(In, StreamState, _Id, Ref, Opts), Message) :-
 1741    erase(Ref),
 1742    call_cleanup(
 1743        '$restore_load_stream'(In, StreamState, Opts),
 1744        '$pop_input_context'),
 1745    '$close_message'(Message).
 1746
 1747'$close_message'(message(Level, Msg)) :-
 1748    !,
 1749    '$print_message'(Level, Msg).
 1750'$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.
 1762'$term_in_file'(In, Read, RLayout, Term, TLayout, Stream, Parents, Options) :-
 1763    Parents \= [_,_|_],
 1764    (   '$load_input'(_, Input)
 1765    ->  stream_property(Input, file_name(File))
 1766    ),
 1767    '$set_source_location'(File, 0),
 1768    '$expanded_term'(In,
 1769                     begin_of_file, 0-0, Read, RLayout, Term, TLayout,
 1770                     Stream, Parents, Options).
 1771'$term_in_file'(In, Read, RLayout, Term, TLayout, Stream, Parents, Options) :-
 1772    '$skip_script_line'(In, Options),
 1773    '$read_clause_options'(Options, ReadOptions),
 1774    repeat,
 1775      read_clause(In, Raw,
 1776                  [ variable_names(Bindings),
 1777                    term_position(Pos),
 1778                    subterm_positions(RawLayout)
 1779                  | ReadOptions
 1780                  ]),
 1781      b_setval('$term_position', Pos),
 1782      b_setval('$variable_names', Bindings),
 1783      (   Raw == end_of_file
 1784      ->  !,
 1785          (   Parents = [_,_|_]     % Included file
 1786          ->  fail
 1787          ;   '$expanded_term'(In,
 1788                               Raw, RawLayout, Read, RLayout, Term, TLayout,
 1789                               Stream, Parents, Options)
 1790          )
 1791      ;   '$expanded_term'(In, Raw, RawLayout, Read, RLayout, Term, TLayout,
 1792                           Stream, Parents, Options)
 1793      ).
 1794
 1795'$read_clause_options'([], []).
 1796'$read_clause_options'([H|T0], List) :-
 1797    (   '$read_clause_option'(H)
 1798    ->  List = [H|T]
 1799    ;   List = T
 1800    ),
 1801    '$read_clause_options'(T0, T).
 1802
 1803'$read_clause_option'(syntax_errors(_)).
 1804'$read_clause_option'(term_position(_)).
 1805'$read_clause_option'(process_comment(_)).
 1806
 1807'$expanded_term'(In, Raw, RawLayout, Read, RLayout, Term, TLayout,
 1808                 Stream, Parents, Options) :-
 1809    E = error(_,_),
 1810    catch('$expand_term'(Raw, RawLayout, Expanded, ExpandedLayout), E,
 1811          '$print_message_fail'(E)),
 1812    (   Expanded \== []
 1813    ->  '$expansion_member'(Expanded, ExpandedLayout, Term1, Layout1)
 1814    ;   Term1 = Expanded,
 1815        Layout1 = ExpandedLayout
 1816    ),
 1817    (   nonvar(Term1), Term1 = (:-Directive), nonvar(Directive)
 1818    ->  (   Directive = include(File),
 1819            '$current_source_module'(Module),
 1820            '$valid_directive'(Module:include(File))
 1821        ->  stream_property(In, encoding(Enc)),
 1822            '$add_encoding'(Enc, Options, Options1),
 1823            '$source_term'(File, Read, RLayout, Term, TLayout,
 1824                           Stream, Parents, Options1)
 1825        ;   Directive = encoding(Enc)
 1826        ->  set_stream(In, encoding(Enc)),
 1827            fail
 1828        ;   Term = Term1,
 1829            Stream = In,
 1830            Read = Raw
 1831        )
 1832    ;   Term = Term1,
 1833        TLayout = Layout1,
 1834        Stream = In,
 1835        Read = Raw,
 1836        RLayout = RawLayout
 1837    ).
 1838
 1839'$expansion_member'(Var, Layout, Var, Layout) :-
 1840    var(Var),
 1841    !.
 1842'$expansion_member'([], _, _, _) :- !, fail.
 1843'$expansion_member'(List, ListLayout, Term, Layout) :-
 1844    is_list(List),
 1845    !,
 1846    (   var(ListLayout)
 1847    ->  '$member'(Term, List)
 1848    ;   is_list(ListLayout)
 1849    ->  '$member_rep2'(Term, Layout, List, ListLayout)
 1850    ;   Layout = ListLayout,
 1851        '$member'(Term, List)
 1852    ).
 1853'$expansion_member'(X, Layout, X, Layout).
 1854
 1855% pairwise member, repeating last element of the second
 1856% list.
 1857
 1858'$member_rep2'(H1, H2, [H1|_], [H2|_]).
 1859'$member_rep2'(H1, H2, [_|T1], [T2]) :-
 1860    !,
 1861    '$member_rep2'(H1, H2, T1, [T2]).
 1862'$member_rep2'(H1, H2, [_|T1], [_|T2]) :-
 1863    '$member_rep2'(H1, H2, T1, T2).
 $add_encoding(+Enc, +Options0, -Options)
 1867'$add_encoding'(Enc, Options0, Options) :-
 1868    (   Options0 = [encoding(Enc)|_]
 1869    ->  Options = Options0
 1870    ;   Options = [encoding(Enc)|Options0]
 1871    ).
 1872
 1873
 1874:- multifile
 1875    '$included'/4.                  % Into, Line, File, LastModified
 1876:- dynamic
 1877    '$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'.

 1891'$record_included'([Parent|Parents], File, Path, Time,
 1892                   message(DoneMsgLevel,
 1893                           include_file(done(Level, file(File, Path))))) :-
 1894    source_location(SrcFile, Line),
 1895    !,
 1896    '$compilation_level'(Level),
 1897    '$load_msg_level'(include_file, Level, StartMsgLevel, DoneMsgLevel),
 1898    '$print_message'(StartMsgLevel,
 1899                     include_file(start(Level,
 1900                                        file(File, Path)))),
 1901    '$last'([Parent|Parents], Owner),
 1902    (   (   '$compilation_mode'(database)
 1903        ;   '$qlf_current_source'(Owner)
 1904        )
 1905    ->  '$store_admin_clause'(
 1906            system:'$included'(Parent, Line, Path, Time),
 1907            _, Owner, SrcFile:Line)
 1908    ;   '$qlf_include'(Owner, Parent, Line, Path, Time)
 1909    ).
 1910'$record_included'(_, _, _, _, true).
 $master_file(+File, -MasterFile)
Find the primary load file from included files.
 1916'$master_file'(File, MasterFile) :-
 1917    '$included'(MasterFile0, _Line, File, _Time),
 1918    !,
 1919    '$master_file'(MasterFile0, MasterFile).
 1920'$master_file'(File, File).
 1921
 1922
 1923'$skip_script_line'(_In, Options) :-
 1924    '$option'(check_script(false), Options),
 1925    !.
 1926'$skip_script_line'(In, _Options) :-
 1927    (   peek_char(In, #)
 1928    ->  skip(In, 10)
 1929    ;   true
 1930    ).
 1931
 1932'$set_encoding'(Stream, Options) :-
 1933    '$option'(encoding(Enc), Options),
 1934    !,
 1935    Enc \== default,
 1936    set_stream(Stream, encoding(Enc)).
 1937'$set_encoding'(_, _).
 1938
 1939
 1940'$prepare_load_stream'(In, Id, state(HasName,HasPos)) :-
 1941    (   stream_property(In, file_name(_))
 1942    ->  HasName = true,
 1943        (   stream_property(In, position(_))
 1944        ->  HasPos = true
 1945        ;   HasPos = false,
 1946            set_stream(In, record_position(true))
 1947        )
 1948    ;   HasName = false,
 1949        set_stream(In, file_name(Id)),
 1950        (   stream_property(In, position(_))
 1951        ->  HasPos = true
 1952        ;   HasPos = false,
 1953            set_stream(In, record_position(true))
 1954        )
 1955    ).
 1956
 1957'$restore_load_stream'(In, _State, Options) :-
 1958    memberchk(close(true), Options),
 1959    !,
 1960    close(In).
 1961'$restore_load_stream'(In, state(HasName, HasPos), _Options) :-
 1962    (   HasName == false
 1963    ->  set_stream(In, file_name(''))
 1964    ;   true
 1965    ),
 1966    (   HasPos == false
 1967    ->  set_stream(In, record_position(false))
 1968    ;   true
 1969    ).
 1970
 1971
 1972                 /*******************************
 1973                 *          DERIVED FILES       *
 1974                 *******************************/
 1975
 1976:- dynamic
 1977    '$derived_source_db'/3.         % Loaded, DerivedFrom, Time
 1978
 1979'$register_derived_source'(_, '-') :- !.
 1980'$register_derived_source'(Loaded, DerivedFrom) :-
 1981    retractall('$derived_source_db'(Loaded, _, _)),
 1982    time_file(DerivedFrom, Time),
 1983    assert('$derived_source_db'(Loaded, DerivedFrom, Time)).
 1984
 1985%       Auto-importing dynamic predicates is not very elegant and
 1986%       leads to problems with qsave_program/[1,2]
 1987
 1988'$derived_source'(Loaded, DerivedFrom, Time) :-
 1989    '$derived_source_db'(Loaded, DerivedFrom, Time).
 1990
 1991
 1992                /********************************
 1993                *       LOAD PREDICATES         *
 1994                *********************************/
 1995
 1996:- meta_predicate
 1997    ensure_loaded(:),
 1998    [:|+],
 1999    consult(:),
 2000    use_module(:),
 2001    use_module(:, +),
 2002    reexport(:),
 2003    reexport(:, +),
 2004    load_files(:),
 2005    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.
 2013ensure_loaded(Files) :-
 2014    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.
 2023use_module(Files) :-
 2024    load_files(Files, [ if(not_loaded),
 2025                        must_be_module(true)
 2026                      ]).
 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.
 2033use_module(File, Import) :-
 2034    load_files(File, [ if(not_loaded),
 2035                       must_be_module(true),
 2036                       imports(Import)
 2037                     ]).
 reexport(+Files)
As use_module/1, exporting all imported predicates.
 2043reexport(Files) :-
 2044    load_files(Files, [ if(not_loaded),
 2045                        must_be_module(true),
 2046                        reexport(true)
 2047                      ]).
 reexport(+File, +ImportList)
As use_module/1, re-exporting all imported predicates.
 2053reexport(File, Import) :-
 2054    load_files(File, [ if(not_loaded),
 2055                       must_be_module(true),
 2056                       imports(Import),
 2057                       reexport(true)
 2058                     ]).
 2059
 2060
 2061[X] :-
 2062    !,
 2063    consult(X).
 2064[M:F|R] :-
 2065    consult(M:[F|R]).
 2066
 2067consult(M:X) :-
 2068    X == user,
 2069    !,
 2070    flag('$user_consult', N, N+1),
 2071    NN is N + 1,
 2072    atom_concat('user://', NN, Id),
 2073    load_files(M:Id, [stream(user_input), check_script(false), silent(false)]).
 2074consult(List) :-
 2075    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.
 2082load_files(Files) :-
 2083    load_files(Files, []).
 2084load_files(Module:Files, Options) :-
 2085    '$must_be'(list, Options),
 2086    '$load_files'(Files, Module, Options).
 2087
 2088'$load_files'(X, _, _) :-
 2089    var(X),
 2090    !,
 2091    '$instantiation_error'(X).
 2092'$load_files'([], _, _) :- !.
 2093'$load_files'(Id, Module, Options) :-   % load_files(foo, [stream(In)])
 2094    '$option'(stream(_), Options),
 2095    !,
 2096    (   atom(Id)
 2097    ->  '$load_file'(Id, Module, Options)
 2098    ;   throw(error(type_error(atom, Id), _))
 2099    ).
 2100'$load_files'(List, Module, Options) :-
 2101    List = [_|_],
 2102    !,
 2103    '$must_be'(list, List),
 2104    '$load_file_list'(List, Module, Options).
 2105'$load_files'(File, Module, Options) :-
 2106    '$load_one_file'(File, Module, Options).
 2107
 2108'$load_file_list'([], _, _).
 2109'$load_file_list'([File|Rest], Module, Options) :-
 2110    E = error(_,_),
 2111    catch('$load_one_file'(File, Module, Options), E,
 2112          '$print_message'(error, E)),
 2113    '$load_file_list'(Rest, Module, Options).
 2114
 2115
 2116'$load_one_file'(Spec, Module, Options) :-
 2117    atomic(Spec),
 2118    '$option'(expand(Expand), Options, false),
 2119    Expand == true,
 2120    !,
 2121    expand_file_name(Spec, Expanded),
 2122    (   Expanded = [Load]
 2123    ->  true
 2124    ;   Load = Expanded
 2125    ),
 2126    '$load_files'(Load, Module, [expand(false)|Options]).
 2127'$load_one_file'(File, Module, Options) :-
 2128    strip_module(Module:File, Into, PlainFile),
 2129    '$load_file'(PlainFile, Into, Options).
 $noload(+Condition, +FullFile, +Options) is semidet
True of FullFile should not be loaded.
 2136'$noload'(true, _, _) :-
 2137    !,
 2138    fail.
 2139'$noload'(_, FullFile, _Options) :-
 2140    '$time_source_file'(FullFile, Time, system),
 2141    Time > 0.0,
 2142    !.
 2143'$noload'(not_loaded, FullFile, _) :-
 2144    source_file(FullFile),
 2145    !.
 2146'$noload'(changed, Derived, _) :-
 2147    '$derived_source'(_FullFile, Derived, LoadTime),
 2148    time_file(Derived, Modified),
 2149    Modified @=< LoadTime,
 2150    !.
 2151'$noload'(changed, FullFile, Options) :-
 2152    '$time_source_file'(FullFile, LoadTime, user),
 2153    '$modified_id'(FullFile, Modified, Options),
 2154    Modified @=< LoadTime,
 2155    !.
 $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.
 2174'$qlf_file'(Spec, _, Spec, stream, Options) :-
 2175    '$option'(stream(_), Options),      % stream: no choice
 2176    !.
 2177'$qlf_file'(Spec, FullFile, FullFile, compile, _) :-
 2178    '$spec_extension'(Spec, Ext),       % user explicitly specified
 2179    user:prolog_file_type(Ext, prolog),
 2180    !.
 2181'$qlf_file'(Spec, FullFile, LoadFile, Mode, Options) :-
 2182    '$compilation_mode'(database),
 2183    file_name_extension(Base, PlExt, FullFile),
 2184    user:prolog_file_type(PlExt, prolog),
 2185    user:prolog_file_type(QlfExt, qlf),
 2186    file_name_extension(Base, QlfExt, QlfFile),
 2187    (   access_file(QlfFile, read),
 2188        (   '$qlf_out_of_date'(FullFile, QlfFile, Why)
 2189        ->  (   access_file(QlfFile, write)
 2190            ->  print_message(informational,
 2191                              qlf(recompile(Spec, FullFile, QlfFile, Why))),
 2192                Mode = qcompile,
 2193                LoadFile = FullFile
 2194            ;   Why == old,
 2195                current_prolog_flag(home, PlHome),
 2196                sub_atom(FullFile, 0, _, _, PlHome)
 2197            ->  print_message(silent,
 2198                              qlf(system_lib_out_of_date(Spec, QlfFile))),
 2199                Mode = qload,
 2200                LoadFile = QlfFile
 2201            ;   print_message(warning,
 2202                              qlf(can_not_recompile(Spec, QlfFile, Why))),
 2203                Mode = compile,
 2204                LoadFile = FullFile
 2205            )
 2206        ;   Mode = qload,
 2207            LoadFile = QlfFile
 2208        )
 2209    ->  !
 2210    ;   '$qlf_auto'(FullFile, QlfFile, Options)
 2211    ->  !, Mode = qcompile,
 2212        LoadFile = FullFile
 2213    ).
 2214'$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.
 2222'$qlf_out_of_date'(PlFile, QlfFile, Why) :-
 2223    (   access_file(PlFile, read)
 2224    ->  time_file(PlFile, PlTime),
 2225        time_file(QlfFile, QlfTime),
 2226        (   PlTime > QlfTime
 2227        ->  Why = old                   % PlFile is newer
 2228        ;   Error = error(Formal,_),
 2229            catch('$qlf_sources'(QlfFile, _Files), Error, true),
 2230            nonvar(Formal)              % QlfFile is incompatible
 2231        ->  Why = Error
 2232        ;   fail                        % QlfFile is up-to-date and ok
 2233        )
 2234    ;   fail                            % can not read .pl; try .qlf
 2235    ).
 $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.
 2243:- create_prolog_flag(qcompile, false, [type(atom)]). 2244
 2245'$qlf_auto'(PlFile, QlfFile, Options) :-
 2246    (   memberchk(qcompile(QlfMode), Options)
 2247    ->  true
 2248    ;   current_prolog_flag(qcompile, QlfMode),
 2249        \+ '$in_system_dir'(PlFile)
 2250    ),
 2251    (   QlfMode == auto
 2252    ->  true
 2253    ;   QlfMode == large,
 2254        size_file(PlFile, Size),
 2255        Size > 100000
 2256    ),
 2257    access_file(QlfFile, write).
 2258
 2259'$in_system_dir'(PlFile) :-
 2260    current_prolog_flag(home, Home),
 2261    sub_atom(PlFile, 0, _, _, Home).
 2262
 2263'$spec_extension'(File, Ext) :-
 2264    atom(File),
 2265    file_name_extension(_, Ext, File).
 2266'$spec_extension'(Spec, Ext) :-
 2267    compound(Spec),
 2268    arg(1, Spec, Arg),
 2269    '$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:
 2281:- dynamic
 2282    '$resolved_source_path'/2.                  % ?Spec, ?Path
 2283
 2284'$load_file'(File, Module, Options) :-
 2285    \+ memberchk(stream(_), Options),
 2286    user:prolog_load_file(Module:File, Options),
 2287    !.
 2288'$load_file'(File, Module, Options) :-
 2289    memberchk(stream(_), Options),
 2290    !,
 2291    '$assert_load_context_module'(File, Module, Options),
 2292    '$qdo_load_file'(File, File, Module, Options).
 2293'$load_file'(File, Module, Options) :-
 2294    (   '$resolved_source_path'(File, FullFile, Options)
 2295    ->  true
 2296    ;   '$resolve_source_path'(File, FullFile, Options)
 2297    ),
 2298    '$mt_load_file'(File, FullFile, Module, Options).
 $resolved_source_path(+File, -FullFile, +Options) is semidet
True when File has already been resolved to an absolute path.
 2304'$resolved_source_path'(File, FullFile, Options) :-
 2305    '$resolved_source_path'(File, FullFile),
 2306    (   '$source_file_property'(FullFile, from_state, true)
 2307    ;   '$source_file_property'(FullFile, resource, true)
 2308    ;   '$option'(if(If), Options, true),
 2309        '$noload'(If, FullFile, Options)
 2310    ),
 2311    !.
 $resolve_source_path(+File, -FullFile, Options) is det
Resolve a source file specification to an absolute path. May throw existence and other errors.
 2318'$resolve_source_path'(File, FullFile, _Options) :-
 2319    absolute_file_name(File, FullFile,
 2320                       [ file_type(prolog),
 2321                         access(read)
 2322                       ]),
 2323    '$register_resolved_source_path'(File, FullFile).
 2324
 2325
 2326'$register_resolved_source_path'(File, FullFile) :-
 2327    '$resolved_source_path'(File, FullFile),
 2328    !.
 2329'$register_resolved_source_path'(File, FullFile) :-
 2330    compound(File),
 2331    !,
 2332    asserta('$resolved_source_path'(File, FullFile)).
 2333'$register_resolved_source_path'(_, _).
 $translated_source(+Old, +New) is det
Called from loading a QLF state when source files are being renamed.
 2339:- public '$translated_source'/2. 2340'$translated_source'(Old, New) :-
 2341    forall(retract('$resolved_source_path'(File, Old)),
 2342           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.
 2349'$register_resource_file'(FullFile) :-
 2350    (   sub_atom(FullFile, 0, _, _, 'res://')
 2351    ->  '$set_source_file'(FullFile, resource, true)
 2352    ;   true
 2353    ).
 $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.
 2366'$already_loaded'(_File, FullFile, Module, Options) :-
 2367    '$assert_load_context_module'(FullFile, Module, Options),
 2368    '$current_module'(LoadModules, FullFile),
 2369    !,
 2370    (   atom(LoadModules)
 2371    ->  LoadModule = LoadModules
 2372    ;   LoadModules = [LoadModule|_]
 2373    ),
 2374    '$import_from_loaded_module'(LoadModule, Module, Options).
 2375'$already_loaded'(_, _, user, _) :- !.
 2376'$already_loaded'(File, FullFile, Module, Options) :-
 2377    (   '$load_context_module'(FullFile, Module, CtxOptions),
 2378        '$load_ctx_options'(Options, CtxOptions)
 2379    ->  true
 2380    ;   '$load_file'(File, Module, [if(true)|Options])
 2381    ).
 $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.

 2396:- dynamic
 2397    '$loading_file'/3.              % File, Queue, Thread
 2398:- volatile
 2399    '$loading_file'/3. 2400
 2401'$mt_load_file'(File, FullFile, Module, Options) :-
 2402    current_prolog_flag(threads, true),
 2403    !,
 2404    setup_call_cleanup(
 2405        with_mutex('$load_file',
 2406                   '$mt_start_load'(FullFile, Loading, Options)),
 2407        '$mt_do_load'(Loading, File, FullFile, Module, Options),
 2408        '$mt_end_load'(Loading)).
 2409'$mt_load_file'(File, FullFile, Module, Options) :-
 2410    '$option'(if(If), Options, true),
 2411    '$noload'(If, FullFile, Options),
 2412    !,
 2413    '$already_loaded'(File, FullFile, Module, Options).
 2414'$mt_load_file'(File, FullFile, Module, Options) :-
 2415    '$qdo_load_file'(File, FullFile, Module, Options).
 2416
 2417'$mt_start_load'(FullFile, queue(Queue), _) :-
 2418    '$loading_file'(FullFile, Queue, LoadThread),
 2419    \+ thread_self(LoadThread),
 2420    !.
 2421'$mt_start_load'(FullFile, already_loaded, Options) :-
 2422    '$option'(if(If), Options, true),
 2423    '$noload'(If, FullFile, Options),
 2424    !.
 2425'$mt_start_load'(FullFile, Ref, _) :-
 2426    thread_self(Me),
 2427    message_queue_create(Queue),
 2428    assertz('$loading_file'(FullFile, Queue, Me), Ref).
 2429
 2430'$mt_do_load'(queue(Queue), File, FullFile, Module, Options) :-
 2431    !,
 2432    catch(thread_get_message(Queue, _), error(_,_), true),
 2433    '$already_loaded'(File, FullFile, Module, Options).
 2434'$mt_do_load'(already_loaded, File, FullFile, Module, Options) :-
 2435    !,
 2436    '$already_loaded'(File, FullFile, Module, Options).
 2437'$mt_do_load'(_Ref, File, FullFile, Module, Options) :-
 2438    '$assert_load_context_module'(FullFile, Module, Options),
 2439    '$qdo_load_file'(File, FullFile, Module, Options).
 2440
 2441'$mt_end_load'(queue(_)) :- !.
 2442'$mt_end_load'(already_loaded) :- !.
 2443'$mt_end_load'(Ref) :-
 2444    clause('$loading_file'(_, Queue, _), _, Ref),
 2445    erase(Ref),
 2446    thread_send_message(Queue, done),
 2447    message_queue_destroy(Queue).
 $qdo_load_file(+Spec, +FullFile, +ContextModule, +Options) is det
Switch to qcompile mode if requested by the option '$qlf'(+Out)
 2454'$qdo_load_file'(File, FullFile, Module, Options) :-
 2455    '$qdo_load_file2'(File, FullFile, Module, Action, Options),
 2456    '$register_resource_file'(FullFile),
 2457    '$run_initialization'(FullFile, Action, Options).
 2458
 2459'$qdo_load_file2'(File, FullFile, Module, Action, Options) :-
 2460    memberchk('$qlf'(QlfOut), Options),
 2461    '$stage_file'(QlfOut, StageQlf),
 2462    !,
 2463    setup_call_catcher_cleanup(
 2464        '$qstart'(StageQlf, Module, State),
 2465        '$do_load_file'(File, FullFile, Module, Action, Options),
 2466        Catcher,
 2467        '$qend'(State, Catcher, StageQlf, QlfOut)).
 2468'$qdo_load_file2'(File, FullFile, Module, Action, Options) :-
 2469    '$do_load_file'(File, FullFile, Module, Action, Options).
 2470
 2471'$qstart'(Qlf, Module, state(OldMode, OldModule)) :-
 2472    '$qlf_open'(Qlf),
 2473    '$compilation_mode'(OldMode, qlf),
 2474    '$set_source_module'(OldModule, Module).
 2475
 2476'$qend'(state(OldMode, OldModule), Catcher, StageQlf, QlfOut) :-
 2477    '$set_source_module'(_, OldModule),
 2478    '$set_compilation_mode'(OldMode),
 2479    '$qlf_close',
 2480    '$install_staged_file'(Catcher, StageQlf, QlfOut, warn).
 2481
 2482'$set_source_module'(OldModule, Module) :-
 2483    '$current_source_module'(OldModule),
 2484    '$set_source_module'(Module).
 $do_load_file(+Spec, +FullFile, +ContextModule, -Action, +Options) is det
Perform the actual loading.
 2491'$do_load_file'(File, FullFile, Module, Action, Options) :-
 2492    '$option'(derived_from(DerivedFrom), Options, -),
 2493    '$register_derived_source'(FullFile, DerivedFrom),
 2494    '$qlf_file'(File, FullFile, Absolute, Mode, Options),
 2495    (   Mode == qcompile
 2496    ->  qcompile(Module:File, Options)
 2497    ;   '$do_load_file_2'(File, Absolute, Module, Action, Options)
 2498    ).
 2499
 2500'$do_load_file_2'(File, Absolute, Module, Action, Options) :-
 2501    '$source_file_property'(Absolute, number_of_clauses, OldClauses),
 2502    statistics(cputime, OldTime),
 2503
 2504    '$setup_load'(ScopedFlags, OldSandBoxed, OldVerbose, OldAutoLevel, OldXRef,
 2505                  Options),
 2506
 2507    '$compilation_level'(Level),
 2508    '$load_msg_level'(load_file, Level, StartMsgLevel, DoneMsgLevel),
 2509    '$print_message'(StartMsgLevel,
 2510                     load_file(start(Level,
 2511                                     file(File, Absolute)))),
 2512
 2513    (   memberchk(stream(FromStream), Options)
 2514    ->  Input = stream
 2515    ;   Input = source
 2516    ),
 2517
 2518    (   Input == stream,
 2519        (   '$option'(format(qlf), Options, source)
 2520        ->  set_stream(FromStream, file_name(Absolute)),
 2521            '$qload_stream'(FromStream, Module, Action, LM, Options)
 2522        ;   '$consult_file'(stream(Absolute, FromStream, []),
 2523                            Module, Action, LM, Options)
 2524        )
 2525    ->  true
 2526    ;   Input == source,
 2527        file_name_extension(_, Ext, Absolute),
 2528        (   user:prolog_file_type(Ext, qlf),
 2529            E = error(_,_),
 2530            catch('$qload_file'(Absolute, Module, Action, LM, Options),
 2531                  E,
 2532                  print_message(warning, E))
 2533        ->  true
 2534        ;   '$consult_file'(Absolute, Module, Action, LM, Options)
 2535        )
 2536    ->  true
 2537    ;   '$print_message'(error, load_file(failed(File))),
 2538        fail
 2539    ),
 2540
 2541    '$import_from_loaded_module'(LM, Module, Options),
 2542
 2543    '$source_file_property'(Absolute, number_of_clauses, NewClauses),
 2544    statistics(cputime, Time),
 2545    ClausesCreated is NewClauses - OldClauses,
 2546    TimeUsed is Time - OldTime,
 2547
 2548    '$print_message'(DoneMsgLevel,
 2549                     load_file(done(Level,
 2550                                    file(File, Absolute),
 2551                                    Action,
 2552                                    LM,
 2553                                    TimeUsed,
 2554                                    ClausesCreated))),
 2555
 2556    '$restore_load'(ScopedFlags, OldSandBoxed, OldVerbose, OldAutoLevel, OldXRef).
 2557
 2558'$setup_load'(ScopedFlags, OldSandBoxed, OldVerbose, OldAutoLevel, OldXRef,
 2559              Options) :-
 2560    '$save_file_scoped_flags'(ScopedFlags),
 2561    '$set_sandboxed_load'(Options, OldSandBoxed),
 2562    '$set_verbose_load'(Options, OldVerbose),
 2563    '$set_optimise_load'(Options),
 2564    '$update_autoload_level'(Options, OldAutoLevel),
 2565    '$set_no_xref'(OldXRef).
 2566
 2567'$restore_load'(ScopedFlags, OldSandBoxed, OldVerbose, OldAutoLevel, OldXRef) :-
 2568    '$set_autoload_level'(OldAutoLevel),
 2569    set_prolog_flag(xref, OldXRef),
 2570    set_prolog_flag(verbose_load, OldVerbose),
 2571    set_prolog_flag(sandboxed_load, OldSandBoxed),
 2572    '$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.
 2580'$save_file_scoped_flags'(State) :-
 2581    current_predicate(findall/3),          % Not when doing boot compile
 2582    !,
 2583    findall(SavedFlag, '$save_file_scoped_flag'(SavedFlag), State).
 2584'$save_file_scoped_flags'([]).
 2585
 2586'$save_file_scoped_flag'(Flag-Value) :-
 2587    '$file_scoped_flag'(Flag, Default),
 2588    (   current_prolog_flag(Flag, Value)
 2589    ->  true
 2590    ;   Value = Default
 2591    ).
 2592
 2593'$file_scoped_flag'(generate_debug_info, true).
 2594'$file_scoped_flag'(optimise,            false).
 2595'$file_scoped_flag'(xref,                false).
 2596
 2597'$restore_file_scoped_flags'([]).
 2598'$restore_file_scoped_flags'([Flag-Value|T]) :-
 2599    set_prolog_flag(Flag, Value),
 2600    '$restore_file_scoped_flags'(T).
 $import_from_loaded_module(LoadedModule, Module, Options) is det
Import public predicates from LoadedModule into Module
 2607'$import_from_loaded_module'(LoadedModule, Module, Options) :-
 2608    LoadedModule \== Module,
 2609    atom(LoadedModule),
 2610    !,
 2611    '$option'(imports(Import), Options, all),
 2612    '$option'(reexport(Reexport), Options, false),
 2613    '$import_list'(Module, LoadedModule, Import, Reexport).
 2614'$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.
 2622'$set_verbose_load'(Options, Old) :-
 2623    current_prolog_flag(verbose_load, Old),
 2624    (   memberchk(silent(Silent), Options)
 2625    ->  (   '$negate'(Silent, Level0)
 2626        ->  '$load_msg_compat'(Level0, Level)
 2627        ;   Level = Silent
 2628        ),
 2629        set_prolog_flag(verbose_load, Level)
 2630    ;   true
 2631    ).
 2632
 2633'$negate'(true, false).
 2634'$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, -)
 2643'$set_sandboxed_load'(Options, Old) :-
 2644    current_prolog_flag(sandboxed_load, Old),
 2645    (   memberchk(sandboxed(SandBoxed), Options),
 2646        '$enter_sandboxed'(Old, SandBoxed, New),
 2647        New \== Old
 2648    ->  set_prolog_flag(sandboxed_load, New)
 2649    ;   true
 2650    ).
 2651
 2652'$enter_sandboxed'(Old, New, SandBoxed) :-
 2653    (   Old == false, New == true
 2654    ->  SandBoxed = true,
 2655        '$ensure_loaded_library_sandbox'
 2656    ;   Old == true, New == false
 2657    ->  throw(error(permission_error(leave, sandbox, -), _))
 2658    ;   SandBoxed = Old
 2659    ).
 2660'$enter_sandboxed'(false, true, true).
 2661
 2662'$ensure_loaded_library_sandbox' :-
 2663    source_file_property(library(sandbox), module(sandbox)),
 2664    !.
 2665'$ensure_loaded_library_sandbox' :-
 2666    load_files(library(sandbox), [if(not_loaded), silent(true)]).
 2667
 2668'$set_optimise_load'(Options) :-
 2669    (   '$option'(optimise(Optimise), Options)
 2670    ->  set_prolog_flag(optimise, Optimise)
 2671    ;   true
 2672    ).
 2673
 2674'$set_no_xref'(OldXRef) :-
 2675    (   current_prolog_flag(xref, OldXRef)
 2676    ->  true
 2677    ;   OldXRef = false
 2678    ),
 2679    set_prolog_flag(xref, false).
 $update_autoload_level(+Options, -OldLevel)
Update the '$autoload_nesting' and return the old value.
 2686:- thread_local
 2687    '$autoload_nesting'/1. 2688
 2689'$update_autoload_level'(Options, AutoLevel) :-
 2690    '$option'(autoload(Autoload), Options, false),
 2691    (   '$autoload_nesting'(CurrentLevel)
 2692    ->  AutoLevel = CurrentLevel
 2693    ;   AutoLevel = 0
 2694    ),
 2695    (   Autoload == false
 2696    ->  true
 2697    ;   NewLevel is AutoLevel + 1,
 2698        '$set_autoload_level'(NewLevel)
 2699    ).
 2700
 2701'$set_autoload_level'(New) :-
 2702    retractall('$autoload_nesting'(_)),
 2703    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.
 2711'$print_message'(Level, Term) :-
 2712    current_predicate(system:print_message/2),
 2713    !,
 2714    print_message(Level, Term).
 2715'$print_message'(warning, Term) :-
 2716    source_location(File, Line),
 2717    !,
 2718    format(user_error, 'WARNING: ~w:~w: ~p~n', [File, Line, Term]).
 2719'$print_message'(error, Term) :-
 2720    !,
 2721    source_location(File, Line),
 2722    !,
 2723    format(user_error, 'ERROR: ~w:~w: ~p~n', [File, Line, Term]).
 2724'$print_message'(_Level, _Term).
 2725
 2726'$print_message_fail'(E) :-
 2727    '$print_message'(error, E),
 2728    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.
 2736'$consult_file'(Absolute, Module, What, LM, Options) :-
 2737    '$current_source_module'(Module),   % same module
 2738    !,
 2739    '$consult_file_2'(Absolute, Module, What, LM, Options).
 2740'$consult_file'(Absolute, Module, What, LM, Options) :-
 2741    '$set_source_module'(OldModule, Module),
 2742    '$ifcompiling'('$qlf_start_sub_module'(Module)),
 2743    '$consult_file_2'(Absolute, Module, What, LM, Options),
 2744    '$ifcompiling'('$qlf_end_part'),
 2745    '$set_source_module'(OldModule).
 2746
 2747'$consult_file_2'(Absolute, Module, What, LM, Options) :-
 2748    '$set_source_module'(OldModule, Module),
 2749    '$load_id'(Absolute, Id, Modified, Options),
 2750    '$compile_type'(What),
 2751    '$save_lex_state'(LexState, Options),
 2752    '$set_dialect'(Options),
 2753    setup_call_cleanup(
 2754        '$start_consult'(Id, Modified),
 2755        '$load_file'(Absolute, Id, LM, Options),
 2756        '$end_consult'(Id, LexState, OldModule)).
 2757
 2758'$end_consult'(Id, LexState, OldModule) :-
 2759    '$end_consult'(Id),
 2760    '$restore_lex_state'(LexState),
 2761    '$set_source_module'(OldModule).
 2762
 2763
 2764:- create_prolog_flag(emulated_dialect, swi, [type(atom)]).
 $save_lex_state(-LexState, +Options) is det
 2768'$save_lex_state'(State, Options) :-
 2769    memberchk(scope_settings(false), Options),
 2770    !,
 2771    State = (-).
 2772'$save_lex_state'(lexstate(Style, Dialect), _) :-
 2773    '$style_check'(Style, Style),
 2774    current_prolog_flag(emulated_dialect, Dialect).
 2775
 2776'$restore_lex_state'(-) :- !.
 2777'$restore_lex_state'(lexstate(Style, Dialect)) :-
 2778    '$style_check'(_, Style),
 2779    set_prolog_flag(emulated_dialect, Dialect).
 2780
 2781'$set_dialect'(Options) :-
 2782    memberchk(dialect(Dialect), Options),
 2783    !,
 2784    '$expects_dialect'(Dialect).
 2785'$set_dialect'(_).
 2786
 2787'$load_id'(stream(Id, _, _), Id, Modified, Options) :-
 2788    !,
 2789    '$modified_id'(Id, Modified, Options).
 2790'$load_id'(Id, Id, Modified, Options) :-
 2791    '$modified_id'(Id, Modified, Options).
 2792
 2793'$modified_id'(_, Modified, Options) :-
 2794    '$option'(modified(Stamp), Options, Def),
 2795    Stamp \== Def,
 2796    !,
 2797    Modified = Stamp.
 2798'$modified_id'(Id, Modified, _) :-
 2799    catch(time_file(Id, Modified),
 2800          error(_, _),
 2801          fail),
 2802    !.
 2803'$modified_id'(_, 0.0, _).
 2804
 2805
 2806'$compile_type'(What) :-
 2807    '$compilation_mode'(How),
 2808    (   How == database
 2809    ->  What = compiled
 2810    ;   How == qlf
 2811    ->  What = '*qcompiled*'
 2812    ;   What = 'boot compiled'
 2813    ).
 $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.
 2823:- dynamic
 2824    '$load_context_module'/3. 2825:- multifile
 2826    '$load_context_module'/3. 2827
 2828'$assert_load_context_module'(_, _, Options) :-
 2829    memberchk(register(false), Options),
 2830    !.
 2831'$assert_load_context_module'(File, Module, Options) :-
 2832    source_location(FromFile, Line),
 2833    !,
 2834    '$master_file'(FromFile, MasterFile),
 2835    '$check_load_non_module'(File, Module),
 2836    '$add_dialect'(Options, Options1),
 2837    '$load_ctx_options'(Options1, Options2),
 2838    '$store_admin_clause'(
 2839        system:'$load_context_module'(File, Module, Options2),
 2840        _Layout, MasterFile, FromFile:Line).
 2841'$assert_load_context_module'(File, Module, Options) :-
 2842    '$check_load_non_module'(File, Module),
 2843    '$add_dialect'(Options, Options1),
 2844    '$load_ctx_options'(Options1, Options2),
 2845    (   clause('$load_context_module'(File, Module, _), true, Ref),
 2846        \+ clause_property(Ref, file(_)),
 2847        erase(Ref)
 2848    ->  true
 2849    ;   true
 2850    ),
 2851    assertz('$load_context_module'(File, Module, Options2)).
 2852
 2853'$add_dialect'(Options0, Options) :-
 2854    current_prolog_flag(emulated_dialect, Dialect), Dialect \== swi,
 2855    !,
 2856    Options = [dialect(Dialect)|Options0].
 2857'$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.
 2864'$load_ctx_options'(Options, CtxOptions) :-
 2865    '$load_ctx_options2'(Options, CtxOptions0),
 2866    sort(CtxOptions0, CtxOptions).
 2867
 2868'$load_ctx_options2'([], []).
 2869'$load_ctx_options2'([H|T0], [H|T]) :-
 2870    '$load_ctx_option'(H),
 2871    !,
 2872    '$load_ctx_options2'(T0, T).
 2873'$load_ctx_options2'([_|T0], T) :-
 2874    '$load_ctx_options2'(T0, T).
 2875
 2876'$load_ctx_option'(derived_from(_)).
 2877'$load_ctx_option'(dialect(_)).
 2878'$load_ctx_option'(encoding(_)).
 2879'$load_ctx_option'(imports(_)).
 2880'$load_ctx_option'(reexport(_)).
 $check_load_non_module(+File) is det
Test that a non-module file is not loaded into multiple contexts.
 2888'$check_load_non_module'(File, _) :-
 2889    '$current_module'(_, File),
 2890    !.          % File is a module file
 2891'$check_load_non_module'(File, Module) :-
 2892    '$load_context_module'(File, OldModule, _),
 2893    Module \== OldModule,
 2894    !,
 2895    format(atom(Msg),
 2896           'Non-module file already loaded into module ~w; \c
 2897               trying to load into ~w',
 2898           [OldModule, Module]),
 2899    throw(error(permission_error(load, source, File),
 2900                context(load_files/2, Msg))).
 2901'$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)

 2914'$load_file'(Path, Id, Module, Options) :-
 2915    State = state(true, _, true, false, Id, -),
 2916    (   '$source_term'(Path, _Read, _Layout, Term, Layout,
 2917                       _Stream, Options),
 2918        '$valid_term'(Term),
 2919        (   arg(1, State, true)
 2920        ->  '$first_term'(Term, Layout, Id, State, Options),
 2921            nb_setarg(1, State, false)
 2922        ;   '$compile_term'(Term, Layout, Id)
 2923        ),
 2924        arg(4, State, true)
 2925    ;   '$fixup_reconsult'(Id),
 2926        '$end_load_file'(State)
 2927    ),
 2928    !,
 2929    arg(2, State, Module).
 2930
 2931'$valid_term'(Var) :-
 2932    var(Var),
 2933    !,
 2934    print_message(error, error(instantiation_error, _)).
 2935'$valid_term'(Term) :-
 2936    Term \== [].
 2937
 2938'$end_load_file'(State) :-
 2939    arg(1, State, true),           % empty file
 2940    !,
 2941    nb_setarg(2, State, Module),
 2942    arg(5, State, Id),
 2943    '$current_source_module'(Module),
 2944    '$ifcompiling'('$qlf_start_file'(Id)),
 2945    '$ifcompiling'('$qlf_end_part').
 2946'$end_load_file'(State) :-
 2947    arg(3, State, End),
 2948    '$end_load_file'(End, State).
 2949
 2950'$end_load_file'(true, _).
 2951'$end_load_file'(end_module, State) :-
 2952    arg(2, State, Module),
 2953    '$check_export'(Module),
 2954    '$ifcompiling'('$qlf_end_part').
 2955'$end_load_file'(end_non_module, _State) :-
 2956    '$ifcompiling'('$qlf_end_part').
 2957
 2958
 2959'$first_term'(?-(Directive), Layout, Id, State, Options) :-
 2960    !,
 2961    '$first_term'(:-(Directive), Layout, Id, State, Options).
 2962'$first_term'(:-(Directive), _Layout, Id, State, Options) :-
 2963    nonvar(Directive),
 2964    (   (   Directive = module(Name, Public)
 2965        ->  Imports = []
 2966        ;   Directive = module(Name, Public, Imports)
 2967        )
 2968    ->  !,
 2969        '$module_name'(Name, Id, Module, Options),
 2970        '$start_module'(Module, Public, State, Options),
 2971        '$module3'(Imports)
 2972    ;   Directive = expects_dialect(Dialect)
 2973    ->  !,
 2974        '$set_dialect'(Dialect, State),
 2975        fail                        % Still consider next term as first
 2976    ).
 2977'$first_term'(Term, Layout, Id, State, Options) :-
 2978    '$start_non_module'(Id, Term, State, Options),
 2979    '$compile_term'(Term, Layout, Id).
 2980
 2981'$compile_term'(Term, Layout, Id) :-
 2982    '$compile_term'(Term, Layout, Id, -).
 2983
 2984'$compile_term'(Var, _Layout, _Id, _Src) :-
 2985    var(Var),
 2986    !,
 2987    '$instantiation_error'(Var).
 2988'$compile_term'((?-Directive), _Layout, Id, _) :-
 2989    !,
 2990    '$execute_directive'(Directive, Id).
 2991'$compile_term'((:-Directive), _Layout, Id, _) :-
 2992    !,
 2993    '$execute_directive'(Directive, Id).
 2994'$compile_term'('$source_location'(File, Line):Term, Layout, Id, _) :-
 2995    !,
 2996    '$compile_term'(Term, Layout, Id, File:Line).
 2997'$compile_term'(Clause, Layout, Id, SrcLoc) :-
 2998    E = error(_,_),
 2999    catch('$store_clause'(Clause, Layout, Id, SrcLoc), E,
 3000          '$print_message'(error, E)).
 3001
 3002'$start_non_module'(_Id, Term, _State, Options) :-
 3003    '$option'(must_be_module(true), Options, false),
 3004    !,
 3005    '$domain_error'(module_header, Term).
 3006'$start_non_module'(Id, _Term, State, _Options) :-
 3007    '$current_source_module'(Module),
 3008    '$ifcompiling'('$qlf_start_file'(Id)),
 3009    '$qset_dialect'(State),
 3010    nb_setarg(2, State, Module),
 3011    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.

 3024'$set_dialect'(Dialect, State) :-
 3025    '$compilation_mode'(qlf, database),
 3026    !,
 3027    '$expects_dialect'(Dialect),
 3028    '$compilation_mode'(_, qlf),
 3029    nb_setarg(6, State, Dialect).
 3030'$set_dialect'(Dialect, _) :-
 3031    '$expects_dialect'(Dialect).
 3032
 3033'$qset_dialect'(State) :-
 3034    '$compilation_mode'(qlf),
 3035    arg(6, State, Dialect), Dialect \== (-),
 3036    !,
 3037    '$add_directive_wic'('$expects_dialect'(Dialect)).
 3038'$qset_dialect'(_).
 3039
 3040'$expects_dialect'(Dialect) :-
 3041    Dialect == swi,
 3042    !,
 3043    set_prolog_flag(emulated_dialect, Dialect).
 3044'$expects_dialect'(Dialect) :-
 3045    current_predicate(expects_dialect/1),
 3046    !,
 3047    expects_dialect(Dialect).
 3048'$expects_dialect'(Dialect) :-
 3049    use_module(library(dialect), [expects_dialect/1]),
 3050    expects_dialect(Dialect).
 3051
 3052
 3053                 /*******************************
 3054                 *           MODULES            *
 3055                 *******************************/
 3056
 3057'$start_module'(Module, _Public, State, _Options) :-
 3058    '$current_module'(Module, OldFile),
 3059    source_location(File, _Line),
 3060    OldFile \== File, OldFile \== [],
 3061    same_file(OldFile, File),
 3062    !,
 3063    nb_setarg(2, State, Module),
 3064    nb_setarg(4, State, true).      % Stop processing
 3065'$start_module'(Module, Public, State, Options) :-
 3066    arg(5, State, File),
 3067    nb_setarg(2, State, Module),
 3068    source_location(_File, Line),
 3069    '$option'(redefine_module(Action), Options, false),
 3070    '$module_class'(File, Class, Super),
 3071    '$redefine_module'(Module, File, Action),
 3072    '$declare_module'(Module, Class, Super, File, Line, false),
 3073    '$export_list'(Public, Module, Ops),
 3074    '$ifcompiling'('$qlf_start_module'(Module)),
 3075    '$export_ops'(Ops, Module, File),
 3076    '$qset_dialect'(State),
 3077    nb_setarg(3, State, end_module).
 $module3(+Spec) is det
Handle the 3th argument of a module declartion.
 3084'$module3'(Var) :-
 3085    var(Var),
 3086    !,
 3087    '$instantiation_error'(Var).
 3088'$module3'([]) :- !.
 3089'$module3'([H|T]) :-
 3090    !,
 3091    '$module3'(H),
 3092    '$module3'(T).
 3093'$module3'(Id) :-
 3094    use_module(library(dialect/Id)).
 $module_name(?Name, +Id, -Module, +Options) is semidet
Determine the module name. There are some cases:
 3108'$module_name'(_, _, Module, Options) :-
 3109    '$option'(module(Module), Options),
 3110    !,
 3111    '$current_source_module'(Context),
 3112    Context \== Module.                     % cause '$first_term'/5 to fail.
 3113'$module_name'(Var, Id, Module, Options) :-
 3114    var(Var),
 3115    !,
 3116    file_base_name(Id, File),
 3117    file_name_extension(Var, _, File),
 3118    '$module_name'(Var, Id, Module, Options).
 3119'$module_name'(Reserved, _, _, _) :-
 3120    '$reserved_module'(Reserved),
 3121    !,
 3122    throw(error(permission_error(load, module, Reserved), _)).
 3123'$module_name'(Module, _Id, Module, _).
 3124
 3125
 3126'$reserved_module'(system).
 3127'$reserved_module'(user).
 $redefine_module(+Module, +File, -Redefine)
 3132'$redefine_module'(_Module, _, false) :- !.
 3133'$redefine_module'(Module, File, true) :-
 3134    !,
 3135    (   module_property(Module, file(OldFile)),
 3136        File \== OldFile
 3137    ->  unload_file(OldFile)
 3138    ;   true
 3139    ).
 3140'$redefine_module'(Module, File, ask) :-
 3141    (   stream_property(user_input, tty(true)),
 3142        module_property(Module, file(OldFile)),
 3143        File \== OldFile,
 3144        '$rdef_response'(Module, OldFile, File, true)
 3145    ->  '$redefine_module'(Module, File, true)
 3146    ;   true
 3147    ).
 3148
 3149'$rdef_response'(Module, OldFile, File, Ok) :-
 3150    repeat,
 3151    print_message(query, redefine_module(Module, OldFile, File)),
 3152    get_single_char(Char),
 3153    '$rdef_response'(Char, Ok0),
 3154    !,
 3155    Ok = Ok0.
 3156
 3157'$rdef_response'(Char, true) :-
 3158    memberchk(Char, `yY`),
 3159    format(user_error, 'yes~n', []).
 3160'$rdef_response'(Char, false) :-
 3161    memberchk(Char, `nN`),
 3162    format(user_error, 'no~n', []).
 3163'$rdef_response'(Char, _) :-
 3164    memberchk(Char, `a`),
 3165    format(user_error, 'abort~n', []),
 3166    abort.
 3167'$rdef_response'(_, _) :-
 3168    print_message(help, redefine_module_reply),
 3169    fail.
 $module_class(+File, -Class, -Super) is det
Determine the file class and initial module from which File inherits. All boot and library modules as well as the -F script files inherit from system, while all normal user modules inherit from user.
 3179'$module_class'(File, Class, system) :-
 3180    current_prolog_flag(home, Home),
 3181    sub_atom(File, 0, Len, _, Home),
 3182    (   sub_atom(File, Len, _, _, '/boot/')
 3183    ->  Class = system
 3184    ;   '$lib_prefix'(Prefix),
 3185        sub_atom(File, Len, _, _, Prefix)
 3186    ->  Class = library
 3187    ;   file_directory_name(File, Home),
 3188        file_name_extension(_, rc, File)
 3189    ->  Class = library
 3190    ),
 3191    !.
 3192'$module_class'(_, user, user).
 3193
 3194'$lib_prefix'('/library').
 3195'$lib_prefix'('/xpce/prolog/').
 3196
 3197'$check_export'(Module) :-
 3198    '$undefined_export'(Module, UndefList),
 3199    (   '$member'(Undef, UndefList),
 3200        strip_module(Undef, _, Local),
 3201        print_message(error,
 3202                      undefined_export(Module, Local)),
 3203        fail
 3204    ;   true
 3205    ).
 $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).
 3214'$import_list'(_, _, Var, _) :-
 3215    var(Var),
 3216    !,
 3217    throw(error(instantitation_error, _)).
 3218'$import_list'(Target, Source, all, Reexport) :-
 3219    !,
 3220    '$exported_ops'(Source, Import, Predicates),
 3221    '$module_property'(Source, exports(Predicates)),
 3222    '$import_all'(Import, Target, Source, Reexport, weak).
 3223'$import_list'(Target, Source, except(Spec), Reexport) :-
 3224    !,
 3225    '$exported_ops'(Source, Export, Predicates),
 3226    '$module_property'(Source, exports(Predicates)),
 3227    (   is_list(Spec)
 3228    ->  true
 3229    ;   throw(error(type_error(list, Spec), _))
 3230    ),
 3231    '$import_except'(Spec, Export, Import),
 3232    '$import_all'(Import, Target, Source, Reexport, weak).
 3233'$import_list'(Target, Source, Import, Reexport) :-
 3234    !,
 3235    is_list(Import),
 3236    !,
 3237    '$import_all'(Import, Target, Source, Reexport, strong).
 3238'$import_list'(_, _, Import, _) :-
 3239    throw(error(type_error(import_specifier, Import))).
 3240
 3241
 3242'$import_except'([], List, List).
 3243'$import_except'([H|T], List0, List) :-
 3244    '$import_except_1'(H, List0, List1),
 3245    '$import_except'(T, List1, List).
 3246
 3247'$import_except_1'(Var, _, _) :-
 3248    var(Var),
 3249    !,
 3250    throw(error(instantitation_error, _)).
 3251'$import_except_1'(PI as N, List0, List) :-
 3252    '$pi'(PI), atom(N),
 3253    !,
 3254    '$canonical_pi'(PI, CPI),
 3255    '$import_as'(CPI, N, List0, List).
 3256'$import_except_1'(op(P,A,N), List0, List) :-
 3257    !,
 3258    '$remove_ops'(List0, op(P,A,N), List).
 3259'$import_except_1'(PI, List0, List) :-
 3260    '$pi'(PI),
 3261    !,
 3262    '$canonical_pi'(PI, CPI),
 3263    '$select'(P, List0, List),
 3264    '$canonical_pi'(CPI, P),
 3265    !.
 3266'$import_except_1'(Except, _, _) :-
 3267    throw(error(type_error(import_specifier, Except), _)).
 3268
 3269'$import_as'(CPI, N, [PI2|T], [CPI as N|T]) :-
 3270    '$canonical_pi'(PI2, CPI),
 3271    !.
 3272'$import_as'(PI, N, [H|T0], [H|T]) :-
 3273    !,
 3274    '$import_as'(PI, N, T0, T).
 3275'$import_as'(PI, _, _, _) :-
 3276    throw(error(existence_error(export, PI), _)).
 3277
 3278'$pi'(N/A) :- atom(N), integer(A), !.
 3279'$pi'(N//A) :- atom(N), integer(A).
 3280
 3281'$canonical_pi'(N//A0, N/A) :-
 3282    A is A0 + 2.
 3283'$canonical_pi'(PI, PI).
 3284
 3285'$remove_ops'([], _, []).
 3286'$remove_ops'([Op|T0], Pattern, T) :-
 3287    subsumes_term(Pattern, Op),
 3288    !,
 3289    '$remove_ops'(T0, Pattern, T).
 3290'$remove_ops'([H|T0], Pattern, [H|T]) :-
 3291    '$remove_ops'(T0, Pattern, T).
 $import_all(+Import, +Context, +Source, +Reexport, +Strength)
 3296'$import_all'(Import, Context, Source, Reexport, Strength) :-
 3297    '$import_all2'(Import, Context, Source, Imported, ImpOps, Strength),
 3298    (   Reexport == true,
 3299        (   '$list_to_conj'(Imported, Conj)
 3300        ->  export(Context:Conj),
 3301            '$ifcompiling'('$add_directive_wic'(export(Context:Conj)))
 3302        ;   true
 3303        ),
 3304        source_location(File, _Line),
 3305        '$export_ops'(ImpOps, Context, File)
 3306    ;   true
 3307    ).
 $import_all2(+Imports, +Context, +Source, -Imported, -ImpOps, +Strength)
 3311'$import_all2'([], _, _, [], [], _).
 3312'$import_all2'([PI as NewName|Rest], Context, Source,
 3313               [NewName/Arity|Imported], ImpOps, Strength) :-
 3314    !,
 3315    '$canonical_pi'(PI, Name/Arity),
 3316    length(Args, Arity),
 3317    Head =.. [Name|Args],
 3318    NewHead =.. [NewName|Args],
 3319    (   '$get_predicate_attribute'(Source:Head, transparent, 1)
 3320    ->  '$set_predicate_attribute'(Context:NewHead, transparent, true)
 3321    ;   true
 3322    ),
 3323    (   source_location(File, Line)
 3324    ->  E = error(_,_),
 3325        catch('$store_admin_clause'((NewHead :- Source:Head),
 3326                                    _Layout, File, File:Line),
 3327              E, '$print_message'(error, E))
 3328    ;   assertz((NewHead :- !, Source:Head)) % ! avoids problems with
 3329    ),                                       % duplicate load
 3330    '$import_all2'(Rest, Context, Source, Imported, ImpOps, Strength).
 3331'$import_all2'([op(P,A,N)|Rest], Context, Source, Imported,
 3332               [op(P,A,N)|ImpOps], Strength) :-
 3333    !,
 3334    '$import_ops'(Context, Source, op(P,A,N)),
 3335    '$import_all2'(Rest, Context, Source, Imported, ImpOps, Strength).
 3336'$import_all2'([Pred|Rest], Context, Source, [Pred|Imported], ImpOps, Strength) :-
 3337    Error = error(_,_),
 3338    catch(Context:'$import'(Source:Pred, Strength), Error,
 3339          print_message(error, Error)),
 3340    '$ifcompiling'('$import_wic'(Source, Pred, Strength)),
 3341    '$import_all2'(Rest, Context, Source, Imported, ImpOps, Strength).
 3342
 3343
 3344'$list_to_conj'([One], One) :- !.
 3345'$list_to_conj'([H|T], (H,Rest)) :-
 3346    '$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.
 3353'$exported_ops'(Module, Ops, Tail) :-
 3354    '$c_current_predicate'(_, Module:'$exported_op'(_,_,_)),
 3355    !,
 3356    findall(op(P,A,N), Module:'$exported_op'(P,A,N), Ops, Tail).
 3357'$exported_ops'(_, Ops, Ops).
 3358
 3359'$exported_op'(Module, P, A, N) :-
 3360    '$c_current_predicate'(_, Module:'$exported_op'(_,_,_)),
 3361    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.
 3368'$import_ops'(To, From, Pattern) :-
 3369    ground(Pattern),
 3370    !,
 3371    Pattern = op(P,A,N),
 3372    op(P,A,To:N),
 3373    (   '$exported_op'(From, P, A, N)
 3374    ->  true
 3375    ;   print_message(warning, no_exported_op(From, Pattern))
 3376    ).
 3377'$import_ops'(To, From, Pattern) :-
 3378    (   '$exported_op'(From, Pri, Assoc, Name),
 3379        Pattern = op(Pri, Assoc, Name),
 3380        op(Pri, Assoc, To:Name),
 3381        fail
 3382    ;   true
 3383    ).
 $export_list(+Declarations, +Module, -Ops)
Handle the export list of the module declaration for Module associated to File.
 3391'$export_list'(Decls, Module, Ops) :-
 3392    is_list(Decls),
 3393    !,
 3394    '$do_export_list'(Decls, Module, Ops).
 3395'$export_list'(Decls, _, _) :-
 3396    var(Decls),
 3397    throw(error(instantiation_error, _)).
 3398'$export_list'(Decls, _, _) :-
 3399    throw(error(type_error(list, Decls), _)).
 3400
 3401'$do_export_list'([], _, []) :- !.
 3402'$do_export_list'([H|T], Module, Ops) :-
 3403    !,
 3404    E = error(_,_),
 3405    catch('$export1'(H, Module, Ops, Ops1),
 3406          E, ('$print_message'(error, E), Ops = Ops1)),
 3407    '$do_export_list'(T, Module, Ops1).
 3408
 3409'$export1'(Var, _, _, _) :-
 3410    var(Var),
 3411    !,
 3412    throw(error(instantiation_error, _)).
 3413'$export1'(Op, _, [Op|T], T) :-
 3414    Op = op(_,_,_),
 3415    !.
 3416'$export1'(PI0, Module, Ops, Ops) :-
 3417    strip_module(Module:PI0, M, PI),
 3418    (   PI = (_//_)
 3419    ->  non_terminal(M:PI)
 3420    ;   true
 3421    ),
 3422    export(M:PI).
 3423
 3424'$export_ops'([op(Pri, Assoc, Name)|T], Module, File) :-
 3425    E = error(_,_),
 3426    catch(( '$execute_directive'(op(Pri, Assoc, Module:Name), File),
 3427            '$export_op'(Pri, Assoc, Name, Module, File)
 3428          ),
 3429          E, '$print_message'(error, E)),
 3430    '$export_ops'(T, Module, File).
 3431'$export_ops'([], _, _).
 3432
 3433'$export_op'(Pri, Assoc, Name, Module, File) :-
 3434    (   '$get_predicate_attribute'(Module:'$exported_op'(_,_,_), defined, 1)
 3435    ->  true
 3436    ;   '$execute_directive'(discontiguous(Module:'$exported_op'/3), File)
 3437    ),
 3438    '$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.
 3444'$execute_directive'(Goal, F) :-
 3445    '$execute_directive_2'(Goal, F).
 3446
 3447'$execute_directive_2'(encoding(Encoding), _F) :-
 3448    !,
 3449    (   '$load_input'(_F, S)
 3450    ->  set_stream(S, encoding(Encoding))
 3451    ).
 3452'$execute_directive_2'(Goal, _) :-
 3453    \+ '$compilation_mode'(database),
 3454    !,
 3455    '$add_directive_wic2'(Goal, Type),
 3456    (   Type == call                % suspend compiling into .qlf file
 3457    ->  '$compilation_mode'(Old, database),
 3458        setup_call_cleanup(
 3459            '$directive_mode'(OldDir, Old),
 3460            '$execute_directive_3'(Goal),
 3461            ( '$set_compilation_mode'(Old),
 3462              '$set_directive_mode'(OldDir)
 3463            ))
 3464    ;   '$execute_directive_3'(Goal)
 3465    ).
 3466'$execute_directive_2'(Goal, _) :-
 3467    '$execute_directive_3'(Goal).
 3468
 3469'$execute_directive_3'(Goal) :-
 3470    '$current_source_module'(Module),
 3471    '$valid_directive'(Module:Goal),
 3472    !,
 3473    (   '$pattr_directive'(Goal, Module)
 3474    ->  true
 3475    ;   Term = error(_,_),
 3476        catch(Module:Goal, Term, '$exception_in_directive'(Term))
 3477    ->  true
 3478    ;   '$print_message'(warning, goal_failed(directive, Module:Goal)),
 3479        fail
 3480    ).
 3481'$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.
 3490:- multifile prolog:sandbox_allowed_directive/1. 3491:- multifile prolog:sandbox_allowed_clause/1. 3492:- meta_predicate '$valid_directive'(:). 3493
 3494'$valid_directive'(_) :-
 3495    current_prolog_flag(sandboxed_load, false),
 3496    !.
 3497'$valid_directive'(Goal) :-
 3498    Error = error(Formal, _),
 3499    catch(prolog:sandbox_allowed_directive(Goal), Error, true),
 3500    !,
 3501    (   var(Formal)
 3502    ->  true
 3503    ;   print_message(error, Error),
 3504        fail
 3505    ).
 3506'$valid_directive'(Goal) :-
 3507    print_message(error,
 3508                  error(permission_error(execute,
 3509                                         sandboxed_directive,
 3510                                         Goal), _)),
 3511    fail.
 3512
 3513'$exception_in_directive'(Term) :-
 3514    '$print_message'(error, Term),
 3515    fail.
 3516
 3517%       Note that the list, consult and ensure_loaded directives are already
 3518%       handled at compile time and therefore should not go into the
 3519%       intermediate code file.
 3520
 3521'$add_directive_wic2'(Goal, Type) :-
 3522    '$common_goal_type'(Goal, Type),
 3523    !,
 3524    (   Type == load
 3525    ->  true
 3526    ;   '$current_source_module'(Module),
 3527        '$add_directive_wic'(Module:Goal)
 3528    ).
 3529'$add_directive_wic2'(Goal, _) :-
 3530    (   '$compilation_mode'(qlf)    % no problem for qlf files
 3531    ->  true
 3532    ;   print_message(error, mixed_directive(Goal))
 3533    ).
 3534
 3535'$common_goal_type'((A,B), Type) :-
 3536    !,
 3537    '$common_goal_type'(A, Type),
 3538    '$common_goal_type'(B, Type).
 3539'$common_goal_type'((A;B), Type) :-
 3540    !,
 3541    '$common_goal_type'(A, Type),
 3542    '$common_goal_type'(B, Type).
 3543'$common_goal_type'((A->B), Type) :-
 3544    !,
 3545    '$common_goal_type'(A, Type),
 3546    '$common_goal_type'(B, Type).
 3547'$common_goal_type'(Goal, Type) :-
 3548    '$goal_type'(Goal, Type).
 3549
 3550'$goal_type'(Goal, Type) :-
 3551    (   '$load_goal'(Goal)
 3552    ->  Type = load
 3553    ;   Type = call
 3554    ).
 3555
 3556'$load_goal'([_|_]).
 3557'$load_goal'(consult(_)).
 3558'$load_goal'(load_files(_)).
 3559'$load_goal'(load_files(_,Options)) :-
 3560    memberchk(qcompile(QlfMode), Options),
 3561    '$qlf_part_mode'(QlfMode).
 3562'$load_goal'(ensure_loaded(_)) :- '$compilation_mode'(wic).
 3563'$load_goal'(use_module(_))    :- '$compilation_mode'(wic).
 3564'$load_goal'(use_module(_, _)) :- '$compilation_mode'(wic).
 3565
 3566'$qlf_part_mode'(part).
 3567'$qlf_part_mode'(true).                 % compatibility
 3568
 3569
 3570                /********************************
 3571                *        COMPILE A CLAUSE       *
 3572                *********************************/
 $store_admin_clause(+Clause, ?Layout, +Owner, +SrcLoc) is det
Store a clause into the database for administrative purposes. This bypasses sanity checking.
 3579'$store_admin_clause'(Clause, Layout, Owner, SrcLoc) :-
 3580    Owner \== (-),
 3581    !,
 3582    setup_call_cleanup(
 3583        '$start_aux'(Owner, Context),
 3584        '$store_admin_clause2'(Clause, Layout, Owner, SrcLoc),
 3585        '$end_aux'(Owner, Context)).
 3586'$store_admin_clause'(Clause, Layout, File, SrcLoc) :-
 3587    '$store_admin_clause2'(Clause, Layout, File, SrcLoc).
 3588
 3589'$store_admin_clause2'(Clause, _Layout, File, SrcLoc) :-
 3590    (   '$compilation_mode'(database)
 3591    ->  '$record_clause'(Clause, File, SrcLoc)
 3592    ;   '$record_clause'(Clause, File, SrcLoc, Ref),
 3593        '$qlf_assert_clause'(Ref, development)
 3594    ).
 $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.
 3604'$store_clause'((_, _), _, _, _) :-
 3605    !,
 3606    print_message(error, cannot_redefine_comma),
 3607    fail.
 3608'$store_clause'(Clause, _Layout, File, SrcLoc) :-
 3609    '$valid_clause'(Clause),
 3610    !,
 3611    (   '$compilation_mode'(database)
 3612    ->  '$record_clause'(Clause, File, SrcLoc)
 3613    ;   '$record_clause'(Clause, File, SrcLoc, Ref),
 3614        '$qlf_assert_clause'(Ref, development)
 3615    ).
 3616
 3617'$valid_clause'(_) :-
 3618    current_prolog_flag(sandboxed_load, false),
 3619    !.
 3620'$valid_clause'(Clause) :-
 3621    \+ '$cross_module_clause'(Clause),
 3622    !.
 3623'$valid_clause'(Clause) :-
 3624    Error = error(Formal, _),
 3625    catch(prolog:sandbox_allowed_clause(Clause), Error, true),
 3626    !,
 3627    (   var(Formal)
 3628    ->  true
 3629    ;   print_message(error, Error),
 3630        fail
 3631    ).
 3632'$valid_clause'(Clause) :-
 3633    print_message(error,
 3634                  error(permission_error(assert,
 3635                                         sandboxed_clause,
 3636                                         Clause), _)),
 3637    fail.
 3638
 3639'$cross_module_clause'(Clause) :-
 3640    '$head_module'(Clause, Module),
 3641    \+ '$current_source_module'(Module).
 3642
 3643'$head_module'(Var, _) :-
 3644    var(Var), !, fail.
 3645'$head_module'((Head :- _), Module) :-
 3646    '$head_module'(Head, Module).
 3647'$head_module'(Module:_, Module).
 3648
 3649'$clause_source'('$source_location'(File,Line):Clause, Clause, File:Line) :- !.
 3650'$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.
 3657:- public
 3658    '$store_clause'/2. 3659
 3660'$store_clause'(Term, Id) :-
 3661    '$clause_source'(Term, Clause, SrcLoc),
 3662    '$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?
 3683compile_aux_clauses(_Clauses) :-
 3684    current_prolog_flag(xref, true),
 3685    !.
 3686compile_aux_clauses(Clauses) :-
 3687    source_location(File, _Line),
 3688    '$compile_aux_clauses'(Clauses, File).
 3689
 3690'$compile_aux_clauses'(Clauses, File) :-
 3691    setup_call_cleanup(
 3692        '$start_aux'(File, Context),
 3693        '$store_aux_clauses'(Clauses, File),
 3694        '$end_aux'(File, Context)).
 3695
 3696'$store_aux_clauses'(Clauses, File) :-
 3697    is_list(Clauses),
 3698    !,
 3699    forall('$member'(C,Clauses),
 3700           '$compile_term'(C, _Layout, File)).
 3701'$store_aux_clauses'(Clause, File) :-
 3702    '$compile_term'(Clause, _Layout, File).
 3703
 3704
 3705		 /*******************************
 3706		 *            STAGING		*
 3707		 *******************************/
 $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.
 3717'$stage_file'(Target, Stage) :-
 3718    file_directory_name(Target, Dir),
 3719    file_base_name(Target, File),
 3720    current_prolog_flag(pid, Pid),
 3721    format(atom(Stage), '~w/.~w.~d', [Dir,File,Pid]).
 3722
 3723'$install_staged_file'(exit, Staged, Target, error) :-
 3724    !,
 3725    rename_file(Staged, Target).
 3726'$install_staged_file'(exit, Staged, Target, OnError) :-
 3727    !,
 3728    InstallError = error(_,_),
 3729    catch(rename_file(Staged, Target),
 3730          InstallError,
 3731          '$install_staged_error'(OnError, InstallError, Staged, Target)).
 3732'$install_staged_file'(_, Staged, _, _OnError) :-
 3733    E = error(_,_),
 3734    catch(delete_file(Staged), E, true).
 3735
 3736'$install_staged_error'(OnError, Error, Staged, _Target) :-
 3737    E = error(_,_),
 3738    catch(delete_file(Staged), E, true),
 3739    (   OnError = silent
 3740    ->  true
 3741    ;   OnError = fail
 3742    ->  fail
 3743    ;   print_message(warning, Error)
 3744    ).
 3745
 3746
 3747                 /*******************************
 3748                 *             READING          *
 3749                 *******************************/
 3750
 3751:- multifile
 3752    prolog:comment_hook/3.                  % hook for read_clause/3
 3753
 3754
 3755                 /*******************************
 3756                 *       FOREIGN INTERFACE      *
 3757                 *******************************/
 3758
 3759%       call-back from PL_register_foreign().  First argument is the module
 3760%       into which the foreign predicate is loaded and second is a term
 3761%       describing the arguments.
 3762
 3763:- dynamic
 3764    '$foreign_registered'/2. 3765
 3766                 /*******************************
 3767                 *   TEMPORARY TERM EXPANSION   *
 3768                 *******************************/
 3769
 3770% Provide temporary definitions for the boot-loader.  These are replaced
 3771% by the real thing in load.pl
 3772
 3773:- dynamic
 3774    '$expand_goal'/2,
 3775    '$expand_term'/4. 3776
 3777'$expand_goal'(In, In).
 3778'$expand_term'(In, Layout, In, Layout).
 3779
 3780
 3781                 /*******************************
 3782                 *         TYPE SUPPORT         *
 3783                 *******************************/
 3784
 3785'$type_error'(Type, Value) :-
 3786    (   var(Value)
 3787    ->  throw(error(instantiation_error, _))
 3788    ;   throw(error(type_error(Type, Value), _))
 3789    ).
 3790
 3791'$domain_error'(Type, Value) :-
 3792    throw(error(domain_error(Type, Value), _)).
 3793
 3794'$existence_error'(Type, Object) :-
 3795    throw(error(existence_error(Type, Object), _)).
 3796
 3797'$permission_error'(Action, Type, Term) :-
 3798    throw(error(permission_error(Action, Type, Term), _)).
 3799
 3800'$instantiation_error'(_Var) :-
 3801    throw(error(instantiation_error, _)).
 3802
 3803'$uninstantiation_error'(NonVar) :-
 3804    throw(error(uninstantiation_error(NonVar), _)).
 3805
 3806'$must_be'(list, X) :- !,
 3807    '$skip_list'(_, X, Tail),
 3808    (   Tail == []
 3809    ->  true
 3810    ;   '$type_error'(list, Tail)
 3811    ).
 3812'$must_be'(options, X) :- !,
 3813    (   '$is_options'(X)
 3814    ->  true
 3815    ;   '$type_error'(options, X)
 3816    ).
 3817'$must_be'(atom, X) :- !,
 3818    (   atom(X)
 3819    ->  true
 3820    ;   '$type_error'(atom, X)
 3821    ).
 3822'$must_be'(integer, X) :- !,
 3823    (   integer(X)
 3824    ->  true
 3825    ;   '$type_error'(integer, X)
 3826    ).
 3827'$must_be'(between(Low,High), X) :- !,
 3828    (   integer(X)
 3829    ->  (   between(Low, High, X)
 3830        ->  true
 3831        ;   '$domain_error'(between(Low,High), X)
 3832        )
 3833    ;   '$type_error'(integer, X)
 3834    ).
 3835'$must_be'(callable, X) :- !,
 3836    (   callable(X)
 3837    ->  true
 3838    ;   '$type_error'(callable, X)
 3839    ).
 3840'$must_be'(acyclic, X) :- !,
 3841    (   acyclic_term(X)
 3842    ->  true
 3843    ;   '$domain_error'(acyclic_term, X)
 3844    ).
 3845'$must_be'(oneof(Type, Domain, List), X) :- !,
 3846    '$must_be'(Type, X),
 3847    (   memberchk(X, List)
 3848    ->  true
 3849    ;   '$domain_error'(Domain, X)
 3850    ).
 3851'$must_be'(boolean, X) :- !,
 3852    (   (X == true ; X == false)
 3853    ->  true
 3854    ;   '$type_error'(boolean, X)
 3855    ).
 3856'$must_be'(ground, X) :- !,
 3857    (   ground(X)
 3858    ->  true
 3859    ;   '$instantiation_error'(X)
 3860    ).
 3861'$must_be'(filespec, X) :- !,
 3862    (   (   atom(X)
 3863        ;   string(X)
 3864        ;   compound(X),
 3865            compound_name_arity(X, _, 1)
 3866        )
 3867    ->  true
 3868    ;   '$type_error'(filespec, X)
 3869    ).
 3870
 3871% Use for debugging
 3872%'$must_be'(Type, _X) :- format('Unknown $must_be type: ~q~n', [Type]).
 3873
 3874
 3875                /********************************
 3876                *       LIST PROCESSING         *
 3877                *********************************/
 3878
 3879'$member'(El, [H|T]) :-
 3880    '$member_'(T, El, H).
 3881
 3882'$member_'(_, El, El).
 3883'$member_'([H|T], El, _) :-
 3884    '$member_'(T, El, H).
 3885
 3886
 3887'$append'([], L, L).
 3888'$append'([H|T], L, [H|R]) :-
 3889    '$append'(T, L, R).
 3890
 3891'$select'(X, [X|Tail], Tail).
 3892'$select'(Elem, [Head|Tail], [Head|Rest]) :-
 3893    '$select'(Elem, Tail, Rest).
 3894
 3895'$reverse'(L1, L2) :-
 3896    '$reverse'(L1, [], L2).
 3897
 3898'$reverse'([], List, List).
 3899'$reverse'([Head|List1], List2, List3) :-
 3900    '$reverse'(List1, [Head|List2], List3).
 3901
 3902'$delete'([], _, []) :- !.
 3903'$delete'([Elem|Tail], Elem, Result) :-
 3904    !,
 3905    '$delete'(Tail, Elem, Result).
 3906'$delete'([Head|Tail], Elem, [Head|Rest]) :-
 3907    '$delete'(Tail, Elem, Rest).
 3908
 3909'$last'([H|T], Last) :-
 3910    '$last'(T, H, Last).
 3911
 3912'$last'([], Last, Last).
 3913'$last'([H|T], _, Last) :-
 3914    '$last'(T, H, Last).
 length(?List, ?N)
Is true when N is the length of List.
 3921:- '$iso'((length/2)). 3922
 3923length(List, Length) :-
 3924    var(Length),
 3925    !,
 3926    '$skip_list'(Length0, List, Tail),
 3927    (   Tail == []
 3928    ->  Length = Length0                    % +,-
 3929    ;   var(Tail)
 3930    ->  Tail \== Length,                    % avoid length(L,L)
 3931        '$length3'(Tail, Length, Length0)   % -,-
 3932    ;   throw(error(type_error(list, List),
 3933                    context(length/2, _)))
 3934    ).
 3935length(List, Length) :-
 3936    integer(Length),
 3937    Length >= 0,
 3938    !,
 3939    '$skip_list'(Length0, List, Tail),
 3940    (   Tail == []                          % proper list
 3941    ->  Length = Length0
 3942    ;   var(Tail)
 3943    ->  Extra is Length-Length0,
 3944        '$length'(Tail, Extra)
 3945    ;   throw(error(type_error(list, List),
 3946                    context(length/2, _)))
 3947    ).
 3948length(_, Length) :-
 3949    integer(Length),
 3950    !,
 3951    throw(error(domain_error(not_less_than_zero, Length),
 3952                context(length/2, _))).
 3953length(_, Length) :-
 3954    throw(error(type_error(integer, Length),
 3955                context(length/2, _))).
 3956
 3957'$length3'([], N, N).
 3958'$length3'([_|List], N, N0) :-
 3959    N1 is N0+1,
 3960    '$length3'(List, N, N1).
 3961
 3962
 3963                 /*******************************
 3964                 *       OPTION PROCESSING      *
 3965                 *******************************/
 $is_options(@Term) is semidet
True if Term looks like it provides options.
 3971'$is_options'(Map) :-
 3972    is_dict(Map, _),
 3973    !.
 3974'$is_options'(List) :-
 3975    is_list(List),
 3976    (   List == []
 3977    ->  true
 3978    ;   List = [H|_],
 3979        '$is_option'(H, _, _)
 3980    ).
 3981
 3982'$is_option'(Var, _, _) :-
 3983    var(Var), !, fail.
 3984'$is_option'(F, Name, Value) :-
 3985    functor(F, _, 1),
 3986    !,
 3987    F =.. [Name,Value].
 3988'$is_option'(Name=Value, Name, Value).
 $option(?Opt, +Options) is semidet
 3992'$option'(Opt, Options) :-
 3993    is_dict(Options),
 3994    !,
 3995    [Opt] :< Options.
 3996'$option'(Opt, Options) :-
 3997    memberchk(Opt, Options).
 $option(?Opt, +Options, +Default) is det
 4001'$option'(Term, Options, Default) :-
 4002    arg(1, Term, Value),
 4003    functor(Term, Name, 1),
 4004    (   is_dict(Options)
 4005    ->  (   get_dict(Name, Options, GVal)
 4006        ->  Value = GVal
 4007        ;   Value = Default
 4008        )
 4009    ;   functor(Gen, Name, 1),
 4010        arg(1, Gen, GVal),
 4011        (   memberchk(Gen, Options)
 4012        ->  Value = GVal
 4013        ;   Value = Default
 4014        )
 4015    ).
 $select_option(?Opt, +Options, -Rest) is semidet
Select an option from Options.
Arguments:
Rest- is always a map.
 4023'$select_option'(Opt, Options, Rest) :-
 4024    select_dict([Opt], Options, Rest).
 $merge_options(+New, +Default, -Merged) is det
Add/replace options specified in New.
Arguments:
Merged- is always a map.
 4032'$merge_options'(New, Old, Merged) :-
 4033    put_dict(New, Old, Merged).
 4034
 4035
 4036                 /*******************************
 4037                 *   HANDLE TRACER 'L'-COMMAND  *
 4038                 *******************************/
 4039
 4040:- public '$prolog_list_goal'/1. 4041
 4042:- multifile
 4043    user:prolog_list_goal/1. 4044
 4045'$prolog_list_goal'(Goal) :-
 4046    user:prolog_list_goal(Goal),
 4047    !.
 4048'$prolog_list_goal'(Goal) :-
 4049    use_module(library(listing), [listing/1]),
 4050    @(listing(Goal), user).
 4051
 4052
 4053                 /*******************************
 4054                 *             HALT             *
 4055                 *******************************/
 4056
 4057:- '$iso'((halt/0)). 4058
 4059halt :-
 4060    halt(0).
 at_halt(:Goal)
Register Goal to be called if the system halts.
To be done
- : get location into the error message
 4069:- meta_predicate at_halt(0). 4070:- dynamic        system:term_expansion/2, '$at_halt'/2. 4071:- multifile      system:term_expansion/2, '$at_halt'/2. 4072
 4073system:term_expansion((:- at_halt(Goal)),
 4074                      system:'$at_halt'(Module:Goal, File:Line)) :-
 4075    \+ current_prolog_flag(xref, true),
 4076    source_location(File, Line),
 4077    '$current_source_module'(Module).
 4078
 4079at_halt(Goal) :-
 4080    asserta('$at_halt'(Goal, (-):0)).
 4081
 4082:- public '$run_at_halt'/0. 4083
 4084'$run_at_halt' :-
 4085    forall(clause('$at_halt'(Goal, Src), true, Ref),
 4086           ( '$call_at_halt'(Goal, Src),
 4087             erase(Ref)
 4088           )).
 4089
 4090'$call_at_halt'(Goal, _Src) :-
 4091    catch(Goal, E, true),
 4092    !,
 4093    (   var(E)
 4094    ->  true
 4095    ;   subsumes_term(cancel_halt(_), E)
 4096    ->  '$print_message'(informational, E),
 4097        fail
 4098    ;   '$print_message'(error, E)
 4099    ).
 4100'$call_at_halt'(Goal, _Src) :-
 4101    '$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.
 4109cancel_halt(Reason) :-
 4110    throw(cancel_halt(Reason)).
 4111
 4112
 4113                /********************************
 4114                *      LOAD OTHER MODULES       *
 4115                *********************************/
 4116
 4117:- meta_predicate
 4118    '$load_wic_files'(:). 4119
 4120'$load_wic_files'(Files) :-
 4121    Files = Module:_,
 4122    '$execute_directive'('$set_source_module'(OldM, Module), []),
 4123    '$save_lex_state'(LexState, []),
 4124    '$style_check'(_, 0xC7),                % see style_name/2 in syspred.pl
 4125    '$compilation_mode'(OldC, wic),
 4126    consult(Files),
 4127    '$execute_directive'('$set_source_module'(OldM), []),
 4128    '$execute_directive'('$restore_lex_state'(LexState), []),
 4129    '$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.
 4137:- public '$load_additional_boot_files'/0. 4138
 4139'$load_additional_boot_files' :-
 4140    current_prolog_flag(argv, Argv),
 4141    '$get_files_argv'(Argv, Files),
 4142    (   Files \== []
 4143    ->  format('Loading additional boot files~n'),
 4144        '$load_wic_files'(user:Files),
 4145        format('additional boot files loaded~n')
 4146    ;   true
 4147    ).
 4148
 4149'$get_files_argv'([], []) :- !.
 4150'$get_files_argv'(['-c'|Files], Files) :- !.
 4151'$get_files_argv'([_|Rest], Files) :-
 4152    '$get_files_argv'(Rest, Files).
 4153
 4154'$:-'(('$boot_message'('Loading Prolog startup files~n', []),
 4155       source_location(File, _Line),
 4156       file_directory_name(File, Dir),
 4157       atom_concat(Dir, '/load.pl', LoadFile),
 4158       '$load_wic_files'(system:[LoadFile]),
 4159       (   current_prolog_flag(windows, true)
 4160       ->  atom_concat(Dir, '/menu.pl', MenuFile),
 4161           '$load_wic_files'(system:[MenuFile])
 4162       ;   true
 4163       ),
 4164       '$boot_message'('SWI-Prolog boot files loaded~n', []),
 4165       '$compilation_mode'(OldC, wic),
 4166       '$execute_directive'('$set_source_module'(user), []),
 4167       '$set_compilation_mode'(OldC)
 4168      ))