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-2017, University of Amsterdam
    7                              VU University Amsterdam
    8    All rights reserved.
    9
   10    Redistribution and use in source and binary forms, with or without
   11    modification, are permitted provided that the following conditions
   12    are met:
   13
   14    1. Redistributions of source code must retain the above copyright
   15       notice, this list of conditions and the following disclaimer.
   16
   17    2. Redistributions in binary form must reproduce the above copyright
   18       notice, this list of conditions and the following disclaimer in
   19       the documentation and/or other materials provided with the
   20       distribution.
   21
   22    THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
   23    "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
   24    LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS
   25    FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE
   26    COPYRIGHT OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT,
   27    INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING,
   28    BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES;
   29    LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER
   30    CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
   31    LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN
   32    ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
   33    POSSIBILITY OF SUCH DAMAGE.
   34*/
   35
   36/*
   37Consult, derivates and basic things.   This  module  is  loaded  by  the
   38C-written  bootstrap  compiler.
   39
   40The $:- directive  is  executed  by  the  bootstrap  compiler,  but  not
   41inserted  in  the  intermediate  code  file.   Used  to print diagnostic
   42messages and start the Prolog defined compiler for  the  remaining  boot
   43modules.
   44
   45If you want  to  debug  this  module,  put  a  '$:-'(trace).   directive
   46somewhere.   The  tracer will work properly under boot compilation as it
   47will use the C defined write predicate  to  print  goals  and  does  not
   48attempt to call the Prolog defined trace interceptor.
   49*/
   50
   51'$:-'(format('Loading boot file ...~n', [])).
   52
   53                /********************************
   54                *    LOAD INTO MODULE SYSTEM    *
   55                ********************************/
   56
   57:- '$set_source_module'(system).   58
   59                /********************************
   60                *          DIRECTIVES           *
   61                *********************************/
   62
   63:- meta_predicate
   64    dynamic(:),
   65    multifile(:),
   66    public(:),
   67    module_transparent(:),
   68    discontiguous(:),
   69    volatile(:),
   70    thread_local(:),
   71    noprofile(:),
   72    '$clausable'(:),
   73    '$iso'(:),
   74    '$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

Predicate versions of standard directives that set predicate attributes. These predicates bail out with an error on the first failure (typically permission errors).

   89dynamic(Spec)            :- '$set_pattr'(Spec, pred, (dynamic)).
   90multifile(Spec)          :- '$set_pattr'(Spec, pred, (multifile)).
   91module_transparent(Spec) :- '$set_pattr'(Spec, pred, (transparent)).
   92discontiguous(Spec)      :- '$set_pattr'(Spec, pred, (discontiguous)).
   93volatile(Spec)           :- '$set_pattr'(Spec, pred, (volatile)).
   94thread_local(Spec)       :- '$set_pattr'(Spec, pred, (thread_local)).
   95noprofile(Spec)          :- '$set_pattr'(Spec, pred, (noprofile)).
   96public(Spec)             :- '$set_pattr'(Spec, pred, (public)).
   97'$iso'(Spec)             :- '$set_pattr'(Spec, pred, (iso)).
   98'$clausable'(Spec)       :- '$set_pattr'(Spec, pred, (clausable)).
   99
  100'$set_pattr'(M:Pred, How, Attr) :-
  101    '$set_pattr'(Pred, M, How, Attr).
  102
  103'$set_pattr'(X, _, _, _) :-
  104    var(X),
  105    throw(error(instantiation_error, _)).
  106'$set_pattr'([], _, _, _) :- !.
  107'$set_pattr'([H|T], M, How, Attr) :-           % ISO
  108    !,
  109    '$set_pattr'(H, M, How, Attr),
  110    '$set_pattr'(T, M, How, Attr).
  111'$set_pattr'((A,B), M, How, Attr) :-           % ISO and traditional
  112    !,
  113    '$set_pattr'(A, M, How, Attr),
  114    '$set_pattr'(B, M, How, Attr).
  115'$set_pattr'(M:T, _, How, Attr) :-
  116    !,
  117    '$set_pattr'(T, M, How, Attr).
  118'$set_pattr'(A, M, pred, Attr) :-
  119    !,
  120    '$set_predicate_attribute'(M:A, Attr, true).
  121'$set_pattr'(A, M, directive, Attr) :-
  122    !,
  123    catch('$set_predicate_attribute'(M:A, Attr, true),
  124          error(E, _),
  125          print_message(error, error(E, context((Attr)/1,_)))).

 $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.

  134'$pattr_directive'(dynamic(Spec), M) :-
  135    '$set_pattr'(Spec, M, directive, (dynamic)).
  136'$pattr_directive'(multifile(Spec), M) :-
  137    '$set_pattr'(Spec, M, directive, (multifile)).
  138'$pattr_directive'(module_transparent(Spec), M) :-
  139    '$set_pattr'(Spec, M, directive, (transparent)).
  140'$pattr_directive'(discontiguous(Spec), M) :-
  141    '$set_pattr'(Spec, M, directive, (discontiguous)).
  142'$pattr_directive'(volatile(Spec), M) :-
  143    '$set_pattr'(Spec, M, directive, (volatile)).
  144'$pattr_directive'(thread_local(Spec), M) :-
  145    '$set_pattr'(Spec, M, directive, (thread_local)).
  146'$pattr_directive'(noprofile(Spec), M) :-
  147    '$set_pattr'(Spec, M, directive, (noprofile)).
  148'$pattr_directive'(public(Spec), M) :-
  149    '$set_pattr'(Spec, M, directive, (public)).

 $hide(:PI)

Predicates protected this way are never visible in the tracer.

  156'$hide'(Pred) :-
  157    '$set_predicate_attribute'(Pred, trace, false).
  158
  159
  160                /********************************
  161                *       CALLING, CONTROL        *
  162                *********************************/
  163
  164:- noprofile((call/1,
  165              catch/3,
  166              once/1,
  167              ignore/1,
  168              call_cleanup/2,
  169              call_cleanup/3,
  170              setup_call_cleanup/3,
  171              setup_call_catcher_cleanup/4)).  172
  173:- meta_predicate
  174    ';'(0,0),
  175    ','(0,0),
  176    @(0,+),
  177    call(0),
  178    call(1,?),
  179    call(2,?,?),
  180    call(3,?,?,?),
  181    call(4,?,?,?,?),
  182    call(5,?,?,?,?,?),
  183    call(6,?,?,?,?,?,?),
  184    call(7,?,?,?,?,?,?,?),
  185    not(0),
  186    \+(0),
  187    '->'(0,0),
  188    '*->'(0,0),
  189    once(0),
  190    ignore(0),
  191    catch(0,?,0),
  192    reset(0,-,?),
  193    setup_call_cleanup(0,0,0),
  194    setup_call_catcher_cleanup(0,0,?,0),
  195    call_cleanup(0,0),
  196    call_cleanup(0,?,0),
  197    '$meta_call'(0).  198
  199:- '$iso'((call/1, (\+)/1, once/1, (;)/2, (',')/2, (->)/2, catch/3)).  200
  201% The control structures are always compiled, both   if they appear in a
  202% clause body and if they are handed  to   call/1.  The only way to call
  203% these predicates is by means of  call/2..   In  that case, we call the
  204% hole control structure again to get it compiled by call/1 and properly
  205% deal  with  !,  etc.  Another  reason  for  having  these  things   as
  206% predicates is to be able to define   properties for them, helping code
  207% analyzers.
  208
  209(M0:If ; M0:Then) :- !, call(M0:(If ; Then)).
  210(M1:If ; M2:Then) :-    call(M1:(If ; M2:Then)).
  211(G1   , G2)       :-    call((G1   , G2)).
  212(If  -> Then)     :-    call((If  -> Then)).
  213(If *-> Then)     :-    call((If *-> Then)).
  214@(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.

  228'$meta_call'(M:G) :-
  229    prolog_current_choice(Ch),
  230    '$meta_call'(G, M, Ch).
  231
  232'$meta_call'(Var, _, _) :-
  233    var(Var),
  234    !,
  235    '$instantiation_error'(Var).
  236'$meta_call'((A,B), M, Ch) :-
  237    !,
  238    '$meta_call'(A, M, Ch),
  239    '$meta_call'(B, M, Ch).
  240'$meta_call'((I->T;E), M, Ch) :-
  241    !,
  242    (   prolog_current_choice(Ch2),
  243        '$meta_call'(I, M, Ch2)
  244    ->  '$meta_call'(T, M, Ch)
  245    ;   '$meta_call'(E, M, Ch)
  246    ).
  247'$meta_call'((I*->T;E), M, Ch) :-
  248    !,
  249    (   prolog_current_choice(Ch2),
  250        '$meta_call'(I, M, Ch2)
  251    *-> '$meta_call'(T, M, Ch)
  252    ;   '$meta_call'(E, M, Ch)
  253    ).
  254'$meta_call'((I->T), M, Ch) :-
  255    !,
  256    (   prolog_current_choice(Ch2),
  257        '$meta_call'(I, M, Ch2)
  258    ->  '$meta_call'(T, M, Ch)
  259    ).
  260'$meta_call'((I*->T), M, Ch) :-
  261    !,
  262    prolog_current_choice(Ch2),
  263    '$meta_call'(I, M, Ch2),
  264    '$meta_call'(T, M, Ch).
  265'$meta_call'((A;B), M, Ch) :-
  266    !,
  267    (   '$meta_call'(A, M, Ch)
  268    ;   '$meta_call'(B, M, Ch)
  269    ).
  270'$meta_call'(\+(G), M, _) :-
  271    !,
  272    prolog_current_choice(Ch),
  273    \+ '$meta_call'(G, M, Ch).
  274'$meta_call'(call(G), M, _) :-
  275    !,
  276    prolog_current_choice(Ch),
  277    '$meta_call'(G, M, Ch).
  278'$meta_call'(M:G, _, Ch) :-
  279    !,
  280    '$meta_call'(G, M, Ch).
  281'$meta_call'(!, _, Ch) :-
  282    prolog_cut_to(Ch).
  283'$meta_call'(G, M, _Ch) :-
  284    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..

  300:- '$iso'((call/2,
  301           call/3,
  302           call/4,
  303           call/5,
  304           call/6,
  305           call/7,
  306           call/8)).  307
  308call(Goal) :-                           % make these available as predicates
  309    Goal.
  310call(Goal, A) :-
  311    call(Goal, A).
  312call(Goal, A, B) :-
  313    call(Goal, A, B).
  314call(Goal, A, B, C) :-
  315    call(Goal, A, B, C).
  316call(Goal, A, B, C, D) :-
  317    call(Goal, A, B, C, D).
  318call(Goal, A, B, C, D, E) :-
  319    call(Goal, A, B, C, D, E).
  320call(Goal, A, B, C, D, E, F) :-
  321    call(Goal, A, B, C, D, E, F).
  322call(Goal, A, B, C, D, E, F, G) :-
  323    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.

  330not(Goal) :-
  331    \+ Goal.

 \+ :Goal is semidet

Predicate version that allows for meta-calling.

  337\+ Goal :-
  338    \+ Goal.

 once(:Goal) is semidet

ISO predicate, acting as call((Goal, !)).

  344once(Goal) :-
  345    Goal,
  346    !.

 ignore(:Goal) is det

Call Goal, cut choice-points on success and succeed on failure. intended for calling side-effects and proceed on failure.

  353ignore(Goal) :-
  354    Goal,
  355    !.
  356ignore(_Goal).
  357
  358:- '$iso'((false/0)).

 false

Synonym for fail/0, providing a declarative reading.

  364false :-
  365    fail.

 catch(:Goal, +Catcher, :Recover)

ISO compliant exception handling.

  371catch(_Goal, _Catcher, _Recover) :-
  372    '$catch'.                       % Maps to I_CATCH, I_EXITCATCH

 prolog_cut_to(+Choice)

Cut all choice points after Choice

  378prolog_cut_to(_Choice) :-
  379    '$cut'.                         % Maps to I_CUTCHP

 reset(:Goal, ?Ball, -Continue)

Delimited continuation support.

  385reset(_Goal, _Ball, _Cont) :-
  386    '$reset'.

 shift(+Ball)

Shift control back to the enclosing reset/3

  392shift(Ball) :-
  393    '$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.

  407call_continuation([]).
  408call_continuation([TB|Rest]) :-
  409    (   Rest == []
  410    ->  '$call_continuation'(TB)
  411    ;   '$call_continuation'(TB),
  412        call_continuation(Rest)
  413    ).

 $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.

  424:- public '$recover_and_rethrow'/2.  425
  426'$recover_and_rethrow'(Goal, Exception) :-
  427    call_cleanup(Goal, throw(Exception)),
  428    !.

 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.

  443setup_call_catcher_cleanup(Setup, _Goal, _Catcher, _Cleanup) :-
  444    '$sig_atomic'(Setup),
  445    '$call_cleanup'.
  446
  447setup_call_cleanup(Setup, Goal, Cleanup) :-
  448    setup_call_catcher_cleanup(Setup, Goal, _Catcher, Cleanup).
  449
  450call_cleanup(Goal, Cleanup) :-
  451    setup_call_catcher_cleanup(true, Goal, _Catcher, Cleanup).
  452
  453call_cleanup(Goal, Catcher, Cleanup) :-
  454    setup_call_catcher_cleanup(true, Goal, Catcher, Cleanup).
  455
  456                 /*******************************
  457                 *       INITIALIZATION         *
  458                 *******************************/
  459
  460:- meta_predicate
  461    initialization(0, +).  462
  463:- multifile '$init_goal'/3.  464:- 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

restore

Do not execute immediately, but only when restoring the state. Not allowed in a sandboxed environment.

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

  481initialization(Goal, When) :-
  482    '$must_be'(oneof(atom, initialization_type,
  483                     [ now,
  484                       after_load,
  485                       restore,
  486                       program,
  487                       main
  488                     ]), When),
  489    '$initialization_context'(Source, Ctx),
  490    '$initialization'(When, Goal, Source, Ctx).
  491
  492'$initialization'(now, Goal, _Source, Ctx) :-
  493    '$run_init_goal'(Goal, Ctx),
  494    '$compile_init_goal'(-, Goal, Ctx).
  495'$initialization'(after_load, Goal, Source, Ctx) :-
  496    (   Source \== (-)
  497    ->  '$compile_init_goal'(Source, Goal, Ctx)
  498    ;   throw(error(context_error(nodirective,
  499                                  initialization(Goal, after_load)),
  500                    _))
  501    ).
  502'$initialization'(restore, Goal, _Source, Ctx) :-
  503    (   \+ current_prolog_flag(sandboxed_load, true)
  504    ->  '$compile_init_goal'(-, Goal, Ctx)
  505    ;   '$permission_error'(register, initialization(restore), Goal)
  506    ).
  507'$initialization'(program, Goal, _Source, Ctx) :-
  508    (   \+ current_prolog_flag(sandboxed_load, true)
  509    ->  '$compile_init_goal'(when(program), Goal, Ctx)
  510    ;   '$permission_error'(register, initialization(restore), Goal)
  511    ).
  512'$initialization'(main, Goal, _Source, Ctx) :-
  513    (   \+ current_prolog_flag(sandboxed_load, true)
  514    ->  '$compile_init_goal'(when(main), Goal, Ctx)
  515    ;   '$permission_error'(register, initialization(restore), Goal)
  516    ).
  517
  518
  519'$compile_init_goal'(Source, Goal, Ctx) :-
  520    atom(Source),
  521    Source \== (-),
  522    !,
  523    '$store_admin_clause'(system:'$init_goal'(Source, Goal, Ctx),
  524                          _Layout, Source, Ctx).
  525'$compile_init_goal'(Source, Goal, Ctx) :-
  526    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.

  538'$run_initialization'(_, loaded, _) :- !.
  539'$run_initialization'(File, _Action, Options) :-
  540    '$run_initialization'(File, Options).
  541
  542'$run_initialization'(File, Options) :-
  543    setup_call_cleanup(
  544        '$start_run_initialization'(Options, Restore),
  545        '$run_initialization_2'(File),
  546        '$end_run_initialization'(Restore)).
  547
  548'$start_run_initialization'(Options, OldSandBoxed) :-
  549    '$push_input_context'(initialization),
  550    '$set_sandboxed_load'(Options, OldSandBoxed).
  551'$end_run_initialization'(OldSandBoxed) :-
  552    set_prolog_flag(sandboxed_load, OldSandBoxed),
  553    '$pop_input_context'.
  554
  555'$run_initialization_2'(File) :-
  556    (   '$init_goal'(File, Goal, Ctx),
  557        File \= when(_),
  558        '$run_init_goal'(Goal, Ctx),
  559        fail
  560    ;   true
  561    ).
  562
  563'$run_init_goal'(Goal, Ctx) :-
  564    (   catch('$run_init_goal'(Goal), E,
  565              '$initialization_error'(E, Goal, Ctx))
  566    ->  true
  567    ;   '$initialization_failure'(Goal, Ctx)
  568    ).
  569
  570:- multifile prolog:sandbox_allowed_goal/1.  571
  572'$run_init_goal'(Goal) :-
  573    current_prolog_flag(sandboxed_load, false),
  574    !,
  575    call(Goal).
  576'$run_init_goal'(Goal) :-
  577    prolog:sandbox_allowed_goal(Goal),
  578    call(Goal).
  579
  580'$initialization_context'(Source, Ctx) :-
  581    (   source_location(File, Line)
  582    ->  Ctx = File:Line,
  583        '$input_context'(Context),
  584        '$top_file'(Context, File, Source)
  585    ;   Ctx = (-),
  586        File = (-)
  587    ).
  588
  589'$top_file'([input(include, F1, _, _)|T], _, F) :-
  590    !,
  591    '$top_file'(T, F1, F).
  592'$top_file'(_, F, F).
  593
  594
  595'$initialization_error'(E, Goal, Ctx) :-
  596    print_message(error, initialization_error(Goal, E, Ctx)).
  597
  598'$initialization_failure'(Goal, Ctx) :-
  599    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

  607:- public '$clear_source_admin'/1.  608
  609'$clear_source_admin'(File) :-
  610    retractall('$init_goal'(_, _, File:_)),
  611    retractall('$load_context_module'(File, _, _)).
  612
  613
  614                 /*******************************
  615                 *            STREAM            *
  616                 *******************************/
  617
  618:- '$iso'(stream_property/2).  619stream_property(Stream, Property) :-
  620    nonvar(Stream),
  621    nonvar(Property),
  622    !,
  623    '$stream_property'(Stream, Property).
  624stream_property(Stream, Property) :-
  625    nonvar(Stream),
  626    !,
  627    '$stream_properties'(Stream, Properties),
  628    '$member'(Property, Properties).
  629stream_property(Stream, Property) :-
  630    nonvar(Property),
  631    !,
  632    (   Property = alias(Alias),
  633        atom(Alias)
  634    ->  '$alias_stream'(Alias, Stream)
  635    ;   '$streams_properties'(Property, Pairs),
  636        '$member'(Stream-Property, Pairs)
  637    ).
  638stream_property(Stream, Property) :-
  639    '$streams_properties'(Property, Pairs),
  640    '$member'(Stream-Properties, Pairs),
  641    '$member'(Property, Properties).
  642
  643
  644                /********************************
  645                *            MODULES            *
  646                *********************************/
  647
  648%       '$prefix_module'(+Module, +Context, +Term, -Prefixed)
  649%       Tags `Term' with `Module:' if `Module' is not the context module.
  650
  651'$prefix_module'(Module, Module, Head, Head) :- !.
  652'$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'.

  658default_module(Me, Super) :-
  659    (   atom(Me)
  660    ->  (   var(Super)
  661        ->  '$default_module'(Me, Super)
  662        ;   '$default_module'(Me, Super), !
  663        )
  664    ;   '$type_error'(module, Me)
  665    ).
  666
  667'$default_module'(Me, Me).
  668'$default_module'(Me, Super) :-
  669    import_module(Me, S),
  670    '$default_module'(S, Super).
  671
  672
  673                /********************************
  674                *      TRACE AND EXCEPTIONS     *
  675                *********************************/
  676
  677:- user:dynamic((exception/3,
  678                 prolog_event_hook/1)).  679:- user:multifile((exception/3,
  680                   prolog_event_hook/1)).

 $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.

  689:- public
  690    '$undefined_procedure'/4.  691
  692'$undefined_procedure'(Module, Name, Arity, Action) :-
  693    '$prefix_module'(Module, user, Name/Arity, Pred),
  694    user:exception(undefined_predicate, Pred, Action0),
  695    !,
  696    Action = Action0.
  697'$undefined_procedure'(Module, Name, Arity, Action) :-
  698    current_prolog_flag(autoload, true),
  699    '$autoload'(Module, Name, Arity),
  700    !,
  701    Action = retry.
  702'$undefined_procedure'(_, _, _, error).
  703
  704'$autoload'(Module, Name, Arity) :-
  705    source_location(File, _Line),
  706    !,
  707    setup_call_cleanup(
  708        '$start_aux'(File, Context),
  709        '$autoload2'(Module, Name, Arity),
  710        '$end_aux'(File, Context)).
  711'$autoload'(Module, Name, Arity) :-
  712    '$autoload2'(Module, Name, Arity).
  713
  714'$autoload2'(Module, Name, Arity) :-
  715    '$find_library'(Module, Name, Arity, LoadModule, Library),
  716    functor(Head, Name, Arity),
  717    '$update_autoload_level'([autoload(true)], Old),
  718    (   current_prolog_flag(verbose_autoload, true)
  719    ->  Level = informational
  720    ;   Level = silent
  721    ),
  722    print_message(Level, autoload(Module:Name/Arity, Library)),
  723    '$compilation_mode'(OldComp, database),
  724    (   Module == LoadModule
  725    ->  ensure_loaded(Module:Library)
  726    ;   (   '$get_predicate_attribute'(LoadModule:Head, defined, 1),
  727            \+ '$loading'(Library)
  728        ->  Module:import(LoadModule:Name/Arity)
  729        ;   use_module(Module:Library, [Name/Arity])
  730        )
  731    ),
  732    '$set_compilation_mode'(OldComp),
  733    '$set_autoload_level'(Old),
  734    '$c_current_predicate'(_, Module:Head).

 $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.

  745'$loading'(Library) :-
  746    current_prolog_flag(threads, true),
  747    '$loading_file'(FullFile, _Queue, _LoadThread),
  748    file_name_extension(Library, _, FullFile),
  749    !.
  750
  751%        handle debugger 'w', 'p' and <N> depth options.
  752
  753'$set_debugger_write_options'(write) :-
  754    !,
  755    create_prolog_flag(debugger_write_options,
  756                       [ quoted(true),
  757                         attributes(dots),
  758                         spacing(next_argument)
  759                       ], []).
  760'$set_debugger_write_options'(print) :-
  761    !,
  762    create_prolog_flag(debugger_write_options,
  763                       [ quoted(true),
  764                         portray(true),
  765                         max_depth(10),
  766                         attributes(portray),
  767                         spacing(next_argument)
  768                       ], []).
  769'$set_debugger_write_options'(Depth) :-
  770    current_prolog_flag(debugger_write_options, Options0),
  771    (   '$select'(max_depth(_), Options0, Options)
  772    ->  true
  773    ;   Options = Options0
  774    ),
  775    create_prolog_flag(debugger_write_options,
  776                       [max_depth(Depth)|Options], []).
  777
  778
  779                /********************************
  780                *        SYSTEM MESSAGES        *
  781                *********************************/

 $confirm(Spec)

Ask the user to confirm a question. Spec is a term as used for print_message/2.

  788'$confirm'(Spec) :-
  789    print_message(query, Spec),
  790    between(0, 5, _),
  791        get_single_char(Answer),
  792        (   '$in_reply'(Answer, 'yYjJ \n')
  793        ->  !,
  794            print_message(query, if_tty([yes-[]]))
  795        ;   '$in_reply'(Answer, 'nN')
  796        ->  !,
  797            print_message(query, if_tty([no-[]])),
  798            fail
  799        ;   print_message(help, query(confirm)),
  800            fail
  801        ).
  802
  803'$in_reply'(Code, Atom) :-
  804    char_code(Char, Code),
  805    sub_atom(Atom, _, _, _, Char),
  806    !.
  807
  808:- dynamic
  809    user:portray/1.  810:- multifile
  811    user:portray/1.  812
  813
  814                 /*******************************
  815                 *       FILE_SEARCH_PATH       *
  816                 *******************************/
  817
  818:- dynamic user:file_search_path/2.  819:- multifile user:file_search_path/2.  820
  821user:(file_search_path(library, Dir) :-
  822        library_directory(Dir)).
  823user:file_search_path(swi, Home) :-
  824    current_prolog_flag(home, Home).
  825user:file_search_path(foreign, swi(ArchLib)) :-
  826    current_prolog_flag(arch, Arch),
  827    atom_concat('lib/', Arch, ArchLib).
  828user:file_search_path(foreign, swi(SoLib)) :-
  829    (   current_prolog_flag(windows, true)
  830    ->  SoLib = bin
  831    ;   SoLib = lib
  832    ).
  833user:file_search_path(path, Dir) :-
  834    getenv('PATH', Path),
  835    (   current_prolog_flag(windows, true)
  836    ->  atomic_list_concat(Dirs, (;), Path)
  837    ;   atomic_list_concat(Dirs, :, Path)
  838    ),
  839    '$member'(Dir, Dirs),
  840    '$no-null-bytes'(Dir).
  841
  842'$no-null-bytes'(Dir) :-
  843    sub_atom(Dir, _, _, _, '\u0000'),
  844    !,
  845    print_message(warning, null_byte_in_path(Dir)),
  846    fail.
  847'$no-null-bytes'(_).

 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?

  855expand_file_search_path(Spec, Expanded) :-
  856    catch('$expand_file_search_path'(Spec, Expanded, 0, []),
  857          loop(Used),
  858          throw(error(loop_error(Spec), file_search(Used)))).
  859
  860'$expand_file_search_path'(Spec, Expanded, N, Used) :-
  861    functor(Spec, Alias, 1),
  862    !,
  863    user:file_search_path(Alias, Exp0),
  864    NN is N + 1,
  865    (   NN > 16
  866    ->  throw(loop(Used))
  867    ;   true
  868    ),
  869    '$expand_file_search_path'(Exp0, Exp1, NN, [Alias=Exp0|Used]),
  870    arg(1, Spec, Segments),
  871    '$segments_to_atom'(Segments, File),
  872    '$make_path'(Exp1, File, Expanded).
  873'$expand_file_search_path'(Spec, Path, _, _) :-
  874    '$segments_to_atom'(Spec, Path).
  875
  876'$make_path'(Dir, File, Path) :-
  877    atom_concat(_, /, Dir),
  878    !,
  879    atom_concat(Dir, File, Path).
  880'$make_path'(Dir, File, Path) :-
  881    atomic_list_concat([Dir, /, File], Path).
  882
  883
  884                /********************************
  885                *         FILE CHECKING         *
  886                *********************************/

 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.

  897absolute_file_name(Spec, Options, Path) :-
  898    '$is_options'(Options),
  899    \+ '$is_options'(Path),
  900    !,
  901    absolute_file_name(Spec, Path, Options).
  902absolute_file_name(Spec, Path, Options) :-
  903    '$must_be'(options, Options),
  904                    % get the valid extensions
  905    (   '$select_option'(extensions(Exts), Options, Options1)
  906    ->  '$must_be'(list, Exts)
  907    ;   '$option'(file_type(Type), Options)
  908    ->  '$must_be'(atom, Type),
  909        '$file_type_extensions'(Type, Exts),
  910        Options1 = Options
  911    ;   Options1 = Options,
  912        Exts = ['']
  913    ),
  914    '$canonicalise_extensions'(Exts, Extensions),
  915                    % unless specified otherwise, ask regular file
  916    (   nonvar(Type)
  917    ->  Options2 = Options1
  918    ;   '$merge_options'(_{file_type:regular}, Options1, Options2)
  919    ),
  920                    % Det or nondet?
  921    (   '$select_option'(solutions(Sols), Options2, Options3)
  922    ->  '$must_be'(oneof(atom, solutions, [first,all]), Sols)
  923    ;   Sols = first,
  924        Options3 = Options2
  925    ),
  926                    % Errors or not?
  927    (   '$select_option'(file_errors(FileErrors), Options3, Options4)
  928    ->  '$must_be'(oneof(atom, file_errors, [error,fail]), FileErrors)
  929    ;   FileErrors = error,
  930        Options4 = Options3
  931    ),
  932                    % Expand shell patterns?
  933    (   atomic(Spec),
  934        '$select_option'(expand(Expand), Options4, Options5),
  935        '$must_be'(boolean, Expand)
  936    ->  expand_file_name(Spec, List),
  937        '$member'(Spec1, List)
  938    ;   Spec1 = Spec,
  939        Options5 = Options4
  940    ),
  941                    % Search for files
  942    (   Sols == first
  943    ->  (   '$chk_file'(Spec1, Extensions, Options5, true, Path)
  944        ->  !       % also kill choice point of expand_file_name/2
  945        ;   (   FileErrors == fail
  946            ->  fail
  947            ;   findall(P,
  948                        '$chk_file'(Spec1, Extensions, [access(exist)],
  949                                    false, P),
  950                        Candidates),
  951                '$abs_file_error'(Spec, Candidates, Options5)
  952            )
  953        )
  954    ;   '$chk_file'(Spec1, Extensions, Options5, false, Path)
  955    ).
  956
  957'$abs_file_error'(Spec, Candidates, Conditions) :-
  958    '$member'(F, Candidates),
  959    '$member'(C, Conditions),
  960    '$file_condition'(C),
  961    '$file_error'(C, Spec, F, E, Comment),
  962    !,
  963    throw(error(E, context(_, Comment))).
  964'$abs_file_error'(Spec, _, _) :-
  965    '$existence_error'(source_sink, Spec).
  966
  967'$file_error'(file_type(directory), Spec, File, Error, Comment) :-
  968    \+ exists_directory(File),
  969    !,
  970    Error = existence_error(directory, Spec),
  971    Comment = not_a_directory(File).
  972'$file_error'(file_type(_), Spec, File, Error, Comment) :-
  973    exists_directory(File),
  974    !,
  975    Error = existence_error(file, Spec),
  976    Comment = directory(File).
  977'$file_error'(access(OneOrList), Spec, File, Error, _) :-
  978    '$one_or_member'(Access, OneOrList),
  979    \+ access_file(File, Access),
  980    Error = permission_error(Access, source_sink, Spec).
  981
  982'$one_or_member'(Elem, List) :-
  983    is_list(List),
  984    !,
  985    '$member'(Elem, List).
  986'$one_or_member'(Elem, Elem).
  987
  988
  989'$file_type_extensions'(source, Exts) :-       % SICStus 3.9 compatibility
  990    !,
  991    '$file_type_extensions'(prolog, Exts).
  992'$file_type_extensions'(Type, Exts) :-
  993    '$current_module'('$bags', _File),
  994    !,
  995    findall(Ext, user:prolog_file_type(Ext, Type), Exts0),
  996    (   Exts0 == [],
  997        \+ '$ft_no_ext'(Type)
  998    ->  '$domain_error'(file_type, Type)
  999    ;   true
 1000    ),
 1001    '$append'(Exts0, [''], Exts).
 1002'$file_type_extensions'(prolog, [pl, '']). % findall is not yet defined ...
 1003
 1004'$ft_no_ext'(txt).
 1005'$ft_no_ext'(executable).
 1006'$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.

 1019:- multifile(user:prolog_file_type/2). 1020:- dynamic(user:prolog_file_type/2). 1021
 1022user:prolog_file_type(pl,       prolog).
 1023user:prolog_file_type(prolog,   prolog).
 1024user:prolog_file_type(qlf,      prolog).
 1025user:prolog_file_type(qlf,      qlf).
 1026user:prolog_file_type(Ext,      executable) :-
 1027    current_prolog_flag(shared_object_extension, Ext).

 $chk_file(+Spec, +Extensions, +Cond, +UseCache, -FullName)

File is a specification of a Prolog source file. Return the full path of the file.

 1034'$chk_file'(Spec, _Extensions, _Cond, _Cache, _FullName) :-
 1035    \+ ground(Spec),
 1036    !,
 1037    '$instantiation_error'(Spec).
 1038'$chk_file'(Spec, Extensions, Cond, Cache, FullName) :-
 1039    compound(Spec),
 1040    functor(Spec, _, 1),
 1041    !,
 1042    '$relative_to'(Cond, cwd, CWD),
 1043    '$chk_alias_file'(Spec, Extensions, Cond, Cache, CWD, FullName).
 1044'$chk_file'(Segments, Ext, Cond, Cache, FullName) :-    % allow a/b/...
 1045    \+ atomic(Segments),
 1046    !,
 1047    '$segments_to_atom'(Segments, Atom),
 1048    '$chk_file'(Atom, Ext, Cond, Cache, FullName).
 1049'$chk_file'(File, Exts, Cond, _, FullName) :-
 1050    is_absolute_file_name(File),
 1051    !,
 1052    '$extend_file'(File, Exts, Extended),
 1053    '$file_conditions'(Cond, Extended),
 1054    '$absolute_file_name'(Extended, FullName).
 1055'$chk_file'(File, Exts, Cond, _, FullName) :-
 1056    '$relative_to'(Cond, source, Dir),
 1057    atomic_list_concat([Dir, /, File], AbsFile),
 1058    '$extend_file'(AbsFile, Exts, Extended),
 1059    '$file_conditions'(Cond, Extended),
 1060    !,
 1061    '$absolute_file_name'(Extended, FullName).
 1062'$chk_file'(File, Exts, Cond, _, FullName) :-
 1063    '$extend_file'(File, Exts, Extended),
 1064    '$file_conditions'(Cond, Extended),
 1065    '$absolute_file_name'(Extended, FullName).
 1066
 1067'$segments_to_atom'(Atom, Atom) :-
 1068    atomic(Atom),
 1069    !.
 1070'$segments_to_atom'(Segments, Atom) :-
 1071    '$segments_to_list'(Segments, List, []),
 1072    !,
 1073    atomic_list_concat(List, /, Atom).
 1074
 1075'$segments_to_list'(A/B, H, T) :-
 1076    '$segments_to_list'(A, H, T0),
 1077    '$segments_to_list'(B, T0, T).
 1078'$segments_to_list'(A, [A|T], T) :-
 1079    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.

 1089'$relative_to'(Conditions, Default, Dir) :-
 1090    (   '$option'(relative_to(FileOrDir), Conditions)
 1091    *-> (   exists_directory(FileOrDir)
 1092        ->  Dir = FileOrDir
 1093        ;   atom_concat(Dir, /, FileOrDir)
 1094        ->  true
 1095        ;   file_directory_name(FileOrDir, Dir)
 1096        )
 1097    ;   Default == cwd
 1098    ->  '$cwd'(Dir)
 1099    ;   Default == source
 1100    ->  source_location(ContextFile, _Line),
 1101        file_directory_name(ContextFile, Dir)
 1102    ).

 $chk_alias_file(+Spec, +Exts, +Cond, +Cache, +CWD, -FullFile) is nondet

 1107:- dynamic
 1108    '$search_path_file_cache'/3,    % SHA1, Time, Path
 1109    '$search_path_gc_time'/1.       % Time
 1110:- volatile
 1111    '$search_path_file_cache'/3,
 1112    '$search_path_gc_time'/1. 1113
 1114:- create_prolog_flag(file_search_cache_time, 10, []). 1115
 1116'$chk_alias_file'(Spec, Exts, Cond, true, CWD, FullFile) :-
 1117    !,
 1118    findall(Exp, expand_file_search_path(Spec, Exp), Expansions),
 1119    Cache = cache(Exts, Cond, CWD, Expansions),
 1120    variant_sha1(Spec+Cache, SHA1),
 1121    get_time(Now),
 1122    current_prolog_flag(file_search_cache_time, TimeOut),
 1123    (   '$search_path_file_cache'(SHA1, CachedTime, FullFile),
 1124        CachedTime > Now - TimeOut,
 1125        '$file_conditions'(Cond, FullFile)
 1126    ->  '$search_message'(file_search(cache(Spec, Cond), FullFile))
 1127    ;   '$member'(Expanded, Expansions),
 1128        '$extend_file'(Expanded, Exts, LibFile),
 1129        (   '$file_conditions'(Cond, LibFile),
 1130            '$absolute_file_name'(LibFile, FullFile),
 1131            '$cache_file_found'(SHA1, Now, TimeOut, FullFile)
 1132        ->  '$search_message'(file_search(found(Spec, Cond), FullFile))
 1133        ;   '$search_message'(file_search(tried(Spec, Cond), LibFile)),
 1134            fail
 1135        )
 1136    ).
 1137'$chk_alias_file'(Spec, Exts, Cond, false, _CWD, FullFile) :-
 1138    expand_file_search_path(Spec, Expanded),
 1139    '$extend_file'(Expanded, Exts, LibFile),
 1140    '$file_conditions'(Cond, LibFile),
 1141    '$absolute_file_name'(LibFile, FullFile).
 1142
 1143'$cache_file_found'(_, _, TimeOut, _) :-
 1144    TimeOut =:= 0,
 1145    !.
 1146'$cache_file_found'(SHA1, Now, TimeOut, FullFile) :-
 1147    '$search_path_file_cache'(SHA1, Saved, FullFile),
 1148    !,
 1149    (   Now - Saved < TimeOut/2
 1150    ->  true
 1151    ;   retractall('$search_path_file_cache'(SHA1, _, _)),
 1152        asserta('$search_path_file_cache'(SHA1, Now, FullFile))
 1153    ).
 1154'$cache_file_found'(SHA1, Now, TimeOut, FullFile) :-
 1155    'gc_file_search_cache'(TimeOut),
 1156    asserta('$search_path_file_cache'(SHA1, Now, FullFile)).
 1157
 1158'gc_file_search_cache'(TimeOut) :-
 1159    get_time(Now),
 1160    '$search_path_gc_time'(Last),
 1161    Now-Last < TimeOut/2,
 1162    !.
 1163'gc_file_search_cache'(TimeOut) :-
 1164    get_time(Now),
 1165    retractall('$search_path_gc_time'(_)),
 1166    assertz('$search_path_gc_time'(Now)),
 1167    Before is Now - TimeOut,
 1168    (   '$search_path_file_cache'(SHA1, Cached, FullFile),
 1169        Cached < Before,
 1170        retractall('$search_path_file_cache'(SHA1, Cached, FullFile)),
 1171        fail
 1172    ;   true
 1173    ).
 1174
 1175
 1176'$search_message'(Term) :-
 1177    current_prolog_flag(verbose_file_search, true),
 1178    !,
 1179    print_message(informational, Term).
 1180'$search_message'(_).

 $file_conditions(+Condition, +Path)

Verify Path satisfies Condition.

 1187'$file_conditions'(List, File) :-
 1188    is_list(List),
 1189    !,
 1190    \+ ( '$member'(C, List),
 1191         '$file_condition'(C),
 1192         \+ '$file_condition'(C, File)
 1193       ).
 1194'$file_conditions'(Map, File) :-
 1195    \+ (  get_dict(Key, Map, Value),
 1196          C =.. [Key,Value],
 1197          '$file_condition'(C),
 1198         \+ '$file_condition'(C, File)
 1199       ).
 1200
 1201'$file_condition'(file_type(directory), File) :-
 1202    !,
 1203    exists_directory(File).
 1204'$file_condition'(file_type(_), File) :-
 1205    !,
 1206    \+ exists_directory(File).
 1207'$file_condition'(access(Accesses), File) :-
 1208    !,
 1209    \+ (  '$one_or_member'(Access, Accesses),
 1210          \+ access_file(File, Access)
 1211       ).
 1212
 1213'$file_condition'(exists).
 1214'$file_condition'(file_type(_)).
 1215'$file_condition'(access(_)).
 1216
 1217'$extend_file'(File, Exts, FileEx) :-
 1218    '$ensure_extensions'(Exts, File, Fs),
 1219    '$list_to_set'(Fs, FsSet),
 1220    '$member'(FileEx, FsSet).
 1221
 1222'$ensure_extensions'([], _, []).
 1223'$ensure_extensions'([E|E0], F, [FE|E1]) :-
 1224    file_name_extension(F, E, FE),
 1225    '$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.

 1234'$list_to_set'(List, Set) :-
 1235    '$list_to_set'(List, [], Set).
 1236
 1237'$list_to_set'([], _, []).
 1238'$list_to_set'([H|T], Seen, R) :-
 1239    memberchk(H, Seen),
 1240    !,
 1241    '$list_to_set'(T, R).
 1242'$list_to_set'([H|T], Seen, [H|R]) :-
 1243    '$list_to_set'(T, [H|Seen], R).
 1244
 1245/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
 1246Canonicalise the extension list. Old SWI-Prolog   require  `.pl', etc, which
 1247the Quintus compatibility  requests  `pl'.   This  layer  canonicalises  all
 1248extensions to .ext
 1249- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
 1250
 1251'$canonicalise_extensions'([], []) :- !.
 1252'$canonicalise_extensions'([H|T], [CH|CT]) :-
 1253    !,
 1254    '$must_be'(atom, H),
 1255    '$canonicalise_extension'(H, CH),
 1256    '$canonicalise_extensions'(T, CT).
 1257'$canonicalise_extensions'(E, [CE]) :-
 1258    '$canonicalise_extension'(E, CE).
 1259
 1260'$canonicalise_extension'('', '') :- !.
 1261'$canonicalise_extension'(DotAtom, DotAtom) :-
 1262    sub_atom(DotAtom, 0, _, _, '.'),
 1263    !.
 1264'$canonicalise_extension'(Atom, DotAtom) :-
 1265    atom_concat('.', Atom, DotAtom).
 1266
 1267
 1268                /********************************
 1269                *            CONSULT            *
 1270                *********************************/
 1271
 1272:- dynamic
 1273    user:library_directory/1,
 1274    user:prolog_load_file/2. 1275:- multifile
 1276    user:library_directory/1,
 1277    user:prolog_load_file/2. 1278
 1279:- prompt(_, '|: '). 1280
 1281:- thread_local
 1282    '$compilation_mode_store'/1,    % database, wic, qlf
 1283    '$directive_mode_store'/1.      % database, wic, qlf
 1284:- volatile
 1285    '$compilation_mode_store'/1,
 1286    '$directive_mode_store'/1. 1287
 1288'$compilation_mode'(Mode) :-
 1289    (   '$compilation_mode_store'(Val)
 1290    ->  Mode = Val
 1291    ;   Mode = database
 1292    ).
 1293
 1294'$set_compilation_mode'(Mode) :-
 1295    retractall('$compilation_mode_store'(_)),
 1296    assertz('$compilation_mode_store'(Mode)).
 1297
 1298'$compilation_mode'(Old, New) :-
 1299    '$compilation_mode'(Old),
 1300    (   New == Old
 1301    ->  true
 1302    ;   '$set_compilation_mode'(New)
 1303    ).
 1304
 1305'$directive_mode'(Mode) :-
 1306    (   '$directive_mode_store'(Val)
 1307    ->  Mode = Val
 1308    ;   Mode = database
 1309    ).
 1310
 1311'$directive_mode'(Old, New) :-
 1312    '$directive_mode'(Old),
 1313    (   New == Old
 1314    ->  true
 1315    ;   '$set_directive_mode'(New)
 1316    ).
 1317
 1318'$set_directive_mode'(Mode) :-
 1319    retractall('$directive_mode_store'(_)),
 1320    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.

 1328'$compilation_level'(Level) :-
 1329    '$input_context'(Stack),
 1330    '$compilation_level'(Stack, Level).
 1331
 1332'$compilation_level'([], 0).
 1333'$compilation_level'([Input|T], Level) :-
 1334    (   arg(1, Input, see)
 1335    ->  '$compilation_level'(T, Level)
 1336    ;   '$compilation_level'(T, Level0),
 1337        Level is Level0+1
 1338    ).

 compiling

Is true if SWI-Prolog is generating a state or qlf file or executes a `call' directive while doing this.

 1346compiling :-
 1347    \+ (   '$compilation_mode'(database),
 1348           '$directive_mode'(database)
 1349       ).
 1350
 1351:- meta_predicate
 1352    '$ifcompiling'(0). 1353
 1354'$ifcompiling'(G) :-
 1355    (   '$compilation_mode'(database)
 1356    ->  true
 1357    ;   call(G)
 1358    ).
 1359
 1360                /********************************
 1361                *         READ SOURCE           *
 1362                *********************************/

 $load_msg_level(+Action, +NestingLevel, -StartVerbose, -EndVerbose)

 1366'$load_msg_level'(Action, Nesting, Start, Done) :-
 1367    '$update_autoload_level'([], 0),
 1368    !,
 1369    current_prolog_flag(verbose_load, Type0),
 1370    '$load_msg_compat'(Type0, Type),
 1371    (   '$load_msg_level'(Action, Nesting, Type, Start, Done)
 1372    ->  true
 1373    ).
 1374'$load_msg_level'(_, _, silent, silent).
 1375
 1376'$load_msg_compat'(true, normal) :- !.
 1377'$load_msg_compat'(false, silent) :- !.
 1378'$load_msg_compat'(X, X).
 1379
 1380'$load_msg_level'(load_file,    _, full,   informational, informational).
 1381'$load_msg_level'(include_file, _, full,   informational, informational).
 1382'$load_msg_level'(load_file,    _, normal, silent,        informational).
 1383'$load_msg_level'(include_file, _, normal, silent,        silent).
 1384'$load_msg_level'(load_file,    0, brief,  silent,        informational).
 1385'$load_msg_level'(load_file,    _, brief,  silent,        silent).
 1386'$load_msg_level'(include_file, _, brief,  silent,        silent).
 1387'$load_msg_level'(load_file,    _, silent, silent,        silent).
 1388'$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)

 1411'$source_term'(From, Read, RLayout, Term, TLayout, Stream, Options) :-
 1412    '$source_term'(From, Read, RLayout, Term, TLayout, Stream, [], Options),
 1413    (   Term == end_of_file
 1414    ->  !, fail
 1415    ;   true
 1416    ).
 1417
 1418'$source_term'(Input, _,_,_,_,_,_,_) :-
 1419    \+ ground(Input),
 1420    !,
 1421    '$instantiation_error'(Input).
 1422'$source_term'(stream(Id, In, Opts),
 1423               Read, RLayout, Term, TLayout, Stream, Parents, Options) :-
 1424    !,
 1425    '$record_included'(Parents, Id, Id, 0.0, Message),
 1426    setup_call_cleanup(
 1427        '$open_source'(stream(Id, In, Opts), In, State, Parents, Options),
 1428        '$term_in_file'(In, Read, RLayout, Term, TLayout, Stream,
 1429                        [Id|Parents], Options),
 1430        '$close_source'(State, Message)).
 1431'$source_term'(File,
 1432               Read, RLayout, Term, TLayout, Stream, Parents, Options) :-
 1433    absolute_file_name(File, Path,
 1434                       [ file_type(prolog),
 1435                         access(read)
 1436                       ]),
 1437    time_file(Path, Time),
 1438    '$record_included'(Parents, File, Path, Time, Message),
 1439    setup_call_cleanup(
 1440        '$open_source'(Path, In, State, Parents, Options),
 1441        '$term_in_file'(In, Read, RLayout, Term, TLayout, Stream,
 1442                        [Path|Parents], Options),
 1443        '$close_source'(State, Message)).
 1444
 1445:- thread_local
 1446    '$load_input'/2. 1447:- volatile
 1448    '$load_input'/2. 1449
 1450'$open_source'(stream(Id, In, Opts), In,
 1451               restore(In, StreamState, Id, Ref, Opts), Parents, Options) :-
 1452    !,
 1453    '$context_type'(Parents, ContextType),
 1454    '$push_input_context'(ContextType),
 1455    '$set_encoding'(In, Options),
 1456    '$prepare_load_stream'(In, Id, StreamState),
 1457    asserta('$load_input'(stream(Id), In), Ref).
 1458'$open_source'(Path, In, close(In, Path, Ref), Parents, Options) :-
 1459    '$context_type'(Parents, ContextType),
 1460    '$push_input_context'(ContextType),
 1461    open(Path, read, In),
 1462    '$set_encoding'(In, Options),
 1463    asserta('$load_input'(Path, In), Ref).
 1464
 1465'$context_type'([], load_file) :- !.
 1466'$context_type'(_, include).
 1467
 1468'$close_source'(close(In, Id, Ref), Message) :-
 1469    erase(Ref),
 1470    '$end_consult'(Id),
 1471    call_cleanup(
 1472        close(In),
 1473        '$pop_input_context'),
 1474    '$close_message'(Message).
 1475'$close_source'(restore(In, StreamState, Id, Ref, Opts), Message) :-
 1476    erase(Ref),
 1477    '$end_consult'(Id),
 1478    call_cleanup(
 1479        '$restore_load_stream'(In, StreamState, Opts),
 1480        '$pop_input_context'),
 1481    '$close_message'(Message).
 1482
 1483'$close_message'(message(Level, Msg)) :-
 1484    !,
 1485    '$print_message'(Level, Msg).
 1486'$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.

 1498'$term_in_file'(In, Read, RLayout, Term, TLayout, Stream, Parents, Options) :-
 1499    '$skip_script_line'(In),
 1500    '$read_clause_options'(Options, ReadOptions),
 1501    repeat,
 1502      read_clause(In, Raw,
 1503                  [ variable_names(Bindings),
 1504                    term_position(Pos),
 1505                    subterm_positions(RawLayout)
 1506                  | ReadOptions
 1507                  ]),
 1508      b_setval('$term_position', Pos),
 1509      b_setval('$variable_names', Bindings),
 1510      (   Raw == end_of_file
 1511      ->  !,
 1512          (   Parents = [_,_|_]     % Included file
 1513          ->  fail
 1514          ;   '$expanded_term'(In,
 1515                               Raw, RawLayout, Read, RLayout, Term, TLayout,
 1516                               Stream, Parents, Options)
 1517          )
 1518      ;   '$expanded_term'(In, Raw, RawLayout, Read, RLayout, Term, TLayout,
 1519                           Stream, Parents, Options)
 1520      ).
 1521
 1522'$read_clause_options'([], []).
 1523'$read_clause_options'([H|T0], List) :-
 1524    (   '$read_clause_option'(H)
 1525    ->  List = [H|T]
 1526    ;   List = T
 1527    ),
 1528    '$read_clause_options'(T0, T).
 1529
 1530'$read_clause_option'(syntax_errors(_)).
 1531'$read_clause_option'(term_position(_)).
 1532'$read_clause_option'(process_comment(_)).
 1533
 1534'$expanded_term'(In, Raw, RawLayout, Read, RLayout, Term, TLayout,
 1535                 Stream, Parents, Options) :-
 1536    catch('$expand_term'(Raw, RawLayout, Expanded, ExpandedLayout), E,
 1537          '$print_message_fail'(E)),
 1538    (   Expanded \== []
 1539    ->  '$expansion_member'(Expanded, ExpandedLayout, Term1, Layout1)
 1540    ;   Term1 = Expanded,
 1541        Layout1 = ExpandedLayout
 1542    ),
 1543    (   nonvar(Term1), Term1 = (:-Directive), nonvar(Directive)
 1544    ->  (   Directive = include(File),
 1545            '$current_source_module'(Module),
 1546            '$valid_directive'(Module:include(File))
 1547        ->  stream_property(In, encoding(Enc)),
 1548            '$add_encoding'(Enc, Options, Options1),
 1549            '$source_term'(File, Read, RLayout, Term, TLayout,
 1550                           Stream, Parents, Options1)
 1551        ;   Directive = encoding(Enc)
 1552        ->  set_stream(In, encoding(Enc)),
 1553            fail
 1554        ;   Term = Term1,
 1555            Stream = In,
 1556            Read = Raw
 1557        )
 1558    ;   Term = Term1,
 1559        TLayout = Layout1,
 1560        Stream = In,
 1561        Read = Raw,
 1562        RLayout = RawLayout
 1563    ).
 1564
 1565'$expansion_member'(Var, Layout, Var, Layout) :-
 1566    var(Var),
 1567    !.
 1568'$expansion_member'([], _, _, _) :- !, fail.
 1569'$expansion_member'(List, ListLayout, Term, Layout) :-
 1570    is_list(List),
 1571    !,
 1572    (   var(ListLayout)
 1573    ->  '$member'(Term, List)
 1574    ;   is_list(ListLayout)
 1575    ->  '$member_rep2'(Term, Layout, List, ListLayout)
 1576    ;   Layout = ListLayout,
 1577        '$member'(Term, List)
 1578    ).
 1579'$expansion_member'(X, Layout, X, Layout).
 1580
 1581% pairwise member, repeating last element of the second
 1582% list.
 1583
 1584'$member_rep2'(H1, H2, [H1|_], [H2|_]).
 1585'$member_rep2'(H1, H2, [_|T1], [T2]) :-
 1586    !,
 1587    '$member_rep2'(H1, H2, T1, [T2]).
 1588'$member_rep2'(H1, H2, [_|T1], [_|T2]) :-
 1589    '$member_rep2'(H1, H2, T1, T2).

 $add_encoding(+Enc, +Options0, -Options)

 1593'$add_encoding'(Enc, Options0, Options) :-
 1594    (   Options0 = [encoding(Enc)|_]
 1595    ->  Options = Options0
 1596    ;   Options = [encoding(Enc)|Options0]
 1597    ).
 1598
 1599
 1600:- multifile
 1601    '$included'/4.                  % Into, Line, File, LastModified
 1602:- dynamic
 1603    '$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'.

 1617'$record_included'([Parent|Parents], File, Path, Time,
 1618                   message(DoneMsgLevel,
 1619                           include_file(done(Level, file(File, Path))))) :-
 1620    source_location(SrcFile, Line),
 1621    !,
 1622    '$compilation_level'(Level),
 1623    '$load_msg_level'(include_file, Level, StartMsgLevel, DoneMsgLevel),
 1624    '$print_message'(StartMsgLevel,
 1625                     include_file(start(Level,
 1626                                        file(File, Path)))),
 1627    '$last'([Parent|Parents], Owner),
 1628    (   (   '$compilation_mode'(database)
 1629        ;   '$qlf_current_source'(Owner)
 1630        )
 1631    ->  '$store_admin_clause'(
 1632            system:'$included'(Parent, Line, Path, Time),
 1633            _, Owner, SrcFile:Line)
 1634    ;   '$qlf_include'(Owner, Parent, Line, Path, Time)
 1635    ).
 1636'$record_included'(_, _, _, _, true).

 $master_file(+File, -MasterFile)

Find the primary load file from included files.

 1642'$master_file'(File, MasterFile) :-
 1643    '$included'(MasterFile0, _Line, File, _Time),
 1644    !,
 1645    '$master_file'(MasterFile0, MasterFile).
 1646'$master_file'(File, File).
 1647
 1648
 1649'$skip_script_line'(In) :-
 1650    (   peek_char(In, #)
 1651    ->  skip(In, 10)
 1652    ;   true
 1653    ).
 1654
 1655'$set_encoding'(Stream, Options) :-
 1656    '$option'(encoding(Enc), Options),
 1657    !,
 1658    Enc \== default,
 1659    set_stream(Stream, encoding(Enc)).
 1660'$set_encoding'(_, _).
 1661
 1662
 1663'$prepare_load_stream'(In, Id, state(HasName,HasPos)) :-
 1664    (   stream_property(In, file_name(_))
 1665    ->  HasName = true,
 1666        (   stream_property(In, position(_))
 1667        ->  HasPos = true
 1668        ;   HasPos = false,
 1669            set_stream(In, record_position(true))
 1670        )
 1671    ;   HasName = false,
 1672        set_stream(In, file_name(Id)),
 1673        (   stream_property(In, position(_))
 1674        ->  HasPos = true
 1675        ;   HasPos = false,
 1676            set_stream(In, record_position(true))
 1677        )
 1678    ).
 1679
 1680'$restore_load_stream'(In, _State, Options) :-
 1681    memberchk(close(true), Options),
 1682    !,
 1683    close(In).
 1684'$restore_load_stream'(In, state(HasName, HasPos), _Options) :-
 1685    (   HasName == false
 1686    ->  set_stream(In, file_name(''))
 1687    ;   true
 1688    ),
 1689    (   HasPos == false
 1690    ->  set_stream(In, record_position(false))
 1691    ;   true
 1692    ).
 1693
 1694
 1695                 /*******************************
 1696                 *          DERIVED FILES       *
 1697                 *******************************/
 1698
 1699:- dynamic
 1700    '$derived_source_db'/3.         % Loaded, DerivedFrom, Time
 1701
 1702'$register_derived_source'(_, '-') :- !.
 1703'$register_derived_source'(Loaded, DerivedFrom) :-
 1704    retractall('$derived_source_db'(Loaded, _, _)),
 1705    time_file(DerivedFrom, Time),
 1706    assert('$derived_source_db'(Loaded, DerivedFrom, Time)).
 1707
 1708%       Auto-importing dynamic predicates is not very elegant and
 1709%       leads to problems with qsave_program/[1,2]
 1710
 1711'$derived_source'(Loaded, DerivedFrom, Time) :-
 1712    '$derived_source_db'(Loaded, DerivedFrom, Time).
 1713
 1714
 1715                /********************************
 1716                *       LOAD PREDICATES         *
 1717                *********************************/
 1718
 1719:- meta_predicate
 1720    ensure_loaded(:),
 1721    [:|+],
 1722    consult(:),
 1723    use_module(:),
 1724    use_module(:, +),
 1725    reexport(:),
 1726    reexport(:, +),
 1727    load_files(:),
 1728    load_files(:, +).