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

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

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

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

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

 1834'$record_included'([Parent|Parents], File, Path, Time,
 1835                   message(DoneMsgLevel,
 1836                           include_file(done(Level, file(File, Path))))) :-
 1837    source_location(SrcFile, Line),
 1838    !,
 1839    '$compilation_level'(Level),
 1840    '$load_msg_level'(include_file, Level, StartMsgLevel, DoneMsgLevel),
 1841    '$print_message'(StartMsgLevel,
 1842                     include_file(start(Level,
 1843                                        file(File, Path)))),
 1844    '$last'([Parent|Parents], Owner),
 1845    (   (   '$compilation_mode'(database)
 1846        ;   '$qlf_current_source'(Owner)
 1847        )
 1848    ->  '$store_admin_clause'(
 1849            system:'$included'(Parent, Line, Path, Time),
 1850            _, Owner, SrcFile:Line)
 1851    ;   '$qlf_include'(Owner, Parent, Line, Path, Time)
 1852    ).
 1853'$record_included'(_, _, _, _, true).
 $master_file(+File, -MasterFile)
Find the primary load file from included files.
 1859'$master_file'(File, MasterFile) :-
 1860    '$included'(MasterFile0, _Line, File, _Time),
 1861    !,
 1862    '$master_file'(MasterFile0, MasterFile).
 1863'$master_file'(File, File).
 1864
 1865
 1866'$skip_script_line'(_In, Options) :-
 1867    '$option'(check_script(false), Options),
 1868    !.
 1869'$skip_script_line'(In, _Options) :-
 1870    (   peek_char(In, #)
 1871    ->  skip(In, 10)
 1872    ;   true
 1873    ).
 1874
 1875'$set_encoding'(Stream, Options) :-
 1876    '$option'(encoding(Enc), Options),
 1877    !,
 1878    Enc \== default,
 1879    set_stream(Stream, encoding(Enc)).
 1880'$set_encoding'(_, _).
 1881
 1882
 1883'$prepare_load_stream'(In, Id, state(HasName,HasPos)) :-
 1884    (   stream_property(In, file_name(_))
 1885    ->  HasName = true,
 1886        (   stream_property(In, position(_))
 1887        ->  HasPos = true
 1888        ;   HasPos = false,
 1889            set_stream(In, record_position(true))
 1890        )
 1891    ;   HasName = false,
 1892        set_stream(In, file_name(Id)),
 1893        (   stream_property(In, position(_))
 1894        ->  HasPos = true
 1895        ;   HasPos = false,
 1896            set_stream(In, record_position(true))
 1897        )
 1898    ).
 1899
 1900'$restore_load_stream'(In, _State, Options) :-
 1901    memberchk(close(true), Options),
 1902    !,
 1903    close(In).
 1904'$restore_load_stream'(In, state(HasName, HasPos), _Options) :-
 1905    (   HasName == false
 1906    ->  set_stream(In, file_name(''))
 1907    ;   true
 1908    ),
 1909    (   HasPos == false
 1910    ->  set_stream(In, record_position(false))
 1911    ;   true
 1912    ).
 1913
 1914
 1915                 /*******************************
 1916                 *          DERIVED FILES       *
 1917                 *******************************/
 1918
 1919:- dynamic
 1920    '$derived_source_db'/3.         % Loaded, DerivedFrom, Time
 1921
 1922'$register_derived_source'(_, '-') :- !.
 1923'$register_derived_source'(Loaded, DerivedFrom) :-
 1924    retractall('$derived_source_db'(Loaded, _, _)),
 1925    time_file(DerivedFrom, Time),
 1926    assert('$derived_source_db'(Loaded, DerivedFrom, Time)).
 1927
 1928%       Auto-importing dynamic predicates is not very elegant and
 1929%       leads to problems with qsave_program/[1,2]
 1930
 1931'$derived_source'(Loaded, DerivedFrom, Time) :-
 1932    '$derived_source_db'(Loaded, DerivedFrom, Time).
 1933
 1934
 1935                /********************************
 1936                *       LOAD PREDICATES         *
 1937                *********************************/
 1938
 1939:- meta_predicate
 1940    ensure_loaded(:),
 1941    [:|+],
 1942    consult(:),
 1943    use_module(:),
 1944    use_module(:, +),
 1945    reexport(:),
 1946    reexport(:, +),
 1947    load_files(:),
 1948    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.
 1956ensure_loaded(Files) :-
 1957    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.
 1966use_module(Files) :-
 1967    load_files(Files, [ if(not_loaded),
 1968                        must_be_module(true)
 1969                      ]).
 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.
 1976use_module(File, Import) :-
 1977    load_files(File, [ if(not_loaded),
 1978                       must_be_module(true),
 1979                       imports(Import)
 1980                     ]).
 reexport(+Files)
As use_module/1, exporting all imported predicates.
 1986reexport(Files) :-
 1987    load_files(Files, [ if(not_loaded),
 1988                        must_be_module(true),
 1989                        reexport(true)
 1990                      ]).
 reexport(+File, +ImportList)
As use_module/1, re-exporting all imported predicates.
 1996reexport(File, Import) :-
 1997    load_files(File, [ if(not_loaded),
 1998                       must_be_module(true),
 1999                       imports(Import),
 2000                       reexport(true)
 2001                     ]).
 2002
 2003
 2004[X] :-
 2005    !,
 2006    consult(X).
 2007[M:F|R] :-
 2008    consult(M:[F|R]).
 2009
 2010consult(M:X) :-
 2011    X == user,
 2012    !,
 2013    flag('$user_consult', N, N+1),
 2014    NN is N + 1,
 2015    atom_concat('user://', NN, Id),
 2016    load_files(M:Id, [stream(user_input), check_script(false), silent(false)]).
 2017consult(List) :-
 2018    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.
 2025load_files(Files) :-
 2026    load_files(Files, []).
 2027load_files(Module:Files, Options) :-
 2028    '$must_be'(list, Options),
 2029    '$load_files'(Files, Module, Options).
 2030
 2031'$load_files'(X, _, _) :-
 2032    var(X),
 2033    !,
 2034    '$instantiation_error'(X).
 2035'$load_files'([], _, _) :- !.
 2036'$load_files'(Id, Module, Options) :-   % load_files(foo, [stream(In)])
 2037    '$option'(stream(_), Options),
 2038    !,
 2039    (   atom(Id)
 2040    ->  '$load_file'(Id, Module, Options)
 2041    ;   throw(error(type_error(atom, Id), _))
 2042    ).
 2043'$load_files'(List, Module, Options) :-
 2044    List = [_|_],
 2045    !,
 2046    '$must_be'(list, List),
 2047    '$load_file_list'(List, Module, Options).
 2048'$load_files'(File, Module, Options) :-
 2049    '$load_one_file'(File, Module, Options).
 2050
 2051'$load_file_list'([], _, _).
 2052'$load_file_list'([File|Rest], Module, Options) :-
 2053    E = error(_,_),
 2054    catch('$load_one_file'(File, Module, Options), E,
 2055          '$print_message'(error, E)),
 2056    '$load_file_list'(Rest, Module, Options).
 2057
 2058
 2059'$load_one_file'(Spec, Module, Options) :-
 2060    atomic(Spec),
 2061    '$option'(expand(Expand), Options, false),
 2062    Expand == true,
 2063    !,
 2064    expand_file_name(Spec, Expanded),
 2065    (   Expanded = [Load]
 2066    ->  true
 2067    ;   Load = Expanded
 2068    ),
 2069    '$load_files'(Load, Module, [expand(false)|Options]).
 2070'$load_one_file'(File, Module, Options) :-
 2071    strip_module(Module:File, Into, PlainFile),
 2072    '$load_file'(PlainFile, Into, Options).
 $noload(+Condition, +FullFile, +Options) is semidet
True of FullFile should not be loaded.
 2079'$noload'(true, _, _) :-
 2080    !,
 2081    fail.
 2082'$noload'(not_loaded, FullFile, _) :-
 2083    source_file(FullFile),
 2084    !.
 2085'$noload'(changed, Derived, _) :-
 2086    '$derived_source'(_FullFile, Derived, LoadTime),
 2087    time_file(Derived, Modified),
 2088    Modified @=< LoadTime,
 2089    !.
 2090'$noload'(changed, FullFile, Options) :-
 2091    '$time_source_file'(FullFile, LoadTime, user),
 2092    '$modified_id'(FullFile, Modified, Options),
 2093    Modified @=< LoadTime,
 2094    !.
 $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.
 2113'$qlf_file'(Spec, _, Spec, stream, Options) :-
 2114    '$option'(stream(_), Options),      % stream: no choice
 2115    !.
 2116'$qlf_file'(Spec, FullFile, FullFile, compile, _) :-
 2117    '$spec_extension'(Spec, Ext),       % user explicitly specified
 2118    user:prolog_file_type(Ext, prolog),
 2119    !.
 2120'$qlf_file'(Spec, FullFile, LoadFile, Mode, Options) :-
 2121    '$compilation_mode'(database),
 2122    file_name_extension(Base, PlExt, FullFile),
 2123    user:prolog_file_type(PlExt, prolog),
 2124    user:prolog_file_type(QlfExt, qlf),
 2125    file_name_extension(Base, QlfExt, QlfFile),
 2126    (   access_file(QlfFile, read),
 2127        (   '$qlf_out_of_date'(FullFile, QlfFile, Why)
 2128        ->  (   access_file(QlfFile, write)
 2129            ->  print_message(informational,
 2130                              qlf(recompile(Spec, FullFile, QlfFile, Why))),
 2131                Mode = qcompile,
 2132                LoadFile = FullFile
 2133            ;   Why == old,
 2134                current_prolog_flag(home, PlHome),
 2135                sub_atom(FullFile, 0, _, _, PlHome)
 2136            ->  print_message(silent,
 2137                              qlf(system_lib_out_of_date(Spec, QlfFile))),
 2138                Mode = qload,
 2139                LoadFile = QlfFile
 2140            ;   print_message(warning,
 2141                              qlf(can_not_recompile(Spec, QlfFile, Why))),
 2142                Mode = compile,
 2143                LoadFile = FullFile
 2144            )
 2145        ;   Mode = qload,
 2146            LoadFile = QlfFile
 2147        )
 2148    ->  !
 2149    ;   '$qlf_auto'(FullFile, QlfFile, Options)
 2150    ->  !, Mode = qcompile,
 2151        LoadFile = FullFile
 2152    ).
 2153'$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.
 2161'$qlf_out_of_date'(PlFile, QlfFile, Why) :-
 2162    (   access_file(PlFile, read)
 2163    ->  time_file(PlFile, PlTime),
 2164        time_file(QlfFile, QlfTime),
 2165        (   PlTime > QlfTime
 2166        ->  Why = old                   % PlFile is newer
 2167        ;   Error = error(Formal,_),
 2168            catch('$qlf_sources'(QlfFile, _Files), Error, true),
 2169            nonvar(Formal)              % QlfFile is incompatible
 2170        ->  Why = Error
 2171        ;   fail                        % QlfFile is up-to-date and ok
 2172        )
 2173    ;   fail                            % can not read .pl; try .qlf
 2174    ).
 $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.
 2182:- create_prolog_flag(qcompile, false, [type(atom)]). 2183
 2184'$qlf_auto'(PlFile, QlfFile, Options) :-
 2185    (   memberchk(qcompile(QlfMode), Options)
 2186    ->  true
 2187    ;   current_prolog_flag(qcompile, QlfMode),
 2188        \+ '$in_system_dir'(PlFile)
 2189    ),
 2190    (   QlfMode == auto
 2191    ->  true
 2192    ;   QlfMode == large,
 2193        size_file(PlFile, Size),
 2194        Size > 100000
 2195    ),
 2196    access_file(QlfFile, write).
 2197
 2198'$in_system_dir'(PlFile) :-
 2199    current_prolog_flag(home, Home),
 2200    sub_atom(PlFile, 0, _, _, Home).
 2201
 2202'$spec_extension'(File, Ext) :-
 2203    atom(File),
 2204    file_name_extension(_, Ext, File).
 2205'$spec_extension'(Spec, Ext) :-
 2206    compound(Spec),
 2207    arg(1, Spec, Arg),
 2208    '$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:
 2220:- dynamic
 2221    '$resolved_source_path'/2.                  % ?Spec, ?Path
 2222
 2223'$load_file'(File, Module, Options) :-
 2224    \+ memberchk(stream(_), Options),
 2225    user:prolog_load_file(Module:File, Options),
 2226    !.
 2227'$load_file'(File, Module, Options) :-
 2228    memberchk(stream(_), Options),
 2229    !,
 2230    '$assert_load_context_module'(File, Module, Options),
 2231    '$qdo_load_file'(File, File, Module, Action, Options),
 2232    '$run_initialization'(File, Action, Options).
 2233'$load_file'(File, Module, Options) :-
 2234    '$resolved_source_path'(File, FullFile, Options),
 2235    !,
 2236    '$already_loaded'(File, FullFile, Module, Options).
 2237'$load_file'(File, Module, Options) :-
 2238    '$resolve_source_path'(File, FullFile, Options),
 2239    '$mt_load_file'(File, FullFile, Module, Options),
 2240    '$register_resource_file'(FullFile).
 $resolved_source_path(+File, -FullFile, +Options) is semidet
True when File has already been resolved to an absolute path.
 2246'$resolved_source_path'(File, FullFile, Options) :-
 2247    '$resolved_source_path'(File, FullFile),
 2248    (   '$source_file_property'(FullFile, from_state, true)
 2249    ;   '$source_file_property'(FullFile, resource, true)
 2250    ;   '$option'(if(If), Options, true),
 2251        '$noload'(If, FullFile, Options)
 2252    ),
 2253    !.
 $resolve_source_path(+File, -FullFile, Options) is det
Resolve a source file specification to an absolute path. May throw existence and other errors.
 2260'$resolve_source_path'(File, FullFile, _Options) :-
 2261    absolute_file_name(File, FullFile,
 2262                       [ file_type(prolog),
 2263                         access(read)
 2264                       ]),
 2265    '$register_resolved_source_path'(File, FullFile).
 2266
 2267
 2268'$register_resolved_source_path'(File, FullFile) :-
 2269    '$resolved_source_path'(File, FullFile),
 2270    !.
 2271'$register_resolved_source_path'(File, FullFile) :-
 2272    compound(File),
 2273    !,
 2274    asserta('$resolved_source_path'(File, FullFile)).
 2275'$register_resolved_source_path'(_, _).
 $translated_source(+Old, +New) is det
Called from loading a QLF state when source files are being renamed.
 2281:- public '$translated_source'/2. 2282'$translated_source'(Old, New) :-
 2283    forall(retract('$resolved_source_path'(File, Old)),
 2284           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.
 2291'$register_resource_file'(FullFile) :-
 2292    (   sub_atom(FullFile, 0, _, _, 'res://')
 2293    ->  '$set_source_file'(FullFile, resource, true)
 2294    ;   true
 2295    ).
 $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.
 2308'$already_loaded'(_File, FullFile, Module, Options) :-
 2309    '$assert_load_context_module'(FullFile, Module, Options),
 2310    '$current_module'(LoadModules, FullFile),
 2311    !,
 2312    (   atom(LoadModules)
 2313    ->  LoadModule = LoadModules
 2314    ;   LoadModules = [LoadModule|_]
 2315    ),
 2316    '$import_from_loaded_module'(LoadModule, Module, Options).
 2317'$already_loaded'(_, _, user, _) :- !.
 2318'$already_loaded'(File, _, Module, Options) :-
 2319    '$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.

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

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