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

  394'$meta_call'(M:G) :-
  395    prolog_current_choice(Ch),
  396    '$meta_call'(G, M, Ch).
  397
  398'$meta_call'(Var, _, _) :-
  399    var(Var),
  400    !,
  401    '$instantiation_error'(Var).
  402'$meta_call'((A,B), M, Ch) :-
  403    !,
  404    '$meta_call'(A, M, Ch),
  405    '$meta_call'(B, M, Ch).
  406'$meta_call'((I->T;E), M, Ch) :-
  407    !,
  408    (   prolog_current_choice(Ch2),
  409        '$meta_call'(I, M, Ch2)
  410    ->  '$meta_call'(T, M, Ch)
  411    ;   '$meta_call'(E, M, Ch)
  412    ).
  413'$meta_call'((I*->T;E), M, Ch) :-
  414    !,
  415    (   prolog_current_choice(Ch2),
  416        '$meta_call'(I, M, Ch2)
  417    *-> '$meta_call'(T, M, Ch)
  418    ;   '$meta_call'(E, M, Ch)
  419    ).
  420'$meta_call'((I->T), M, Ch) :-
  421    !,
  422    (   prolog_current_choice(Ch2),
  423        '$meta_call'(I, M, Ch2)
  424    ->  '$meta_call'(T, M, Ch)
  425    ).
  426'$meta_call'((I*->T), M, Ch) :-
  427    !,
  428    prolog_current_choice(Ch2),
  429    '$meta_call'(I, M, Ch2),
  430    '$meta_call'(T, M, Ch).
  431'$meta_call'((A;B), M, Ch) :-
  432    !,
  433    (   '$meta_call'(A, M, Ch)
  434    ;   '$meta_call'(B, M, Ch)
  435    ).
  436'$meta_call'(\+(G), M, _) :-
  437    !,
  438    prolog_current_choice(Ch),
  439    \+ '$meta_call'(G, M, Ch).
  440'$meta_call'(call(G), M, _) :-
  441    !,
  442    prolog_current_choice(Ch),
  443    '$meta_call'(G, M, Ch).
  444'$meta_call'(M:G, _, Ch) :-
  445    !,
  446    '$meta_call'(G, M, Ch).
  447'$meta_call'(!, _, Ch) :-
  448    prolog_cut_to(Ch).
  449'$meta_call'(G, M, _Ch) :-
  450    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..
  466:- '$iso'((call/2,
  467           call/3,
  468           call/4,
  469           call/5,
  470           call/6,
  471           call/7,
  472           call/8)).  473
  474call(Goal) :-                           % make these available as predicates
  475    Goal.
  476call(Goal, A) :-
  477    call(Goal, A).
  478call(Goal, A, B) :-
  479    call(Goal, A, B).
  480call(Goal, A, B, C) :-
  481    call(Goal, A, B, C).
  482call(Goal, A, B, C, D) :-
  483    call(Goal, A, B, C, D).
  484call(Goal, A, B, C, D, E) :-
  485    call(Goal, A, B, C, D, E).
  486call(Goal, A, B, C, D, E, F) :-
  487    call(Goal, A, B, C, D, E, F).
  488call(Goal, A, B, C, D, E, F, G) :-
  489    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.
  496not(Goal) :-
  497    \+ Goal.
 \+ :Goal is semidet
Predicate version that allows for meta-calling.
  503\+ Goal :-
  504    \+ Goal.
 once(:Goal) is semidet
ISO predicate, acting as call((Goal, !)).
  510once(Goal) :-
  511    Goal,
  512    !.
 ignore(:Goal) is det
Call Goal, cut choice-points on success and succeed on failure. intended for calling side-effects and proceed on failure.
  519ignore(Goal) :-
  520    Goal,
  521    !.
  522ignore(_Goal).
  523
  524:- '$iso'((false/0)).
 false
Synonym for fail/0, providing a declarative reading.
  530false :-
  531    fail.
 catch(:Goal, +Catcher, :Recover)
ISO compliant exception handling.
  537catch(_Goal, _Catcher, _Recover) :-
  538    '$catch'.                       % Maps to I_CATCH, I_EXITCATCH
 prolog_cut_to(+Choice)
Cut all choice points after Choice
  544prolog_cut_to(_Choice) :-
  545    '$cut'.                         % Maps to I_CUTCHP
 reset(:Goal, ?Ball, -Continue)
Delimited continuation support.
  551reset(_Goal, _Ball, _Cont) :-
  552    '$reset'.
 shift(+Ball)
Shift control back to the enclosing reset/3
  558shift(Ball) :-
  559    '$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.

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

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

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

 1913'$record_included'([Parent|Parents], File, Path, Time,
 1914                   message(DoneMsgLevel,
 1915                           include_file(done(Level, file(File, Path))))) :-
 1916    source_location(SrcFile, Line),
 1917    !,
 1918    '$compilation_level'(Level),
 1919    '$load_msg_level'(include_file, Level, StartMsgLevel, DoneMsgLevel),
 1920    '$print_message'(StartMsgLevel,
 1921                     include_file(start(Level,
 1922                                        file(File, Path)))),
 1923    '$last'([Parent|Parents], Owner),
 1924    (   (   '$compilation_mode'(database)
 1925        ;   '$qlf_current_source'(Owner)
 1926        )
 1927    ->  '$store_admin_clause'(
 1928            system:'$included'(Parent, Line, Path, Time),
 1929            _, Owner, SrcFile:Line)
 1930    ;   '$qlf_include'(Owner, Parent, Line, Path, Time)
 1931    ).
 1932'$record_included'(_, _, _, _, true).
 $master_file(+File, -MasterFile)
Find the primary load file from included files.
 1938'$master_file'(File, MasterFile) :-
 1939    '$included'(MasterFile0, _Line, File, _Time),
 1940    !,
 1941    '$master_file'(MasterFile0, MasterFile).
 1942'$master_file'(File, File).
 1943
 1944
 1945'$skip_script_line'(_In, Options) :-
 1946    '$option'(check_script(false), Options),
 1947    !.
 1948'$skip_script_line'(In, _Options) :-
 1949    (   peek_char(In, #)
 1950    ->  skip(In, 10)
 1951    ;   true
 1952    ).
 1953
 1954'$set_encoding'(Stream, Options) :-
 1955    '$option'(encoding(Enc), Options),
 1956    !,
 1957    Enc \== default,
 1958    set_stream(Stream, encoding(Enc)).
 1959'$set_encoding'(_, _).
 1960
 1961
 1962'$prepare_load_stream'(In, Id, state(HasName,HasPos)) :-
 1963    (   stream_property(In, file_name(_))
 1964    ->  HasName = true,
 1965        (   stream_property(In, position(_))
 1966        ->  HasPos = true
 1967        ;   HasPos = false,
 1968            set_stream(In, record_position(true))
 1969        )
 1970    ;   HasName = false,
 1971        set_stream(In, file_name(Id)),
 1972        (   stream_property(In, position(_))
 1973        ->  HasPos = true
 1974        ;   HasPos = false,
 1975            set_stream(In, record_position(true))
 1976        )
 1977    ).
 1978
 1979'$restore_load_stream'(In, _State, Options) :-
 1980    memberchk(close(true), Options),
 1981    !,
 1982    close(In).
 1983'$restore_load_stream'(In, state(HasName, HasPos), _Options) :-
 1984    (   HasName == false
 1985    ->  set_stream(In, file_name(''))
 1986    ;   true
 1987    ),
 1988    (   HasPos == false
 1989    ->  set_stream(In, record_position(false))
 1990    ;   true
 1991    ).
 1992
 1993
 1994                 /*******************************
 1995                 *          DERIVED FILES       *
 1996                 *******************************/
 1997
 1998:- dynamic
 1999    '$derived_source_db'/3.         % Loaded, DerivedFrom, Time
 2000
 2001'$register_derived_source'(_, '-') :- !.
 2002'$register_derived_source'(Loaded, DerivedFrom) :-
 2003    retractall('$derived_source_db'(Loaded, _, _)),
 2004    time_file(DerivedFrom, Time),
 2005    assert('$derived_source_db'(Loaded, DerivedFrom, Time)).
 2006
 2007%       Auto-importing dynamic predicates is not very elegant and
 2008%       leads to problems with qsave_program/[1,2]
 2009
 2010'$derived_source'(Loaded, DerivedFrom, Time) :-
 2011    '$derived_source_db'(Loaded, DerivedFrom, Time).
 2012
 2013
 2014                /********************************
 2015                *       LOAD PREDICATES         *
 2016                *********************************/
 2017
 2018:- meta_predicate
 2019    ensure_loaded(:),
 2020    [:|+],
 2021    consult(:),
 2022    use_module(:),
 2023    use_module(:, +),
 2024    reexport(:),
 2025    reexport(:, +),
 2026    load_files(:),
 2027    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.
 2035ensure_loaded(Files) :-
 2036    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.
 2045use_module(Files) :-
 2046    load_files(Files, [ if(not_loaded),
 2047                        must_be_module(true)
 2048                      ]).
 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.
 2055use_module(File, Import) :-
 2056    load_files(File, [ if(not_loaded),
 2057                       must_be_module(true),
 2058                       imports(Import)
 2059                     ]).
 reexport(+Files)
As use_module/1, exporting all imported predicates.
 2065reexport(Files) :-
 2066    load_files(Files, [ if(not_loaded),
 2067                        must_be_module(true),
 2068                        reexport(true)
 2069                      ]).
 reexport(+File, +ImportList)
As use_module/1, re-exporting all imported predicates.
 2075reexport(File, Import) :-
 2076    load_files(File, [ if(not_loaded),
 2077                       must_be_module(true),
 2078                       imports(Import),
 2079                       reexport(true)
 2080                     ]).
 2081
 2082
 2083[X] :-
 2084    !,
 2085    consult(X).
 2086[M:F|R] :-
 2087    consult(M:[F|R]).
 2088
 2089consult(M:X) :-
 2090    X == user,
 2091    !,
 2092    flag('$user_consult', N, N+1),
 2093    NN is N + 1,
 2094    atom_concat('user://', NN, Id),
 2095    load_files(M:Id, [stream(user_input), check_script(false), silent(false)]).
 2096consult(List) :-
 2097    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.
 2104load_files(Files) :-
 2105    load_files(Files, []).
 2106load_files(Module:Files, Options) :-
 2107    '$must_be'(list, Options),
 2108    '$load_files'(Files, Module, Options).
 2109
 2110'$load_files'(X, _, _) :-
 2111    var(X),
 2112    !,
 2113    '$instantiation_error'(X).
 2114'$load_files'([], _, _) :- !.
 2115'$load_files'(Id, Module, Options) :-   % load_files(foo, [stream(In)])
 2116    '$option'(stream(_), Options),
 2117    !,
 2118    (   atom(Id)
 2119    ->  '$load_file'(Id, Module, Options)
 2120    ;   throw(error(type_error(atom, Id), _))
 2121    ).
 2122'$load_files'(List, Module, Options) :-
 2123    List = [_|_],
 2124    !,
 2125    '$must_be'(list, List),
 2126    '$load_file_list'(List, Module, Options).
 2127'$load_files'(File, Module, Options) :-
 2128    '$load_one_file'(File, Module, Options).
 2129
 2130'$load_file_list'([], _, _).
 2131'$load_file_list'([File|Rest], Module, Options) :-
 2132    E = error(_,_),
 2133    catch('$load_one_file'(File, Module, Options), E,
 2134          '$print_message'(error, E)),
 2135    '$load_file_list'(Rest, Module, Options).
 2136
 2137
 2138'$load_one_file'(Spec, Module, Options) :-
 2139    atomic(Spec),
 2140    '$option'(expand(Expand), Options, false),
 2141    Expand == true,
 2142    !,
 2143    expand_file_name(Spec, Expanded),
 2144    (   Expanded = [Load]
 2145    ->  true
 2146    ;   Load = Expanded
 2147    ),
 2148    '$load_files'(Load, Module, [expand(false)|Options]).
 2149'$load_one_file'(File, Module, Options) :-
 2150    strip_module(Module:File, Into, PlainFile),
 2151    '$load_file'(PlainFile, Into, Options).
 $noload(+Condition, +FullFile, +Options) is semidet
True of FullFile should not be loaded.
 2158'$noload'(true, _, _) :-
 2159    !,
 2160    fail.
 2161'$noload'(_, FullFile, _Options) :-
 2162    '$time_source_file'(FullFile, Time, system),
 2163    Time > 0.0,
 2164    !.
 2165'$noload'(not_loaded, FullFile, _) :-
 2166    source_file(FullFile),
 2167    !.
 2168'$noload'(changed, Derived, _) :-
 2169    '$derived_source'(_FullFile, Derived, LoadTime),
 2170    time_file(Derived, Modified),
 2171    Modified @=< LoadTime,
 2172    !.
 2173'$noload'(changed, FullFile, Options) :-
 2174    '$time_source_file'(FullFile, LoadTime, user),
 2175    '$modified_id'(FullFile, Modified, Options),
 2176    Modified @=< LoadTime,
 2177    !.
 $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.
 2196'$qlf_file'(Spec, _, Spec, stream, Options) :-
 2197    '$option'(stream(_), Options),      % stream: no choice
 2198    !.
 2199'$qlf_file'(Spec, FullFile, FullFile, compile, _) :-
 2200    '$spec_extension'(Spec, Ext),       % user explicitly specified
 2201    user:prolog_file_type(Ext, prolog),
 2202    !.
 2203'$qlf_file'(Spec, FullFile, LoadFile, Mode, Options) :-
 2204    '$compilation_mode'(database),
 2205    file_name_extension(Base, PlExt, FullFile),
 2206    user:prolog_file_type(PlExt, prolog),
 2207    user:prolog_file_type(QlfExt, qlf),
 2208    file_name_extension(Base, QlfExt, QlfFile),
 2209    (   access_file(QlfFile, read),
 2210        (   '$qlf_out_of_date'(FullFile, QlfFile, Why)
 2211        ->  (   access_file(QlfFile, write)
 2212            ->  print_message(informational,
 2213                              qlf(recompile(Spec, FullFile, QlfFile, Why))),
 2214                Mode = qcompile,
 2215                LoadFile = FullFile
 2216            ;   Why == old,
 2217                current_prolog_flag(home, PlHome),
 2218                sub_atom(FullFile, 0, _, _, PlHome)
 2219            ->  print_message(silent,
 2220                              qlf(system_lib_out_of_date(Spec, QlfFile))),
 2221                Mode = qload,
 2222                LoadFile = QlfFile
 2223            ;   print_message(warning,
 2224                              qlf(can_not_recompile(Spec, QlfFile, Why))),
 2225                Mode = compile,
 2226                LoadFile = FullFile
 2227            )
 2228        ;   Mode = qload,
 2229            LoadFile = QlfFile
 2230        )
 2231    ->  !
 2232    ;   '$qlf_auto'(FullFile, QlfFile, Options)
 2233    ->  !, Mode = qcompile,
 2234        LoadFile = FullFile
 2235    ).
 2236'$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.
 2244'$qlf_out_of_date'(PlFile, QlfFile, Why) :-
 2245    (   access_file(PlFile, read)
 2246    ->  time_file(PlFile, PlTime),
 2247        time_file(QlfFile, QlfTime),
 2248        (   PlTime > QlfTime
 2249        ->  Why = old                   % PlFile is newer
 2250        ;   Error = error(Formal,_),
 2251            catch('$qlf_sources'(QlfFile, _Files), Error, true),
 2252            nonvar(Formal)              % QlfFile is incompatible
 2253        ->  Why = Error
 2254        ;   fail                        % QlfFile is up-to-date and ok
 2255        )
 2256    ;   fail                            % can not read .pl; try .qlf
 2257    ).
 $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.
 2265:- create_prolog_flag(qcompile, false, [type(atom)]). 2266
 2267'$qlf_auto'(PlFile, QlfFile, Options) :-
 2268    (   memberchk(qcompile(QlfMode), Options)
 2269    ->  true
 2270    ;   current_prolog_flag(qcompile, QlfMode),
 2271        \+ '$in_system_dir'(PlFile)
 2272    ),
 2273    (   QlfMode == auto
 2274    ->  true
 2275    ;   QlfMode == large,
 2276        size_file(PlFile, Size),
 2277        Size > 100000
 2278    ),
 2279    access_file(QlfFile, write).
 2280
 2281'$in_system_dir'(PlFile) :-
 2282    current_prolog_flag(home, Home),
 2283    sub_atom(PlFile, 0, _, _, Home).
 2284
 2285'$spec_extension'(File, Ext) :-
 2286    atom(File),
 2287    file_name_extension(_, Ext, File).
 2288'$spec_extension'(Spec, Ext) :-
 2289    compound(Spec),
 2290    arg(1, Spec, Arg),
 2291    '$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:
 2303:- dynamic
 2304    '$resolved_source_path_db'/3.                % ?Spec, ?Dialect, ?Path
 2305
 2306'$load_file'(File, Module, Options) :-
 2307    \+ memberchk(stream(_), Options),
 2308    user:prolog_load_file(Module:File, Options),
 2309    !.
 2310'$load_file'(File, Module, Options) :-
 2311    memberchk(stream(_), Options),
 2312    !,
 2313    '$assert_load_context_module'(File, Module, Options),
 2314    '$qdo_load_file'(File, File, Module, Options).
 2315'$load_file'(File, Module, Options) :-
 2316    (   '$resolved_source_path'(File, FullFile, Options)
 2317    ->  true
 2318    ;   '$resolve_source_path'(File, FullFile, Options)
 2319    ),
 2320    '$mt_load_file'(File, FullFile, Module, Options).
 $resolved_source_path(+File, -FullFile, +Options) is semidet
True when File has already been resolved to an absolute path.
 2326'$resolved_source_path'(File, FullFile, Options) :-
 2327    current_prolog_flag(emulated_dialect, Dialect),
 2328    '$resolved_source_path_db'(File, Dialect, FullFile),
 2329    (   '$source_file_property'(FullFile, from_state, true)
 2330    ;   '$source_file_property'(FullFile, resource, true)
 2331    ;   '$option'(if(If), Options, true),
 2332        '$noload'(If, FullFile, Options)
 2333    ),
 2334    !.
 $resolve_source_path(+File, -FullFile, Options) is det
Resolve a source file specification to an absolute path. May throw existence and other errors.
 2341'$resolve_source_path'(File, FullFile, _Options) :-
 2342    absolute_file_name(File, FullFile,
 2343                       [ file_type(prolog),
 2344                         access(read)
 2345                       ]),
 2346    '$register_resolved_source_path'(File, FullFile).
 2347
 2348
 2349'$register_resolved_source_path'(File, FullFile) :-
 2350    (   compound(File)
 2351    ->  current_prolog_flag(emulated_dialect, Dialect),
 2352        (   '$resolved_source_path_db'(File, Dialect, FullFile)
 2353        ->  true
 2354        ;   asserta('$resolved_source_path_db'(File, Dialect, FullFile))
 2355        )
 2356    ;   true
 2357    ).
 $translated_source(+Old, +New) is det
Called from loading a QLF state when source files are being renamed.
 2363:- public '$translated_source'/2. 2364'$translated_source'(Old, New) :-
 2365    forall(retract('$resolved_source_path_db'(File, Dialect, Old)),
 2366           assertz('$resolved_source_path_db'(File, Dialect, 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.
 2373'$register_resource_file'(FullFile) :-
 2374    (   sub_atom(FullFile, 0, _, _, 'res://')
 2375    ->  '$set_source_file'(FullFile, resource, true)
 2376    ;   true
 2377    ).
 $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.
 2390'$already_loaded'(_File, FullFile, Module, Options) :-
 2391    '$assert_load_context_module'(FullFile, Module, Options),
 2392    '$current_module'(LoadModules, FullFile),
 2393    !,
 2394    (   atom(LoadModules)
 2395    ->  LoadModule = LoadModules
 2396    ;   LoadModules = [LoadModule|_]
 2397    ),
 2398    '$import_from_loaded_module'(LoadModule, Module, Options).
 2399'$already_loaded'(_, _, user, _) :- !.
 2400'$already_loaded'(File, FullFile, Module, Options) :-
 2401    (   '$load_context_module'(FullFile, Module, CtxOptions),
 2402        '$load_ctx_options'(Options, CtxOptions)
 2403    ->  true
 2404    ;   '$load_file'(File, Module, [if(true)|Options])
 2405    ).
 $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.

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

 2938'$load_file'(Path, Id, Module, Options) :-
 2939    State = state(true, _, true, false, Id, -),
 2940    (   '$source_term'(Path, _Read, _Layout, Term, Layout,
 2941                       _Stream, Options),
 2942        '$valid_term'(Term),
 2943        (   arg(1, State, true)
 2944        ->  '$first_term'(Term, Layout, Id, State, Options),
 2945            nb_setarg(1, State, false)
 2946        ;   '$compile_term'(Term, Layout, Id)
 2947        ),
 2948        arg(4, State, true)
 2949    ;   '$fixup_reconsult'(Id),
 2950        '$end_load_file'(State)
 2951    ),
 2952    !,
 2953    arg(2, State, Module).
 2954
 2955'$valid_term'(Var) :-
 2956    var(Var),
 2957    !,
 2958    print_message(error, error(instantiation_error, _)).
 2959'$valid_term'(Term) :-
 2960    Term \== [].
 2961
 2962'$end_load_file'(State) :-
 2963    arg(1, State, true),           % empty file
 2964    !,
 2965    nb_setarg(2, State, Module),
 2966    arg(5, State, Id),
 2967    '$current_source_module'(Module),
 2968    '$ifcompiling'('$qlf_start_file'(Id)),
 2969    '$ifcompiling'('$qlf_end_part').
 2970'$end_load_file'(State) :-
 2971    arg(3, State, End),
 2972    '$end_load_file'(End, State).
 2973
 2974'$end_load_file'(true, _).
 2975'$end_load_file'(end_module, State) :-
 2976    arg(2, State, Module),
 2977    '$check_export'(Module),
 2978    '$ifcompiling'('$qlf_end_part').
 2979'$end_load_file'(end_non_module, _State) :-
 2980    '$ifcompiling'('$qlf_end_part').
 2981
 2982
 2983'$first_term'(?-(Directive), Layout, Id, State, Options) :-
 2984    !,
 2985    '$first_term'(:-(Directive), Layout, Id, State, Options).
 2986'$first_term'(:-(Directive), _Layout, Id, State, Options) :-
 2987    nonvar(Directive),
 2988    (   (   Directive = module(Name, Public)
 2989        ->  Imports = []
 2990        ;   Directive = module(Name, Public, Imports)
 2991        )
 2992    ->  !,
 2993        '$module_name'(Name, Id, Module, Options),
 2994        '$start_module'(Module, Public, State, Options),
 2995        '$module3'(Imports)
 2996    ;   Directive = expects_dialect(Dialect)
 2997    ->  !,
 2998        '$set_dialect'(Dialect, State),
 2999        fail                        % Still consider next term as first
 3000    ).
 3001'$first_term'(Term, Layout, Id, State, Options) :-
 3002    '$start_non_module'(Id, Term, State, Options),
 3003    '$compile_term'(Term, Layout, Id).
 3004
 3005'$compile_term'(Term, Layout, Id) :-
 3006    '$compile_term'(Term, Layout, Id, -).
 3007
 3008'$compile_term'(Var, _Layout, _Id, _Src) :-
 3009    var(Var),
 3010    !,
 3011    '$instantiation_error'(Var).
 3012'$compile_term'((?-Directive), _Layout, Id, _) :-
 3013    !,
 3014    '$execute_directive'(Directive, Id).
 3015'$compile_term'((:-Directive), _Layout, Id, _) :-
 3016    !,
 3017    '$execute_directive'(Directive, Id).
 3018'$compile_term'('$source_location'(File, Line):Term, Layout, Id, _) :-
 3019    !,
 3020    '$compile_term'(Term, Layout, Id, File:Line).
 3021'$compile_term'(Clause, Layout, Id, SrcLoc) :-
 3022    E = error(_,_),
 3023    catch('$store_clause'(Clause, Layout, Id, SrcLoc), E,
 3024          '$print_message'(error, E)).
 3025
 3026'$start_non_module'(_Id, Term, _State, Options) :-
 3027    '$option'(must_be_module(true), Options, false),
 3028    !,
 3029    '$domain_error'(module_header, Term).
 3030'$start_non_module'(Id, _Term, State, _Options) :-
 3031    '$current_source_module'(Module),
 3032    '$ifcompiling'('$qlf_start_file'(Id)),
 3033    '$qset_dialect'(State),
 3034    nb_setarg(2, State, Module),
 3035    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.

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