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

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

  394'$meta_call'(M:G) :-
  395    prolog_current_choice(Ch),
  396    '$meta_call'(G, M, Ch).
  397
  398'$meta_call'(Var, _, _) :-
  399    var(Var),
  400    !,
  401    '$instantiation_error'(Var).
  402'$meta_call'((A,B), M, Ch) :-
  403    !,
  404    '$meta_call'(A, M, Ch),
  405    '$meta_call'(B, M, Ch).
  406'$meta_call'((I->T;E), M, Ch) :-
  407    !,
  408    (   prolog_current_choice(Ch2),
  409        '$meta_call'(I, M, Ch2)
  410    ->  '$meta_call'(T, M, Ch)
  411    ;   '$meta_call'(E, M, Ch)
  412    ).
  413'$meta_call'((I*->T;E), M, Ch) :-
  414    !,
  415    (   prolog_current_choice(Ch2),
  416        '$meta_call'(I, M, Ch2)
  417    *-> '$meta_call'(T, M, Ch)
  418    ;   '$meta_call'(E, M, Ch)
  419    ).
  420'$meta_call'((I->T), M, Ch) :-
  421    !,
  422    (   prolog_current_choice(Ch2),
  423        '$meta_call'(I, M, Ch2)
  424    ->  '$meta_call'(T, M, Ch)
  425    ).
  426'$meta_call'((I*->T), M, Ch) :-
  427    !,
  428    prolog_current_choice(Ch2),
  429    '$meta_call'(I, M, Ch2),
  430    '$meta_call'(T, M, Ch).
  431'$meta_call'((A;B), M, Ch) :-
  432    !,
  433    (   '$meta_call'(A, M, Ch)
  434    ;   '$meta_call'(B, M, Ch)
  435    ).
  436'$meta_call'(\+(G), M, _) :-
  437    !,
  438    prolog_current_choice(Ch),
  439    \+ '$meta_call'(G, M, Ch).
  440'$meta_call'(call(G), M, _) :-
  441    !,
  442    prolog_current_choice(Ch),
  443    '$meta_call'(G, M, Ch).
  444'$meta_call'(M:G, _, Ch) :-
  445    !,
  446    '$meta_call'(G, M, Ch).
  447'$meta_call'(!, _, Ch) :-
  448    prolog_cut_to(Ch).
  449'$meta_call'(G, M, _Ch) :-
  450    call(M:G).
 call(:Closure, ?A)
 call(:Closure, ?A1, ?A2)
 call(:Closure, ?A1, ?A2, ?A3)
 call(:Closure, ?A1, ?A2, ?A3, ?A4)
 call(:Closure, ?A1, ?A2, ?A3, ?A4, ?A5)
 call(:Closure, ?A1, ?A2, ?A3, ?A4, ?A5, ?A6)
 call(:Closure, ?A1, ?A2, ?A3, ?A4, ?A5, ?A6, ?A7)
Arity 2..8 is demanded by the ISO standard. Higher arities are supported, but handled by the compiler. This implies they are not backed up by predicates and analyzers thus cannot ask for their properties. Analyzers should hard-code handling of call/2..
  466:- '$iso'((call/2,
  467           call/3,
  468           call/4,
  469           call/5,
  470           call/6,
  471           call/7,
  472           call/8)).  473
  474call(Goal) :-                           % make these available as predicates
  475    Goal.
  476call(Goal, A) :-
  477    call(Goal, A).
  478call(Goal, A, B) :-
  479    call(Goal, A, B).
  480call(Goal, A, B, C) :-
  481    call(Goal, A, B, C).
  482call(Goal, A, B, C, D) :-
  483    call(Goal, A, B, C, D).
  484call(Goal, A, B, C, D, E) :-
  485    call(Goal, A, B, C, D, E).
  486call(Goal, A, B, C, D, E, F) :-
  487    call(Goal, A, B, C, D, E, F).
  488call(Goal, A, B, C, D, E, F, G) :-
  489    call(Goal, A, B, C, D, E, F, G).
 not(:Goal) is semidet
Pre-ISO version of \+/1. Note that some systems define not/1 as a logically more sound version of \+/1.
  496not(Goal) :-
  497    \+ Goal.
 \+ :Goal is semidet
Predicate version that allows for meta-calling.
  503\+ Goal :-
  504    \+ Goal.
 once(:Goal) is semidet
ISO predicate, acting as call((Goal, !)).
  510once(Goal) :-
  511    Goal,
  512    !.
 ignore(:Goal) is det
Call Goal, cut choice-points on success and succeed on failure. intended for calling side-effects and proceed on failure.
  519ignore(Goal) :-
  520    Goal,
  521    !.
  522ignore(_Goal).
  523
  524:- '$iso'((false/0)).
 false
Synonym for fail/0, providing a declarative reading.
  530false :-
  531    fail.
 catch(:Goal, +Catcher, :Recover)
ISO compliant exception handling.
  537catch(_Goal, _Catcher, _Recover) :-
  538    '$catch'.                       % Maps to I_CATCH, I_EXITCATCH
 prolog_cut_to(+Choice)
Cut all choice points after Choice
  544prolog_cut_to(_Choice) :-
  545    '$cut'.                         % Maps to I_CUTCHP
 reset(:Goal, ?Ball, -Continue)
Delimited continuation support.
  551reset(_Goal, _Ball, _Cont) :-
  552    '$reset'.
 shift(+Ball)
Shift control back to the enclosing reset/3
  558shift(Ball) :-
  559    '$shift'(Ball).
 call_continuation(+Continuation:list)
Call a continuation as created by shift/1. The continuation is a list of '$cont$'(Clause, PC, EnvironmentArg, ...) structures. The predicate '$call_one_tail_body'/1 creates a frame from the continuation and calls this.

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

  573call_continuation([]).
  574call_continuation([TB|Rest]) :-
  575    (   Rest == []
  576    ->  '$call_continuation'(TB)
  577    ;   '$call_continuation'(TB),
  578        call_continuation(Rest)
  579    ).
 catch_with_backtrace(:Goal, ?Ball, :Recover)
As catch/3, but tell library(prolog_stack) to record a backtrace in case of an exception.
  586catch_with_backtrace(Goal, Ball, Recover) :-
  587    catch(Goal, Ball, Recover),
  588    '$no_lco'.
  589
  590'$no_lco'.
 $recover_and_rethrow(:Goal, +Term)
This goal is used to wrap the catch/3 recover handler if the exception is not supposed to be `catchable'. An example of an uncachable exception is '$aborted', used by abort/0. Note that we cut to ensure that the exception is not delayed forever because the recover handler leaves a choicepoint.
  600:- public '$recover_and_rethrow'/2.  601
  602'$recover_and_rethrow'(Goal, Exception) :-
  603    call_cleanup(Goal, throw(Exception)),
  604    !.
 setup_call_cleanup(:Setup, :Goal, :Cleanup)
 setup_call_catcher_cleanup(:Setup, :Goal, +Catcher, :Cleanup)
 call_cleanup(:Goal, :Cleanup)
 call_cleanup(:Goal, +Catcher, :Cleanup)
Call Cleanup once after Goal is finished (deterministic success, failure, exception or cut). The call to '$call_cleanup' is translated to I_CALLCLEANUP. This instruction relies on the exact stack layout left by setup_call_catcher_cleanup/4. Also the predicate name is used by the kernel cleanup mechanism and can only be changed together with the kernel.
  619setup_call_catcher_cleanup(Setup, _Goal, _Catcher, _Cleanup) :-
  620    '$sig_atomic'(Setup),
  621    '$call_cleanup'.
  622
  623setup_call_cleanup(Setup, Goal, Cleanup) :-
  624    setup_call_catcher_cleanup(Setup, Goal, _Catcher, Cleanup).
  625
  626call_cleanup(Goal, Cleanup) :-
  627    setup_call_catcher_cleanup(true, Goal, _Catcher, Cleanup).
  628
  629call_cleanup(Goal, Catcher, Cleanup) :-
  630    setup_call_catcher_cleanup(true, Goal, Catcher, Cleanup).
  631
  632                 /*******************************
  633                 *       INITIALIZATION         *
  634                 *******************************/
  635
  636:- meta_predicate
  637    initialization(0, +).  638
  639:- multifile '$init_goal'/3.  640:- dynamic   '$init_goal'/3.
 initialization(:Goal, +When)
Register Goal to be executed if a saved state is restored. In addition, the goal is executed depending on When:
now
Execute immediately
after_load
Execute after loading the file in which it appears. This is initialization/1.
restore_state
Do not execute immediately, but only when restoring the state. Not allowed in a sandboxed environment.
prepare_state
Called before saving a state. Can be used to clean the environment (see also volatile/1) or eagerly execute goals that are normally executed lazily.
program
Works as -g goal goals.
main
Starts the application. Only last declaration is used.

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

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

Note that qlf must be last when searching for Prolog files. Otherwise use_module/1 will consider the file as not-loaded because the .qlf file is not the loaded file. Must be fixed elsewhere.

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

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

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

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

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