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

  417'$meta_call'(M:G) :-
  418    prolog_current_choice(Ch),
  419    '$meta_call'(G, M, Ch).
  420
  421'$meta_call'(Var, _, _) :-
  422    var(Var),
  423    !,
  424    '$instantiation_error'(Var).
  425'$meta_call'((A,B), M, Ch) :-
  426    !,
  427    '$meta_call'(A, M, Ch),
  428    '$meta_call'(B, M, Ch).
  429'$meta_call'((I->T;E), M, Ch) :-
  430    !,
  431    (   prolog_current_choice(Ch2),
  432	'$meta_call'(I, M, Ch2)
  433    ->  '$meta_call'(T, M, Ch)
  434    ;   '$meta_call'(E, M, Ch)
  435    ).
  436'$meta_call'((I*->T;E), M, Ch) :-
  437    !,
  438    (   prolog_current_choice(Ch2),
  439	'$meta_call'(I, M, Ch2)
  440    *-> '$meta_call'(T, M, Ch)
  441    ;   '$meta_call'(E, M, Ch)
  442    ).
  443'$meta_call'((I->T), M, Ch) :-
  444    !,
  445    (   prolog_current_choice(Ch2),
  446	'$meta_call'(I, M, Ch2)
  447    ->  '$meta_call'(T, M, Ch)
  448    ).
  449'$meta_call'((I*->T), M, Ch) :-
  450    !,
  451    prolog_current_choice(Ch2),
  452    '$meta_call'(I, M, Ch2),
  453    '$meta_call'(T, M, Ch).
  454'$meta_call'((A;B), M, Ch) :-
  455    !,
  456    (   '$meta_call'(A, M, Ch)
  457    ;   '$meta_call'(B, M, Ch)
  458    ).
  459'$meta_call'(\+(G), M, _) :-
  460    !,
  461    prolog_current_choice(Ch),
  462    \+ '$meta_call'(G, M, Ch).
  463'$meta_call'($(G), M, _) :-
  464    !,
  465    prolog_current_choice(Ch),
  466    $('$meta_call'(G, M, Ch)).
  467'$meta_call'(call(G), M, _) :-
  468    !,
  469    prolog_current_choice(Ch),
  470    '$meta_call'(G, M, Ch).
  471'$meta_call'(M:G, _, Ch) :-
  472    !,
  473    '$meta_call'(G, M, Ch).
  474'$meta_call'(!, _, Ch) :-
  475    prolog_cut_to(Ch).
  476'$meta_call'(G, M, _Ch) :-
  477    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..
  493:- '$iso'((call/2,
  494	   call/3,
  495	   call/4,
  496	   call/5,
  497	   call/6,
  498	   call/7,
  499	   call/8)).  500
  501call(Goal) :-                           % make these available as predicates
  502    Goal.
  503call(Goal, A) :-
  504    call(Goal, A).
  505call(Goal, A, B) :-
  506    call(Goal, A, B).
  507call(Goal, A, B, C) :-
  508    call(Goal, A, B, C).
  509call(Goal, A, B, C, D) :-
  510    call(Goal, A, B, C, D).
  511call(Goal, A, B, C, D, E) :-
  512    call(Goal, A, B, C, D, E).
  513call(Goal, A, B, C, D, E, F) :-
  514    call(Goal, A, B, C, D, E, F).
  515call(Goal, A, B, C, D, E, F, G) :-
  516    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.
  523not(Goal) :-
  524    \+ Goal.
 \+ :Goal is semidet
Predicate version that allows for meta-calling.
  530\+ Goal :-
  531    \+ Goal.
 once(:Goal) is semidet
ISO predicate, acting as call((Goal, !)).
  537once(Goal) :-
  538    Goal,
  539    !.
 ignore(:Goal) is det
Call Goal, cut choice-points on success and succeed on failure. intended for calling side-effects and proceed on failure.
  546ignore(Goal) :-
  547    Goal,
  548    !.
  549ignore(_Goal).
  550
  551:- '$iso'((false/0)).
 false
Synonym for fail/0, providing a declarative reading.
  557false :-
  558    fail.
 catch(:Goal, +Catcher, :Recover)
ISO compliant exception handling.
  564catch(_Goal, _Catcher, _Recover) :-
  565    '$catch'.                       % Maps to I_CATCH, I_EXITCATCH
 prolog_cut_to(+Choice)
Cut all choice points after Choice
  571prolog_cut_to(_Choice) :-
  572    '$cut'.                         % Maps to I_CUTCHP
 $ is det
Declare that from now on this predicate succeeds deterministically.
  578'$' :- '$'.
 $ :Goal is det
Declare that Goal must succeed deterministically.
  584$(Goal) :- $(Goal).
 notrace(:Goal) is semidet
Suspend the tracer while running Goal.
  590:- '$hide'(notrace/1).  591
  592notrace(Goal) :-
  593    setup_call_cleanup(
  594	'$notrace'(Flags, SkipLevel),
  595	once(Goal),
  596	'$restore_trace'(Flags, SkipLevel)).
 reset(:Goal, ?Ball, -Continue)
Delimited continuation support.
  603reset(_Goal, _Ball, _Cont) :-
  604    '$reset'.
 shift(+Ball)
 shift_for_copy(+Ball)
Shift control back to the enclosing reset/3. The second version assumes the continuation will be saved to be reused in a different context.
  613shift(Ball) :-
  614    '$shift'(Ball).
  615
  616shift_for_copy(Ball) :-
  617    '$shift_for_copy'(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.

  631call_continuation([]).
  632call_continuation([TB|Rest]) :-
  633    (   Rest == []
  634    ->  '$call_continuation'(TB)
  635    ;   '$call_continuation'(TB),
  636	call_continuation(Rest)
  637    ).
 catch_with_backtrace(:Goal, ?Ball, :Recover)
As catch/3, but tell library(prolog_stack) to record a backtrace in case of an exception.
  644catch_with_backtrace(Goal, Ball, Recover) :-
  645    catch(Goal, Ball, Recover),
  646    '$no_lco'.
  647
  648'$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.
  658:- public '$recover_and_rethrow'/2.  659
  660'$recover_and_rethrow'(Goal, Exception) :-
  661    call_cleanup(Goal, throw(Exception)),
  662    !.
 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.
  677setup_call_catcher_cleanup(Setup, _Goal, _Catcher, _Cleanup) :-
  678    sig_atomic(Setup),
  679    '$call_cleanup'.
  680
  681setup_call_cleanup(Setup, Goal, Cleanup) :-
  682    setup_call_catcher_cleanup(Setup, Goal, _Catcher, Cleanup).
  683
  684call_cleanup(Goal, Cleanup) :-
  685    setup_call_catcher_cleanup(true, Goal, _Catcher, Cleanup).
  686
  687call_cleanup(Goal, Catcher, Cleanup) :-
  688    setup_call_catcher_cleanup(true, Goal, Catcher, Cleanup).
  689
  690		 /*******************************
  691		 *       INITIALIZATION         *
  692		 *******************************/
  693
  694:- meta_predicate
  695    initialization(0, +).  696
  697:- multifile '$init_goal'/3.  698:- 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.

  724initialization(Goal, When) :-
  725    '$must_be'(oneof(atom, initialization_type,
  726		     [ now,
  727		       after_load,
  728		       restore,
  729		       restore_state,
  730		       prepare_state,
  731		       program,
  732		       main
  733		     ]), When),
  734    '$initialization_context'(Source, Ctx),
  735    '$initialization'(When, Goal, Source, Ctx).
  736
  737'$initialization'(now, Goal, _Source, Ctx) :-
  738    '$run_init_goal'(Goal, Ctx),
  739    '$compile_init_goal'(-, Goal, Ctx).
  740'$initialization'(after_load, Goal, Source, Ctx) :-
  741    (   Source \== (-)
  742    ->  '$compile_init_goal'(Source, Goal, Ctx)
  743    ;   throw(error(context_error(nodirective,
  744				  initialization(Goal, after_load)),
  745		    _))
  746    ).
  747'$initialization'(restore, Goal, Source, Ctx) :- % deprecated
  748    '$initialization'(restore_state, Goal, Source, Ctx).
  749'$initialization'(restore_state, Goal, _Source, Ctx) :-
  750    (   \+ current_prolog_flag(sandboxed_load, true)
  751    ->  '$compile_init_goal'(-, Goal, Ctx)
  752    ;   '$permission_error'(register, initialization(restore), Goal)
  753    ).
  754'$initialization'(prepare_state, Goal, _Source, Ctx) :-
  755    (   \+ current_prolog_flag(sandboxed_load, true)
  756    ->  '$compile_init_goal'(when(prepare_state), Goal, Ctx)
  757    ;   '$permission_error'(register, initialization(restore), Goal)
  758    ).
  759'$initialization'(program, Goal, _Source, Ctx) :-
  760    (   \+ current_prolog_flag(sandboxed_load, true)
  761    ->  '$compile_init_goal'(when(program), Goal, Ctx)
  762    ;   '$permission_error'(register, initialization(restore), Goal)
  763    ).
  764'$initialization'(main, Goal, _Source, Ctx) :-
  765    (   \+ current_prolog_flag(sandboxed_load, true)
  766    ->  '$compile_init_goal'(when(main), Goal, Ctx)
  767    ;   '$permission_error'(register, initialization(restore), Goal)
  768    ).
  769
  770
  771'$compile_init_goal'(Source, Goal, Ctx) :-
  772    atom(Source),
  773    Source \== (-),
  774    !,
  775    '$store_admin_clause'(system:'$init_goal'(Source, Goal, Ctx),
  776			  _Layout, Source, Ctx).
  777'$compile_init_goal'(Source, Goal, Ctx) :-
  778    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.
  790'$run_initialization'(_, loaded, _) :- !.
  791'$run_initialization'(File, _Action, Options) :-
  792    '$run_initialization'(File, Options).
  793
  794'$run_initialization'(File, Options) :-
  795    setup_call_cleanup(
  796	'$start_run_initialization'(Options, Restore),
  797	'$run_initialization_2'(File),
  798	'$end_run_initialization'(Restore)).
  799
  800'$start_run_initialization'(Options, OldSandBoxed) :-
  801    '$push_input_context'(initialization),
  802    '$set_sandboxed_load'(Options, OldSandBoxed).
  803'$end_run_initialization'(OldSandBoxed) :-
  804    set_prolog_flag(sandboxed_load, OldSandBoxed),
  805    '$pop_input_context'.
  806
  807'$run_initialization_2'(File) :-
  808    (   '$init_goal'(File, Goal, Ctx),
  809	File \= when(_),
  810	'$run_init_goal'(Goal, Ctx),
  811	fail
  812    ;   true
  813    ).
  814
  815'$run_init_goal'(Goal, Ctx) :-
  816    (   catch_with_backtrace('$run_init_goal'(Goal), E,
  817			     '$initialization_error'(E, Goal, Ctx))
  818    ->  true
  819    ;   '$initialization_failure'(Goal, Ctx)
  820    ).
  821
  822:- multifile prolog:sandbox_allowed_goal/1.  823
  824'$run_init_goal'(Goal) :-
  825    current_prolog_flag(sandboxed_load, false),
  826    !,
  827    call(Goal).
  828'$run_init_goal'(Goal) :-
  829    prolog:sandbox_allowed_goal(Goal),
  830    call(Goal).
  831
  832'$initialization_context'(Source, Ctx) :-
  833    (   source_location(File, Line)
  834    ->  Ctx = File:Line,
  835	'$input_context'(Context),
  836	'$top_file'(Context, File, Source)
  837    ;   Ctx = (-),
  838	File = (-)
  839    ).
  840
  841'$top_file'([input(include, F1, _, _)|T], _, F) :-
  842    !,
  843    '$top_file'(T, F1, F).
  844'$top_file'(_, F, F).
  845
  846
  847'$initialization_error'(E, Goal, Ctx) :-
  848    print_message(error, initialization_error(Goal, E, Ctx)).
  849
  850'$initialization_failure'(Goal, Ctx) :-
  851    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
  859:- public '$clear_source_admin'/1.  860
  861'$clear_source_admin'(File) :-
  862    retractall('$init_goal'(_, _, File:_)),
  863    retractall('$load_context_module'(File, _, _)),
  864    retractall('$resolved_source_path_db'(_, _, File)).
  865
  866
  867		 /*******************************
  868		 *            STREAM            *
  869		 *******************************/
  870
  871:- '$iso'(stream_property/2).  872stream_property(Stream, Property) :-
  873    nonvar(Stream),
  874    nonvar(Property),
  875    !,
  876    '$stream_property'(Stream, Property).
  877stream_property(Stream, Property) :-
  878    nonvar(Stream),
  879    !,
  880    '$stream_properties'(Stream, Properties),
  881    '$member'(Property, Properties).
  882stream_property(Stream, Property) :-
  883    nonvar(Property),
  884    !,
  885    (   Property = alias(Alias),
  886	atom(Alias)
  887    ->  '$alias_stream'(Alias, Stream)
  888    ;   '$streams_properties'(Property, Pairs),
  889	'$member'(Stream-Property, Pairs)
  890    ).
  891stream_property(Stream, Property) :-
  892    '$streams_properties'(Property, Pairs),
  893    '$member'(Stream-Properties, Pairs),
  894    '$member'(Property, Properties).
  895
  896
  897		/********************************
  898		*            MODULES            *
  899		*********************************/
  900
  901%       '$prefix_module'(+Module, +Context, +Term, -Prefixed)
  902%       Tags `Term' with `Module:' if `Module' is not the context module.
  903
  904'$prefix_module'(Module, Module, Head, Head) :- !.
  905'$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'.
  911default_module(Me, Super) :-
  912    (   atom(Me)
  913    ->  (   var(Super)
  914	->  '$default_module'(Me, Super)
  915	;   '$default_module'(Me, Super), !
  916	)
  917    ;   '$type_error'(module, Me)
  918    ).
  919
  920'$default_module'(Me, Me).
  921'$default_module'(Me, Super) :-
  922    import_module(Me, S),
  923    '$default_module'(S, Super).
  924
  925
  926		/********************************
  927		*      TRACE AND EXCEPTIONS     *
  928		*********************************/
  929
  930:- dynamic   user:exception/3.  931:- multifile user:exception/3.  932:- '$hide'(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.
  941:- public
  942    '$undefined_procedure'/4.  943
  944'$undefined_procedure'(Module, Name, Arity, Action) :-
  945    '$prefix_module'(Module, user, Name/Arity, Pred),
  946    user:exception(undefined_predicate, Pred, Action0),
  947    !,
  948    Action = Action0.
  949'$undefined_procedure'(Module, Name, Arity, Action) :-
  950    \+ current_prolog_flag(autoload, false),
  951    '$autoload'(Module:Name/Arity),
  952    !,
  953    Action = retry.
  954'$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.
  966'$loading'(Library) :-
  967    current_prolog_flag(threads, true),
  968    (   '$loading_file'(Library, _Queue, _LoadThread)
  969    ->  true
  970    ;   '$loading_file'(FullFile, _Queue, _LoadThread),
  971	file_name_extension(Library, _, FullFile)
  972    ->  true
  973    ).
  974
  975%        handle debugger 'w', 'p' and <N> depth options.
  976
  977'$set_debugger_write_options'(write) :-
  978    !,
  979    create_prolog_flag(debugger_write_options,
  980		       [ quoted(true),
  981			 attributes(dots),
  982			 spacing(next_argument)
  983		       ], []).
  984'$set_debugger_write_options'(print) :-
  985    !,
  986    create_prolog_flag(debugger_write_options,
  987		       [ quoted(true),
  988			 portray(true),
  989			 max_depth(10),
  990			 attributes(portray),
  991			 spacing(next_argument)
  992		       ], []).
  993'$set_debugger_write_options'(Depth) :-
  994    current_prolog_flag(debugger_write_options, Options0),
  995    (   '$select'(max_depth(_), Options0, Options)
  996    ->  true
  997    ;   Options = Options0
  998    ),
  999    create_prolog_flag(debugger_write_options,
 1000		       [max_depth(Depth)|Options], []).
 1001
 1002
 1003		/********************************
 1004		*        SYSTEM MESSAGES        *
 1005		*********************************/
 $confirm(Spec) is semidet
Ask the user to confirm a question. Spec is a term as used for print_message/2. It is printed the the query channel. This predicate may be hooked using confirm/2, which must return a boolean.
 1014:- multifile
 1015    prolog:confirm/2. 1016
 1017'$confirm'(Spec) :-
 1018    prolog:confirm(Spec, Result),
 1019    !,
 1020    Result == true.
 1021'$confirm'(Spec) :-
 1022    print_message(query, Spec),
 1023    between(0, 5, _),
 1024	get_single_char(Answer),
 1025	(   '$in_reply'(Answer, 'yYjJ \n')
 1026	->  !,
 1027	    print_message(query, if_tty([yes-[]]))
 1028	;   '$in_reply'(Answer, 'nN')
 1029	->  !,
 1030	    print_message(query, if_tty([no-[]])),
 1031	    fail
 1032	;   print_message(help, query(confirm)),
 1033	    fail
 1034	).
 1035
 1036'$in_reply'(Code, Atom) :-
 1037    char_code(Char, Code),
 1038    sub_atom(Atom, _, _, _, Char),
 1039    !.
 1040
 1041:- dynamic
 1042    user:portray/1. 1043:- multifile
 1044    user:portray/1. 1045
 1046
 1047		 /*******************************
 1048		 *       FILE_SEARCH_PATH       *
 1049		 *******************************/
 1050
 1051:- dynamic
 1052    user:file_search_path/2,
 1053    user:library_directory/1. 1054:- multifile
 1055    user:file_search_path/2,
 1056    user:library_directory/1. 1057
 1058user:(file_search_path(library, Dir) :-
 1059	library_directory(Dir)).
 1060user:file_search_path(swi, Home) :-
 1061    current_prolog_flag(home, Home).
 1062user:file_search_path(swi, Home) :-
 1063    current_prolog_flag(shared_home, Home).
 1064user:file_search_path(library, app_config(lib)).
 1065user:file_search_path(library, swi(library)).
 1066user:file_search_path(library, swi(library/clp)).
 1067user:file_search_path(foreign, swi(ArchLib)) :-
 1068    current_prolog_flag(apple_universal_binary, true),
 1069    ArchLib = 'lib/fat-darwin'.
 1070user:file_search_path(foreign, swi(ArchLib)) :-
 1071    \+ current_prolog_flag(windows, true),
 1072    current_prolog_flag(arch, Arch),
 1073    atom_concat('lib/', Arch, ArchLib).
 1074user:file_search_path(foreign, swi(ArchLib)) :-
 1075    current_prolog_flag(msys2, true),
 1076    current_prolog_flag(arch, Arch),
 1077    atomic_list_concat([lib, Arch], /, ArchLib).
 1078user:file_search_path(foreign, swi(SoLib)) :-
 1079    current_prolog_flag(msys2, true),
 1080    current_prolog_flag(arch, Arch),
 1081    atomic_list_concat([bin, Arch], /, SoLib).
 1082user:file_search_path(foreign, swi(SoLib)) :-
 1083    (   current_prolog_flag(windows, true)
 1084    ->  SoLib = bin
 1085    ;   SoLib = lib
 1086    ).
 1087user:file_search_path(path, Dir) :-
 1088    getenv('PATH', Path),
 1089    (   current_prolog_flag(windows, true)
 1090    ->  atomic_list_concat(Dirs, (;), Path)
 1091    ;   atomic_list_concat(Dirs, :, Path)
 1092    ),
 1093    '$member'(Dir, Dirs).
 1094user:file_search_path(user_app_data, Dir) :-
 1095    '$xdg_prolog_directory'(data, Dir).
 1096user:file_search_path(common_app_data, Dir) :-
 1097    '$xdg_prolog_directory'(common_data, Dir).
 1098user:file_search_path(user_app_config, Dir) :-
 1099    '$xdg_prolog_directory'(config, Dir).
 1100user:file_search_path(common_app_config, Dir) :-
 1101    '$xdg_prolog_directory'(common_config, Dir).
 1102user:file_search_path(app_data, user_app_data('.')).
 1103user:file_search_path(app_data, common_app_data('.')).
 1104user:file_search_path(app_config, user_app_config('.')).
 1105user:file_search_path(app_config, common_app_config('.')).
 1106% backward compatibility
 1107user:file_search_path(app_preferences, user_app_config('.')).
 1108user:file_search_path(user_profile, app_preferences('.')).
 1109
 1110'$xdg_prolog_directory'(Which, Dir) :-
 1111    '$xdg_directory'(Which, XDGDir),
 1112    '$make_config_dir'(XDGDir),
 1113    '$ensure_slash'(XDGDir, XDGDirS),
 1114    atom_concat(XDGDirS, 'swi-prolog', Dir),
 1115    '$make_config_dir'(Dir).
 1116
 1117% config
 1118'$xdg_directory'(config, Home) :-
 1119    current_prolog_flag(windows, true),
 1120    catch(win_folder(appdata, Home), _, fail),
 1121    !.
 1122'$xdg_directory'(config, Home) :-
 1123    getenv('XDG_CONFIG_HOME', Home).
 1124'$xdg_directory'(config, Home) :-
 1125    expand_file_name('~/.config', [Home]).
 1126% data
 1127'$xdg_directory'(data, Home) :-
 1128    current_prolog_flag(windows, true),
 1129    catch(win_folder(local_appdata, Home), _, fail),
 1130    !.
 1131'$xdg_directory'(data, Home) :-
 1132    getenv('XDG_DATA_HOME', Home).
 1133'$xdg_directory'(data, Home) :-
 1134    expand_file_name('~/.local', [Local]),
 1135    '$make_config_dir'(Local),
 1136    atom_concat(Local, '/share', Home),
 1137    '$make_config_dir'(Home).
 1138% common data
 1139'$xdg_directory'(common_data, Dir) :-
 1140    current_prolog_flag(windows, true),
 1141    catch(win_folder(common_appdata, Dir), _, fail),
 1142    !.
 1143'$xdg_directory'(common_data, Dir) :-
 1144    '$existing_dir_from_env_path'('XDG_DATA_DIRS',
 1145				  [ '/usr/local/share',
 1146				    '/usr/share'
 1147				  ],
 1148				  Dir).
 1149% common config
 1150'$xdg_directory'(common_config, Dir) :-
 1151    current_prolog_flag(windows, true),
 1152    catch(win_folder(common_appdata, Dir), _, fail),
 1153    !.
 1154'$xdg_directory'(common_config, Dir) :-
 1155    '$existing_dir_from_env_path'('XDG_CONFIG_DIRS', ['/etc/xdg'], Dir).
 1156
 1157'$existing_dir_from_env_path'(Env, Defaults, Dir) :-
 1158    (   getenv(Env, Path)
 1159    ->  '$path_sep'(Sep),
 1160	atomic_list_concat(Dirs, Sep, Path)
 1161    ;   Dirs = Defaults
 1162    ),
 1163    '$member'(Dir, Dirs),
 1164    Dir \== '',
 1165    exists_directory(Dir).
 1166
 1167'$path_sep'(Char) :-
 1168    (   current_prolog_flag(windows, true)
 1169    ->  Char = ';'
 1170    ;   Char = ':'
 1171    ).
 1172
 1173'$make_config_dir'(Dir) :-
 1174    exists_directory(Dir),
 1175    !.
 1176'$make_config_dir'(Dir) :-
 1177    nb_current('$create_search_directories', true),
 1178    file_directory_name(Dir, Parent),
 1179    '$my_file'(Parent),
 1180    catch(make_directory(Dir), _, fail).
 1181
 1182'$ensure_slash'(Dir, DirS) :-
 1183    (   sub_atom(Dir, _, _, 0, /)
 1184    ->  DirS = Dir
 1185    ;   atom_concat(Dir, /, DirS)
 1186    ).
 $expand_file_search_path(+Spec, -Expanded, +Cond) is nondet
 1191'$expand_file_search_path'(Spec, Expanded, Cond) :-
 1192    '$option'(access(Access), Cond),
 1193    memberchk(Access, [write,append]),
 1194    !,
 1195    setup_call_cleanup(
 1196	nb_setval('$create_search_directories', true),
 1197	expand_file_search_path(Spec, Expanded),
 1198	nb_delete('$create_search_directories')).
 1199'$expand_file_search_path'(Spec, Expanded, _Cond) :-
 1200    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?
 1208expand_file_search_path(Spec, Expanded) :-
 1209    catch('$expand_file_search_path'(Spec, Expanded, 0, []),
 1210	  loop(Used),
 1211	  throw(error(loop_error(Spec), file_search(Used)))).
 1212
 1213'$expand_file_search_path'(Spec, Expanded, N, Used) :-
 1214    functor(Spec, Alias, 1),
 1215    !,
 1216    user:file_search_path(Alias, Exp0),
 1217    NN is N + 1,
 1218    (   NN > 16
 1219    ->  throw(loop(Used))
 1220    ;   true
 1221    ),
 1222    '$expand_file_search_path'(Exp0, Exp1, NN, [Alias=Exp0|Used]),
 1223    arg(1, Spec, Segments),
 1224    '$segments_to_atom'(Segments, File),
 1225    '$make_path'(Exp1, File, Expanded).
 1226'$expand_file_search_path'(Spec, Path, _, _) :-
 1227    '$segments_to_atom'(Spec, Path).
 1228
 1229'$make_path'(Dir, '.', Path) :-
 1230    !,
 1231    Path = Dir.
 1232'$make_path'(Dir, File, Path) :-
 1233    sub_atom(Dir, _, _, 0, /),
 1234    !,
 1235    atom_concat(Dir, File, Path).
 1236'$make_path'(Dir, File, Path) :-
 1237    atomic_list_concat([Dir, /, File], Path).
 1238
 1239
 1240		/********************************
 1241		*         FILE CHECKING         *
 1242		*********************************/
 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.
 1253absolute_file_name(Spec, Options, Path) :-
 1254    '$is_options'(Options),
 1255    \+ '$is_options'(Path),
 1256    !,
 1257    absolute_file_name(Spec, Path, Options).
 1258absolute_file_name(Spec, Path, Options) :-
 1259    '$must_be'(options, Options),
 1260		    % get the valid extensions
 1261    (   '$select_option'(extensions(Exts), Options, Options1)
 1262    ->  '$must_be'(list, Exts)
 1263    ;   '$option'(file_type(Type), Options)
 1264    ->  '$must_be'(atom, Type),
 1265	'$file_type_extensions'(Type, Exts),
 1266	Options1 = Options
 1267    ;   Options1 = Options,
 1268	Exts = ['']
 1269    ),
 1270    '$canonicalise_extensions'(Exts, Extensions),
 1271		    % unless specified otherwise, ask regular file
 1272    (   (   nonvar(Type)
 1273	;   '$option'(access(none), Options, none)
 1274	)
 1275    ->  Options2 = Options1
 1276    ;   '$merge_options'(_{file_type:regular}, Options1, Options2)
 1277    ),
 1278		    % Det or nondet?
 1279    (   '$select_option'(solutions(Sols), Options2, Options3)
 1280    ->  '$must_be'(oneof(atom, solutions, [first,all]), Sols)
 1281    ;   Sols = first,
 1282	Options3 = Options2
 1283    ),
 1284		    % Errors or not?
 1285    (   '$select_option'(file_errors(FileErrors), Options3, Options4)
 1286    ->  '$must_be'(oneof(atom, file_errors, [error,fail]), FileErrors)
 1287    ;   FileErrors = error,
 1288	Options4 = Options3
 1289    ),
 1290		    % Expand shell patterns?
 1291    (   atomic(Spec),
 1292	'$select_option'(expand(Expand), Options4, Options5),
 1293	'$must_be'(boolean, Expand)
 1294    ->  expand_file_name(Spec, List),
 1295	'$member'(Spec1, List)
 1296    ;   Spec1 = Spec,
 1297	Options5 = Options4
 1298    ),
 1299		    % Search for files
 1300    (   Sols == first
 1301    ->  (   '$chk_file'(Spec1, Extensions, Options5, true, Path)
 1302	->  !       % also kill choice point of expand_file_name/2
 1303	;   (   FileErrors == fail
 1304	    ->  fail
 1305	    ;   '$current_module'('$bags', _File),
 1306		findall(P,
 1307			'$chk_file'(Spec1, Extensions, [access(exist)],
 1308				    false, P),
 1309			Candidates),
 1310		'$abs_file_error'(Spec, Candidates, Options5)
 1311	    )
 1312	)
 1313    ;   '$chk_file'(Spec1, Extensions, Options5, false, Path)
 1314    ).
 1315
 1316'$abs_file_error'(Spec, Candidates, Conditions) :-
 1317    '$member'(F, Candidates),
 1318    '$member'(C, Conditions),
 1319    '$file_condition'(C),
 1320    '$file_error'(C, Spec, F, E, Comment),
 1321    !,
 1322    throw(error(E, context(_, Comment))).
 1323'$abs_file_error'(Spec, _, _) :-
 1324    '$existence_error'(source_sink, Spec).
 1325
 1326'$file_error'(file_type(directory), Spec, File, Error, Comment) :-
 1327    \+ exists_directory(File),
 1328    !,
 1329    Error = existence_error(directory, Spec),
 1330    Comment = not_a_directory(File).
 1331'$file_error'(file_type(_), Spec, File, Error, Comment) :-
 1332    exists_directory(File),
 1333    !,
 1334    Error = existence_error(file, Spec),
 1335    Comment = directory(File).
 1336'$file_error'(access(OneOrList), Spec, File, Error, _) :-
 1337    '$one_or_member'(Access, OneOrList),
 1338    \+ access_file(File, Access),
 1339    Error = permission_error(Access, source_sink, Spec).
 1340
 1341'$one_or_member'(Elem, List) :-
 1342    is_list(List),
 1343    !,
 1344    '$member'(Elem, List).
 1345'$one_or_member'(Elem, Elem).
 1346
 1347
 1348'$file_type_extensions'(source, Exts) :-       % SICStus 3.9 compatibility
 1349    !,
 1350    '$file_type_extensions'(prolog, Exts).
 1351'$file_type_extensions'(Type, Exts) :-
 1352    '$current_module'('$bags', _File),
 1353    !,
 1354    findall(Ext, user:prolog_file_type(Ext, Type), Exts0),
 1355    (   Exts0 == [],
 1356	\+ '$ft_no_ext'(Type)
 1357    ->  '$domain_error'(file_type, Type)
 1358    ;   true
 1359    ),
 1360    '$append'(Exts0, [''], Exts).
 1361'$file_type_extensions'(prolog, [pl, '']). % findall is not yet defined ...
 1362
 1363'$ft_no_ext'(txt).
 1364'$ft_no_ext'(executable).
 1365'$ft_no_ext'(directory).
 1366'$ft_no_ext'(regular).
 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.

 1379:- multifile(user:prolog_file_type/2). 1380:- dynamic(user:prolog_file_type/2). 1381
 1382user:prolog_file_type(pl,       prolog).
 1383user:prolog_file_type(prolog,   prolog).
 1384user:prolog_file_type(qlf,      prolog).
 1385user:prolog_file_type(qlf,      qlf).
 1386user:prolog_file_type(Ext,      executable) :-
 1387    current_prolog_flag(shared_object_extension, Ext).
 1388user:prolog_file_type(dylib,    executable) :-
 1389    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.
 1396'$chk_file'(Spec, _Extensions, _Cond, _Cache, _FullName) :-
 1397    \+ ground(Spec),
 1398    !,
 1399    '$instantiation_error'(Spec).
 1400'$chk_file'(Spec, Extensions, Cond, Cache, FullName) :-
 1401    compound(Spec),
 1402    functor(Spec, _, 1),
 1403    !,
 1404    '$relative_to'(Cond, cwd, CWD),
 1405    '$chk_alias_file'(Spec, Extensions, Cond, Cache, CWD, FullName).
 1406'$chk_file'(Segments, Ext, Cond, Cache, FullName) :-    % allow a/b/...
 1407    \+ atomic(Segments),
 1408    !,
 1409    '$segments_to_atom'(Segments, Atom),
 1410    '$chk_file'(Atom, Ext, Cond, Cache, FullName).
 1411'$chk_file'(File, Exts, Cond, _, FullName) :-
 1412    is_absolute_file_name(File),
 1413    !,
 1414    '$extend_file'(File, Exts, Extended),
 1415    '$file_conditions'(Cond, Extended),
 1416    '$absolute_file_name'(Extended, FullName).
 1417'$chk_file'(File, Exts, Cond, _, FullName) :-
 1418    '$relative_to'(Cond, source, Dir),
 1419    atomic_list_concat([Dir, /, File], AbsFile),
 1420    '$extend_file'(AbsFile, Exts, Extended),
 1421    '$file_conditions'(Cond, Extended),
 1422    !,
 1423    '$absolute_file_name'(Extended, FullName).
 1424'$chk_file'(File, Exts, Cond, _, FullName) :-
 1425    '$extend_file'(File, Exts, Extended),
 1426    '$file_conditions'(Cond, Extended),
 1427    '$absolute_file_name'(Extended, FullName).
 1428
 1429'$segments_to_atom'(Atom, Atom) :-
 1430    atomic(Atom),
 1431    !.
 1432'$segments_to_atom'(Segments, Atom) :-
 1433    '$segments_to_list'(Segments, List, []),
 1434    !,
 1435    atomic_list_concat(List, /, Atom).
 1436
 1437'$segments_to_list'(A/B, H, T) :-
 1438    '$segments_to_list'(A, H, T0),
 1439    '$segments_to_list'(B, T0, T).
 1440'$segments_to_list'(A, [A|T], T) :-
 1441    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.
 1451'$relative_to'(Conditions, Default, Dir) :-
 1452    (   '$option'(relative_to(FileOrDir), Conditions)
 1453    *-> (   exists_directory(FileOrDir)
 1454	->  Dir = FileOrDir
 1455	;   atom_concat(Dir, /, FileOrDir)
 1456	->  true
 1457	;   file_directory_name(FileOrDir, Dir)
 1458	)
 1459    ;   Default == cwd
 1460    ->  '$cwd'(Dir)
 1461    ;   Default == source
 1462    ->  source_location(ContextFile, _Line),
 1463	file_directory_name(ContextFile, Dir)
 1464    ).
 $chk_alias_file(+Spec, +Exts, +Cond, +Cache, +CWD, -FullFile) is nondet
 1469:- dynamic
 1470    '$search_path_file_cache'/3,    % SHA1, Time, Path
 1471    '$search_path_gc_time'/1.       % Time
 1472:- volatile
 1473    '$search_path_file_cache'/3,
 1474    '$search_path_gc_time'/1. 1475
 1476:- create_prolog_flag(file_search_cache_time, 10, []). 1477
 1478'$chk_alias_file'(Spec, Exts, Cond, true, CWD, FullFile) :-
 1479    !,
 1480    findall(Exp, '$expand_file_search_path'(Spec, Exp, Cond), Expansions),
 1481    current_prolog_flag(emulated_dialect, Dialect),
 1482    Cache = cache(Exts, Cond, CWD, Expansions, Dialect),
 1483    variant_sha1(Spec+Cache, SHA1),
 1484    get_time(Now),
 1485    current_prolog_flag(file_search_cache_time, TimeOut),
 1486    (   '$search_path_file_cache'(SHA1, CachedTime, FullFile),
 1487	CachedTime > Now - TimeOut,
 1488	'$file_conditions'(Cond, FullFile)
 1489    ->  '$search_message'(file_search(cache(Spec, Cond), FullFile))
 1490    ;   '$member'(Expanded, Expansions),
 1491	'$extend_file'(Expanded, Exts, LibFile),
 1492	(   '$file_conditions'(Cond, LibFile),
 1493	    '$absolute_file_name'(LibFile, FullFile),
 1494	    '$cache_file_found'(SHA1, Now, TimeOut, FullFile)
 1495	->  '$search_message'(file_search(found(Spec, Cond), FullFile))
 1496	;   '$search_message'(file_search(tried(Spec, Cond), LibFile)),
 1497	    fail
 1498	)
 1499    ).
 1500'$chk_alias_file'(Spec, Exts, Cond, false, _CWD, FullFile) :-
 1501    '$expand_file_search_path'(Spec, Expanded, Cond),
 1502    '$extend_file'(Expanded, Exts, LibFile),
 1503    '$file_conditions'(Cond, LibFile),
 1504    '$absolute_file_name'(LibFile, FullFile).
 1505
 1506'$cache_file_found'(_, _, TimeOut, _) :-
 1507    TimeOut =:= 0,
 1508    !.
 1509'$cache_file_found'(SHA1, Now, TimeOut, FullFile) :-
 1510    '$search_path_file_cache'(SHA1, Saved, FullFile),
 1511    !,
 1512    (   Now - Saved < TimeOut/2
 1513    ->  true
 1514    ;   retractall('$search_path_file_cache'(SHA1, _, _)),
 1515	asserta('$search_path_file_cache'(SHA1, Now, FullFile))
 1516    ).
 1517'$cache_file_found'(SHA1, Now, TimeOut, FullFile) :-
 1518    'gc_file_search_cache'(TimeOut),
 1519    asserta('$search_path_file_cache'(SHA1, Now, FullFile)).
 1520
 1521'gc_file_search_cache'(TimeOut) :-
 1522    get_time(Now),
 1523    '$search_path_gc_time'(Last),
 1524    Now-Last < TimeOut/2,
 1525    !.
 1526'gc_file_search_cache'(TimeOut) :-
 1527    get_time(Now),
 1528    retractall('$search_path_gc_time'(_)),
 1529    assertz('$search_path_gc_time'(Now)),
 1530    Before is Now - TimeOut,
 1531    (   '$search_path_file_cache'(SHA1, Cached, FullFile),
 1532	Cached < Before,
 1533	retractall('$search_path_file_cache'(SHA1, Cached, FullFile)),
 1534	fail
 1535    ;   true
 1536    ).
 1537
 1538
 1539'$search_message'(Term) :-
 1540    current_prolog_flag(verbose_file_search, true),
 1541    !,
 1542    print_message(informational, Term).
 1543'$search_message'(_).
 $file_conditions(+Condition, +Path)
Verify Path satisfies Condition.
 1550'$file_conditions'(List, File) :-
 1551    is_list(List),
 1552    !,
 1553    \+ ( '$member'(C, List),
 1554	 '$file_condition'(C),
 1555	 \+ '$file_condition'(C, File)
 1556       ).
 1557'$file_conditions'(Map, File) :-
 1558    \+ (  get_dict(Key, Map, Value),
 1559	  C =.. [Key,Value],
 1560	  '$file_condition'(C),
 1561	 \+ '$file_condition'(C, File)
 1562       ).
 1563
 1564'$file_condition'(file_type(directory), File) :-
 1565    !,
 1566    exists_directory(File).
 1567'$file_condition'(file_type(_), File) :-
 1568    !,
 1569    \+ exists_directory(File).
 1570'$file_condition'(access(Accesses), File) :-
 1571    !,
 1572    \+ (  '$one_or_member'(Access, Accesses),
 1573	  \+ access_file(File, Access)
 1574       ).
 1575
 1576'$file_condition'(exists).
 1577'$file_condition'(file_type(_)).
 1578'$file_condition'(access(_)).
 1579
 1580'$extend_file'(File, Exts, FileEx) :-
 1581    '$ensure_extensions'(Exts, File, Fs),
 1582    '$list_to_set'(Fs, FsSet),
 1583    '$member'(FileEx, FsSet).
 1584
 1585'$ensure_extensions'([], _, []).
 1586'$ensure_extensions'([E|E0], F, [FE|E1]) :-
 1587    file_name_extension(F, E, FE),
 1588    '$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. Copied from library(lists).
 1595'$list_to_set'(List, Set) :-
 1596    '$number_list'(List, 1, Numbered),
 1597    sort(1, @=<, Numbered, ONum),
 1598    '$remove_dup_keys'(ONum, NumSet),
 1599    sort(2, @=<, NumSet, ONumSet),
 1600    '$pairs_keys'(ONumSet, Set).
 1601
 1602'$number_list'([], _, []).
 1603'$number_list'([H|T0], N, [H-N|T]) :-
 1604    N1 is N+1,
 1605    '$number_list'(T0, N1, T).
 1606
 1607'$remove_dup_keys'([], []).
 1608'$remove_dup_keys'([H|T0], [H|T]) :-
 1609    H = V-_,
 1610    '$remove_same_key'(T0, V, T1),
 1611    '$remove_dup_keys'(T1, T).
 1612
 1613'$remove_same_key'([V1-_|T0], V, T) :-
 1614    V1 == V,
 1615    !,
 1616    '$remove_same_key'(T0, V, T).
 1617'$remove_same_key'(L, _, L).
 1618
 1619'$pairs_keys'([], []).
 1620'$pairs_keys'([K-_|T0], [K|T]) :-
 1621    '$pairs_keys'(T0, T).
 1622
 1623
 1624/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
 1625Canonicalise the extension list. Old SWI-Prolog   require  `.pl', etc, which
 1626the Quintus compatibility  requests  `pl'.   This  layer  canonicalises  all
 1627extensions to .ext
 1628- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
 1629
 1630'$canonicalise_extensions'([], []) :- !.
 1631'$canonicalise_extensions'([H|T], [CH|CT]) :-
 1632    !,
 1633    '$must_be'(atom, H),
 1634    '$canonicalise_extension'(H, CH),
 1635    '$canonicalise_extensions'(T, CT).
 1636'$canonicalise_extensions'(E, [CE]) :-
 1637    '$canonicalise_extension'(E, CE).
 1638
 1639'$canonicalise_extension'('', '') :- !.
 1640'$canonicalise_extension'(DotAtom, DotAtom) :-
 1641    sub_atom(DotAtom, 0, _, _, '.'),
 1642    !.
 1643'$canonicalise_extension'(Atom, DotAtom) :-
 1644    atom_concat('.', Atom, DotAtom).
 1645
 1646
 1647		/********************************
 1648		*            CONSULT            *
 1649		*********************************/
 1650
 1651:- dynamic
 1652    user:library_directory/1,
 1653    user:prolog_load_file/2. 1654:- multifile
 1655    user:library_directory/1,
 1656    user:prolog_load_file/2. 1657
 1658:- prompt(_, '|: '). 1659
 1660:- thread_local
 1661    '$compilation_mode_store'/1,    % database, wic, qlf
 1662    '$directive_mode_store'/1.      % database, wic, qlf
 1663:- volatile
 1664    '$compilation_mode_store'/1,
 1665    '$directive_mode_store'/1. 1666
 1667'$compilation_mode'(Mode) :-
 1668    (   '$compilation_mode_store'(Val)
 1669    ->  Mode = Val
 1670    ;   Mode = database
 1671    ).
 1672
 1673'$set_compilation_mode'(Mode) :-
 1674    retractall('$compilation_mode_store'(_)),
 1675    assertz('$compilation_mode_store'(Mode)).
 1676
 1677'$compilation_mode'(Old, New) :-
 1678    '$compilation_mode'(Old),
 1679    (   New == Old
 1680    ->  true
 1681    ;   '$set_compilation_mode'(New)
 1682    ).
 1683
 1684'$directive_mode'(Mode) :-
 1685    (   '$directive_mode_store'(Val)
 1686    ->  Mode = Val
 1687    ;   Mode = database
 1688    ).
 1689
 1690'$directive_mode'(Old, New) :-
 1691    '$directive_mode'(Old),
 1692    (   New == Old
 1693    ->  true
 1694    ;   '$set_directive_mode'(New)
 1695    ).
 1696
 1697'$set_directive_mode'(Mode) :-
 1698    retractall('$directive_mode_store'(_)),
 1699    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.
 1707'$compilation_level'(Level) :-
 1708    '$input_context'(Stack),
 1709    '$compilation_level'(Stack, Level).
 1710
 1711'$compilation_level'([], 0).
 1712'$compilation_level'([Input|T], Level) :-
 1713    (   arg(1, Input, see)
 1714    ->  '$compilation_level'(T, Level)
 1715    ;   '$compilation_level'(T, Level0),
 1716	Level is Level0+1
 1717    ).
 compiling
Is true if SWI-Prolog is generating a state or qlf file or executes a `call' directive while doing this.
 1725compiling :-
 1726    \+ (   '$compilation_mode'(database),
 1727	   '$directive_mode'(database)
 1728       ).
 1729
 1730:- meta_predicate
 1731    '$ifcompiling'(0). 1732
 1733'$ifcompiling'(G) :-
 1734    (   '$compilation_mode'(database)
 1735    ->  true
 1736    ;   call(G)
 1737    ).
 1738
 1739		/********************************
 1740		*         READ SOURCE           *
 1741		*********************************/
 $load_msg_level(+Action, +NestingLevel, -StartVerbose, -EndVerbose)
 1745'$load_msg_level'(Action, Nesting, Start, Done) :-
 1746    '$update_autoload_level'([], 0),
 1747    !,
 1748    current_prolog_flag(verbose_load, Type0),
 1749    '$load_msg_compat'(Type0, Type),
 1750    (   '$load_msg_level'(Action, Nesting, Type, Start, Done)
 1751    ->  true
 1752    ).
 1753'$load_msg_level'(_, _, silent, silent).
 1754
 1755'$load_msg_compat'(true, normal) :- !.
 1756'$load_msg_compat'(false, silent) :- !.
 1757'$load_msg_compat'(X, X).
 1758
 1759'$load_msg_level'(load_file,    _, full,   informational, informational).
 1760'$load_msg_level'(include_file, _, full,   informational, informational).
 1761'$load_msg_level'(load_file,    _, normal, silent,        informational).
 1762'$load_msg_level'(include_file, _, normal, silent,        silent).
 1763'$load_msg_level'(load_file,    0, brief,  silent,        informational).
 1764'$load_msg_level'(load_file,    _, brief,  silent,        silent).
 1765'$load_msg_level'(include_file, _, brief,  silent,        silent).
 1766'$load_msg_level'(load_file,    _, silent, silent,        silent).
 1767'$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)
 1790'$source_term'(From, Read, RLayout, Term, TLayout, Stream, Options) :-
 1791    '$source_term'(From, Read, RLayout, Term, TLayout, Stream, [], Options),
 1792    (   Term == end_of_file
 1793    ->  !, fail
 1794    ;   Term \== begin_of_file
 1795    ).
 1796
 1797'$source_term'(Input, _,_,_,_,_,_,_) :-
 1798    \+ ground(Input),
 1799    !,
 1800    '$instantiation_error'(Input).
 1801'$source_term'(stream(Id, In, Opts),
 1802	       Read, RLayout, Term, TLayout, Stream, Parents, Options) :-
 1803    !,
 1804    '$record_included'(Parents, Id, Id, 0.0, Message),
 1805    setup_call_cleanup(
 1806	'$open_source'(stream(Id, In, Opts), In, State, Parents, Options),
 1807	'$term_in_file'(In, Read, RLayout, Term, TLayout, Stream,
 1808			[Id|Parents], Options),
 1809	'$close_source'(State, Message)).
 1810'$source_term'(File,
 1811	       Read, RLayout, Term, TLayout, Stream, Parents, Options) :-
 1812    absolute_file_name(File, Path,
 1813		       [ file_type(prolog),
 1814			 access(read)
 1815		       ]),
 1816    time_file(Path, Time),
 1817    '$record_included'(Parents, File, Path, Time, Message),
 1818    setup_call_cleanup(
 1819	'$open_source'(Path, In, State, Parents, Options),
 1820	'$term_in_file'(In, Read, RLayout, Term, TLayout, Stream,
 1821			[Path|Parents], Options),
 1822	'$close_source'(State, Message)).
 1823
 1824:- thread_local
 1825    '$load_input'/2. 1826:- volatile
 1827    '$load_input'/2. 1828
 1829'$open_source'(stream(Id, In, Opts), In,
 1830	       restore(In, StreamState, Id, Ref, Opts), Parents, _Options) :-
 1831    !,
 1832    '$context_type'(Parents, ContextType),
 1833    '$push_input_context'(ContextType),
 1834    '$prepare_load_stream'(In, Id, StreamState),
 1835    asserta('$load_input'(stream(Id), In), Ref).
 1836'$open_source'(Path, In, close(In, Path, Ref), Parents, Options) :-
 1837    '$context_type'(Parents, ContextType),
 1838    '$push_input_context'(ContextType),
 1839    '$open_source'(Path, In, Options),
 1840    '$set_encoding'(In, Options),
 1841    asserta('$load_input'(Path, In), Ref).
 1842
 1843'$context_type'([], load_file) :- !.
 1844'$context_type'(_, include).
 1845
 1846:- multifile prolog:open_source_hook/3. 1847
 1848'$open_source'(Path, In, Options) :-
 1849    prolog:open_source_hook(Path, In, Options),
 1850    !.
 1851'$open_source'(Path, In, _Options) :-
 1852    open(Path, read, In).
 1853
 1854'$close_source'(close(In, _Id, Ref), Message) :-
 1855    erase(Ref),
 1856    call_cleanup(
 1857	close(In),
 1858	'$pop_input_context'),
 1859    '$close_message'(Message).
 1860'$close_source'(restore(In, StreamState, _Id, Ref, Opts), Message) :-
 1861    erase(Ref),
 1862    call_cleanup(
 1863	'$restore_load_stream'(In, StreamState, Opts),
 1864	'$pop_input_context'),
 1865    '$close_message'(Message).
 1866
 1867'$close_message'(message(Level, Msg)) :-
 1868    !,
 1869    '$print_message'(Level, Msg).
 1870'$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.
 1882'$term_in_file'(In, Read, RLayout, Term, TLayout, Stream, Parents, Options) :-
 1883    Parents \= [_,_|_],
 1884    (   '$load_input'(_, Input)
 1885    ->  stream_property(Input, file_name(File))
 1886    ),
 1887    '$set_source_location'(File, 0),
 1888    '$expanded_term'(In,
 1889		     begin_of_file, 0-0, Read, RLayout, Term, TLayout,
 1890		     Stream, Parents, Options).
 1891'$term_in_file'(In, Read, RLayout, Term, TLayout, Stream, Parents, Options) :-
 1892    '$skip_script_line'(In, Options),
 1893    '$read_clause_options'(Options, ReadOptions),
 1894    '$repeat_and_read_error_mode'(ErrorMode),
 1895      read_clause(In, Raw,
 1896		  [ syntax_errors(ErrorMode),
 1897		    variable_names(Bindings),
 1898		    term_position(Pos),
 1899		    subterm_positions(RawLayout)
 1900		  | ReadOptions
 1901		  ]),
 1902      b_setval('$term_position', Pos),
 1903      b_setval('$variable_names', Bindings),
 1904      (   Raw == end_of_file
 1905      ->  !,
 1906	  (   Parents = [_,_|_]     % Included file
 1907	  ->  fail
 1908	  ;   '$expanded_term'(In,
 1909			       Raw, RawLayout, Read, RLayout, Term, TLayout,
 1910			       Stream, Parents, Options)
 1911	  )
 1912      ;   '$expanded_term'(In, Raw, RawLayout, Read, RLayout, Term, TLayout,
 1913			   Stream, Parents, Options)
 1914      ).
 1915
 1916'$read_clause_options'([], []).
 1917'$read_clause_options'([H|T0], List) :-
 1918    (   '$read_clause_option'(H)
 1919    ->  List = [H|T]
 1920    ;   List = T
 1921    ),
 1922    '$read_clause_options'(T0, T).
 1923
 1924'$read_clause_option'(syntax_errors(_)).
 1925'$read_clause_option'(term_position(_)).
 1926'$read_clause_option'(process_comment(_)).
 $repeat_and_read_error_mode(-Mode) is multi
Calls repeat/1 and return the error mode. The implemenation is like this because during part of the boot cycle expand.pl is not yet loaded.
 1934'$repeat_and_read_error_mode'(Mode) :-
 1935    (   current_predicate('$including'/0)
 1936    ->  repeat,
 1937	(   '$including'
 1938	->  Mode = dec10
 1939	;   Mode = quiet
 1940	)
 1941    ;   Mode = dec10,
 1942	repeat
 1943    ).
 1944
 1945
 1946'$expanded_term'(In, Raw, RawLayout, Read, RLayout, Term, TLayout,
 1947		 Stream, Parents, Options) :-
 1948    E = error(_,_),
 1949    catch('$expand_term'(Raw, RawLayout, Expanded, ExpandedLayout), E,
 1950	  '$print_message_fail'(E)),
 1951    (   Expanded \== []
 1952    ->  '$expansion_member'(Expanded, ExpandedLayout, Term1, Layout1)
 1953    ;   Term1 = Expanded,
 1954	Layout1 = ExpandedLayout
 1955    ),
 1956    (   nonvar(Term1), Term1 = (:-Directive), nonvar(Directive)
 1957    ->  (   Directive = include(File),
 1958	    '$current_source_module'(Module),
 1959	    '$valid_directive'(Module:include(File))
 1960	->  stream_property(In, encoding(Enc)),
 1961	    '$add_encoding'(Enc, Options, Options1),
 1962	    '$source_term'(File, Read, RLayout, Term, TLayout,
 1963			   Stream, Parents, Options1)
 1964	;   Directive = encoding(Enc)
 1965	->  set_stream(In, encoding(Enc)),
 1966	    fail
 1967	;   Term = Term1,
 1968	    Stream = In,
 1969	    Read = Raw
 1970	)
 1971    ;   Term = Term1,
 1972	TLayout = Layout1,
 1973	Stream = In,
 1974	Read = Raw,
 1975	RLayout = RawLayout
 1976    ).
 1977
 1978'$expansion_member'(Var, Layout, Var, Layout) :-
 1979    var(Var),
 1980    !.
 1981'$expansion_member'([], _, _, _) :- !, fail.
 1982'$expansion_member'(List, ListLayout, Term, Layout) :-
 1983    is_list(List),
 1984    !,
 1985    (   var(ListLayout)
 1986    ->  '$member'(Term, List)
 1987    ;   is_list(ListLayout)
 1988    ->  '$member_rep2'(Term, Layout, List, ListLayout)
 1989    ;   Layout = ListLayout,
 1990	'$member'(Term, List)
 1991    ).
 1992'$expansion_member'(X, Layout, X, Layout).
 1993
 1994% pairwise member, repeating last element of the second
 1995% list.
 1996
 1997'$member_rep2'(H1, H2, [H1|_], [H2|_]).
 1998'$member_rep2'(H1, H2, [_|T1], [T2]) :-
 1999    !,
 2000    '$member_rep2'(H1, H2, T1, [T2]).
 2001'$member_rep2'(H1, H2, [_|T1], [_|T2]) :-
 2002    '$member_rep2'(H1, H2, T1, T2).
 $add_encoding(+Enc, +Options0, -Options)
 2006'$add_encoding'(Enc, Options0, Options) :-
 2007    (   Options0 = [encoding(Enc)|_]
 2008    ->  Options = Options0
 2009    ;   Options = [encoding(Enc)|Options0]
 2010    ).
 2011
 2012
 2013:- multifile
 2014    '$included'/4.                  % Into, Line, File, LastModified
 2015:- dynamic
 2016    '$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'.

 2030'$record_included'([Parent|Parents], File, Path, Time,
 2031		   message(DoneMsgLevel,
 2032			   include_file(done(Level, file(File, Path))))) :-
 2033    source_location(SrcFile, Line),
 2034    !,
 2035    '$compilation_level'(Level),
 2036    '$load_msg_level'(include_file, Level, StartMsgLevel, DoneMsgLevel),
 2037    '$print_message'(StartMsgLevel,
 2038		     include_file(start(Level,
 2039					file(File, Path)))),
 2040    '$last'([Parent|Parents], Owner),
 2041    (   (   '$compilation_mode'(database)
 2042	;   '$qlf_current_source'(Owner)
 2043	)
 2044    ->  '$store_admin_clause'(
 2045	    system:'$included'(Parent, Line, Path, Time),
 2046	    _, Owner, SrcFile:Line)
 2047    ;   '$qlf_include'(Owner, Parent, Line, Path, Time)
 2048    ).
 2049'$record_included'(_, _, _, _, true).
 $master_file(+File, -MasterFile)
Find the primary load file from included files.
 2055'$master_file'(File, MasterFile) :-
 2056    '$included'(MasterFile0, _Line, File, _Time),
 2057    !,
 2058    '$master_file'(MasterFile0, MasterFile).
 2059'$master_file'(File, File).
 2060
 2061
 2062'$skip_script_line'(_In, Options) :-
 2063    '$option'(check_script(false), Options),
 2064    !.
 2065'$skip_script_line'(In, _Options) :-
 2066    (   peek_char(In, #)
 2067    ->  skip(In, 10)
 2068    ;   true
 2069    ).
 2070
 2071'$set_encoding'(Stream, Options) :-
 2072    '$option'(encoding(Enc), Options),
 2073    !,
 2074    Enc \== default,
 2075    set_stream(Stream, encoding(Enc)).
 2076'$set_encoding'(_, _).
 2077
 2078
 2079'$prepare_load_stream'(In, Id, state(HasName,HasPos)) :-
 2080    (   stream_property(In, file_name(_))
 2081    ->  HasName = true,
 2082	(   stream_property(In, position(_))
 2083	->  HasPos = true
 2084	;   HasPos = false,
 2085	    set_stream(In, record_position(true))
 2086	)
 2087    ;   HasName = false,
 2088	set_stream(In, file_name(Id)),
 2089	(   stream_property(In, position(_))
 2090	->  HasPos = true
 2091	;   HasPos = false,
 2092	    set_stream(In, record_position(true))
 2093	)
 2094    ).
 2095
 2096'$restore_load_stream'(In, _State, Options) :-
 2097    memberchk(close(true), Options),
 2098    !,
 2099    close(In).
 2100'$restore_load_stream'(In, state(HasName, HasPos), _Options) :-
 2101    (   HasName == false
 2102    ->  set_stream(In, file_name(''))
 2103    ;   true
 2104    ),
 2105    (   HasPos == false
 2106    ->  set_stream(In, record_position(false))
 2107    ;   true
 2108    ).
 2109
 2110
 2111		 /*******************************
 2112		 *          DERIVED FILES       *
 2113		 *******************************/
 2114
 2115:- dynamic
 2116    '$derived_source_db'/3.         % Loaded, DerivedFrom, Time
 2117
 2118'$register_derived_source'(_, '-') :- !.
 2119'$register_derived_source'(Loaded, DerivedFrom) :-
 2120    retractall('$derived_source_db'(Loaded, _, _)),
 2121    time_file(DerivedFrom, Time),
 2122    assert('$derived_source_db'(Loaded, DerivedFrom, Time)).
 2123
 2124%       Auto-importing dynamic predicates is not very elegant and
 2125%       leads to problems with qsave_program/[1,2]
 2126
 2127'$derived_source'(Loaded, DerivedFrom, Time) :-
 2128    '$derived_source_db'(Loaded, DerivedFrom, Time).
 2129
 2130
 2131		/********************************
 2132		*       LOAD PREDICATES         *
 2133		*********************************/
 2134
 2135:- meta_predicate
 2136    ensure_loaded(:),
 2137    [:|+],
 2138    consult(:),
 2139    use_module(:),
 2140    use_module(:, +),
 2141    reexport(:),
 2142    reexport(:, +),
 2143    load_files(:),
 2144    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.
 2152ensure_loaded(Files) :-
 2153    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.
 2162use_module(Files) :-
 2163    load_files(Files, [ if(not_loaded),
 2164			must_be_module(true)
 2165		      ]).
 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.
 2172use_module(File, Import) :-
 2173    load_files(File, [ if(not_loaded),
 2174		       must_be_module(true),
 2175		       imports(Import)
 2176		     ]).
 reexport(+Files)
As use_module/1, exporting all imported predicates.
 2182reexport(Files) :-
 2183    load_files(Files, [ if(not_loaded),
 2184			must_be_module(true),
 2185			reexport(true)
 2186		      ]).
 reexport(+File, +ImportList)
As use_module/1, re-exporting all imported predicates.
 2192reexport(File, Import) :-
 2193    load_files(File, [ if(not_loaded),
 2194		       must_be_module(true),
 2195		       imports(Import),
 2196		       reexport(true)
 2197		     ]).
 2198
 2199
 2200[X] :-
 2201    !,
 2202    consult(X).
 2203[M:F|R] :-
 2204    consult(M:[F|R]).
 2205
 2206consult(M:X) :-
 2207    X == user,
 2208    !,
 2209    flag('$user_consult', N, N+1),
 2210    NN is N + 1,
 2211    atom_concat('user://', NN, Id),
 2212    load_files(M:Id, [stream(user_input), check_script(false), silent(false)]).
 2213consult(List) :-
 2214    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.
 2221load_files(Files) :-
 2222    load_files(Files, []).
 2223load_files(Module:Files, Options) :-
 2224    '$must_be'(list, Options),
 2225    '$load_files'(Files, Module, Options).
 2226
 2227'$load_files'(X, _, _) :-
 2228    var(X),
 2229    !,
 2230    '$instantiation_error'(X).
 2231'$load_files'([], _, _) :- !.
 2232'$load_files'(Id, Module, Options) :-   % load_files(foo, [stream(In)])
 2233    '$option'(stream(_), Options),
 2234    !,
 2235    (   atom(Id)
 2236    ->  '$load_file'(Id, Module, Options)
 2237    ;   throw(error(type_error(atom, Id), _))
 2238    ).
 2239'$load_files'(List, Module, Options) :-
 2240    List = [_|_],
 2241    !,
 2242    '$must_be'(list, List),
 2243    '$load_file_list'(List, Module, Options).
 2244'$load_files'(File, Module, Options) :-
 2245    '$load_one_file'(File, Module, Options).
 2246
 2247'$load_file_list'([], _, _).
 2248'$load_file_list'([File|Rest], Module, Options) :-
 2249    E = error(_,_),
 2250    catch('$load_one_file'(File, Module, Options), E,
 2251	  '$print_message'(error, E)),
 2252    '$load_file_list'(Rest, Module, Options).
 2253
 2254
 2255'$load_one_file'(Spec, Module, Options) :-
 2256    atomic(Spec),
 2257    '$option'(expand(Expand), Options, false),
 2258    Expand == true,
 2259    !,
 2260    expand_file_name(Spec, Expanded),
 2261    (   Expanded = [Load]
 2262    ->  true
 2263    ;   Load = Expanded
 2264    ),
 2265    '$load_files'(Load, Module, [expand(false)|Options]).
 2266'$load_one_file'(File, Module, Options) :-
 2267    strip_module(Module:File, Into, PlainFile),
 2268    '$load_file'(PlainFile, Into, Options).
 $noload(+Condition, +FullFile, +Options) is semidet
True of FullFile should not be loaded.
 2275'$noload'(true, _, _) :-
 2276    !,
 2277    fail.
 2278'$noload'(_, FullFile, _Options) :-
 2279    '$time_source_file'(FullFile, Time, system),
 2280    Time > 0.0,
 2281    !.
 2282'$noload'(not_loaded, FullFile, _) :-
 2283    source_file(FullFile),
 2284    !.
 2285'$noload'(changed, Derived, _) :-
 2286    '$derived_source'(_FullFile, Derived, LoadTime),
 2287    time_file(Derived, Modified),
 2288    Modified @=< LoadTime,
 2289    !.
 2290'$noload'(changed, FullFile, Options) :-
 2291    '$time_source_file'(FullFile, LoadTime, user),
 2292    '$modified_id'(FullFile, Modified, Options),
 2293    Modified @=< LoadTime,
 2294    !.
 2295'$noload'(exists, File, Options) :-
 2296    '$noload'(changed, File, Options).
 $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.
 2315'$qlf_file'(Spec, _, Spec, stream, Options) :-
 2316    '$option'(stream(_), Options),      % stream: no choice
 2317    !.
 2318'$qlf_file'(Spec, FullFile, FullFile, compile, _) :-
 2319    '$spec_extension'(Spec, Ext),       % user explicitly specified
 2320    user:prolog_file_type(Ext, prolog),
 2321    !.
 2322'$qlf_file'(Spec, FullFile, LoadFile, Mode, Options) :-
 2323    '$compilation_mode'(database),
 2324    file_name_extension(Base, PlExt, FullFile),
 2325    user:prolog_file_type(PlExt, prolog),
 2326    user:prolog_file_type(QlfExt, qlf),
 2327    file_name_extension(Base, QlfExt, QlfFile),
 2328    (   access_file(QlfFile, read),
 2329	(   '$qlf_out_of_date'(FullFile, QlfFile, Why)
 2330	->  (   access_file(QlfFile, write)
 2331	    ->  print_message(informational,
 2332			      qlf(recompile(Spec, FullFile, QlfFile, Why))),
 2333		Mode = qcompile,
 2334		LoadFile = FullFile
 2335	    ;   Why == old,
 2336		(   current_prolog_flag(home, PlHome),
 2337		    sub_atom(FullFile, 0, _, _, PlHome)
 2338		;   sub_atom(QlfFile, 0, _, _, 'res://')
 2339		)
 2340	    ->  print_message(silent,
 2341			      qlf(system_lib_out_of_date(Spec, QlfFile))),
 2342		Mode = qload,
 2343		LoadFile = QlfFile
 2344	    ;   print_message(warning,
 2345			      qlf(can_not_recompile(Spec, QlfFile, Why))),
 2346		Mode = compile,
 2347		LoadFile = FullFile
 2348	    )
 2349	;   Mode = qload,
 2350	    LoadFile = QlfFile
 2351	)
 2352    ->  !
 2353    ;   '$qlf_auto'(FullFile, QlfFile, Options)
 2354    ->  !, Mode = qcompile,
 2355	LoadFile = FullFile
 2356    ).
 2357'$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.
 2365'$qlf_out_of_date'(PlFile, QlfFile, Why) :-
 2366    (   access_file(PlFile, read)
 2367    ->  time_file(PlFile, PlTime),
 2368	time_file(QlfFile, QlfTime),
 2369	(   PlTime > QlfTime
 2370	->  Why = old                   % PlFile is newer
 2371	;   Error = error(Formal,_),
 2372	    catch('$qlf_info'(QlfFile, _CVer, _MLVer,
 2373			      _FVer, _CSig, _FSig),
 2374		  Error, true),
 2375	    nonvar(Formal)              % QlfFile is incompatible
 2376	->  Why = Error
 2377	;   fail                        % QlfFile is up-to-date and ok
 2378	)
 2379    ;   fail                            % can not read .pl; try .qlf
 2380    ).
 $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.
 2388:- create_prolog_flag(qcompile, false, [type(atom)]). 2389
 2390'$qlf_auto'(PlFile, QlfFile, Options) :-
 2391    (   memberchk(qcompile(QlfMode), Options)
 2392    ->  true
 2393    ;   current_prolog_flag(qcompile, QlfMode),
 2394	\+ '$in_system_dir'(PlFile)
 2395    ),
 2396    (   QlfMode == auto
 2397    ->  true
 2398    ;   QlfMode == large,
 2399	size_file(PlFile, Size),
 2400	Size > 100000
 2401    ),
 2402    access_file(QlfFile, write).
 2403
 2404'$in_system_dir'(PlFile) :-
 2405    current_prolog_flag(home, Home),
 2406    sub_atom(PlFile, 0, _, _, Home).
 2407
 2408'$spec_extension'(File, Ext) :-
 2409    atom(File),
 2410    file_name_extension(_, Ext, File).
 2411'$spec_extension'(Spec, Ext) :-
 2412    compound(Spec),
 2413    arg(1, Spec, Arg),
 2414    '$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:
 2426:- dynamic
 2427    '$resolved_source_path_db'/3.                % ?Spec, ?Dialect, ?Path
 2428
 2429'$load_file'(File, Module, Options) :-
 2430    '$error_count'(E0, W0),
 2431    '$load_file_e'(File, Module, Options),
 2432    '$error_count'(E1, W1),
 2433    Errors is E1-E0,
 2434    Warnings is W1-W0,
 2435    (   Errors+Warnings =:= 0
 2436    ->  true
 2437    ;   '$print_message'(silent, load_file_errors(File, Errors, Warnings))
 2438    ).
 2439
 2440:- if(current_prolog_flag(threads, true)). 2441'$error_count'(Errors, Warnings) :-
 2442    current_prolog_flag(threads, true),
 2443    !,
 2444    thread_self(Me),
 2445    thread_statistics(Me, errors, Errors),
 2446    thread_statistics(Me, warnings, Warnings).
 2447:- endif. 2448'$error_count'(Errors, Warnings) :-
 2449    statistics(errors, Errors),
 2450    statistics(warnings, Warnings).
 2451
 2452'$load_file_e'(File, Module, Options) :-
 2453    \+ memberchk(stream(_), Options),
 2454    user:prolog_load_file(Module:File, Options),
 2455    !.
 2456'$load_file_e'(File, Module, Options) :-
 2457    memberchk(stream(_), Options),
 2458    !,
 2459    '$assert_load_context_module'(File, Module, Options),
 2460    '$qdo_load_file'(File, File, Module, Options).
 2461'$load_file_e'(File, Module, Options) :-
 2462    (   '$resolved_source_path'(File, FullFile, Options)
 2463    ->  true
 2464    ;   '$resolve_source_path'(File, FullFile, Options)
 2465    ),
 2466    !,
 2467    '$mt_load_file'(File, FullFile, Module, Options).
 2468'$load_file_e'(_, _, _).
 $resolved_source_path(+File, -FullFile, +Options) is semidet
True when File has already been resolved to an absolute path.
 2474'$resolved_source_path'(File, FullFile, Options) :-
 2475    current_prolog_flag(emulated_dialect, Dialect),
 2476    '$resolved_source_path_db'(File, Dialect, FullFile),
 2477    (   '$source_file_property'(FullFile, from_state, true)
 2478    ;   '$source_file_property'(FullFile, resource, true)
 2479    ;   '$option'(if(If), Options, true),
 2480	'$noload'(If, FullFile, Options)
 2481    ),
 2482    !.
 $resolve_source_path(+File, -FullFile, +Options) is semidet
Resolve a source file specification to an absolute path. May throw existence and other errors.
 2489'$resolve_source_path'(File, FullFile, Options) :-
 2490    (   '$option'(if(If), Options),
 2491	If == exists
 2492    ->  Extra = [file_errors(fail)]
 2493    ;   Extra = []
 2494    ),
 2495    absolute_file_name(File, FullFile,
 2496		       [ file_type(prolog),
 2497			 access(read)
 2498		       | Extra
 2499		       ]),
 2500    '$register_resolved_source_path'(File, FullFile).
 2501
 2502'$register_resolved_source_path'(File, FullFile) :-
 2503    (   compound(File)
 2504    ->  current_prolog_flag(emulated_dialect, Dialect),
 2505	(   '$resolved_source_path_db'(File, Dialect, FullFile)
 2506	->  true
 2507	;   asserta('$resolved_source_path_db'(File, Dialect, FullFile))
 2508	)
 2509    ;   true
 2510    ).
 $translated_source(+Old, +New) is det
Called from loading a QLF state when source files are being renamed.
 2516:- public '$translated_source'/2. 2517'$translated_source'(Old, New) :-
 2518    forall(retract('$resolved_source_path_db'(File, Dialect, Old)),
 2519	   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.
 2526'$register_resource_file'(FullFile) :-
 2527    (   sub_atom(FullFile, 0, _, _, 'res://'),
 2528	\+ file_name_extension(_, qlf, FullFile)
 2529    ->  '$set_source_file'(FullFile, resource, true)
 2530    ;   true
 2531    ).
 $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.
 2544'$already_loaded'(_File, FullFile, Module, Options) :-
 2545    '$assert_load_context_module'(FullFile, Module, Options),
 2546    '$current_module'(LoadModules, FullFile),
 2547    !,
 2548    (   atom(LoadModules)
 2549    ->  LoadModule = LoadModules
 2550    ;   LoadModules = [LoadModule|_]
 2551    ),
 2552    '$import_from_loaded_module'(LoadModule, Module, Options).
 2553'$already_loaded'(_, _, user, _) :- !.
 2554'$already_loaded'(File, FullFile, Module, Options) :-
 2555    (   '$load_context_module'(FullFile, Module, CtxOptions),
 2556	'$load_ctx_options'(Options, CtxOptions)
 2557    ->  true
 2558    ;   '$load_file'(File, Module, [if(true)|Options])
 2559    ).
 $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.

 2574:- dynamic
 2575    '$loading_file'/3.              % File, Queue, Thread
 2576:- volatile
 2577    '$loading_file'/3. 2578
 2579:- if(current_prolog_flag(threads, true)). 2580'$mt_load_file'(File, FullFile, Module, Options) :-
 2581    current_prolog_flag(threads, true),
 2582    !,
 2583    sig_atomic(setup_call_cleanup(
 2584		   with_mutex('$load_file',
 2585			      '$mt_start_load'(FullFile, Loading, Options)),
 2586		   '$mt_do_load'(Loading, File, FullFile, Module, Options),
 2587		   '$mt_end_load'(Loading))).
 2588:- endif. 2589'$mt_load_file'(File, FullFile, Module, Options) :-
 2590    '$option'(if(If), Options, true),
 2591    '$noload'(If, FullFile, Options),
 2592    !,
 2593    '$already_loaded'(File, FullFile, Module, Options).
 2594:- if(current_prolog_flag(threads, true)). 2595'$mt_load_file'(File, FullFile, Module, Options) :-
 2596    sig_atomic('$qdo_load_file'(File, FullFile, Module, Options)).
 2597:- else. 2598'$mt_load_file'(File, FullFile, Module, Options) :-
 2599    '$qdo_load_file'(File, FullFile, Module, Options).
 2600:- endif. 2601
 2602:- if(current_prolog_flag(threads, true)). 2603'$mt_start_load'(FullFile, queue(Queue), _) :-
 2604    '$loading_file'(FullFile, Queue, LoadThread),
 2605    \+ thread_self(LoadThread),
 2606    !.
 2607'$mt_start_load'(FullFile, already_loaded, Options) :-
 2608    '$option'(if(If), Options, true),
 2609    '$noload'(If, FullFile, Options),
 2610    !.
 2611'$mt_start_load'(FullFile, Ref, _) :-
 2612    thread_self(Me),
 2613    message_queue_create(Queue),
 2614    assertz('$loading_file'(FullFile, Queue, Me), Ref).
 2615
 2616'$mt_do_load'(queue(Queue), File, FullFile, Module, Options) :-
 2617    !,
 2618    catch(thread_get_message(Queue, _), error(_,_), true),
 2619    '$already_loaded'(File, FullFile, Module, Options).
 2620'$mt_do_load'(already_loaded, File, FullFile, Module, Options) :-
 2621    !,
 2622    '$already_loaded'(File, FullFile, Module, Options).
 2623'$mt_do_load'(_Ref, File, FullFile, Module, Options) :-
 2624    '$assert_load_context_module'(FullFile, Module, Options),
 2625    '$qdo_load_file'(File, FullFile, Module, Options).
 2626
 2627'$mt_end_load'(queue(_)) :- !.
 2628'$mt_end_load'(already_loaded) :- !.
 2629'$mt_end_load'(Ref) :-
 2630    clause('$loading_file'(_, Queue, _), _, Ref),
 2631    erase(Ref),
 2632    thread_send_message(Queue, done),
 2633    message_queue_destroy(Queue).
 2634:- endif.
 $qdo_load_file(+Spec, +FullFile, +ContextModule, +Options) is det
Switch to qcompile mode if requested by the option '$qlf'(+Out)
 2640'$qdo_load_file'(File, FullFile, Module, Options) :-
 2641    '$qdo_load_file2'(File, FullFile, Module, Action, Options),
 2642    '$register_resource_file'(FullFile),
 2643    '$run_initialization'(FullFile, Action, Options).
 2644
 2645'$qdo_load_file2'(File, FullFile, Module, Action, Options) :-
 2646    memberchk('$qlf'(QlfOut), Options),
 2647    '$stage_file'(QlfOut, StageQlf),
 2648    !,
 2649    setup_call_catcher_cleanup(
 2650	'$qstart'(StageQlf, Module, State),
 2651	'$do_load_file'(File, FullFile, Module, Action, Options),
 2652	Catcher,
 2653	'$qend'(State, Catcher, StageQlf, QlfOut)).
 2654'$qdo_load_file2'(File, FullFile, Module, Action, Options) :-
 2655    '$do_load_file'(File, FullFile, Module, Action, Options).
 2656
 2657'$qstart'(Qlf, Module, state(OldMode, OldModule)) :-
 2658    '$qlf_open'(Qlf),
 2659    '$compilation_mode'(OldMode, qlf),
 2660    '$set_source_module'(OldModule, Module).
 2661
 2662'$qend'(state(OldMode, OldModule), Catcher, StageQlf, QlfOut) :-
 2663    '$set_source_module'(_, OldModule),
 2664    '$set_compilation_mode'(OldMode),
 2665    '$qlf_close',
 2666    '$install_staged_file'(Catcher, StageQlf, QlfOut, warn).
 2667
 2668'$set_source_module'(OldModule, Module) :-
 2669    '$current_source_module'(OldModule),
 2670    '$set_source_module'(Module).
 $do_load_file(+Spec, +FullFile, +ContextModule, -Action, +Options) is det
Perform the actual loading.
 2677'$do_load_file'(File, FullFile, Module, Action, Options) :-
 2678    '$option'(derived_from(DerivedFrom), Options, -),
 2679    '$register_derived_source'(FullFile, DerivedFrom),
 2680    '$qlf_file'(File, FullFile, Absolute, Mode, Options),
 2681    (   Mode == qcompile
 2682    ->  qcompile(Module:File, Options)
 2683    ;   '$do_load_file_2'(File, Absolute, Module, Action, Options)
 2684    ).
 2685
 2686'$do_load_file_2'(File, Absolute, Module, Action, Options) :-
 2687    '$source_file_property'(Absolute, number_of_clauses, OldClauses),
 2688    statistics(cputime, OldTime),
 2689
 2690    '$setup_load'(ScopedFlags, OldSandBoxed, OldVerbose, OldAutoLevel, OldXRef,
 2691		  Options),
 2692
 2693    '$compilation_level'(Level),
 2694    '$load_msg_level'(load_file, Level, StartMsgLevel, DoneMsgLevel),
 2695    '$print_message'(StartMsgLevel,
 2696		     load_file(start(Level,
 2697				     file(File, Absolute)))),
 2698
 2699    (   memberchk(stream(FromStream), Options)
 2700    ->  Input = stream
 2701    ;   Input = source
 2702    ),
 2703
 2704    (   Input == stream,
 2705	(   '$option'(format(qlf), Options, source)
 2706	->  set_stream(FromStream, file_name(Absolute)),
 2707	    '$qload_stream'(FromStream, Module, Action, LM, Options)
 2708	;   '$consult_file'(stream(Absolute, FromStream, []),
 2709			    Module, Action, LM, Options)
 2710	)
 2711    ->  true
 2712    ;   Input == source,
 2713	file_name_extension(_, Ext, Absolute),
 2714	(   user:prolog_file_type(Ext, qlf),
 2715	    E = error(_,_),
 2716	    catch('$qload_file'(Absolute, Module, Action, LM, Options),
 2717		  E,
 2718		  print_message(warning, E))
 2719	->  true
 2720	;   '$consult_file'(Absolute, Module, Action, LM, Options)
 2721	)
 2722    ->  true
 2723    ;   '$print_message'(error, load_file(failed(File))),
 2724	fail
 2725    ),
 2726
 2727    '$import_from_loaded_module'(LM, Module, Options),
 2728
 2729    '$source_file_property'(Absolute, number_of_clauses, NewClauses),
 2730    statistics(cputime, Time),
 2731    ClausesCreated is NewClauses - OldClauses,
 2732    TimeUsed is Time - OldTime,
 2733
 2734    '$print_message'(DoneMsgLevel,
 2735		     load_file(done(Level,
 2736				    file(File, Absolute),
 2737				    Action,
 2738				    LM,
 2739				    TimeUsed,
 2740				    ClausesCreated))),
 2741
 2742    '$restore_load'(ScopedFlags, OldSandBoxed, OldVerbose, OldAutoLevel, OldXRef).
 2743
 2744'$setup_load'(ScopedFlags, OldSandBoxed, OldVerbose, OldAutoLevel, OldXRef,
 2745	      Options) :-
 2746    '$save_file_scoped_flags'(ScopedFlags),
 2747    '$set_sandboxed_load'(Options, OldSandBoxed),
 2748    '$set_verbose_load'(Options, OldVerbose),
 2749    '$set_optimise_load'(Options),
 2750    '$update_autoload_level'(Options, OldAutoLevel),
 2751    '$set_no_xref'(OldXRef).
 2752
 2753'$restore_load'(ScopedFlags, OldSandBoxed, OldVerbose, OldAutoLevel, OldXRef) :-
 2754    '$set_autoload_level'(OldAutoLevel),
 2755    set_prolog_flag(xref, OldXRef),
 2756    set_prolog_flag(verbose_load, OldVerbose),
 2757    set_prolog_flag(sandboxed_load, OldSandBoxed),
 2758    '$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.
 2766'$save_file_scoped_flags'(State) :-
 2767    current_predicate(findall/3),          % Not when doing boot compile
 2768    !,
 2769    findall(SavedFlag, '$save_file_scoped_flag'(SavedFlag), State).
 2770'$save_file_scoped_flags'([]).
 2771
 2772'$save_file_scoped_flag'(Flag-Value) :-
 2773    '$file_scoped_flag'(Flag, Default),
 2774    (   current_prolog_flag(Flag, Value)
 2775    ->  true
 2776    ;   Value = Default
 2777    ).
 2778
 2779'$file_scoped_flag'(generate_debug_info, true).
 2780'$file_scoped_flag'(optimise,            false).
 2781'$file_scoped_flag'(xref,                false).
 2782
 2783'$restore_file_scoped_flags'([]).
 2784'$restore_file_scoped_flags'([Flag-Value|T]) :-
 2785    set_prolog_flag(Flag, Value),
 2786    '$restore_file_scoped_flags'(T).
 $import_from_loaded_module(+LoadedModule, +Module, +Options) is det
Import public predicates from LoadedModule into Module
 2793'$import_from_loaded_module'(LoadedModule, Module, Options) :-
 2794    LoadedModule \== Module,
 2795    atom(LoadedModule),
 2796    !,
 2797    '$option'(imports(Import), Options, all),
 2798    '$option'(reexport(Reexport), Options, false),
 2799    '$import_list'(Module, LoadedModule, Import, Reexport).
 2800'$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.
 2808'$set_verbose_load'(Options, Old) :-
 2809    current_prolog_flag(verbose_load, Old),
 2810    (   memberchk(silent(Silent), Options)
 2811    ->  (   '$negate'(Silent, Level0)
 2812	->  '$load_msg_compat'(Level0, Level)
 2813	;   Level = Silent
 2814	),
 2815	set_prolog_flag(verbose_load, Level)
 2816    ;   true
 2817    ).
 2818
 2819'$negate'(true, false).
 2820'$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, -)
 2829'$set_sandboxed_load'(Options, Old) :-
 2830    current_prolog_flag(sandboxed_load, Old),
 2831    (   memberchk(sandboxed(SandBoxed), Options),
 2832	'$enter_sandboxed'(Old, SandBoxed, New),
 2833	New \== Old
 2834    ->  set_prolog_flag(sandboxed_load, New)
 2835    ;   true
 2836    ).
 2837
 2838'$enter_sandboxed'(Old, New, SandBoxed) :-
 2839    (   Old == false, New == true
 2840    ->  SandBoxed = true,
 2841	'$ensure_loaded_library_sandbox'
 2842    ;   Old == true, New == false
 2843    ->  throw(error(permission_error(leave, sandbox, -), _))
 2844    ;   SandBoxed = Old
 2845    ).
 2846'$enter_sandboxed'(false, true, true).
 2847
 2848'$ensure_loaded_library_sandbox' :-
 2849    source_file_property(library(sandbox), module(sandbox)),
 2850    !.
 2851'$ensure_loaded_library_sandbox' :-
 2852    load_files(library(sandbox), [if(not_loaded), silent(true)]).
 2853
 2854'$set_optimise_load'(Options) :-
 2855    (   '$option'(optimise(Optimise), Options)
 2856    ->  set_prolog_flag(optimise, Optimise)
 2857    ;   true
 2858    ).
 2859
 2860'$set_no_xref'(OldXRef) :-
 2861    (   current_prolog_flag(xref, OldXRef)
 2862    ->  true
 2863    ;   OldXRef = false
 2864    ),
 2865    set_prolog_flag(xref, false).
 $update_autoload_level(+Options, -OldLevel)
Update the '$autoload_nesting' and return the old value.
 2872:- thread_local
 2873    '$autoload_nesting'/1. 2874
 2875'$update_autoload_level'(Options, AutoLevel) :-
 2876    '$option'(autoload(Autoload), Options, false),
 2877    (   '$autoload_nesting'(CurrentLevel)
 2878    ->  AutoLevel = CurrentLevel
 2879    ;   AutoLevel = 0
 2880    ),
 2881    (   Autoload == false
 2882    ->  true
 2883    ;   NewLevel is AutoLevel + 1,
 2884	'$set_autoload_level'(NewLevel)
 2885    ).
 2886
 2887'$set_autoload_level'(New) :-
 2888    retractall('$autoload_nesting'(_)),
 2889    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.
 2897'$print_message'(Level, Term) :-
 2898    current_predicate(system:print_message/2),
 2899    !,
 2900    print_message(Level, Term).
 2901'$print_message'(warning, Term) :-
 2902    source_location(File, Line),
 2903    !,
 2904    format(user_error, 'WARNING: ~w:~w: ~p~n', [File, Line, Term]).
 2905'$print_message'(error, Term) :-
 2906    !,
 2907    source_location(File, Line),
 2908    !,
 2909    format(user_error, 'ERROR: ~w:~w: ~p~n', [File, Line, Term]).
 2910'$print_message'(_Level, _Term).
 2911
 2912'$print_message_fail'(E) :-
 2913    '$print_message'(error, E),
 2914    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.
 2922'$consult_file'(Absolute, Module, What, LM, Options) :-
 2923    '$current_source_module'(Module),   % same module
 2924    !,
 2925    '$consult_file_2'(Absolute, Module, What, LM, Options).
 2926'$consult_file'(Absolute, Module, What, LM, Options) :-
 2927    '$set_source_module'(OldModule, Module),
 2928    '$ifcompiling'('$qlf_start_sub_module'(Module)),
 2929    '$consult_file_2'(Absolute, Module, What, LM, Options),
 2930    '$ifcompiling'('$qlf_end_part'),
 2931    '$set_source_module'(OldModule).
 2932
 2933'$consult_file_2'(Absolute, Module, What, LM, Options) :-
 2934    '$set_source_module'(OldModule, Module),
 2935    '$load_id'(Absolute, Id, Modified, Options),
 2936    '$compile_type'(What),
 2937    '$save_lex_state'(LexState, Options),
 2938    '$set_dialect'(Options),
 2939    setup_call_cleanup(
 2940	'$start_consult'(Id, Modified),
 2941	'$load_file'(Absolute, Id, LM, Options),
 2942	'$end_consult'(Id, LexState, OldModule)).
 2943
 2944'$end_consult'(Id, LexState, OldModule) :-
 2945    '$end_consult'(Id),
 2946    '$restore_lex_state'(LexState),
 2947    '$set_source_module'(OldModule).
 2948
 2949
 2950:- create_prolog_flag(emulated_dialect, swi, [type(atom)]).
 $save_lex_state(-LexState, +Options) is det
 2954'$save_lex_state'(State, Options) :-
 2955    memberchk(scope_settings(false), Options),
 2956    !,
 2957    State = (-).
 2958'$save_lex_state'(lexstate(Style, Dialect), _) :-
 2959    '$style_check'(Style, Style),
 2960    current_prolog_flag(emulated_dialect, Dialect).
 2961
 2962'$restore_lex_state'(-) :- !.
 2963'$restore_lex_state'(lexstate(Style, Dialect)) :-
 2964    '$style_check'(_, Style),
 2965    set_prolog_flag(emulated_dialect, Dialect).
 2966
 2967'$set_dialect'(Options) :-
 2968    memberchk(dialect(Dialect), Options),
 2969    !,
 2970    '$expects_dialect'(Dialect).
 2971'$set_dialect'(_).
 2972
 2973'$load_id'(stream(Id, _, _), Id, Modified, Options) :-
 2974    !,
 2975    '$modified_id'(Id, Modified, Options).
 2976'$load_id'(Id, Id, Modified, Options) :-
 2977    '$modified_id'(Id, Modified, Options).
 2978
 2979'$modified_id'(_, Modified, Options) :-
 2980    '$option'(modified(Stamp), Options, Def),
 2981    Stamp \== Def,
 2982    !,
 2983    Modified = Stamp.
 2984'$modified_id'(Id, Modified, _) :-
 2985    catch(time_file(Id, Modified),
 2986	  error(_, _),
 2987	  fail),
 2988    !.
 2989'$modified_id'(_, 0.0, _).
 2990
 2991
 2992'$compile_type'(What) :-
 2993    '$compilation_mode'(How),
 2994    (   How == database
 2995    ->  What = compiled
 2996    ;   How == qlf
 2997    ->  What = '*qcompiled*'
 2998    ;   What = 'boot compiled'
 2999    ).
 $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.
 3009:- dynamic
 3010    '$load_context_module'/3. 3011:- multifile
 3012    '$load_context_module'/3. 3013
 3014'$assert_load_context_module'(_, _, Options) :-
 3015    memberchk(register(false), Options),
 3016    !.
 3017'$assert_load_context_module'(File, Module, Options) :-
 3018    source_location(FromFile, Line),
 3019    !,
 3020    '$master_file'(FromFile, MasterFile),
 3021    '$check_load_non_module'(File, Module),
 3022    '$add_dialect'(Options, Options1),
 3023    '$load_ctx_options'(Options1, Options2),
 3024    '$store_admin_clause'(
 3025	system:'$load_context_module'(File, Module, Options2),
 3026	_Layout, MasterFile, FromFile:Line).
 3027'$assert_load_context_module'(File, Module, Options) :-
 3028    '$check_load_non_module'(File, Module),
 3029    '$add_dialect'(Options, Options1),
 3030    '$load_ctx_options'(Options1, Options2),
 3031    (   clause('$load_context_module'(File, Module, _), true, Ref),
 3032	\+ clause_property(Ref, file(_)),
 3033	erase(Ref)
 3034    ->  true
 3035    ;   true
 3036    ),
 3037    assertz('$load_context_module'(File, Module, Options2)).
 3038
 3039'$add_dialect'(Options0, Options) :-
 3040    current_prolog_flag(emulated_dialect, Dialect), Dialect \== swi,
 3041    !,
 3042    Options = [dialect(Dialect)|Options0].
 3043'$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.
 3050'$load_ctx_options'(Options, CtxOptions) :-
 3051    '$load_ctx_options2'(Options, CtxOptions0),
 3052    sort(CtxOptions0, CtxOptions).
 3053
 3054'$load_ctx_options2'([], []).
 3055'$load_ctx_options2'([H|T0], [H|T]) :-
 3056    '$load_ctx_option'(H),
 3057    !,
 3058    '$load_ctx_options2'(T0, T).
 3059'$load_ctx_options2'([_|T0], T) :-
 3060    '$load_ctx_options2'(T0, T).
 3061
 3062'$load_ctx_option'(derived_from(_)).
 3063'$load_ctx_option'(dialect(_)).
 3064'$load_ctx_option'(encoding(_)).
 3065'$load_ctx_option'(imports(_)).
 3066'$load_ctx_option'(reexport(_)).
 $check_load_non_module(+File) is det
Test that a non-module file is not loaded into multiple contexts.
 3074'$check_load_non_module'(File, _) :-
 3075    '$current_module'(_, File),
 3076    !.          % File is a module file
 3077'$check_load_non_module'(File, Module) :-
 3078    '$load_context_module'(File, OldModule, _),
 3079    Module \== OldModule,
 3080    !,
 3081    format(atom(Msg),
 3082	   'Non-module file already loaded into module ~w; \c
 3083	       trying to load into ~w',
 3084	   [OldModule, Module]),
 3085    throw(error(permission_error(load, source, File),
 3086		context(load_files/2, Msg))).
 3087'$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)

 3100'$load_file'(Path, Id, Module, Options) :-
 3101    State = state(true, _, true, false, Id, -),
 3102    (   '$source_term'(Path, _Read, _Layout, Term, Layout,
 3103		       _Stream, Options),
 3104	'$valid_term'(Term),
 3105	(   arg(1, State, true)
 3106	->  '$first_term'(Term, Layout, Id, State, Options),
 3107	    nb_setarg(1, State, false)
 3108	;   '$compile_term'(Term, Layout, Id, Options)
 3109	),
 3110	arg(4, State, true)
 3111    ;   '$fixup_reconsult'(Id),
 3112	'$end_load_file'(State)
 3113    ),
 3114    !,
 3115    arg(2, State, Module).
 3116
 3117'$valid_term'(Var) :-
 3118    var(Var),
 3119    !,
 3120    print_message(error, error(instantiation_error, _)).
 3121'$valid_term'(Term) :-
 3122    Term \== [].
 3123
 3124'$end_load_file'(State) :-
 3125    arg(1, State, true),           % empty file
 3126    !,
 3127    nb_setarg(2, State, Module),
 3128    arg(5, State, Id),
 3129    '$current_source_module'(Module),
 3130    '$ifcompiling'('$qlf_start_file'(Id)),
 3131    '$ifcompiling'('$qlf_end_part').
 3132'$end_load_file'(State) :-
 3133    arg(3, State, End),
 3134    '$end_load_file'(End, State).
 3135
 3136'$end_load_file'(true, _).
 3137'$end_load_file'(end_module, State) :-
 3138    arg(2, State, Module),
 3139    '$check_export'(Module),
 3140    '$ifcompiling'('$qlf_end_part').
 3141'$end_load_file'(end_non_module, _State) :-
 3142    '$ifcompiling'('$qlf_end_part').
 3143
 3144
 3145'$first_term'(?-(Directive), Layout, Id, State, Options) :-
 3146    !,
 3147    '$first_term'(:-(Directive), Layout, Id, State, Options).
 3148'$first_term'(:-(Directive), _Layout, Id, State, Options) :-
 3149    nonvar(Directive),
 3150    (   (   Directive = module(Name, Public)
 3151	->  Imports = []
 3152	;   Directive = module(Name, Public, Imports)
 3153	)
 3154    ->  !,
 3155	'$module_name'(Name, Id, Module, Options),
 3156	'$start_module'(Module, Public, State, Options),
 3157	'$module3'(Imports)
 3158    ;   Directive = expects_dialect(Dialect)
 3159    ->  !,
 3160	'$set_dialect'(Dialect, State),
 3161	fail                        % Still consider next term as first
 3162    ).
 3163'$first_term'(Term, Layout, Id, State, Options) :-
 3164    '$start_non_module'(Id, Term, State, Options),
 3165    '$compile_term'(Term, Layout, Id, Options).
 $compile_term(+Term, +Layout, +SrcId, +Options) is det
 $compile_term(+Term, +Layout, +SrcId, +SrcLoc, +Options) is det
Distinguish between directives and normal clauses.
 3172'$compile_term'(Term, Layout, SrcId, Options) :-
 3173    '$compile_term'(Term, Layout, SrcId, -, Options).
 3174
 3175'$compile_term'(Var, _Layout, _Id, _SrcLoc, _Options) :-
 3176    var(Var),
 3177    !,
 3178    '$instantiation_error'(Var).
 3179'$compile_term'((?-Directive), _Layout, Id, _SrcLoc, Options) :-
 3180    !,
 3181    '$execute_directive'(Directive, Id, Options).
 3182'$compile_term'((:-Directive), _Layout, Id, _SrcLoc, Options) :-
 3183    !,
 3184    '$execute_directive'(Directive, Id, Options).
 3185'$compile_term'('$source_location'(File, Line):Term,
 3186		Layout, Id, _SrcLoc, Options) :-
 3187    !,
 3188    '$compile_term'(Term, Layout, Id, File:Line, Options).
 3189'$compile_term'(Clause, Layout, Id, SrcLoc, _Options) :-
 3190    E = error(_,_),
 3191    catch('$store_clause'(Clause, Layout, Id, SrcLoc), E,
 3192	  '$print_message'(error, E)).
 3193
 3194'$start_non_module'(_Id, Term, _State, Options) :-
 3195    '$option'(must_be_module(true), Options, false),
 3196    !,
 3197    '$domain_error'(module_header, Term).
 3198'$start_non_module'(Id, _Term, State, _Options) :-
 3199    '$current_source_module'(Module),
 3200    '$ifcompiling'('$qlf_start_file'(Id)),
 3201    '$qset_dialect'(State),
 3202    nb_setarg(2, State, Module),
 3203    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.

 3216'$set_dialect'(Dialect, State) :-
 3217    '$compilation_mode'(qlf, database),
 3218    !,
 3219    '$expects_dialect'(Dialect),
 3220    '$compilation_mode'(_, qlf),
 3221    nb_setarg(6, State, Dialect).
 3222'$set_dialect'(Dialect, _) :-
 3223    '$expects_dialect'(Dialect).
 3224
 3225'$qset_dialect'(State) :-
 3226    '$compilation_mode'(qlf),
 3227    arg(6, State, Dialect), Dialect \== (-),
 3228    !,
 3229    '$add_directive_wic'('$expects_dialect'(Dialect)).
 3230'$qset_dialect'(_).
 3231
 3232'$expects_dialect'(Dialect) :-
 3233    Dialect == swi,
 3234    !,
 3235    set_prolog_flag(emulated_dialect, Dialect).
 3236'$expects_dialect'(Dialect) :-
 3237    current_predicate(expects_dialect/1),
 3238    !,
 3239    expects_dialect(Dialect).
 3240'$expects_dialect'(Dialect) :-
 3241    use_module(library(dialect), [expects_dialect/1]),
 3242    expects_dialect(Dialect).
 3243
 3244
 3245		 /*******************************
 3246		 *           MODULES            *
 3247		 *******************************/
 3248
 3249'$start_module'(Module, _Public, State, _Options) :-
 3250    '$current_module'(Module, OldFile),
 3251    source_location(File, _Line),
 3252    OldFile \== File, OldFile \== [],
 3253    same_file(OldFile, File),
 3254    !,
 3255    nb_setarg(2, State, Module),
 3256    nb_setarg(4, State, true).      % Stop processing
 3257'$start_module'(Module, Public, State, Options) :-
 3258    arg(5, State, File),
 3259    nb_setarg(2, State, Module),
 3260    source_location(_File, Line),
 3261    '$option'(redefine_module(Action), Options, false),
 3262    '$module_class'(File, Class, Super),
 3263    '$reset_dialect'(File, Class),
 3264    '$redefine_module'(Module, File, Action),
 3265    '$declare_module'(Module, Class, Super, File, Line, false),
 3266    '$export_list'(Public, Module, Ops),
 3267    '$ifcompiling'('$qlf_start_module'(Module)),
 3268    '$export_ops'(Ops, Module, File),
 3269    '$qset_dialect'(State),
 3270    nb_setarg(3, State, end_module).
 $reset_dialect(+File, +Class) is det
Load .pl files from the SWI-Prolog distribution always in swi dialect.
 3277'$reset_dialect'(File, library) :-
 3278    file_name_extension(_, pl, File),
 3279    !,
 3280    set_prolog_flag(emulated_dialect, swi).
 3281'$reset_dialect'(_, _).
 $module3(+Spec) is det
Handle the 3th argument of a module declartion.
 3288'$module3'(Var) :-
 3289    var(Var),
 3290    !,
 3291    '$instantiation_error'(Var).
 3292'$module3'([]) :- !.
 3293'$module3'([H|T]) :-
 3294    !,
 3295    '$module3'(H),
 3296    '$module3'(T).
 3297'$module3'(Id) :-
 3298    use_module(library(dialect/Id)).
 $module_name(?Name, +Id, -Module, +Options) is semidet
Determine the module name. There are some cases:
 3312'$module_name'(_, _, Module, Options) :-
 3313    '$option'(module(Module), Options),
 3314    !,
 3315    '$current_source_module'(Context),
 3316    Context \== Module.                     % cause '$first_term'/5 to fail.
 3317'$module_name'(Var, Id, Module, Options) :-
 3318    var(Var),
 3319    !,
 3320    file_base_name(Id, File),
 3321    file_name_extension(Var, _, File),
 3322    '$module_name'(Var, Id, Module, Options).
 3323'$module_name'(Reserved, _, _, _) :-
 3324    '$reserved_module'(Reserved),
 3325    !,
 3326    throw(error(permission_error(load, module, Reserved), _)).
 3327'$module_name'(Module, _Id, Module, _).
 3328
 3329
 3330'$reserved_module'(system).
 3331'$reserved_module'(user).
 $redefine_module(+Module, +File, -Redefine)
 3336'$redefine_module'(_Module, _, false) :- !.
 3337'$redefine_module'(Module, File, true) :-
 3338    !,
 3339    (   module_property(Module, file(OldFile)),
 3340	File \== OldFile
 3341    ->  unload_file(OldFile)
 3342    ;   true
 3343    ).
 3344'$redefine_module'(Module, File, ask) :-
 3345    (   stream_property(user_input, tty(true)),
 3346	module_property(Module, file(OldFile)),
 3347	File \== OldFile,
 3348	'$rdef_response'(Module, OldFile, File, true)
 3349    ->  '$redefine_module'(Module, File, true)
 3350    ;   true
 3351    ).
 3352
 3353'$rdef_response'(Module, OldFile, File, Ok) :-
 3354    repeat,
 3355    print_message(query, redefine_module(Module, OldFile, File)),
 3356    get_single_char(Char),
 3357    '$rdef_response'(Char, Ok0),
 3358    !,
 3359    Ok = Ok0.
 3360
 3361'$rdef_response'(Char, true) :-
 3362    memberchk(Char, `yY`),
 3363    format(user_error, 'yes~n', []).
 3364'$rdef_response'(Char, false) :-
 3365    memberchk(Char, `nN`),
 3366    format(user_error, 'no~n', []).
 3367'$rdef_response'(Char, _) :-
 3368    memberchk(Char, `a`),
 3369    format(user_error, 'abort~n', []),
 3370    abort.
 3371'$rdef_response'(_, _) :-
 3372    print_message(help, redefine_module_reply),
 3373    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.
 3383'$module_class'(File, Class, system) :-
 3384    current_prolog_flag(home, Home),
 3385    sub_atom(File, 0, Len, _, Home),
 3386    (   sub_atom(File, Len, _, _, '/boot/')
 3387    ->  !, Class = system
 3388    ;   '$lib_prefix'(Prefix),
 3389	sub_atom(File, Len, _, _, Prefix)
 3390    ->  !, Class = library
 3391    ;   file_directory_name(File, Home),
 3392	file_name_extension(_, rc, File)
 3393    ->  !, Class = library
 3394    ).
 3395'$module_class'(_, user, user).
 3396
 3397'$lib_prefix'('/library').
 3398'$lib_prefix'('/xpce/prolog/').
 3399
 3400'$check_export'(Module) :-
 3401    '$undefined_export'(Module, UndefList),
 3402    (   '$member'(Undef, UndefList),
 3403	strip_module(Undef, _, Local),
 3404	print_message(error,
 3405		      undefined_export(Module, Local)),
 3406	fail
 3407    ;   true
 3408    ).
 $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).
 3417'$import_list'(_, _, Var, _) :-
 3418    var(Var),
 3419    !,
 3420    throw(error(instantitation_error, _)).
 3421'$import_list'(Target, Source, all, Reexport) :-
 3422    !,
 3423    '$exported_ops'(Source, Import, Predicates),
 3424    '$module_property'(Source, exports(Predicates)),
 3425    '$import_all'(Import, Target, Source, Reexport, weak).
 3426'$import_list'(Target, Source, except(Spec), Reexport) :-
 3427    !,
 3428    '$exported_ops'(Source, Export, Predicates),
 3429    '$module_property'(Source, exports(Predicates)),
 3430    (   is_list(Spec)
 3431    ->  true
 3432    ;   throw(error(type_error(list, Spec), _))
 3433    ),
 3434    '$import_except'(Spec, Export, Import),
 3435    '$import_all'(Import, Target, Source, Reexport, weak).
 3436'$import_list'(Target, Source, Import, Reexport) :-
 3437    !,
 3438    is_list(Import),
 3439    !,
 3440    '$import_all'(Import, Target, Source, Reexport, strong).
 3441'$import_list'(_, _, Import, _) :-
 3442    throw(error(type_error(import_specifier, Import))).
 3443
 3444
 3445'$import_except'([], List, List).
 3446'$import_except'([H|T], List0, List) :-
 3447    '$import_except_1'(H, List0, List1),
 3448    '$import_except'(T, List1, List).
 3449
 3450'$import_except_1'(Var, _, _) :-
 3451    var(Var),
 3452    !,
 3453    throw(error(instantitation_error, _)).
 3454'$import_except_1'(PI as N, List0, List) :-
 3455    '$pi'(PI), atom(N),
 3456    !,
 3457    '$canonical_pi'(PI, CPI),
 3458    '$import_as'(CPI, N, List0, List).
 3459'$import_except_1'(op(P,A,N), List0, List) :-
 3460    !,
 3461    '$remove_ops'(List0, op(P,A,N), List).
 3462'$import_except_1'(PI, List0, List) :-
 3463    '$pi'(PI),
 3464    !,
 3465    '$canonical_pi'(PI, CPI),
 3466    '$select'(P, List0, List),
 3467    '$canonical_pi'(CPI, P),
 3468    !.
 3469'$import_except_1'(Except, _, _) :-
 3470    throw(error(type_error(import_specifier, Except), _)).
 3471
 3472'$import_as'(CPI, N, [PI2|T], [CPI as N|T]) :-
 3473    '$canonical_pi'(PI2, CPI),
 3474    !.
 3475'$import_as'(PI, N, [H|T0], [H|T]) :-
 3476    !,
 3477    '$import_as'(PI, N, T0, T).
 3478'$import_as'(PI, _, _, _) :-
 3479    throw(error(existence_error(export, PI), _)).
 3480
 3481'$pi'(N/A) :- atom(N), integer(A), !.
 3482'$pi'(N//A) :- atom(N), integer(A).
 3483
 3484'$canonical_pi'(N//A0, N/A) :-
 3485    A is A0 + 2.
 3486'$canonical_pi'(PI, PI).
 3487
 3488'$remove_ops'([], _, []).
 3489'$remove_ops'([Op|T0], Pattern, T) :-
 3490    subsumes_term(Pattern, Op),
 3491    !,
 3492    '$remove_ops'(T0, Pattern, T).
 3493'$remove_ops'([H|T0], Pattern, [H|T]) :-
 3494    '$remove_ops'(T0, Pattern, T).
 $import_all(+Import, +Context, +Source, +Reexport, +Strength)
 3499'$import_all'(Import, Context, Source, Reexport, Strength) :-
 3500    '$import_all2'(Import, Context, Source, Imported, ImpOps, Strength),
 3501    (   Reexport == true,
 3502	(   '$list_to_conj'(Imported, Conj)
 3503	->  export(Context:Conj),
 3504	    '$ifcompiling'('$add_directive_wic'(export(Context:Conj)))
 3505	;   true
 3506	),
 3507	source_location(File, _Line),
 3508	'$export_ops'(ImpOps, Context, File)
 3509    ;   true
 3510    ).
 $import_all2(+Imports, +Context, +Source, -Imported, -ImpOps, +Strength)
 3514'$import_all2'([], _, _, [], [], _).
 3515'$import_all2'([PI as NewName|Rest], Context, Source,
 3516	       [NewName/Arity|Imported], ImpOps, Strength) :-
 3517    !,
 3518    '$canonical_pi'(PI, Name/Arity),
 3519    length(Args, Arity),
 3520    Head =.. [Name|Args],
 3521    NewHead =.. [NewName|Args],
 3522    (   '$get_predicate_attribute'(Source:Head, transparent, 1)
 3523    ->  '$set_predicate_attribute'(Context:NewHead, transparent, true)
 3524    ;   true
 3525    ),
 3526    (   source_location(File, Line)
 3527    ->  E = error(_,_),
 3528	catch('$store_admin_clause'((NewHead :- Source:Head),
 3529				    _Layout, File, File:Line),
 3530	      E, '$print_message'(error, E))
 3531    ;   assertz((NewHead :- !, Source:Head)) % ! avoids problems with
 3532    ),                                       % duplicate load
 3533    '$import_all2'(Rest, Context, Source, Imported, ImpOps, Strength).
 3534'$import_all2'([op(P,A,N)|Rest], Context, Source, Imported,
 3535	       [op(P,A,N)|ImpOps], Strength) :-
 3536    !,
 3537    '$import_ops'(Context, Source, op(P,A,N)),
 3538    '$import_all2'(Rest, Context, Source, Imported, ImpOps, Strength).
 3539'$import_all2'([Pred|Rest], Context, Source, [Pred|Imported], ImpOps, Strength) :-
 3540    Error = error(_,_),
 3541    catch(Context:'$import'(Source:Pred, Strength), Error,
 3542	  print_message(error, Error)),
 3543    '$ifcompiling'('$import_wic'(Source, Pred, Strength)),
 3544    '$import_all2'(Rest, Context, Source, Imported, ImpOps, Strength).
 3545
 3546
 3547'$list_to_conj'([One], One) :- !.
 3548'$list_to_conj'([H|T], (H,Rest)) :-
 3549    '$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.
 3556'$exported_ops'(Module, Ops, Tail) :-
 3557    '$c_current_predicate'(_, Module:'$exported_op'(_,_,_)),
 3558    !,
 3559    findall(op(P,A,N), Module:'$exported_op'(P,A,N), Ops, Tail).
 3560'$exported_ops'(_, Ops, Ops).
 3561
 3562'$exported_op'(Module, P, A, N) :-
 3563    '$c_current_predicate'(_, Module:'$exported_op'(_,_,_)),
 3564    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.
 3571'$import_ops'(To, From, Pattern) :-
 3572    ground(Pattern),
 3573    !,
 3574    Pattern = op(P,A,N),
 3575    op(P,A,To:N),
 3576    (   '$exported_op'(From, P, A, N)
 3577    ->  true
 3578    ;   print_message(warning, no_exported_op(From, Pattern))
 3579    ).
 3580'$import_ops'(To, From, Pattern) :-
 3581    (   '$exported_op'(From, Pri, Assoc, Name),
 3582	Pattern = op(Pri, Assoc, Name),
 3583	op(Pri, Assoc, To:Name),
 3584	fail
 3585    ;   true
 3586    ).
 $export_list(+Declarations, +Module, -Ops)
Handle the export list of the module declaration for Module associated to File.
 3594'$export_list'(Decls, Module, Ops) :-
 3595    is_list(Decls),
 3596    !,
 3597    '$do_export_list'(Decls, Module, Ops).
 3598'$export_list'(Decls, _, _) :-
 3599    var(Decls),
 3600    throw(error(instantiation_error, _)).
 3601'$export_list'(Decls, _, _) :-
 3602    throw(error(type_error(list, Decls), _)).
 3603
 3604'$do_export_list'([], _, []) :- !.
 3605'$do_export_list'([H|T], Module, Ops) :-
 3606    !,
 3607    E = error(_,_),
 3608    catch('$export1'(H, Module, Ops, Ops1),
 3609	  E, ('$print_message'(error, E), Ops = Ops1)),
 3610    '$do_export_list'(T, Module, Ops1).
 3611
 3612'$export1'(Var, _, _, _) :-
 3613    var(Var),
 3614    !,
 3615    throw(error(instantiation_error, _)).
 3616'$export1'(Op, _, [Op|T], T) :-
 3617    Op = op(_,_,_),
 3618    !.
 3619'$export1'(PI0, Module, Ops, Ops) :-
 3620    strip_module(Module:PI0, M, PI),
 3621    (   PI = (_//_)
 3622    ->  non_terminal(M:PI)
 3623    ;   true
 3624    ),
 3625    export(M:PI).
 3626
 3627'$export_ops'([op(Pri, Assoc, Name)|T], Module, File) :-
 3628    E = error(_,_),
 3629    catch(( '$execute_directive'(op(Pri, Assoc, Module:Name), File, []),
 3630	    '$export_op'(Pri, Assoc, Name, Module, File)
 3631	  ),
 3632	  E, '$print_message'(error, E)),
 3633    '$export_ops'(T, Module, File).
 3634'$export_ops'([], _, _).
 3635
 3636'$export_op'(Pri, Assoc, Name, Module, File) :-
 3637    (   '$get_predicate_attribute'(Module:'$exported_op'(_,_,_), defined, 1)
 3638    ->  true
 3639    ;   '$execute_directive'(discontiguous(Module:'$exported_op'/3), File, [])
 3640    ),
 3641    '$store_admin_clause'('$exported_op'(Pri, Assoc, Name), _Layout, File, -).
 $execute_directive(:Goal, +File, +Options) is det
Execute the argument of :- or ?- while loading a file.
 3647'$execute_directive'(Var, _F, _Options) :-
 3648    var(Var),
 3649    '$instantiation_error'(Var).
 3650'$execute_directive'(encoding(Encoding), _F, _Options) :-
 3651    !,
 3652    (   '$load_input'(_F, S)
 3653    ->  set_stream(S, encoding(Encoding))
 3654    ).
 3655'$execute_directive'(Goal, _, Options) :-
 3656    \+ '$compilation_mode'(database),
 3657    !,
 3658    '$add_directive_wic2'(Goal, Type, Options),
 3659    (   Type == call                % suspend compiling into .qlf file
 3660    ->  '$compilation_mode'(Old, database),
 3661	setup_call_cleanup(
 3662	    '$directive_mode'(OldDir, Old),
 3663	    '$execute_directive_3'(Goal),
 3664	    ( '$set_compilation_mode'(Old),
 3665	      '$set_directive_mode'(OldDir)
 3666	    ))
 3667    ;   '$execute_directive_3'(Goal)
 3668    ).
 3669'$execute_directive'(Goal, _, _Options) :-
 3670    '$execute_directive_3'(Goal).
 3671
 3672'$execute_directive_3'(Goal) :-
 3673    '$current_source_module'(Module),
 3674    '$valid_directive'(Module:Goal),
 3675    !,
 3676    (   '$pattr_directive'(Goal, Module)
 3677    ->  true
 3678    ;   Term = error(_,_),
 3679	catch(Module:Goal, Term, '$exception_in_directive'(Term))
 3680    ->  true
 3681    ;   '$print_message'(warning, goal_failed(directive, Module:Goal)),
 3682	fail
 3683    ).
 3684'$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.
 3693:- multifile prolog:sandbox_allowed_directive/1. 3694:- multifile prolog:sandbox_allowed_clause/1. 3695:- meta_predicate '$valid_directive'(:). 3696
 3697'$valid_directive'(_) :-
 3698    current_prolog_flag(sandboxed_load, false),
 3699    !.
 3700'$valid_directive'(Goal) :-
 3701    Error = error(Formal, _),
 3702    catch(prolog:sandbox_allowed_directive(Goal), Error, true),
 3703    !,
 3704    (   var(Formal)
 3705    ->  true
 3706    ;   print_message(error, Error),
 3707	fail
 3708    ).
 3709'$valid_directive'(Goal) :-
 3710    print_message(error,
 3711		  error(permission_error(execute,
 3712					 sandboxed_directive,
 3713					 Goal), _)),
 3714    fail.
 3715
 3716'$exception_in_directive'(Term) :-
 3717    '$print_message'(error, Term),
 3718    fail.
 $add_directive_wic2(+Directive, -Type, +Options) is det
Classify Directive as one of load or call. Add a call directive to the QLF file. load directives continue the compilation into the QLF file.
 3726'$add_directive_wic2'(Goal, Type, Options) :-
 3727    '$common_goal_type'(Goal, Type, Options),
 3728    !,
 3729    (   Type == load
 3730    ->  true
 3731    ;   '$current_source_module'(Module),
 3732	'$add_directive_wic'(Module:Goal)
 3733    ).
 3734'$add_directive_wic2'(Goal, _, _) :-
 3735    (   '$compilation_mode'(qlf)    % no problem for qlf files
 3736    ->  true
 3737    ;   print_message(error, mixed_directive(Goal))
 3738    ).
 $common_goal_type(+Directive, -Type, +Options) is semidet
True when all subgoals of Directive must be handled using load or call.
 3745'$common_goal_type'((A,B), Type, Options) :-
 3746    !,
 3747    '$common_goal_type'(A, Type, Options),
 3748    '$common_goal_type'(B, Type, Options).
 3749'$common_goal_type'((A;B), Type, Options) :-
 3750    !,
 3751    '$common_goal_type'(A, Type, Options),
 3752    '$common_goal_type'(B, Type, Options).
 3753'$common_goal_type'((A->B), Type, Options) :-
 3754    !,
 3755    '$common_goal_type'(A, Type, Options),
 3756    '$common_goal_type'(B, Type, Options).
 3757'$common_goal_type'(Goal, Type, Options) :-
 3758    '$goal_type'(Goal, Type, Options).
 3759
 3760'$goal_type'(Goal, Type, Options) :-
 3761    (   '$load_goal'(Goal, Options)
 3762    ->  Type = load
 3763    ;   Type = call
 3764    ).
 3765
 3766:- thread_local
 3767    '$qlf':qinclude/1. 3768
 3769'$load_goal'([_|_], _).
 3770'$load_goal'(consult(_), _).
 3771'$load_goal'(load_files(_), _).
 3772'$load_goal'(load_files(_,Options), _) :-
 3773    memberchk(qcompile(QlfMode), Options),
 3774    '$qlf_part_mode'(QlfMode).
 3775'$load_goal'(ensure_loaded(_), _) :- '$compilation_mode'(wic).
 3776'$load_goal'(use_module(_), _)    :- '$compilation_mode'(wic).
 3777'$load_goal'(use_module(_, _), _) :- '$compilation_mode'(wic).
 3778'$load_goal'(reexport(_), _)      :- '$compilation_mode'(wic).
 3779'$load_goal'(reexport(_, _), _)   :- '$compilation_mode'(wic).
 3780'$load_goal'(Goal, _Options) :-
 3781    '$qlf':qinclude(user),
 3782    '$load_goal_file'(Goal, File),
 3783    '$all_user_files'(File).
 3784
 3785
 3786'$load_goal_file'(load_files(F), F).
 3787'$load_goal_file'(load_files(F, _), F).
 3788'$load_goal_file'(ensure_loaded(F), F).
 3789'$load_goal_file'(use_module(F), F).
 3790'$load_goal_file'(use_module(F, _), F).
 3791'$load_goal_file'(reexport(F), F).
 3792'$load_goal_file'(reexport(F, _), F).
 3793
 3794'$all_user_files'([]) :-
 3795    !.
 3796'$all_user_files'([H|T]) :-
 3797    !,
 3798    '$is_user_file'(H),
 3799    '$all_user_files'(T).
 3800'$all_user_files'(F) :-
 3801    ground(F),
 3802    '$is_user_file'(F).
 3803
 3804'$is_user_file'(File) :-
 3805    absolute_file_name(File, Path,
 3806		       [ file_type(prolog),
 3807			 access(read)
 3808		       ]),
 3809    '$module_class'(Path, user, _).
 3810
 3811'$qlf_part_mode'(part).
 3812'$qlf_part_mode'(true).                 % compatibility
 3813
 3814
 3815		/********************************
 3816		*        COMPILE A CLAUSE       *
 3817		*********************************/
 $store_admin_clause(+Clause, ?Layout, +Owner, +SrcLoc) is det
Store a clause into the database for administrative purposes. This bypasses sanity checking.
 3824'$store_admin_clause'(Clause, Layout, Owner, SrcLoc) :-
 3825    Owner \== (-),
 3826    !,
 3827    setup_call_cleanup(
 3828	'$start_aux'(Owner, Context),
 3829	'$store_admin_clause2'(Clause, Layout, Owner, SrcLoc),
 3830	'$end_aux'(Owner, Context)).
 3831'$store_admin_clause'(Clause, Layout, File, SrcLoc) :-
 3832    '$store_admin_clause2'(Clause, Layout, File, SrcLoc).
 3833
 3834'$store_admin_clause2'(Clause, _Layout, File, SrcLoc) :-
 3835    (   '$compilation_mode'(database)
 3836    ->  '$record_clause'(Clause, File, SrcLoc)
 3837    ;   '$record_clause'(Clause, File, SrcLoc, Ref),
 3838	'$qlf_assert_clause'(Ref, development)
 3839    ).
 $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.
 3849'$store_clause'((_, _), _, _, _) :-
 3850    !,
 3851    print_message(error, cannot_redefine_comma),
 3852    fail.
 3853'$store_clause'((Pre => Body), _Layout, File, SrcLoc) :-
 3854    nonvar(Pre),
 3855    Pre = (Head,Cond),
 3856    !,
 3857    (   '$is_true'(Cond), current_prolog_flag(optimise, true)
 3858    ->  '$store_clause'((Head=>Body), _Layout, File, SrcLoc)
 3859    ;   '$store_clause'(?=>(Head,(Cond,!,Body)), _Layout, File, SrcLoc)
 3860    ).
 3861'$store_clause'(Clause, _Layout, File, SrcLoc) :-
 3862    '$valid_clause'(Clause),
 3863    !,
 3864    (   '$compilation_mode'(database)
 3865    ->  '$record_clause'(Clause, File, SrcLoc)
 3866    ;   '$record_clause'(Clause, File, SrcLoc, Ref),
 3867	'$qlf_assert_clause'(Ref, development)
 3868    ).
 3869
 3870'$is_true'(true)  => true.
 3871'$is_true'((A,B)) => '$is_true'(A), '$is_true'(B).
 3872'$is_true'(_)     => fail.
 3873
 3874'$valid_clause'(_) :-
 3875    current_prolog_flag(sandboxed_load, false),
 3876    !.
 3877'$valid_clause'(Clause) :-
 3878    \+ '$cross_module_clause'(Clause),
 3879    !.
 3880'$valid_clause'(Clause) :-
 3881    Error = error(Formal, _),
 3882    catch(prolog:sandbox_allowed_clause(Clause), Error, true),
 3883    !,
 3884    (   var(Formal)
 3885    ->  true
 3886    ;   print_message(error, Error),
 3887	fail
 3888    ).
 3889'$valid_clause'(Clause) :-
 3890    print_message(error,
 3891		  error(permission_error(assert,
 3892					 sandboxed_clause,
 3893					 Clause), _)),
 3894    fail.
 3895
 3896'$cross_module_clause'(Clause) :-
 3897    '$head_module'(Clause, Module),
 3898    \+ '$current_source_module'(Module).
 3899
 3900'$head_module'(Var, _) :-
 3901    var(Var), !, fail.
 3902'$head_module'((Head :- _), Module) :-
 3903    '$head_module'(Head, Module).
 3904'$head_module'(Module:_, Module).
 3905
 3906'$clause_source'('$source_location'(File,Line):Clause, Clause, File:Line) :- !.
 3907'$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.
 3914:- public
 3915    '$store_clause'/2. 3916
 3917'$store_clause'(Term, Id) :-
 3918    '$clause_source'(Term, Clause, SrcLoc),
 3919    '$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?
 3940compile_aux_clauses(_Clauses) :-
 3941    current_prolog_flag(xref, true),
 3942    !.
 3943compile_aux_clauses(Clauses) :-
 3944    source_location(File, _Line),
 3945    '$compile_aux_clauses'(Clauses, File).
 3946
 3947'$compile_aux_clauses'(Clauses, File) :-
 3948    setup_call_cleanup(
 3949	'$start_aux'(File, Context),
 3950	'$store_aux_clauses'(Clauses, File),
 3951	'$end_aux'(File, Context)).
 3952
 3953'$store_aux_clauses'(Clauses, File) :-
 3954    is_list(Clauses),
 3955    !,
 3956    forall('$member'(C,Clauses),
 3957	   '$compile_term'(C, _Layout, File, [])).
 3958'$store_aux_clauses'(Clause, File) :-
 3959    '$compile_term'(Clause, _Layout, File, []).
 3960
 3961
 3962		 /*******************************
 3963		 *            STAGING		*
 3964		 *******************************/
 $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.
 3974'$stage_file'(Target, Stage) :-
 3975    file_directory_name(Target, Dir),
 3976    file_base_name(Target, File),
 3977    current_prolog_flag(pid, Pid),
 3978    format(atom(Stage), '~w/.~w.~d', [Dir,File,Pid]).
 3979
 3980'$install_staged_file'(exit, Staged, Target, error) :-
 3981    !,
 3982    rename_file(Staged, Target).
 3983'$install_staged_file'(exit, Staged, Target, OnError) :-
 3984    !,
 3985    InstallError = error(_,_),
 3986    catch(rename_file(Staged, Target),
 3987	  InstallError,
 3988	  '$install_staged_error'(OnError, InstallError, Staged, Target)).
 3989'$install_staged_file'(_, Staged, _, _OnError) :-
 3990    E = error(_,_),
 3991    catch(delete_file(Staged), E, true).
 3992
 3993'$install_staged_error'(OnError, Error, Staged, _Target) :-
 3994    E = error(_,_),
 3995    catch(delete_file(Staged), E, true),
 3996    (   OnError = silent
 3997    ->  true
 3998    ;   OnError = fail
 3999    ->  fail
 4000    ;   print_message(warning, Error)
 4001    ).
 4002
 4003
 4004		 /*******************************
 4005		 *             READING          *
 4006		 *******************************/
 4007
 4008:- multifile
 4009    prolog:comment_hook/3.                  % hook for read_clause/3
 4010
 4011
 4012		 /*******************************
 4013		 *       FOREIGN INTERFACE      *
 4014		 *******************************/
 4015
 4016%       call-back from PL_register_foreign().  First argument is the module
 4017%       into which the foreign predicate is loaded and second is a term
 4018%       describing the arguments.
 4019
 4020:- dynamic
 4021    '$foreign_registered'/2. 4022
 4023		 /*******************************
 4024		 *   TEMPORARY TERM EXPANSION   *
 4025		 *******************************/
 4026
 4027% Provide temporary definitions for the boot-loader.  These are replaced
 4028% by the real thing in load.pl
 4029
 4030:- dynamic
 4031    '$expand_goal'/2,
 4032    '$expand_term'/4. 4033
 4034'$expand_goal'(In, In).
 4035'$expand_term'(In, Layout, In, Layout).
 4036
 4037
 4038		 /*******************************
 4039		 *         TYPE SUPPORT         *
 4040		 *******************************/
 4041
 4042'$type_error'(Type, Value) :-
 4043    (   var(Value)
 4044    ->  throw(error(instantiation_error, _))
 4045    ;   throw(error(type_error(Type, Value), _))
 4046    ).
 4047
 4048'$domain_error'(Type, Value) :-
 4049    throw(error(domain_error(Type, Value), _)).
 4050
 4051'$existence_error'(Type, Object) :-
 4052    throw(error(existence_error(Type, Object), _)).
 4053
 4054'$permission_error'(Action, Type, Term) :-
 4055    throw(error(permission_error(Action, Type, Term), _)).
 4056
 4057'$instantiation_error'(_Var) :-
 4058    throw(error(instantiation_error, _)).
 4059
 4060'$uninstantiation_error'(NonVar) :-
 4061    throw(error(uninstantiation_error(NonVar), _)).
 4062
 4063'$must_be'(list, X) :- !,
 4064    '$skip_list'(_, X, Tail),
 4065    (   Tail == []
 4066    ->  true
 4067    ;   '$type_error'(list, Tail)
 4068    ).
 4069'$must_be'(options, X) :- !,
 4070    (   '$is_options'(X)
 4071    ->  true
 4072    ;   '$type_error'(options, X)
 4073    ).
 4074'$must_be'(atom, X) :- !,
 4075    (   atom(X)
 4076    ->  true
 4077    ;   '$type_error'(atom, X)
 4078    ).
 4079'$must_be'(integer, X) :- !,
 4080    (   integer(X)
 4081    ->  true
 4082    ;   '$type_error'(integer, X)
 4083    ).
 4084'$must_be'(between(Low,High), X) :- !,
 4085    (   integer(X)
 4086    ->  (   between(Low, High, X)
 4087	->  true
 4088	;   '$domain_error'(between(Low,High), X)
 4089	)
 4090    ;   '$type_error'(integer, X)
 4091    ).
 4092'$must_be'(callable, X) :- !,
 4093    (   callable(X)
 4094    ->  true
 4095    ;   '$type_error'(callable, X)
 4096    ).
 4097'$must_be'(acyclic, X) :- !,
 4098    (   acyclic_term(X)
 4099    ->  true
 4100    ;   '$domain_error'(acyclic_term, X)
 4101    ).
 4102'$must_be'(oneof(Type, Domain, List), X) :- !,
 4103    '$must_be'(Type, X),
 4104    (   memberchk(X, List)
 4105    ->  true
 4106    ;   '$domain_error'(Domain, X)
 4107    ).
 4108'$must_be'(boolean, X) :- !,
 4109    (   (X == true ; X == false)
 4110    ->  true
 4111    ;   '$type_error'(boolean, X)
 4112    ).
 4113'$must_be'(ground, X) :- !,
 4114    (   ground(X)
 4115    ->  true
 4116    ;   '$instantiation_error'(X)
 4117    ).
 4118'$must_be'(filespec, X) :- !,
 4119    (   (   atom(X)
 4120	;   string(X)
 4121	;   compound(X),
 4122	    compound_name_arity(X, _, 1)
 4123	)
 4124    ->  true
 4125    ;   '$type_error'(filespec, X)
 4126    ).
 4127
 4128% Use for debugging
 4129%'$must_be'(Type, _X) :- format('Unknown $must_be type: ~q~n', [Type]).
 4130
 4131
 4132		/********************************
 4133		*       LIST PROCESSING         *
 4134		*********************************/
 4135
 4136'$member'(El, [H|T]) :-
 4137    '$member_'(T, El, H).
 4138
 4139'$member_'(_, El, El).
 4140'$member_'([H|T], El, _) :-
 4141    '$member_'(T, El, H).
 4142
 4143'$append'([], L, L).
 4144'$append'([H|T], L, [H|R]) :-
 4145    '$append'(T, L, R).
 4146
 4147'$append'(ListOfLists, List) :-
 4148    '$must_be'(list, ListOfLists),
 4149    '$append_'(ListOfLists, List).
 4150
 4151'$append_'([], []).
 4152'$append_'([L|Ls], As) :-
 4153    '$append'(L, Ws, As),
 4154    '$append_'(Ls, Ws).
 4155
 4156'$select'(X, [X|Tail], Tail).
 4157'$select'(Elem, [Head|Tail], [Head|Rest]) :-
 4158    '$select'(Elem, Tail, Rest).
 4159
 4160'$reverse'(L1, L2) :-
 4161    '$reverse'(L1, [], L2).
 4162
 4163'$reverse'([], List, List).
 4164'$reverse'([Head|List1], List2, List3) :-
 4165    '$reverse'(List1, [Head|List2], List3).
 4166
 4167'$delete'([], _, []) :- !.
 4168'$delete'([Elem|Tail], Elem, Result) :-
 4169    !,
 4170    '$delete'(Tail, Elem, Result).
 4171'$delete'([Head|Tail], Elem, [Head|Rest]) :-
 4172    '$delete'(Tail, Elem, Rest).
 4173
 4174'$last'([H|T], Last) :-
 4175    '$last'(T, H, Last).
 4176
 4177'$last'([], Last, Last).
 4178'$last'([H|T], _, Last) :-
 4179    '$last'(T, H, Last).
 length(?List, ?N)
Is true when N is the length of List.
 4186:- '$iso'((length/2)). 4187
 4188length(List, Length) :-
 4189    var(Length),
 4190    !,
 4191    '$skip_list'(Length0, List, Tail),
 4192    (   Tail == []
 4193    ->  Length = Length0                    % +,-
 4194    ;   var(Tail)
 4195    ->  Tail \== Length,                    % avoid length(L,L)
 4196	'$length3'(Tail, Length, Length0)   % -,-
 4197    ;   throw(error(type_error(list, List),
 4198		    context(length/2, _)))
 4199    ).
 4200length(List, Length) :-
 4201    integer(Length),
 4202    Length >= 0,
 4203    !,
 4204    '$skip_list'(Length0, List, Tail),
 4205    (   Tail == []                          % proper list
 4206    ->  Length = Length0
 4207    ;   var(Tail)
 4208    ->  Extra is Length-Length0,
 4209	'$length'(Tail, Extra)
 4210    ;   throw(error(type_error(list, List),
 4211		    context(length/2, _)))
 4212    ).
 4213length(_, Length) :-
 4214    integer(Length),
 4215    !,
 4216    throw(error(domain_error(not_less_than_zero, Length),
 4217		context(length/2, _))).
 4218length(_, Length) :-
 4219    throw(error(type_error(integer, Length),
 4220		context(length/2, _))).
 4221
 4222'$length3'([], N, N).
 4223'$length3'([_|List], N, N0) :-
 4224    N1 is N0+1,
 4225    '$length3'(List, N, N1).
 4226
 4227
 4228		 /*******************************
 4229		 *       OPTION PROCESSING      *
 4230		 *******************************/
 $is_options(@Term) is semidet
True if Term looks like it provides options.
 4236'$is_options'(Map) :-
 4237    is_dict(Map, _),
 4238    !.
 4239'$is_options'(List) :-
 4240    is_list(List),
 4241    (   List == []
 4242    ->  true
 4243    ;   List = [H|_],
 4244	'$is_option'(H, _, _)
 4245    ).
 4246
 4247'$is_option'(Var, _, _) :-
 4248    var(Var), !, fail.
 4249'$is_option'(F, Name, Value) :-
 4250    functor(F, _, 1),
 4251    !,
 4252    F =.. [Name,Value].
 4253'$is_option'(Name=Value, Name, Value).
 $option(?Opt, +Options) is semidet
 4257'$option'(Opt, Options) :-
 4258    is_dict(Options),
 4259    !,
 4260    [Opt] :< Options.
 4261'$option'(Opt, Options) :-
 4262    memberchk(Opt, Options).
 $option(?Opt, +Options, +Default) is det
 4266'$option'(Term, Options, Default) :-
 4267    arg(1, Term, Value),
 4268    functor(Term, Name, 1),
 4269    (   is_dict(Options)
 4270    ->  (   get_dict(Name, Options, GVal)
 4271	->  Value = GVal
 4272	;   Value = Default
 4273	)
 4274    ;   functor(Gen, Name, 1),
 4275	arg(1, Gen, GVal),
 4276	(   memberchk(Gen, Options)
 4277	->  Value = GVal
 4278	;   Value = Default
 4279	)
 4280    ).
 $select_option(?Opt, +Options, -Rest) is semidet
Select an option from Options.
Arguments:
Rest- is always a map.
 4288'$select_option'(Opt, Options, Rest) :-
 4289    select_dict([Opt], Options, Rest).
 $merge_options(+New, +Default, -Merged) is det
Add/replace options specified in New.
Arguments:
Merged- is always a map.
 4297'$merge_options'(New, Old, Merged) :-
 4298    put_dict(New, Old, Merged).
 4299
 4300
 4301		 /*******************************
 4302		 *   HANDLE TRACER 'L'-COMMAND  *
 4303		 *******************************/
 4304
 4305:- public '$prolog_list_goal'/1. 4306
 4307:- multifile
 4308    user:prolog_list_goal/1. 4309
 4310'$prolog_list_goal'(Goal) :-
 4311    user:prolog_list_goal(Goal),
 4312    !.
 4313'$prolog_list_goal'(Goal) :-
 4314    use_module(library(listing), [listing/1]),
 4315    @(listing(Goal), user).
 4316
 4317
 4318		 /*******************************
 4319		 *             HALT             *
 4320		 *******************************/
 4321
 4322:- '$iso'((halt/0)). 4323
 4324halt :-
 4325    '$exit_code'(Code),
 4326    (   Code == 0
 4327    ->  true
 4328    ;   print_message(warning, on_error(halt(1)))
 4329    ),
 4330    halt(Code).
 $exit_code(Code)
Determine the exit code baed on the on_error and on_warning flags. Also used by qsave_toplevel/0.
 4337'$exit_code'(Code) :-
 4338    (   (   current_prolog_flag(on_error, status),
 4339	    statistics(errors, Count),
 4340	    Count > 0
 4341	;   current_prolog_flag(on_warning, status),
 4342	    statistics(warnings, Count),
 4343	    Count > 0
 4344	)
 4345    ->  Code = 1
 4346    ;   Code = 0
 4347    ).
 at_halt(:Goal)
Register Goal to be called if the system halts.
To be done
- : get location into the error message
 4356:- meta_predicate at_halt(0). 4357:- dynamic        system:term_expansion/2, '$at_halt'/2. 4358:- multifile      system:term_expansion/2, '$at_halt'/2. 4359
 4360system:term_expansion((:- at_halt(Goal)),
 4361		      system:'$at_halt'(Module:Goal, File:Line)) :-
 4362    \+ current_prolog_flag(xref, true),
 4363    source_location(File, Line),
 4364    '$current_source_module'(Module).
 4365
 4366at_halt(Goal) :-
 4367    asserta('$at_halt'(Goal, (-):0)).
 4368
 4369:- public '$run_at_halt'/0. 4370
 4371'$run_at_halt' :-
 4372    forall(clause('$at_halt'(Goal, Src), true, Ref),
 4373	   ( '$call_at_halt'(Goal, Src),
 4374	     erase(Ref)
 4375	   )).
 4376
 4377'$call_at_halt'(Goal, _Src) :-
 4378    catch(Goal, E, true),
 4379    !,
 4380    (   var(E)
 4381    ->  true
 4382    ;   subsumes_term(cancel_halt(_), E)
 4383    ->  '$print_message'(informational, E),
 4384	fail
 4385    ;   '$print_message'(error, E)
 4386    ).
 4387'$call_at_halt'(Goal, _Src) :-
 4388    '$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.
 4396cancel_halt(Reason) :-
 4397    throw(cancel_halt(Reason)).
 prolog:heartbeat
Called every N inferences of the Prolog flag heartbeat is non-zero.
 4404:- multifile prolog:heartbeat/0. 4405
 4406
 4407		/********************************
 4408		*      LOAD OTHER MODULES       *
 4409		*********************************/
 4410
 4411:- meta_predicate
 4412    '$load_wic_files'(:). 4413
 4414'$load_wic_files'(Files) :-
 4415    Files = Module:_,
 4416    '$execute_directive'('$set_source_module'(OldM, Module), [], []),
 4417    '$save_lex_state'(LexState, []),
 4418    '$style_check'(_, 0xC7),                % see style_name/2 in syspred.pl
 4419    '$compilation_mode'(OldC, wic),
 4420    consult(Files),
 4421    '$execute_directive'('$set_source_module'(OldM), [], []),
 4422    '$execute_directive'('$restore_lex_state'(LexState), [], []),
 4423    '$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.
 4431:- public '$load_additional_boot_files'/0. 4432
 4433'$load_additional_boot_files' :-
 4434    current_prolog_flag(argv, Argv),
 4435    '$get_files_argv'(Argv, Files),
 4436    (   Files \== []
 4437    ->  format('Loading additional boot files~n'),
 4438	'$load_wic_files'(user:Files),
 4439	format('additional boot files loaded~n')
 4440    ;   true
 4441    ).
 4442
 4443'$get_files_argv'([], []) :- !.
 4444'$get_files_argv'(['-c'|Files], Files) :- !.
 4445'$get_files_argv'([_|Rest], Files) :-
 4446    '$get_files_argv'(Rest, Files).
 4447
 4448'$:-'(('$boot_message'('Loading Prolog startup files~n', []),
 4449       source_location(File, _Line),
 4450       file_directory_name(File, Dir),
 4451       atom_concat(Dir, '/load.pl', LoadFile),
 4452       '$load_wic_files'(system:[LoadFile]),
 4453       (   current_prolog_flag(windows, true)
 4454       ->  atom_concat(Dir, '/menu.pl', MenuFile),
 4455	   '$load_wic_files'(system:[MenuFile])
 4456       ;   true
 4457       ),
 4458       '$boot_message'('SWI-Prolog boot files loaded~n', []),
 4459       '$compilation_mode'(OldC, wic),
 4460       '$execute_directive'('$set_source_module'(user), [], []),
 4461       '$set_compilation_mode'(OldC)
 4462      ))