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-2021, 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    '$clausable'(:),
   99    '$iso'(:),
  100    '$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.
  132dynamic(Spec)            :- '$set_pattr'(Spec, pred, dynamic(true)).
  133multifile(Spec)          :- '$set_pattr'(Spec, pred, multifile(true)).
  134module_transparent(Spec) :- '$set_pattr'(Spec, pred, transparent(true)).
  135discontiguous(Spec)      :- '$set_pattr'(Spec, pred, discontiguous(true)).
  136volatile(Spec)           :- '$set_pattr'(Spec, pred, volatile(true)).
  137thread_local(Spec)       :- '$set_pattr'(Spec, pred, thread_local(true)).
  138noprofile(Spec)          :- '$set_pattr'(Spec, pred, noprofile(true)).
  139public(Spec)             :- '$set_pattr'(Spec, pred, public(true)).
  140non_terminal(Spec)       :- '$set_pattr'(Spec, pred, non_terminal(true)).
  141det(Spec)                :- '$set_pattr'(Spec, pred, det(true)).
  142'$iso'(Spec)             :- '$set_pattr'(Spec, pred, iso(true)).
  143'$clausable'(Spec)       :- '$set_pattr'(Spec, pred, clausable(true)).
  144'$hide'(Spec)            :- '$set_pattr'(Spec, pred, trace(false)).
  145
  146'$set_pattr'(M:Pred, How, Attr) :-
  147    '$set_pattr'(Pred, M, How, Attr).
 $set_pattr(+Spec, +Module, +From, +Attr)
Set predicate attributes. From is one of pred or directive.
  153'$set_pattr'(X, _, _, _) :-
  154    var(X),
  155    '$uninstantiation_error'(X).
  156'$set_pattr'(as(Spec,Options), M, How, Attr0) :-
  157    !,
  158    '$attr_options'(Options, Attr0, Attr),
  159    '$set_pattr'(Spec, M, How, Attr).
  160'$set_pattr'([], _, _, _) :- !.
  161'$set_pattr'([H|T], M, How, Attr) :-           % ISO
  162    !,
  163    '$set_pattr'(H, M, How, Attr),
  164    '$set_pattr'(T, M, How, Attr).
  165'$set_pattr'((A,B), M, How, Attr) :-           % ISO and traditional
  166    !,
  167    '$set_pattr'(A, M, How, Attr),
  168    '$set_pattr'(B, M, How, Attr).
  169'$set_pattr'(M:T, _, How, Attr) :-
  170    !,
  171    '$set_pattr'(T, M, How, Attr).
  172'$set_pattr'(PI, M, _, []) :-
  173    !,
  174    '$pi_head'(M:PI, Pred),
  175    '$set_table_wrappers'(Pred).
  176'$set_pattr'(A, M, How, [O|OT]) :-
  177    !,
  178    '$set_pattr'(A, M, How, O),
  179    '$set_pattr'(A, M, How, OT).
  180'$set_pattr'(A, M, pred, Attr) :-
  181    !,
  182    Attr =.. [Name,Val],
  183    '$set_pi_attr'(M:A, Name, Val).
  184'$set_pattr'(A, M, directive, Attr) :-
  185    !,
  186    Attr =.. [Name,Val],
  187    catch('$set_pi_attr'(M:A, Name, Val),
  188          error(E, _),
  189          print_message(error, error(E, context((Name)/1,_)))).
  190
  191'$set_pi_attr'(PI, Name, Val) :-
  192    '$pi_head'(PI, Head),
  193    '$set_predicate_attribute'(Head, Name, Val).
  194
  195'$attr_options'(Var, _, _) :-
  196    var(Var),
  197    !,
  198    '$uninstantiation_error'(Var).
  199'$attr_options'((A,B), Attr0, Attr) :-
  200    !,
  201    '$attr_options'(A, Attr0, Attr1),
  202    '$attr_options'(B, Attr1, Attr).
  203'$attr_options'(Opt, Attr0, Attrs) :-
  204    '$must_be'(ground, Opt),
  205    (   '$attr_option'(Opt, AttrX)
  206    ->  (   is_list(Attr0)
  207        ->  '$join_attrs'(AttrX, Attr0, Attrs)
  208        ;   '$join_attrs'(AttrX, [Attr0], Attrs)
  209        )
  210    ;   '$domain_error'(predicate_option, Opt)
  211    ).
  212
  213'$join_attrs'([], Attrs, Attrs) :-
  214    !.
  215'$join_attrs'([H|T], Attrs0, Attrs) :-
  216    !,
  217    '$join_attrs'(H, Attrs0, Attrs1),
  218    '$join_attrs'(T, Attrs1, Attrs).
  219'$join_attrs'(Attr, Attrs, Attrs) :-
  220    memberchk(Attr, Attrs),
  221    !.
  222'$join_attrs'(Attr, Attrs, Attrs) :-
  223    Attr =.. [Name,Value],
  224    Gen =.. [Name,Existing],
  225    memberchk(Gen, Attrs),
  226    !,
  227    throw(error(conflict_error(Name, Value, Existing), _)).
  228'$join_attrs'(Attr, Attrs0, Attrs) :-
  229    '$append'(Attrs0, [Attr], Attrs).
  230
  231'$attr_option'(incremental, [incremental(true),opaque(false)]).
  232'$attr_option'(monotonic, monotonic(true)).
  233'$attr_option'(lazy, lazy(true)).
  234'$attr_option'(opaque, [incremental(false),opaque(true)]).
  235'$attr_option'(abstract(Level0), abstract(Level)) :-
  236    '$table_option'(Level0, Level).
  237'$attr_option'(subgoal_abstract(Level0), subgoal_abstract(Level)) :-
  238    '$table_option'(Level0, Level).
  239'$attr_option'(answer_abstract(Level0), answer_abstract(Level)) :-
  240    '$table_option'(Level0, Level).
  241'$attr_option'(max_answers(Level0), max_answers(Level)) :-
  242    '$table_option'(Level0, Level).
  243'$attr_option'(volatile, volatile(true)).
  244'$attr_option'(multifile, multifile(true)).
  245'$attr_option'(discontiguous, discontiguous(true)).
  246'$attr_option'(shared, thread_local(false)).
  247'$attr_option'(local, thread_local(true)).
  248'$attr_option'(private, thread_local(true)).
  249
  250'$table_option'(Value0, _Value) :-
  251    var(Value0),
  252    !,
  253    '$instantiation_error'(Value0).
  254'$table_option'(Value0, Value) :-
  255    integer(Value0),
  256    Value0 >= 0,
  257    !,
  258    Value = Value0.
  259'$table_option'(off, -1) :-
  260    !.
  261'$table_option'(false, -1) :-
  262    !.
  263'$table_option'(infinite, -1) :-
  264    !.
  265'$table_option'(Value, _) :-
  266    '$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.
  276'$pattr_directive'(dynamic(Spec), M) :-
  277    '$set_pattr'(Spec, M, directive, dynamic(true)).
  278'$pattr_directive'(multifile(Spec), M) :-
  279    '$set_pattr'(Spec, M, directive, multifile(true)).
  280'$pattr_directive'(module_transparent(Spec), M) :-
  281    '$set_pattr'(Spec, M, directive, transparent(true)).
  282'$pattr_directive'(discontiguous(Spec), M) :-
  283    '$set_pattr'(Spec, M, directive, discontiguous(true)).
  284'$pattr_directive'(volatile(Spec), M) :-
  285    '$set_pattr'(Spec, M, directive, volatile(true)).
  286'$pattr_directive'(thread_local(Spec), M) :-
  287    '$set_pattr'(Spec, M, directive, thread_local(true)).
  288'$pattr_directive'(noprofile(Spec), M) :-
  289    '$set_pattr'(Spec, M, directive, noprofile(true)).
  290'$pattr_directive'(public(Spec), M) :-
  291    '$set_pattr'(Spec, M, directive, public(true)).
  292'$pattr_directive'(det(Spec), M) :-
  293    '$set_pattr'(Spec, M, directive, det(true)).
 $pi_head(?PI, ?Head)
  297'$pi_head'(PI, Head) :-
  298    var(PI),
  299    var(Head),
  300    '$instantiation_error'([PI,Head]).
  301'$pi_head'(M:PI, M:Head) :-
  302    !,
  303    '$pi_head'(PI, Head).
  304'$pi_head'(Name/Arity, Head) :-
  305    !,
  306    '$head_name_arity'(Head, Name, Arity).
  307'$pi_head'(Name//DCGArity, Head) :-
  308    !,
  309    (   nonvar(DCGArity)
  310    ->  Arity is DCGArity+2,
  311        '$head_name_arity'(Head, Name, Arity)
  312    ;   '$head_name_arity'(Head, Name, Arity),
  313        DCGArity is Arity - 2
  314    ).
  315'$pi_head'(PI, _) :-
  316    '$type_error'(predicate_indicator, PI).
 $head_name_arity(+Goal, -Name, -Arity)
$head_name_arity(-Goal, +Name, +Arity)
  321'$head_name_arity'(Goal, Name, Arity) :-
  322    (   atom(Goal)
  323    ->  Name = Goal, Arity = 0
  324    ;   compound(Goal)
  325    ->  compound_name_arity(Goal, Name, Arity)
  326    ;   var(Goal)
  327    ->  (   Arity == 0
  328        ->  (   atom(Name)
  329            ->  Goal = Name
  330            ;   Name == []
  331            ->  Goal = Name
  332            ;   blob(Name, closure)
  333            ->  Goal = Name
  334            ;   '$type_error'(atom, Name)
  335            )
  336        ;   compound_name_arity(Goal, Name, Arity)
  337        )
  338    ;   '$type_error'(callable, Goal)
  339    ).
  340
  341:- '$iso'(((dynamic)/1, (multifile)/1, (discontiguous)/1)).  342
  343
  344                /********************************
  345                *       CALLING, CONTROL        *
  346                *********************************/
  347
  348:- noprofile((call/1,
  349              catch/3,
  350              once/1,
  351              ignore/1,
  352              call_cleanup/2,
  353              call_cleanup/3,
  354              setup_call_cleanup/3,
  355              setup_call_catcher_cleanup/4,
  356              notrace/1)).  357
  358:- meta_predicate
  359    ';'(0,0),
  360    ','(0,0),
  361    @(0,+),
  362    call(0),
  363    call(1,?),
  364    call(2,?,?),
  365    call(3,?,?,?),
  366    call(4,?,?,?,?),
  367    call(5,?,?,?,?,?),
  368    call(6,?,?,?,?,?,?),
  369    call(7,?,?,?,?,?,?,?),
  370    not(0),
  371    \+(0),
  372    $(0),
  373    '->'(0,0),
  374    '*->'(0,0),
  375    once(0),
  376    ignore(0),
  377    catch(0,?,0),
  378    reset(0,?,-),
  379    setup_call_cleanup(0,0,0),
  380    setup_call_catcher_cleanup(0,0,?,0),
  381    call_cleanup(0,0),
  382    call_cleanup(0,?,0),
  383    catch_with_backtrace(0,?,0),
  384    notrace(0),
  385    '$meta_call'(0).  386
  387:- '$iso'((call/1, (\+)/1, once/1, (;)/2, (',')/2, (->)/2, catch/3)).  388
  389% The control structures are always compiled, both   if they appear in a
  390% clause body and if they are handed  to   call/1.  The only way to call
  391% these predicates is by means of  call/2..   In  that case, we call the
  392% hole control structure again to get it compiled by call/1 and properly
  393% deal  with  !,  etc.  Another  reason  for  having  these  things   as
  394% predicates is to be able to define   properties for them, helping code
  395% analyzers.
  396
  397(M0:If ; M0:Then) :- !, call(M0:(If ; Then)).
  398(M1:If ; M2:Then) :-    call(M1:(If ; M2:Then)).
  399(G1   , G2)       :-    call((G1   , G2)).
  400(If  -> Then)     :-    call((If  -> Then)).
  401(If *-> Then)     :-    call((If *-> Then)).
  402@(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.

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

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

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

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

 2002'$record_included'([Parent|Parents], File, Path, Time,
 2003                   message(DoneMsgLevel,
 2004                           include_file(done(Level, file(File, Path))))) :-
 2005    source_location(SrcFile, Line),
 2006    !,
 2007    '$compilation_level'(Level),
 2008    '$load_msg_level'(include_file, Level, StartMsgLevel, DoneMsgLevel),
 2009    '$print_message'(StartMsgLevel,
 2010                     include_file(start(Level,
 2011                                        file(File, Path)))),
 2012    '$last'([Parent|Parents], Owner),
 2013    (   (   '$compilation_mode'(database)
 2014        ;   '$qlf_current_source'(Owner)
 2015        )
 2016    ->  '$store_admin_clause'(
 2017            system:'$included'(Parent, Line, Path, Time),
 2018            _, Owner, SrcFile:Line)
 2019    ;   '$qlf_include'(Owner, Parent, Line, Path, Time)
 2020    ).
 2021'$record_included'(_, _, _, _, true).
 $master_file(+File, -MasterFile)
Find the primary load file from included files.
 2027'$master_file'(File, MasterFile) :-
 2028    '$included'(MasterFile0, _Line, File, _Time),
 2029    !,
 2030    '$master_file'(MasterFile0, MasterFile).
 2031'$master_file'(File, File).
 2032
 2033
 2034'$skip_script_line'(_In, Options) :-
 2035    '$option'(check_script(false), Options),
 2036    !.
 2037'$skip_script_line'(In, _Options) :-
 2038    (   peek_char(In, #)
 2039    ->  skip(In, 10)
 2040    ;   true
 2041    ).
 2042
 2043'$set_encoding'(Stream, Options) :-
 2044    '$option'(encoding(Enc), Options),
 2045    !,
 2046    Enc \== default,
 2047    set_stream(Stream, encoding(Enc)).
 2048'$set_encoding'(_, _).
 2049
 2050
 2051'$prepare_load_stream'(In, Id, state(HasName,HasPos)) :-
 2052    (   stream_property(In, file_name(_))
 2053    ->  HasName = true,
 2054        (   stream_property(In, position(_))
 2055        ->  HasPos = true
 2056        ;   HasPos = false,
 2057            set_stream(In, record_position(true))
 2058        )
 2059    ;   HasName = false,
 2060        set_stream(In, file_name(Id)),
 2061        (   stream_property(In, position(_))
 2062        ->  HasPos = true
 2063        ;   HasPos = false,
 2064            set_stream(In, record_position(true))
 2065        )
 2066    ).
 2067
 2068'$restore_load_stream'(In, _State, Options) :-
 2069    memberchk(close(true), Options),
 2070    !,
 2071    close(In).
 2072'$restore_load_stream'(In, state(HasName, HasPos), _Options) :-
 2073    (   HasName == false
 2074    ->  set_stream(In, file_name(''))
 2075    ;   true
 2076    ),
 2077    (   HasPos == false
 2078    ->  set_stream(In, record_position(false))
 2079    ;   true
 2080    ).
 2081
 2082
 2083                 /*******************************
 2084                 *          DERIVED FILES       *
 2085                 *******************************/
 2086
 2087:- dynamic
 2088    '$derived_source_db'/3.         % Loaded, DerivedFrom, Time
 2089
 2090'$register_derived_source'(_, '-') :- !.
 2091'$register_derived_source'(Loaded, DerivedFrom) :-
 2092    retractall('$derived_source_db'(Loaded, _, _)),
 2093    time_file(DerivedFrom, Time),
 2094    assert('$derived_source_db'(Loaded, DerivedFrom, Time)).
 2095
 2096%       Auto-importing dynamic predicates is not very elegant and
 2097%       leads to problems with qsave_program/[1,2]
 2098
 2099'$derived_source'(Loaded, DerivedFrom, Time) :-
 2100    '$derived_source_db'(Loaded, DerivedFrom, Time).
 2101
 2102
 2103                /********************************
 2104                *       LOAD PREDICATES         *
 2105                *********************************/
 2106
 2107:- meta_predicate
 2108    ensure_loaded(:),
 2109    [:|+],
 2110    consult(:),
 2111    use_module(:),
 2112    use_module(:, +),
 2113    reexport(:),
 2114    reexport(:, +),
 2115    load_files(:),
 2116    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.
 2124ensure_loaded(Files) :-
 2125    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.
 2134use_module(Files) :-
 2135    load_files(Files, [ if(not_loaded),
 2136                        must_be_module(true)
 2137                      ]).
 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.
 2144use_module(File, Import) :-
 2145    load_files(File, [ if(not_loaded),
 2146                       must_be_module(true),
 2147                       imports(Import)
 2148                     ]).
 reexport(+Files)
As use_module/1, exporting all imported predicates.
 2154reexport(Files) :-
 2155    load_files(Files, [ if(not_loaded),
 2156                        must_be_module(true),
 2157                        reexport(true)
 2158                      ]).
 reexport(+File, +ImportList)
As use_module/1, re-exporting all imported predicates.
 2164reexport(File, Import) :-
 2165    load_files(File, [ if(not_loaded),
 2166                       must_be_module(true),
 2167                       imports(Import),
 2168                       reexport(true)
 2169                     ]).
 2170
 2171
 2172[X] :-
 2173    !,
 2174    consult(X).
 2175[M:F|R] :-
 2176    consult(M:[F|R]).
 2177
 2178consult(M:X) :-
 2179    X == user,
 2180    !,
 2181    flag('$user_consult', N, N+1),
 2182    NN is N + 1,
 2183    atom_concat('user://', NN, Id),
 2184    load_files(M:Id, [stream(user_input), check_script(false), silent(false)]).
 2185consult(List) :-
 2186    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.
 2193load_files(Files) :-
 2194    load_files(Files, []).
 2195load_files(Module:Files, Options) :-
 2196    '$must_be'(list, Options),
 2197    '$load_files'(Files, Module, Options).
 2198
 2199'$load_files'(X, _, _) :-
 2200    var(X),
 2201    !,
 2202    '$instantiation_error'(X).
 2203'$load_files'([], _, _) :- !.
 2204'$load_files'(Id, Module, Options) :-   % load_files(foo, [stream(In)])
 2205    '$option'(stream(_), Options),
 2206    !,
 2207    (   atom(Id)
 2208    ->  '$load_file'(Id, Module, Options)
 2209    ;   throw(error(type_error(atom, Id), _))
 2210    ).
 2211'$load_files'(List, Module, Options) :-
 2212    List = [_|_],
 2213    !,
 2214    '$must_be'(list, List),
 2215    '$load_file_list'(List, Module, Options).
 2216'$load_files'(File, Module, Options) :-
 2217    '$load_one_file'(File, Module, Options).
 2218
 2219'$load_file_list'([], _, _).
 2220'$load_file_list'([File|Rest], Module, Options) :-
 2221    E = error(_,_),
 2222    catch('$load_one_file'(File, Module, Options), E,
 2223          '$print_message'(error, E)),
 2224    '$load_file_list'(Rest, Module, Options).
 2225
 2226
 2227'$load_one_file'(Spec, Module, Options) :-
 2228    atomic(Spec),
 2229    '$option'(expand(Expand), Options, false),
 2230    Expand == true,
 2231    !,
 2232    expand_file_name(Spec, Expanded),
 2233    (   Expanded = [Load]
 2234    ->  true
 2235    ;   Load = Expanded
 2236    ),
 2237    '$load_files'(Load, Module, [expand(false)|Options]).
 2238'$load_one_file'(File, Module, Options) :-
 2239    strip_module(Module:File, Into, PlainFile),
 2240    '$load_file'(PlainFile, Into, Options).
 $noload(+Condition, +FullFile, +Options) is semidet
True of FullFile should not be loaded.
 2247'$noload'(true, _, _) :-
 2248    !,
 2249    fail.
 2250'$noload'(_, FullFile, _Options) :-
 2251    '$time_source_file'(FullFile, Time, system),
 2252    Time > 0.0,
 2253    !.
 2254'$noload'(not_loaded, FullFile, _) :-
 2255    source_file(FullFile),
 2256    !.
 2257'$noload'(changed, Derived, _) :-
 2258    '$derived_source'(_FullFile, Derived, LoadTime),
 2259    time_file(Derived, Modified),
 2260    Modified @=< LoadTime,
 2261    !.
 2262'$noload'(changed, FullFile, Options) :-
 2263    '$time_source_file'(FullFile, LoadTime, user),
 2264    '$modified_id'(FullFile, Modified, Options),
 2265    Modified @=< LoadTime,
 2266    !.
 $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.
 2285'$qlf_file'(Spec, _, Spec, stream, Options) :-
 2286    '$option'(stream(_), Options),      % stream: no choice
 2287    !.
 2288'$qlf_file'(Spec, FullFile, FullFile, compile, _) :-
 2289    '$spec_extension'(Spec, Ext),       % user explicitly specified
 2290    user:prolog_file_type(Ext, prolog),
 2291    !.
 2292'$qlf_file'(Spec, FullFile, LoadFile, Mode, Options) :-
 2293    '$compilation_mode'(database),
 2294    file_name_extension(Base, PlExt, FullFile),
 2295    user:prolog_file_type(PlExt, prolog),
 2296    user:prolog_file_type(QlfExt, qlf),
 2297    file_name_extension(Base, QlfExt, QlfFile),
 2298    (   access_file(QlfFile, read),
 2299        (   '$qlf_out_of_date'(FullFile, QlfFile, Why)
 2300        ->  (   access_file(QlfFile, write)
 2301            ->  print_message(informational,
 2302                              qlf(recompile(Spec, FullFile, QlfFile, Why))),
 2303                Mode = qcompile,
 2304                LoadFile = FullFile
 2305            ;   Why == old,
 2306                (   current_prolog_flag(home, PlHome),
 2307                    sub_atom(FullFile, 0, _, _, PlHome)
 2308                ;   sub_atom(QlfFile, 0, _, _, 'res://')
 2309                )
 2310            ->  print_message(silent,
 2311                              qlf(system_lib_out_of_date(Spec, QlfFile))),
 2312                Mode = qload,
 2313                LoadFile = QlfFile
 2314            ;   print_message(warning,
 2315                              qlf(can_not_recompile(Spec, QlfFile, Why))),
 2316                Mode = compile,
 2317                LoadFile = FullFile
 2318            )
 2319        ;   Mode = qload,
 2320            LoadFile = QlfFile
 2321        )
 2322    ->  !
 2323    ;   '$qlf_auto'(FullFile, QlfFile, Options)
 2324    ->  !, Mode = qcompile,
 2325        LoadFile = FullFile
 2326    ).
 2327'$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.
 2335'$qlf_out_of_date'(PlFile, QlfFile, Why) :-
 2336    (   access_file(PlFile, read)
 2337    ->  time_file(PlFile, PlTime),
 2338        time_file(QlfFile, QlfTime),
 2339        (   PlTime > QlfTime
 2340        ->  Why = old                   % PlFile is newer
 2341        ;   Error = error(Formal,_),
 2342            catch('$qlf_info'(QlfFile, _CVer, _MLVer,
 2343                              _FVer, _CSig, _FSig),
 2344                  Error, true),
 2345            nonvar(Formal)              % QlfFile is incompatible
 2346        ->  Why = Error
 2347        ;   fail                        % QlfFile is up-to-date and ok
 2348        )
 2349    ;   fail                            % can not read .pl; try .qlf
 2350    ).
 $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.
 2358:- create_prolog_flag(qcompile, false, [type(atom)]). 2359
 2360'$qlf_auto'(PlFile, QlfFile, Options) :-
 2361    (   memberchk(qcompile(QlfMode), Options)
 2362    ->  true
 2363    ;   current_prolog_flag(qcompile, QlfMode),
 2364        \+ '$in_system_dir'(PlFile)
 2365    ),
 2366    (   QlfMode == auto
 2367    ->  true
 2368    ;   QlfMode == large,
 2369        size_file(PlFile, Size),
 2370        Size > 100000
 2371    ),
 2372    access_file(QlfFile, write).
 2373
 2374'$in_system_dir'(PlFile) :-
 2375    current_prolog_flag(home, Home),
 2376    sub_atom(PlFile, 0, _, _, Home).
 2377
 2378'$spec_extension'(File, Ext) :-
 2379    atom(File),
 2380    file_name_extension(_, Ext, File).
 2381'$spec_extension'(Spec, Ext) :-
 2382    compound(Spec),
 2383    arg(1, Spec, Arg),
 2384    '$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:
 2396:- dynamic
 2397    '$resolved_source_path_db'/3.                % ?Spec, ?Dialect, ?Path
 2398
 2399'$load_file'(File, Module, Options) :-
 2400    '$error_count'(E0, W0),
 2401    '$load_file_e'(File, Module, Options),
 2402    '$error_count'(E1, W1),
 2403    Errors is E1-E0,
 2404    Warnings is W1-W0,
 2405    (   Errors+Warnings =:= 0
 2406    ->  true
 2407    ;   '$print_message'(silent, load_file_errors(File, Errors, Warnings))
 2408    ).
 2409
 2410'$error_count'(Errors, Warnings) :-
 2411    current_prolog_flag(threads, true),
 2412    !,
 2413    thread_self(Me),
 2414    thread_statistics(Me, errors, Errors),
 2415    thread_statistics(Me, warnings, Warnings).
 2416'$error_count'(Errors, Warnings) :-
 2417    statistics(errors, Errors),
 2418    statistics(warnings, Warnings).
 2419
 2420'$load_file_e'(File, Module, Options) :-
 2421    \+ memberchk(stream(_), Options),
 2422    user:prolog_load_file(Module:File, Options),
 2423    !.
 2424'$load_file_e'(File, Module, Options) :-
 2425    memberchk(stream(_), Options),
 2426    !,
 2427    '$assert_load_context_module'(File, Module, Options),
 2428    '$qdo_load_file'(File, File, Module, Options).
 2429'$load_file_e'(File, Module, Options) :-
 2430    (   '$resolved_source_path'(File, FullFile, Options)
 2431    ->  true
 2432    ;   '$resolve_source_path'(File, FullFile, Options)
 2433    ),
 2434    '$mt_load_file'(File, FullFile, Module, Options).
 $resolved_source_path(+File, -FullFile, +Options) is semidet
True when File has already been resolved to an absolute path.
 2440'$resolved_source_path'(File, FullFile, Options) :-
 2441    current_prolog_flag(emulated_dialect, Dialect),
 2442    '$resolved_source_path_db'(File, Dialect, FullFile),
 2443    (   '$source_file_property'(FullFile, from_state, true)
 2444    ;   '$source_file_property'(FullFile, resource, true)
 2445    ;   '$option'(if(If), Options, true),
 2446        '$noload'(If, FullFile, Options)
 2447    ),
 2448    !.
 $resolve_source_path(+File, -FullFile, Options) is det
Resolve a source file specification to an absolute path. May throw existence and other errors.
 2455'$resolve_source_path'(File, FullFile, _Options) :-
 2456    absolute_file_name(File, FullFile,
 2457                       [ file_type(prolog),
 2458                         access(read)
 2459                       ]),
 2460    '$register_resolved_source_path'(File, FullFile).
 2461
 2462
 2463'$register_resolved_source_path'(File, FullFile) :-
 2464    (   compound(File)
 2465    ->  current_prolog_flag(emulated_dialect, Dialect),
 2466        (   '$resolved_source_path_db'(File, Dialect, FullFile)
 2467        ->  true
 2468        ;   asserta('$resolved_source_path_db'(File, Dialect, FullFile))
 2469        )
 2470    ;   true
 2471    ).
 $translated_source(+Old, +New) is det
Called from loading a QLF state when source files are being renamed.
 2477:- public '$translated_source'/2. 2478'$translated_source'(Old, New) :-
 2479    forall(retract('$resolved_source_path_db'(File, Dialect, Old)),
 2480           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.
 2487'$register_resource_file'(FullFile) :-
 2488    (   sub_atom(FullFile, 0, _, _, 'res://'),
 2489        \+ file_name_extension(_, qlf, FullFile)
 2490    ->  '$set_source_file'(FullFile, resource, true)
 2491    ;   true
 2492    ).
 $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.
 2505'$already_loaded'(_File, FullFile, Module, Options) :-
 2506    '$assert_load_context_module'(FullFile, Module, Options),
 2507    '$current_module'(LoadModules, FullFile),
 2508    !,
 2509    (   atom(LoadModules)
 2510    ->  LoadModule = LoadModules
 2511    ;   LoadModules = [LoadModule|_]
 2512    ),
 2513    '$import_from_loaded_module'(LoadModule, Module, Options).
 2514'$already_loaded'(_, _, user, _) :- !.
 2515'$already_loaded'(File, FullFile, Module, Options) :-
 2516    (   '$load_context_module'(FullFile, Module, CtxOptions),
 2517        '$load_ctx_options'(Options, CtxOptions)
 2518    ->  true
 2519    ;   '$load_file'(File, Module, [if(true)|Options])
 2520    ).
 $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.

 2535:- dynamic
 2536    '$loading_file'/3.              % File, Queue, Thread
 2537:- volatile
 2538    '$loading_file'/3. 2539
 2540'$mt_load_file'(File, FullFile, Module, Options) :-
 2541    current_prolog_flag(threads, true),
 2542    !,
 2543    sig_atomic(setup_call_cleanup(
 2544                   with_mutex('$load_file',
 2545                              '$mt_start_load'(FullFile, Loading, Options)),
 2546                   '$mt_do_load'(Loading, File, FullFile, Module, Options),
 2547                   '$mt_end_load'(Loading))).
 2548'$mt_load_file'(File, FullFile, Module, Options) :-
 2549    '$option'(if(If), Options, true),
 2550    '$noload'(If, FullFile, Options),
 2551    !,
 2552    '$already_loaded'(File, FullFile, Module, Options).
 2553'$mt_load_file'(File, FullFile, Module, Options) :-
 2554    sig_atomic('$qdo_load_file'(File, FullFile, Module, Options)).
 2555
 2556'$mt_start_load'(FullFile, queue(Queue), _) :-
 2557    '$loading_file'(FullFile, Queue, LoadThread),
 2558    \+ thread_self(LoadThread),
 2559    !.
 2560'$mt_start_load'(FullFile, already_loaded, Options) :-
 2561    '$option'(if(If), Options, true),
 2562    '$noload'(If, FullFile, Options),
 2563    !.
 2564'$mt_start_load'(FullFile, Ref, _) :-
 2565    thread_self(Me),
 2566    message_queue_create(Queue),
 2567    assertz('$loading_file'(FullFile, Queue, Me), Ref).
 2568
 2569'$mt_do_load'(queue(Queue), File, FullFile, Module, Options) :-
 2570    !,
 2571    catch(thread_get_message(Queue, _), error(_,_), true),
 2572    '$already_loaded'(File, FullFile, Module, Options).
 2573'$mt_do_load'(already_loaded, File, FullFile, Module, Options) :-
 2574    !,
 2575    '$already_loaded'(File, FullFile, Module, Options).
 2576'$mt_do_load'(_Ref, File, FullFile, Module, Options) :-
 2577    '$assert_load_context_module'(FullFile, Module, Options),
 2578    '$qdo_load_file'(File, FullFile, Module, Options).
 2579
 2580'$mt_end_load'(queue(_)) :- !.
 2581'$mt_end_load'(already_loaded) :- !.
 2582'$mt_end_load'(Ref) :-
 2583    clause('$loading_file'(_, Queue, _), _, Ref),
 2584    erase(Ref),
 2585    thread_send_message(Queue, done),
 2586    message_queue_destroy(Queue).
 $qdo_load_file(+Spec, +FullFile, +ContextModule, +Options) is det
Switch to qcompile mode if requested by the option '$qlf'(+Out)
 2593'$qdo_load_file'(File, FullFile, Module, Options) :-
 2594    '$qdo_load_file2'(File, FullFile, Module, Action, Options),
 2595    '$register_resource_file'(FullFile),
 2596    '$run_initialization'(FullFile, Action, Options).
 2597
 2598'$qdo_load_file2'(File, FullFile, Module, Action, Options) :-
 2599    memberchk('$qlf'(QlfOut), Options),
 2600    '$stage_file'(QlfOut, StageQlf),
 2601    !,
 2602    setup_call_catcher_cleanup(
 2603        '$qstart'(StageQlf, Module, State),
 2604        '$do_load_file'(File, FullFile, Module, Action, Options),
 2605        Catcher,
 2606        '$qend'(State, Catcher, StageQlf, QlfOut)).
 2607'$qdo_load_file2'(File, FullFile, Module, Action, Options) :-
 2608    '$do_load_file'(File, FullFile, Module, Action, Options).
 2609
 2610'$qstart'(Qlf, Module, state(OldMode, OldModule)) :-
 2611    '$qlf_open'(Qlf),
 2612    '$compilation_mode'(OldMode, qlf),
 2613    '$set_source_module'(OldModule, Module).
 2614
 2615'$qend'(state(OldMode, OldModule), Catcher, StageQlf, QlfOut) :-
 2616    '$set_source_module'(_, OldModule),
 2617    '$set_compilation_mode'(OldMode),
 2618    '$qlf_close',
 2619    '$install_staged_file'(Catcher, StageQlf, QlfOut, warn).
 2620
 2621'$set_source_module'(OldModule, Module) :-
 2622    '$current_source_module'(OldModule),
 2623    '$set_source_module'(Module).
 $do_load_file(+Spec, +FullFile, +ContextModule, -Action, +Options) is det
Perform the actual loading.
 2630'$do_load_file'(File, FullFile, Module, Action, Options) :-
 2631    '$option'(derived_from(DerivedFrom), Options, -),
 2632    '$register_derived_source'(FullFile, DerivedFrom),
 2633    '$qlf_file'(File, FullFile, Absolute, Mode, Options),
 2634    (   Mode == qcompile
 2635    ->  qcompile(Module:File, Options)
 2636    ;   '$do_load_file_2'(File, Absolute, Module, Action, Options)
 2637    ).
 2638
 2639'$do_load_file_2'(File, Absolute, Module, Action, Options) :-
 2640    '$source_file_property'(Absolute, number_of_clauses, OldClauses),
 2641    statistics(cputime, OldTime),
 2642
 2643    '$setup_load'(ScopedFlags, OldSandBoxed, OldVerbose, OldAutoLevel, OldXRef,
 2644                  Options),
 2645
 2646    '$compilation_level'(Level),
 2647    '$load_msg_level'(load_file, Level, StartMsgLevel, DoneMsgLevel),
 2648    '$print_message'(StartMsgLevel,
 2649                     load_file(start(Level,
 2650                                     file(File, Absolute)))),
 2651
 2652    (   memberchk(stream(FromStream), Options)
 2653    ->  Input = stream
 2654    ;   Input = source
 2655    ),
 2656
 2657    (   Input == stream,
 2658        (   '$option'(format(qlf), Options, source)
 2659        ->  set_stream(FromStream, file_name(Absolute)),
 2660            '$qload_stream'(FromStream, Module, Action, LM, Options)
 2661        ;   '$consult_file'(stream(Absolute, FromStream, []),
 2662                            Module, Action, LM, Options)
 2663        )
 2664    ->  true
 2665    ;   Input == source,
 2666        file_name_extension(_, Ext, Absolute),
 2667        (   user:prolog_file_type(Ext, qlf),
 2668            E = error(_,_),
 2669            catch('$qload_file'(Absolute, Module, Action, LM, Options),
 2670                  E,
 2671                  print_message(warning, E))
 2672        ->  true
 2673        ;   '$consult_file'(Absolute, Module, Action, LM, Options)
 2674        )
 2675    ->  true
 2676    ;   '$print_message'(error, load_file(failed(File))),
 2677        fail
 2678    ),
 2679
 2680    '$import_from_loaded_module'(LM, Module, Options),
 2681
 2682    '$source_file_property'(Absolute, number_of_clauses, NewClauses),
 2683    statistics(cputime, Time),
 2684    ClausesCreated is NewClauses - OldClauses,
 2685    TimeUsed is Time - OldTime,
 2686
 2687    '$print_message'(DoneMsgLevel,
 2688                     load_file(done(Level,
 2689                                    file(File, Absolute),
 2690                                    Action,
 2691                                    LM,
 2692                                    TimeUsed,
 2693                                    ClausesCreated))),
 2694
 2695    '$restore_load'(ScopedFlags, OldSandBoxed, OldVerbose, OldAutoLevel, OldXRef).
 2696
 2697'$setup_load'(ScopedFlags, OldSandBoxed, OldVerbose, OldAutoLevel, OldXRef,
 2698              Options) :-
 2699    '$save_file_scoped_flags'(ScopedFlags),
 2700    '$set_sandboxed_load'(Options, OldSandBoxed),
 2701    '$set_verbose_load'(Options, OldVerbose),
 2702    '$set_optimise_load'(Options),
 2703    '$update_autoload_level'(Options, OldAutoLevel),
 2704    '$set_no_xref'(OldXRef).
 2705
 2706'$restore_load'(ScopedFlags, OldSandBoxed, OldVerbose, OldAutoLevel, OldXRef) :-
 2707    '$set_autoload_level'(OldAutoLevel),
 2708    set_prolog_flag(xref, OldXRef),
 2709    set_prolog_flag(verbose_load, OldVerbose),
 2710    set_prolog_flag(sandboxed_load, OldSandBoxed),
 2711    '$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.
 2719'$save_file_scoped_flags'(State) :-
 2720    current_predicate(findall/3),          % Not when doing boot compile
 2721    !,
 2722    findall(SavedFlag, '$save_file_scoped_flag'(SavedFlag), State).
 2723'$save_file_scoped_flags'([]).
 2724
 2725'$save_file_scoped_flag'(Flag-Value) :-
 2726    '$file_scoped_flag'(Flag, Default),
 2727    (   current_prolog_flag(Flag, Value)
 2728    ->  true
 2729    ;   Value = Default
 2730    ).
 2731
 2732'$file_scoped_flag'(generate_debug_info, true).
 2733'$file_scoped_flag'(optimise,            false).
 2734'$file_scoped_flag'(xref,                false).
 2735
 2736'$restore_file_scoped_flags'([]).
 2737'$restore_file_scoped_flags'([Flag-Value|T]) :-
 2738    set_prolog_flag(Flag, Value),
 2739    '$restore_file_scoped_flags'(T).
 $import_from_loaded_module(+LoadedModule, +Module, +Options) is det
Import public predicates from LoadedModule into Module
 2746'$import_from_loaded_module'(LoadedModule, Module, Options) :-
 2747    LoadedModule \== Module,
 2748    atom(LoadedModule),
 2749    !,
 2750    '$option'(imports(Import), Options, all),
 2751    '$option'(reexport(Reexport), Options, false),
 2752    '$import_list'(Module, LoadedModule, Import, Reexport).
 2753'$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.
 2761'$set_verbose_load'(Options, Old) :-
 2762    current_prolog_flag(verbose_load, Old),
 2763    (   memberchk(silent(Silent), Options)
 2764    ->  (   '$negate'(Silent, Level0)
 2765        ->  '$load_msg_compat'(Level0, Level)
 2766        ;   Level = Silent
 2767        ),
 2768        set_prolog_flag(verbose_load, Level)
 2769    ;   true
 2770    ).
 2771
 2772'$negate'(true, false).
 2773'$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, -)
 2782'$set_sandboxed_load'(Options, Old) :-
 2783    current_prolog_flag(sandboxed_load, Old),
 2784    (   memberchk(sandboxed(SandBoxed), Options),
 2785        '$enter_sandboxed'(Old, SandBoxed, New),
 2786        New \== Old
 2787    ->  set_prolog_flag(sandboxed_load, New)
 2788    ;   true
 2789    ).
 2790
 2791'$enter_sandboxed'(Old, New, SandBoxed) :-
 2792    (   Old == false, New == true
 2793    ->  SandBoxed = true,
 2794        '$ensure_loaded_library_sandbox'
 2795    ;   Old == true, New == false
 2796    ->  throw(error(permission_error(leave, sandbox, -), _))
 2797    ;   SandBoxed = Old
 2798    ).
 2799'$enter_sandboxed'(false, true, true).
 2800
 2801'$ensure_loaded_library_sandbox' :-
 2802    source_file_property(library(sandbox), module(sandbox)),
 2803    !.
 2804'$ensure_loaded_library_sandbox' :-
 2805    load_files(library(sandbox), [if(not_loaded), silent(true)]).
 2806
 2807'$set_optimise_load'(Options) :-
 2808    (   '$option'(optimise(Optimise), Options)
 2809    ->  set_prolog_flag(optimise, Optimise)
 2810    ;   true
 2811    ).
 2812
 2813'$set_no_xref'(OldXRef) :-
 2814    (   current_prolog_flag(xref, OldXRef)
 2815    ->  true
 2816    ;   OldXRef = false
 2817    ),
 2818    set_prolog_flag(xref, false).
 $update_autoload_level(+Options, -OldLevel)
Update the '$autoload_nesting' and return the old value.
 2825:- thread_local
 2826    '$autoload_nesting'/1. 2827
 2828'$update_autoload_level'(Options, AutoLevel) :-
 2829    '$option'(autoload(Autoload), Options, false),
 2830    (   '$autoload_nesting'(CurrentLevel)
 2831    ->  AutoLevel = CurrentLevel
 2832    ;   AutoLevel = 0
 2833    ),
 2834    (   Autoload == false
 2835    ->  true
 2836    ;   NewLevel is AutoLevel + 1,
 2837        '$set_autoload_level'(NewLevel)
 2838    ).
 2839
 2840'$set_autoload_level'(New) :-
 2841    retractall('$autoload_nesting'(_)),
 2842    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.
 2850'$print_message'(Level, Term) :-
 2851    current_predicate(system:print_message/2),
 2852    !,
 2853    print_message(Level, Term).
 2854'$print_message'(warning, Term) :-
 2855    source_location(File, Line),
 2856    !,
 2857    format(user_error, 'WARNING: ~w:~w: ~p~n', [File, Line, Term]).
 2858'$print_message'(error, Term) :-
 2859    !,
 2860    source_location(File, Line),
 2861    !,
 2862    format(user_error, 'ERROR: ~w:~w: ~p~n', [File, Line, Term]).
 2863'$print_message'(_Level, _Term).
 2864
 2865'$print_message_fail'(E) :-
 2866    '$print_message'(error, E),
 2867    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.
 2875'$consult_file'(Absolute, Module, What, LM, Options) :-
 2876    '$current_source_module'(Module),   % same module
 2877    !,
 2878    '$consult_file_2'(Absolute, Module, What, LM, Options).
 2879'$consult_file'(Absolute, Module, What, LM, Options) :-
 2880    '$set_source_module'(OldModule, Module),
 2881    '$ifcompiling'('$qlf_start_sub_module'(Module)),
 2882    '$consult_file_2'(Absolute, Module, What, LM, Options),
 2883    '$ifcompiling'('$qlf_end_part'),
 2884    '$set_source_module'(OldModule).
 2885
 2886'$consult_file_2'(Absolute, Module, What, LM, Options) :-
 2887    '$set_source_module'(OldModule, Module),
 2888    '$load_id'(Absolute, Id, Modified, Options),
 2889    '$compile_type'(What),
 2890    '$save_lex_state'(LexState, Options),
 2891    '$set_dialect'(Options),
 2892    setup_call_cleanup(
 2893        '$start_consult'(Id, Modified),
 2894        '$load_file'(Absolute, Id, LM, Options),
 2895        '$end_consult'(Id, LexState, OldModule)).
 2896
 2897'$end_consult'(Id, LexState, OldModule) :-
 2898    '$end_consult'(Id),
 2899    '$restore_lex_state'(LexState),
 2900    '$set_source_module'(OldModule).
 2901
 2902
 2903:- create_prolog_flag(emulated_dialect, swi, [type(atom)]).
 $save_lex_state(-LexState, +Options) is det
 2907'$save_lex_state'(State, Options) :-
 2908    memberchk(scope_settings(false), Options),
 2909    !,
 2910    State = (-).
 2911'$save_lex_state'(lexstate(Style, Dialect), _) :-
 2912    '$style_check'(Style, Style),
 2913    current_prolog_flag(emulated_dialect, Dialect).
 2914
 2915'$restore_lex_state'(-) :- !.
 2916'$restore_lex_state'(lexstate(Style, Dialect)) :-
 2917    '$style_check'(_, Style),
 2918    set_prolog_flag(emulated_dialect, Dialect).
 2919
 2920'$set_dialect'(Options) :-
 2921    memberchk(dialect(Dialect), Options),
 2922    !,
 2923    '$expects_dialect'(Dialect).
 2924'$set_dialect'(_).
 2925
 2926'$load_id'(stream(Id, _, _), Id, Modified, Options) :-
 2927    !,
 2928    '$modified_id'(Id, Modified, Options).
 2929'$load_id'(Id, Id, Modified, Options) :-
 2930    '$modified_id'(Id, Modified, Options).
 2931
 2932'$modified_id'(_, Modified, Options) :-
 2933    '$option'(modified(Stamp), Options, Def),
 2934    Stamp \== Def,
 2935    !,
 2936    Modified = Stamp.
 2937'$modified_id'(Id, Modified, _) :-
 2938    catch(time_file(Id, Modified),
 2939          error(_, _),
 2940          fail),
 2941    !.
 2942'$modified_id'(_, 0.0, _).
 2943
 2944
 2945'$compile_type'(What) :-
 2946    '$compilation_mode'(How),
 2947    (   How == database
 2948    ->  What = compiled
 2949    ;   How == qlf
 2950    ->  What = '*qcompiled*'
 2951    ;   What = 'boot compiled'
 2952    ).
 $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.
 2962:- dynamic
 2963    '$load_context_module'/3. 2964:- multifile
 2965    '$load_context_module'/3. 2966
 2967'$assert_load_context_module'(_, _, Options) :-
 2968    memberchk(register(false), Options),
 2969    !.
 2970'$assert_load_context_module'(File, Module, Options) :-
 2971    source_location(FromFile, Line),
 2972    !,
 2973    '$master_file'(FromFile, MasterFile),
 2974    '$check_load_non_module'(File, Module),
 2975    '$add_dialect'(Options, Options1),
 2976    '$load_ctx_options'(Options1, Options2),
 2977    '$store_admin_clause'(
 2978        system:'$load_context_module'(File, Module, Options2),
 2979        _Layout, MasterFile, FromFile:Line).
 2980'$assert_load_context_module'(File, Module, Options) :-
 2981    '$check_load_non_module'(File, Module),
 2982    '$add_dialect'(Options, Options1),
 2983    '$load_ctx_options'(Options1, Options2),
 2984    (   clause('$load_context_module'(File, Module, _), true, Ref),
 2985        \+ clause_property(Ref, file(_)),
 2986        erase(Ref)
 2987    ->  true
 2988    ;   true
 2989    ),
 2990    assertz('$load_context_module'(File, Module, Options2)).
 2991
 2992'$add_dialect'(Options0, Options) :-
 2993    current_prolog_flag(emulated_dialect, Dialect), Dialect \== swi,
 2994    !,
 2995    Options = [dialect(Dialect)|Options0].
 2996'$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.
 3003'$load_ctx_options'(Options, CtxOptions) :-
 3004    '$load_ctx_options2'(Options, CtxOptions0),
 3005    sort(CtxOptions0, CtxOptions).
 3006
 3007'$load_ctx_options2'([], []).
 3008'$load_ctx_options2'([H|T0], [H|T]) :-
 3009    '$load_ctx_option'(H),
 3010    !,
 3011    '$load_ctx_options2'(T0, T).
 3012'$load_ctx_options2'([_|T0], T) :-
 3013    '$load_ctx_options2'(T0, T).
 3014
 3015'$load_ctx_option'(derived_from(_)).
 3016'$load_ctx_option'(dialect(_)).
 3017'$load_ctx_option'(encoding(_)).
 3018'$load_ctx_option'(imports(_)).
 3019'$load_ctx_option'(reexport(_)).
 $check_load_non_module(+File) is det
Test that a non-module file is not loaded into multiple contexts.
 3027'$check_load_non_module'(File, _) :-
 3028    '$current_module'(_, File),
 3029    !.          % File is a module file
 3030'$check_load_non_module'(File, Module) :-
 3031    '$load_context_module'(File, OldModule, _),
 3032    Module \== OldModule,
 3033    !,
 3034    format(atom(Msg),
 3035           'Non-module file already loaded into module ~w; \c
 3036               trying to load into ~w',
 3037           [OldModule, Module]),
 3038    throw(error(permission_error(load, source, File),
 3039                context(load_files/2, Msg))).
 3040'$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)

 3053'$load_file'(Path, Id, Module, Options) :-
 3054    State = state(true, _, true, false, Id, -),
 3055    (   '$source_term'(Path, _Read, _Layout, Term, Layout,
 3056                       _Stream, Options),
 3057        '$valid_term'(Term),
 3058        (   arg(1, State, true)
 3059        ->  '$first_term'(Term, Layout, Id, State, Options),
 3060            nb_setarg(1, State, false)
 3061        ;   '$compile_term'(Term, Layout, Id)
 3062        ),
 3063        arg(4, State, true)
 3064    ;   '$fixup_reconsult'(Id),
 3065        '$end_load_file'(State)
 3066    ),
 3067    !,
 3068    arg(2, State, Module).
 3069
 3070'$valid_term'(Var) :-
 3071    var(Var),
 3072    !,
 3073    print_message(error, error(instantiation_error, _)).
 3074'$valid_term'(Term) :-
 3075    Term \== [].
 3076
 3077'$end_load_file'(State) :-
 3078    arg(1, State, true),           % empty file
 3079    !,
 3080    nb_setarg(2, State, Module),
 3081    arg(5, State, Id),
 3082    '$current_source_module'(Module),
 3083    '$ifcompiling'('$qlf_start_file'(Id)),
 3084    '$ifcompiling'('$qlf_end_part').
 3085'$end_load_file'(State) :-
 3086    arg(3, State, End),
 3087    '$end_load_file'(End, State).
 3088
 3089'$end_load_file'(true, _).
 3090'$end_load_file'(end_module, State) :-
 3091    arg(2, State, Module),
 3092    '$check_export'(Module),
 3093    '$ifcompiling'('$qlf_end_part').
 3094'$end_load_file'(end_non_module, _State) :-
 3095    '$ifcompiling'('$qlf_end_part').
 3096
 3097
 3098'$first_term'(?-(Directive), Layout, Id, State, Options) :-
 3099    !,
 3100    '$first_term'(:-(Directive), Layout, Id, State, Options).
 3101'$first_term'(:-(Directive), _Layout, Id, State, Options) :-
 3102    nonvar(Directive),
 3103    (   (   Directive = module(Name, Public)
 3104        ->  Imports = []
 3105        ;   Directive = module(Name, Public, Imports)
 3106        )
 3107    ->  !,
 3108        '$module_name'(Name, Id, Module, Options),
 3109        '$start_module'(Module, Public, State, Options),
 3110        '$module3'(Imports)
 3111    ;   Directive = expects_dialect(Dialect)
 3112    ->  !,
 3113        '$set_dialect'(Dialect, State),
 3114        fail                        % Still consider next term as first
 3115    ).
 3116'$first_term'(Term, Layout, Id, State, Options) :-
 3117    '$start_non_module'(Id, Term, State, Options),
 3118    '$compile_term'(Term, Layout, Id).
 3119
 3120'$compile_term'(Term, Layout, Id) :-
 3121    '$compile_term'(Term, Layout, Id, -).
 3122
 3123'$compile_term'(Var, _Layout, _Id, _Src) :-
 3124    var(Var),
 3125    !,
 3126    '$instantiation_error'(Var).
 3127'$compile_term'((?-Directive), _Layout, Id, _) :-
 3128    !,
 3129    '$execute_directive'(Directive, Id).
 3130'$compile_term'((:-Directive), _Layout, Id, _) :-
 3131    !,
 3132    '$execute_directive'(Directive, Id).
 3133'$compile_term'('$source_location'(File, Line):Term, Layout, Id, _) :-
 3134    !,
 3135    '$compile_term'(Term, Layout, Id, File:Line).
 3136'$compile_term'(Clause, Layout, Id, SrcLoc) :-
 3137    E = error(_,_),
 3138    catch('$store_clause'(Clause, Layout, Id, SrcLoc), E,
 3139          '$print_message'(error, E)).
 3140
 3141'$start_non_module'(_Id, Term, _State, Options) :-
 3142    '$option'(must_be_module(true), Options, false),
 3143    !,
 3144    '$domain_error'(module_header, Term).
 3145'$start_non_module'(Id, _Term, State, _Options) :-
 3146    '$current_source_module'(Module),
 3147    '$ifcompiling'('$qlf_start_file'(Id)),
 3148    '$qset_dialect'(State),
 3149    nb_setarg(2, State, Module),
 3150    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.

 3163'$set_dialect'(Dialect, State) :-
 3164    '$compilation_mode'(qlf, database),
 3165    !,
 3166    '$expects_dialect'(Dialect),
 3167    '$compilation_mode'(_, qlf),
 3168    nb_setarg(6, State, Dialect).
 3169'$set_dialect'(Dialect, _) :-
 3170    '$expects_dialect'(Dialect).
 3171
 3172'$qset_dialect'(State) :-
 3173    '$compilation_mode'(qlf),
 3174    arg(6, State, Dialect), Dialect \== (-),
 3175    !,
 3176    '$add_directive_wic'('$expects_dialect'(Dialect)).
 3177'$qset_dialect'(_).
 3178
 3179'$expects_dialect'(Dialect) :-
 3180    Dialect == swi,
 3181    !,
 3182    set_prolog_flag(emulated_dialect, Dialect).
 3183'$expects_dialect'(Dialect) :-
 3184    current_predicate(expects_dialect/1),
 3185    !,
 3186    expects_dialect(Dialect).
 3187'$expects_dialect'(Dialect) :-
 3188    use_module(library(dialect), [expects_dialect/1]),
 3189    expects_dialect(Dialect).
 3190
 3191
 3192                 /*******************************
 3193                 *           MODULES            *
 3194                 *******************************/
 3195
 3196'$start_module'(Module, _Public, State, _Options) :-
 3197    '$current_module'(Module, OldFile),
 3198    source_location(File, _Line),
 3199    OldFile \== File, OldFile \== [],
 3200    same_file(OldFile, File),
 3201    !,
 3202    nb_setarg(2, State, Module),
 3203    nb_setarg(4, State, true).      % Stop processing
 3204'$start_module'(Module, Public, State, Options) :-
 3205    arg(5, State, File),
 3206    nb_setarg(2, State, Module),
 3207    source_location(_File, Line),
 3208    '$option'(redefine_module(Action), Options, false),
 3209    '$module_class'(File, Class, Super),
 3210    '$reset_dialect'(File, Class),
 3211    '$redefine_module'(Module, File, Action),
 3212    '$declare_module'(Module, Class, Super, File, Line, false),
 3213    '$export_list'(Public, Module, Ops),
 3214    '$ifcompiling'('$qlf_start_module'(Module)),
 3215    '$export_ops'(Ops, Module, File),
 3216    '$qset_dialect'(State),
 3217    nb_setarg(3, State, end_module).
 $reset_dialect(+File, +Class) is det
Load .pl files from the SWI-Prolog distribution always in swi dialect.
 3224'$reset_dialect'(File, library) :-
 3225    file_name_extension(_, pl, File),
 3226    !,
 3227    set_prolog_flag(emulated_dialect, swi).
 3228'$reset_dialect'(_, _).
 $module3(+Spec) is det
Handle the 3th argument of a module declartion.
 3235'$module3'(Var) :-
 3236    var(Var),
 3237    !,
 3238    '$instantiation_error'(Var).
 3239'$module3'([]) :- !.
 3240'$module3'([H|T]) :-
 3241    !,
 3242    '$module3'(H),
 3243    '$module3'(T).
 3244'$module3'(Id) :-
 3245    use_module(library(dialect/Id)).
 $module_name(?Name, +Id, -Module, +Options) is semidet
Determine the module name. There are some cases:
 3259'$module_name'(_, _, Module, Options) :-
 3260    '$option'(module(Module), Options),
 3261    !,
 3262    '$current_source_module'(Context),
 3263    Context \== Module.                     % cause '$first_term'/5 to fail.
 3264'$module_name'(Var, Id, Module, Options) :-
 3265    var(Var),
 3266    !,
 3267    file_base_name(Id, File),
 3268    file_name_extension(Var, _, File),
 3269    '$module_name'(Var, Id, Module, Options).
 3270'$module_name'(Reserved, _, _, _) :-
 3271    '$reserved_module'(Reserved),
 3272    !,
 3273    throw(error(permission_error(load, module, Reserved), _)).
 3274'$module_name'(Module, _Id, Module, _).
 3275
 3276
 3277'$reserved_module'(system).
 3278'$reserved_module'(user).
 $redefine_module(+Module, +File, -Redefine)
 3283'$redefine_module'(_Module, _, false) :- !.
 3284'$redefine_module'(Module, File, true) :-
 3285    !,
 3286    (   module_property(Module, file(OldFile)),
 3287        File \== OldFile
 3288    ->  unload_file(OldFile)
 3289    ;   true
 3290    ).
 3291'$redefine_module'(Module, File, ask) :-
 3292    (   stream_property(user_input, tty(true)),
 3293        module_property(Module, file(OldFile)),
 3294        File \== OldFile,
 3295        '$rdef_response'(Module, OldFile, File, true)
 3296    ->  '$redefine_module'(Module, File, true)
 3297    ;   true
 3298    ).
 3299
 3300'$rdef_response'(Module, OldFile, File, Ok) :-
 3301    repeat,
 3302    print_message(query, redefine_module(Module, OldFile, File)),
 3303    get_single_char(Char),
 3304    '$rdef_response'(Char, Ok0),
 3305    !,
 3306    Ok = Ok0.
 3307
 3308'$rdef_response'(Char, true) :-
 3309    memberchk(Char, `yY`),
 3310    format(user_error, 'yes~n', []).
 3311'$rdef_response'(Char, false) :-
 3312    memberchk(Char, `nN`),
 3313    format(user_error, 'no~n', []).
 3314'$rdef_response'(Char, _) :-
 3315    memberchk(Char, `a`),
 3316    format(user_error, 'abort~n', []),
 3317    abort.
 3318'$rdef_response'(_, _) :-
 3319    print_message(help, redefine_module_reply),
 3320    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.
 3330'$module_class'(File, Class, system) :-
 3331    current_prolog_flag(home, Home),
 3332    sub_atom(File, 0, Len, _, Home),
 3333    (   sub_atom(File, Len, _, _, '/boot/')
 3334    ->  Class = system
 3335    ;   '$lib_prefix'(Prefix),
 3336        sub_atom(File, Len, _, _, Prefix)
 3337    ->  Class = library
 3338    ;   file_directory_name(File, Home),
 3339        file_name_extension(_, rc, File)
 3340    ->  Class = library
 3341    ),
 3342    !.
 3343'$module_class'(_, user, user).
 3344
 3345'$lib_prefix'('/library').
 3346'$lib_prefix'('/xpce/prolog/').
 3347
 3348'$check_export'(Module) :-
 3349    '$undefined_export'(Module, UndefList),
 3350    (   '$member'(Undef, UndefList),
 3351        strip_module(Undef, _, Local),
 3352        print_message(error,
 3353                      undefined_export(Module, Local)),
 3354        fail
 3355    ;   true
 3356    ).
 $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).
 3365'$import_list'(_, _, Var, _) :-
 3366    var(Var),
 3367    !,
 3368    throw(error(instantitation_error, _)).
 3369'$import_list'(Target, Source, all, Reexport) :-
 3370    !,
 3371    '$exported_ops'(Source, Import, Predicates),
 3372    '$module_property'(Source, exports(Predicates)),
 3373    '$import_all'(Import, Target, Source, Reexport, weak).
 3374'$import_list'(Target, Source, except(Spec), Reexport) :-
 3375    !,
 3376    '$exported_ops'(Source, Export, Predicates),
 3377    '$module_property'(Source, exports(Predicates)),
 3378    (   is_list(Spec)
 3379    ->  true
 3380    ;   throw(error(type_error(list, Spec), _))
 3381    ),
 3382    '$import_except'(Spec, Export, Import),
 3383    '$import_all'(Import, Target, Source, Reexport, weak).
 3384'$import_list'(Target, Source, Import, Reexport) :-
 3385    !,
 3386    is_list(Import),
 3387    !,
 3388    '$import_all'(Import, Target, Source, Reexport, strong).
 3389'$import_list'(_, _, Import, _) :-
 3390    throw(error(type_error(import_specifier, Import))).
 3391
 3392
 3393'$import_except'([], List, List).
 3394'$import_except'([H|T], List0, List) :-
 3395    '$import_except_1'(H, List0, List1),
 3396    '$import_except'(T, List1, List).
 3397
 3398'$import_except_1'(Var, _, _) :-
 3399    var(Var),
 3400    !,
 3401    throw(error(instantitation_error, _)).
 3402'$import_except_1'(PI as N, List0, List) :-
 3403    '$pi'(PI), atom(N),
 3404    !,
 3405    '$canonical_pi'(PI, CPI),
 3406    '$import_as'(CPI, N, List0, List).
 3407'$import_except_1'(op(P,A,N), List0, List) :-
 3408    !,
 3409    '$remove_ops'(List0, op(P,A,N), List).
 3410'$import_except_1'(PI, List0, List) :-
 3411    '$pi'(PI),
 3412    !,
 3413    '$canonical_pi'(PI, CPI),
 3414    '$select'(P, List0, List),
 3415    '$canonical_pi'(CPI, P),
 3416    !.
 3417'$import_except_1'(Except, _, _) :-
 3418    throw(error(type_error(import_specifier, Except), _)).
 3419
 3420'$import_as'(CPI, N, [PI2|T], [CPI as N|T]) :-
 3421    '$canonical_pi'(PI2, CPI),
 3422    !.
 3423'$import_as'(PI, N, [H|T0], [H|T]) :-
 3424    !,
 3425    '$import_as'(PI, N, T0, T).
 3426'$import_as'(PI, _, _, _) :-
 3427    throw(error(existence_error(export, PI), _)).
 3428
 3429'$pi'(N/A) :- atom(N), integer(A), !.
 3430'$pi'(N//A) :- atom(N), integer(A).
 3431
 3432'$canonical_pi'(N//A0, N/A) :-
 3433    A is A0 + 2.
 3434'$canonical_pi'(PI, PI).
 3435
 3436'$remove_ops'([], _, []).
 3437'$remove_ops'([Op|T0], Pattern, T) :-
 3438    subsumes_term(Pattern, Op),
 3439    !,
 3440    '$remove_ops'(T0, Pattern, T).
 3441'$remove_ops'([H|T0], Pattern, [H|T]) :-
 3442    '$remove_ops'(T0, Pattern, T).
 $import_all(+Import, +Context, +Source, +Reexport, +Strength)
 3447'$import_all'(Import, Context, Source, Reexport, Strength) :-
 3448    '$import_all2'(Import, Context, Source, Imported, ImpOps, Strength),
 3449    (   Reexport == true,
 3450        (   '$list_to_conj'(Imported, Conj)
 3451        ->  export(Context:Conj),
 3452            '$ifcompiling'('$add_directive_wic'(export(Context:Conj)))
 3453        ;   true
 3454        ),
 3455        source_location(File, _Line),
 3456        '$export_ops'(ImpOps, Context, File)
 3457    ;   true
 3458    ).
 $import_all2(+Imports, +Context, +Source, -Imported, -ImpOps, +Strength)
 3462'$import_all2'([], _, _, [], [], _).
 3463'$import_all2'([PI as NewName|Rest], Context, Source,
 3464               [NewName/Arity|Imported], ImpOps, Strength) :-
 3465    !,
 3466    '$canonical_pi'(PI, Name/Arity),
 3467    length(Args, Arity),
 3468    Head =.. [Name|Args],
 3469    NewHead =.. [NewName|Args],
 3470    (   '$get_predicate_attribute'(Source:Head, transparent, 1)
 3471    ->  '$set_predicate_attribute'(Context:NewHead, transparent, true)
 3472    ;   true
 3473    ),
 3474    (   source_location(File, Line)
 3475    ->  E = error(_,_),
 3476        catch('$store_admin_clause'((NewHead :- Source:Head),
 3477                                    _Layout, File, File:Line),
 3478              E, '$print_message'(error, E))
 3479    ;   assertz((NewHead :- !, Source:Head)) % ! avoids problems with
 3480    ),                                       % duplicate load
 3481    '$import_all2'(Rest, Context, Source, Imported, ImpOps, Strength).
 3482'$import_all2'([op(P,A,N)|Rest], Context, Source, Imported,
 3483               [op(P,A,N)|ImpOps], Strength) :-
 3484    !,
 3485    '$import_ops'(Context, Source, op(P,A,N)),
 3486    '$import_all2'(Rest, Context, Source, Imported, ImpOps, Strength).
 3487'$import_all2'([Pred|Rest], Context, Source, [Pred|Imported], ImpOps, Strength) :-
 3488    Error = error(_,_),
 3489    catch(Context:'$import'(Source:Pred, Strength), Error,
 3490          print_message(error, Error)),
 3491    '$ifcompiling'('$import_wic'(Source, Pred, Strength)),
 3492    '$import_all2'(Rest, Context, Source, Imported, ImpOps, Strength).
 3493
 3494
 3495'$list_to_conj'([One], One) :- !.
 3496'$list_to_conj'([H|T], (H,Rest)) :-
 3497    '$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.
 3504'$exported_ops'(Module, Ops, Tail) :-
 3505    '$c_current_predicate'(_, Module:'$exported_op'(_,_,_)),
 3506    !,
 3507    findall(op(P,A,N), Module:'$exported_op'(P,A,N), Ops, Tail).
 3508'$exported_ops'(_, Ops, Ops).
 3509
 3510'$exported_op'(Module, P, A, N) :-
 3511    '$c_current_predicate'(_, Module:'$exported_op'(_,_,_)),
 3512    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.
 3519'$import_ops'(To, From, Pattern) :-
 3520    ground(Pattern),
 3521    !,
 3522    Pattern = op(P,A,N),
 3523    op(P,A,To:N),
 3524    (   '$exported_op'(From, P, A, N)
 3525    ->  true
 3526    ;   print_message(warning, no_exported_op(From, Pattern))
 3527    ).
 3528'$import_ops'(To, From, Pattern) :-
 3529    (   '$exported_op'(From, Pri, Assoc, Name),
 3530        Pattern = op(Pri, Assoc, Name),
 3531        op(Pri, Assoc, To:Name),
 3532        fail
 3533    ;   true
 3534    ).
 $export_list(+Declarations, +Module, -Ops)
Handle the export list of the module declaration for Module associated to File.
 3542'$export_list'(Decls, Module, Ops) :-
 3543    is_list(Decls),
 3544    !,
 3545    '$do_export_list'(Decls, Module, Ops).
 3546'$export_list'(Decls, _, _) :-
 3547    var(Decls),
 3548    throw(error(instantiation_error, _)).
 3549'$export_list'(Decls, _, _) :-
 3550    throw(error(type_error(list, Decls), _)).
 3551
 3552'$do_export_list'([], _, []) :- !.
 3553'$do_export_list'([H|T], Module, Ops) :-
 3554    !,
 3555    E = error(_,_),
 3556    catch('$export1'(H, Module, Ops, Ops1),
 3557          E, ('$print_message'(error, E), Ops = Ops1)),
 3558    '$do_export_list'(T, Module, Ops1).
 3559
 3560'$export1'(Var, _, _, _) :-
 3561    var(Var),
 3562    !,
 3563    throw(error(instantiation_error, _)).
 3564'$export1'(Op, _, [Op|T], T) :-
 3565    Op = op(_,_,_),
 3566    !.
 3567'$export1'(PI0, Module, Ops, Ops) :-
 3568    strip_module(Module:PI0, M, PI),
 3569    (   PI = (_//_)
 3570    ->  non_terminal(M:PI)
 3571    ;   true
 3572    ),
 3573    export(M:PI).
 3574
 3575'$export_ops'([op(Pri, Assoc, Name)|T], Module, File) :-
 3576    E = error(_,_),
 3577    catch(( '$execute_directive'(op(Pri, Assoc, Module:Name), File),
 3578            '$export_op'(Pri, Assoc, Name, Module, File)
 3579          ),
 3580          E, '$print_message'(error, E)),
 3581    '$export_ops'(T, Module, File).
 3582'$export_ops'([], _, _).
 3583
 3584'$export_op'(Pri, Assoc, Name, Module, File) :-
 3585    (   '$get_predicate_attribute'(Module:'$exported_op'(_,_,_), defined, 1)
 3586    ->  true
 3587    ;   '$execute_directive'(discontiguous(Module:'$exported_op'/3), File)
 3588    ),
 3589    '$store_admin_clause'('$exported_op'(Pri, Assoc, Name), _Layout, File, -).
 $execute_directive(:Goal, +File) is det
Execute the argument of :- or ?- while loading a file.
 3595'$execute_directive'(Goal, F) :-
 3596    '$execute_directive_2'(Goal, F).
 3597
 3598'$execute_directive_2'(encoding(Encoding), _F) :-
 3599    !,
 3600    (   '$load_input'(_F, S)
 3601    ->  set_stream(S, encoding(Encoding))
 3602    ).
 3603'$execute_directive_2'(Goal, _) :-
 3604    \+ '$compilation_mode'(database),
 3605    !,
 3606    '$add_directive_wic2'(Goal, Type),
 3607    (   Type == call                % suspend compiling into .qlf file
 3608    ->  '$compilation_mode'(Old, database),
 3609        setup_call_cleanup(
 3610            '$directive_mode'(OldDir, Old),
 3611            '$execute_directive_3'(Goal),
 3612            ( '$set_compilation_mode'(Old),
 3613              '$set_directive_mode'(OldDir)
 3614            ))
 3615    ;   '$execute_directive_3'(Goal)
 3616    ).
 3617'$execute_directive_2'(Goal, _) :-
 3618    '$execute_directive_3'(Goal).
 3619
 3620'$execute_directive_3'(Goal) :-
 3621    '$current_source_module'(Module),
 3622    '$valid_directive'(Module:Goal),
 3623    !,
 3624    (   '$pattr_directive'(Goal, Module)
 3625    ->  true
 3626    ;   Term = error(_,_),
 3627        catch(Module:Goal, Term, '$exception_in_directive'(Term))
 3628    ->  true
 3629    ;   '$print_message'(warning, goal_failed(directive, Module:Goal)),
 3630        fail
 3631    ).
 3632'$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.
 3641:- multifile prolog:sandbox_allowed_directive/1. 3642:- multifile prolog:sandbox_allowed_clause/1. 3643:- meta_predicate '$valid_directive'(:). 3644
 3645'$valid_directive'(_) :-
 3646    current_prolog_flag(sandboxed_load, false),
 3647    !.
 3648'$valid_directive'(Goal) :-
 3649    Error = error(Formal, _),
 3650    catch(prolog:sandbox_allowed_directive(Goal), Error, true),
 3651    !,
 3652    (   var(Formal)
 3653    ->  true
 3654    ;   print_message(error, Error),
 3655        fail
 3656    ).
 3657'$valid_directive'(Goal) :-
 3658    print_message(error,
 3659                  error(permission_error(execute,
 3660                                         sandboxed_directive,
 3661                                         Goal), _)),
 3662    fail.
 3663
 3664'$exception_in_directive'(Term) :-
 3665    '$print_message'(error, Term),
 3666    fail.
 3667
 3668%       Note that the list, consult and ensure_loaded directives are already
 3669%       handled at compile time and therefore should not go into the
 3670%       intermediate code file.
 3671
 3672'$add_directive_wic2'(Goal, Type) :-
 3673    '$common_goal_type'(Goal, Type),
 3674    !,
 3675    (   Type == load
 3676    ->  true
 3677    ;   '$current_source_module'(Module),
 3678        '$add_directive_wic'(Module:Goal)
 3679    ).
 3680'$add_directive_wic2'(Goal, _) :-
 3681    (   '$compilation_mode'(qlf)    % no problem for qlf files
 3682    ->  true
 3683    ;   print_message(error, mixed_directive(Goal))
 3684    ).
 3685
 3686'$common_goal_type'((A,B), Type) :-
 3687    !,
 3688    '$common_goal_type'(A, Type),
 3689    '$common_goal_type'(B, Type).
 3690'$common_goal_type'((A;B), Type) :-
 3691    !,
 3692    '$common_goal_type'(A, Type),
 3693    '$common_goal_type'(B, Type).
 3694'$common_goal_type'((A->B), Type) :-
 3695    !,
 3696    '$common_goal_type'(A, Type),
 3697    '$common_goal_type'(B, Type).
 3698'$common_goal_type'(Goal, Type) :-
 3699    '$goal_type'(Goal, Type).
 3700
 3701'$goal_type'(Goal, Type) :-
 3702    (   '$load_goal'(Goal)
 3703    ->  Type = load
 3704    ;   Type = call
 3705    ).
 3706
 3707'$load_goal'([_|_]).
 3708'$load_goal'(consult(_)).
 3709'$load_goal'(load_files(_)).
 3710'$load_goal'(load_files(_,Options)) :-
 3711    memberchk(qcompile(QlfMode), Options),
 3712    '$qlf_part_mode'(QlfMode).
 3713'$load_goal'(ensure_loaded(_)) :- '$compilation_mode'(wic).
 3714'$load_goal'(use_module(_))    :- '$compilation_mode'(wic).
 3715'$load_goal'(use_module(_, _)) :- '$compilation_mode'(wic).
 3716
 3717'$qlf_part_mode'(part).
 3718'$qlf_part_mode'(true).                 % compatibility
 3719
 3720
 3721                /********************************
 3722                *        COMPILE A CLAUSE       *
 3723                *********************************/
 $store_admin_clause(+Clause, ?Layout, +Owner, +SrcLoc) is det
Store a clause into the database for administrative purposes. This bypasses sanity checking.
 3730'$store_admin_clause'(Clause, Layout, Owner, SrcLoc) :-
 3731    Owner \== (-),
 3732    !,
 3733    setup_call_cleanup(
 3734        '$start_aux'(Owner, Context),
 3735        '$store_admin_clause2'(Clause, Layout, Owner, SrcLoc),
 3736        '$end_aux'(Owner, Context)).
 3737'$store_admin_clause'(Clause, Layout, File, SrcLoc) :-
 3738    '$store_admin_clause2'(Clause, Layout, File, SrcLoc).
 3739
 3740'$store_admin_clause2'(Clause, _Layout, File, SrcLoc) :-
 3741    (   '$compilation_mode'(database)
 3742    ->  '$record_clause'(Clause, File, SrcLoc)
 3743    ;   '$record_clause'(Clause, File, SrcLoc, Ref),
 3744        '$qlf_assert_clause'(Ref, development)
 3745    ).
 $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.
 3755'$store_clause'((_, _), _, _, _) :-
 3756    !,
 3757    print_message(error, cannot_redefine_comma),
 3758    fail.
 3759'$store_clause'((Pre => Body), _Layout, File, SrcLoc) :-
 3760    nonvar(Pre),
 3761    Pre = (Head,Cond),
 3762    !,
 3763    (   '$is_true'(Cond), current_prolog_flag(optimise, true)
 3764    ->  '$store_clause'((Head=>Body), _Layout, File, SrcLoc)
 3765    ;   '$store_clause'(?=>(Head,(Cond,!,Body)), _Layout, File, SrcLoc)
 3766    ).
 3767'$store_clause'(Clause, _Layout, File, SrcLoc) :-
 3768    '$valid_clause'(Clause),
 3769    !,
 3770    (   '$compilation_mode'(database)
 3771    ->  '$record_clause'(Clause, File, SrcLoc)
 3772    ;   '$record_clause'(Clause, File, SrcLoc, Ref),
 3773        '$qlf_assert_clause'(Ref, development)
 3774    ).
 3775
 3776'$is_true'(true)  => true.
 3777'$is_true'((A,B)) => '$is_true'(A), '$is_true'(B).
 3778'$is_true'(_)     => fail.
 3779
 3780'$valid_clause'(_) :-
 3781    current_prolog_flag(sandboxed_load, false),
 3782    !.
 3783'$valid_clause'(Clause) :-
 3784    \+ '$cross_module_clause'(Clause),
 3785    !.
 3786'$valid_clause'(Clause) :-
 3787    Error = error(Formal, _),
 3788    catch(prolog:sandbox_allowed_clause(Clause), Error, true),
 3789    !,
 3790    (   var(Formal)
 3791    ->  true
 3792    ;   print_message(error, Error),
 3793        fail
 3794    ).
 3795'$valid_clause'(Clause) :-
 3796    print_message(error,
 3797                  error(permission_error(assert,
 3798                                         sandboxed_clause,
 3799                                         Clause), _)),
 3800    fail.
 3801
 3802'$cross_module_clause'(Clause) :-
 3803    '$head_module'(Clause, Module),
 3804    \+ '$current_source_module'(Module).
 3805
 3806'$head_module'(Var, _) :-
 3807    var(Var), !, fail.
 3808'$head_module'((Head :- _), Module) :-
 3809    '$head_module'(Head, Module).
 3810'$head_module'(Module:_, Module).
 3811
 3812'$clause_source'('$source_location'(File,Line):Clause, Clause, File:Line) :- !.
 3813'$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.
 3820:- public
 3821    '$store_clause'/2. 3822
 3823'$store_clause'(Term, Id) :-
 3824    '$clause_source'(Term, Clause, SrcLoc),
 3825    '$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?
 3846compile_aux_clauses(_Clauses) :-
 3847    current_prolog_flag(xref, true),
 3848    !.
 3849compile_aux_clauses(Clauses) :-
 3850    source_location(File, _Line),
 3851    '$compile_aux_clauses'(Clauses, File).
 3852
 3853'$compile_aux_clauses'(Clauses, File) :-
 3854    setup_call_cleanup(
 3855        '$start_aux'(File, Context),
 3856        '$store_aux_clauses'(Clauses, File),
 3857        '$end_aux'(File, Context)).
 3858
 3859'$store_aux_clauses'(Clauses, File) :-
 3860    is_list(Clauses),
 3861    !,
 3862    forall('$member'(C,Clauses),
 3863           '$compile_term'(C, _Layout, File)).
 3864'$store_aux_clauses'(Clause, File) :-
 3865    '$compile_term'(Clause, _Layout, File).
 3866
 3867
 3868		 /*******************************
 3869		 *            STAGING		*
 3870		 *******************************/
 $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.
 3880'$stage_file'(Target, Stage) :-
 3881    file_directory_name(Target, Dir),
 3882    file_base_name(Target, File),
 3883    current_prolog_flag(pid, Pid),
 3884    format(atom(Stage), '~w/.~w.~d', [Dir,File,Pid]).
 3885
 3886'$install_staged_file'(exit, Staged, Target, error) :-
 3887    !,
 3888    rename_file(Staged, Target).
 3889'$install_staged_file'(exit, Staged, Target, OnError) :-
 3890    !,
 3891    InstallError = error(_,_),
 3892    catch(rename_file(Staged, Target),
 3893          InstallError,
 3894          '$install_staged_error'(OnError, InstallError, Staged, Target)).
 3895'$install_staged_file'(_, Staged, _, _OnError) :-
 3896    E = error(_,_),
 3897    catch(delete_file(Staged), E, true).
 3898
 3899'$install_staged_error'(OnError, Error, Staged, _Target) :-
 3900    E = error(_,_),
 3901    catch(delete_file(Staged), E, true),
 3902    (   OnError = silent
 3903    ->  true
 3904    ;   OnError = fail
 3905    ->  fail
 3906    ;   print_message(warning, Error)
 3907    ).
 3908
 3909
 3910                 /*******************************
 3911                 *             READING          *
 3912                 *******************************/
 3913
 3914:- multifile
 3915    prolog:comment_hook/3.                  % hook for read_clause/3
 3916
 3917
 3918                 /*******************************
 3919                 *       FOREIGN INTERFACE      *
 3920                 *******************************/
 3921
 3922%       call-back from PL_register_foreign().  First argument is the module
 3923%       into which the foreign predicate is loaded and second is a term
 3924%       describing the arguments.
 3925
 3926:- dynamic
 3927    '$foreign_registered'/2. 3928
 3929                 /*******************************
 3930                 *   TEMPORARY TERM EXPANSION   *
 3931                 *******************************/
 3932
 3933% Provide temporary definitions for the boot-loader.  These are replaced
 3934% by the real thing in load.pl
 3935
 3936:- dynamic
 3937    '$expand_goal'/2,
 3938    '$expand_term'/4. 3939
 3940'$expand_goal'(In, In).
 3941'$expand_term'(In, Layout, In, Layout).
 3942
 3943
 3944                 /*******************************
 3945                 *         TYPE SUPPORT         *
 3946                 *******************************/
 3947
 3948'$type_error'(Type, Value) :-
 3949    (   var(Value)
 3950    ->  throw(error(instantiation_error, _))
 3951    ;   throw(error(type_error(Type, Value), _))
 3952    ).
 3953
 3954'$domain_error'(Type, Value) :-
 3955    throw(error(domain_error(Type, Value), _)).
 3956
 3957'$existence_error'(Type, Object) :-
 3958    throw(error(existence_error(Type, Object), _)).
 3959
 3960'$permission_error'(Action, Type, Term) :-
 3961    throw(error(permission_error(Action, Type, Term), _)).
 3962
 3963'$instantiation_error'(_Var) :-
 3964    throw(error(instantiation_error, _)).
 3965
 3966'$uninstantiation_error'(NonVar) :-
 3967    throw(error(uninstantiation_error(NonVar), _)).
 3968
 3969'$must_be'(list, X) :- !,
 3970    '$skip_list'(_, X, Tail),
 3971    (   Tail == []
 3972    ->  true
 3973    ;   '$type_error'(list, Tail)
 3974    ).
 3975'$must_be'(options, X) :- !,
 3976    (   '$is_options'(X)
 3977    ->  true
 3978    ;   '$type_error'(options, X)
 3979    ).
 3980'$must_be'(atom, X) :- !,
 3981    (   atom(X)
 3982    ->  true
 3983    ;   '$type_error'(atom, X)
 3984    ).
 3985'$must_be'(integer, X) :- !,
 3986    (   integer(X)
 3987    ->  true
 3988    ;   '$type_error'(integer, X)
 3989    ).
 3990'$must_be'(between(Low,High), X) :- !,
 3991    (   integer(X)
 3992    ->  (   between(Low, High, X)
 3993        ->  true
 3994        ;   '$domain_error'(between(Low,High), X)
 3995        )
 3996    ;   '$type_error'(integer, X)
 3997    ).
 3998'$must_be'(callable, X) :- !,
 3999    (   callable(X)
 4000    ->  true
 4001    ;   '$type_error'(callable, X)
 4002    ).
 4003'$must_be'(acyclic, X) :- !,
 4004    (   acyclic_term(X)
 4005    ->  true
 4006    ;   '$domain_error'(acyclic_term, X)
 4007    ).
 4008'$must_be'(oneof(Type, Domain, List), X) :- !,
 4009    '$must_be'(Type, X),
 4010    (   memberchk(X, List)
 4011    ->  true
 4012    ;   '$domain_error'(Domain, X)
 4013    ).
 4014'$must_be'(boolean, X) :- !,
 4015    (   (X == true ; X == false)
 4016    ->  true
 4017    ;   '$type_error'(boolean, X)
 4018    ).
 4019'$must_be'(ground, X) :- !,
 4020    (   ground(X)
 4021    ->  true
 4022    ;   '$instantiation_error'(X)
 4023    ).
 4024'$must_be'(filespec, X) :- !,
 4025    (   (   atom(X)
 4026        ;   string(X)
 4027        ;   compound(X),
 4028            compound_name_arity(X, _, 1)
 4029        )
 4030    ->  true
 4031    ;   '$type_error'(filespec, X)
 4032    ).
 4033
 4034% Use for debugging
 4035%'$must_be'(Type, _X) :- format('Unknown $must_be type: ~q~n', [Type]).
 4036
 4037
 4038                /********************************
 4039                *       LIST PROCESSING         *
 4040                *********************************/
 4041
 4042'$member'(El, [H|T]) :-
 4043    '$member_'(T, El, H).
 4044
 4045'$member_'(_, El, El).
 4046'$member_'([H|T], El, _) :-
 4047    '$member_'(T, El, H).
 4048
 4049'$append'([], L, L).
 4050'$append'([H|T], L, [H|R]) :-
 4051    '$append'(T, L, R).
 4052
 4053'$append'(ListOfLists, List) :-
 4054    '$must_be'(list, ListOfLists),
 4055    '$append_'(ListOfLists, List).
 4056
 4057'$append_'([], []).
 4058'$append_'([L|Ls], As) :-
 4059    '$append'(L, Ws, As),
 4060    '$append_'(Ls, Ws).
 4061
 4062'$select'(X, [X|Tail], Tail).
 4063'$select'(Elem, [Head|Tail], [Head|Rest]) :-
 4064    '$select'(Elem, Tail, Rest).
 4065
 4066'$reverse'(L1, L2) :-
 4067    '$reverse'(L1, [], L2).
 4068
 4069'$reverse'([], List, List).
 4070'$reverse'([Head|List1], List2, List3) :-
 4071    '$reverse'(List1, [Head|List2], List3).
 4072
 4073'$delete'([], _, []) :- !.
 4074'$delete'([Elem|Tail], Elem, Result) :-
 4075    !,
 4076    '$delete'(Tail, Elem, Result).
 4077'$delete'([Head|Tail], Elem, [Head|Rest]) :-
 4078    '$delete'(Tail, Elem, Rest).
 4079
 4080'$last'([H|T], Last) :-
 4081    '$last'(T, H, Last).
 4082
 4083'$last'([], Last, Last).
 4084'$last'([H|T], _, Last) :-
 4085    '$last'(T, H, Last).
 length(?List, ?N)
Is true when N is the length of List.
 4092:- '$iso'((length/2)). 4093
 4094length(List, Length) :-
 4095    var(Length),
 4096    !,
 4097    '$skip_list'(Length0, List, Tail),
 4098    (   Tail == []
 4099    ->  Length = Length0                    % +,-
 4100    ;   var(Tail)
 4101    ->  Tail \== Length,                    % avoid length(L,L)
 4102        '$length3'(Tail, Length, Length0)   % -,-
 4103    ;   throw(error(type_error(list, List),
 4104                    context(length/2, _)))
 4105    ).
 4106length(List, Length) :-
 4107    integer(Length),
 4108    Length >= 0,
 4109    !,
 4110    '$skip_list'(Length0, List, Tail),
 4111    (   Tail == []                          % proper list
 4112    ->  Length = Length0
 4113    ;   var(Tail)
 4114    ->  Extra is Length-Length0,
 4115        '$length'(Tail, Extra)
 4116    ;   throw(error(type_error(list, List),
 4117                    context(length/2, _)))
 4118    ).
 4119length(_, Length) :-
 4120    integer(Length),
 4121    !,
 4122    throw(error(domain_error(not_less_than_zero, Length),
 4123                context(length/2, _))).
 4124length(_, Length) :-
 4125    throw(error(type_error(integer, Length),
 4126                context(length/2, _))).
 4127
 4128'$length3'([], N, N).
 4129'$length3'([_|List], N, N0) :-
 4130    N1 is N0+1,
 4131    '$length3'(List, N, N1).
 4132
 4133
 4134                 /*******************************
 4135                 *       OPTION PROCESSING      *
 4136                 *******************************/
 $is_options(@Term) is semidet
True if Term looks like it provides options.
 4142'$is_options'(Map) :-
 4143    is_dict(Map, _),
 4144    !.
 4145'$is_options'(List) :-
 4146    is_list(List),
 4147    (   List == []
 4148    ->  true
 4149    ;   List = [H|_],
 4150        '$is_option'(H, _, _)
 4151    ).
 4152
 4153'$is_option'(Var, _, _) :-
 4154    var(Var), !, fail.
 4155'$is_option'(F, Name, Value) :-
 4156    functor(F, _, 1),
 4157    !,
 4158    F =.. [Name,Value].
 4159'$is_option'(Name=Value, Name, Value).
 $option(?Opt, +Options) is semidet
 4163'$option'(Opt, Options) :-
 4164    is_dict(Options),
 4165    !,
 4166    [Opt] :< Options.
 4167'$option'(Opt, Options) :-
 4168    memberchk(Opt, Options).
 $option(?Opt, +Options, +Default) is det
 4172'$option'(Term, Options, Default) :-
 4173    arg(1, Term, Value),
 4174    functor(Term, Name, 1),
 4175    (   is_dict(Options)
 4176    ->  (   get_dict(Name, Options, GVal)
 4177        ->  Value = GVal
 4178        ;   Value = Default
 4179        )
 4180    ;   functor(Gen, Name, 1),
 4181        arg(1, Gen, GVal),
 4182        (   memberchk(Gen, Options)
 4183        ->  Value = GVal
 4184        ;   Value = Default
 4185        )
 4186    ).
 $select_option(?Opt, +Options, -Rest) is semidet
Select an option from Options.
Arguments:
Rest- is always a map.
 4194'$select_option'(Opt, Options, Rest) :-
 4195    select_dict([Opt], Options, Rest).
 $merge_options(+New, +Default, -Merged) is det
Add/replace options specified in New.
Arguments:
Merged- is always a map.
 4203'$merge_options'(New, Old, Merged) :-
 4204    put_dict(New, Old, Merged).
 4205
 4206
 4207                 /*******************************
 4208                 *   HANDLE TRACER 'L'-COMMAND  *
 4209                 *******************************/
 4210
 4211:- public '$prolog_list_goal'/1. 4212
 4213:- multifile
 4214    user:prolog_list_goal/1. 4215
 4216'$prolog_list_goal'(Goal) :-
 4217    user:prolog_list_goal(Goal),
 4218    !.
 4219'$prolog_list_goal'(Goal) :-
 4220    use_module(library(listing), [listing/1]),
 4221    @(listing(Goal), user).
 4222
 4223
 4224                 /*******************************
 4225                 *             HALT             *
 4226                 *******************************/
 4227
 4228:- '$iso'((halt/0)). 4229
 4230halt :-
 4231    '$exit_code'(Code),
 4232    (   Code == 0
 4233    ->  true
 4234    ;   print_message(warning, on_error(halt(1)))
 4235    ),
 4236    halt(Code).
 $exit_code(Code)
Determine the exit code baed on the on_error and on_warning flags. Also used by qsave_toplevel/0.
 4243'$exit_code'(Code) :-
 4244    (   (   current_prolog_flag(on_error, status),
 4245            statistics(errors, Count),
 4246            Count > 0
 4247        ;   current_prolog_flag(on_warning, status),
 4248            statistics(warnings, Count),
 4249            Count > 0
 4250        )
 4251    ->  Code = 1
 4252    ;   Code = 0
 4253    ).
 at_halt(:Goal)
Register Goal to be called if the system halts.
To be done
- : get location into the error message
 4262:- meta_predicate at_halt(0). 4263:- dynamic        system:term_expansion/2, '$at_halt'/2. 4264:- multifile      system:term_expansion/2, '$at_halt'/2. 4265
 4266system:term_expansion((:- at_halt(Goal)),
 4267                      system:'$at_halt'(Module:Goal, File:Line)) :-
 4268    \+ current_prolog_flag(xref, true),
 4269    source_location(File, Line),
 4270    '$current_source_module'(Module).
 4271
 4272at_halt(Goal) :-
 4273    asserta('$at_halt'(Goal, (-):0)).
 4274
 4275:- public '$run_at_halt'/0. 4276
 4277'$run_at_halt' :-
 4278    forall(clause('$at_halt'(Goal, Src), true, Ref),
 4279           ( '$call_at_halt'(Goal, Src),
 4280             erase(Ref)
 4281           )).
 4282
 4283'$call_at_halt'(Goal, _Src) :-
 4284    catch(Goal, E, true),
 4285    !,
 4286    (   var(E)
 4287    ->  true
 4288    ;   subsumes_term(cancel_halt(_), E)
 4289    ->  '$print_message'(informational, E),
 4290        fail
 4291    ;   '$print_message'(error, E)
 4292    ).
 4293'$call_at_halt'(Goal, _Src) :-
 4294    '$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.
 4302cancel_halt(Reason) :-
 4303    throw(cancel_halt(Reason)).
 prolog:heartbeat
Called every N inferences of the Prolog flag heartbeat is non-zero.
 4310:- multifile prolog:heartbeat/0. 4311
 4312
 4313                /********************************
 4314                *      LOAD OTHER MODULES       *
 4315                *********************************/
 4316
 4317:- meta_predicate
 4318    '$load_wic_files'(:). 4319
 4320'$load_wic_files'(Files) :-
 4321    Files = Module:_,
 4322    '$execute_directive'('$set_source_module'(OldM, Module), []),
 4323    '$save_lex_state'(LexState, []),
 4324    '$style_check'(_, 0xC7),                % see style_name/2 in syspred.pl
 4325    '$compilation_mode'(OldC, wic),
 4326    consult(Files),
 4327    '$execute_directive'('$set_source_module'(OldM), []),
 4328    '$execute_directive'('$restore_lex_state'(LexState), []),
 4329    '$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.
 4337:- public '$load_additional_boot_files'/0. 4338
 4339'$load_additional_boot_files' :-
 4340    current_prolog_flag(argv, Argv),
 4341    '$get_files_argv'(Argv, Files),
 4342    (   Files \== []
 4343    ->  format('Loading additional boot files~n'),
 4344        '$load_wic_files'(user:Files),
 4345        format('additional boot files loaded~n')
 4346    ;   true
 4347    ).
 4348
 4349'$get_files_argv'([], []) :- !.
 4350'$get_files_argv'(['-c'|Files], Files) :- !.
 4351'$get_files_argv'([_|Rest], Files) :-
 4352    '$get_files_argv'(Rest, Files).
 4353
 4354'$:-'(('$boot_message'('Loading Prolog startup files~n', []),
 4355       source_location(File, _Line),
 4356       file_directory_name(File, Dir),
 4357       atom_concat(Dir, '/load.pl', LoadFile),
 4358       '$load_wic_files'(system:[LoadFile]),
 4359       (   current_prolog_flag(windows, true)
 4360       ->  atom_concat(Dir, '/menu.pl', MenuFile),
 4361           '$load_wic_files'(system:[MenuFile])
 4362       ;   true
 4363       ),
 4364       '$boot_message'('SWI-Prolog boot files loaded~n', []),
 4365       '$compilation_mode'(OldC, wic),
 4366       '$execute_directive'('$set_source_module'(user), []),
 4367       '$set_compilation_mode'(OldC)
 4368      ))