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_predicate_attribute'(M:A, Name, Val).
  167'$set_pattr'(A, M, directive, Attr) :-
  168    !,
  169    Attr =.. [Name,Val],
  170    catch('$set_predicate_attribute'(M:A, Name, Val),
  171          error(E, _),
  172          print_message(error, error(E, context((Name)/1,_)))).
  173
  174'$attr_options'(Var, _, _) :-
  175    var(Var),
  176    !,
  177    '$uninstantiation_error'(Var).
  178'$attr_options'((A,B), Attr0, Attr) :-
  179    !,
  180    '$attr_options'(A, Attr0, Attr1),
  181    '$attr_options'(B, Attr1, Attr).
  182'$attr_options'(Opt, Attr0, Attrs) :-
  183    '$must_be'(ground, Opt),
  184    (   '$attr_option'(Opt, AttrX)
  185    ->  (   is_list(Attr0)
  186        ->  '$join_attrs'(AttrX, Attr0, Attrs)
  187        ;   '$join_attrs'(AttrX, [Attr0], Attrs)
  188        )
  189    ;   '$domain_error'(predicate_option, Opt)
  190    ).
  191
  192'$join_attrs'(Attr, Attrs, Attrs) :-
  193    memberchk(Attr, Attrs),
  194    !.
  195'$join_attrs'(Attr, Attrs, Attrs) :-
  196    Attr =.. [Name,Value],
  197    Gen =.. [Name,Existing],
  198    memberchk(Gen, Attrs),
  199    !,
  200    throw(error(conflict_error(Name, Value, Existing), _)).
  201'$join_attrs'(Attr, Attrs0, Attrs) :-
  202    '$append'(Attrs0, [Attr], Attrs).
  203
  204'$attr_option'(incremental, incremental(true)).
  205'$attr_option'(monotonic, monotonic(true)).
  206'$attr_option'(opaque, incremental(false)).
  207'$attr_option'(abstract(Level0), abstract(Level)) :-
  208    '$table_option'(Level0, Level).
  209'$attr_option'(subgoal_abstract(Level0), subgoal_abstract(Level)) :-
  210    '$table_option'(Level0, Level).
  211'$attr_option'(answer_abstract(Level0), answer_abstract(Level)) :-
  212    '$table_option'(Level0, Level).
  213'$attr_option'(max_answers(Level0), max_answers(Level)) :-
  214    '$table_option'(Level0, Level).
  215'$attr_option'(volatile, volatile(true)).
  216'$attr_option'(multifile, multifile(true)).
  217'$attr_option'(discontiguous, discontiguous(true)).
  218'$attr_option'(shared, thread_local(false)).
  219'$attr_option'(local, thread_local(true)).
  220'$attr_option'(private, thread_local(true)).
  221
  222'$table_option'(Value0, _Value) :-
  223    var(Value0),
  224    !,
  225    '$instantiation_error'(Value0).
  226'$table_option'(Value0, Value) :-
  227    integer(Value0),
  228    Value0 >= 0,
  229    !,
  230    Value = Value0.
  231'$table_option'(off, -1) :-
  232    !.
  233'$table_option'(false, -1) :-
  234    !.
  235'$table_option'(infinite, -1) :-
  236    !.
  237'$table_option'(Value, _) :-
  238    '$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.
  248'$pattr_directive'(dynamic(Spec), M) :-
  249    '$set_pattr'(Spec, M, directive, dynamic(true)).
  250'$pattr_directive'(multifile(Spec), M) :-
  251    '$set_pattr'(Spec, M, directive, multifile(true)).
  252'$pattr_directive'(module_transparent(Spec), M) :-
  253    '$set_pattr'(Spec, M, directive, transparent(true)).
  254'$pattr_directive'(discontiguous(Spec), M) :-
  255    '$set_pattr'(Spec, M, directive, discontiguous(true)).
  256'$pattr_directive'(volatile(Spec), M) :-
  257    '$set_pattr'(Spec, M, directive, volatile(true)).
  258'$pattr_directive'(thread_local(Spec), M) :-
  259    '$set_pattr'(Spec, M, directive, thread_local(true)).
  260'$pattr_directive'(noprofile(Spec), M) :-
  261    '$set_pattr'(Spec, M, directive, noprofile(true)).
  262'$pattr_directive'(public(Spec), M) :-
  263    '$set_pattr'(Spec, M, directive, public(true)).
  264
  265:- '$iso'(((dynamic)/1, (multifile)/1, (discontiguous)/1)).  266
  267
  268                /********************************
  269                *       CALLING, CONTROL        *
  270                *********************************/
  271
  272:- noprofile((call/1,
  273              catch/3,
  274              once/1,
  275              ignore/1,
  276              call_cleanup/2,
  277              call_cleanup/3,
  278              setup_call_cleanup/3,
  279              setup_call_catcher_cleanup/4)).  280
  281:- meta_predicate
  282    ';'(0,0),
  283    ','(0,0),
  284    @(0,+),
  285    call(0),
  286    call(1,?),
  287    call(2,?,?),
  288    call(3,?,?,?),
  289    call(4,?,?,?,?),
  290    call(5,?,?,?,?,?),
  291    call(6,?,?,?,?,?,?),
  292    call(7,?,?,?,?,?,?,?),
  293    not(0),
  294    \+(0),
  295    '->'(0,0),
  296    '*->'(0,0),
  297    once(0),
  298    ignore(0),
  299    catch(0,?,0),
  300    reset(0,?,-),
  301    setup_call_cleanup(0,0,0),
  302    setup_call_catcher_cleanup(0,0,?,0),
  303    call_cleanup(0,0),
  304    call_cleanup(0,?,0),
  305    catch_with_backtrace(0,?,0),
  306    '$meta_call'(0).  307
  308:- '$iso'((call/1, (\+)/1, once/1, (;)/2, (',')/2, (->)/2, catch/3)).  309
  310% The control structures are always compiled, both   if they appear in a
  311% clause body and if they are handed  to   call/1.  The only way to call
  312% these predicates is by means of  call/2..   In  that case, we call the
  313% hole control structure again to get it compiled by call/1 and properly
  314% deal  with  !,  etc.  Another  reason  for  having  these  things   as
  315% predicates is to be able to define   properties for them, helping code
  316% analyzers.
  317
  318(M0:If ; M0:Then) :- !, call(M0:(If ; Then)).
  319(M1:If ; M2:Then) :-    call(M1:(If ; M2:Then)).
  320(G1   , G2)       :-    call((G1   , G2)).
  321(If  -> Then)     :-    call((If  -> Then)).
  322(If *-> Then)     :-    call((If *-> Then)).
  323@(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.

  337'$meta_call'(M:G) :-
  338    prolog_current_choice(Ch),
  339    '$meta_call'(G, M, Ch).
  340
  341'$meta_call'(Var, _, _) :-
  342    var(Var),
  343    !,
  344    '$instantiation_error'(Var).
  345'$meta_call'((A,B), M, Ch) :-
  346    !,
  347    '$meta_call'(A, M, Ch),
  348    '$meta_call'(B, M, Ch).
  349'$meta_call'((I->T;E), M, Ch) :-
  350    !,
  351    (   prolog_current_choice(Ch2),
  352        '$meta_call'(I, M, Ch2)
  353    ->  '$meta_call'(T, M, Ch)
  354    ;   '$meta_call'(E, M, Ch)
  355    ).
  356'$meta_call'((I*->T;E), M, Ch) :-
  357    !,
  358    (   prolog_current_choice(Ch2),
  359        '$meta_call'(I, M, Ch2)
  360    *-> '$meta_call'(T, M, Ch)
  361    ;   '$meta_call'(E, M, Ch)
  362    ).
  363'$meta_call'((I->T), M, Ch) :-
  364    !,
  365    (   prolog_current_choice(Ch2),
  366        '$meta_call'(I, M, Ch2)
  367    ->  '$meta_call'(T, M, Ch)
  368    ).
  369'$meta_call'((I*->T), M, Ch) :-
  370    !,
  371    prolog_current_choice(Ch2),
  372    '$meta_call'(I, M, Ch2),
  373    '$meta_call'(T, M, Ch).
  374'$meta_call'((A;B), M, Ch) :-
  375    !,
  376    (   '$meta_call'(A, M, Ch)
  377    ;   '$meta_call'(B, M, Ch)
  378    ).
  379'$meta_call'(\+(G), M, _) :-
  380    !,
  381    prolog_current_choice(Ch),
  382    \+ '$meta_call'(G, M, Ch).
  383'$meta_call'(call(G), M, _) :-
  384    !,
  385    prolog_current_choice(Ch),
  386    '$meta_call'(G, M, Ch).
  387'$meta_call'(M:G, _, Ch) :-
  388    !,
  389    '$meta_call'(G, M, Ch).
  390'$meta_call'(!, _, Ch) :-
  391    prolog_cut_to(Ch).
  392'$meta_call'(G, M, _Ch) :-
  393    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..
  409:- '$iso'((call/2,
  410           call/3,
  411           call/4,
  412           call/5,
  413           call/6,
  414           call/7,
  415           call/8)).  416
  417call(Goal) :-                           % make these available as predicates
  418    Goal.
  419call(Goal, A) :-
  420    call(Goal, A).
  421call(Goal, A, B) :-
  422    call(Goal, A, B).
  423call(Goal, A, B, C) :-
  424    call(Goal, A, B, C).
  425call(Goal, A, B, C, D) :-
  426    call(Goal, A, B, C, D).
  427call(Goal, A, B, C, D, E) :-
  428    call(Goal, A, B, C, D, E).
  429call(Goal, A, B, C, D, E, F) :-
  430    call(Goal, A, B, C, D, E, F).
  431call(Goal, A, B, C, D, E, F, G) :-
  432    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.
  439not(Goal) :-
  440    \+ Goal.
 \+ :Goal is semidet
Predicate version that allows for meta-calling.
  446\+ Goal :-
  447    \+ Goal.
 once(:Goal) is semidet
ISO predicate, acting as call((Goal, !)).
  453once(Goal) :-
  454    Goal,
  455    !.
 ignore(:Goal) is det
Call Goal, cut choice-points on success and succeed on failure. intended for calling side-effects and proceed on failure.
  462ignore(Goal) :-
  463    Goal,
  464    !.
  465ignore(_Goal).
  466
  467:- '$iso'((false/0)).
 false
Synonym for fail/0, providing a declarative reading.
  473false :-
  474    fail.
 catch(:Goal, +Catcher, :Recover)
ISO compliant exception handling.
  480catch(_Goal, _Catcher, _Recover) :-
  481    '$catch'.                       % Maps to I_CATCH, I_EXITCATCH
 prolog_cut_to(+Choice)
Cut all choice points after Choice
  487prolog_cut_to(_Choice) :-
  488    '$cut'.                         % Maps to I_CUTCHP
 reset(:Goal, ?Ball, -Continue)
Delimited continuation support.
  494reset(_Goal, _Ball, _Cont) :-
  495    '$reset'.
 shift(+Ball)
Shift control back to the enclosing reset/3
  501shift(Ball) :-
  502    '$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.

  516call_continuation([]).
  517call_continuation([TB|Rest]) :-
  518    (   Rest == []
  519    ->  '$call_continuation'(TB)
  520    ;   '$call_continuation'(TB),
  521        call_continuation(Rest)
  522    ).
 catch_with_backtrace(:Goal, ?Ball, :Recover)
As catch/3, but tell library(prolog_stack) to record a backtrace in case of an exception.
  529catch_with_backtrace(Goal, Ball, Recover) :-
  530    catch(Goal, Ball, Recover),
  531    '$no_lco'.
  532
  533'$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.
  543:- public '$recover_and_rethrow'/2.  544
  545'$recover_and_rethrow'(Goal, Exception) :-
  546    call_cleanup(Goal, throw(Exception)),
  547    !.
 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.
  562setup_call_catcher_cleanup(Setup, _Goal, _Catcher, _Cleanup) :-
  563    '$sig_atomic'(Setup),
  564    '$call_cleanup'.
  565
  566setup_call_cleanup(Setup, Goal, Cleanup) :-
  567    setup_call_catcher_cleanup(Setup, Goal, _Catcher, Cleanup).
  568
  569call_cleanup(Goal, Cleanup) :-
  570    setup_call_catcher_cleanup(true, Goal, _Catcher, Cleanup).
  571
  572call_cleanup(Goal, Catcher, Cleanup) :-
  573    setup_call_catcher_cleanup(true, Goal, Catcher, Cleanup).
  574
  575                 /*******************************
  576                 *       INITIALIZATION         *
  577                 *******************************/
  578
  579:- meta_predicate
  580    initialization(0, +).  581
  582:- multifile '$init_goal'/3.  583:- 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.

  609initialization(Goal, When) :-
  610    '$must_be'(oneof(atom, initialization_type,
  611                     [ now,
  612                       after_load,
  613                       restore,
  614                       restore_state,
  615                       prepare_state,
  616                       program,
  617                       main
  618                     ]), When),
  619    '$initialization_context'(Source, Ctx),
  620    '$initialization'(When, Goal, Source, Ctx).
  621
  622'$initialization'(now, Goal, _Source, Ctx) :-
  623    '$run_init_goal'(Goal, Ctx),
  624    '$compile_init_goal'(-, Goal, Ctx).
  625'$initialization'(after_load, Goal, Source, Ctx) :-
  626    (   Source \== (-)
  627    ->  '$compile_init_goal'(Source, Goal, Ctx)
  628    ;   throw(error(context_error(nodirective,
  629                                  initialization(Goal, after_load)),
  630                    _))
  631    ).
  632'$initialization'(restore, Goal, Source, Ctx) :- % deprecated
  633    '$initialization'(restore_state, Goal, Source, Ctx).
  634'$initialization'(restore_state, Goal, _Source, Ctx) :-
  635    (   \+ current_prolog_flag(sandboxed_load, true)
  636    ->  '$compile_init_goal'(-, Goal, Ctx)
  637    ;   '$permission_error'(register, initialization(restore), Goal)
  638    ).
  639'$initialization'(prepare_state, Goal, _Source, Ctx) :-
  640    (   \+ current_prolog_flag(sandboxed_load, true)
  641    ->  '$compile_init_goal'(when(prepare_state), Goal, Ctx)
  642    ;   '$permission_error'(register, initialization(restore), Goal)
  643    ).
  644'$initialization'(program, Goal, _Source, Ctx) :-
  645    (   \+ current_prolog_flag(sandboxed_load, true)
  646    ->  '$compile_init_goal'(when(program), Goal, Ctx)
  647    ;   '$permission_error'(register, initialization(restore), Goal)
  648    ).
  649'$initialization'(main, Goal, _Source, Ctx) :-
  650    (   \+ current_prolog_flag(sandboxed_load, true)
  651    ->  '$compile_init_goal'(when(main), Goal, Ctx)
  652    ;   '$permission_error'(register, initialization(restore), Goal)
  653    ).
  654
  655
  656'$compile_init_goal'(Source, Goal, Ctx) :-
  657    atom(Source),
  658    Source \== (-),
  659    !,
  660    '$store_admin_clause'(system:'$init_goal'(Source, Goal, Ctx),
  661                          _Layout, Source, Ctx).
  662'$compile_init_goal'(Source, Goal, Ctx) :-
  663    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.
  675'$run_initialization'(_, loaded, _) :- !.
  676'$run_initialization'(File, _Action, Options) :-
  677    '$run_initialization'(File, Options).
  678
  679'$run_initialization'(File, Options) :-
  680    setup_call_cleanup(
  681        '$start_run_initialization'(Options, Restore),
  682        '$run_initialization_2'(File),
  683        '$end_run_initialization'(Restore)).
  684
  685'$start_run_initialization'(Options, OldSandBoxed) :-
  686    '$push_input_context'(initialization),
  687    '$set_sandboxed_load'(Options, OldSandBoxed).
  688'$end_run_initialization'(OldSandBoxed) :-
  689    set_prolog_flag(sandboxed_load, OldSandBoxed),
  690    '$pop_input_context'.
  691
  692'$run_initialization_2'(File) :-
  693    (   '$init_goal'(File, Goal, Ctx),
  694        File \= when(_),
  695        '$run_init_goal'(Goal, Ctx),
  696        fail
  697    ;   true
  698    ).
  699
  700'$run_init_goal'(Goal, Ctx) :-
  701    (   catch_with_backtrace('$run_init_goal'(Goal), E,
  702                             '$initialization_error'(E, Goal, Ctx))
  703    ->  true
  704    ;   '$initialization_failure'(Goal, Ctx)
  705    ).
  706
  707:- multifile prolog:sandbox_allowed_goal/1.  708
  709'$run_init_goal'(Goal) :-
  710    current_prolog_flag(sandboxed_load, false),
  711    !,
  712    call(Goal).
  713'$run_init_goal'(Goal) :-
  714    prolog:sandbox_allowed_goal(Goal),
  715    call(Goal).
  716
  717'$initialization_context'(Source, Ctx) :-
  718    (   source_location(File, Line)
  719    ->  Ctx = File:Line,
  720        '$input_context'(Context),
  721        '$top_file'(Context, File, Source)
  722    ;   Ctx = (-),
  723        File = (-)
  724    ).
  725
  726'$top_file'([input(include, F1, _, _)|T], _, F) :-
  727    !,
  728    '$top_file'(T, F1, F).
  729'$top_file'(_, F, F).
  730
  731
  732'$initialization_error'(E, Goal, Ctx) :-
  733    print_message(error, initialization_error(Goal, E, Ctx)).
  734
  735'$initialization_failure'(Goal, Ctx) :-
  736    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
  744:- public '$clear_source_admin'/1.  745
  746'$clear_source_admin'(File) :-
  747    retractall('$init_goal'(_, _, File:_)),
  748    retractall('$load_context_module'(File, _, _)),
  749    retractall('$resolved_source_path'(_, File)).
  750
  751
  752                 /*******************************
  753                 *            STREAM            *
  754                 *******************************/
  755
  756:- '$iso'(stream_property/2).  757stream_property(Stream, Property) :-
  758    nonvar(Stream),
  759    nonvar(Property),
  760    !,
  761    '$stream_property'(Stream, Property).
  762stream_property(Stream, Property) :-
  763    nonvar(Stream),
  764    !,
  765    '$stream_properties'(Stream, Properties),
  766    '$member'(Property, Properties).
  767stream_property(Stream, Property) :-
  768    nonvar(Property),
  769    !,
  770    (   Property = alias(Alias),
  771        atom(Alias)
  772    ->  '$alias_stream'(Alias, Stream)
  773    ;   '$streams_properties'(Property, Pairs),
  774        '$member'(Stream-Property, Pairs)
  775    ).
  776stream_property(Stream, Property) :-
  777    '$streams_properties'(Property, Pairs),
  778    '$member'(Stream-Properties, Pairs),
  779    '$member'(Property, Properties).
  780
  781
  782                /********************************
  783                *            MODULES            *
  784                *********************************/
  785
  786%       '$prefix_module'(+Module, +Context, +Term, -Prefixed)
  787%       Tags `Term' with `Module:' if `Module' is not the context module.
  788
  789'$prefix_module'(Module, Module, Head, Head) :- !.
  790'$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'.
  796default_module(Me, Super) :-
  797    (   atom(Me)
  798    ->  (   var(Super)
  799        ->  '$default_module'(Me, Super)
  800        ;   '$default_module'(Me, Super), !
  801        )
  802    ;   '$type_error'(module, Me)
  803    ).
  804
  805'$default_module'(Me, Me).
  806'$default_module'(Me, Super) :-
  807    import_module(Me, S),
  808    '$default_module'(S, Super).
  809
  810
  811                /********************************
  812                *      TRACE AND EXCEPTIONS     *
  813                *********************************/
  814
  815:- dynamic   user:exception/3.  816:- 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.
  825:- public
  826    '$undefined_procedure'/4.  827
  828'$undefined_procedure'(Module, Name, Arity, Action) :-
  829    '$prefix_module'(Module, user, Name/Arity, Pred),
  830    user:exception(undefined_predicate, Pred, Action0),
  831    !,
  832    Action = Action0.
  833'$undefined_procedure'(Module, Name, Arity, Action) :-
  834    \+ current_prolog_flag(autoload, false),
  835    '$autoload'(Module:Name/Arity),
  836    !,
  837    Action = retry.
  838'$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.
  850'$loading'(Library) :-
  851    current_prolog_flag(threads, true),
  852    '$loading_file'(FullFile, _Queue, _LoadThread),
  853    file_name_extension(Library, _, FullFile),
  854    !.
  855
  856%        handle debugger 'w', 'p' and <N> depth options.
  857
  858'$set_debugger_write_options'(write) :-
  859    !,
  860    create_prolog_flag(debugger_write_options,
  861                       [ quoted(true),
  862                         attributes(dots),
  863                         spacing(next_argument)
  864                       ], []).
  865'$set_debugger_write_options'(print) :-
  866    !,
  867    create_prolog_flag(debugger_write_options,
  868                       [ quoted(true),
  869                         portray(true),
  870                         max_depth(10),
  871                         attributes(portray),
  872                         spacing(next_argument)
  873                       ], []).
  874'$set_debugger_write_options'(Depth) :-
  875    current_prolog_flag(debugger_write_options, Options0),
  876    (   '$select'(max_depth(_), Options0, Options)
  877    ->  true
  878    ;   Options = Options0
  879    ),
  880    create_prolog_flag(debugger_write_options,
  881                       [max_depth(Depth)|Options], []).
  882
  883
  884                /********************************
  885                *        SYSTEM MESSAGES        *
  886                *********************************/
 $confirm(Spec)
Ask the user to confirm a question. Spec is a term as used for print_message/2.
  893'$confirm'(Spec) :-
  894    print_message(query, Spec),
  895    between(0, 5, _),
  896        get_single_char(Answer),
  897        (   '$in_reply'(Answer, 'yYjJ \n')
  898        ->  !,
  899            print_message(query, if_tty([yes-[]]))
  900        ;   '$in_reply'(Answer, 'nN')
  901        ->  !,
  902            print_message(query, if_tty([no-[]])),
  903            fail
  904        ;   print_message(help, query(confirm)),
  905            fail
  906        ).
  907
  908'$in_reply'(Code, Atom) :-
  909    char_code(Char, Code),
  910    sub_atom(Atom, _, _, _, Char),
  911    !.
  912
  913:- dynamic
  914    user:portray/1.  915:- multifile
  916    user:portray/1.  917
  918
  919                 /*******************************
  920                 *       FILE_SEARCH_PATH       *
  921                 *******************************/
  922
  923:- dynamic
  924    user:file_search_path/2,
  925    user:library_directory/1.  926:- multifile
  927    user:file_search_path/2,
  928    user:library_directory/1.  929
  930user:(file_search_path(library, Dir) :-
  931        library_directory(Dir)).
  932user:file_search_path(swi, Home) :-
  933    current_prolog_flag(home, Home).
  934user:file_search_path(swi, Home) :-
  935    current_prolog_flag(shared_home, Home).
  936user:file_search_path(library, app_config(lib)).
  937user:file_search_path(library, swi(library)).
  938user:file_search_path(library, swi(library/clp)).
  939user:file_search_path(foreign, swi(ArchLib)) :-
  940    \+ current_prolog_flag(windows, true),
  941    current_prolog_flag(arch, Arch),
  942    atom_concat('lib/', Arch, ArchLib).
  943user:file_search_path(foreign, swi(SoLib)) :-
  944    (   current_prolog_flag(windows, true)
  945    ->  SoLib = bin
  946    ;   SoLib = lib
  947    ).
  948user:file_search_path(path, Dir) :-
  949    getenv('PATH', Path),
  950    (   current_prolog_flag(windows, true)
  951    ->  atomic_list_concat(Dirs, (;), Path)
  952    ;   atomic_list_concat(Dirs, :, Path)
  953    ),
  954    '$member'(Dir, Dirs).
  955user:file_search_path(user_app_data, Dir) :-
  956    '$xdg_prolog_directory'(data, Dir).
  957user:file_search_path(common_app_data, Dir) :-
  958    '$xdg_prolog_directory'(common_data, Dir).
  959user:file_search_path(user_app_config, Dir) :-
  960    '$xdg_prolog_directory'(config, Dir).
  961user:file_search_path(common_app_config, Dir) :-
  962    '$xdg_prolog_directory'(common_config, Dir).
  963user:file_search_path(app_data, user_app_data('.')).
  964user:file_search_path(app_data, common_app_data('.')).
  965user:file_search_path(app_config, user_app_config('.')).
  966user:file_search_path(app_config, common_app_config('.')).
  967% backward compatibility
  968user:file_search_path(app_preferences, user_app_config('.')).
  969user:file_search_path(user_profile, app_preferences('.')).
  970
  971'$xdg_prolog_directory'(Which, Dir) :-
  972    '$xdg_directory'(Which, XDGDir),
  973    '$make_config_dir'(XDGDir),
  974    '$ensure_slash'(XDGDir, XDGDirS),
  975    atom_concat(XDGDirS, 'swi-prolog', Dir),
  976    '$make_config_dir'(Dir).
  977
  978% config
  979'$xdg_directory'(config, Home) :-
  980    current_prolog_flag(windows, true),
  981    catch(win_folder(appdata, Home), _, fail),
  982    !.
  983'$xdg_directory'(config, Home) :-
  984    getenv('XDG_CONFIG_HOME', Home).
  985'$xdg_directory'(config, Home) :-
  986    expand_file_name('~/.config', [Home]).
  987% data
  988'$xdg_directory'(data, Home) :-
  989    current_prolog_flag(windows, true),
  990    catch(win_folder(local_appdata, Home), _, fail),
  991    !.
  992'$xdg_directory'(data, Home) :-
  993    getenv('XDG_DATA_HOME', Home).
  994'$xdg_directory'(data, Home) :-
  995    expand_file_name('~/.local', [Local]),
  996    '$make_config_dir'(Local),
  997    atom_concat(Local, '/share', Home),
  998    '$make_config_dir'(Home).
  999% common data
 1000'$xdg_directory'(common_data, Dir) :-
 1001    current_prolog_flag(windows, true),
 1002    catch(win_folder(common_appdata, Dir), _, fail),
 1003    !.
 1004'$xdg_directory'(common_data, Dir) :-
 1005    '$existing_dir_from_env_path'('XDG_DATA_DIRS',
 1006                                  [ '/usr/local/share',
 1007                                    '/usr/share'
 1008                                  ],
 1009                                  Dir).
 1010% common config
 1011'$xdg_directory'(common_data, Dir) :-
 1012    current_prolog_flag(windows, true),
 1013    catch(win_folder(common_appdata, Dir), _, fail),
 1014    !.
 1015'$xdg_directory'(common_data, Dir) :-
 1016    '$existing_dir_from_env_path'('XDG_CONFIG_DIRS', ['/etc/xdg'], Dir).
 1017
 1018'$existing_dir_from_env_path'(Env, Defaults, Dir) :-
 1019    (   getenv(Env, Path)
 1020    ->  '$path_sep'(Sep),
 1021        atomic_list_concat(Dirs, Sep, Path)
 1022    ;   Dirs = Defaults
 1023    ),
 1024    '$member'(Dir, Dirs),
 1025    exists_directory(Dir).
 1026
 1027'$path_sep'(Char) :-
 1028    (   current_prolog_flag(windows, true)
 1029    ->  Char = ';'
 1030    ;   Char = ':'
 1031    ).
 1032
 1033'$make_config_dir'(Dir) :-
 1034    exists_directory(Dir),
 1035    !.
 1036'$make_config_dir'(Dir) :-
 1037    file_directory_name(Dir, Parent),
 1038    '$my_file'(Parent),
 1039    catch(make_directory(Dir), _, fail).
 1040
 1041'$ensure_slash'(Dir, DirS) :-
 1042    (   sub_atom(Dir, _, _, 0, /)
 1043    ->  DirS = Dir
 1044    ;   atom_concat(Dir, /, DirS)
 1045    ).
 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?
 1054expand_file_search_path(Spec, Expanded) :-
 1055    catch('$expand_file_search_path'(Spec, Expanded, 0, []),
 1056          loop(Used),
 1057          throw(error(loop_error(Spec), file_search(Used)))).
 1058
 1059'$expand_file_search_path'(Spec, Expanded, N, Used) :-
 1060    functor(Spec, Alias, 1),
 1061    !,
 1062    user:file_search_path(Alias, Exp0),
 1063    NN is N + 1,
 1064    (   NN > 16
 1065    ->  throw(loop(Used))
 1066    ;   true
 1067    ),
 1068    '$expand_file_search_path'(Exp0, Exp1, NN, [Alias=Exp0|Used]),
 1069    arg(1, Spec, Segments),
 1070    '$segments_to_atom'(Segments, File),
 1071    '$make_path'(Exp1, File, Expanded).
 1072'$expand_file_search_path'(Spec, Path, _, _) :-
 1073    '$segments_to_atom'(Spec, Path).
 1074
 1075'$make_path'(Dir, '.', Path) :-
 1076    !,
 1077    Path = Dir.
 1078'$make_path'(Dir, File, Path) :-
 1079    sub_atom(Dir, _, _, 0, /),
 1080    !,
 1081    atom_concat(Dir, File, Path).
 1082'$make_path'(Dir, File, Path) :-
 1083    atomic_list_concat([Dir, /, File], Path).
 1084
 1085
 1086                /********************************
 1087                *         FILE CHECKING         *
 1088                *********************************/
 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.
 1099absolute_file_name(Spec, Options, Path) :-
 1100    '$is_options'(Options),
 1101    \+ '$is_options'(Path),
 1102    !,
 1103    absolute_file_name(Spec, Path, Options).
 1104absolute_file_name(Spec, Path, Options) :-
 1105    '$must_be'(options, Options),
 1106                    % get the valid extensions
 1107    (   '$select_option'(extensions(Exts), Options, Options1)
 1108    ->  '$must_be'(list, Exts)
 1109    ;   '$option'(file_type(Type), Options)
 1110    ->  '$must_be'(atom, Type),
 1111        '$file_type_extensions'(Type, Exts),
 1112        Options1 = Options
 1113    ;   Options1 = Options,
 1114        Exts = ['']
 1115    ),
 1116    '$canonicalise_extensions'(Exts, Extensions),
 1117                    % unless specified otherwise, ask regular file
 1118    (   nonvar(Type)
 1119    ->  Options2 = Options1
 1120    ;   '$merge_options'(_{file_type:regular}, Options1, Options2)
 1121    ),
 1122                    % Det or nondet?
 1123    (   '$select_option'(solutions(Sols), Options2, Options3)
 1124    ->  '$must_be'(oneof(atom, solutions, [first,all]), Sols)
 1125    ;   Sols = first,
 1126        Options3 = Options2
 1127    ),
 1128                    % Errors or not?
 1129    (   '$select_option'(file_errors(FileErrors), Options3, Options4)
 1130    ->  '$must_be'(oneof(atom, file_errors, [error,fail]), FileErrors)
 1131    ;   FileErrors = error,
 1132        Options4 = Options3
 1133    ),
 1134                    % Expand shell patterns?
 1135    (   atomic(Spec),
 1136        '$select_option'(expand(Expand), Options4, Options5),
 1137        '$must_be'(boolean, Expand)
 1138    ->  expand_file_name(Spec, List),
 1139        '$member'(Spec1, List)
 1140    ;   Spec1 = Spec,
 1141        Options5 = Options4
 1142    ),
 1143                    % Search for files
 1144    (   Sols == first
 1145    ->  (   '$chk_file'(Spec1, Extensions, Options5, true, Path)
 1146        ->  !       % also kill choice point of expand_file_name/2
 1147        ;   (   FileErrors == fail
 1148            ->  fail
 1149            ;   '$current_module'('$bags', _File),
 1150                findall(P,
 1151                        '$chk_file'(Spec1, Extensions, [access(exist)],
 1152                                    false, P),
 1153                        Candidates),
 1154                '$abs_file_error'(Spec, Candidates, Options5)
 1155            )
 1156        )
 1157    ;   '$chk_file'(Spec1, Extensions, Options5, false, Path)
 1158    ).
 1159
 1160'$abs_file_error'(Spec, Candidates, Conditions) :-
 1161    '$member'(F, Candidates),
 1162    '$member'(C, Conditions),
 1163    '$file_condition'(C),
 1164    '$file_error'(C, Spec, F, E, Comment),
 1165    !,
 1166    throw(error(E, context(_, Comment))).
 1167'$abs_file_error'(Spec, _, _) :-
 1168    '$existence_error'(source_sink, Spec).
 1169
 1170'$file_error'(file_type(directory), Spec, File, Error, Comment) :-
 1171    \+ exists_directory(File),
 1172    !,
 1173    Error = existence_error(directory, Spec),
 1174    Comment = not_a_directory(File).
 1175'$file_error'(file_type(_), Spec, File, Error, Comment) :-
 1176    exists_directory(File),
 1177    !,
 1178    Error = existence_error(file, Spec),
 1179    Comment = directory(File).
 1180'$file_error'(access(OneOrList), Spec, File, Error, _) :-
 1181    '$one_or_member'(Access, OneOrList),
 1182    \+ access_file(File, Access),
 1183    Error = permission_error(Access, source_sink, Spec).
 1184
 1185'$one_or_member'(Elem, List) :-
 1186    is_list(List),
 1187    !,
 1188    '$member'(Elem, List).
 1189'$one_or_member'(Elem, Elem).
 1190
 1191
 1192'$file_type_extensions'(source, Exts) :-       % SICStus 3.9 compatibility
 1193    !,
 1194    '$file_type_extensions'(prolog, Exts).
 1195'$file_type_extensions'(Type, Exts) :-
 1196    '$current_module'('$bags', _File),
 1197    !,
 1198    findall(Ext, user:prolog_file_type(Ext, Type), Exts0),
 1199    (   Exts0 == [],
 1200        \+ '$ft_no_ext'(Type)
 1201    ->  '$domain_error'(file_type, Type)
 1202    ;   true
 1203    ),
 1204    '$append'(Exts0, [''], Exts).
 1205'$file_type_extensions'(prolog, [pl, '']). % findall is not yet defined ...
 1206
 1207'$ft_no_ext'(txt).
 1208'$ft_no_ext'(executable).
 1209'$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.

 1222:- multifile(user:prolog_file_type/2). 1223:- dynamic(user:prolog_file_type/2). 1224
 1225user:prolog_file_type(pl,       prolog).
 1226user:prolog_file_type(prolog,   prolog).
 1227user:prolog_file_type(qlf,      prolog).
 1228user:prolog_file_type(qlf,      qlf).
 1229user:prolog_file_type(Ext,      executable) :-
 1230    current_prolog_flag(shared_object_extension, Ext).
 1231user:prolog_file_type(dylib,    executable) :-
 1232    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.
 1239'$chk_file'(Spec, _Extensions, _Cond, _Cache, _FullName) :-
 1240    \+ ground(Spec),
 1241    !,
 1242    '$instantiation_error'(Spec).
 1243'$chk_file'(Spec, Extensions, Cond, Cache, FullName) :-
 1244    compound(Spec),
 1245    functor(Spec, _, 1),
 1246    !,
 1247    '$relative_to'(Cond, cwd, CWD),
 1248    '$chk_alias_file'(Spec, Extensions, Cond, Cache, CWD, FullName).
 1249'$chk_file'(Segments, Ext, Cond, Cache, FullName) :-    % allow a/b/...
 1250    \+ atomic(Segments),
 1251    !,
 1252    '$segments_to_atom'(Segments, Atom),
 1253    '$chk_file'(Atom, Ext, Cond, Cache, FullName).
 1254'$chk_file'(File, Exts, Cond, _, FullName) :-
 1255    is_absolute_file_name(File),
 1256    !,
 1257    '$extend_file'(File, Exts, Extended),
 1258    '$file_conditions'(Cond, Extended),
 1259    '$absolute_file_name'(Extended, FullName).
 1260'$chk_file'(File, Exts, Cond, _, FullName) :-
 1261    '$relative_to'(Cond, source, Dir),
 1262    atomic_list_concat([Dir, /, File], AbsFile),
 1263    '$extend_file'(AbsFile, Exts, Extended),
 1264    '$file_conditions'(Cond, Extended),
 1265    !,
 1266    '$absolute_file_name'(Extended, FullName).
 1267'$chk_file'(File, Exts, Cond, _, FullName) :-
 1268    '$extend_file'(File, Exts, Extended),
 1269    '$file_conditions'(Cond, Extended),
 1270    '$absolute_file_name'(Extended, FullName).
 1271
 1272'$segments_to_atom'(Atom, Atom) :-
 1273    atomic(Atom),
 1274    !.
 1275'$segments_to_atom'(Segments, Atom) :-
 1276    '$segments_to_list'(Segments, List, []),
 1277    !,
 1278    atomic_list_concat(List, /, Atom).
 1279
 1280'$segments_to_list'(A/B, H, T) :-
 1281    '$segments_to_list'(A, H, T0),
 1282    '$segments_to_list'(B, T0, T).
 1283'$segments_to_list'(A, [A|T], T) :-
 1284    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.
 1294'$relative_to'(Conditions, Default, Dir) :-
 1295    (   '$option'(relative_to(FileOrDir), Conditions)
 1296    *-> (   exists_directory(FileOrDir)
 1297        ->  Dir = FileOrDir
 1298        ;   atom_concat(Dir, /, FileOrDir)
 1299        ->  true
 1300        ;   file_directory_name(FileOrDir, Dir)
 1301        )
 1302    ;   Default == cwd
 1303    ->  '$cwd'(Dir)
 1304    ;   Default == source
 1305    ->  source_location(ContextFile, _Line),
 1306        file_directory_name(ContextFile, Dir)
 1307    ).
 $chk_alias_file(+Spec, +Exts, +Cond, +Cache, +CWD, -FullFile) is nondet
 1312:- dynamic
 1313    '$search_path_file_cache'/3,    % SHA1, Time, Path
 1314    '$search_path_gc_time'/1.       % Time
 1315:- volatile
 1316    '$search_path_file_cache'/3,
 1317    '$search_path_gc_time'/1. 1318
 1319:- create_prolog_flag(file_search_cache_time, 10, []). 1320
 1321'$chk_alias_file'(Spec, Exts, Cond, true, CWD, FullFile) :-
 1322    !,
 1323    findall(Exp, expand_file_search_path(Spec, Exp), Expansions),
 1324    Cache = cache(Exts, Cond, CWD, Expansions),
 1325    variant_sha1(Spec+Cache, SHA1),
 1326    get_time(Now),
 1327    current_prolog_flag(file_search_cache_time, TimeOut),
 1328    (   '$search_path_file_cache'(SHA1, CachedTime, FullFile),
 1329        CachedTime > Now - TimeOut,
 1330        '$file_conditions'(Cond, FullFile)
 1331    ->  '$search_message'(file_search(cache(Spec, Cond), FullFile))
 1332    ;   '$member'(Expanded, Expansions),
 1333        '$extend_file'(Expanded, Exts, LibFile),
 1334        (   '$file_conditions'(Cond, LibFile),
 1335            '$absolute_file_name'(LibFile, FullFile),
 1336            '$cache_file_found'(SHA1, Now, TimeOut, FullFile)
 1337        ->  '$search_message'(file_search(found(Spec, Cond), FullFile))
 1338        ;   '$search_message'(file_search(tried(Spec, Cond), LibFile)),
 1339            fail
 1340        )
 1341    ).
 1342'$chk_alias_file'(Spec, Exts, Cond, false, _CWD, FullFile) :-
 1343    expand_file_search_path(Spec, Expanded),
 1344    '$extend_file'(Expanded, Exts, LibFile),
 1345    '$file_conditions'(Cond, LibFile),
 1346    '$absolute_file_name'(LibFile, FullFile).
 1347
 1348'$cache_file_found'(_, _, TimeOut, _) :-
 1349    TimeOut =:= 0,
 1350    !.
 1351'$cache_file_found'(SHA1, Now, TimeOut, FullFile) :-
 1352    '$search_path_file_cache'(SHA1, Saved, FullFile),
 1353    !,
 1354    (   Now - Saved < TimeOut/2
 1355    ->  true
 1356    ;   retractall('$search_path_file_cache'(SHA1, _, _)),
 1357        asserta('$search_path_file_cache'(SHA1, Now, FullFile))
 1358    ).
 1359'$cache_file_found'(SHA1, Now, TimeOut, FullFile) :-
 1360    'gc_file_search_cache'(TimeOut),
 1361    asserta('$search_path_file_cache'(SHA1, Now, FullFile)).
 1362
 1363'gc_file_search_cache'(TimeOut) :-
 1364    get_time(Now),
 1365    '$search_path_gc_time'(Last),
 1366    Now-Last < TimeOut/2,
 1367    !.
 1368'gc_file_search_cache'(TimeOut) :-
 1369    get_time(Now),
 1370    retractall('$search_path_gc_time'(_)),
 1371    assertz('$search_path_gc_time'(Now)),
 1372    Before is Now - TimeOut,
 1373    (   '$search_path_file_cache'(SHA1, Cached, FullFile),
 1374        Cached < Before,
 1375        retractall('$search_path_file_cache'(SHA1, Cached, FullFile)),
 1376        fail
 1377    ;   true
 1378    ).
 1379
 1380
 1381'$search_message'(Term) :-
 1382    current_prolog_flag(verbose_file_search, true),
 1383    !,
 1384    print_message(informational, Term).
 1385'$search_message'(_).
 $file_conditions(+Condition, +Path)
Verify Path satisfies Condition.
 1392'$file_conditions'(List, File) :-
 1393    is_list(List),
 1394    !,
 1395    \+ ( '$member'(C, List),
 1396         '$file_condition'(C),
 1397         \+ '$file_condition'(C, File)
 1398       ).
 1399'$file_conditions'(Map, File) :-
 1400    \+ (  get_dict(Key, Map, Value),
 1401          C =.. [Key,Value],
 1402          '$file_condition'(C),
 1403         \+ '$file_condition'(C, File)
 1404       ).
 1405
 1406'$file_condition'(file_type(directory), File) :-
 1407    !,
 1408    exists_directory(File).
 1409'$file_condition'(file_type(_), File) :-
 1410    !,
 1411    \+ exists_directory(File).
 1412'$file_condition'(access(Accesses), File) :-
 1413    !,
 1414    \+ (  '$one_or_member'(Access, Accesses),
 1415          \+ access_file(File, Access)
 1416       ).
 1417
 1418'$file_condition'(exists).
 1419'$file_condition'(file_type(_)).
 1420'$file_condition'(access(_)).
 1421
 1422'$extend_file'(File, Exts, FileEx) :-
 1423    '$ensure_extensions'(Exts, File, Fs),
 1424    '$list_to_set'(Fs, FsSet),
 1425    '$member'(FileEx, FsSet).
 1426
 1427'$ensure_extensions'([], _, []).
 1428'$ensure_extensions'([E|E0], F, [FE|E1]) :-
 1429    file_name_extension(F, E, FE),
 1430    '$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.
 1439'$list_to_set'(List, Set) :-
 1440    '$list_to_set'(List, [], Set).
 1441
 1442'$list_to_set'([], _, []).
 1443'$list_to_set'([H|T], Seen, R) :-
 1444    memberchk(H, Seen),
 1445    !,
 1446    '$list_to_set'(T, R).
 1447'$list_to_set'([H|T], Seen, [H|R]) :-
 1448    '$list_to_set'(T, [H|Seen], R).
 1449
 1450/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
 1451Canonicalise the extension list. Old SWI-Prolog   require  `.pl', etc, which
 1452the Quintus compatibility  requests  `pl'.   This  layer  canonicalises  all
 1453extensions to .ext
 1454- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
 1455
 1456'$canonicalise_extensions'([], []) :- !.
 1457'$canonicalise_extensions'([H|T], [CH|CT]) :-
 1458    !,
 1459    '$must_be'(atom, H),
 1460    '$canonicalise_extension'(H, CH),
 1461    '$canonicalise_extensions'(T, CT).
 1462'$canonicalise_extensions'(E, [CE]) :-
 1463    '$canonicalise_extension'(E, CE).
 1464
 1465'$canonicalise_extension'('', '') :- !.
 1466'$canonicalise_extension'(DotAtom, DotAtom) :-
 1467    sub_atom(DotAtom, 0, _, _, '.'),
 1468    !.
 1469'$canonicalise_extension'(Atom, DotAtom) :-
 1470    atom_concat('.', Atom, DotAtom).
 1471
 1472
 1473                /********************************
 1474                *            CONSULT            *
 1475                *********************************/
 1476
 1477:- dynamic
 1478    user:library_directory/1,
 1479    user:prolog_load_file/2. 1480:- multifile
 1481    user:library_directory/1,
 1482    user:prolog_load_file/2. 1483
 1484:- prompt(_, '|: '). 1485
 1486:- thread_local
 1487    '$compilation_mode_store'/1,    % database, wic, qlf
 1488    '$directive_mode_store'/1.      % database, wic, qlf
 1489:- volatile
 1490    '$compilation_mode_store'/1,
 1491    '$directive_mode_store'/1. 1492
 1493'$compilation_mode'(Mode) :-
 1494    (   '$compilation_mode_store'(Val)
 1495    ->  Mode = Val
 1496    ;   Mode = database
 1497    ).
 1498
 1499'$set_compilation_mode'(Mode) :-
 1500    retractall('$compilation_mode_store'(_)),
 1501    assertz('$compilation_mode_store'(Mode)).
 1502
 1503'$compilation_mode'(Old, New) :-
 1504    '$compilation_mode'(Old),
 1505    (   New == Old
 1506    ->  true
 1507    ;   '$set_compilation_mode'(New)
 1508    ).
 1509
 1510'$directive_mode'(Mode) :-
 1511    (   '$directive_mode_store'(Val)
 1512    ->  Mode = Val
 1513    ;   Mode = database
 1514    ).
 1515
 1516'$directive_mode'(Old, New) :-
 1517    '$directive_mode'(Old),
 1518    (   New == Old
 1519    ->  true
 1520    ;   '$set_directive_mode'(New)
 1521    ).
 1522
 1523'$set_directive_mode'(Mode) :-
 1524    retractall('$directive_mode_store'(_)),
 1525    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.
 1533'$compilation_level'(Level) :-
 1534    '$input_context'(Stack),
 1535    '$compilation_level'(Stack, Level).
 1536
 1537'$compilation_level'([], 0).
 1538'$compilation_level'([Input|T], Level) :-
 1539    (   arg(1, Input, see)
 1540    ->  '$compilation_level'(T, Level)
 1541    ;   '$compilation_level'(T, Level0),
 1542        Level is Level0+1
 1543    ).
 compiling
Is true if SWI-Prolog is generating a state or qlf file or executes a `call' directive while doing this.
 1551compiling :-
 1552    \+ (   '$compilation_mode'(database),
 1553           '$directive_mode'(database)
 1554       ).
 1555
 1556:- meta_predicate
 1557    '$ifcompiling'(0). 1558
 1559'$ifcompiling'(G) :-
 1560    (   '$compilation_mode'(database)
 1561    ->  true
 1562    ;   call(G)
 1563    ).
 1564
 1565                /********************************
 1566                *         READ SOURCE           *
 1567                *********************************/
 $load_msg_level(+Action, +NestingLevel, -StartVerbose, -EndVerbose)
 1571'$load_msg_level'(Action, Nesting, Start, Done) :-
 1572    '$update_autoload_level'([], 0),
 1573    !,
 1574    current_prolog_flag(verbose_load, Type0),
 1575    '$load_msg_compat'(Type0, Type),
 1576    (   '$load_msg_level'(Action, Nesting, Type, Start, Done)
 1577    ->  true
 1578    ).
 1579'$load_msg_level'(_, _, silent, silent).
 1580
 1581'$load_msg_compat'(true, normal) :- !.
 1582'$load_msg_compat'(false, silent) :- !.
 1583'$load_msg_compat'(X, X).
 1584
 1585'$load_msg_level'(load_file,    _, full,   informational, informational).
 1586'$load_msg_level'(include_file, _, full,   informational, informational).
 1587'$load_msg_level'(load_file,    _, normal, silent,        informational).
 1588'$load_msg_level'(include_file, _, normal, silent,        silent).
 1589'$load_msg_level'(load_file,    0, brief,  silent,        informational).
 1590'$load_msg_level'(load_file,    _, brief,  silent,        silent).
 1591'$load_msg_level'(include_file, _, brief,  silent,        silent).
 1592'$load_msg_level'(load_file,    _, silent, silent,        silent).
 1593'$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)
 1616'$source_term'(From, Read, RLayout, Term, TLayout, Stream, Options) :-
 1617    '$source_term'(From, Read, RLayout, Term, TLayout, Stream, [], Options),
 1618    (   Term == end_of_file
 1619    ->  !, fail
 1620    ;   Term \== begin_of_file
 1621    ).
 1622
 1623'$source_term'(Input, _,_,_,_,_,_,_) :-
 1624    \+ ground(Input),
 1625    !,
 1626    '$instantiation_error'(Input).
 1627'$source_term'(stream(Id, In, Opts),
 1628               Read, RLayout, Term, TLayout, Stream, Parents, Options) :-
 1629    !,
 1630    '$record_included'(Parents, Id, Id, 0.0, Message),
 1631    setup_call_cleanup(
 1632        '$open_source'(stream(Id, In, Opts), In, State, Parents, Options),
 1633        '$term_in_file'(In, Read, RLayout, Term, TLayout, Stream,
 1634                        [Id|Parents], Options),
 1635        '$close_source'(State, Message)).
 1636'$source_term'(File,
 1637               Read, RLayout, Term, TLayout, Stream, Parents, Options) :-
 1638    absolute_file_name(File, Path,
 1639                       [ file_type(prolog),
 1640                         access(read)
 1641                       ]),
 1642    time_file(Path, Time),
 1643    '$record_included'(Parents, File, Path, Time, Message),
 1644    setup_call_cleanup(
 1645        '$open_source'(Path, In, State, Parents, Options),
 1646        '$term_in_file'(In, Read, RLayout, Term, TLayout, Stream,
 1647                        [Path|Parents], Options),
 1648        '$close_source'(State, Message)).
 1649
 1650:- thread_local
 1651    '$load_input'/2. 1652:- volatile
 1653    '$load_input'/2. 1654
 1655'$open_source'(stream(Id, In, Opts), In,
 1656               restore(In, StreamState, Id, Ref, Opts), Parents, _Options) :-
 1657    !,
 1658    '$context_type'(Parents, ContextType),
 1659    '$push_input_context'(ContextType),
 1660    '$prepare_load_stream'(In, Id, StreamState),
 1661    asserta('$load_input'(stream(Id), In), Ref).
 1662'$open_source'(Path, In, close(In, Path, Ref), Parents, Options) :-
 1663    '$context_type'(Parents, ContextType),
 1664    '$push_input_context'(ContextType),
 1665    '$open_source'(Path, In, Options),
 1666    '$set_encoding'(In, Options),
 1667    asserta('$load_input'(Path, In), Ref).
 1668
 1669'$context_type'([], load_file) :- !.
 1670'$context_type'(_, include).
 1671
 1672:- multifile prolog:open_source_hook/3. 1673
 1674'$open_source'(Path, In, Options) :-
 1675    prolog:open_source_hook(Path, In, Options),
 1676    !.
 1677'$open_source'(Path, In, _Options) :-
 1678    open(Path, read, In).
 1679
 1680'$close_source'(close(In, _Id, Ref), Message) :-
 1681    erase(Ref),
 1682    call_cleanup(
 1683        close(In),
 1684        '$pop_input_context'),
 1685    '$close_message'(Message).
 1686'$close_source'(restore(In, StreamState, _Id, Ref, Opts), Message) :-
 1687    erase(Ref),
 1688    call_cleanup(
 1689        '$restore_load_stream'(In, StreamState, Opts),
 1690        '$pop_input_context'),
 1691    '$close_message'(Message).
 1692
 1693'$close_message'(message(Level, Msg)) :-
 1694    !,
 1695    '$print_message'(Level, Msg).
 1696'$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.
 1708'$term_in_file'(In, Read, RLayout, Term, TLayout, Stream, Parents, Options) :-
 1709    Parents \= [_,_|_],
 1710    (   '$load_input'(_, Input)
 1711    ->  stream_property(Input, file_name(File))
 1712    ),
 1713    '$set_source_location'(File, 0),
 1714    '$expanded_term'(In,
 1715                     begin_of_file, 0-0, Read, RLayout, Term, TLayout,
 1716                     Stream, Parents, Options).
 1717'$term_in_file'(In, Read, RLayout, Term, TLayout, Stream, Parents, Options) :-
 1718    '$skip_script_line'(In, Options),
 1719    '$read_clause_options'(Options, ReadOptions),
 1720    repeat,
 1721      read_clause(In, Raw,
 1722                  [ variable_names(Bindings),
 1723                    term_position(Pos),
 1724                    subterm_positions(RawLayout)
 1725                  | ReadOptions
 1726                  ]),
 1727      b_setval('$term_position', Pos),
 1728      b_setval('$variable_names', Bindings),
 1729      (   Raw == end_of_file
 1730      ->  !,
 1731          (   Parents = [_,_|_]     % Included file
 1732          ->  fail
 1733          ;   '$expanded_term'(In,
 1734                               Raw, RawLayout, Read, RLayout, Term, TLayout,
 1735                               Stream, Parents, Options)
 1736          )
 1737      ;   '$expanded_term'(In, Raw, RawLayout, Read, RLayout, Term, TLayout,
 1738                           Stream, Parents, Options)
 1739      ).
 1740
 1741'$read_clause_options'([], []).
 1742'$read_clause_options'([H|T0], List) :-
 1743    (   '$read_clause_option'(H)
 1744    ->  List = [H|T]
 1745    ;   List = T
 1746    ),
 1747    '$read_clause_options'(T0, T).
 1748
 1749'$read_clause_option'(syntax_errors(_)).
 1750'$read_clause_option'(term_position(_)).
 1751'$read_clause_option'(process_comment(_)).
 1752
 1753'$expanded_term'(In, Raw, RawLayout, Read, RLayout, Term, TLayout,
 1754                 Stream, Parents, Options) :-
 1755    E = error(_,_),
 1756    catch('$expand_term'(Raw, RawLayout, Expanded, ExpandedLayout), E,
 1757          '$print_message_fail'(E)),
 1758    (   Expanded \== []
 1759    ->  '$expansion_member'(Expanded, ExpandedLayout, Term1, Layout1)
 1760    ;   Term1 = Expanded,
 1761        Layout1 = ExpandedLayout
 1762    ),
 1763    (   nonvar(Term1), Term1 = (:-Directive), nonvar(Directive)
 1764    ->  (   Directive = include(File),
 1765            '$current_source_module'(Module),
 1766            '$valid_directive'(Module:include(File))
 1767        ->  stream_property(In, encoding(Enc)),
 1768            '$add_encoding'(Enc, Options, Options1),
 1769            '$source_term'(File, Read, RLayout, Term, TLayout,
 1770                           Stream, Parents, Options1)
 1771        ;   Directive = encoding(Enc)
 1772        ->  set_stream(In, encoding(Enc)),
 1773            fail
 1774        ;   Term = Term1,
 1775            Stream = In,
 1776            Read = Raw
 1777        )
 1778    ;   Term = Term1,
 1779        TLayout = Layout1,
 1780        Stream = In,
 1781        Read = Raw,
 1782        RLayout = RawLayout
 1783    ).
 1784
 1785'$expansion_member'(Var, Layout, Var, Layout) :-
 1786    var(Var),
 1787    !.
 1788'$expansion_member'([], _, _, _) :- !, fail.
 1789'$expansion_member'(List, ListLayout, Term, Layout) :-
 1790    is_list(List),
 1791    !,
 1792    (   var(ListLayout)
 1793    ->  '$member'(Term, List)
 1794    ;   is_list(ListLayout)
 1795    ->  '$member_rep2'(Term, Layout, List, ListLayout)
 1796    ;   Layout = ListLayout,
 1797        '$member'(Term, List)
 1798    ).
 1799'$expansion_member'(X, Layout, X, Layout).
 1800
 1801% pairwise member, repeating last element of the second
 1802% list.
 1803
 1804'$member_rep2'(H1, H2, [H1|_], [H2|_]).
 1805'$member_rep2'(H1, H2, [_|T1], [T2]) :-
 1806    !,
 1807    '$member_rep2'(H1, H2, T1, [T2]).
 1808'$member_rep2'(H1, H2, [_|T1], [_|T2]) :-
 1809    '$member_rep2'(H1, H2, T1, T2).
 $add_encoding(+Enc, +Options0, -Options)
 1813'$add_encoding'(Enc, Options0, Options) :-
 1814    (   Options0 = [encoding(Enc)|_]
 1815    ->  Options = Options0
 1816    ;   Options = [encoding(Enc)|Options0]
 1817    ).
 1818
 1819
 1820:- multifile
 1821    '$included'/4.                  % Into, Line, File, LastModified
 1822:- dynamic
 1823    '$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'.

 1837'$record_included'([Parent|Parents], File, Path, Time,
 1838                   message(DoneMsgLevel,
 1839                           include_file(done(Level, file(File, Path))))) :-
 1840    source_location(SrcFile, Line),
 1841    !,
 1842    '$compilation_level'(Level),
 1843    '$load_msg_level'(include_file, Level, StartMsgLevel, DoneMsgLevel),
 1844    '$print_message'(StartMsgLevel,
 1845                     include_file(start(Level,
 1846                                        file(File, Path)))),
 1847    '$last'([Parent|Parents], Owner),
 1848    (   (   '$compilation_mode'(database)
 1849        ;   '$qlf_current_source'(Owner)
 1850        )
 1851    ->  '$store_admin_clause'(
 1852            system:'$included'(Parent, Line, Path, Time),
 1853            _, Owner, SrcFile:Line)
 1854    ;   '$qlf_include'(Owner, Parent, Line, Path, Time)
 1855    ).
 1856'$record_included'(_, _, _, _, true).
 $master_file(+File, -MasterFile)
Find the primary load file from included files.
 1862'$master_file'(File, MasterFile) :-
 1863    '$included'(MasterFile0, _Line, File, _Time),
 1864    !,
 1865    '$master_file'(MasterFile0, MasterFile).
 1866'$master_file'(File, File).
 1867
 1868
 1869'$skip_script_line'(_In, Options) :-
 1870    '$option'(check_script(false), Options),
 1871    !.
 1872'$skip_script_line'(In, _Options) :-
 1873    (   peek_char(In, #)
 1874    ->  skip(In, 10)
 1875    ;   true
 1876    ).
 1877
 1878'$set_encoding'(Stream, Options) :-
 1879    '$option'(encoding(Enc), Options),
 1880    !,
 1881    Enc \== default,
 1882    set_stream(Stream, encoding(Enc)).
 1883'$set_encoding'(_, _).
 1884
 1885
 1886'$prepare_load_stream'(In, Id, state(HasName,HasPos)) :-
 1887    (   stream_property(In, file_name(_))
 1888    ->  HasName = true,
 1889        (   stream_property(In, position(_))
 1890        ->  HasPos = true
 1891        ;   HasPos = false,
 1892            set_stream(In, record_position(true))
 1893        )
 1894    ;   HasName = false,
 1895        set_stream(In, file_name(Id)),
 1896        (   stream_property(In, position(_))
 1897        ->  HasPos = true
 1898        ;   HasPos = false,
 1899            set_stream(In, record_position(true))
 1900        )
 1901    ).
 1902
 1903'$restore_load_stream'(In, _State, Options) :-
 1904    memberchk(close(true), Options),
 1905    !,
 1906    close(In).
 1907'$restore_load_stream'(In, state(HasName, HasPos), _Options) :-
 1908    (   HasName == false
 1909    ->  set_stream(In, file_name(''))
 1910    ;   true
 1911    ),
 1912    (   HasPos == false
 1913    ->  set_stream(In, record_position(false))
 1914    ;   true
 1915    ).
 1916
 1917
 1918                 /*******************************
 1919                 *          DERIVED FILES       *
 1920                 *******************************/
 1921
 1922:- dynamic
 1923    '$derived_source_db'/3.         % Loaded, DerivedFrom, Time
 1924
 1925'$register_derived_source'(_, '-') :- !.
 1926'$register_derived_source'(Loaded, DerivedFrom) :-
 1927    retractall('$derived_source_db'(Loaded, _, _)),
 1928    time_file(DerivedFrom, Time),
 1929    assert('$derived_source_db'(Loaded, DerivedFrom, Time)).
 1930
 1931%       Auto-importing dynamic predicates is not very elegant and
 1932%       leads to problems with qsave_program/[1,2]
 1933
 1934'$derived_source'(Loaded, DerivedFrom, Time) :-
 1935    '$derived_source_db'(Loaded, DerivedFrom, Time).
 1936
 1937
 1938                /********************************
 1939                *       LOAD PREDICATES         *
 1940                *********************************/
 1941
 1942:- meta_predicate
 1943    ensure_loaded(:),
 1944    [:|+],
 1945    consult(:),
 1946    use_module(:),
 1947    use_module(:, +),
 1948    reexport(:),
 1949    reexport(:, +),
 1950    load_files(:),
 1951    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.
 1959ensure_loaded(Files) :-
 1960    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.
 1969use_module(Files) :-
 1970    load_files(Files, [ if(not_loaded),
 1971                        must_be_module(true)
 1972                      ]).
 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.
 1979use_module(File, Import) :-
 1980    load_files(File, [ if(not_loaded),
 1981                       must_be_module(true),
 1982                       imports(Import)
 1983                     ]).
 reexport(+Files)
As use_module/1, exporting all imported predicates.
 1989reexport(Files) :-
 1990    load_files(Files, [ if(not_loaded),
 1991                        must_be_module(true),
 1992                        reexport(true)
 1993                      ]).
 reexport(+File, +ImportList)
As use_module/1, re-exporting all imported predicates.
 1999reexport(File, Import) :-
 2000    load_files(File, [ if(not_loaded),
 2001                       must_be_module(true),
 2002                       imports(Import),
 2003                       reexport(true)
 2004                     ]).
 2005
 2006
 2007[X] :-
 2008    !,
 2009    consult(X).
 2010[M:F|R] :-
 2011    consult(M:[F|R]).
 2012
 2013consult(M:X) :-
 2014    X == user,
 2015    !,
 2016    flag('$user_consult', N, N+1),
 2017    NN is N + 1,
 2018    atom_concat('user://', NN, Id),
 2019    load_files(M:Id, [stream(user_input), check_script(false), silent(false)]).
 2020consult(List) :-
 2021    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.
 2028load_files(Files) :-
 2029    load_files(Files, []).
 2030load_files(Module:Files, Options) :-
 2031    '$must_be'(list, Options),
 2032    '$load_files'(Files, Module, Options).
 2033
 2034'$load_files'(X, _, _) :-
 2035    var(X),
 2036    !,
 2037    '$instantiation_error'(X).
 2038'$load_files'([], _, _) :- !.
 2039'$load_files'(Id, Module, Options) :-   % load_files(foo, [stream(In)])
 2040    '$option'(stream(_), Options),
 2041    !,
 2042    (   atom(Id)
 2043    ->  '$load_file'(Id, Module, Options)
 2044    ;   throw(error(type_error(atom, Id), _))
 2045    ).
 2046'$load_files'(List, Module, Options) :-
 2047    List = [_|_],
 2048    !,
 2049    '$must_be'(list, List),
 2050    '$load_file_list'(List, Module, Options).
 2051'$load_files'(File, Module, Options) :-
 2052    '$load_one_file'(File, Module, Options).
 2053
 2054'$load_file_list'([], _, _).
 2055'$load_file_list'([File|Rest], Module, Options) :-
 2056    E = error(_,_),
 2057    catch('$load_one_file'(File, Module, Options), E,
 2058          '$print_message'(error, E)),
 2059    '$load_file_list'(Rest, Module, Options).
 2060
 2061
 2062'$load_one_file'(Spec, Module, Options) :-
 2063    atomic(Spec),
 2064    '$option'(expand(Expand), Options, false),
 2065    Expand == true,
 2066    !,
 2067    expand_file_name(Spec, Expanded),
 2068    (   Expanded = [Load]
 2069    ->  true
 2070    ;   Load = Expanded
 2071    ),
 2072    '$load_files'(Load, Module, [expand(false)|Options]).
 2073'$load_one_file'(File, Module, Options) :-
 2074    strip_module(Module:File, Into, PlainFile),
 2075    '$load_file'(PlainFile, Into, Options).
 $noload(+Condition, +FullFile, +Options) is semidet
True of FullFile should not be loaded.
 2082'$noload'(true, _, _) :-
 2083    !,
 2084    fail.
 2085'$noload'(_, FullFile, _Options) :-
 2086    '$time_source_file'(FullFile, Time, system),
 2087    Time > 0.0,
 2088    !.
 2089'$noload'(not_loaded, FullFile, _) :-
 2090    source_file(FullFile),
 2091    !.
 2092'$noload'(changed, Derived, _) :-
 2093    '$derived_source'(_FullFile, Derived, LoadTime),
 2094    time_file(Derived, Modified),
 2095    Modified @=< LoadTime,
 2096    !.
 2097'$noload'(changed, FullFile, Options) :-
 2098    '$time_source_file'(FullFile, LoadTime, user),
 2099    '$modified_id'(FullFile, Modified, Options),
 2100    Modified @=< LoadTime,
 2101    !.
 $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.
 2120'$qlf_file'(Spec, _, Spec, stream, Options) :-
 2121    '$option'(stream(_), Options),      % stream: no choice
 2122    !.
 2123'$qlf_file'(Spec, FullFile, FullFile, compile, _) :-
 2124    '$spec_extension'(Spec, Ext),       % user explicitly specified
 2125    user:prolog_file_type(Ext, prolog),
 2126    !.
 2127'$qlf_file'(Spec, FullFile, LoadFile, Mode, Options) :-
 2128    '$compilation_mode'(database),
 2129    file_name_extension(Base, PlExt, FullFile),
 2130    user:prolog_file_type(PlExt, prolog),
 2131    user:prolog_file_type(QlfExt, qlf),
 2132    file_name_extension(Base, QlfExt, QlfFile),
 2133    (   access_file(QlfFile, read),
 2134        (   '$qlf_out_of_date'(FullFile, QlfFile, Why)
 2135        ->  (   access_file(QlfFile, write)
 2136            ->  print_message(informational,
 2137                              qlf(recompile(Spec, FullFile, QlfFile, Why))),
 2138                Mode = qcompile,
 2139                LoadFile = FullFile
 2140            ;   Why == old,
 2141                current_prolog_flag(home, PlHome),
 2142                sub_atom(FullFile, 0, _, _, PlHome)
 2143            ->  print_message(silent,
 2144                              qlf(system_lib_out_of_date(Spec, QlfFile))),
 2145                Mode = qload,
 2146                LoadFile = QlfFile
 2147            ;   print_message(warning,
 2148                              qlf(can_not_recompile(Spec, QlfFile, Why))),
 2149                Mode = compile,
 2150                LoadFile = FullFile
 2151            )
 2152        ;   Mode = qload,
 2153            LoadFile = QlfFile
 2154        )
 2155    ->  !
 2156    ;   '$qlf_auto'(FullFile, QlfFile, Options)
 2157    ->  !, Mode = qcompile,
 2158        LoadFile = FullFile
 2159    ).
 2160'$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.
 2168'$qlf_out_of_date'(PlFile, QlfFile, Why) :-
 2169    (   access_file(PlFile, read)
 2170    ->  time_file(PlFile, PlTime),
 2171        time_file(QlfFile, QlfTime),
 2172        (   PlTime > QlfTime
 2173        ->  Why = old                   % PlFile is newer
 2174        ;   Error = error(Formal,_),
 2175            catch('$qlf_sources'(QlfFile, _Files), Error, true),
 2176            nonvar(Formal)              % QlfFile is incompatible
 2177        ->  Why = Error
 2178        ;   fail                        % QlfFile is up-to-date and ok
 2179        )
 2180    ;   fail                            % can not read .pl; try .qlf
 2181    ).
 $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.
 2189:- create_prolog_flag(qcompile, false, [type(atom)]). 2190
 2191'$qlf_auto'(PlFile, QlfFile, Options) :-
 2192    (   memberchk(qcompile(QlfMode), Options)
 2193    ->  true
 2194    ;   current_prolog_flag(qcompile, QlfMode),
 2195        \+ '$in_system_dir'(PlFile)
 2196    ),
 2197    (   QlfMode == auto
 2198    ->  true
 2199    ;   QlfMode == large,
 2200        size_file(PlFile, Size),
 2201        Size > 100000
 2202    ),
 2203    access_file(QlfFile, write).
 2204
 2205'$in_system_dir'(PlFile) :-
 2206    current_prolog_flag(home, Home),
 2207    sub_atom(PlFile, 0, _, _, Home).
 2208
 2209'$spec_extension'(File, Ext) :-
 2210    atom(File),
 2211    file_name_extension(_, Ext, File).
 2212'$spec_extension'(Spec, Ext) :-
 2213    compound(Spec),
 2214    arg(1, Spec, Arg),
 2215    '$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:
 2227:- dynamic
 2228    '$resolved_source_path'/2.                  % ?Spec, ?Path
 2229
 2230'$load_file'(File, Module, Options) :-
 2231    \+ memberchk(stream(_), Options),
 2232    user:prolog_load_file(Module:File, Options),
 2233    !.
 2234'$load_file'(File, Module, Options) :-
 2235    memberchk(stream(_), Options),
 2236    !,
 2237    '$assert_load_context_module'(File, Module, Options),
 2238    '$qdo_load_file'(File, File, Module, Options).
 2239'$load_file'(File, Module, Options) :-
 2240    (   '$resolved_source_path'(File, FullFile, Options)
 2241    ->  true
 2242    ;   '$resolve_source_path'(File, FullFile, Options)
 2243    ),
 2244    '$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.
 2250'$resolved_source_path'(File, FullFile, Options) :-
 2251    '$resolved_source_path'(File, FullFile),
 2252    (   '$source_file_property'(FullFile, from_state, true)
 2253    ;   '$source_file_property'(FullFile, resource, true)
 2254    ;   '$option'(if(If), Options, true),
 2255        '$noload'(If, FullFile, Options)
 2256    ),
 2257    !.
 $resolve_source_path(+File, -FullFile, Options) is det
Resolve a source file specification to an absolute path. May throw existence and other errors.
 2264'$resolve_source_path'(File, FullFile, _Options) :-
 2265    absolute_file_name(File, FullFile,
 2266                       [ file_type(prolog),
 2267                         access(read)
 2268                       ]),
 2269    '$register_resolved_source_path'(File, FullFile).
 2270
 2271
 2272'$register_resolved_source_path'(File, FullFile) :-
 2273    '$resolved_source_path'(File, FullFile),
 2274    !.
 2275'$register_resolved_source_path'(File, FullFile) :-
 2276    compound(File),
 2277    !,
 2278    asserta('$resolved_source_path'(File, FullFile)).
 2279'$register_resolved_source_path'(_, _).
 $translated_source(+Old, +New) is det
Called from loading a QLF state when source files are being renamed.
 2285:- public '$translated_source'/2. 2286'$translated_source'(Old, New) :-
 2287    forall(retract('$resolved_source_path'(File, Old)),
 2288           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.
 2295'$register_resource_file'(FullFile) :-
 2296    (   sub_atom(FullFile, 0, _, _, 'res://')
 2297    ->  '$set_source_file'(FullFile, resource, true)
 2298    ;   true
 2299    ).
 $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.
 2312'$already_loaded'(_File, FullFile, Module, Options) :-
 2313    '$assert_load_context_module'(FullFile, Module, Options),
 2314    '$current_module'(LoadModules, FullFile),
 2315    !,
 2316    (   atom(LoadModules)
 2317    ->  LoadModule = LoadModules
 2318    ;   LoadModules = [LoadModule|_]
 2319    ),
 2320    '$import_from_loaded_module'(LoadModule, Module, Options).
 2321'$already_loaded'(_, _, user, _) :- !.
 2322'$already_loaded'(File, _, Module, Options) :-
 2323    '$load_file'(File, Module, [if(true)|Options]).
 $mt_load_file(+File, +FullFile, +Module, +Options) is det
Deal with multi-threaded loading of files. The thread that wishes to load the thread first will do so, while other threads will wait until the leader finished and than act as if the file is already loaded.

Synchronisation is handled using a message queue that exists while the file is being loaded. This synchronisation relies on the fact that thread_get_message/1 throws an existence_error if the message queue is destroyed. This is hacky. Events or condition variables would have made a cleaner design.

 2338:- dynamic
 2339    '$loading_file'/3.              % File, Queue, Thread
 2340:- volatile
 2341    '$loading_file'/3. 2342
 2343'$mt_load_file'(File, FullFile, Module, Options) :-
 2344    current_prolog_flag(threads, true),
 2345    !,
 2346    setup_call_cleanup(
 2347        with_mutex('$load_file',
 2348                   '$mt_start_load'(FullFile, Loading, Options)),
 2349        '$mt_do_load'(Loading, File, FullFile, Module, Options),
 2350        '$mt_end_load'(Loading)).
 2351'$mt_load_file'(File, FullFile, Module, Options) :-
 2352    '$option'(if(If), Options, true),
 2353    '$noload'(If, FullFile, Options),
 2354    !,
 2355    '$already_loaded'(File, FullFile, Module, Options).
 2356'$mt_load_file'(File, FullFile, Module, Options) :-
 2357    '$qdo_load_file'(File, FullFile, Module, Options).
 2358
 2359'$mt_start_load'(FullFile, queue(Queue), _) :-
 2360    '$loading_file'(FullFile, Queue, LoadThread),
 2361    \+ thread_self(LoadThread),
 2362    !.
 2363'$mt_start_load'(FullFile, already_loaded, Options) :-
 2364    '$option'(if(If), Options, true),
 2365    '$noload'(If, FullFile, Options),
 2366    !.
 2367'$mt_start_load'(FullFile, Ref, _) :-
 2368    thread_self(Me),
 2369    message_queue_create(Queue),
 2370    assertz('$loading_file'(FullFile, Queue, Me), Ref).
 2371
 2372'$mt_do_load'(queue(Queue), File, FullFile, Module, Options) :-
 2373    !,
 2374    catch(thread_get_message(Queue, _), error(_,_), true),
 2375    '$already_loaded'(File, FullFile, Module, Options).
 2376'$mt_do_load'(already_loaded, File, FullFile, Module, Options) :-
 2377    !,
 2378    '$already_loaded'(File, FullFile, Module, Options).
 2379'$mt_do_load'(_Ref, File, FullFile, Module, Options) :-
 2380    '$assert_load_context_module'(FullFile, Module, Options),
 2381    '$qdo_load_file'(File, FullFile, Module, Options).
 2382
 2383'$mt_end_load'(queue(_)) :- !.
 2384'$mt_end_load'(already_loaded) :- !.
 2385'$mt_end_load'(Ref) :-
 2386    clause('$loading_file'(_, Queue, _), _, Ref),
 2387    erase(Ref),
 2388    thread_send_message(Queue, done),
 2389    message_queue_destroy(Queue).
 $qdo_load_file(+Spec, +FullFile, +ContextModule, +Options) is det
Switch to qcompile mode if requested by the option '$qlf'(+Out)
 2396'$qdo_load_file'(File, FullFile, Module, Options) :-
 2397    '$qdo_load_file2'(File, FullFile, Module, Action, Options),
 2398    '$register_resource_file'(FullFile),
 2399    '$run_initialization'(FullFile, Action, Options).
 2400
 2401'$qdo_load_file2'(File, FullFile, Module, Action, Options) :-
 2402    memberchk('$qlf'(QlfOut), Options),
 2403    '$stage_file'(QlfOut, StageQlf),
 2404    !,
 2405    setup_call_catcher_cleanup(
 2406        '$qstart'(StageQlf, Module, State),
 2407        '$do_load_file'(File, FullFile, Module, Action, Options),
 2408        Catcher,
 2409        '$qend'(State, Catcher, StageQlf, QlfOut)).
 2410'$qdo_load_file2'(File, FullFile, Module, Action, Options) :-
 2411    '$do_load_file'(File, FullFile, Module, Action, Options).
 2412
 2413'$qstart'(Qlf, Module, state(OldMode, OldModule)) :-
 2414    '$qlf_open'(Qlf),
 2415    '$compilation_mode'(OldMode, qlf),
 2416    '$set_source_module'(OldModule, Module).
 2417
 2418'$qend'(state(OldMode, OldModule), Catcher, StageQlf, QlfOut) :-
 2419    '$set_source_module'(_, OldModule),
 2420    '$set_compilation_mode'(OldMode),
 2421    '$qlf_close',
 2422    '$install_staged_file'(Catcher, StageQlf, QlfOut, warn).
 2423
 2424'$set_source_module'(OldModule, Module) :-
 2425    '$current_source_module'(OldModule),
 2426    '$set_source_module'(Module).
 $do_load_file(+Spec, +FullFile, +ContextModule, -Action, +Options) is det
Perform the actual loading.
 2433'$do_load_file'(File, FullFile, Module, Action, Options) :-
 2434    '$option'(derived_from(DerivedFrom), Options, -),
 2435    '$register_derived_source'(FullFile, DerivedFrom),
 2436    '$qlf_file'(File, FullFile, Absolute, Mode, Options),
 2437    (   Mode == qcompile
 2438    ->  qcompile(Module:File, Options)
 2439    ;   '$do_load_file_2'(File, Absolute, Module, Action, Options)
 2440    ).
 2441
 2442'$do_load_file_2'(File, Absolute, Module, Action, Options) :-
 2443    '$source_file_property'(Absolute, number_of_clauses, OldClauses),
 2444    statistics(cputime, OldTime),
 2445
 2446    '$setup_load'(ScopedFlags, OldSandBoxed, OldVerbose, OldAutoLevel, OldXRef,
 2447                  Options),
 2448
 2449    '$compilation_level'(Level),
 2450    '$load_msg_level'(load_file, Level, StartMsgLevel, DoneMsgLevel),
 2451    '$print_message'(StartMsgLevel,
 2452                     load_file(start(Level,
 2453                                     file(File, Absolute)))),
 2454
 2455    (   memberchk(stream(FromStream), Options)
 2456    ->  Input = stream
 2457    ;   Input = source
 2458    ),
 2459
 2460    (   Input == stream,
 2461        (   '$option'(format(qlf), Options, source)
 2462        ->  set_stream(FromStream, file_name(Absolute)),
 2463            '$qload_stream'(FromStream, Module, Action, LM, Options)
 2464        ;   '$consult_file'(stream(Absolute, FromStream, []),
 2465                            Module, Action, LM, Options)
 2466        )
 2467    ->  true
 2468    ;   Input == source,
 2469        file_name_extension(_, Ext, Absolute),
 2470        (   user:prolog_file_type(Ext, qlf),
 2471            E = error(_,_),
 2472            catch('$qload_file'(Absolute, Module, Action, LM, Options),
 2473                  E,
 2474                  print_message(warning, E))
 2475        ->  true
 2476        ;   '$consult_file'(Absolute, Module, Action, LM, Options)
 2477        )
 2478    ->  true
 2479    ;   '$print_message'(error, load_file(failed(File))),
 2480        fail
 2481    ),
 2482
 2483    '$import_from_loaded_module'(LM, Module, Options),
 2484
 2485    '$source_file_property'(Absolute, number_of_clauses, NewClauses),
 2486    statistics(cputime, Time),
 2487    ClausesCreated is NewClauses - OldClauses,
 2488    TimeUsed is Time - OldTime,
 2489
 2490    '$print_message'(DoneMsgLevel,
 2491                     load_file(done(Level,
 2492                                    file(File, Absolute),
 2493                                    Action,
 2494                                    LM,
 2495                                    TimeUsed,
 2496                                    ClausesCreated))),
 2497
 2498    '$restore_load'(ScopedFlags, OldSandBoxed, OldVerbose, OldAutoLevel, OldXRef).
 2499
 2500'$setup_load'(ScopedFlags, OldSandBoxed, OldVerbose, OldAutoLevel, OldXRef,
 2501              Options) :-
 2502    '$save_file_scoped_flags'(ScopedFlags),
 2503    '$set_sandboxed_load'(Options, OldSandBoxed),
 2504    '$set_verbose_load'(Options, OldVerbose),
 2505    '$set_optimise_load'(Options),
 2506    '$update_autoload_level'(Options, OldAutoLevel),
 2507    '$set_no_xref'(OldXRef).
 2508
 2509'$restore_load'(ScopedFlags, OldSandBoxed, OldVerbose, OldAutoLevel, OldXRef) :-
 2510    '$set_autoload_level'(OldAutoLevel),
 2511    set_prolog_flag(xref, OldXRef),
 2512    set_prolog_flag(verbose_load, OldVerbose),
 2513    set_prolog_flag(sandboxed_load, OldSandBoxed),
 2514    '$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.
 2522'$save_file_scoped_flags'(State) :-
 2523    current_predicate(findall/3),          % Not when doing boot compile
 2524    !,
 2525    findall(SavedFlag, '$save_file_scoped_flag'(SavedFlag), State).
 2526'$save_file_scoped_flags'([]).
 2527
 2528'$save_file_scoped_flag'(Flag-Value) :-
 2529    '$file_scoped_flag'(Flag, Default),
 2530    (   current_prolog_flag(Flag, Value)
 2531    ->  true
 2532    ;   Value = Default
 2533    ).
 2534
 2535'$file_scoped_flag'(generate_debug_info, true).
 2536'$file_scoped_flag'(optimise,            false).
 2537'$file_scoped_flag'(xref,                false).
 2538
 2539'$restore_file_scoped_flags'([]).
 2540'$restore_file_scoped_flags'([Flag-Value|T]) :-
 2541    set_prolog_flag(Flag, Value),
 2542    '$restore_file_scoped_flags'(T).
 $import_from_loaded_module(LoadedModule, Module, Options) is det
Import public predicates from LoadedModule into Module
 2549'$import_from_loaded_module'(LoadedModule, Module, Options) :-
 2550    LoadedModule \== Module,
 2551    atom(LoadedModule),
 2552    !,
 2553    '$option'(imports(Import), Options, all),
 2554    '$option'(reexport(Reexport), Options, false),
 2555    '$import_list'(Module, LoadedModule, Import, Reexport).
 2556'$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.
 2564'$set_verbose_load'(Options, Old) :-
 2565    current_prolog_flag(verbose_load, Old),
 2566    (   memberchk(silent(Silent), Options)
 2567    ->  (   '$negate'(Silent, Level0)
 2568        ->  '$load_msg_compat'(Level0, Level)
 2569        ;   Level = Silent
 2570        ),
 2571        set_prolog_flag(verbose_load, Level)
 2572    ;   true
 2573    ).
 2574
 2575'$negate'(true, false).
 2576'$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, -)
 2585'$set_sandboxed_load'(Options, Old) :-
 2586    current_prolog_flag(sandboxed_load, Old),
 2587    (   memberchk(sandboxed(SandBoxed), Options),
 2588        '$enter_sandboxed'(Old, SandBoxed, New),
 2589        New \== Old
 2590    ->  set_prolog_flag(sandboxed_load, New)
 2591    ;   true
 2592    ).
 2593
 2594'$enter_sandboxed'(Old, New, SandBoxed) :-
 2595    (   Old == false, New == true
 2596    ->  SandBoxed = true,
 2597        '$ensure_loaded_library_sandbox'
 2598    ;   Old == true, New == false
 2599    ->  throw(error(permission_error(leave, sandbox, -), _))
 2600    ;   SandBoxed = Old
 2601    ).
 2602'$enter_sandboxed'(false, true, true).
 2603
 2604'$ensure_loaded_library_sandbox' :-
 2605    source_file_property(library(sandbox), module(sandbox)),
 2606    !.
 2607'$ensure_loaded_library_sandbox' :-
 2608    load_files(library(sandbox), [if(not_loaded), silent(true)]).
 2609
 2610'$set_optimise_load'(Options) :-
 2611    (   '$option'(optimise(Optimise), Options)
 2612    ->  set_prolog_flag(optimise, Optimise)
 2613    ;   true
 2614    ).
 2615
 2616'$set_no_xref'(OldXRef) :-
 2617    (   current_prolog_flag(xref, OldXRef)
 2618    ->  true
 2619    ;   OldXRef = false
 2620    ),
 2621    set_prolog_flag(xref, false).
 $update_autoload_level(+Options, -OldLevel)
Update the '$autoload_nesting' and return the old value.
 2628:- thread_local
 2629    '$autoload_nesting'/1. 2630
 2631'$update_autoload_level'(Options, AutoLevel) :-
 2632    '$option'(autoload(Autoload), Options, false),
 2633    (   '$autoload_nesting'(CurrentLevel)
 2634    ->  AutoLevel = CurrentLevel
 2635    ;   AutoLevel = 0
 2636    ),
 2637    (   Autoload == false
 2638    ->  true
 2639    ;   NewLevel is AutoLevel + 1,
 2640        '$set_autoload_level'(NewLevel)
 2641    ).
 2642
 2643'$set_autoload_level'(New) :-
 2644    retractall('$autoload_nesting'(_)),
 2645    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.
 2653'$print_message'(Level, Term) :-
 2654    current_predicate(system:print_message/2),
 2655    !,
 2656    print_message(Level, Term).
 2657'$print_message'(warning, Term) :-
 2658    source_location(File, Line),
 2659    !,
 2660    format(user_error, 'WARNING: ~w:~w: ~p~n', [File, Line, Term]).
 2661'$print_message'(error, Term) :-
 2662    !,
 2663    source_location(File, Line),
 2664    !,
 2665    format(user_error, 'ERROR: ~w:~w: ~p~n', [File, Line, Term]).
 2666'$print_message'(_Level, _Term).
 2667
 2668'$print_message_fail'(E) :-
 2669    '$print_message'(error, E),
 2670    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.
 2678'$consult_file'(Absolute, Module, What, LM, Options) :-
 2679    '$current_source_module'(Module),   % same module
 2680    !,
 2681    '$consult_file_2'(Absolute, Module, What, LM, Options).
 2682'$consult_file'(Absolute, Module, What, LM, Options) :-
 2683    '$set_source_module'(OldModule, Module),
 2684    '$ifcompiling'('$qlf_start_sub_module'(Module)),
 2685    '$consult_file_2'(Absolute, Module, What, LM, Options),
 2686    '$ifcompiling'('$qlf_end_part'),
 2687    '$set_source_module'(OldModule).
 2688
 2689'$consult_file_2'(Absolute, Module, What, LM, Options) :-
 2690    '$set_source_module'(OldModule, Module),
 2691    '$load_id'(Absolute, Id, Modified, Options),
 2692    '$compile_type'(What),
 2693    '$save_lex_state'(LexState, Options),
 2694    '$set_dialect'(Options),
 2695    setup_call_cleanup(
 2696        '$start_consult'(Id, Modified),
 2697        '$load_file'(Absolute, Id, LM, Options),
 2698        '$end_consult'(Id, LexState, OldModule)).
 2699
 2700'$end_consult'(Id, LexState, OldModule) :-
 2701    '$end_consult'(Id),
 2702    '$restore_lex_state'(LexState),
 2703    '$set_source_module'(OldModule).
 2704
 2705
 2706:- create_prolog_flag(emulated_dialect, swi, [type(atom)]).
 $save_lex_state(-LexState, +Options) is det
 2710'$save_lex_state'(State, Options) :-
 2711    memberchk(scope_settings(false), Options),
 2712    !,
 2713    State = (-).
 2714'$save_lex_state'(lexstate(Style, Dialect), _) :-
 2715    '$style_check'(Style, Style),
 2716    current_prolog_flag(emulated_dialect, Dialect).
 2717
 2718'$restore_lex_state'(-) :- !.
 2719'$restore_lex_state'(lexstate(Style, Dialect)) :-
 2720    '$style_check'(_, Style),
 2721    set_prolog_flag(emulated_dialect, Dialect).
 2722
 2723'$set_dialect'(Options) :-
 2724    memberchk(dialect(Dialect), Options),
 2725    !,
 2726    '$expects_dialect'(Dialect).
 2727'$set_dialect'(_).
 2728
 2729'$load_id'(stream(Id, _, _), Id, Modified, Options) :-
 2730    !,
 2731    '$modified_id'(Id, Modified, Options).
 2732'$load_id'(Id, Id, Modified, Options) :-
 2733    '$modified_id'(Id, Modified, Options).
 2734
 2735'$modified_id'(_, Modified, Options) :-
 2736    '$option'(modified(Stamp), Options, Def),
 2737    Stamp \== Def,
 2738    !,
 2739    Modified = Stamp.
 2740'$modified_id'(Id, Modified, _) :-
 2741    catch(time_file(Id, Modified),
 2742          error(_, _),
 2743          fail),
 2744    !.
 2745'$modified_id'(_, 0.0, _).
 2746
 2747
 2748'$compile_type'(What) :-
 2749    '$compilation_mode'(How),
 2750    (   How == database
 2751    ->  What = compiled
 2752    ;   How == qlf
 2753    ->  What = '*qcompiled*'
 2754    ;   What = 'boot compiled'
 2755    ).
 $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.
 2765:- dynamic
 2766    '$load_context_module'/3. 2767:- multifile
 2768    '$load_context_module'/3. 2769
 2770'$assert_load_context_module'(_, _, Options) :-
 2771    memberchk(register(false), Options),
 2772    !.
 2773'$assert_load_context_module'(File, Module, Options) :-
 2774    source_location(FromFile, Line),
 2775    !,
 2776    '$master_file'(FromFile, MasterFile),
 2777    '$check_load_non_module'(File, Module),
 2778    '$add_dialect'(Options, Options1),
 2779    '$load_ctx_options'(Options1, Options2),
 2780    '$store_admin_clause'(
 2781        system:'$load_context_module'(File, Module, Options2),
 2782        _Layout, MasterFile, FromFile:Line).
 2783'$assert_load_context_module'(File, Module, Options) :-
 2784    '$check_load_non_module'(File, Module),
 2785    '$add_dialect'(Options, Options1),
 2786    '$load_ctx_options'(Options1, Options2),
 2787    (   clause('$load_context_module'(File, Module, _), true, Ref),
 2788        \+ clause_property(Ref, file(_)),
 2789        erase(Ref)
 2790    ->  true
 2791    ;   true
 2792    ),
 2793    assertz('$load_context_module'(File, Module, Options2)).
 2794
 2795'$add_dialect'(Options0, Options) :-
 2796    current_prolog_flag(emulated_dialect, Dialect), Dialect \== swi,
 2797    !,
 2798    Options = [dialect(Dialect)|Options0].
 2799'$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.
 2806'$load_ctx_options'([], []).
 2807'$load_ctx_options'([H|T0], [H|T]) :-
 2808    '$load_ctx_option'(H),
 2809    !,
 2810    '$load_ctx_options'(T0, T).
 2811'$load_ctx_options'([_|T0], T) :-
 2812    '$load_ctx_options'(T0, T).
 2813
 2814'$load_ctx_option'(derived_from(_)).
 2815'$load_ctx_option'(dialect(_)).
 2816'$load_ctx_option'(encoding(_)).
 2817'$load_ctx_option'(imports(_)).
 2818'$load_ctx_option'(reexport(_)).
 $check_load_non_module(+File) is det
Test that a non-module file is not loaded into multiple contexts.
 2826'$check_load_non_module'(File, _) :-
 2827    '$current_module'(_, File),
 2828    !.          % File is a module file
 2829'$check_load_non_module'(File, Module) :-
 2830    '$load_context_module'(File, OldModule, _),
 2831    Module \== OldModule,
 2832    !,
 2833    format(atom(Msg),
 2834           'Non-module file already loaded into module ~w; \c
 2835               trying to load into ~w',
 2836           [OldModule, Module]),
 2837    throw(error(permission_error(load, source, File),
 2838                context(load_files/2, Msg))).
 2839'$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)
 2852'$load_file'(Path, Id, Module, Options) :-
 2853    State = state(true, _, true, false, Id, -),
 2854    (   '$source_term'(Path, _Read, _Layout, Term, Layout,
 2855                       _Stream, Options),
 2856        '$valid_term'(Term),
 2857        (   arg(1, State, true)
 2858        ->  '$first_term'(Term, Layout, Id, State, Options),
 2859            nb_setarg(1, State, false)
 2860        ;   '$compile_term'(Term, Layout, Id)
 2861        ),
 2862        arg(4, State, true)
 2863    ;   '$fixup_reconsult'(Id),
 2864        '$end_load_file'(State)
 2865    ),
 2866    !,
 2867    arg(2, State, Module).
 2868
 2869'$valid_term'(Var) :-
 2870    var(Var),
 2871    !,
 2872    print_message(error, error(instantiation_error, _)).
 2873'$valid_term'(Term) :-
 2874    Term \== [].
 2875
 2876'$end_load_file'(State) :-
 2877    arg(1, State, true),           % empty file
 2878    !,
 2879    nb_setarg(2, State, Module),
 2880    arg(5, State, Id),
 2881    '$current_source_module'(Module),
 2882    '$ifcompiling'('$qlf_start_file'(Id)),
 2883    '$ifcompiling'('$qlf_end_part').
 2884'$end_load_file'(State) :-
 2885    arg(3, State, End),
 2886    '$end_load_file'(End, State).
 2887
 2888'$end_load_file'(true, _).
 2889'$end_load_file'(end_module, State) :-
 2890    arg(2, State, Module),
 2891    '$check_export'(Module),
 2892    '$ifcompiling'('$qlf_end_part').
 2893'$end_load_file'(end_non_module, _State) :-
 2894    '$ifcompiling'('$qlf_end_part').
 2895
 2896
 2897'$first_term'(?-(Directive), Layout, Id, State, Options) :-
 2898    !,
 2899    '$first_term'(:-(Directive), Layout, Id, State, Options).
 2900'$first_term'(:-(Directive), _Layout, Id, State, Options) :-
 2901    nonvar(Directive),
 2902    (   (   Directive = module(Name, Public)
 2903        ->  Imports = []
 2904        ;   Directive = module(Name, Public, Imports)
 2905        )
 2906    ->  !,
 2907        '$module_name'(Name, Id, Module, Options),
 2908        '$start_module'(Module, Public, State, Options),
 2909        '$module3'(Imports)
 2910    ;   Directive = expects_dialect(Dialect)
 2911    ->  !,
 2912        '$set_dialect'(Dialect, State),
 2913        fail                        % Still consider next term as first
 2914    ).
 2915'$first_term'(Term, Layout, Id, State, Options) :-
 2916    '$start_non_module'(Id, State, Options),
 2917    '$compile_term'(Term, Layout, Id).
 2918
 2919'$compile_term'(Term, Layout, Id) :-
 2920    '$compile_term'(Term, Layout, Id, -).
 2921
 2922'$compile_term'(Var, _Layout, _Id, _Src) :-
 2923    var(Var),
 2924    !,
 2925    '$instantiation_error'(Var).
 2926'$compile_term'((?-Directive), _Layout, Id, _) :-
 2927    !,
 2928    '$execute_directive'(Directive, Id).
 2929'$compile_term'((:-Directive), _Layout, Id, _) :-
 2930    !,
 2931    '$execute_directive'(Directive, Id).
 2932'$compile_term'('$source_location'(File, Line):Term, Layout, Id, _) :-
 2933    !,
 2934    '$compile_term'(Term, Layout, Id, File:Line).
 2935'$compile_term'(Clause, Layout, Id, SrcLoc) :-
 2936    E = error(_,_),
 2937    catch('$store_clause'(Clause, Layout, Id, SrcLoc), E,
 2938          '$print_message'(error, E)).
 2939
 2940'$start_non_module'(Id, _State, Options) :-
 2941    '$option'(must_be_module(true), Options, false),
 2942    !,
 2943    throw(error(domain_error(module_file, Id), _)).
 2944'$start_non_module'(Id, State, _Options) :-
 2945    '$current_source_module'(Module),
 2946    '$ifcompiling'('$qlf_start_file'(Id)),
 2947    '$qset_dialect'(State),
 2948    nb_setarg(2, State, Module),
 2949    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.

 2962'$set_dialect'(Dialect, State) :-
 2963    '$compilation_mode'(qlf, database),
 2964    !,
 2965    '$expects_dialect'(Dialect),
 2966    '$compilation_mode'(_, qlf),
 2967    nb_setarg(6, State, Dialect).
 2968'$set_dialect'(Dialect, _) :-
 2969    '$expects_dialect'(Dialect).
 2970
 2971'$qset_dialect'(State) :-
 2972    '$compilation_mode'(qlf),
 2973    arg(6, State, Dialect), Dialect \== (-),
 2974    !,
 2975    '$add_directive_wic'('$expects_dialect'(Dialect)).
 2976'$qset_dialect'(_).
 2977
 2978'$expects_dialect'(Dialect) :-
 2979    Dialect == swi,
 2980    !,
 2981    set_prolog_flag(emulated_dialect, Dialect).
 2982'$expects_dialect'(Dialect) :-
 2983    current_predicate(expects_dialect/1),
 2984    !,
 2985    expects_dialect(Dialect).
 2986'$expects_dialect'(Dialect) :-
 2987    use_module(library(dialect), [expects_dialect/1]),
 2988    expects_dialect(Dialect).
 2989
 2990
 2991                 /*******************************
 2992                 *           MODULES            *
 2993                 *******************************/
 2994
 2995'$start_module'(Module, _Public, State, _Options) :-
 2996    '$current_module'(Module, OldFile),
 2997    source_location(File, _Line),
 2998    OldFile \== File, OldFile \== [],
 2999    same_file(OldFile, File),
 3000    !,
 3001    nb_setarg(2, State, Module),
 3002    nb_setarg(4, State, true).      % Stop processing
 3003'$start_module'(Module, Public, State, Options) :-
 3004    arg(5, State, File),
 3005    nb_setarg(2, State, Module),
 3006    source_location(_File, Line),
 3007    '$option'(redefine_module(Action), Options, false),
 3008    '$module_class'(File, Class, Super),
 3009    '$redefine_module'(Module, File, Action),
 3010    '$declare_module'(Module, Class, Super, File, Line, false),
 3011    '$export_list'(Public, Module, Ops),
 3012    '$ifcompiling'('$qlf_start_module'(Module)),
 3013    '$export_ops'(Ops, Module, File),
 3014    '$qset_dialect'(State),
 3015    nb_setarg(3, State, end_module).
 $module3(+Spec) is det
Handle the 3th argument of a module declartion.
 3022'$module3'(Var) :-
 3023    var(Var),
 3024    !,
 3025    '$instantiation_error'(Var).
 3026'$module3'([]) :- !.
 3027'$module3'([H|T]) :-
 3028    !,
 3029    '$module3'(H),
 3030    '$module3'(T).
 3031'$module3'(Id) :-
 3032    use_module(library(dialect/Id)).
 $module_name(?Name, +Id, -Module, +Options) is semidet
Determine the module name. There are some cases:
 3046'$module_name'(_, _, Module, Options) :-
 3047    '$option'(module(Module), Options),
 3048    !,
 3049    '$current_source_module'(Context),
 3050    Context \== Module.                     % cause '$first_term'/5 to fail.
 3051'$module_name'(Var, Id, Module, Options) :-
 3052    var(Var),
 3053    !,
 3054    file_base_name(Id, File),
 3055    file_name_extension(Var, _, File),
 3056    '$module_name'(Var, Id, Module, Options).
 3057'$module_name'(Reserved, _, _, _) :-
 3058    '$reserved_module'(Reserved),
 3059    !,
 3060    throw(error(permission_error(load, module, Reserved), _)).
 3061'$module_name'(Module, _Id, Module, _).
 3062
 3063
 3064'$reserved_module'(system).
 3065'$reserved_module'(user).
 $redefine_module(+Module, +File, -Redefine)
 3070'$redefine_module'(_Module, _, false) :- !.
 3071'$redefine_module'(Module, File, true) :-
 3072    !,
 3073    (   module_property(Module, file(OldFile)),
 3074        File \== OldFile
 3075    ->  unload_file(OldFile)
 3076    ;   true
 3077    ).
 3078'$redefine_module'(Module, File, ask) :-
 3079    (   stream_property(user_input, tty(true)),
 3080        module_property(Module, file(OldFile)),
 3081        File \== OldFile,
 3082        '$rdef_response'(Module, OldFile, File, true)
 3083    ->  '$redefine_module'(Module, File, true)
 3084    ;   true
 3085    ).
 3086
 3087'$rdef_response'(Module, OldFile, File, Ok) :-
 3088    repeat,
 3089    print_message(query, redefine_module(Module, OldFile, File)),
 3090    get_single_char(Char),
 3091    '$rdef_response'(Char, Ok0),
 3092    !,
 3093    Ok = Ok0.
 3094
 3095'$rdef_response'(Char, true) :-
 3096    memberchk(Char, `yY`),
 3097    format(user_error, 'yes~n', []).
 3098'$rdef_response'(Char, false) :-
 3099    memberchk(Char, `nN`),
 3100    format(user_error, 'no~n', []).
 3101'$rdef_response'(Char, _) :-
 3102    memberchk(Char, `a`),
 3103    format(user_error, 'abort~n', []),
 3104    abort.
 3105'$rdef_response'(_, _) :-
 3106    print_message(help, redefine_module_reply),
 3107    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.
 3117'$module_class'(File, Class, system) :-
 3118    current_prolog_flag(home, Home),
 3119    sub_atom(File, 0, Len, _, Home),
 3120    (   sub_atom(File, Len, _, _, '/boot/')
 3121    ->  Class = system
 3122    ;   '$lib_prefix'(Prefix),
 3123        sub_atom(File, Len, _, _, Prefix)
 3124    ->  Class = library
 3125    ;   file_directory_name(File, Home),
 3126        file_name_extension(_, rc, File)
 3127    ->  Class = library
 3128    ),
 3129    !.
 3130'$module_class'(_, user, user).
 3131
 3132'$lib_prefix'('/library').
 3133'$lib_prefix'('/xpce/prolog/lib/').
 3134
 3135'$check_export'(Module) :-
 3136    '$undefined_export'(Module, UndefList),
 3137    (   '$member'(Undef, UndefList),
 3138        strip_module(Undef, _, Local),
 3139        print_message(error,
 3140                      undefined_export(Module, Local)),
 3141        fail
 3142    ;   true
 3143    ).
 $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).
 3152'$import_list'(_, _, Var, _) :-
 3153    var(Var),
 3154    !,
 3155    throw(error(instantitation_error, _)).
 3156'$import_list'(Target, Source, all, Reexport) :-
 3157    !,
 3158    '$exported_ops'(Source, Import, Predicates),
 3159    '$module_property'(Source, exports(Predicates)),
 3160    '$import_all'(Import, Target, Source, Reexport, weak).
 3161'$import_list'(Target, Source, except(Spec), Reexport) :-
 3162    !,
 3163    '$exported_ops'(Source, Export, Predicates),
 3164    '$module_property'(Source, exports(Predicates)),
 3165    (   is_list(Spec)
 3166    ->  true
 3167    ;   throw(error(type_error(list, Spec), _))
 3168    ),
 3169    '$import_except'(Spec, Export, Import),
 3170    '$import_all'(Import, Target, Source, Reexport, weak).
 3171'$import_list'(Target, Source, Import, Reexport) :-
 3172    !,
 3173    is_list(Import),
 3174    !,
 3175    '$import_all'(Import, Target, Source, Reexport, strong).
 3176'$import_list'(_, _, Import, _) :-
 3177    throw(error(type_error(import_specifier, Import))).
 3178
 3179
 3180'$import_except'([], List, List).
 3181'$import_except'([H|T], List0, List) :-
 3182    '$import_except_1'(H, List0, List1),
 3183    '$import_except'(T, List1, List).
 3184
 3185'$import_except_1'(Var, _, _) :-
 3186    var(Var),
 3187    !,
 3188    throw(error(instantitation_error, _)).
 3189'$import_except_1'(PI as N, List0, List) :-
 3190    '$pi'(PI), atom(N),
 3191    !,
 3192    '$canonical_pi'(PI, CPI),
 3193    '$import_as'(CPI, N, List0, List).
 3194'$import_except_1'(op(P,A,N), List0, List) :-
 3195    !,
 3196    '$remove_ops'(List0, op(P,A,N), List).
 3197'$import_except_1'(PI, List0, List) :-
 3198    '$pi'(PI),
 3199    !,
 3200    '$canonical_pi'(PI, CPI),
 3201    '$select'(P, List0, List),
 3202    '$canonical_pi'(CPI, P),
 3203    !.
 3204'$import_except_1'(Except, _, _) :-
 3205    throw(error(type_error(import_specifier, Except), _)).
 3206
 3207'$import_as'(CPI, N, [PI2|T], [CPI as N|T]) :-
 3208    '$canonical_pi'(PI2, CPI),
 3209    !.
 3210'$import_as'(PI, N, [H|T0], [H|T]) :-
 3211    !,
 3212    '$import_as'(PI, N, T0, T).
 3213'$import_as'(PI, _, _, _) :-
 3214    throw(error(existence_error(export, PI), _)).
 3215
 3216'$pi'(N/A) :- atom(N), integer(A), !.
 3217'$pi'(N//A) :- atom(N), integer(A).
 3218
 3219'$canonical_pi'(N//A0, N/A) :-
 3220    A is A0 + 2.
 3221'$canonical_pi'(PI, PI).
 3222
 3223'$remove_ops'([], _, []).
 3224'$remove_ops'([Op|T0], Pattern, T) :-
 3225    subsumes_term(Pattern, Op),
 3226    !,
 3227    '$remove_ops'(T0, Pattern, T).
 3228'$remove_ops'([H|T0], Pattern, [H|T]) :-
 3229    '$remove_ops'(T0, Pattern, T).
 $import_all(+Import, +Context, +Source, +Reexport, +Strength)
 3234'$import_all'(Import, Context, Source, Reexport, Strength) :-
 3235    '$import_all2'(Import, Context, Source, Imported, ImpOps, Strength),
 3236    (   Reexport == true,
 3237        (   '$list_to_conj'(Imported, Conj)
 3238        ->  export(Context:Conj),
 3239            '$ifcompiling'('$add_directive_wic'(export(Context:Conj)))
 3240        ;   true
 3241        ),
 3242        source_location(File, _Line),
 3243        '$export_ops'(ImpOps, Context, File)
 3244    ;   true
 3245    ).
 $import_all2(+Imports, +Context, +Source, -Imported, -ImpOps, +Strength)
 3249'$import_all2'([], _, _, [], [], _).
 3250'$import_all2'([PI as NewName|Rest], Context, Source,
 3251               [NewName/Arity|Imported], ImpOps, Strength) :-
 3252    !,
 3253    '$canonical_pi'(PI, Name/Arity),
 3254    length(Args, Arity),
 3255    Head =.. [Name|Args],
 3256    NewHead =.. [NewName|Args],
 3257    (   '$get_predicate_attribute'(Source:Head, transparent, 1)
 3258    ->  '$set_predicate_attribute'(Context:NewHead, transparent, true)
 3259    ;   true
 3260    ),
 3261    (   source_location(File, Line)
 3262    ->  E = error(_,_),
 3263        catch('$store_admin_clause'((NewHead :- Source:Head),
 3264                                    _Layout, File, File:Line),
 3265              E, '$print_message'(error, E))
 3266    ;   assertz((NewHead :- !, Source:Head)) % ! avoids problems with
 3267    ),                                       % duplicate load
 3268    '$import_all2'(Rest, Context, Source, Imported, ImpOps, Strength).
 3269'$import_all2'([op(P,A,N)|Rest], Context, Source, Imported,
 3270               [op(P,A,N)|ImpOps], Strength) :-
 3271    !,
 3272    '$import_ops'(Context, Source, op(P,A,N)),
 3273    '$import_all2'(Rest, Context, Source, Imported, ImpOps, Strength).
 3274'$import_all2'([Pred|Rest], Context, Source, [Pred|Imported], ImpOps, Strength) :-
 3275    Error = error(_,_),
 3276    catch(Context:'$import'(Source:Pred, Strength), Error,
 3277          print_message(error, Error)),
 3278    '$ifcompiling'('$import_wic'(Source, Pred, Strength)),
 3279    '$import_all2'(Rest, Context, Source, Imported, ImpOps, Strength).
 3280
 3281
 3282'$list_to_conj'([One], One) :- !.
 3283'$list_to_conj'([H|T], (H,Rest)) :-
 3284    '$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.
 3291'$exported_ops'(Module, Ops, Tail) :-
 3292    '$c_current_predicate'(_, Module:'$exported_op'(_,_,_)),
 3293    !,
 3294    findall(op(P,A,N), Module:'$exported_op'(P,A,N), Ops, Tail).
 3295'$exported_ops'(_, Ops, Ops).
 3296
 3297'$exported_op'(Module, P, A, N) :-
 3298    '$c_current_predicate'(_, Module:'$exported_op'(_,_,_)),
 3299    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.
 3306'$import_ops'(To, From, Pattern) :-
 3307    ground(Pattern),
 3308    !,
 3309    Pattern = op(P,A,N),
 3310    op(P,A,To:N),
 3311    (   '$exported_op'(From, P, A, N)
 3312    ->  true
 3313    ;   print_message(warning, no_exported_op(From, Pattern))
 3314    ).
 3315'$import_ops'(To, From, Pattern) :-
 3316    (   '$exported_op'(From, Pri, Assoc, Name),
 3317        Pattern = op(Pri, Assoc, Name),
 3318        op(Pri, Assoc, To:Name),
 3319        fail
 3320    ;   true
 3321    ).
 $export_list(+Declarations, +Module, -Ops)
Handle the export list of the module declaration for Module associated to File.
 3329'$export_list'(Decls, Module, Ops) :-
 3330    is_list(Decls),
 3331    !,
 3332    '$do_export_list'(Decls, Module, Ops).
 3333'$export_list'(Decls, _, _) :-
 3334    var(Decls),
 3335    throw(error(instantiation_error, _)).
 3336'$export_list'(Decls, _, _) :-
 3337    throw(error(type_error(list, Decls), _)).
 3338
 3339'$do_export_list'([], _, []) :- !.
 3340'$do_export_list'([H|T], Module, Ops) :-
 3341    !,
 3342    E = error(_,_),
 3343    catch('$export1'(H, Module, Ops, Ops1),
 3344          E, ('$print_message'(error, E), Ops = Ops1)),
 3345    '$do_export_list'(T, Module, Ops1).
 3346
 3347'$export1'(Var, _, _, _) :-
 3348    var(Var),
 3349    !,
 3350    throw(error(instantiation_error, _)).
 3351'$export1'(Op, _, [Op|T], T) :-
 3352    Op = op(_,_,_),
 3353    !.
 3354'$export1'(PI0, Module, Ops, Ops) :-
 3355    strip_module(Module:PI0, M, PI),
 3356    (   PI = (_//_)
 3357    ->  non_terminal(M:PI)
 3358    ;   true
 3359    ),
 3360    export(M:PI).
 3361
 3362'$export_ops'([op(Pri, Assoc, Name)|T], Module, File) :-
 3363    E = error(_,_),
 3364    catch(( '$execute_directive'(op(Pri, Assoc, Module:Name), File),
 3365            '$export_op'(Pri, Assoc, Name, Module, File)
 3366          ),
 3367          E, '$print_message'(error, E)),
 3368    '$export_ops'(T, Module, File).
 3369'$export_ops'([], _, _).
 3370
 3371'$export_op'(Pri, Assoc, Name, Module, File) :-
 3372    (   '$get_predicate_attribute'(Module:'$exported_op'(_,_,_), defined, 1)
 3373    ->  true
 3374    ;   '$execute_directive'(discontiguous(Module:'$exported_op'/3), File)
 3375    ),
 3376    '$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.
 3382'$execute_directive'(Goal, F) :-
 3383    '$execute_directive_2'(Goal, F).
 3384
 3385'$execute_directive_2'(encoding(Encoding), _F) :-
 3386    !,
 3387    (   '$load_input'(_F, S)
 3388    ->  set_stream(S, encoding(Encoding))
 3389    ).
 3390'$execute_directive_2'(Goal, _) :-
 3391    \+ '$compilation_mode'(database),
 3392    !,
 3393    '$add_directive_wic2'(Goal, Type),
 3394    (   Type == call                % suspend compiling into .qlf file
 3395    ->  '$compilation_mode'(Old, database),
 3396        setup_call_cleanup(
 3397            '$directive_mode'(OldDir, Old),
 3398            '$execute_directive_3'(Goal),
 3399            ( '$set_compilation_mode'(Old),
 3400              '$set_directive_mode'(OldDir)
 3401            ))
 3402    ;   '$execute_directive_3'(Goal)
 3403    ).
 3404'$execute_directive_2'(Goal, _) :-
 3405    '$execute_directive_3'(Goal).
 3406
 3407'$execute_directive_3'(Goal) :-
 3408    '$current_source_module'(Module),
 3409    '$valid_directive'(Module:Goal),
 3410    !,
 3411    (   '$pattr_directive'(Goal, Module)
 3412    ->  true
 3413    ;   Term = error(_,_),
 3414        catch(Module:Goal, Term, '$exception_in_directive'(Term))
 3415    ->  true
 3416    ;   '$print_message'(warning, goal_failed(directive, Module:Goal)),
 3417        fail
 3418    ).
 3419'$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.
 3428:- multifile prolog:sandbox_allowed_directive/1. 3429:- multifile prolog:sandbox_allowed_clause/1. 3430:- meta_predicate '$valid_directive'(:). 3431
 3432'$valid_directive'(_) :-
 3433    current_prolog_flag(sandboxed_load, false),
 3434    !.
 3435'$valid_directive'(Goal) :-
 3436    Error = error(Formal, _),
 3437    catch(prolog:sandbox_allowed_directive(Goal), Error, true),
 3438    !,
 3439    (   var(Formal)
 3440    ->  true
 3441    ;   print_message(error, Error),
 3442        fail
 3443    ).
 3444'$valid_directive'(Goal) :-
 3445    print_message(error,
 3446                  error(permission_error(execute,
 3447                                         sandboxed_directive,
 3448                                         Goal), _)),
 3449    fail.
 3450
 3451'$exception_in_directive'(Term) :-
 3452    '$print_message'(error, Term),
 3453    fail.
 3454
 3455%       Note that the list, consult and ensure_loaded directives are already
 3456%       handled at compile time and therefore should not go into the
 3457%       intermediate code file.
 3458
 3459'$add_directive_wic2'(Goal, Type) :-
 3460    '$common_goal_type'(Goal, Type),
 3461    !,
 3462    (   Type == load
 3463    ->  true
 3464    ;   '$current_source_module'(Module),
 3465        '$add_directive_wic'(Module:Goal)
 3466    ).
 3467'$add_directive_wic2'(Goal, _) :-
 3468    (   '$compilation_mode'(qlf)    % no problem for qlf files
 3469    ->  true
 3470    ;   print_message(error, mixed_directive(Goal))
 3471    ).
 3472
 3473'$common_goal_type'((A,B), Type) :-
 3474    !,
 3475    '$common_goal_type'(A, Type),
 3476    '$common_goal_type'(B, Type).
 3477'$common_goal_type'((A;B), Type) :-
 3478    !,
 3479    '$common_goal_type'(A, Type),
 3480    '$common_goal_type'(B, Type).
 3481'$common_goal_type'((A->B), Type) :-
 3482    !,
 3483    '$common_goal_type'(A, Type),
 3484    '$common_goal_type'(B, Type).
 3485'$common_goal_type'(Goal, Type) :-
 3486    '$goal_type'(Goal, Type).
 3487
 3488'$goal_type'(Goal, Type) :-
 3489    (   '$load_goal'(Goal)
 3490    ->  Type = load
 3491    ;   Type = call
 3492    ).
 3493
 3494'$load_goal'([_|_]).
 3495'$load_goal'(consult(_)).
 3496'$load_goal'(load_files(_)).
 3497'$load_goal'(load_files(_,Options)) :-
 3498    memberchk(qcompile(QlfMode), Options),
 3499    '$qlf_part_mode'(QlfMode).
 3500'$load_goal'(ensure_loaded(_)) :- '$compilation_mode'(wic).
 3501'$load_goal'(use_module(_))    :- '$compilation_mode'(wic).
 3502'$load_goal'(use_module(_, _)) :- '$compilation_mode'(wic).
 3503
 3504'$qlf_part_mode'(part).
 3505'$qlf_part_mode'(true).                 % compatibility
 3506
 3507
 3508                /********************************
 3509                *        COMPILE A CLAUSE       *
 3510                *********************************/
 $store_admin_clause(+Clause, ?Layout, +Owner, +SrcLoc) is det
Store a clause into the database for administrative purposes. This bypasses sanity checking.
 3517'$store_admin_clause'(Clause, Layout, Owner, SrcLoc) :-
 3518    Owner \== (-),
 3519    !,
 3520    setup_call_cleanup(
 3521        '$start_aux'(Owner, Context),
 3522        '$store_admin_clause2'(Clause, Layout, Owner, SrcLoc),
 3523        '$end_aux'(Owner, Context)).
 3524'$store_admin_clause'(Clause, Layout, File, SrcLoc) :-
 3525    '$store_admin_clause2'(Clause, Layout, File, SrcLoc).
 3526
 3527'$store_admin_clause2'(Clause, _Layout, File, SrcLoc) :-
 3528    (   '$compilation_mode'(database)
 3529    ->  '$record_clause'(Clause, File, SrcLoc)
 3530    ;   '$record_clause'(Clause, File, SrcLoc, Ref),
 3531        '$qlf_assert_clause'(Ref, development)
 3532    ).
 $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.
 3542'$store_clause'((_, _), _, _, _) :-
 3543    !,
 3544    print_message(error, cannot_redefine_comma),
 3545    fail.
 3546'$store_clause'(Clause, _Layout, File, SrcLoc) :-
 3547    '$valid_clause'(Clause),
 3548    !,
 3549    (   '$compilation_mode'(database)
 3550    ->  '$record_clause'(Clause, File, SrcLoc)
 3551    ;   '$record_clause'(Clause, File, SrcLoc, Ref),
 3552        '$qlf_assert_clause'(Ref, development)
 3553    ).
 3554
 3555'$valid_clause'(_) :-
 3556    current_prolog_flag(sandboxed_load, false),
 3557    !.
 3558'$valid_clause'(Clause) :-
 3559    \+ '$cross_module_clause'(Clause),
 3560    !.
 3561'$valid_clause'(Clause) :-
 3562    Error = error(Formal, _),
 3563    catch(prolog:sandbox_allowed_clause(Clause), Error, true),
 3564    !,
 3565    (   var(Formal)
 3566    ->  true
 3567    ;   print_message(error, Error),
 3568        fail
 3569    ).
 3570'$valid_clause'(Clause) :-
 3571    print_message(error,
 3572                  error(permission_error(assert,
 3573                                         sandboxed_clause,
 3574                                         Clause), _)),
 3575    fail.
 3576
 3577'$cross_module_clause'(Clause) :-
 3578    '$head_module'(Clause, Module),
 3579    \+ '$current_source_module'(Module).
 3580
 3581'$head_module'(Var, _) :-
 3582    var(Var), !, fail.
 3583'$head_module'((Head :- _), Module) :-
 3584    '$head_module'(Head, Module).
 3585'$head_module'(Module:_, Module).
 3586
 3587'$clause_source'('$source_location'(File,Line):Clause, Clause, File:Line) :- !.
 3588'$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.
 3595:- public
 3596    '$store_clause'/2. 3597
 3598'$store_clause'(Term, Id) :-
 3599    '$clause_source'(Term, Clause, SrcLoc),
 3600    '$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?
 3621compile_aux_clauses(_Clauses) :-
 3622    current_prolog_flag(xref, true),
 3623    !.
 3624compile_aux_clauses(Clauses) :-
 3625    source_location(File, _Line),
 3626    '$compile_aux_clauses'(Clauses, File).
 3627
 3628'$compile_aux_clauses'(Clauses, File) :-
 3629    setup_call_cleanup(
 3630        '$start_aux'(File, Context),
 3631        '$store_aux_clauses'(Clauses, File),
 3632        '$end_aux'(File, Context)).
 3633
 3634'$store_aux_clauses'(Clauses, File) :-
 3635    is_list(Clauses),
 3636    !,
 3637    forall('$member'(C,Clauses),
 3638           '$compile_term'(C, _Layout, File)).
 3639'$store_aux_clauses'(Clause, File) :-
 3640    '$compile_term'(Clause, _Layout, File).
 3641
 3642
 3643		 /*******************************
 3644		 *            STAGING		*
 3645		 *******************************/
 $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.
 3655'$stage_file'(Target, Stage) :-
 3656    file_directory_name(Target, Dir),
 3657    file_base_name(Target, File),
 3658    current_prolog_flag(pid, Pid),
 3659    format(atom(Stage), '~w/.~w.~d', [Dir,File,Pid]).
 3660
 3661'$install_staged_file'(exit, Staged, Target, error) :-
 3662    !,
 3663    rename_file(Staged, Target).
 3664'$install_staged_file'(exit, Staged, Target, OnError) :-
 3665    !,
 3666    InstallError = error(_,_),
 3667    catch(rename_file(Staged, Target),
 3668          InstallError,
 3669          '$install_staged_error'(OnError, InstallError, Staged, Target)).
 3670'$install_staged_file'(_, Staged, _, _OnError) :-
 3671    E = error(_,_),
 3672    catch(delete_file(Staged), E, true).
 3673
 3674'$install_staged_error'(OnError, Error, Staged, _Target) :-
 3675    E = error(_,_),
 3676    catch(delete_file(Staged), E, true),
 3677    (   OnError = silent
 3678    ->  true
 3679    ;   OnError = fail
 3680    ->  fail
 3681    ;   print_message(warning, Error)
 3682    ).
 3683
 3684
 3685                 /*******************************
 3686                 *             READING          *
 3687                 *******************************/
 3688
 3689:- multifile
 3690    prolog:comment_hook/3.                  % hook for read_clause/3
 3691
 3692
 3693                 /*******************************
 3694                 *       FOREIGN INTERFACE      *
 3695                 *******************************/
 3696
 3697%       call-back from PL_register_foreign().  First argument is the module
 3698%       into which the foreign predicate is loaded and second is a term
 3699%       describing the arguments.
 3700
 3701:- dynamic
 3702    '$foreign_registered'/2. 3703
 3704                 /*******************************
 3705                 *   TEMPORARY TERM EXPANSION   *
 3706                 *******************************/
 3707
 3708% Provide temporary definitions for the boot-loader.  These are replaced
 3709% by the real thing in load.pl
 3710
 3711:- dynamic
 3712    '$expand_goal'/2,
 3713    '$expand_term'/4. 3714
 3715'$expand_goal'(In, In).
 3716'$expand_term'(In, Layout, In, Layout).
 3717
 3718
 3719                 /*******************************
 3720                 *         TYPE SUPPORT         *
 3721                 *******************************/
 3722
 3723'$type_error'(Type, Value) :-
 3724    (   var(Value)
 3725    ->  throw(error(instantiation_error, _))
 3726    ;   throw(error(type_error(Type, Value), _))
 3727    ).
 3728
 3729'$domain_error'(Type, Value) :-
 3730    throw(error(domain_error(Type, Value), _)).
 3731
 3732'$existence_error'(Type, Object) :-
 3733    throw(error(existence_error(Type, Object), _)).
 3734
 3735'$permission_error'(Action, Type, Term) :-
 3736    throw(error(permission_error(Action, Type, Term), _)).
 3737
 3738'$instantiation_error'(_Var) :-
 3739    throw(error(instantiation_error, _)).
 3740
 3741'$uninstantiation_error'(NonVar) :-
 3742    throw(error(uninstantiation_error(NonVar), _)).
 3743
 3744'$must_be'(list, X) :- !,
 3745    '$skip_list'(_, X, Tail),
 3746    (   Tail == []
 3747    ->  true
 3748    ;   '$type_error'(list, Tail)
 3749    ).
 3750'$must_be'(options, X) :- !,
 3751    (   '$is_options'(X)
 3752    ->  true
 3753    ;   '$type_error'(options, X)
 3754    ).
 3755'$must_be'(atom, X) :- !,
 3756    (   atom(X)
 3757    ->  true
 3758    ;   '$type_error'(atom, X)
 3759    ).
 3760'$must_be'(integer, X) :- !,
 3761    (   integer(X)
 3762    ->  true
 3763    ;   '$type_error'(integer, X)
 3764    ).
 3765'$must_be'(between(Low,High), X) :- !,
 3766    (   integer(X)
 3767    ->  (   between(Low, High, X)
 3768        ->  true
 3769        ;   '$domain_error'(between(Low,High), X)
 3770        )
 3771    ;   '$type_error'(integer, X)
 3772    ).
 3773'$must_be'(callable, X) :- !,
 3774    (   callable(X)
 3775    ->  true
 3776    ;   '$type_error'(callable, X)
 3777    ).
 3778'$must_be'(acyclic, X) :- !,
 3779    (   acyclic_term(X)
 3780    ->  true
 3781    ;   '$domain_error'(acyclic_term, X)
 3782    ).
 3783'$must_be'(oneof(Type, Domain, List), X) :- !,
 3784    '$must_be'(Type, X),
 3785    (   memberchk(X, List)
 3786    ->  true
 3787    ;   '$domain_error'(Domain, X)
 3788    ).
 3789'$must_be'(boolean, X) :- !,
 3790    (   (X == true ; X == false)
 3791    ->  true
 3792    ;   '$type_error'(boolean, X)
 3793    ).
 3794'$must_be'(ground, X) :- !,
 3795    (   ground(X)
 3796    ->  true
 3797    ;   '$instantiation_error'(X)
 3798    ).
 3799'$must_be'(filespec, X) :- !,
 3800    (   (   atom(X)
 3801        ;   string(X)
 3802        ;   compound(X),
 3803            compound_name_arity(X, _, 1)
 3804        )
 3805    ->  true
 3806    ;   '$type_error'(filespec, X)
 3807    ).
 3808
 3809% Use for debugging
 3810%'$must_be'(Type, _X) :- format('Unknown $must_be type: ~q~n', [Type]).
 3811
 3812
 3813                /********************************
 3814                *       LIST PROCESSING         *
 3815                *********************************/
 3816
 3817'$member'(El, [H|T]) :-
 3818    '$member_'(T, El, H).
 3819
 3820'$member_'(_, El, El).
 3821'$member_'([H|T], El, _) :-
 3822    '$member_'(T, El, H).
 3823
 3824
 3825'$append'([], L, L).
 3826'$append'([H|T], L, [H|R]) :-
 3827    '$append'(T, L, R).
 3828
 3829'$select'(X, [X|Tail], Tail).
 3830'$select'(Elem, [Head|Tail], [Head|Rest]) :-
 3831    '$select'(Elem, Tail, Rest).
 3832
 3833'$reverse'(L1, L2) :-
 3834    '$reverse'(L1, [], L2).
 3835
 3836'$reverse'([], List, List).
 3837'$reverse'([Head|List1], List2, List3) :-
 3838    '$reverse'(List1, [Head|List2], List3).
 3839
 3840'$delete'([], _, []) :- !.
 3841'$delete'([Elem|Tail], Elem, Result) :-
 3842    !,
 3843    '$delete'(Tail, Elem, Result).
 3844'$delete'([Head|Tail], Elem, [Head|Rest]) :-
 3845    '$delete'(Tail, Elem, Rest).
 3846
 3847'$last'([H|T], Last) :-
 3848    '$last'(T, H, Last).
 3849
 3850'$last'([], Last, Last).
 3851'$last'([H|T], _, Last) :-
 3852    '$last'(T, H, Last).
 length(?List, ?N)
Is true when N is the length of List.
 3859:- '$iso'((length/2)). 3860
 3861length(List, Length) :-
 3862    var(Length),
 3863    !,
 3864    '$skip_list'(Length0, List, Tail),
 3865    (   Tail == []
 3866    ->  Length = Length0                    % +,-
 3867    ;   var(Tail)
 3868    ->  Tail \== Length,                    % avoid length(L,L)
 3869        '$length3'(Tail, Length, Length0)   % -,-
 3870    ;   throw(error(type_error(list, List),
 3871                    context(length/2, _)))
 3872    ).
 3873length(List, Length) :-
 3874    integer(Length),
 3875    Length >= 0,
 3876    !,
 3877    '$skip_list'(Length0, List, Tail),
 3878    (   Tail == []                          % proper list
 3879    ->  Length = Length0
 3880    ;   var(Tail)
 3881    ->  Extra is Length-Length0,
 3882        '$length'(Tail, Extra)
 3883    ;   throw(error(type_error(list, List),
 3884                    context(length/2, _)))
 3885    ).
 3886length(_, Length) :-
 3887    integer(Length),
 3888    !,
 3889    throw(error(domain_error(not_less_than_zero, Length),
 3890                context(length/2, _))).
 3891length(_, Length) :-
 3892    throw(error(type_error(integer, Length),
 3893                context(length/2, _))).
 3894
 3895'$length3'([], N, N).
 3896'$length3'([_|List], N, N0) :-
 3897    N1 is N0+1,
 3898    '$length3'(List, N, N1).
 3899
 3900
 3901                 /*******************************
 3902                 *       OPTION PROCESSING      *
 3903                 *******************************/
 $is_options(@Term) is semidet
True if Term looks like it provides options.
 3909'$is_options'(Map) :-
 3910    is_dict(Map, _),
 3911    !.
 3912'$is_options'(List) :-
 3913    is_list(List),
 3914    (   List == []
 3915    ->  true
 3916    ;   List = [H|_],
 3917        '$is_option'(H, _, _)
 3918    ).
 3919
 3920'$is_option'(Var, _, _) :-
 3921    var(Var), !, fail.
 3922'$is_option'(F, Name, Value) :-
 3923    functor(F, _, 1),
 3924    !,
 3925    F =.. [Name,Value].
 3926'$is_option'(Name=Value, Name, Value).
 $option(?Opt, +Options) is semidet
 3930'$option'(Opt, Options) :-
 3931    is_dict(Options),
 3932    !,
 3933    [Opt] :< Options.
 3934'$option'(Opt, Options) :-
 3935    memberchk(Opt, Options).
 $option(?Opt, +Options, +Default) is det
 3939'$option'(Term, Options, Default) :-
 3940    arg(1, Term, Value),
 3941    functor(Term, Name, 1),
 3942    (   is_dict(Options)
 3943    ->  (   get_dict(Name, Options, GVal)
 3944        ->  Value = GVal
 3945        ;   Value = Default
 3946        )
 3947    ;   functor(Gen, Name, 1),
 3948        arg(1, Gen, GVal),
 3949        (   memberchk(Gen, Options)
 3950        ->  Value = GVal
 3951        ;   Value = Default
 3952        )
 3953    ).
 $select_option(?Opt, +Options, -Rest) is semidet
Select an option from Options.
Arguments:
Rest- is always a map.
 3961'$select_option'(Opt, Options, Rest) :-
 3962    select_dict([Opt], Options, Rest).
 $merge_options(+New, +Default, -Merged) is det
Add/replace options specified in New.
Arguments:
Merged- is always a map.
 3970'$merge_options'(New, Old, Merged) :-
 3971    put_dict(New, Old, Merged).
 3972
 3973
 3974                 /*******************************
 3975                 *   HANDLE TRACER 'L'-COMMAND  *
 3976                 *******************************/
 3977
 3978:- public '$prolog_list_goal'/1. 3979
 3980:- multifile
 3981    user:prolog_list_goal/1. 3982
 3983'$prolog_list_goal'(Goal) :-
 3984    user:prolog_list_goal(Goal),
 3985    !.
 3986'$prolog_list_goal'(Goal) :-
 3987    use_module(library(listing), [listing/1]),
 3988    @(listing(Goal), user).
 3989
 3990
 3991		 /*******************************
 3992		 *              MISC		*
 3993		 *******************************/
 3994
 3995'$pi_head'(PI, Head) :-
 3996    var(PI),
 3997    var(Head),
 3998    '$instantiation_error'([PI,Head]).
 3999'$pi_head'(M:PI, M:Head) :-
 4000    !,
 4001    '$pi_head'(PI, Head).
 4002'$pi_head'(Name/Arity, Head) :-
 4003    !,
 4004    '$head_name_arity'(Head, Name, Arity).
 4005'$pi_head'(Name//DCGArity, Head) :-
 4006    !,
 4007    (   nonvar(DCGArity)
 4008    ->  Arity is DCGArity+2,
 4009        '$head_name_arity'(Head, Name, Arity)
 4010    ;   '$head_name_arity'(Head, Name, Arity),
 4011        DCGArity is Arity - 2
 4012    ).
 4013'$pi_head'(PI, _) :-
 4014    '$type_error'(predicate_indicator, PI).
 4015
 4016'$head_name_arity'(Goal, Name, Arity) :-
 4017    (   atom(Goal)
 4018    ->  Name = Goal, Arity = 0
 4019    ;   compound(Goal)
 4020    ->  compound_name_arity(Goal, Name, Arity)
 4021    ;   var(Goal)
 4022    ->  (   Arity == 0
 4023        ->  (   atom(Name)
 4024            ->  Goal = Name
 4025            ;   blob(Name, closure)
 4026            ->  Goal = Name
 4027            ;   '$type_error'(atom, Name)
 4028            )
 4029        ;   compound_name_arity(Goal, Name, Arity)
 4030        )
 4031    ;   '$type_error'(callable, Goal)
 4032    ).
 4033
 4034
 4035                 /*******************************
 4036                 *             HALT             *
 4037                 *******************************/
 4038
 4039:- '$iso'((halt/0)). 4040
 4041halt :-
 4042    halt(0).
 at_halt(:Goal)
Register Goal to be called if the system halts.
To be done
- : get location into the error message
 4051:- meta_predicate at_halt(0). 4052:- dynamic        system:term_expansion/2, '$at_halt'/2. 4053:- multifile      system:term_expansion/2, '$at_halt'/2. 4054
 4055system:term_expansion((:- at_halt(Goal)),
 4056                      system:'$at_halt'(Module:Goal, File:Line)) :-
 4057    \+ current_prolog_flag(xref, true),
 4058    source_location(File, Line),
 4059    '$current_source_module'(Module).
 4060
 4061at_halt(Goal) :-
 4062    asserta('$at_halt'(Goal, (-):0)).
 4063
 4064:- public '$run_at_halt'/0. 4065
 4066'$run_at_halt' :-
 4067    forall(clause('$at_halt'(Goal, Src), true, Ref),
 4068           ( '$call_at_halt'(Goal, Src),
 4069             erase(Ref)
 4070           )).
 4071
 4072'$call_at_halt'(Goal, _Src) :-
 4073    catch(Goal, E, true),
 4074    !,
 4075    (   var(E)
 4076    ->  true
 4077    ;   subsumes_term(cancel_halt(_), E)
 4078    ->  '$print_message'(informational, E),
 4079        fail
 4080    ;   '$print_message'(error, E)
 4081    ).
 4082'$call_at_halt'(Goal, _Src) :-
 4083    '$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.
 4091cancel_halt(Reason) :-
 4092    throw(cancel_halt(Reason)).
 4093
 4094
 4095                /********************************
 4096                *      LOAD OTHER MODULES       *
 4097                *********************************/
 4098
 4099:- meta_predicate
 4100    '$load_wic_files'(:). 4101
 4102'$load_wic_files'(Files) :-
 4103    Files = Module:_,
 4104    '$execute_directive'('$set_source_module'(OldM, Module), []),
 4105    '$save_lex_state'(LexState, []),
 4106    '$style_check'(_, 0xC7),                % see style_name/2 in syspred.pl
 4107    '$compilation_mode'(OldC, wic),
 4108    consult(Files),
 4109    '$execute_directive'('$set_source_module'(OldM), []),
 4110    '$execute_directive'('$restore_lex_state'(LexState), []),
 4111    '$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.
 4119:- public '$load_additional_boot_files'/0. 4120
 4121'$load_additional_boot_files' :-
 4122    current_prolog_flag(argv, Argv),
 4123    '$get_files_argv'(Argv, Files),
 4124    (   Files \== []
 4125    ->  format('Loading additional boot files~n'),
 4126        '$load_wic_files'(user:Files),
 4127        format('additional boot files loaded~n')
 4128    ;   true
 4129    ).
 4130
 4131'$get_files_argv'([], []) :- !.
 4132'$get_files_argv'(['-c'|Files], Files) :- !.
 4133'$get_files_argv'([_|Rest], Files) :-
 4134    '$get_files_argv'(Rest, Files).
 4135
 4136'$:-'(('$boot_message'('Loading Prolog startup files~n', []),
 4137       source_location(File, _Line),
 4138       file_directory_name(File, Dir),
 4139       atom_concat(Dir, '/load.pl', LoadFile),
 4140       '$load_wic_files'(system:[LoadFile]),
 4141       (   current_prolog_flag(windows, true)
 4142       ->  atom_concat(Dir, '/menu.pl', MenuFile),
 4143           '$load_wic_files'(system:[MenuFile])
 4144       ;   true
 4145       ),
 4146       '$boot_message'('SWI-Prolog boot files loaded~n', []),
 4147       '$compilation_mode'(OldC, wic),
 4148       '$execute_directive'('$set_source_module'(user), []),
 4149       '$set_compilation_mode'(OldC)
 4150      ))