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

This implementation is used by reset/3 because the continuation cannot be captured if it contains a such a compiled temporary clause.

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

Note that we can technically also push the entire continuation onto the environment and call it. Doing it incrementally as below exploits last-call optimization and therefore possible quadratic expansion of the continuation.

  631call_continuation([]).
  632call_continuation([TB|Rest]) :-
  633    (   Rest == []
  634    ->  '$call_continuation'(TB)
  635    ;   '$call_continuation'(TB),
  636        call_continuation(Rest)
  637    ).
 catch_with_backtrace(:Goal, ?Ball, :Recover)
As catch/3, but tell library(prolog_stack) to record a backtrace in case of an exception.
  644catch_with_backtrace(Goal, Ball, Recover) :-
  645    catch(Goal, Ball, Recover),
  646    '$no_lco'.
  647
  648'$no_lco'.
 $recover_and_rethrow(:Goal, +Term)
This goal is used to wrap the catch/3 recover handler if the exception is not supposed to be `catchable'. An example of an uncachable exception is '$aborted', used by abort/0. Note that we cut to ensure that the exception is not delayed forever because the recover handler leaves a choicepoint.
  658:- public '$recover_and_rethrow'/2.  659
  660'$recover_and_rethrow'(Goal, Exception) :-
  661    call_cleanup(Goal, throw(Exception)),
  662    !.
 setup_call_cleanup(:Setup, :Goal, :Cleanup)
 setup_call_catcher_cleanup(:Setup, :Goal, +Catcher, :Cleanup)
 call_cleanup(:Goal, :Cleanup)
 call_cleanup(:Goal, +Catcher, :Cleanup)
Call Cleanup once after Goal is finished (deterministic success, failure, exception or cut). The call to '$call_cleanup' is translated to I_CALLCLEANUP. This instruction relies on the exact stack layout left by setup_call_catcher_cleanup/4. Also the predicate name is used by the kernel cleanup mechanism and can only be changed together with the kernel.
  677setup_call_catcher_cleanup(Setup, _Goal, _Catcher, _Cleanup) :-
  678    sig_atomic(Setup),
  679    '$call_cleanup'.
  680
  681setup_call_cleanup(Setup, Goal, Cleanup) :-
  682    setup_call_catcher_cleanup(Setup, Goal, _Catcher, Cleanup).
  683
  684call_cleanup(Goal, Cleanup) :-
  685    setup_call_catcher_cleanup(true, Goal, _Catcher, Cleanup).
  686
  687call_cleanup(Goal, Catcher, Cleanup) :-
  688    setup_call_catcher_cleanup(true, Goal, Catcher, Cleanup).
  689
  690                 /*******************************
  691                 *       INITIALIZATION         *
  692                 *******************************/
  693
  694:- meta_predicate
  695    initialization(0, +).  696
  697:- multifile '$init_goal'/3.  698:- dynamic   '$init_goal'/3.
 initialization(:Goal, +When)
Register Goal to be executed if a saved state is restored. In addition, the goal is executed depending on When:
now
Execute immediately
after_load
Execute after loading the file in which it appears. This is initialization/1.
restore_state
Do not execute immediately, but only when restoring the state. Not allowed in a sandboxed environment.
prepare_state
Called before saving a state. Can be used to clean the environment (see also volatile/1) or eagerly execute goals that are normally executed lazily.
program
Works as -g goal goals.
main
Starts the application. Only last declaration is used.

Note that all goals are executed when a program is restored.

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

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

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

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

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

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