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-2019, 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).

  100dynamic(Spec)            :- '$set_pattr'(Spec, pred, (dynamic)).
  101multifile(Spec)          :- '$set_pattr'(Spec, pred, (multifile)).
  102module_transparent(Spec) :- '$set_pattr'(Spec, pred, (transparent)).
  103discontiguous(Spec)      :- '$set_pattr'(Spec, pred, (discontiguous)).
  104volatile(Spec)           :- '$set_pattr'(Spec, pred, (volatile)).
  105thread_local(Spec)       :- '$set_pattr'(Spec, pred, (thread_local)).
  106noprofile(Spec)          :- '$set_pattr'(Spec, pred, (noprofile)).
  107public(Spec)             :- '$set_pattr'(Spec, pred, (public)).
  108non_terminal(Spec)       :- '$set_pattr'(Spec, pred, (non_terminal)).
  109'$iso'(Spec)             :- '$set_pattr'(Spec, pred, (iso)).
  110'$clausable'(Spec)       :- '$set_pattr'(Spec, pred, (clausable)).
  111
  112'$set_pattr'(M:Pred, How, Attr) :-
  113    '$set_pattr'(Pred, M, How, Attr).
  114
  115'$set_pattr'(X, _, _, _) :-
  116    var(X),
  117    throw(error(instantiation_error, _)).
  118'$set_pattr'([], _, _, _) :- !.
  119'$set_pattr'([H|T], M, How, Attr) :-           % ISO
  120    !,
  121    '$set_pattr'(H, M, How, Attr),
  122    '$set_pattr'(T, M, How, Attr).
  123'$set_pattr'((A,B), M, How, Attr) :-           % ISO and traditional
  124    !,
  125    '$set_pattr'(A, M, How, Attr),
  126    '$set_pattr'(B, M, How, Attr).
  127'$set_pattr'(M:T, _, How, Attr) :-
  128    !,
  129    '$set_pattr'(T, M, How, Attr).
  130'$set_pattr'(A, M, pred, Attr) :-
  131    !,
  132    '$set_predicate_attribute'(M:A, Attr, true).
  133'$set_pattr'(A, M, directive, Attr) :-
  134    !,
  135    catch('$set_predicate_attribute'(M:A, Attr, true),
  136          error(E, _),
  137          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.

  146'$pattr_directive'(dynamic(Spec), M) :-
  147    '$set_pattr'(Spec, M, directive, (dynamic)).
  148'$pattr_directive'(multifile(Spec), M) :-
  149    '$set_pattr'(Spec, M, directive, (multifile)).
  150'$pattr_directive'(module_transparent(Spec), M) :-
  151    '$set_pattr'(Spec, M, directive, (transparent)).
  152'$pattr_directive'(discontiguous(Spec), M) :-
  153    '$set_pattr'(Spec, M, directive, (discontiguous)).
  154'$pattr_directive'(volatile(Spec), M) :-
  155    '$set_pattr'(Spec, M, directive, (volatile)).
  156'$pattr_directive'(thread_local(Spec), M) :-
  157    '$set_pattr'(Spec, M, directive, (thread_local)).
  158'$pattr_directive'(noprofile(Spec), M) :-
  159    '$set_pattr'(Spec, M, directive, (noprofile)).
  160'$pattr_directive'(public(Spec), M) :-
  161    '$set_pattr'(Spec, M, directive, (public)).

 $hide(:PI)

Predicates protected this way are never visible in the tracer.

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

  243'$meta_call'(M:G) :-
  244    prolog_current_choice(Ch),
  245    '$meta_call'(G, M, Ch).
  246
  247'$meta_call'(Var, _, _) :-
  248    var(Var),
  249    !,
  250    '$instantiation_error'(Var).
  251'$meta_call'((A,B), M, Ch) :-
  252    !,
  253    '$meta_call'(A, M, Ch),
  254    '$meta_call'(B, M, Ch).
  255'$meta_call'((I->T;E), M, Ch) :-
  256    !,
  257    (   prolog_current_choice(Ch2),
  258        '$meta_call'(I, M, Ch2)
  259    ->  '$meta_call'(T, M, Ch)
  260    ;   '$meta_call'(E, M, Ch)
  261    ).
  262'$meta_call'((I*->T;E), M, Ch) :-
  263    !,
  264    (   prolog_current_choice(Ch2),
  265        '$meta_call'(I, M, Ch2)
  266    *-> '$meta_call'(T, M, Ch)
  267    ;   '$meta_call'(E, M, Ch)
  268    ).
  269'$meta_call'((I->T), M, Ch) :-
  270    !,
  271    (   prolog_current_choice(Ch2),
  272        '$meta_call'(I, M, Ch2)
  273    ->  '$meta_call'(T, M, Ch)
  274    ).
  275'$meta_call'((I*->T), M, Ch) :-
  276    !,
  277    prolog_current_choice(Ch2),
  278    '$meta_call'(I, M, Ch2),
  279    '$meta_call'(T, M, Ch).
  280'$meta_call'((A;B), M, Ch) :-
  281    !,
  282    (   '$meta_call'(A, M, Ch)
  283    ;   '$meta_call'(B, M, Ch)
  284    ).
  285'$meta_call'(\+(G), M, _) :-
  286    !,
  287    prolog_current_choice(Ch),
  288    \+ '$meta_call'(G, M, Ch).
  289'$meta_call'(call(G), M, _) :-
  290    !,
  291    prolog_current_choice(Ch),
  292    '$meta_call'(G, M, Ch).
  293'$meta_call'(M:G, _, Ch) :-
  294    !,
  295    '$meta_call'(G, M, Ch).
  296'$meta_call'(!, _, Ch) :-
  297    prolog_cut_to(Ch).
  298'$meta_call'(G, M, _Ch) :-
  299    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..

  315:- '$iso'((call/2,
  316           call/3,
  317           call/4,
  318           call/5,
  319           call/6,
  320           call/7,
  321           call/8)).  322
  323call(Goal) :-                           % make these available as predicates
  324    Goal.
  325call(Goal, A) :-
  326    call(Goal, A).
  327call(Goal, A, B) :-
  328    call(Goal, A, B).
  329call(Goal, A, B, C) :-
  330    call(Goal, A, B, C).
  331call(Goal, A, B, C, D) :-
  332    call(Goal, A, B, C, D).
  333call(Goal, A, B, C, D, E) :-
  334    call(Goal, A, B, C, D, E).
  335call(Goal, A, B, C, D, E, F) :-
  336    call(Goal, A, B, C, D, E, F).
  337call(Goal, A, B, C, D, E, F, G) :-
  338    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.

  345not(Goal) :-
  346    \+ Goal.

 \+ :Goal is semidet

Predicate version that allows for meta-calling.

  352\+ Goal :-
  353    \+ Goal.

 once(:Goal) is semidet

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

  359once(Goal) :-
  360    Goal,
  361    !.

 ignore(:Goal) is det

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

  368ignore(Goal) :-
  369    Goal,
  370    !.
  371ignore(_Goal).
  372
  373:- '$iso'((false/0)).

 false

Synonym for fail/0, providing a declarative reading.

  379false :-
  380    fail.

 catch(:Goal, +Catcher, :Recover)

ISO compliant exception handling.

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

 prolog_cut_to(+Choice)

Cut all choice points after Choice

  393prolog_cut_to(_Choice) :-
  394    '$cut'.                         % Maps to I_CUTCHP

 reset(:Goal, ?Ball, -Continue)

Delimited continuation support.

  400reset(_Goal, _Ball, _Cont) :-
  401    '$reset'.

 shift(+Ball)

Shift control back to the enclosing reset/3

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

  422call_continuation([]).
  423call_continuation([TB|Rest]) :-
  424    (   Rest == []
  425    ->  '$call_continuation'(TB)
  426    ;   '$call_continuation'(TB),
  427        call_continuation(Rest)
  428    ).

 catch_with_backtrace(:Goal, ?Ball, :Recover)

As catch/3, but tell library(prolog_stack) to record a backtrace in case of an exception.

  435catch_with_backtrace(Goal, Ball, Recover) :-
  436    catch(Goal, Ball, Recover),
  437    '$no_lco'.
  438
  439'$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.

  449:- public '$recover_and_rethrow'/2.  450
  451'$recover_and_rethrow'(Goal, Exception) :-
  452    call_cleanup(Goal, throw(Exception)),
  453    !.

 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.

  468setup_call_catcher_cleanup(Setup, _Goal, _Catcher, _Cleanup) :-
  469    '$sig_atomic'(Setup),
  470    '$call_cleanup'.
  471
  472setup_call_cleanup(Setup, Goal, Cleanup) :-
  473    setup_call_catcher_cleanup(Setup, Goal, _Catcher, Cleanup).
  474
  475call_cleanup(Goal, Cleanup) :-
  476    setup_call_catcher_cleanup(true, Goal, _Catcher, Cleanup).
  477
  478call_cleanup(Goal, Catcher, Cleanup) :-
  479    setup_call_catcher_cleanup(true, Goal, Catcher, Cleanup).
  480
  481                 /*******************************
  482                 *       INITIALIZATION         *
  483                 *******************************/
  484
  485:- meta_predicate
  486    initialization(0, +).  487
  488:- multifile '$init_goal'/3.  489:- 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.

  515initialization(Goal, When) :-
  516    '$must_be'(oneof(atom, initialization_type,
  517                     [ now,
  518                       after_load,
  519                       restore,
  520                       restore_state,
  521                       prepare_state,
  522                       program,
  523                       main
  524                     ]), When),
  525    '$initialization_context'(Source, Ctx),
  526    '$initialization'(When, Goal, Source, Ctx).
  527
  528'$initialization'(now, Goal, _Source, Ctx) :-
  529    '$run_init_goal'(Goal, Ctx),
  530    '$compile_init_goal'(-, Goal, Ctx).
  531'$initialization'(after_load, Goal, Source, Ctx) :-
  532    (   Source \== (-)
  533    ->  '$compile_init_goal'(Source, Goal, Ctx)
  534    ;   throw(error(context_error(nodirective,
  535                                  initialization(Goal, after_load)),
  536                    _))
  537    ).
  538'$initialization'(restore, Goal, Source, Ctx) :- % deprecated
  539    '$initialization'(restore_state, Goal, Source, Ctx).
  540'$initialization'(restore_state, Goal, _Source, Ctx) :-
  541    (   \+ current_prolog_flag(sandboxed_load, true)
  542    ->  '$compile_init_goal'(-, Goal, Ctx)
  543    ;   '$permission_error'(register, initialization(restore), Goal)
  544    ).
  545'$initialization'(prepare_state, Goal, _Source, Ctx) :-
  546    (   \+ current_prolog_flag(sandboxed_load, true)
  547    ->  '$compile_init_goal'(when(prepare_state), Goal, Ctx)
  548    ;   '$permission_error'(register, initialization(restore), Goal)
  549    ).
  550'$initialization'(program, Goal, _Source, Ctx) :-
  551    (   \+ current_prolog_flag(sandboxed_load, true)
  552    ->  '$compile_init_goal'(when(program), Goal, Ctx)
  553    ;   '$permission_error'(register, initialization(restore), Goal)
  554    ).
  555'$initialization'(main, Goal, _Source, Ctx) :-
  556    (   \+ current_prolog_flag(sandboxed_load, true)
  557    ->  '$compile_init_goal'(when(main), Goal, Ctx)
  558    ;   '$permission_error'(register, initialization(restore), Goal)
  559    ).
  560
  561
  562'$compile_init_goal'(Source, Goal, Ctx) :-
  563    atom(Source),
  564    Source \== (-),
  565    !,
  566    '$store_admin_clause'(system:'$init_goal'(Source, Goal, Ctx),
  567                          _Layout, Source, Ctx).
  568'$compile_init_goal'(Source, Goal, Ctx) :-
  569    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.

  581'$run_initialization'(_, loaded, _) :- !.
  582'$run_initialization'(File, _Action, Options) :-
  583    '$run_initialization'(File, Options).
  584
  585'$run_initialization'(File, Options) :-
  586    setup_call_cleanup(
  587        '$start_run_initialization'(Options, Restore),
  588        '$run_initialization_2'(File),
  589        '$end_run_initialization'(Restore)).
  590
  591'$start_run_initialization'(Options, OldSandBoxed) :-
  592    '$push_input_context'(initialization),
  593    '$set_sandboxed_load'(Options, OldSandBoxed).
  594'$end_run_initialization'(OldSandBoxed) :-
  595    set_prolog_flag(sandboxed_load, OldSandBoxed),
  596    '$pop_input_context'.
  597
  598'$run_initialization_2'(File) :-
  599    (   '$init_goal'(File, Goal, Ctx),
  600        File \= when(_),
  601        '$run_init_goal'(Goal, Ctx),
  602        fail
  603    ;   true
  604    ).
  605
  606'$run_init_goal'(Goal, Ctx) :-
  607    (   catch_with_backtrace('$run_init_goal'(Goal), E,
  608                             '$initialization_error'(E, Goal, Ctx))
  609    ->  true
  610    ;   '$initialization_failure'(Goal, Ctx)
  611    ).
  612
  613:- multifile prolog:sandbox_allowed_goal/1.  614
  615'$run_init_goal'(Goal) :-
  616    current_prolog_flag(sandboxed_load, false),
  617    !,
  618    call(Goal).
  619'$run_init_goal'(Goal) :-
  620    prolog:sandbox_allowed_goal(Goal),
  621    call(Goal).
  622
  623'$initialization_context'(Source, Ctx) :-
  624    (   source_location(File, Line)
  625    ->  Ctx = File:Line,
  626        '$input_context'(Context),
  627        '$top_file'(Context, File, Source)
  628    ;   Ctx = (-),
  629        File = (-)
  630    ).
  631
  632'$top_file'([input(include, F1, _, _)|T], _, F) :-
  633    !,
  634    '$top_file'(T, F1, F).
  635'$top_file'(_, F, F).
  636
  637
  638'$initialization_error'(E, Goal, Ctx) :-
  639    print_message(error, initialization_error(Goal, E, Ctx)).
  640
  641'$initialization_failure'(Goal, Ctx) :-
  642    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

  650:- public '$clear_source_admin'/1.  651
  652'$clear_source_admin'(File) :-
  653    retractall('$init_goal'(_, _, File:_)),
  654    retractall('$load_context_module'(File, _, _)),
  655    retractall('$resolved_source_path'(_, File)).
  656
  657
  658                 /*******************************
  659                 *            STREAM            *
  660                 *******************************/
  661
  662:- '$iso'(stream_property/2).  663stream_property(Stream, Property) :-
  664    nonvar(Stream),
  665    nonvar(Property),
  666    !,
  667    '$stream_property'(Stream, Property).
  668stream_property(Stream, Property) :-
  669    nonvar(Stream),
  670    !,
  671    '$stream_properties'(Stream, Properties),
  672    '$member'(Property, Properties).
  673stream_property(Stream, Property) :-
  674    nonvar(Property),
  675    !,
  676    (   Property = alias(Alias),
  677        atom(Alias)
  678    ->  '$alias_stream'(Alias, Stream)
  679    ;   '$streams_properties'(Property, Pairs),
  680        '$member'(Stream-Property, Pairs)
  681    ).
  682stream_property(Stream, Property) :-
  683    '$streams_properties'(Property, Pairs),
  684    '$member'(Stream-Properties, Pairs),
  685    '$member'(Property, Properties).
  686
  687
  688                /********************************
  689                *            MODULES            *
  690                *********************************/
  691
  692%       '$prefix_module'(+Module, +Context, +Term, -Prefixed)
  693%       Tags `Term' with `Module:' if `Module' is not the context module.
  694
  695'$prefix_module'(Module, Module, Head, Head) :- !.
  696'$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'.

  702default_module(Me, Super) :-
  703    (   atom(Me)
  704    ->  (   var(Super)
  705        ->  '$default_module'(Me, Super)
  706        ;   '$default_module'(Me, Super), !
  707        )
  708    ;   '$type_error'(module, Me)
  709    ).
  710
  711'$default_module'(Me, Me).
  712'$default_module'(Me, Super) :-
  713    import_module(Me, S),
  714    '$default_module'(S, Super).
  715
  716
  717                /********************************
  718                *      TRACE AND EXCEPTIONS     *
  719                *********************************/
  720
  721:- dynamic   user:exception/3.  722:- multifile 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.

  731:- public
  732    '$undefined_procedure'/4.  733
  734'$undefined_procedure'(Module, Name, Arity, Action) :-
  735    '$prefix_module'(Module, user, Name/Arity, Pred),
  736    user:exception(undefined_predicate, Pred, Action0),
  737    !,
  738    Action = Action0.
  739'$undefined_procedure'(Module, Name, Arity, Action) :-
  740    current_prolog_flag(autoload, true),
  741    '$autoload'(Module, Name, Arity),
  742    !,
  743    Action = retry.
  744'$undefined_procedure'(_, _, _, error).
  745
  746'$autoload'(Module, Name, Arity) :-
  747    source_location(File, _Line),
  748    !,
  749    setup_call_cleanup(
  750        '$start_aux'(File, Context),
  751        '$autoload2'(Module, Name, Arity),
  752        '$end_aux'(File, Context)).
  753'$autoload'(Module, Name, Arity) :-
  754    '$autoload2'(Module, Name, Arity).
  755
  756'$autoload2'(Module, Name, Arity) :-
  757    '$find_library'(Module, Name, Arity, LoadModule, Library),
  758    functor(Head, Name, Arity),
  759    '$update_autoload_level'([autoload(true)], Old),
  760    (   current_prolog_flag(verbose_autoload, true)
  761    ->  Level = informational
  762    ;   Level = silent
  763    ),
  764    print_message(Level, autoload(Module:Name/Arity, Library)),
  765    '$compilation_mode'(OldComp, database),
  766    (   Module == LoadModule
  767    ->  ensure_loaded(Module:Library)
  768    ;   (   '$get_predicate_attribute'(LoadModule:Head, defined, 1),
  769            \+ '$loading'(Library)
  770        ->  Module:import(LoadModule:Name/Arity)
  771        ;   use_module(Module:Library, [Name/Arity])
  772        )
  773    ),
  774    '$set_compilation_mode'(OldComp),
  775    '$set_autoload_level'(Old),
  776    '$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.

  787'$loading'(Library) :-
  788    current_prolog_flag(threads, true),
  789    '$loading_file'(FullFile, _Queue, _LoadThread),
  790    file_name_extension(Library, _, FullFile),
  791    !.
  792
  793%        handle debugger 'w', 'p' and <N> depth options.
  794
  795'$set_debugger_write_options'(write) :-
  796    !,
  797    create_prolog_flag(debugger_write_options,
  798                       [ quoted(true),
  799                         attributes(dots),
  800                         spacing(next_argument)
  801                       ], []).
  802'$set_debugger_write_options'(print) :-
  803    !,
  804    create_prolog_flag(debugger_write_options,
  805                       [ quoted(true),
  806                         portray(true),
  807                         max_depth(10),
  808                         attributes(portray),
  809                         spacing(next_argument)
  810                       ], []).
  811'$set_debugger_write_options'(Depth) :-
  812    current_prolog_flag(debugger_write_options, Options0),
  813    (   '$select'(max_depth(_), Options0, Options)
  814    ->  true
  815    ;   Options = Options0
  816    ),
  817    create_prolog_flag(debugger_write_options,
  818                       [max_depth(Depth)|Options], []).
  819
  820
  821                /********************************
  822                *        SYSTEM MESSAGES        *
  823                *********************************/

 $confirm(Spec)

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

  830'$confirm'(Spec) :-
  831    print_message(query, Spec),
  832    between(0, 5, _),
  833        get_single_char(Answer),
  834        (   '$in_reply'(Answer, 'yYjJ \n')
  835        ->  !,
  836            print_message(query, if_tty([yes-[]]))
  837        ;   '$in_reply'(Answer, 'nN')
  838        ->  !,
  839            print_message(query, if_tty([no-[]])),
  840            fail
  841        ;   print_message(help, query(confirm)),
  842            fail
  843        ).
  844
  845'$in_reply'(Code, Atom) :-
  846    char_code(Char, Code),
  847    sub_atom(Atom, _, _, _, Char),
  848    !.
  849
  850:- dynamic
  851    user:portray/1.  852:- multifile
  853    user:portray/1.  854
  855
  856                 /*******************************
  857                 *       FILE_SEARCH_PATH       *
  858                 *******************************/
  859
  860:- dynamic user:file_search_path/2.  861:- multifile user:file_search_path/2.  862
  863user:(file_search_path(library, Dir) :-
  864        library_directory(Dir)).
  865user:file_search_path(swi, Home) :-
  866    current_prolog_flag(home, Home).
  867user:file_search_path(foreign, swi(ArchLib)) :-
  868    current_prolog_flag(arch, Arch),
  869    atom_concat('lib/', Arch, ArchLib).
  870user:file_search_path(foreign, swi(SoLib)) :-
  871    (   current_prolog_flag(windows, true)
  872    ->  SoLib = bin
  873    ;   SoLib = lib
  874    ).
  875user:file_search_path(path, Dir) :-
  876    getenv('PATH', Path),
  877    (   current_prolog_flag(windows, true)
  878    ->  atomic_list_concat(Dirs, (;), Path)
  879    ;   atomic_list_concat(Dirs, :, Path)
  880    ),
  881    '$member'(Dir, Dirs),
  882    '$no-null-bytes'(Dir).
  883
  884'$no-null-bytes'(Dir) :-
  885    sub_atom(Dir, _, _, _, '\u0000'),
  886    !,
  887    print_message(warning, null_byte_in_path(Dir)),
  888    fail.
  889'$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?

  897expand_file_search_path(Spec, Expanded) :-
  898    catch('$expand_file_search_path'(Spec, Expanded, 0, []),
  899          loop(Used),
  900          throw(error(loop_error(Spec), file_search(Used)))).
  901
  902'$expand_file_search_path'(Spec, Expanded, N, Used) :-
  903    functor(Spec, Alias, 1),
  904    !,
  905    user:file_search_path(Alias, Exp0),
  906    NN is N + 1,
  907    (   NN > 16
  908    ->  throw(loop(Used))
  909    ;   true
  910    ),
  911    '$expand_file_search_path'(Exp0, Exp1, NN, [Alias=Exp0|Used]),
  912    arg(1, Spec, Segments),
  913    '$segments_to_atom'(Segments, File),
  914    '$make_path'(Exp1, File, Expanded).
  915'$expand_file_search_path'(Spec, Path, _, _) :-
  916    '$segments_to_atom'(Spec, Path).
  917
  918'$make_path'(Dir, '.', Path) :-
  919    !,
  920    Path = Dir.
  921'$make_path'(Dir, File, Path) :-
  922    sub_atom(Dir, _, _, 0, /),
  923    !,
  924    atom_concat(Dir, File, Path).
  925'$make_path'(Dir, File, Path) :-
  926    atomic_list_concat([Dir, /, File], Path).
  927
  928
  929                /********************************
  930                *         FILE CHECKING         *
  931                *********************************/

 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.

  942absolute_file_name(Spec, Options, Path) :-
  943    '$is_options'(Options),
  944    \+ '$is_options'(Path),
  945    !,
  946    absolute_file_name(Spec, Path, Options).
  947absolute_file_name(Spec, Path, Options) :-
  948    '$must_be'(options, Options),
  949                    % get the valid extensions
  950    (   '$select_option'(extensions(Exts), Options, Options1)
  951    ->  '$must_be'(list, Exts)
  952    ;   '$option'(file_type(Type), Options)
  953    ->  '$must_be'(atom, Type),
  954        '$file_type_extensions'(Type, Exts),
  955        Options1 = Options
  956    ;   Options1 = Options,
  957        Exts = ['']
  958    ),
  959    '$canonicalise_extensions'(Exts, Extensions),
  960                    % unless specified otherwise, ask regular file
  961    (   nonvar(Type)
  962    ->  Options2 = Options1
  963    ;   '$merge_options'(_{file_type:regular}, Options1, Options2)
  964    ),
  965                    % Det or nondet?
  966    (   '$select_option'(solutions(Sols), Options2, Options3)
  967    ->  '$must_be'(oneof(atom, solutions, [first,all]), Sols)
  968    ;   Sols = first,
  969        Options3 = Options2
  970    ),
  971                    % Errors or not?
  972    (   '$select_option'(file_errors(FileErrors), Options3, Options4)
  973    ->  '$must_be'(oneof(atom, file_errors, [error,fail]), FileErrors)
  974    ;   FileErrors = error,
  975        Options4 = Options3
  976    ),
  977                    % Expand shell patterns?
  978    (   atomic(Spec),
  979        '$select_option'(expand(Expand), Options4, Options5),
  980        '$must_be'(boolean, Expand)
  981    ->  expand_file_name(Spec, List),
  982        '$member'(Spec1, List)
  983    ;   Spec1 = Spec,
  984        Options5 = Options4
  985    ),
  986                    % Search for files
  987    (   Sols == first
  988    ->  (   '$chk_file'(Spec1, Extensions, Options5, true, Path)
  989        ->  !       % also kill choice point of expand_file_name/2
  990        ;   (   FileErrors == fail
  991            ->  fail
  992            ;   '$current_module'('$bags', _File),
  993                findall(P,
  994                        '$chk_file'(Spec1, Extensions, [access(exist)],
  995                                    false, P),
  996                        Candidates),
  997                '$abs_file_error'(Spec, Candidates, Options5)
  998            )
  999        )
 1000    ;   '$chk_file'(Spec1, Extensions, Options5, false, Path)
 1001    ).
 1002
 1003'$abs_file_error'(Spec, Candidates, Conditions) :-
 1004    '$member'(F, Candidates),
 1005    '$member'(C, Conditions),
 1006    '$file_condition'(C),
 1007    '$file_error'(C, Spec, F, E, Comment),
 1008    !,
 1009    throw(error(E, context(_, Comment))).
 1010'$abs_file_error'(Spec, _, _) :-
 1011    '$existence_error'(source_sink, Spec).
 1012
 1013'$file_error'(file_type(directory), Spec, File, Error, Comment) :-
 1014    \+ exists_directory(File),
 1015    !,
 1016    Error = existence_error(directory, Spec),
 1017    Comment = not_a_directory(File).
 1018'$file_error'(file_type(_), Spec, File, Error, Comment) :-
 1019    exists_directory(File),
 1020    !,
 1021    Error = existence_error(file, Spec),
 1022    Comment = directory(File).
 1023'$file_error'(access(OneOrList), Spec, File, Error, _) :-
 1024    '$one_or_member'(Access, OneOrList),
 1025    \+ access_file(File, Access),
 1026    Error = permission_error(Access, source_sink, Spec).
 1027
 1028'$one_or_member'(Elem, List) :-
 1029    is_list(List),
 1030    !,
 1031    '$member'(Elem, List).
 1032'$one_or_member'(Elem, Elem).
 1033
 1034
 1035'$file_type_extensions'(source, Exts) :-       % SICStus 3.9 compatibility
 1036    !,
 1037    '$file_type_extensions'(prolog, Exts).
 1038'$file_type_extensions'(Type, Exts) :-
 1039    '$current_module'('$bags', _File),
 1040    !,
 1041    findall(Ext, user:prolog_file_type(Ext, Type), Exts0),
 1042    (   Exts0 == [],
 1043        \+ '$ft_no_ext'(Type)
 1044    ->  '$domain_error'(file_type, Type)
 1045    ;   true
 1046    ),
 1047    '$append'(Exts0, [''], Exts).
 1048'$file_type_extensions'(prolog, [pl, '']). % findall is not yet defined ...
 1049
 1050'$ft_no_ext'(txt).
 1051'$ft_no_ext'(executable).
 1052'$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.

 1065:- multifile(user:prolog_file_type/2). 1066:- dynamic(user:prolog_file_type/2). 1067
 1068user:prolog_file_type(pl,       prolog).
 1069user:prolog_file_type(prolog,   prolog).
 1070user:prolog_file_type(qlf,      prolog).
 1071user:prolog_file_type(qlf,      qlf).
 1072user:prolog_file_type(Ext,      executable) :-
 1073    current_prolog_flag(shared_object_extension, Ext).
 1074user:prolog_file_type(dylib,    executable) :-
 1075    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.

 1082'$chk_file'(Spec, _Extensions, _Cond, _Cache, _FullName) :-
 1083    \+ ground(Spec),
 1084    !,
 1085    '$instantiation_error'(Spec).
 1086'$chk_file'(Spec, Extensions, Cond, Cache, FullName) :-
 1087    compound(Spec),
 1088    functor(Spec, _, 1),
 1089    !,
 1090    '$relative_to'(Cond, cwd, CWD),
 1091    '$chk_alias_file'(Spec, Extensions, Cond, Cache, CWD, FullName).
 1092'$chk_file'(Segments, Ext, Cond, Cache, FullName) :-    % allow a/b/...
 1093    \+ atomic(Segments),
 1094    !,
 1095    '$segments_to_atom'(Segments, Atom),
 1096    '$chk_file'(Atom, Ext, Cond, Cache, FullName).
 1097'$chk_file'(File, Exts, Cond, _, FullName) :-
 1098    is_absolute_file_name(File),
 1099    !,
 1100    '$extend_file'(File, Exts, Extended),
 1101    '$file_conditions'(Cond, Extended),
 1102    '$absolute_file_name'(Extended, FullName).
 1103'$chk_file'(File, Exts, Cond, _, FullName) :-
 1104    '$relative_to'(Cond, source, Dir),
 1105    atomic_list_concat([Dir, /, File], AbsFile),
 1106    '$extend_file'(AbsFile, Exts, Extended),
 1107    '$file_conditions'(Cond, Extended),
 1108    !,
 1109    '$absolute_file_name'(Extended, FullName).
 1110'$chk_file'(File, Exts, Cond, _, FullName) :-
 1111    '$extend_file'(File, Exts, Extended),
 1112    '$file_conditions'(Cond, Extended),
 1113    '$absolute_file_name'(Extended, FullName).
 1114
 1115'$segments_to_atom'(Atom, Atom) :-
 1116    atomic(Atom),
 1117    !.
 1118'$segments_to_atom'(Segments, Atom) :-
 1119    '$segments_to_list'(Segments, List, []),
 1120    !,
 1121    atomic_list_concat(List, /, Atom).
 1122
 1123'$segments_to_list'(A/B, H, T) :-
 1124    '$segments_to_list'(A, H, T0),
 1125    '$segments_to_list'(B, T0, T).
 1126'$segments_to_list'(A, [A|T], T) :-
 1127    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.

 1137'$relative_to'(Conditions, Default, Dir) :-
 1138    (   '$option'(relative_to(FileOrDir), Conditions)
 1139    *-> (   exists_directory(FileOrDir)
 1140        ->  Dir = FileOrDir
 1141        ;   atom_concat(Dir, /, FileOrDir)
 1142        ->  true
 1143        ;   file_directory_name(FileOrDir, Dir)
 1144        )
 1145    ;   Default == cwd
 1146    ->  '$cwd'(Dir)
 1147    ;   Default == source
 1148    ->  source_location(ContextFile, _Line),
 1149        file_directory_name(ContextFile, Dir)
 1150    ).

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

 1155:- dynamic
 1156    '$search_path_file_cache'/3,    % SHA1, Time, Path
 1157    '$search_path_gc_time'/1.       % Time
 1158:- volatile
 1159    '$search_path_file_cache'/3,
 1160    '$search_path_gc_time'/1. 1161
 1162:- create_prolog_flag(file_search_cache_time, 10, []). 1163
 1164'$chk_alias_file'(Spec, Exts, Cond, true, CWD, FullFile) :-
 1165    !,
 1166    findall(Exp, expand_file_search_path(Spec, Exp), Expansions),
 1167    Cache = cache(Exts, Cond, CWD, Expansions),
 1168    variant_sha1(Spec+Cache, SHA1),
 1169    get_time(Now),
 1170    current_prolog_flag(file_search_cache_time, TimeOut),
 1171    (   '$search_path_file_cache'(SHA1, CachedTime, FullFile),
 1172        CachedTime > Now - TimeOut,
 1173        '$file_conditions'(Cond, FullFile)
 1174    ->  '$search_message'(file_search(cache(Spec, Cond), FullFile))
 1175    ;   '$member'(Expanded, Expansions),
 1176        '$extend_file'(Expanded, Exts, LibFile),
 1177        (   '$file_conditions'(Cond, LibFile),
 1178            '$absolute_file_name'(LibFile, FullFile),
 1179            '$cache_file_found'(SHA1, Now, TimeOut, FullFile)
 1180        ->  '$search_message'(file_search(found(Spec, Cond), FullFile))
 1181        ;   '$search_message'(file_search(tried(Spec, Cond), LibFile)),
 1182            fail
 1183        )
 1184    ).
 1185'$chk_alias_file'(Spec, Exts, Cond, false, _CWD, FullFile) :-
 1186    expand_file_search_path(Spec, Expanded),
 1187    '$extend_file'(Expanded, Exts, LibFile),
 1188    '$file_conditions'(Cond, LibFile),
 1189    '$absolute_file_name'(LibFile, FullFile).
 1190
 1191'$cache_file_found'(_, _, TimeOut, _) :-
 1192    TimeOut =:= 0,
 1193    !.
 1194'$cache_file_found'(SHA1, Now, TimeOut, FullFile) :-
 1195    '$search_path_file_cache'(SHA1, Saved, FullFile),
 1196    !,
 1197    (   Now - Saved < TimeOut/2
 1198    ->  true
 1199    ;   retractall('$search_path_file_cache'(SHA1, _, _)),
 1200        asserta('$search_path_file_cache'(SHA1, Now, FullFile))
 1201    ).
 1202'$cache_file_found'(SHA1, Now, TimeOut, FullFile) :-
 1203    'gc_file_search_cache'(TimeOut),
 1204    asserta('$search_path_file_cache'(SHA1, Now, FullFile)).
 1205
 1206'gc_file_search_cache'(TimeOut) :-
 1207    get_time(Now),
 1208    '$search_path_gc_time'(Last),
 1209    Now-Last < TimeOut/2,
 1210    !.
 1211'gc_file_search_cache'(TimeOut) :-
 1212    get_time(Now),
 1213    retractall('$search_path_gc_time'(_)),
 1214    assertz('$search_path_gc_time'(Now)),
 1215    Before is Now - TimeOut,
 1216    (   '$search_path_file_cache'(SHA1, Cached, FullFile),
 1217        Cached < Before,
 1218        retractall('$search_path_file_cache'(SHA1, Cached, FullFile)),
 1219        fail
 1220    ;   true
 1221    ).
 1222
 1223
 1224'$search_message'(Term) :-
 1225    current_prolog_flag(verbose_file_search, true),
 1226    !,
 1227    print_message(informational, Term).
 1228'$search_message'(_).

 $file_conditions(+Condition, +Path)

Verify Path satisfies Condition.

 1235'$file_conditions'(List, File) :-
 1236    is_list(List),
 1237    !,
 1238    \+ ( '$member'(C, List),
 1239         '$file_condition'(C),
 1240         \+ '$file_condition'(C, File)
 1241       ).
 1242'$file_conditions'(Map, File) :-
 1243    \+ (  get_dict(Key, Map, Value),
 1244          C =.. [Key,Value],
 1245          '$file_condition'(C),
 1246         \+ '$file_condition'(C, File)
 1247       ).
 1248
 1249'$file_condition'(file_type(directory), File) :-
 1250    !,
 1251    exists_directory(File).
 1252'$file_condition'(file_type(_), File) :-
 1253    !,
 1254    \+ exists_directory(File).
 1255'$file_condition'(access(Accesses), File) :-
 1256    !,
 1257    \+ (  '$one_or_member'(Access, Accesses),
 1258          \+ access_file(File, Access)
 1259       ).
 1260
 1261'$file_condition'(exists).
 1262'$file_condition'(file_type(_)).
 1263'$file_condition'(access(_)).
 1264
 1265'$extend_file'(File, Exts, FileEx) :-
 1266    '$ensure_extensions'(Exts, File, Fs),
 1267    '$list_to_set'(Fs, FsSet),
 1268    '$member'(FileEx, FsSet).
 1269
 1270'$ensure_extensions'([], _, []).
 1271'$ensure_extensions'([E|E0], F, [FE|E1]) :-
 1272    file_name_extension(F, E, FE),
 1273    '$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.

 1282'$list_to_set'(List, Set) :-
 1283    '$list_to_set'(List, [], Set).
 1284
 1285'$list_to_set'([], _, []).
 1286'$list_to_set'([H|T], Seen, R) :-
 1287    memberchk(H, Seen),
 1288    !,
 1289    '$list_to_set'(T, R).
 1290'$list_to_set'([H|T], Seen, [H|R]) :-
 1291    '$list_to_set'(T, [H|Seen], R).
 1292
 1293/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
 1294Canonicalise the extension list. Old SWI-Prolog   require  `.pl', etc, which
 1295the Quintus compatibility  requests  `pl'.   This  layer  canonicalises  all
 1296extensions to .ext
 1297- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
 1298
 1299'$canonicalise_extensions'([], []) :- !.
 1300'$canonicalise_extensions'([H|T], [CH|CT]) :-
 1301    !,
 1302    '$must_be'(atom, H),
 1303    '$canonicalise_extension'(H, CH),
 1304    '$canonicalise_extensions'(T, CT).
 1305'$canonicalise_extensions'(E, [CE]) :-
 1306    '$canonicalise_extension'(E, CE).
 1307
 1308'$canonicalise_extension'('', '') :- !.
 1309'$canonicalise_extension'(DotAtom, DotAtom) :-
 1310    sub_atom(DotAtom, 0, _, _, '.'),
 1311    !.
 1312'$canonicalise_extension'(Atom, DotAtom) :-
 1313    atom_concat('.', Atom, DotAtom).
 1314
 1315
 1316                /********************************
 1317                *            CONSULT            *
 1318                *********************************/
 1319
 1320:- dynamic
 1321    user:library_directory/1,
 1322    user:prolog_load_file/2. 1323:- multifile
 1324    user:library_directory/1,
 1325    user:prolog_load_file/2. 1326
 1327:- prompt(_, '|: '). 1328
 1329:- thread_local
 1330    '$compilation_mode_store'/1,    % database, wic, qlf
 1331    '$directive_mode_store'/1.      % database, wic, qlf
 1332:- volatile
 1333    '$compilation_mode_store'/1,
 1334    '$directive_mode_store'/1. 1335
 1336'$compilation_mode'(Mode) :-
 1337    (   '$compilation_mode_store'(Val)
 1338    ->  Mode = Val
 1339    ;   Mode = database
 1340    ).
 1341
 1342'$set_compilation_mode'(Mode) :-
 1343    retractall('$compilation_mode_store'(_)),
 1344    assertz('$compilation_mode_store'(Mode)).
 1345
 1346'$compilation_mode'(Old, New) :-
 1347    '$compilation_mode'(Old),
 1348    (   New == Old
 1349    ->  true
 1350    ;   '$set_compilation_mode'(New)
 1351    ).
 1352
 1353'$directive_mode'(Mode) :-
 1354    (   '$directive_mode_store'(Val)
 1355    ->  Mode = Val
 1356    ;   Mode = database
 1357    ).
 1358
 1359'$directive_mode'(Old, New) :-
 1360    '$directive_mode'(Old),
 1361    (   New == Old
 1362    ->  true
 1363    ;   '$set_directive_mode'(New)
 1364    ).
 1365
 1366'$set_directive_mode'(Mode) :-
 1367    retractall('$directive_mode_store'(_)),
 1368    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.

 1376'$compilation_level'(Level) :-
 1377    '$input_context'(Stack),
 1378    '$compilation_level'(Stack, Level).
 1379
 1380'$compilation_level'([], 0).
 1381'$compilation_level'([Input|T], Level) :-
 1382    (   arg(1, Input, see)
 1383    ->  '$compilation_level'(T, Level)
 1384    ;   '$compilation_level'(T, Level0),
 1385        Level is Level0+1
 1386    ).

 compiling

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

 1394compiling :-
 1395    \+ (   '$compilation_mode'(database),
 1396           '$directive_mode'(database)
 1397       ).
 1398
 1399:- meta_predicate
 1400    '$ifcompiling'(0). 1401
 1402'$ifcompiling'(G) :-
 1403    (   '$compilation_mode'(database)
 1404    ->  true
 1405    ;   call(G)
 1406    ).
 1407
 1408                /********************************
 1409                *         READ SOURCE           *
 1410                *********************************/

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

 1414'$load_msg_level'(Action, Nesting, Start, Done) :-
 1415    '$update_autoload_level'([], 0),
 1416    !,
 1417    current_prolog_flag(verbose_load, Type0),
 1418    '$load_msg_compat'(Type0, Type),
 1419    (   '$load_msg_level'(Action, Nesting, Type, Start, Done)
 1420    ->  true
 1421    ).
 1422'$load_msg_level'(_, _, silent, silent).
 1423
 1424'$load_msg_compat'(true, normal) :- !.
 1425'$load_msg_compat'(false, silent) :- !.
 1426'$load_msg_compat'(X, X).
 1427
 1428'$load_msg_level'(load_file,    _, full,   informational, informational).
 1429'$load_msg_level'(include_file, _, full,   informational, informational).
 1430'$load_msg_level'(load_file,    _, normal, silent,        informational).
 1431'$load_msg_level'(include_file, _, normal, silent,        silent).
 1432'$load_msg_level'(load_file,    0, brief,  silent,        informational).
 1433'$load_msg_level'(load_file,    _, brief,  silent,        silent).
 1434'$load_msg_level'(include_file, _, brief,  silent,        silent).
 1435'$load_msg_level'(load_file,    _, silent, silent,        silent).
 1436'$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)

 1459'$source_term'(From, Read, RLayout, Term, TLayout, Stream, Options) :-
 1460    '$source_term'(From, Read, RLayout, Term, TLayout, Stream, [], Options),
 1461    (   Term == end_of_file
 1462    ->  !, fail
 1463    ;   Term \== begin_of_file
 1464    ).
 1465
 1466'$source_term'(Input, _,_,_,_,_,_,_) :-
 1467    \+ ground(Input),
 1468    !,
 1469    '$instantiation_error'(Input).
 1470'$source_term'(stream(Id, In, Opts),
 1471               Read, RLayout, Term, TLayout, Stream, Parents, Options) :-
 1472    !,
 1473    '$record_included'(Parents, Id, Id, 0.0, Message),
 1474    setup_call_cleanup(
 1475        '$open_source'(stream(Id, In, Opts), In, State, Parents, Options),
 1476        '$term_in_file'(In, Read, RLayout, Term, TLayout, Stream,
 1477                        [Id|Parents], Options),
 1478        '$close_source'(State, Message)).
 1479'$source_term'(File,
 1480               Read, RLayout, Term, TLayout, Stream, Parents, Options) :-
 1481    absolute_file_name(File, Path,
 1482                       [ file_type(prolog),
 1483                         access(read)
 1484                       ]),
 1485    time_file(Path, Time),
 1486    '$record_included'(Parents, File, Path, Time, Message),
 1487    setup_call_cleanup(
 1488        '$open_source'(Path, In, State, Parents, Options),
 1489        '$term_in_file'(In, Read, RLayout, Term, TLayout, Stream,
 1490                        [Path|Parents], Options),
 1491        '$close_source'(State, Message)).
 1492
 1493:- thread_local
 1494    '$load_input'/2. 1495:- volatile
 1496    '$load_input'/2. 1497
 1498'$open_source'(stream(Id, In, Opts), In,
 1499               restore(In, StreamState, Id, Ref, Opts), Parents, Options) :-
 1500    !,
 1501    '$context_type'(Parents, ContextType),
 1502    '$push_input_context'(ContextType),
 1503    '$set_encoding'(In, Options),
 1504    '$prepare_load_stream'(In, Id, StreamState),
 1505    asserta('$load_input'(stream(Id), In), Ref).
 1506'$open_source'(Path, In, close(In, Path, Ref), Parents, Options) :-
 1507    '$context_type'(Parents, ContextType),
 1508    '$push_input_context'(ContextType),
 1509    open(Path, read, In),
 1510    '$set_encoding'(In, Options),
 1511    asserta('$load_input'(Path, In), Ref).
 1512
 1513'$context_type'([], load_file) :- !.
 1514'$context_type'(_, include).
 1515
 1516'$close_source'(close(In, Id, Ref), Message) :-
 1517    erase(Ref),
 1518    '$end_consult'(Id),
 1519    call_cleanup(
 1520        close(In),
 1521        '$pop_input_context'),
 1522    '$close_message'(Message).
 1523'$close_source'(restore(In, StreamState, Id, Ref, Opts), Message) :-
 1524    erase(Ref),
 1525    '$end_consult'(Id),
 1526    call_cleanup(
 1527        '$restore_load_stream'(In, StreamState, Opts),
 1528        '$pop_input_context'),
 1529    '$close_message'(Message).
 1530
 1531'$close_message'(message(Level, Msg)) :-
 1532    !,
 1533    '$print_message'(Level, Msg).
 1534'$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.

 1546'$term_in_file'(In, Read, RLayout, Term, TLayout, Stream, Parents, Options) :-
 1547    Parents \= [_,_|_],
 1548    (   '$load_input'(_, Input)
 1549    ->  stream_property(Input, file_name(File))
 1550    ),
 1551    '$set_source_location'(File, 0),
 1552    '$expanded_term'(In,
 1553                     begin_of_file, 0-0, Read, RLayout, Term, TLayout,
 1554                     Stream, Parents, Options).
 1555'$term_in_file'(In, Read, RLayout, Term, TLayout, Stream, Parents, Options) :-
 1556    '$skip_script_line'(In, Options),
 1557    '$read_clause_options'(Options, ReadOptions),
 1558    repeat,
 1559      read_clause(In, Raw,
 1560                  [ variable_names(Bindings),
 1561                    term_position(Pos),
 1562                    subterm_positions(RawLayout)
 1563                  | ReadOptions
 1564                  ]),
 1565      b_setval('$term_position', Pos),
 1566      b_setval('$variable_names', Bindings),
 1567      (   Raw == end_of_file
 1568      ->  !,
 1569          (   Parents = [_,_|_]     % Included file
 1570          ->  fail
 1571          ;   '$expanded_term'(In,
 1572                               Raw, RawLayout, Read, RLayout, Term, TLayout,
 1573                               Stream, Parents, Options)
 1574          )
 1575      ;   '$expanded_term'(In, Raw, RawLayout, Read, RLayout, Term, TLayout,
 1576                           Stream, Parents, Options)
 1577      ).
 1578
 1579'$read_clause_options'([], []).
 1580'$read_clause_options'([H|T0], List) :-
 1581    (   '$read_clause_option'(H)
 1582    ->  List = [H|T]
 1583    ;   List = T
 1584    ),
 1585    '$read_clause_options'(T0, T).
 1586
 1587'$read_clause_option'(syntax_errors(_)).
 1588'$read_clause_option'(term_position(_)).
 1589'$read_clause_option'(process_comment(_)).
 1590
 1591'$expanded_term'(In, Raw, RawLayout, Read, RLayout, Term, TLayout,
 1592                 Stream, Parents, Options) :-
 1593    E = error(_,_),
 1594    catch('$expand_term'(Raw, RawLayout, Expanded, ExpandedLayout), E,
 1595          '$print_message_fail'(E)),
 1596    (   Expanded \== []
 1597    ->  '$expansion_member'(Expanded, ExpandedLayout, Term1, Layout1)
 1598    ;   Term1 = Expanded,
 1599        Layout1 = ExpandedLayout
 1600    ),
 1601    (   nonvar(Term1), Term1 = (:-Directive), nonvar(Directive)
 1602    ->  (   Directive = include(File),
 1603            '$current_source_module'(Module),
 1604            '$valid_directive'(Module:include(File))
 1605        ->  stream_property(In, encoding(Enc)),
 1606            '$add_encoding'(Enc, Options, Options1),
 1607            '$source_term'(File, Read, RLayout, Term, TLayout,
 1608                           Stream, Parents, Options1)
 1609        ;   Directive = encoding(Enc)
 1610        ->  set_stream(In, encoding(Enc)),
 1611            fail
 1612        ;   Term = Term1,
 1613            Stream = In,
 1614            Read = Raw
 1615        )
 1616    ;   Term = Term1,
 1617        TLayout = Layout1,
 1618        Stream = In,
 1619        Read = Raw,
 1620        RLayout = RawLayout
 1621    ).
 1622
 1623'$expansion_member'(Var, Layout, Var, Layout) :-
 1624    var(Var),
 1625    !.
 1626'$expansion_member'([], _, _, _) :- !, fail.
 1627'$expansion_member'(List, ListLayout, Term, Layout) :-
 1628    is_list(List),
 1629    !,
 1630    (   var(ListLayout)
 1631    ->  '$member'(Term, List)
 1632    ;   is_list(ListLayout)
 1633    ->  '$member_rep2'(Term, Layout, List, ListLayout)
 1634    ;   Layout = ListLayout,
 1635        '$member'(Term, List)
 1636    ).
 1637'$expansion_member'(X, Layout, X, Layout).
 1638
 1639% pairwise member, repeating last element of the second
 1640% list.
 1641
 1642'$member_rep2'(H1, H2, [H1|_], [H2|_]).
 1643'$member_rep2'(H1, H2, [_|T1], [T2]) :-
 1644    !,
 1645    '$member_rep2'(H1, H2, T1, [T2]).
 1646'$member_rep2'(H1, H2, [_|T1], [_|T2]) :-
 1647    '$member_rep2'(H1, H2, T1, T2).

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

 1651'$add_encoding'(Enc, Options0, Options) :-
 1652    (   Options0 = [encoding(Enc)|_]
 1653    ->  Options = Options0
 1654    ;   Options = [encoding(Enc)|Options0]
 1655    ).
 1656
 1657
 1658:- multifile
 1659    '$included'/4.                  % Into, Line, File, LastModified
 1660:- dynamic
 1661    '$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'.

 1675'$record_included'([Parent|Parents], File, Path, Time,
 1676                   message(DoneMsgLevel,
 1677                           include_file(done(Level, file(File, Path))))) :-
 1678    source_location(SrcFile, Line),
 1679    !,
 1680    '$compilation_level'(Level),
 1681    '$load_msg_level'(include_file, Level, StartMsgLevel, DoneMsgLevel),
 1682    '$print_message'(StartMsgLevel,
 1683                     include_file(start(Level,
 1684                                        file(File, Path)))),
 1685    '$last'([Parent|Parents], Owner),
 1686    (   (   '$compilation_mode'(database)
 1687        ;   '$qlf_current_source'(Owner)
 1688        )
 1689    ->  '$store_admin_clause'(
 1690            system:'$included'(Parent, Line, Path, Time),
 1691            _, Owner, SrcFile:Line)
 1692    ;   '$qlf_include'(Owner, Parent, Line, Path, Time)
 1693    ).
 1694'$record_included'(_, _, _, _, true).