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-2023, 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	      setup_call_cleanup/3,
  355	      setup_call_catcher_cleanup/4,
  356	      notrace/1)).  357
  358:- meta_predicate
  359    ';'(0,0),
  360    ','(0,0),
  361    @(0,+),
  362    call(0),
  363    call(1,?),
  364    call(2,?,?),
  365    call(3,?,?,?),
  366    call(4,?,?,?,?),
  367    call(5,?,?,?,?,?),
  368    call(6,?,?,?,?,?,?),
  369    call(7,?,?,?,?,?,?,?),
  370    not(0),
  371    \+(0),
  372    $(0),
  373    '->'(0,0),
  374    '*->'(0,0),
  375    once(0),
  376    ignore(0),
  377    catch(0,?,0),
  378    reset(0,?,-),
  379    setup_call_cleanup(0,0,0),
  380    setup_call_catcher_cleanup(0,0,?,0),
  381    call_cleanup(0,0),
  382    catch_with_backtrace(0,?,0),
  383    notrace(0),
  384    '$meta_call'(0).  385
  386:- '$iso'((call/1, (\+)/1, once/1, (;)/2, (',')/2, (->)/2, catch/3)).  387
  388% The control structures are always compiled, both   if they appear in a
  389% clause body and if they are handed  to   call/1.  The only way to call
  390% these predicates is by means of  call/2..   In  that case, we call the
  391% hole control structure again to get it compiled by call/1 and properly
  392% deal  with  !,  etc.  Another  reason  for  having  these  things   as
  393% predicates is to be able to define   properties for them, helping code
  394% analyzers.
  395
  396(M0:If ; M0:Then) :- !, call(M0:(If ; Then)).
  397(M1:If ; M2:Then) :-    call(M1:(If ; M2:Then)).
  398(G1   , G2)       :-    call((G1   , G2)).
  399(If  -> Then)     :-    call((If  -> Then)).
  400(If *-> Then)     :-    call((If *-> Then)).
  401@(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.

  415'$meta_call'(M:G) :-
  416    prolog_current_choice(Ch),
  417    '$meta_call'(G, M, Ch).
  418
  419'$meta_call'(Var, _, _) :-
  420    var(Var),
  421    !,
  422    '$instantiation_error'(Var).
  423'$meta_call'((A,B), M, Ch) :-
  424    !,
  425    '$meta_call'(A, M, Ch),
  426    '$meta_call'(B, M, Ch).
  427'$meta_call'((I->T;E), M, Ch) :-
  428    !,
  429    (   prolog_current_choice(Ch2),
  430	'$meta_call'(I, M, Ch2)
  431    ->  '$meta_call'(T, M, Ch)
  432    ;   '$meta_call'(E, M, Ch)
  433    ).
  434'$meta_call'((I*->T;E), M, Ch) :-
  435    !,
  436    (   prolog_current_choice(Ch2),
  437	'$meta_call'(I, M, Ch2)
  438    *-> '$meta_call'(T, M, Ch)
  439    ;   '$meta_call'(E, M, Ch)
  440    ).
  441'$meta_call'((I->T), M, Ch) :-
  442    !,
  443    (   prolog_current_choice(Ch2),
  444	'$meta_call'(I, M, Ch2)
  445    ->  '$meta_call'(T, M, Ch)
  446    ).
  447'$meta_call'((I*->T), M, Ch) :-
  448    !,
  449    prolog_current_choice(Ch2),
  450    '$meta_call'(I, M, Ch2),
  451    '$meta_call'(T, M, Ch).
  452'$meta_call'((A;B), M, Ch) :-
  453    !,
  454    (   '$meta_call'(A, M, Ch)
  455    ;   '$meta_call'(B, M, Ch)
  456    ).
  457'$meta_call'(\+(G), M, _) :-
  458    !,
  459    prolog_current_choice(Ch),
  460    \+ '$meta_call'(G, M, Ch).
  461'$meta_call'($(G), M, _) :-
  462    !,
  463    prolog_current_choice(Ch),
  464    $('$meta_call'(G, M, Ch)).
  465'$meta_call'(call(G), M, _) :-
  466    !,
  467    prolog_current_choice(Ch),
  468    '$meta_call'(G, M, Ch).
  469'$meta_call'(M:G, _, Ch) :-
  470    !,
  471    '$meta_call'(G, M, Ch).
  472'$meta_call'(!, _, Ch) :-
  473    prolog_cut_to(Ch).
  474'$meta_call'(G, M, _Ch) :-
  475    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..
  491:- '$iso'((call/2,
  492	   call/3,
  493	   call/4,
  494	   call/5,
  495	   call/6,
  496	   call/7,
  497	   call/8)).  498
  499call(Goal) :-                           % make these available as predicates
  500    Goal.
  501call(Goal, A) :-
  502    call(Goal, A).
  503call(Goal, A, B) :-
  504    call(Goal, A, B).
  505call(Goal, A, B, C) :-
  506    call(Goal, A, B, C).
  507call(Goal, A, B, C, D) :-
  508    call(Goal, A, B, C, D).
  509call(Goal, A, B, C, D, E) :-
  510    call(Goal, A, B, C, D, E).
  511call(Goal, A, B, C, D, E, F) :-
  512    call(Goal, A, B, C, D, E, F).
  513call(Goal, A, B, C, D, E, F, G) :-
  514    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.
  521not(Goal) :-
  522    \+ Goal.
 \+ :Goal is semidet
Predicate version that allows for meta-calling.
  528\+ Goal :-
  529    \+ Goal.
 once(:Goal) is semidet
ISO predicate, acting as call((Goal, !)).
  535once(Goal) :-
  536    Goal,
  537    !.
 ignore(:Goal) is det
Call Goal, cut choice-points on success and succeed on failure. intended for calling side-effects and proceed on failure.
  544ignore(Goal) :-
  545    Goal,
  546    !.
  547ignore(_Goal).
  548
  549:- '$iso'((false/0)).
 false
Synonym for fail/0, providing a declarative reading.
  555false :-
  556    fail.
 catch(:Goal, +Catcher, :Recover)
ISO compliant exception handling.
  562catch(_Goal, _Catcher, _Recover) :-
  563    '$catch'.                       % Maps to I_CATCH, I_EXITCATCH
 prolog_cut_to(+Choice)
Cut all choice points after Choice
  569prolog_cut_to(_Choice) :-
  570    '$cut'.                         % Maps to I_CUTCHP
 $ is det
Declare that from now on this predicate succeeds deterministically.
  576'$' :- '$'.
 $ :Goal is det
Declare that Goal must succeed deterministically.
  582$(Goal) :- $(Goal).
 notrace(:Goal) is semidet
Suspend the tracer while running Goal.
  588:- '$hide'(notrace/1).  589
  590notrace(Goal) :-
  591    setup_call_cleanup(
  592	'$notrace'(Flags, SkipLevel),
  593	once(Goal),
  594	'$restore_trace'(Flags, SkipLevel)).
 reset(:Goal, ?Ball, -Continue)
Delimited continuation support.
  601reset(_Goal, _Ball, _Cont) :-
  602    '$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.
  611shift(Ball) :-
  612    '$shift'(Ball).
  613
  614shift_for_copy(Ball) :-
  615    '$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.

  629call_continuation([]).
  630call_continuation([TB|Rest]) :-
  631    (   Rest == []
  632    ->  '$call_continuation'(TB)
  633    ;   '$call_continuation'(TB),
  634	call_continuation(Rest)
  635    ).
 catch_with_backtrace(:Goal, ?Ball, :Recover)
As catch/3, but tell library(prolog_stack) to record a backtrace in case of an exception.
  642catch_with_backtrace(Goal, Ball, Recover) :-
  643    catch(Goal, Ball, Recover),
  644    '$no_lco'.
  645
  646'$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.
  656:- public '$recover_and_rethrow'/2.  657
  658'$recover_and_rethrow'(Goal, Exception) :-
  659    call_cleanup(Goal, throw(Exception)),
  660    !.
 call_cleanup(:Goal, :Cleanup)
 setup_call_cleanup(:Setup, :Goal, :Cleanup)
 setup_call_catcher_cleanup(:Setup, :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, I_EXITCLEANUP. These instructions rely on the exact stack layout left by these predicates, where the variant is determined by the arity. See also callCleanupHandler() in pl-wam.c.
  674setup_call_catcher_cleanup(Setup, _Goal, _Catcher, _Cleanup) :-
  675    sig_atomic(Setup),
  676    '$call_cleanup'.
  677
  678setup_call_cleanup(Setup, _Goal, _Cleanup) :-
  679    sig_atomic(Setup),
  680    '$call_cleanup'.
  681
  682call_cleanup(_Goal, _Cleanup) :-
  683    '$call_cleanup'.
  684
  685
  686		 /*******************************
  687		 *       INITIALIZATION         *
  688		 *******************************/
  689
  690:- meta_predicate
  691    initialization(0, +).  692
  693:- multifile '$init_goal'/3.  694:- 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.

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

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

 2017'$record_included'([Parent|Parents], File, Path, Time,
 2018		   message(DoneMsgLevel,
 2019			   include_file(done(Level, file(File, Path))))) :-
 2020    source_location(SrcFile, Line),
 2021    !,
 2022    '$compilation_level'(Level),
 2023    '$load_msg_level'(include_file, Level, StartMsgLevel, DoneMsgLevel),
 2024    '$print_message'(StartMsgLevel,
 2025		     include_file(start(Level,
 2026					file(File, Path)))),
 2027    '$last'([Parent|Parents], Owner),
 2028    (   (   '$compilation_mode'(database)
 2029	;   '$qlf_current_source'(Owner)
 2030	)
 2031    ->  '$store_admin_clause'(
 2032	    system:'$included'(Parent, Line, Path, Time),
 2033	    _, Owner, SrcFile:Line)
 2034    ;   '$qlf_include'(Owner, Parent, Line, Path, Time)
 2035    ).
 2036'$record_included'(_, _, _, _, true).
 $master_file(+File, -MasterFile)
Find the primary load file from included files.
 2042'$master_file'(File, MasterFile) :-
 2043    '$included'(MasterFile0, _Line, File, _Time),
 2044    !,
 2045    '$master_file'(MasterFile0, MasterFile).
 2046'$master_file'(File, File).
 2047
 2048
 2049'$skip_script_line'(_In, Options) :-
 2050    '$option'(check_script(false), Options),
 2051    !.
 2052'$skip_script_line'(In, _Options) :-
 2053    (   peek_char(In, #)
 2054    ->  skip(In, 10)
 2055    ;   true
 2056    ).
 2057
 2058'$set_encoding'(Stream, Options) :-
 2059    '$option'(encoding(Enc), Options),
 2060    !,
 2061    Enc \== default,
 2062    set_stream(Stream, encoding(Enc)).
 2063'$set_encoding'(_, _).
 2064
 2065
 2066'$prepare_load_stream'(In, Id, state(HasName,HasPos)) :-
 2067    (   stream_property(In, file_name(_))
 2068    ->  HasName = true,
 2069	(   stream_property(In, position(_))
 2070	->  HasPos = true
 2071	;   HasPos = false,
 2072	    set_stream(In, record_position(true))
 2073	)
 2074    ;   HasName = false,
 2075	set_stream(In, file_name(Id)),
 2076	(   stream_property(In, position(_))
 2077	->  HasPos = true
 2078	;   HasPos = false,
 2079	    set_stream(In, record_position(true))
 2080	)
 2081    ).
 2082
 2083'$restore_load_stream'(In, _State, Options) :-
 2084    memberchk(close(true), Options),
 2085    !,
 2086    close(In).
 2087'$restore_load_stream'(In, state(HasName, HasPos), _Options) :-
 2088    (   HasName == false
 2089    ->  set_stream(In, file_name(''))
 2090    ;   true
 2091    ),
 2092    (   HasPos == false
 2093    ->  set_stream(In, record_position(false))
 2094    ;   true
 2095    ).
 2096
 2097
 2098		 /*******************************
 2099		 *          DERIVED FILES       *
 2100		 *******************************/
 2101
 2102:- dynamic
 2103    '$derived_source_db'/3.         % Loaded, DerivedFrom, Time
 2104
 2105'$register_derived_source'(_, '-') :- !.
 2106'$register_derived_source'(Loaded, DerivedFrom) :-
 2107    retractall('$derived_source_db'(Loaded, _, _)),
 2108    time_file(DerivedFrom, Time),
 2109    assert('$derived_source_db'(Loaded, DerivedFrom, Time)).
 2110
 2111%       Auto-importing dynamic predicates is not very elegant and
 2112%       leads to problems with qsave_program/[1,2]
 2113
 2114'$derived_source'(Loaded, DerivedFrom, Time) :-
 2115    '$derived_source_db'(Loaded, DerivedFrom, Time).
 2116
 2117
 2118		/********************************
 2119		*       LOAD PREDICATES         *
 2120		*********************************/
 2121
 2122:- meta_predicate
 2123    ensure_loaded(:),
 2124    [:|+],
 2125    consult(:),
 2126    use_module(:),
 2127    use_module(:, +),
 2128    reexport(:),
 2129    reexport(:, +),
 2130    load_files(:),
 2131    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.
 2139ensure_loaded(Files) :-
 2140    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.
 2149use_module(Files) :-
 2150    load_files(Files, [ if(not_loaded),
 2151			must_be_module(true)
 2152		      ]).
 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.
 2159use_module(File, Import) :-
 2160    load_files(File, [ if(not_loaded),
 2161		       must_be_module(true),
 2162		       imports(Import)
 2163		     ]).
 reexport(+Files)
As use_module/1, exporting all imported predicates.
 2169reexport(Files) :-
 2170    load_files(Files, [ if(not_loaded),
 2171			must_be_module(true),
 2172			reexport(true)
 2173		      ]).
 reexport(+File, +ImportList)
As use_module/1, re-exporting all imported predicates.
 2179reexport(File, Import) :-
 2180    load_files(File, [ if(not_loaded),
 2181		       must_be_module(true),
 2182		       imports(Import),
 2183		       reexport(true)
 2184		     ]).
 2185
 2186
 2187[X] :-
 2188    !,
 2189    consult(X).
 2190[M:F|R] :-
 2191    consult(M:[F|R]).
 2192
 2193consult(M:X) :-
 2194    X == user,
 2195    !,
 2196    flag('$user_consult', N, N+1),
 2197    NN is N + 1,
 2198    atom_concat('user://', NN, Id),
 2199    load_files(M:Id, [stream(user_input), check_script(false), silent(false)]).
 2200consult(List) :-
 2201    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.
 2208load_files(Files) :-
 2209    load_files(Files, []).
 2210load_files(Module:Files, Options) :-
 2211    '$must_be'(list, Options),
 2212    '$load_files'(Files, Module, Options).
 2213
 2214'$load_files'(X, _, _) :-
 2215    var(X),
 2216    !,
 2217    '$instantiation_error'(X).
 2218'$load_files'([], _, _) :- !.
 2219'$load_files'(Id, Module, Options) :-   % load_files(foo, [stream(In)])
 2220    '$option'(stream(_), Options),
 2221    !,
 2222    (   atom(Id)
 2223    ->  '$load_file'(Id, Module, Options)
 2224    ;   throw(error(type_error(atom, Id), _))
 2225    ).
 2226'$load_files'(List, Module, Options) :-
 2227    List = [_|_],
 2228    !,
 2229    '$must_be'(list, List),
 2230    '$load_file_list'(List, Module, Options).
 2231'$load_files'(File, Module, Options) :-
 2232    '$load_one_file'(File, Module, Options).
 2233
 2234'$load_file_list'([], _, _).
 2235'$load_file_list'([File|Rest], Module, Options) :-
 2236    E = error(_,_),
 2237    catch('$load_one_file'(File, Module, Options), E,
 2238	  '$print_message'(error, E)),
 2239    '$load_file_list'(Rest, Module, Options).
 2240
 2241
 2242'$load_one_file'(Spec, Module, Options) :-
 2243    atomic(Spec),
 2244    '$option'(expand(Expand), Options, false),
 2245    Expand == true,
 2246    !,
 2247    expand_file_name(Spec, Expanded),
 2248    (   Expanded = [Load]
 2249    ->  true
 2250    ;   Load = Expanded
 2251    ),
 2252    '$load_files'(Load, Module, [expand(false)|Options]).
 2253'$load_one_file'(File, Module, Options) :-
 2254    strip_module(Module:File, Into, PlainFile),
 2255    '$load_file'(PlainFile, Into, Options).
 $noload(+Condition, +FullFile, +Options) is semidet
True of FullFile should not be loaded.
 2262'$noload'(true, _, _) :-
 2263    !,
 2264    fail.
 2265'$noload'(_, FullFile, _Options) :-
 2266    '$time_source_file'(FullFile, Time, system),
 2267    Time > 0.0,
 2268    !.
 2269'$noload'(not_loaded, FullFile, _) :-
 2270    source_file(FullFile),
 2271    !.
 2272'$noload'(changed, Derived, _) :-
 2273    '$derived_source'(_FullFile, Derived, LoadTime),
 2274    time_file(Derived, Modified),
 2275    Modified @=< LoadTime,
 2276    !.
 2277'$noload'(changed, FullFile, Options) :-
 2278    '$time_source_file'(FullFile, LoadTime, user),
 2279    '$modified_id'(FullFile, Modified, Options),
 2280    Modified @=< LoadTime,
 2281    !.
 2282'$noload'(exists, File, Options) :-
 2283    '$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.
 2302'$qlf_file'(Spec, _, Spec, stream, Options) :-
 2303    '$option'(stream(_), Options),      % stream: no choice
 2304    !.
 2305'$qlf_file'(Spec, FullFile, FullFile, compile, _) :-
 2306    '$spec_extension'(Spec, Ext),       % user explicitly specified
 2307    user:prolog_file_type(Ext, prolog),
 2308    !.
 2309'$qlf_file'(Spec, FullFile, LoadFile, Mode, Options) :-
 2310    '$compilation_mode'(database),
 2311    file_name_extension(Base, PlExt, FullFile),
 2312    user:prolog_file_type(PlExt, prolog),
 2313    user:prolog_file_type(QlfExt, qlf),
 2314    file_name_extension(Base, QlfExt, QlfFile),
 2315    (   access_file(QlfFile, read),
 2316	(   '$qlf_out_of_date'(FullFile, QlfFile, Why)
 2317	->  (   access_file(QlfFile, write)
 2318	    ->  print_message(informational,
 2319			      qlf(recompile(Spec, FullFile, QlfFile, Why))),
 2320		Mode = qcompile,
 2321		LoadFile = FullFile
 2322	    ;   Why == old,
 2323		(   current_prolog_flag(home, PlHome),
 2324		    sub_atom(FullFile, 0, _, _, PlHome)
 2325		;   sub_atom(QlfFile, 0, _, _, 'res://')
 2326		)
 2327	    ->  print_message(silent,
 2328			      qlf(system_lib_out_of_date(Spec, QlfFile))),
 2329		Mode = qload,
 2330		LoadFile = QlfFile
 2331	    ;   print_message(warning,
 2332			      qlf(can_not_recompile(Spec, QlfFile, Why))),
 2333		Mode = compile,
 2334		LoadFile = FullFile
 2335	    )
 2336	;   Mode = qload,
 2337	    LoadFile = QlfFile
 2338	)
 2339    ->  !
 2340    ;   '$qlf_auto'(FullFile, QlfFile, Options)
 2341    ->  !, Mode = qcompile,
 2342	LoadFile = FullFile
 2343    ).
 2344'$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.
 2352'$qlf_out_of_date'(PlFile, QlfFile, Why) :-
 2353    (   access_file(PlFile, read)
 2354    ->  time_file(PlFile, PlTime),
 2355	time_file(QlfFile, QlfTime),
 2356	(   PlTime > QlfTime
 2357	->  Why = old                   % PlFile is newer
 2358	;   Error = error(Formal,_),
 2359	    catch('$qlf_info'(QlfFile, _CVer, _MLVer,
 2360			      _FVer, _CSig, _FSig),
 2361		  Error, true),
 2362	    nonvar(Formal)              % QlfFile is incompatible
 2363	->  Why = Error
 2364	;   fail                        % QlfFile is up-to-date and ok
 2365	)
 2366    ;   fail                            % can not read .pl; try .qlf
 2367    ).
 $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.
 2375:- create_prolog_flag(qcompile, false, [type(atom)]). 2376
 2377'$qlf_auto'(PlFile, QlfFile, Options) :-
 2378    (   memberchk(qcompile(QlfMode), Options)
 2379    ->  true
 2380    ;   current_prolog_flag(qcompile, QlfMode),
 2381	\+ '$in_system_dir'(PlFile)
 2382    ),
 2383    (   QlfMode == auto
 2384    ->  true
 2385    ;   QlfMode == large,
 2386	size_file(PlFile, Size),
 2387	Size > 100000
 2388    ),
 2389    access_file(QlfFile, write).
 2390
 2391'$in_system_dir'(PlFile) :-
 2392    current_prolog_flag(home, Home),
 2393    sub_atom(PlFile, 0, _, _, Home).
 2394
 2395'$spec_extension'(File, Ext) :-
 2396    atom(File),
 2397    file_name_extension(_, Ext, File).
 2398'$spec_extension'(Spec, Ext) :-
 2399    compound(Spec),
 2400    arg(1, Spec, Arg),
 2401    '$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:
 2413:- dynamic
 2414    '$resolved_source_path_db'/3.                % ?Spec, ?Dialect, ?Path
 2415
 2416'$load_file'(File, Module, Options) :-
 2417    '$error_count'(E0, W0),
 2418    '$load_file_e'(File, Module, Options),
 2419    '$error_count'(E1, W1),
 2420    Errors is E1-E0,
 2421    Warnings is W1-W0,
 2422    (   Errors+Warnings =:= 0
 2423    ->  true
 2424    ;   '$print_message'(silent, load_file_errors(File, Errors, Warnings))
 2425    ).
 2426
 2427:- if(current_prolog_flag(threads, true)). 2428'$error_count'(Errors, Warnings) :-
 2429    current_prolog_flag(threads, true),
 2430    !,
 2431    thread_self(Me),
 2432    thread_statistics(Me, errors, Errors),
 2433    thread_statistics(Me, warnings, Warnings).
 2434:- endif. 2435'$error_count'(Errors, Warnings) :-
 2436    statistics(errors, Errors),
 2437    statistics(warnings, Warnings).
 2438
 2439'$load_file_e'(File, Module, Options) :-
 2440    \+ memberchk(stream(_), Options),
 2441    user:prolog_load_file(Module:File, Options),
 2442    !.
 2443'$load_file_e'(File, Module, Options) :-
 2444    memberchk(stream(_), Options),
 2445    !,
 2446    '$assert_load_context_module'(File, Module, Options),
 2447    '$qdo_load_file'(File, File, Module, Options).
 2448'$load_file_e'(File, Module, Options) :-
 2449    (   '$resolved_source_path'(File, FullFile, Options)
 2450    ->  true
 2451    ;   '$resolve_source_path'(File, FullFile, Options)
 2452    ),
 2453    !,
 2454    '$mt_load_file'(File, FullFile, Module, Options).
 2455'$load_file_e'(_, _, _).
 $resolved_source_path(+File, -FullFile, +Options) is semidet
True when File has already been resolved to an absolute path.
 2461'$resolved_source_path'(File, FullFile, Options) :-
 2462    current_prolog_flag(emulated_dialect, Dialect),
 2463    '$resolved_source_path_db'(File, Dialect, FullFile),
 2464    (   '$source_file_property'(FullFile, from_state, true)
 2465    ;   '$source_file_property'(FullFile, resource, true)
 2466    ;   '$option'(if(If), Options, true),
 2467	'$noload'(If, FullFile, Options)
 2468    ),
 2469    !.
 $resolve_source_path(+File, -FullFile, +Options) is semidet
Resolve a source file specification to an absolute path. May throw existence and other errors.
 2476'$resolve_source_path'(File, FullFile, Options) :-
 2477    (   '$option'(if(If), Options),
 2478	If == exists
 2479    ->  Extra = [file_errors(fail)]
 2480    ;   Extra = []
 2481    ),
 2482    absolute_file_name(File, FullFile,
 2483		       [ file_type(prolog),
 2484			 access(read)
 2485		       | Extra
 2486		       ]),
 2487    '$register_resolved_source_path'(File, FullFile).
 2488
 2489'$register_resolved_source_path'(File, FullFile) :-
 2490    (   compound(File)
 2491    ->  current_prolog_flag(emulated_dialect, Dialect),
 2492	(   '$resolved_source_path_db'(File, Dialect, FullFile)
 2493	->  true
 2494	;   asserta('$resolved_source_path_db'(File, Dialect, FullFile))
 2495	)
 2496    ;   true
 2497    ).
 $translated_source(+Old, +New) is det
Called from loading a QLF state when source files are being renamed.
 2503:- public '$translated_source'/2. 2504'$translated_source'(Old, New) :-
 2505    forall(retract('$resolved_source_path_db'(File, Dialect, Old)),
 2506	   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.
 2513'$register_resource_file'(FullFile) :-
 2514    (   sub_atom(FullFile, 0, _, _, 'res://'),
 2515	\+ file_name_extension(_, qlf, FullFile)
 2516    ->  '$set_source_file'(FullFile, resource, true)
 2517    ;   true
 2518    ).
 $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.
 2531'$already_loaded'(_File, FullFile, Module, Options) :-
 2532    '$assert_load_context_module'(FullFile, Module, Options),
 2533    '$current_module'(LoadModules, FullFile),
 2534    !,
 2535    (   atom(LoadModules)
 2536    ->  LoadModule = LoadModules
 2537    ;   LoadModules = [LoadModule|_]
 2538    ),
 2539    '$import_from_loaded_module'(LoadModule, Module, Options).
 2540'$already_loaded'(_, _, user, _) :- !.
 2541'$already_loaded'(File, FullFile, Module, Options) :-
 2542    (   '$load_context_module'(FullFile, Module, CtxOptions),
 2543	'$load_ctx_options'(Options, CtxOptions)
 2544    ->  true
 2545    ;   '$load_file'(File, Module, [if(true)|Options])
 2546    ).
 $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.

 2561:- dynamic
 2562    '$loading_file'/3.              % File, Queue, Thread
 2563:- volatile
 2564    '$loading_file'/3. 2565
 2566:- if(current_prolog_flag(threads, true)). 2567'$mt_load_file'(File, FullFile, Module, Options) :-
 2568    current_prolog_flag(threads, true),
 2569    !,
 2570    sig_atomic(setup_call_cleanup(
 2571		   with_mutex('$load_file',
 2572			      '$mt_start_load'(FullFile, Loading, Options)),
 2573		   '$mt_do_load'(Loading, File, FullFile, Module, Options),
 2574		   '$mt_end_load'(Loading))).
 2575:- endif. 2576'$mt_load_file'(File, FullFile, Module, Options) :-
 2577    '$option'(if(If), Options, true),
 2578    '$noload'(If, FullFile, Options),
 2579    !,
 2580    '$already_loaded'(File, FullFile, Module, Options).
 2581:- if(current_prolog_flag(threads, true)). 2582'$mt_load_file'(File, FullFile, Module, Options) :-
 2583    sig_atomic('$qdo_load_file'(File, FullFile, Module, Options)).
 2584:- else. 2585'$mt_load_file'(File, FullFile, Module, Options) :-
 2586    '$qdo_load_file'(File, FullFile, Module, Options).
 2587:- endif. 2588
 2589:- if(current_prolog_flag(threads, true)). 2590'$mt_start_load'(FullFile, queue(Queue), _) :-
 2591    '$loading_file'(FullFile, Queue, LoadThread),
 2592    \+ thread_self(LoadThread),
 2593    !.
 2594'$mt_start_load'(FullFile, already_loaded, Options) :-
 2595    '$option'(if(If), Options, true),
 2596    '$noload'(If, FullFile, Options),
 2597    !.
 2598'$mt_start_load'(FullFile, Ref, _) :-
 2599    thread_self(Me),
 2600    message_queue_create(Queue),
 2601    assertz('$loading_file'(FullFile, Queue, Me), Ref).
 2602
 2603'$mt_do_load'(queue(Queue), File, FullFile, Module, Options) :-
 2604    !,
 2605    catch(thread_get_message(Queue, _), error(_,_), true),
 2606    '$already_loaded'(File, FullFile, Module, Options).
 2607'$mt_do_load'(already_loaded, File, FullFile, Module, Options) :-
 2608    !,
 2609    '$already_loaded'(File, FullFile, Module, Options).
 2610'$mt_do_load'(_Ref, File, FullFile, Module, Options) :-
 2611    '$assert_load_context_module'(FullFile, Module, Options),
 2612    '$qdo_load_file'(File, FullFile, Module, Options).
 2613
 2614'$mt_end_load'(queue(_)) :- !.
 2615'$mt_end_load'(already_loaded) :- !.
 2616'$mt_end_load'(Ref) :-
 2617    clause('$loading_file'(_, Queue, _), _, Ref),
 2618    erase(Ref),
 2619    thread_send_message(Queue, done),
 2620    message_queue_destroy(Queue).
 2621:- endif.
 $qdo_load_file(+Spec, +FullFile, +ContextModule, +Options) is det
Switch to qcompile mode if requested by the option '$qlf'(+Out)
 2627'$qdo_load_file'(File, FullFile, Module, Options) :-
 2628    '$qdo_load_file2'(File, FullFile, Module, Action, Options),
 2629    '$register_resource_file'(FullFile),
 2630    '$run_initialization'(FullFile, Action, Options).
 2631
 2632'$qdo_load_file2'(File, FullFile, Module, Action, Options) :-
 2633    memberchk('$qlf'(QlfOut), Options),
 2634    '$stage_file'(QlfOut, StageQlf),
 2635    !,
 2636    setup_call_catcher_cleanup(
 2637	'$qstart'(StageQlf, Module, State),
 2638	'$do_load_file'(File, FullFile, Module, Action, Options),
 2639	Catcher,
 2640	'$qend'(State, Catcher, StageQlf, QlfOut)).
 2641'$qdo_load_file2'(File, FullFile, Module, Action, Options) :-
 2642    '$do_load_file'(File, FullFile, Module, Action, Options).
 2643
 2644'$qstart'(Qlf, Module, state(OldMode, OldModule)) :-
 2645    '$qlf_open'(Qlf),
 2646    '$compilation_mode'(OldMode, qlf),
 2647    '$set_source_module'(OldModule, Module).
 2648
 2649'$qend'(state(OldMode, OldModule), Catcher, StageQlf, QlfOut) :-
 2650    '$set_source_module'(_, OldModule),
 2651    '$set_compilation_mode'(OldMode),
 2652    '$qlf_close',
 2653    '$install_staged_file'(Catcher, StageQlf, QlfOut, warn).
 2654
 2655'$set_source_module'(OldModule, Module) :-
 2656    '$current_source_module'(OldModule),
 2657    '$set_source_module'(Module).
 $do_load_file(+Spec, +FullFile, +ContextModule, -Action, +Options) is det
Perform the actual loading.
 2664'$do_load_file'(File, FullFile, Module, Action, Options) :-
 2665    '$option'(derived_from(DerivedFrom), Options, -),
 2666    '$register_derived_source'(FullFile, DerivedFrom),
 2667    '$qlf_file'(File, FullFile, Absolute, Mode, Options),
 2668    (   Mode == qcompile
 2669    ->  qcompile(Module:File, Options)
 2670    ;   '$do_load_file_2'(File, Absolute, Module, Action, Options)
 2671    ).
 2672
 2673'$do_load_file_2'(File, Absolute, Module, Action, Options) :-
 2674    '$source_file_property'(Absolute, number_of_clauses, OldClauses),
 2675    statistics(cputime, OldTime),
 2676
 2677    '$setup_load'(ScopedFlags, OldSandBoxed, OldVerbose, OldAutoLevel, OldXRef,
 2678		  Options),
 2679
 2680    '$compilation_level'(Level),
 2681    '$load_msg_level'(load_file, Level, StartMsgLevel, DoneMsgLevel),
 2682    '$print_message'(StartMsgLevel,
 2683		     load_file(start(Level,
 2684				     file(File, Absolute)))),
 2685
 2686    (   memberchk(stream(FromStream), Options)
 2687    ->  Input = stream
 2688    ;   Input = source
 2689    ),
 2690
 2691    (   Input == stream,
 2692	(   '$option'(format(qlf), Options, source)
 2693	->  set_stream(FromStream, file_name(Absolute)),
 2694	    '$qload_stream'(FromStream, Module, Action, LM, Options)
 2695	;   '$consult_file'(stream(Absolute, FromStream, []),
 2696			    Module, Action, LM, Options)
 2697	)
 2698    ->  true
 2699    ;   Input == source,
 2700	file_name_extension(_, Ext, Absolute),
 2701	(   user:prolog_file_type(Ext, qlf),
 2702	    E = error(_,_),
 2703	    catch('$qload_file'(Absolute, Module, Action, LM, Options),
 2704		  E,
 2705		  print_message(warning, E))
 2706	->  true
 2707	;   '$consult_file'(Absolute, Module, Action, LM, Options)
 2708	)
 2709    ->  true
 2710    ;   '$print_message'(error, load_file(failed(File))),
 2711	fail
 2712    ),
 2713
 2714    '$import_from_loaded_module'(LM, Module, Options),
 2715
 2716    '$source_file_property'(Absolute, number_of_clauses, NewClauses),
 2717    statistics(cputime, Time),
 2718    ClausesCreated is NewClauses - OldClauses,
 2719    TimeUsed is Time - OldTime,
 2720
 2721    '$print_message'(DoneMsgLevel,
 2722		     load_file(done(Level,
 2723				    file(File, Absolute),
 2724				    Action,
 2725				    LM,
 2726				    TimeUsed,
 2727				    ClausesCreated))),
 2728
 2729    '$restore_load'(ScopedFlags, OldSandBoxed, OldVerbose, OldAutoLevel, OldXRef).
 2730
 2731'$setup_load'(ScopedFlags, OldSandBoxed, OldVerbose, OldAutoLevel, OldXRef,
 2732	      Options) :-
 2733    '$save_file_scoped_flags'(ScopedFlags),
 2734    '$set_sandboxed_load'(Options, OldSandBoxed),
 2735    '$set_verbose_load'(Options, OldVerbose),
 2736    '$set_optimise_load'(Options),
 2737    '$update_autoload_level'(Options, OldAutoLevel),
 2738    '$set_no_xref'(OldXRef).
 2739
 2740'$restore_load'(ScopedFlags, OldSandBoxed, OldVerbose, OldAutoLevel, OldXRef) :-
 2741    '$set_autoload_level'(OldAutoLevel),
 2742    set_prolog_flag(xref, OldXRef),
 2743    set_prolog_flag(verbose_load, OldVerbose),
 2744    set_prolog_flag(sandboxed_load, OldSandBoxed),
 2745    '$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.
 2753'$save_file_scoped_flags'(State) :-
 2754    current_predicate(findall/3),          % Not when doing boot compile
 2755    !,
 2756    findall(SavedFlag, '$save_file_scoped_flag'(SavedFlag), State).
 2757'$save_file_scoped_flags'([]).
 2758
 2759'$save_file_scoped_flag'(Flag-Value) :-
 2760    '$file_scoped_flag'(Flag, Default),
 2761    (   current_prolog_flag(Flag, Value)
 2762    ->  true
 2763    ;   Value = Default
 2764    ).
 2765
 2766'$file_scoped_flag'(generate_debug_info, true).
 2767'$file_scoped_flag'(optimise,            false).
 2768'$file_scoped_flag'(xref,                false).
 2769
 2770'$restore_file_scoped_flags'([]).
 2771'$restore_file_scoped_flags'([Flag-Value|T]) :-
 2772    set_prolog_flag(Flag, Value),
 2773    '$restore_file_scoped_flags'(T).
 $import_from_loaded_module(+LoadedModule, +Module, +Options) is det
Import public predicates from LoadedModule into Module
 2780'$import_from_loaded_module'(LoadedModule, Module, Options) :-
 2781    LoadedModule \== Module,
 2782    atom(LoadedModule),
 2783    !,
 2784    '$option'(imports(Import), Options, all),
 2785    '$option'(reexport(Reexport), Options, false),
 2786    '$import_list'(Module, LoadedModule, Import, Reexport).
 2787'$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.
 2795'$set_verbose_load'(Options, Old) :-
 2796    current_prolog_flag(verbose_load, Old),
 2797    (   memberchk(silent(Silent), Options)
 2798    ->  (   '$negate'(Silent, Level0)
 2799	->  '$load_msg_compat'(Level0, Level)
 2800	;   Level = Silent
 2801	),
 2802	set_prolog_flag(verbose_load, Level)
 2803    ;   true
 2804    ).
 2805
 2806'$negate'(true, false).
 2807'$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, -)
 2816'$set_sandboxed_load'(Options, Old) :-
 2817    current_prolog_flag(sandboxed_load, Old),
 2818    (   memberchk(sandboxed(SandBoxed), Options),
 2819	'$enter_sandboxed'(Old, SandBoxed, New),
 2820	New \== Old
 2821    ->  set_prolog_flag(sandboxed_load, New)
 2822    ;   true
 2823    ).
 2824
 2825'$enter_sandboxed'(Old, New, SandBoxed) :-
 2826    (   Old == false, New == true
 2827    ->  SandBoxed = true,
 2828	'$ensure_loaded_library_sandbox'
 2829    ;   Old == true, New == false
 2830    ->  throw(error(permission_error(leave, sandbox, -), _))
 2831    ;   SandBoxed = Old
 2832    ).
 2833'$enter_sandboxed'(false, true, true).
 2834
 2835'$ensure_loaded_library_sandbox' :-
 2836    source_file_property(library(sandbox), module(sandbox)),
 2837    !.
 2838'$ensure_loaded_library_sandbox' :-
 2839    load_files(library(sandbox), [if(not_loaded), silent(true)]).
 2840
 2841'$set_optimise_load'(Options) :-
 2842    (   '$option'(optimise(Optimise), Options)
 2843    ->  set_prolog_flag(optimise, Optimise)
 2844    ;   true
 2845    ).
 2846
 2847'$set_no_xref'(OldXRef) :-
 2848    (   current_prolog_flag(xref, OldXRef)
 2849    ->  true
 2850    ;   OldXRef = false
 2851    ),
 2852    set_prolog_flag(xref, false).
 $update_autoload_level(+Options, -OldLevel)
Update the '$autoload_nesting' and return the old value.
 2859:- thread_local
 2860    '$autoload_nesting'/1. 2861
 2862'$update_autoload_level'(Options, AutoLevel) :-
 2863    '$option'(autoload(Autoload), Options, false),
 2864    (   '$autoload_nesting'(CurrentLevel)
 2865    ->  AutoLevel = CurrentLevel
 2866    ;   AutoLevel = 0
 2867    ),
 2868    (   Autoload == false
 2869    ->  true
 2870    ;   NewLevel is AutoLevel + 1,
 2871	'$set_autoload_level'(NewLevel)
 2872    ).
 2873
 2874'$set_autoload_level'(New) :-
 2875    retractall('$autoload_nesting'(_)),
 2876    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.
 2884'$print_message'(Level, Term) :-
 2885    current_predicate(system:print_message/2),
 2886    !,
 2887    print_message(Level, Term).
 2888'$print_message'(warning, Term) :-
 2889    source_location(File, Line),
 2890    !,
 2891    format(user_error, 'WARNING: ~w:~w: ~p~n', [File, Line, Term]).
 2892'$print_message'(error, Term) :-
 2893    !,
 2894    source_location(File, Line),
 2895    !,
 2896    format(user_error, 'ERROR: ~w:~w: ~p~n', [File, Line, Term]).
 2897'$print_message'(_Level, _Term).
 2898
 2899'$print_message_fail'(E) :-
 2900    '$print_message'(error, E),
 2901    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.
 2909'$consult_file'(Absolute, Module, What, LM, Options) :-
 2910    '$current_source_module'(Module),   % same module
 2911    !,
 2912    '$consult_file_2'(Absolute, Module, What, LM, Options).
 2913'$consult_file'(Absolute, Module, What, LM, Options) :-
 2914    '$set_source_module'(OldModule, Module),
 2915    '$ifcompiling'('$qlf_start_sub_module'(Module)),
 2916    '$consult_file_2'(Absolute, Module, What, LM, Options),
 2917    '$ifcompiling'('$qlf_end_part'),
 2918    '$set_source_module'(OldModule).
 2919
 2920'$consult_file_2'(Absolute, Module, What, LM, Options) :-
 2921    '$set_source_module'(OldModule, Module),
 2922    '$load_id'(Absolute, Id, Modified, Options),
 2923    '$compile_type'(What),
 2924    '$save_lex_state'(LexState, Options),
 2925    '$set_dialect'(Options),
 2926    setup_call_cleanup(
 2927	'$start_consult'(Id, Modified),
 2928	'$load_file'(Absolute, Id, LM, Options),
 2929	'$end_consult'(Id, LexState, OldModule)).
 2930
 2931'$end_consult'(Id, LexState, OldModule) :-
 2932    '$end_consult'(Id),
 2933    '$restore_lex_state'(LexState),
 2934    '$set_source_module'(OldModule).
 2935
 2936
 2937:- create_prolog_flag(emulated_dialect, swi, [type(atom)]).
 $save_lex_state(-LexState, +Options) is det
 2941'$save_lex_state'(State, Options) :-
 2942    memberchk(scope_settings(false), Options),
 2943    !,
 2944    State = (-).
 2945'$save_lex_state'(lexstate(Style, Dialect), _) :-
 2946    '$style_check'(Style, Style),
 2947    current_prolog_flag(emulated_dialect, Dialect).
 2948
 2949'$restore_lex_state'(-) :- !.
 2950'$restore_lex_state'(lexstate(Style, Dialect)) :-
 2951    '$style_check'(_, Style),
 2952    set_prolog_flag(emulated_dialect, Dialect).
 2953
 2954'$set_dialect'(Options) :-
 2955    memberchk(dialect(Dialect), Options),
 2956    !,
 2957    '$expects_dialect'(Dialect).
 2958'$set_dialect'(_).
 2959
 2960'$load_id'(stream(Id, _, _), Id, Modified, Options) :-
 2961    !,
 2962    '$modified_id'(Id, Modified, Options).
 2963'$load_id'(Id, Id, Modified, Options) :-
 2964    '$modified_id'(Id, Modified, Options).
 2965
 2966'$modified_id'(_, Modified, Options) :-
 2967    '$option'(modified(Stamp), Options, Def),
 2968    Stamp \== Def,
 2969    !,
 2970    Modified = Stamp.
 2971'$modified_id'(Id, Modified, _) :-
 2972    catch(time_file(Id, Modified),
 2973	  error(_, _),
 2974	  fail),
 2975    !.
 2976'$modified_id'(_, 0.0, _).
 2977
 2978
 2979'$compile_type'(What) :-
 2980    '$compilation_mode'(How),
 2981    (   How == database
 2982    ->  What = compiled
 2983    ;   How == qlf
 2984    ->  What = '*qcompiled*'
 2985    ;   What = 'boot compiled'
 2986    ).
 $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.
 2996:- dynamic
 2997    '$load_context_module'/3. 2998:- multifile
 2999    '$load_context_module'/3. 3000
 3001'$assert_load_context_module'(_, _, Options) :-
 3002    memberchk(register(false), Options),
 3003    !.
 3004'$assert_load_context_module'(File, Module, Options) :-
 3005    source_location(FromFile, Line),
 3006    !,
 3007    '$master_file'(FromFile, MasterFile),
 3008    '$check_load_non_module'(File, Module),
 3009    '$add_dialect'(Options, Options1),
 3010    '$load_ctx_options'(Options1, Options2),
 3011    '$store_admin_clause'(
 3012	system:'$load_context_module'(File, Module, Options2),
 3013	_Layout, MasterFile, FromFile:Line).
 3014'$assert_load_context_module'(File, Module, Options) :-
 3015    '$check_load_non_module'(File, Module),
 3016    '$add_dialect'(Options, Options1),
 3017    '$load_ctx_options'(Options1, Options2),
 3018    (   clause('$load_context_module'(File, Module, _), true, Ref),
 3019	\+ clause_property(Ref, file(_)),
 3020	erase(Ref)
 3021    ->  true
 3022    ;   true
 3023    ),
 3024    assertz('$load_context_module'(File, Module, Options2)).
 3025
 3026'$add_dialect'(Options0, Options) :-
 3027    current_prolog_flag(emulated_dialect, Dialect), Dialect \== swi,
 3028    !,
 3029    Options = [dialect(Dialect)|Options0].
 3030'$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.
 3037'$load_ctx_options'(Options, CtxOptions) :-
 3038    '$load_ctx_options2'(Options, CtxOptions0),
 3039    sort(CtxOptions0, CtxOptions).
 3040
 3041'$load_ctx_options2'([], []).
 3042'$load_ctx_options2'([H|T0], [H|T]) :-
 3043    '$load_ctx_option'(H),
 3044    !,
 3045    '$load_ctx_options2'(T0, T).
 3046'$load_ctx_options2'([_|T0], T) :-
 3047    '$load_ctx_options2'(T0, T).
 3048
 3049'$load_ctx_option'(derived_from(_)).
 3050'$load_ctx_option'(dialect(_)).
 3051'$load_ctx_option'(encoding(_)).
 3052'$load_ctx_option'(imports(_)).
 3053'$load_ctx_option'(reexport(_)).
 $check_load_non_module(+File) is det
Test that a non-module file is not loaded into multiple contexts.
 3061'$check_load_non_module'(File, _) :-
 3062    '$current_module'(_, File),
 3063    !.          % File is a module file
 3064'$check_load_non_module'(File, Module) :-
 3065    '$load_context_module'(File, OldModule, _),
 3066    Module \== OldModule,
 3067    !,
 3068    format(atom(Msg),
 3069	   'Non-module file already loaded into module ~w; \c
 3070	       trying to load into ~w',
 3071	   [OldModule, Module]),
 3072    throw(error(permission_error(load, source, File),
 3073		context(load_files/2, Msg))).
 3074'$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)

 3087'$load_file'(Path, Id, Module, Options) :-
 3088    State = state(true, _, true, false, Id, -),
 3089    (   '$source_term'(Path, _Read, _Layout, Term, Layout,
 3090		       _Stream, Options),
 3091	'$valid_term'(Term),
 3092	(   arg(1, State, true)
 3093	->  '$first_term'(Term, Layout, Id, State, Options),
 3094	    nb_setarg(1, State, false)
 3095	;   '$compile_term'(Term, Layout, Id, Options)
 3096	),
 3097	arg(4, State, true)
 3098    ;   '$fixup_reconsult'(Id),
 3099	'$end_load_file'(State)
 3100    ),
 3101    !,
 3102    arg(2, State, Module).
 3103
 3104'$valid_term'(Var) :-
 3105    var(Var),
 3106    !,
 3107    print_message(error, error(instantiation_error, _)).
 3108'$valid_term'(Term) :-
 3109    Term \== [].
 3110
 3111'$end_load_file'(State) :-
 3112    arg(1, State, true),           % empty file
 3113    !,
 3114    nb_setarg(2, State, Module),
 3115    arg(5, State, Id),
 3116    '$current_source_module'(Module),
 3117    '$ifcompiling'('$qlf_start_file'(Id)),
 3118    '$ifcompiling'('$qlf_end_part').
 3119'$end_load_file'(State) :-
 3120    arg(3, State, End),
 3121    '$end_load_file'(End, State).
 3122
 3123'$end_load_file'(true, _).
 3124'$end_load_file'(end_module, State) :-
 3125    arg(2, State, Module),
 3126    '$check_export'(Module),
 3127    '$ifcompiling'('$qlf_end_part').
 3128'$end_load_file'(end_non_module, _State) :-
 3129    '$ifcompiling'('$qlf_end_part').
 3130
 3131
 3132'$first_term'(?-(Directive), Layout, Id, State, Options) :-
 3133    !,
 3134    '$first_term'(:-(Directive), Layout, Id, State, Options).
 3135'$first_term'(:-(Directive), _Layout, Id, State, Options) :-
 3136    nonvar(Directive),
 3137    (   (   Directive = module(Name, Public)
 3138	->  Imports = []
 3139	;   Directive = module(Name, Public, Imports)
 3140	)
 3141    ->  !,
 3142	'$module_name'(Name, Id, Module, Options),
 3143	'$start_module'(Module, Public, State, Options),
 3144	'$module3'(Imports)
 3145    ;   Directive = expects_dialect(Dialect)
 3146    ->  !,
 3147	'$set_dialect'(Dialect, State),
 3148	fail                        % Still consider next term as first
 3149    ).
 3150'$first_term'(Term, Layout, Id, State, Options) :-
 3151    '$start_non_module'(Id, Term, State, Options),
 3152    '$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.
 3159'$compile_term'(Term, Layout, SrcId, Options) :-
 3160    '$compile_term'(Term, Layout, SrcId, -, Options).
 3161
 3162'$compile_term'(Var, _Layout, _Id, _SrcLoc, _Options) :-
 3163    var(Var),
 3164    !,
 3165    '$instantiation_error'(Var).
 3166'$compile_term'((?-Directive), _Layout, Id, _SrcLoc, Options) :-
 3167    !,
 3168    '$execute_directive'(Directive, Id, Options).
 3169'$compile_term'((:-Directive), _Layout, Id, _SrcLoc, Options) :-
 3170    !,
 3171    '$execute_directive'(Directive, Id, Options).
 3172'$compile_term'('$source_location'(File, Line):Term,
 3173		Layout, Id, _SrcLoc, Options) :-
 3174    !,
 3175    '$compile_term'(Term, Layout, Id, File:Line, Options).
 3176'$compile_term'(Clause, Layout, Id, SrcLoc, _Options) :-
 3177    E = error(_,_),
 3178    catch('$store_clause'(Clause, Layout, Id, SrcLoc), E,
 3179	  '$print_message'(error, E)).
 3180
 3181'$start_non_module'(_Id, Term, _State, Options) :-
 3182    '$option'(must_be_module(true), Options, false),
 3183    !,
 3184    '$domain_error'(module_header, Term).
 3185'$start_non_module'(Id, _Term, State, _Options) :-
 3186    '$current_source_module'(Module),
 3187    '$ifcompiling'('$qlf_start_file'(Id)),
 3188    '$qset_dialect'(State),
 3189    nb_setarg(2, State, Module),
 3190    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.

 3203'$set_dialect'(Dialect, State) :-
 3204    '$compilation_mode'(qlf, database),
 3205    !,
 3206    '$expects_dialect'(Dialect),
 3207    '$compilation_mode'(_, qlf),
 3208    nb_setarg(6, State, Dialect).
 3209'$set_dialect'(Dialect, _) :-
 3210    '$expects_dialect'(Dialect).
 3211
 3212'$qset_dialect'(State) :-
 3213    '$compilation_mode'(qlf),
 3214    arg(6, State, Dialect), Dialect \== (-),
 3215    !,
 3216    '$add_directive_wic'('$expects_dialect'(Dialect)).
 3217'$qset_dialect'(_).
 3218
 3219'$expects_dialect'(Dialect) :-
 3220    Dialect == swi,
 3221    !,
 3222    set_prolog_flag(emulated_dialect, Dialect).
 3223'$expects_dialect'(Dialect) :-
 3224    current_predicate(expects_dialect/1),
 3225    !,
 3226    expects_dialect(Dialect).
 3227'$expects_dialect'(Dialect) :-
 3228    use_module(library(dialect), [expects_dialect/1]),
 3229    expects_dialect(Dialect).
 3230
 3231
 3232		 /*******************************
 3233		 *           MODULES            *
 3234		 *******************************/
 3235
 3236'$start_module'(Module, _Public, State, _Options) :-
 3237    '$current_module'(Module, OldFile),
 3238    source_location(File, _Line),
 3239    OldFile \== File, OldFile \== [],
 3240    same_file(OldFile, File),
 3241    !,
 3242    nb_setarg(2, State, Module),
 3243    nb_setarg(4, State, true).      % Stop processing
 3244'$start_module'(Module, Public, State, Options) :-
 3245    arg(5, State, File),
 3246    nb_setarg(2, State, Module),
 3247    source_location(_File, Line),
 3248    '$option'(redefine_module(Action), Options, false),
 3249    '$module_class'(File, Class, Super),
 3250    '$reset_dialect'(File, Class),
 3251    '$redefine_module'(Module, File, Action),
 3252    '$declare_module'(Module, Class, Super, File, Line, false),
 3253    '$export_list'(Public, Module, Ops),
 3254    '$ifcompiling'('$qlf_start_module'(Module)),
 3255    '$export_ops'(Ops, Module, File),
 3256    '$qset_dialect'(State),
 3257    nb_setarg(3, State, end_module).
 $reset_dialect(+File, +Class) is det
Load .pl files from the SWI-Prolog distribution always in swi dialect.
 3264'$reset_dialect'(File, library) :-
 3265    file_name_extension(_, pl, File),
 3266    !,
 3267    set_prolog_flag(emulated_dialect, swi).
 3268'$reset_dialect'(_, _).
 $module3(+Spec) is det
Handle the 3th argument of a module declartion.
 3275'$module3'(Var) :-
 3276    var(Var),
 3277    !,
 3278    '$instantiation_error'(Var).
 3279'$module3'([]) :- !.
 3280'$module3'([H|T]) :-
 3281    !,
 3282    '$module3'(H),
 3283    '$module3'(T).
 3284'$module3'(Id) :-
 3285    use_module(library(dialect/Id)).
 $module_name(?Name, +Id, -Module, +Options) is semidet
Determine the module name. There are some cases:
 3299'$module_name'(_, _, Module, Options) :-
 3300    '$option'(module(Module), Options),
 3301    !,
 3302    '$current_source_module'(Context),
 3303    Context \== Module.                     % cause '$first_term'/5 to fail.
 3304'$module_name'(Var, Id, Module, Options) :-
 3305    var(Var),
 3306    !,
 3307    file_base_name(Id, File),
 3308    file_name_extension(Var, _, File),
 3309    '$module_name'(Var, Id, Module, Options).
 3310'$module_name'(Reserved, _, _, _) :-
 3311    '$reserved_module'(Reserved),
 3312    !,
 3313    throw(error(permission_error(load, module, Reserved), _)).
 3314'$module_name'(Module, _Id, Module, _).
 3315
 3316
 3317'$reserved_module'(system).
 3318'$reserved_module'(user).
 $redefine_module(+Module, +File, -Redefine)
 3323'$redefine_module'(_Module, _, false) :- !.
 3324'$redefine_module'(Module, File, true) :-
 3325    !,
 3326    (   module_property(Module, file(OldFile)),
 3327	File \== OldFile
 3328    ->  unload_file(OldFile)
 3329    ;   true
 3330    ).
 3331'$redefine_module'(Module, File, ask) :-
 3332    (   stream_property(user_input, tty(true)),
 3333	module_property(Module, file(OldFile)),
 3334	File \== OldFile,
 3335	'$rdef_response'(Module, OldFile, File, true)
 3336    ->  '$redefine_module'(Module, File, true)
 3337    ;   true
 3338    ).
 3339
 3340'$rdef_response'(Module, OldFile, File, Ok) :-
 3341    repeat,
 3342    print_message(query, redefine_module(Module, OldFile, File)),
 3343    get_single_char(Char),
 3344    '$rdef_response'(Char, Ok0),
 3345    !,
 3346    Ok = Ok0.
 3347
 3348'$rdef_response'(Char, true) :-
 3349    memberchk(Char, `yY`),
 3350    format(user_error, 'yes~n', []).
 3351'$rdef_response'(Char, false) :-
 3352    memberchk(Char, `nN`),
 3353    format(user_error, 'no~n', []).
 3354'$rdef_response'(Char, _) :-
 3355    memberchk(Char, `a`),
 3356    format(user_error, 'abort~n', []),
 3357    abort.
 3358'$rdef_response'(_, _) :-
 3359    print_message(help, redefine_module_reply),
 3360    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.
 3370'$module_class'(File, Class, system) :-
 3371    current_prolog_flag(home, Home),
 3372    sub_atom(File, 0, Len, _, Home),
 3373    (   sub_atom(File, Len, _, _, '/boot/')
 3374    ->  !, Class = system
 3375    ;   '$lib_prefix'(Prefix),
 3376	sub_atom(File, Len, _, _, Prefix)
 3377    ->  !, Class = library
 3378    ;   file_directory_name(File, Home),
 3379	file_name_extension(_, rc, File)
 3380    ->  !, Class = library
 3381    ).
 3382'$module_class'(_, user, user).
 3383
 3384'$lib_prefix'('/library').
 3385'$lib_prefix'('/xpce/prolog/').
 3386
 3387'$check_export'(Module) :-
 3388    '$undefined_export'(Module, UndefList),
 3389    (   '$member'(Undef, UndefList),
 3390	strip_module(Undef, _, Local),
 3391	print_message(error,
 3392		      undefined_export(Module, Local)),
 3393	fail
 3394    ;   true
 3395    ).
 $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).
 3404'$import_list'(_, _, Var, _) :-
 3405    var(Var),
 3406    !,
 3407    throw(error(instantitation_error, _)).
 3408'$import_list'(Target, Source, all, Reexport) :-
 3409    !,
 3410    '$exported_ops'(Source, Import, Predicates),
 3411    '$module_property'(Source, exports(Predicates)),
 3412    '$import_all'(Import, Target, Source, Reexport, weak).
 3413'$import_list'(Target, Source, except(Spec), Reexport) :-
 3414    !,
 3415    '$exported_ops'(Source, Export, Predicates),
 3416    '$module_property'(Source, exports(Predicates)),
 3417    (   is_list(Spec)
 3418    ->  true
 3419    ;   throw(error(type_error(list, Spec), _))
 3420    ),
 3421    '$import_except'(Spec, Export, Import),
 3422    '$import_all'(Import, Target, Source, Reexport, weak).
 3423'$import_list'(Target, Source, Import, Reexport) :-
 3424    !,
 3425    is_list(Import),
 3426    !,
 3427    '$import_all'(Import, Target, Source, Reexport, strong).
 3428'$import_list'(_, _, Import, _) :-
 3429    throw(error(type_error(import_specifier, Import))).
 3430
 3431
 3432'$import_except'([], List, List).
 3433'$import_except'([H|T], List0, List) :-
 3434    '$import_except_1'(H, List0, List1),
 3435    '$import_except'(T, List1, List).
 3436
 3437'$import_except_1'(Var, _, _) :-
 3438    var(Var),
 3439    !,
 3440    throw(error(instantitation_error, _)).
 3441'$import_except_1'(PI as N, List0, List) :-
 3442    '$pi'(PI), atom(N),
 3443    !,
 3444    '$canonical_pi'(PI, CPI),
 3445    '$import_as'(CPI, N, List0, List).
 3446'$import_except_1'(op(P,A,N), List0, List) :-
 3447    !,
 3448    '$remove_ops'(List0, op(P,A,N), List).
 3449'$import_except_1'(PI, List0, List) :-
 3450    '$pi'(PI),
 3451    !,
 3452    '$canonical_pi'(PI, CPI),
 3453    '$select'(P, List0, List),
 3454    '$canonical_pi'(CPI, P),
 3455    !.
 3456'$import_except_1'(Except, _, _) :-
 3457    throw(error(type_error(import_specifier, Except), _)).
 3458
 3459'$import_as'(CPI, N, [PI2|T], [CPI as N|T]) :-
 3460    '$canonical_pi'(PI2, CPI),
 3461    !.
 3462'$import_as'(PI, N, [H|T0], [H|T]) :-
 3463    !,
 3464    '$import_as'(PI, N, T0, T).
 3465'$import_as'(PI, _, _, _) :-
 3466    throw(error(existence_error(export, PI), _)).
 3467
 3468'$pi'(N/A) :- atom(N), integer(A), !.
 3469'$pi'(N//A) :- atom(N), integer(A).
 3470
 3471'$canonical_pi'(N//A0, N/A) :-
 3472    A is A0 + 2.
 3473'$canonical_pi'(PI, PI).
 3474
 3475'$remove_ops'([], _, []).
 3476'$remove_ops'([Op|T0], Pattern, T) :-
 3477    subsumes_term(Pattern, Op),
 3478    !,
 3479    '$remove_ops'(T0, Pattern, T).
 3480'$remove_ops'([H|T0], Pattern, [H|T]) :-
 3481    '$remove_ops'(T0, Pattern, T).
 $import_all(+Import, +Context, +Source, +Reexport, +Strength)
 3486'$import_all'(Import, Context, Source, Reexport, Strength) :-
 3487    '$import_all2'(Import, Context, Source, Imported, ImpOps, Strength),
 3488    (   Reexport == true,
 3489	(   '$list_to_conj'(Imported, Conj)
 3490	->  export(Context:Conj),
 3491	    '$ifcompiling'('$add_directive_wic'(export(Context:Conj)))
 3492	;   true
 3493	),
 3494	source_location(File, _Line),
 3495	'$export_ops'(ImpOps, Context, File)
 3496    ;   true
 3497    ).
 $import_all2(+Imports, +Context, +Source, -Imported, -ImpOps, +Strength)
 3501'$import_all2'([], _, _, [], [], _).
 3502'$import_all2'([PI as NewName|Rest], Context, Source,
 3503	       [NewName/Arity|Imported], ImpOps, Strength) :-
 3504    !,
 3505    '$canonical_pi'(PI, Name/Arity),
 3506    length(Args, Arity),
 3507    Head =.. [Name|Args],
 3508    NewHead =.. [NewName|Args],
 3509    (   '$get_predicate_attribute'(Source:Head, transparent, 1)
 3510    ->  '$set_predicate_attribute'(Context:NewHead, transparent, true)
 3511    ;   true
 3512    ),
 3513    (   source_location(File, Line)
 3514    ->  E = error(_,_),
 3515	catch('$store_admin_clause'((NewHead :- Source:Head),
 3516				    _Layout, File, File:Line),
 3517	      E, '$print_message'(error, E))
 3518    ;   assertz((NewHead :- !, Source:Head)) % ! avoids problems with
 3519    ),                                       % duplicate load
 3520    '$import_all2'(Rest, Context, Source, Imported, ImpOps, Strength).
 3521'$import_all2'([op(P,A,N)|Rest], Context, Source, Imported,
 3522	       [op(P,A,N)|ImpOps], Strength) :-
 3523    !,
 3524    '$import_ops'(Context, Source, op(P,A,N)),
 3525    '$import_all2'(Rest, Context, Source, Imported, ImpOps, Strength).
 3526'$import_all2'([Pred|Rest], Context, Source, [Pred|Imported], ImpOps, Strength) :-
 3527    Error = error(_,_),
 3528    catch(Context:'$import'(Source:Pred, Strength), Error,
 3529	  print_message(error, Error)),
 3530    '$ifcompiling'('$import_wic'(Source, Pred, Strength)),
 3531    '$import_all2'(Rest, Context, Source, Imported, ImpOps, Strength).
 3532
 3533
 3534'$list_to_conj'([One], One) :- !.
 3535'$list_to_conj'([H|T], (H,Rest)) :-
 3536    '$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.
 3543'$exported_ops'(Module, Ops, Tail) :-
 3544    '$c_current_predicate'(_, Module:'$exported_op'(_,_,_)),
 3545    !,
 3546    findall(op(P,A,N), Module:'$exported_op'(P,A,N), Ops, Tail).
 3547'$exported_ops'(_, Ops, Ops).
 3548
 3549'$exported_op'(Module, P, A, N) :-
 3550    '$c_current_predicate'(_, Module:'$exported_op'(_,_,_)),
 3551    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.
 3558'$import_ops'(To, From, Pattern) :-
 3559    ground(Pattern),
 3560    !,
 3561    Pattern = op(P,A,N),
 3562    op(P,A,To:N),
 3563    (   '$exported_op'(From, P, A, N)
 3564    ->  true
 3565    ;   print_message(warning, no_exported_op(From, Pattern))
 3566    ).
 3567'$import_ops'(To, From, Pattern) :-
 3568    (   '$exported_op'(From, Pri, Assoc, Name),
 3569	Pattern = op(Pri, Assoc, Name),
 3570	op(Pri, Assoc, To:Name),
 3571	fail
 3572    ;   true
 3573    ).
 $export_list(+Declarations, +Module, -Ops)
Handle the export list of the module declaration for Module associated to File.
 3581'$export_list'(Decls, Module, Ops) :-
 3582    is_list(Decls),
 3583    !,
 3584    '$do_export_list'(Decls, Module, Ops).
 3585'$export_list'(Decls, _, _) :-
 3586    var(Decls),
 3587    throw(error(instantiation_error, _)).
 3588'$export_list'(Decls, _, _) :-
 3589    throw(error(type_error(list, Decls), _)).
 3590
 3591'$do_export_list'([], _, []) :- !.
 3592'$do_export_list'([H|T], Module, Ops) :-
 3593    !,
 3594    E = error(_,_),
 3595    catch('$export1'(H, Module, Ops, Ops1),
 3596	  E, ('$print_message'(error, E), Ops = Ops1)),
 3597    '$do_export_list'(T, Module, Ops1).
 3598
 3599'$export1'(Var, _, _, _) :-
 3600    var(Var),
 3601    !,
 3602    throw(error(instantiation_error, _)).
 3603'$export1'(Op, _, [Op|T], T) :-
 3604    Op = op(_,_,_),
 3605    !.
 3606'$export1'(PI0, Module, Ops, Ops) :-
 3607    strip_module(Module:PI0, M, PI),
 3608    (   PI = (_//_)
 3609    ->  non_terminal(M:PI)
 3610    ;   true
 3611    ),
 3612    export(M:PI).
 3613
 3614'$export_ops'([op(Pri, Assoc, Name)|T], Module, File) :-
 3615    E = error(_,_),
 3616    catch(( '$execute_directive'(op(Pri, Assoc, Module:Name), File, []),
 3617	    '$export_op'(Pri, Assoc, Name, Module, File)
 3618	  ),
 3619	  E, '$print_message'(error, E)),
 3620    '$export_ops'(T, Module, File).
 3621'$export_ops'([], _, _).
 3622
 3623'$export_op'(Pri, Assoc, Name, Module, File) :-
 3624    (   '$get_predicate_attribute'(Module:'$exported_op'(_,_,_), defined, 1)
 3625    ->  true
 3626    ;   '$execute_directive'(discontiguous(Module:'$exported_op'/3), File, [])
 3627    ),
 3628    '$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.
 3634'$execute_directive'(Var, _F, _Options) :-
 3635    var(Var),
 3636    '$instantiation_error'(Var).
 3637'$execute_directive'(encoding(Encoding), _F, _Options) :-
 3638    !,
 3639    (   '$load_input'(_F, S)
 3640    ->  set_stream(S, encoding(Encoding))
 3641    ).
 3642'$execute_directive'(Goal, _, Options) :-
 3643    \+ '$compilation_mode'(database),
 3644    !,
 3645    '$add_directive_wic2'(Goal, Type, Options),
 3646    (   Type == call                % suspend compiling into .qlf file
 3647    ->  '$compilation_mode'(Old, database),
 3648	setup_call_cleanup(
 3649	    '$directive_mode'(OldDir, Old),
 3650	    '$execute_directive_3'(Goal),
 3651	    ( '$set_compilation_mode'(Old),
 3652	      '$set_directive_mode'(OldDir)
 3653	    ))
 3654    ;   '$execute_directive_3'(Goal)
 3655    ).
 3656'$execute_directive'(Goal, _, _Options) :-
 3657    '$execute_directive_3'(Goal).
 3658
 3659'$execute_directive_3'(Goal) :-
 3660    '$current_source_module'(Module),
 3661    '$valid_directive'(Module:Goal),
 3662    !,
 3663    (   '$pattr_directive'(Goal, Module)
 3664    ->  true
 3665    ;   Term = error(_,_),
 3666	catch(Module:Goal, Term, '$exception_in_directive'(Term))
 3667    ->  true
 3668    ;   '$print_message'(warning, goal_failed(directive, Module:Goal)),
 3669	fail
 3670    ).
 3671'$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.
 3680:- multifile prolog:sandbox_allowed_directive/1. 3681:- multifile prolog:sandbox_allowed_clause/1. 3682:- meta_predicate '$valid_directive'(:). 3683
 3684'$valid_directive'(_) :-
 3685    current_prolog_flag(sandboxed_load, false),
 3686    !.
 3687'$valid_directive'(Goal) :-
 3688    Error = error(Formal, _),
 3689    catch(prolog:sandbox_allowed_directive(Goal), Error, true),
 3690    !,
 3691    (   var(Formal)
 3692    ->  true
 3693    ;   print_message(error, Error),
 3694	fail
 3695    ).
 3696'$valid_directive'(Goal) :-
 3697    print_message(error,
 3698		  error(permission_error(execute,
 3699					 sandboxed_directive,
 3700					 Goal), _)),
 3701    fail.
 3702
 3703'$exception_in_directive'(Term) :-
 3704    '$print_message'(error, Term),
 3705    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.
 3713'$add_directive_wic2'(Goal, Type, Options) :-
 3714    '$common_goal_type'(Goal, Type, Options),
 3715    !,
 3716    (   Type == load
 3717    ->  true
 3718    ;   '$current_source_module'(Module),
 3719	'$add_directive_wic'(Module:Goal)
 3720    ).
 3721'$add_directive_wic2'(Goal, _, _) :-
 3722    (   '$compilation_mode'(qlf)    % no problem for qlf files
 3723    ->  true
 3724    ;   print_message(error, mixed_directive(Goal))
 3725    ).
 $common_goal_type(+Directive, -Type, +Options) is semidet
True when all subgoals of Directive must be handled using load or call.
 3732'$common_goal_type'((A,B), Type, Options) :-
 3733    !,
 3734    '$common_goal_type'(A, Type, Options),
 3735    '$common_goal_type'(B, Type, Options).
 3736'$common_goal_type'((A;B), Type, Options) :-
 3737    !,
 3738    '$common_goal_type'(A, Type, Options),
 3739    '$common_goal_type'(B, Type, Options).
 3740'$common_goal_type'((A->B), Type, Options) :-
 3741    !,
 3742    '$common_goal_type'(A, Type, Options),
 3743    '$common_goal_type'(B, Type, Options).
 3744'$common_goal_type'(Goal, Type, Options) :-
 3745    '$goal_type'(Goal, Type, Options).
 3746
 3747'$goal_type'(Goal, Type, Options) :-
 3748    (   '$load_goal'(Goal, Options)
 3749    ->  Type = load
 3750    ;   Type = call
 3751    ).
 3752
 3753:- thread_local
 3754    '$qlf':qinclude/1. 3755
 3756'$load_goal'([_|_], _).
 3757'$load_goal'(consult(_), _).
 3758'$load_goal'(load_files(_), _).
 3759'$load_goal'(load_files(_,Options), _) :-
 3760    memberchk(qcompile(QlfMode), Options),
 3761    '$qlf_part_mode'(QlfMode).
 3762'$load_goal'(ensure_loaded(_), _) :- '$compilation_mode'(wic).
 3763'$load_goal'(use_module(_), _)    :- '$compilation_mode'(wic).
 3764'$load_goal'(use_module(_, _), _) :- '$compilation_mode'(wic).
 3765'$load_goal'(reexport(_), _)      :- '$compilation_mode'(wic).
 3766'$load_goal'(reexport(_, _), _)   :- '$compilation_mode'(wic).
 3767'$load_goal'(Goal, _Options) :-
 3768    '$qlf':qinclude(user),
 3769    '$load_goal_file'(Goal, File),
 3770    '$all_user_files'(File).
 3771
 3772
 3773'$load_goal_file'(load_files(F), F).
 3774'$load_goal_file'(load_files(F, _), F).
 3775'$load_goal_file'(ensure_loaded(F), F).
 3776'$load_goal_file'(use_module(F), F).
 3777'$load_goal_file'(use_module(F, _), F).
 3778'$load_goal_file'(reexport(F), F).
 3779'$load_goal_file'(reexport(F, _), F).
 3780
 3781'$all_user_files'([]) :-
 3782    !.
 3783'$all_user_files'([H|T]) :-
 3784    !,
 3785    '$is_user_file'(H),
 3786    '$all_user_files'(T).
 3787'$all_user_files'(F) :-
 3788    ground(F),
 3789    '$is_user_file'(F).
 3790
 3791'$is_user_file'(File) :-
 3792    absolute_file_name(File, Path,
 3793		       [ file_type(prolog),
 3794			 access(read)
 3795		       ]),
 3796    '$module_class'(Path, user, _).
 3797
 3798'$qlf_part_mode'(part).
 3799'$qlf_part_mode'(true).                 % compatibility
 3800
 3801
 3802		/********************************
 3803		*        COMPILE A CLAUSE       *
 3804		*********************************/
 $store_admin_clause(+Clause, ?Layout, +Owner, +SrcLoc) is det
Store a clause into the database for administrative purposes. This bypasses sanity checking.
 3811'$store_admin_clause'(Clause, Layout, Owner, SrcLoc) :-
 3812    Owner \== (-),
 3813    !,
 3814    setup_call_cleanup(
 3815	'$start_aux'(Owner, Context),
 3816	'$store_admin_clause2'(Clause, Layout, Owner, SrcLoc),
 3817	'$end_aux'(Owner, Context)).
 3818'$store_admin_clause'(Clause, Layout, File, SrcLoc) :-
 3819    '$store_admin_clause2'(Clause, Layout, File, SrcLoc).
 3820
 3821'$store_admin_clause2'(Clause, _Layout, File, SrcLoc) :-
 3822    (   '$compilation_mode'(database)
 3823    ->  '$record_clause'(Clause, File, SrcLoc)
 3824    ;   '$record_clause'(Clause, File, SrcLoc, Ref),
 3825	'$qlf_assert_clause'(Ref, development)
 3826    ).
 $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.
 3836'$store_clause'((_, _), _, _, _) :-
 3837    !,
 3838    print_message(error, cannot_redefine_comma),
 3839    fail.
 3840'$store_clause'((Pre => Body), _Layout, File, SrcLoc) :-
 3841    nonvar(Pre),
 3842    Pre = (Head,Cond),
 3843    !,
 3844    (   '$is_true'(Cond), current_prolog_flag(optimise, true)
 3845    ->  '$store_clause'((Head=>Body), _Layout, File, SrcLoc)
 3846    ;   '$store_clause'(?=>(Head,(Cond,!,Body)), _Layout, File, SrcLoc)
 3847    ).
 3848'$store_clause'(Clause, _Layout, File, SrcLoc) :-
 3849    '$valid_clause'(Clause),
 3850    !,
 3851    (   '$compilation_mode'(database)
 3852    ->  '$record_clause'(Clause, File, SrcLoc)
 3853    ;   '$record_clause'(Clause, File, SrcLoc, Ref),
 3854	'$qlf_assert_clause'(Ref, development)
 3855    ).
 3856
 3857'$is_true'(true)  => true.
 3858'$is_true'((A,B)) => '$is_true'(A), '$is_true'(B).
 3859'$is_true'(_)     => fail.
 3860
 3861'$valid_clause'(_) :-
 3862    current_prolog_flag(sandboxed_load, false),
 3863    !.
 3864'$valid_clause'(Clause) :-
 3865    \+ '$cross_module_clause'(Clause),
 3866    !.
 3867'$valid_clause'(Clause) :-
 3868    Error = error(Formal, _),
 3869    catch(prolog:sandbox_allowed_clause(Clause), Error, true),
 3870    !,
 3871    (   var(Formal)
 3872    ->  true
 3873    ;   print_message(error, Error),
 3874	fail
 3875    ).
 3876'$valid_clause'(Clause) :-
 3877    print_message(error,
 3878		  error(permission_error(assert,
 3879					 sandboxed_clause,
 3880					 Clause), _)),
 3881    fail.
 3882
 3883'$cross_module_clause'(Clause) :-
 3884    '$head_module'(Clause, Module),
 3885    \+ '$current_source_module'(Module).
 3886
 3887'$head_module'(Var, _) :-
 3888    var(Var), !, fail.
 3889'$head_module'((Head :- _), Module) :-
 3890    '$head_module'(Head, Module).
 3891'$head_module'(Module:_, Module).
 3892
 3893'$clause_source'('$source_location'(File,Line):Clause, Clause, File:Line) :- !.
 3894'$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.
 3901:- public
 3902    '$store_clause'/2. 3903
 3904'$store_clause'(Term, Id) :-
 3905    '$clause_source'(Term, Clause, SrcLoc),
 3906    '$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?
 3927compile_aux_clauses(_Clauses) :-
 3928    current_prolog_flag(xref, true),
 3929    !.
 3930compile_aux_clauses(Clauses) :-
 3931    source_location(File, _Line),
 3932    '$compile_aux_clauses'(Clauses, File).
 3933
 3934'$compile_aux_clauses'(Clauses, File) :-
 3935    setup_call_cleanup(
 3936	'$start_aux'(File, Context),
 3937	'$store_aux_clauses'(Clauses, File),
 3938	'$end_aux'(File, Context)).
 3939
 3940'$store_aux_clauses'(Clauses, File) :-
 3941    is_list(Clauses),
 3942    !,
 3943    forall('$member'(C,Clauses),
 3944	   '$compile_term'(C, _Layout, File, [])).
 3945'$store_aux_clauses'(Clause, File) :-
 3946    '$compile_term'(Clause, _Layout, File, []).
 3947
 3948
 3949		 /*******************************
 3950		 *            STAGING		*
 3951		 *******************************/
 $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.
 3961'$stage_file'(Target, Stage) :-
 3962    file_directory_name(Target, Dir),
 3963    file_base_name(Target, File),
 3964    current_prolog_flag(pid, Pid),
 3965    format(atom(Stage), '~w/.~w.~d', [Dir,File,Pid]).
 3966
 3967'$install_staged_file'(exit, Staged, Target, error) :-
 3968    !,
 3969    rename_file(Staged, Target).
 3970'$install_staged_file'(exit, Staged, Target, OnError) :-
 3971    !,
 3972    InstallError = error(_,_),
 3973    catch(rename_file(Staged, Target),
 3974	  InstallError,
 3975	  '$install_staged_error'(OnError, InstallError, Staged, Target)).
 3976'$install_staged_file'(_, Staged, _, _OnError) :-
 3977    E = error(_,_),
 3978    catch(delete_file(Staged), E, true).
 3979
 3980'$install_staged_error'(OnError, Error, Staged, _Target) :-
 3981    E = error(_,_),
 3982    catch(delete_file(Staged), E, true),
 3983    (   OnError = silent
 3984    ->  true
 3985    ;   OnError = fail
 3986    ->  fail
 3987    ;   print_message(warning, Error)
 3988    ).
 3989
 3990
 3991		 /*******************************
 3992		 *             READING          *
 3993		 *******************************/
 3994
 3995:- multifile
 3996    prolog:comment_hook/3.                  % hook for read_clause/3
 3997
 3998
 3999		 /*******************************
 4000		 *       FOREIGN INTERFACE      *
 4001		 *******************************/
 4002
 4003%       call-back from PL_register_foreign().  First argument is the module
 4004%       into which the foreign predicate is loaded and second is a term
 4005%       describing the arguments.
 4006
 4007:- dynamic
 4008    '$foreign_registered'/2. 4009
 4010		 /*******************************
 4011		 *   TEMPORARY TERM EXPANSION   *
 4012		 *******************************/
 4013
 4014% Provide temporary definitions for the boot-loader.  These are replaced
 4015% by the real thing in load.pl
 4016
 4017:- dynamic
 4018    '$expand_goal'/2,
 4019    '$expand_term'/4. 4020
 4021'$expand_goal'(In, In).
 4022'$expand_term'(In, Layout, In, Layout).
 4023
 4024
 4025		 /*******************************
 4026		 *         TYPE SUPPORT         *
 4027		 *******************************/
 4028
 4029'$type_error'(Type, Value) :-
 4030    (   var(Value)
 4031    ->  throw(error(instantiation_error, _))
 4032    ;   throw(error(type_error(Type, Value), _))
 4033    ).
 4034
 4035'$domain_error'(Type, Value) :-
 4036    throw(error(domain_error(Type, Value), _)).
 4037
 4038'$existence_error'(Type, Object) :-
 4039    throw(error(existence_error(Type, Object), _)).
 4040
 4041'$permission_error'(Action, Type, Term) :-
 4042    throw(error(permission_error(Action, Type, Term), _)).
 4043
 4044'$instantiation_error'(_Var) :-
 4045    throw(error(instantiation_error, _)).
 4046
 4047'$uninstantiation_error'(NonVar) :-
 4048    throw(error(uninstantiation_error(NonVar), _)).
 4049
 4050'$must_be'(list, X) :- !,
 4051    '$skip_list'(_, X, Tail),
 4052    (   Tail == []
 4053    ->  true
 4054    ;   '$type_error'(list, Tail)
 4055    ).
 4056'$must_be'(options, X) :- !,
 4057    (   '$is_options'(X)
 4058    ->  true
 4059    ;   '$type_error'(options, X)
 4060    ).
 4061'$must_be'(atom, X) :- !,
 4062    (   atom(X)
 4063    ->  true
 4064    ;   '$type_error'(atom, X)
 4065    ).
 4066'$must_be'(integer, X) :- !,
 4067    (   integer(X)
 4068    ->  true
 4069    ;   '$type_error'(integer, X)
 4070    ).
 4071'$must_be'(between(Low,High), X) :- !,
 4072    (   integer(X)
 4073    ->  (   between(Low, High, X)
 4074	->  true
 4075	;   '$domain_error'(between(Low,High), X)
 4076	)
 4077    ;   '$type_error'(integer, X)
 4078    ).
 4079'$must_be'(callable, X) :- !,
 4080    (   callable(X)
 4081    ->  true
 4082    ;   '$type_error'(callable, X)
 4083    ).
 4084'$must_be'(acyclic, X) :- !,
 4085    (   acyclic_term(X)
 4086    ->  true
 4087    ;   '$domain_error'(acyclic_term, X)
 4088    ).
 4089'$must_be'(oneof(Type, Domain, List), X) :- !,
 4090    '$must_be'(Type, X),
 4091    (   memberchk(X, List)
 4092    ->  true
 4093    ;   '$domain_error'(Domain, X)
 4094    ).
 4095'$must_be'(boolean, X) :- !,
 4096    (   (X == true ; X == false)
 4097    ->  true
 4098    ;   '$type_error'(boolean, X)
 4099    ).
 4100'$must_be'(ground, X) :- !,
 4101    (   ground(X)
 4102    ->  true
 4103    ;   '$instantiation_error'(X)
 4104    ).
 4105'$must_be'(filespec, X) :- !,
 4106    (   (   atom(X)
 4107	;   string(X)
 4108	;   compound(X),
 4109	    compound_name_arity(X, _, 1)
 4110	)
 4111    ->  true
 4112    ;   '$type_error'(filespec, X)
 4113    ).
 4114
 4115% Use for debugging
 4116%'$must_be'(Type, _X) :- format('Unknown $must_be type: ~q~n', [Type]).
 4117
 4118
 4119		/********************************
 4120		*       LIST PROCESSING         *
 4121		*********************************/
 4122
 4123'$member'(El, [H|T]) :-
 4124    '$member_'(T, El, H).
 4125
 4126'$member_'(_, El, El).
 4127'$member_'([H|T], El, _) :-
 4128    '$member_'(T, El, H).
 4129
 4130'$append'([], L, L).
 4131'$append'([H|T], L, [H|R]) :-
 4132    '$append'(T, L, R).
 4133
 4134'$append'(ListOfLists, List) :-
 4135    '$must_be'(list, ListOfLists),
 4136    '$append_'(ListOfLists, List).
 4137
 4138'$append_'([], []).
 4139'$append_'([L|Ls], As) :-
 4140    '$append'(L, Ws, As),
 4141    '$append_'(Ls, Ws).
 4142
 4143'$select'(X, [X|Tail], Tail).
 4144'$select'(Elem, [Head|Tail], [Head|Rest]) :-
 4145    '$select'(Elem, Tail, Rest).
 4146
 4147'$reverse'(L1, L2) :-
 4148    '$reverse'(L1, [], L2).
 4149
 4150'$reverse'([], List, List).
 4151'$reverse'([Head|List1], List2, List3) :-
 4152    '$reverse'(List1, [Head|List2], List3).
 4153
 4154'$delete'([], _, []) :- !.
 4155'$delete'([Elem|Tail], Elem, Result) :-
 4156    !,
 4157    '$delete'(Tail, Elem, Result).
 4158'$delete'([Head|Tail], Elem, [Head|Rest]) :-
 4159    '$delete'(Tail, Elem, Rest).
 4160
 4161'$last'([H|T], Last) :-
 4162    '$last'(T, H, Last).
 4163
 4164'$last'([], Last, Last).
 4165'$last'([H|T], _, Last) :-
 4166    '$last'(T, H, Last).
 length(?List, ?N)
Is true when N is the length of List.
 4173:- '$iso'((length/2)). 4174
 4175length(List, Length) :-
 4176    var(Length),
 4177    !,
 4178    '$skip_list'(Length0, List, Tail),
 4179    (   Tail == []
 4180    ->  Length = Length0                    % +,-
 4181    ;   var(Tail)
 4182    ->  Tail \== Length,                    % avoid length(L,L)
 4183	'$length3'(Tail, Length, Length0)   % -,-
 4184    ;   throw(error(type_error(list, List),
 4185		    context(length/2, _)))
 4186    ).
 4187length(List, Length) :-
 4188    integer(Length),
 4189    Length >= 0,
 4190    !,
 4191    '$skip_list'(Length0, List, Tail),
 4192    (   Tail == []                          % proper list
 4193    ->  Length = Length0
 4194    ;   var(Tail)
 4195    ->  Extra is Length-Length0,
 4196	'$length'(Tail, Extra)
 4197    ;   throw(error(type_error(list, List),
 4198		    context(length/2, _)))
 4199    ).
 4200length(_, Length) :-
 4201    integer(Length),
 4202    !,
 4203    throw(error(domain_error(not_less_than_zero, Length),
 4204		context(length/2, _))).
 4205length(_, Length) :-
 4206    throw(error(type_error(integer, Length),
 4207		context(length/2, _))).
 4208
 4209'$length3'([], N, N).
 4210'$length3'([_|List], N, N0) :-
 4211    N1 is N0+1,
 4212    '$length3'(List, N, N1).
 4213
 4214
 4215		 /*******************************
 4216		 *       OPTION PROCESSING      *
 4217		 *******************************/
 $is_options(@Term) is semidet
True if Term looks like it provides options.
 4223'$is_options'(Map) :-
 4224    is_dict(Map, _),
 4225    !.
 4226'$is_options'(List) :-
 4227    is_list(List),
 4228    (   List == []
 4229    ->  true
 4230    ;   List = [H|_],
 4231	'$is_option'(H, _, _)
 4232    ).
 4233
 4234'$is_option'(Var, _, _) :-
 4235    var(Var), !, fail.
 4236'$is_option'(F, Name, Value) :-
 4237    functor(F, _, 1),
 4238    !,
 4239    F =.. [Name,Value].
 4240'$is_option'(Name=Value, Name, Value).
 $option(?Opt, +Options) is semidet
 4244'$option'(Opt, Options) :-
 4245    is_dict(Options),
 4246    !,
 4247    [Opt] :< Options.
 4248'$option'(Opt, Options) :-
 4249    memberchk(Opt, Options).
 $option(?Opt, +Options, +Default) is det
 4253'$option'(Term, Options, Default) :-
 4254    arg(1, Term, Value),
 4255    functor(Term, Name, 1),
 4256    (   is_dict(Options)
 4257    ->  (   get_dict(Name, Options, GVal)
 4258	->  Value = GVal
 4259	;   Value = Default
 4260	)
 4261    ;   functor(Gen, Name, 1),
 4262	arg(1, Gen, GVal),
 4263	(   memberchk(Gen, Options)
 4264	->  Value = GVal
 4265	;   Value = Default
 4266	)
 4267    ).
 $select_option(?Opt, +Options, -Rest) is semidet
Select an option from Options.
Arguments:
Rest- is always a map.
 4275'$select_option'(Opt, Options, Rest) :-
 4276    '$options_dict'(Options, Dict),
 4277    select_dict([Opt], Dict, Rest).
 $merge_options(+New, +Default, -Merged) is det
Add/replace options specified in New.
Arguments:
Merged- is always a map.
 4285'$merge_options'(New, Old, Merged) :-
 4286    '$options_dict'(New, NewDict),
 4287    '$options_dict'(Old, OldDict),
 4288    put_dict(NewDict, OldDict, Merged).
 $options_dict(+Options, --Dict) is det
Translate to an options dict. For possible duplicate keys we keep the first.
 4295'$options_dict'(Options, Dict) :-
 4296    is_list(Options),
 4297    !,
 4298    '$keyed_options'(Options, Keyed),
 4299    sort(1, @<, Keyed, UniqueKeyed),
 4300    '$pairs_values'(UniqueKeyed, Unique),
 4301    dict_create(Dict, _, Unique).
 4302'$options_dict'(Dict, Dict) :-
 4303    is_dict(Dict),
 4304    !.
 4305'$options_dict'(Options, _) :-
 4306    '$domain_error'(options, Options).
 4307
 4308'$keyed_options'([], []).
 4309'$keyed_options'([H0|T0], [H|T]) :-
 4310    '$keyed_option'(H0, H),
 4311    '$keyed_options'(T0, T).
 4312
 4313'$keyed_option'(Var, _) :-
 4314    var(Var),
 4315    !,
 4316    '$instantiation_error'(Var).
 4317'$keyed_option'(Name=Value, Name-(Name-Value)).
 4318'$keyed_option'(NameValue, Name-(Name-Value)) :-
 4319    compound_name_arguments(NameValue, Name, [Value]),
 4320    !.
 4321'$keyed_option'(Opt, _) :-
 4322    '$domain_error'(option, Opt).
 4323
 4324
 4325		 /*******************************
 4326		 *   HANDLE TRACER 'L'-COMMAND  *
 4327		 *******************************/
 4328
 4329:- public '$prolog_list_goal'/1. 4330
 4331:- multifile
 4332    user:prolog_list_goal/1. 4333
 4334'$prolog_list_goal'(Goal) :-
 4335    user:prolog_list_goal(Goal),
 4336    !.
 4337'$prolog_list_goal'(Goal) :-
 4338    use_module(library(listing), [listing/1]),
 4339    @(listing(Goal), user).
 4340
 4341
 4342		 /*******************************
 4343		 *             HALT             *
 4344		 *******************************/
 4345
 4346:- '$iso'((halt/0)). 4347
 4348halt :-
 4349    '$exit_code'(Code),
 4350    (   Code == 0
 4351    ->  true
 4352    ;   print_message(warning, on_error(halt(1)))
 4353    ),
 4354    halt(Code).
 $exit_code(Code)
Determine the exit code baed on the on_error and on_warning flags. Also used by qsave_toplevel/0.
 4361'$exit_code'(Code) :-
 4362    (   (   current_prolog_flag(on_error, status),
 4363	    statistics(errors, Count),
 4364	    Count > 0
 4365	;   current_prolog_flag(on_warning, status),
 4366	    statistics(warnings, Count),
 4367	    Count > 0
 4368	)
 4369    ->  Code = 1
 4370    ;   Code = 0
 4371    ).
 at_halt(:Goal)
Register Goal to be called if the system halts.
To be done
- : get location into the error message
 4380:- meta_predicate at_halt(0). 4381:- dynamic        system:term_expansion/2, '$at_halt'/2. 4382:- multifile      system:term_expansion/2, '$at_halt'/2. 4383
 4384system:term_expansion((:- at_halt(Goal)),
 4385		      system:'$at_halt'(Module:Goal, File:Line)) :-
 4386    \+ current_prolog_flag(xref, true),
 4387    source_location(File, Line),
 4388    '$current_source_module'(Module).
 4389
 4390at_halt(Goal) :-
 4391    asserta('$at_halt'(Goal, (-):0)).
 4392
 4393:- public '$run_at_halt'/0. 4394
 4395'$run_at_halt' :-
 4396    forall(clause('$at_halt'(Goal, Src), true, Ref),
 4397	   ( '$call_at_halt'(Goal, Src),
 4398	     erase(Ref)
 4399	   )).
 4400
 4401'$call_at_halt'(Goal, _Src) :-
 4402    catch(Goal, E, true),
 4403    !,
 4404    (   var(E)
 4405    ->  true
 4406    ;   subsumes_term(cancel_halt(_), E)
 4407    ->  '$print_message'(informational, E),
 4408	fail
 4409    ;   '$print_message'(error, E)
 4410    ).
 4411'$call_at_halt'(Goal, _Src) :-
 4412    '$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.
 4420cancel_halt(Reason) :-
 4421    throw(cancel_halt(Reason)).
 prolog:heartbeat
Called every N inferences of the Prolog flag heartbeat is non-zero.
 4428:- multifile prolog:heartbeat/0. 4429
 4430
 4431		/********************************
 4432		*      LOAD OTHER MODULES       *
 4433		*********************************/
 4434
 4435:- meta_predicate
 4436    '$load_wic_files'(:). 4437
 4438'$load_wic_files'(Files) :-
 4439    Files = Module:_,
 4440    '$execute_directive'('$set_source_module'(OldM, Module), [], []),
 4441    '$save_lex_state'(LexState, []),
 4442    '$style_check'(_, 0xC7),                % see style_name/2 in syspred.pl
 4443    '$compilation_mode'(OldC, wic),
 4444    consult(Files),
 4445    '$execute_directive'('$set_source_module'(OldM), [], []),
 4446    '$execute_directive'('$restore_lex_state'(LexState), [], []),
 4447    '$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.
 4455:- public '$load_additional_boot_files'/0. 4456
 4457'$load_additional_boot_files' :-
 4458    current_prolog_flag(argv, Argv),
 4459    '$get_files_argv'(Argv, Files),
 4460    (   Files \== []
 4461    ->  format('Loading additional boot files~n'),
 4462	'$load_wic_files'(user:Files),
 4463	format('additional boot files loaded~n')
 4464    ;   true
 4465    ).
 4466
 4467'$get_files_argv'([], []) :- !.
 4468'$get_files_argv'(['-c'|Files], Files) :- !.
 4469'$get_files_argv'([_|Rest], Files) :-
 4470    '$get_files_argv'(Rest, Files).
 4471
 4472'$:-'(('$boot_message'('Loading Prolog startup files~n', []),
 4473       source_location(File, _Line),
 4474       file_directory_name(File, Dir),
 4475       atom_concat(Dir, '/load.pl', LoadFile),
 4476       '$load_wic_files'(system:[LoadFile]),
 4477       (   current_prolog_flag(windows, true)
 4478       ->  atom_concat(Dir, '/menu.pl', MenuFile),
 4479	   '$load_wic_files'(system:[MenuFile])
 4480       ;   true
 4481       ),
 4482       '$boot_message'('SWI-Prolog boot files loaded~n', []),
 4483       '$compilation_mode'(OldC, wic),
 4484       '$execute_directive'('$set_source_module'(user), [], []),
 4485       '$set_compilation_mode'(OldC)
 4486      ))