View source with raw comments or as raw
    1/*  Part of SWI-Prolog
    2
    3    Author:        Jan Wielemaker
    4    E-mail:        J.Wielemaker@vu.nl
    5    WWW:           http://www.swi-prolog.org
    6    Copyright (c)  1985-2019, University of Amsterdam
    7                              VU University Amsterdam
    8                              CWI, Amsterdam
    9    All rights reserved.
   10
   11    Redistribution and use in source and binary forms, with or without
   12    modification, are permitted provided that the following conditions
   13    are met:
   14
   15    1. Redistributions of source code must retain the above copyright
   16       notice, this list of conditions and the following disclaimer.
   17
   18    2. Redistributions in binary form must reproduce the above copyright
   19       notice, this list of conditions and the following disclaimer in
   20       the documentation and/or other materials provided with the
   21       distribution.
   22
   23    THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
   24    "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
   25    LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS
   26    FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE
   27    COPYRIGHT OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT,
   28    INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING,
   29    BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES;
   30    LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER
   31    CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
   32    LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN
   33    ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
   34    POSSIBILITY OF SUCH DAMAGE.
   35*/
   36
   37/*
   38Consult, derivates and basic things.   This  module  is  loaded  by  the
   39C-written  bootstrap  compiler.
   40
   41The $:- directive  is  executed  by  the  bootstrap  compiler,  but  not
   42inserted  in  the  intermediate  code  file.   Used  to print diagnostic
   43messages and start the Prolog defined compiler for  the  remaining  boot
   44modules.
   45
   46If you want  to  debug  this  module,  put  a  '$:-'(trace).   directive
   47somewhere.   The  tracer will work properly under boot compilation as it
   48will use the C defined write predicate  to  print  goals  and  does  not
   49attempt to call the Prolog defined trace interceptor.
   50*/
   51
   52                /********************************
   53                *    LOAD INTO MODULE SYSTEM    *
   54                ********************************/
   55
   56:- '$set_source_module'(system).   57
   58'$boot_message'(_Format, _Args) :-
   59    current_prolog_flag(verbose, silent),
   60    !.
   61'$boot_message'(Format, Args) :-
   62    format(Format, Args),
   63    !.
   64
   65'$:-'('$boot_message'('Loading boot file ...~n', [])).
   66
   67
   68                /********************************
   69                *          DIRECTIVES           *
   70                *********************************/
   71
   72:- meta_predicate
   73    dynamic(:),
   74    multifile(:),
   75    public(:),
   76    module_transparent(:),
   77    discontiguous(:),
   78    volatile(:),
   79    thread_local(:),
   80    noprofile(:),
   81    non_terminal(:),
   82    '$clausable'(:),
   83    '$iso'(:),
   84    '$hide'(:).
 dynamic +Spec is det
 multifile +Spec is det
 module_transparent +Spec is det
 discontiguous +Spec is det
 volatile +Spec is det
 thread_local +Spec is det
 noprofile(+Spec) is det
 public +Spec is det
 non_terminal(+Spec) is det
Predicate versions of standard directives that set predicate attributes. These predicates bail out with an error on the first failure (typically permission errors).
 $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(Level), abstract(true)) :-
  210    '$must_be'(between(0,0), Level).
  211'$attr_option'(volatile, volatile(true)).
  212'$attr_option'(multifile, multifile(true)).
  213'$attr_option'(discontiguous, discontiguous(true)).
  214'$attr_option'(shared, thread_local(false)).
  215'$attr_option'(local, thread_local(true)).
  216'$attr_option'(private, thread_local(true)).
 $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.
  225'$pattr_directive'(dynamic(Spec), M) :-
  226    '$set_pattr'(Spec, M, directive, dynamic(true)).
  227'$pattr_directive'(multifile(Spec), M) :-
  228    '$set_pattr'(Spec, M, directive, multifile(true)).
  229'$pattr_directive'(module_transparent(Spec), M) :-
  230    '$set_pattr'(Spec, M, directive, transparent(true)).
  231'$pattr_directive'(discontiguous(Spec), M) :-
  232    '$set_pattr'(Spec, M, directive, discontiguous(true)).
  233'$pattr_directive'(volatile(Spec), M) :-
  234    '$set_pattr'(Spec, M, directive, volatile(true)).
  235'$pattr_directive'(thread_local(Spec), M) :-
  236    '$set_pattr'(Spec, M, directive, thread_local(true)).
  237'$pattr_directive'(noprofile(Spec), M) :-
  238    '$set_pattr'(Spec, M, directive, noprofile(true)).
  239'$pattr_directive'(public(Spec), M) :-
  240    '$set_pattr'(Spec, M, directive, public(true)).
  241
  242:- '$iso'(((dynamic)/1, (multifile)/1, (discontiguous)/1)).  243
  244
  245                /********************************
  246                *       CALLING, CONTROL        *
  247                *********************************/
  248
  249:- noprofile((call/1,
  250              catch/3,
  251              once/1,
  252              ignore/1,
  253              call_cleanup/2,
  254              call_cleanup/3,
  255              setup_call_cleanup/3,
  256              setup_call_catcher_cleanup/4)).  257
  258:- meta_predicate
  259    ';'(0,0),
  260    ','(0,0),
  261    @(0,+),
  262    call(0),
  263    call(1,?),
  264    call(2,?,?),
  265    call(3,?,?,?),
  266    call(4,?,?,?,?),
  267    call(5,?,?,?,?,?),
  268    call(6,?,?,?,?,?,?),
  269    call(7,?,?,?,?,?,?,?),
  270    not(0),
  271    \+(0),
  272    '->'(0,0),
  273    '*->'(0,0),
  274    once(0),
  275    ignore(0),
  276    catch(0,?,0),
  277    reset(0,?,-),
  278    setup_call_cleanup(0,0,0),
  279    setup_call_catcher_cleanup(0,0,?,0),
  280    call_cleanup(0,0),
  281    call_cleanup(0,?,0),
  282    catch_with_backtrace(0,?,0),
  283    '$meta_call'(0).  284
  285:- '$iso'((call/1, (\+)/1, once/1, (;)/2, (',')/2, (->)/2, catch/3)).  286
  287% The control structures are always compiled, both   if they appear in a
  288% clause body and if they are handed  to   call/1.  The only way to call
  289% these predicates is by means of  call/2..   In  that case, we call the
  290% hole control structure again to get it compiled by call/1 and properly
  291% deal  with  !,  etc.  Another  reason  for  having  these  things   as
  292% predicates is to be able to define   properties for them, helping code
  293% analyzers.
  294
  295(M0:If ; M0:Then) :- !, call(M0:(If ; Then)).
  296(M1:If ; M2:Then) :-    call(M1:(If ; M2:Then)).
  297(G1   , G2)       :-    call((G1   , G2)).
  298(If  -> Then)     :-    call((If  -> Then)).
  299(If *-> Then)     :-    call((If *-> Then)).
  300@(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.

  314'$meta_call'(M:G) :-
  315    prolog_current_choice(Ch),
  316    '$meta_call'(G, M, Ch).
  317
  318'$meta_call'(Var, _, _) :-
  319    var(Var),
  320    !,
  321    '$instantiation_error'(Var).
  322'$meta_call'((A,B), M, Ch) :-
  323    !,
  324    '$meta_call'(A, M, Ch),
  325    '$meta_call'(B, M, Ch).
  326'$meta_call'((I->T;E), M, Ch) :-
  327    !,
  328    (   prolog_current_choice(Ch2),
  329        '$meta_call'(I, M, Ch2)
  330    ->  '$meta_call'(T, M, Ch)
  331    ;   '$meta_call'(E, M, Ch)
  332    ).
  333'$meta_call'((I*->T;E), M, Ch) :-
  334    !,
  335    (   prolog_current_choice(Ch2),
  336        '$meta_call'(I, M, Ch2)
  337    *-> '$meta_call'(T, M, Ch)
  338    ;   '$meta_call'(E, M, Ch)
  339    ).
  340'$meta_call'((I->T), M, Ch) :-
  341    !,
  342    (   prolog_current_choice(Ch2),
  343        '$meta_call'(I, M, Ch2)
  344    ->  '$meta_call'(T, M, Ch)
  345    ).
  346'$meta_call'((I*->T), M, Ch) :-
  347    !,
  348    prolog_current_choice(Ch2),
  349    '$meta_call'(I, M, Ch2),
  350    '$meta_call'(T, M, Ch).
  351'$meta_call'((A;B), M, Ch) :-
  352    !,
  353    (   '$meta_call'(A, M, Ch)
  354    ;   '$meta_call'(B, M, Ch)
  355    ).
  356'$meta_call'(\+(G), M, _) :-
  357    !,
  358    prolog_current_choice(Ch),
  359    \+ '$meta_call'(G, M, Ch).
  360'$meta_call'(call(G), M, _) :-
  361    !,
  362    prolog_current_choice(Ch),
  363    '$meta_call'(G, M, Ch).
  364'$meta_call'(M:G, _, Ch) :-
  365    !,
  366    '$meta_call'(G, M, Ch).
  367'$meta_call'(!, _, Ch) :-
  368    prolog_cut_to(Ch).
  369'$meta_call'(G, M, _Ch) :-
  370    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..
  386:- '$iso'((call/2,
  387           call/3,
  388           call/4,
  389           call/5,
  390           call/6,
  391           call/7,
  392           call/8)).  393
  394call(Goal) :-                           % make these available as predicates
  395    Goal.
  396call(Goal, A) :-
  397    call(Goal, A).
  398call(Goal, A, B) :-
  399    call(Goal, A, B).
  400call(Goal, A, B, C) :-
  401    call(Goal, A, B, C).
  402call(Goal, A, B, C, D) :-
  403    call(Goal, A, B, C, D).
  404call(Goal, A, B, C, D, E) :-
  405    call(Goal, A, B, C, D, E).
  406call(Goal, A, B, C, D, E, F) :-
  407    call(Goal, A, B, C, D, E, F).
  408call(Goal, A, B, C, D, E, F, G) :-
  409    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.
  416not(Goal) :-
  417    \+ Goal.
 \+ :Goal is semidet
Predicate version that allows for meta-calling.
  423\+ Goal :-
  424    \+ Goal.
 once(:Goal) is semidet
ISO predicate, acting as call((Goal, !)).
  430once(Goal) :-
  431    Goal,
  432    !.
 ignore(:Goal) is det
Call Goal, cut choice-points on success and succeed on failure. intended for calling side-effects and proceed on failure.
  439ignore(Goal) :-
  440    Goal,
  441    !.
  442ignore(_Goal).
  443
  444:- '$iso'((false/0)).
 false
Synonym for fail/0, providing a declarative reading.
  450false :-
  451    fail.
 catch(:Goal, +Catcher, :Recover)
ISO compliant exception handling.
  457catch(_Goal, _Catcher, _Recover) :-
  458    '$catch'.                       % Maps to I_CATCH, I_EXITCATCH
 prolog_cut_to(+Choice)
Cut all choice points after Choice
  464prolog_cut_to(_Choice) :-
  465    '$cut'.                         % Maps to I_CUTCHP
 reset(:Goal, ?Ball, -Continue)
Delimited continuation support.
  471reset(_Goal, _Ball, _Cont) :-
  472    '$reset'.
 shift(+Ball)
Shift control back to the enclosing reset/3
  478shift(Ball) :-
  479    '$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.

  493call_continuation([]).
  494call_continuation([TB|Rest]) :-
  495    (   Rest == []
  496    ->  '$call_continuation'(TB)
  497    ;   '$call_continuation'(TB),
  498        call_continuation(Rest)
  499    ).
 catch_with_backtrace(:Goal, ?Ball, :Recover)
As catch/3, but tell library(prolog_stack) to record a backtrace in case of an exception.
  506catch_with_backtrace(Goal, Ball, Recover) :-
  507    catch(Goal, Ball, Recover),
  508    '$no_lco'.
  509
  510'$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.
  520:- public '$recover_and_rethrow'/2.  521
  522'$recover_and_rethrow'(Goal, Exception) :-
  523    call_cleanup(Goal, throw(Exception)),
  524    !.
 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.
  539setup_call_catcher_cleanup(Setup, _Goal, _Catcher, _Cleanup) :-
  540    '$sig_atomic'(Setup),
  541    '$call_cleanup'.
  542
  543setup_call_cleanup(Setup, Goal, Cleanup) :-
  544    setup_call_catcher_cleanup(Setup, Goal, _Catcher, Cleanup).
  545
  546call_cleanup(Goal, Cleanup) :-
  547    setup_call_catcher_cleanup(true, Goal, _Catcher, Cleanup).
  548
  549call_cleanup(Goal, Catcher, Cleanup) :-
  550    setup_call_catcher_cleanup(true, Goal, Catcher, Cleanup).
  551
  552                 /*******************************
  553                 *       INITIALIZATION         *
  554                 *******************************/
  555
  556:- meta_predicate
  557    initialization(0, +).  558
  559:- multifile '$init_goal'/3.  560:- 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.

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

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

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

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

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