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

 $iso(+Spec) is det

Set the ISO flag. This defines that the predicate cannot be redefined inside a module.

 $clausable(+Spec) is det

Specify that we can run clause/2 on a predicate, even if it is static. ISO specifies that public also plays this role. in SWI, public means that the predicate can be called, even if we cannot find a reference to it.

 $hide(+Spec) is det

Specify that the predicate cannot be seen in the debugger.

  116dynamic(Spec)            :- '$set_pattr'(Spec, pred, dynamic(true)).
  117multifile(Spec)          :- '$set_pattr'(Spec, pred, multifile(true)).
  118module_transparent(Spec) :- '$set_pattr'(Spec, pred, transparent(true)).
  119discontiguous(Spec)      :- '$set_pattr'(Spec, pred, discontiguous(true)).
  120volatile(Spec)           :- '$set_pattr'(Spec, pred, volatile(true)).
  121thread_local(Spec)       :- '$set_pattr'(Spec, pred, thread_local(true)).
  122noprofile(Spec)          :- '$set_pattr'(Spec, pred, noprofile(true)).
  123public(Spec)             :- '$set_pattr'(Spec, pred, public(true)).
  124non_terminal(Spec)       :- '$set_pattr'(Spec, pred, non_terminal(true)).
  125'$iso'(Spec)             :- '$set_pattr'(Spec, pred, iso(true)).
  126'$clausable'(Spec)       :- '$set_pattr'(Spec, pred, clausable(true)).
  127'$hide'(Spec)            :- '$set_pattr'(Spec, pred, trace(false)).
  128
  129'$set_pattr'(M:Pred, How, Attr) :-
  130    '$set_pattr'(Pred, M, How, Attr).

 $set_pattr(+Spec, +Module, +From, +Attr)

Set predicate attributes. From is one of pred or directive.

  136'$set_pattr'(X, _, _, _) :-
  137    var(X),
  138    '$uninstantiation_error'(X).
  139'$set_pattr'(as(Spec,Options), M, How, Attr0) :-
  140    !,
  141    '$attr_options'(Options, Attr0, Attr),
  142    '$set_pattr'(Spec, M, How, Attr).
  143'$set_pattr'([], _, _, _) :- !.
  144'$set_pattr'([H|T], M, How, Attr) :-           % ISO
  145    !,
  146    '$set_pattr'(H, M, How, Attr),
  147    '$set_pattr'(T, M, How, Attr).
  148'$set_pattr'((A,B), M, How, Attr) :-           % ISO and traditional
  149    !,
  150    '$set_pattr'(A, M, How, Attr),
  151    '$set_pattr'(B, M, How, Attr).
  152'$set_pattr'(M:T, _, How, Attr) :-
  153    !,
  154    '$set_pattr'(T, M, How, Attr).
  155'$set_pattr'(PI, M, _, []) :-
  156    !,
  157    '$pi_head'(M:PI, Pred),
  158    (   '$get_predicate_attribute'(Pred, incremental, 1)
  159    ->  '$wrap_incremental'(Pred)
  160    ;   '$unwrap_incremental'(Pred)
  161    ).
  162'$set_pattr'(A, M, How, [O|OT]) :-
  163    !,
  164    '$set_pattr'(A, M, How, O),
  165    '$set_pattr'(A, M, How, OT).
  166'$set_pattr'(A, M, pred, Attr) :-
  167    !,
  168    Attr =.. [Name,Val],
  169    '$set_predicate_attribute'(M:A, Name, Val).
  170'$set_pattr'(A, M, directive, Attr) :-
  171    !,
  172    Attr =.. [Name,Val],
  173    catch('$set_predicate_attribute'(M:A, Name, Val),
  174          error(E, _),
  175          print_message(error, error(E, context((Name)/1,_)))).
  176
  177'$attr_options'(Var, _, _) :-
  178    var(Var),
  179    !,
  180    '$uninstantiation_error'(Var).
  181'$attr_options'((A,B), Attr0, Attr) :-
  182    !,
  183    '$attr_options'(A, Attr0, Attr1),
  184    '$attr_options'(B, Attr1, Attr).
  185'$attr_options'(Opt, Attr0, Attrs) :-
  186    '$must_be'(ground, Opt),
  187    (   '$attr_option'(Opt, AttrX)
  188    ->  (   is_list(Attr0)
  189        ->  '$join_attrs'(AttrX, Attr0, Attrs)
  190        ;   '$join_attrs'(AttrX, [Attr0], Attrs)
  191        )
  192    ;   '$domain_error'(predicate_option, Opt)
  193    ).
  194
  195'$join_attrs'(Attr, Attrs, Attrs) :-
  196    memberchk(Attr, Attrs),
  197    !.
  198'$join_attrs'(Attr, Attrs, Attrs) :-
  199    Attr =.. [Name,Value],
  200    Gen =.. [Name,Existing],
  201    memberchk(Gen, Attrs),
  202    !,
  203    throw(error(conflict_error(Name, Value, Existing), _)).
  204'$join_attrs'(Attr, Attrs0, Attrs) :-
  205    '$append'(Attrs0, [Attr], Attrs).
  206
  207'$attr_option'(incremental, incremental(true)).
  208'$attr_option'(opaque, incremental(false)).
  209'$attr_option'(abstract(Level), abstract(true)) :-
  210    '$must_be'(between(0,0), Level).
  211'$attr_option'(volatile, volatile(true)).
  212'$attr_option'(multifile, multifile(true)).
  213'$attr_option'(discontiguous, discontiguous(true)).
  214'$attr_option'(shared, thread_local(false)).
  215'$attr_option'(local, thread_local(true)).
  216'$attr_option'(private, thread_local(true)).

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

  225'$pattr_directive'(dynamic(Spec), M) :-
  226    '$set_pattr'(Spec, M, directive, dynamic(true)).
  227'$pattr_directive'(multifile(Spec), M) :-
  228    '$set_pattr'(Spec, M, directive, multifile(true)).
  229'$pattr_directive'(module_transparent(Spec), M) :-
  230    '$set_pattr'(Spec, M, directive, transparent(true)).
  231'$pattr_directive'(discontiguous(Spec), M) :-
  232    '$set_pattr'(Spec, M, directive, discontiguous(true)).
  233'$pattr_directive'(volatile(Spec), M) :-
  234    '$set_pattr'(Spec, M, directive, volatile(true)).
  235'$pattr_directive'(thread_local(Spec), M) :-
  236    '$set_pattr'(Spec, M, directive, thread_local(true)).
  237'$pattr_directive'(noprofile(Spec), M) :-
  238    '$set_pattr'(Spec, M, directive, noprofile(true)).
  239'$pattr_directive'(public(Spec), M) :-
  240    '$set_pattr'(Spec, M, directive, public(true)).
  241
  242:- '$iso'(((dynamic)/1, (multifile)/1, (discontiguous)/1)).  243
  244
  245                /********************************
  246                *       CALLING, CONTROL        *
  247                *********************************/
  248
  249:- noprofile((call/1,
  250              catch/3,
  251              once/1,
  252              ignore/1,
  253              call_cleanup/2,
  254              call_cleanup/3,
  255              setup_call_cleanup/3,
  256              setup_call_catcher_cleanup/4)).  257
  258:- meta_predicate
  259    ';'(0,0),
  260    ','(0,0),
  261    @(0,+),
  262    call(0),
  263    call(1,?),
  264    call(2,?,?),
  265    call(3,?,?,?),
  266    call(4,?,?,?,?),
  267    call(5,?,?,?,?,?),
  268    call(6,?,?,?,?,?,?),
  269    call(7,?,?,?,?,?,?,?),
  270    not(0),
  271    \+(0),
  272    '->'(0,0),
  273    '*->'(0,0),
  274    once(0),
  275    ignore(0),
  276    catch(0,?,0),
  277    reset(0,?,-),
  278    setup_call_cleanup(0,0,0),
  279    setup_call_catcher_cleanup(0,0,?,0),
  280    call_cleanup(0,0),
  281    call_cleanup(0,?,0),
  282    catch_with_backtrace(0,?,0),
  283    '$meta_call'(0).  284
  285:- '$iso'((call/1, (\+)/1, once/1, (;)/2, (',')/2, (->)/2, catch/3)).  286
  287% The control structures are always compiled, both   if they appear in a
  288% clause body and if they are handed  to   call/1.  The only way to call
  289% these predicates is by means of  call/2..   In  that case, we call the
  290% hole control structure again to get it compiled by call/1 and properly
  291% deal  with  !,  etc.  Another  reason  for  having  these  things   as
  292% predicates is to be able to define   properties for them, helping code
  293% analyzers.
  294
  295(M0:If ; M0:Then) :- !, call(M0:(If ; Then)).
  296(M1:If ; M2:Then) :-    call(M1:(If ; M2:Then)).
  297(G1   , G2)       :-    call((G1   , G2)).
  298(If  -> Then)     :-    call((If  -> Then)).
  299(If *-> Then)     :-    call((If *-> Then)).
  300@(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.

  314'$meta_call'(M:G) :-
  315    prolog_current_choice(Ch),
  316    '$meta_call'(G, M, Ch).
  317
  318'$meta_call'(Var, _, _) :-
  319    var(Var),
  320    !,
  321    '$instantiation_error'(Var).
  322'$meta_call'((A,B), M, Ch) :-
  323    !,
  324    '$meta_call'(A, M, Ch),
  325    '$meta_call'(B, M, Ch).
  326'$meta_call'((I->T;E), M, Ch) :-
  327    !,
  328    (   prolog_current_choice(Ch2),
  329        '$meta_call'(I, M, Ch2)
  330    ->  '$meta_call'(T, M, Ch)
  331    ;   '$meta_call'(E, M, Ch)
  332    ).
  333'$meta_call'((I*->T;E), M, Ch) :-
  334    !,
  335    (   prolog_current_choice(Ch2),
  336        '$meta_call'(I, M, Ch2)
  337    *-> '$meta_call'(T, M, Ch)
  338    ;   '$meta_call'(E, M, Ch)
  339    ).
  340'$meta_call'((I->T), M, Ch) :-
  341    !,
  342    (   prolog_current_choice(Ch2),
  343        '$meta_call'(I, M, Ch2)
  344    ->  '$meta_call'(T, M, Ch)
  345    ).
  346'$meta_call'((I*->T), M, Ch) :-
  347    !,
  348    prolog_current_choice(Ch2),
  349    '$meta_call'(I, M, Ch2),
  350    '$meta_call'(T, M, Ch).
  351'$meta_call'((A;B), M, Ch) :-
  352    !,
  353    (   '$meta_call'(A, M, Ch)
  354    ;   '$meta_call'(B, M, Ch)
  355    ).
  356'$meta_call'(\+(G), M, _) :-
  357    !,
  358    prolog_current_choice(Ch),
  359    \+ '$meta_call'(G, M, Ch).
  360'$meta_call'(call(G), M, _) :-
  361    !,
  362    prolog_current_choice(Ch),
  363    '$meta_call'(G, M, Ch).
  364'$meta_call'(M:G, _, Ch) :-
  365    !,
  366    '$meta_call'(G, M, Ch).
  367'$meta_call'(!, _, Ch) :-
  368    prolog_cut_to(Ch).
  369'$meta_call'(G, M, _Ch) :-
  370    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..

  386:- '$iso'((call/2,
  387           call/3,
  388           call/4,
  389           call/5,
  390           call/6,
  391           call/7,
  392           call/8)).  393
  394call(Goal) :-                           % make these available as predicates
  395    Goal.
  396call(Goal, A) :-
  397    call(Goal, A).
  398call(Goal, A, B) :-
  399    call(Goal, A, B).
  400call(Goal, A, B, C) :-
  401    call(Goal, A, B, C).
  402call(Goal, A, B, C, D) :-
  403    call(Goal, A, B, C, D).
  404call(Goal, A, B, C, D, E) :-
  405    call(Goal, A, B, C, D, E).
  406call(Goal, A, B, C, D, E, F) :-
  407    call(Goal, A, B, C, D, E, F).
  408call(Goal, A, B, C, D, E, F, G) :-
  409    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.

  416not(Goal) :-
  417    \+ Goal.

 \+ :Goal is semidet

Predicate version that allows for meta-calling.

  423\+ Goal :-
  424    \+ Goal.

 once(:Goal) is semidet

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

  430once(Goal) :-
  431    Goal,
  432    !.

 ignore(:Goal) is det

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

  439ignore(Goal) :-
  440    Goal,
  441    !.
  442ignore(_Goal).
  443
  444:- '$iso'((false/0)).

 false

Synonym for fail/0, providing a declarative reading.

  450false :-
  451    fail.

 catch(:Goal, +Catcher, :Recover)

ISO compliant exception handling.

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

 prolog_cut_to(+Choice)

Cut all choice points after Choice

  464prolog_cut_to(_Choice) :-
  465    '$cut'.                         % Maps to I_CUTCHP

 reset(:Goal, ?Ball, -Continue)

Delimited continuation support.

  471reset(_Goal, _Ball, _Cont) :-
  472    '$reset'.

 shift(+Ball)

Shift control back to the enclosing reset/3

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

  493call_continuation([]).
  494call_continuation([TB|Rest]) :-
  495    (   Rest == []
  496    ->  '$call_continuation'(TB)
  497    ;   '$call_continuation'(TB),
  498        call_continuation(Rest)
  499    ).

 catch_with_backtrace(:Goal, ?Ball, :Recover)

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

  506catch_with_backtrace(Goal, Ball, Recover) :-
  507    catch(Goal, Ball, Recover),
  508    '$no_lco'.
  509
  510'$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.

  520:- public '$recover_and_rethrow'/2.  521
  522'$recover_and_rethrow'(Goal, Exception) :-
  523    call_cleanup(Goal, throw(Exception)),
  524    !.

 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.

  539setup_call_catcher_cleanup(Setup, _Goal, _Catcher, _Cleanup) :-
  540    '$sig_atomic'(Setup),
  541    '$call_cleanup'.
  542
  543setup_call_cleanup(Setup, Goal, Cleanup) :-
  544    setup_call_catcher_cleanup(Setup, Goal, _Catcher, Cleanup).
  545
  546call_cleanup(Goal, Cleanup) :-
  547    setup_call_catcher_cleanup(true, Goal, _Catcher, Cleanup).
  548
  549call_cleanup(Goal, Catcher, Cleanup) :-
  550    setup_call_catcher_cleanup(true, Goal, Catcher, Cleanup).
  551
  552                 /*******************************
  553                 *       INITIALIZATION         *
  554                 *******************************/
  555
  556:- meta_predicate
  557    initialization(0, +).  558
  559:- multifile '$init_goal'/3.  560:- 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.

  586initialization(Goal, When) :-
  587    '$must_be'(oneof(atom, initialization_type,
  588                     [ now,
  589                       after_load,
  590                       restore,
  591                       restore_state,
  592                       prepare_state,
  593                       program,
  594                       main
  595                     ]), When),
  596    '$initialization_context'(Source, Ctx),
  597    '$initialization'(When, Goal, Source, Ctx).
  598
  599'$initialization'(now, Goal, _Source, Ctx) :-
  600    '$run_init_goal'(Goal, Ctx),
  601    '$compile_init_goal'(-, Goal, Ctx).
  602'$initialization'(after_load, Goal, Source, Ctx) :-
  603    (   Source \== (-)
  604    ->  '$compile_init_goal'(Source, Goal, Ctx)
  605    ;   throw(error(context_error(nodirective,
  606                                  initialization(Goal, after_load)),
  607                    _))
  608    ).
  609'$initialization'(restore, Goal, Source, Ctx) :- % deprecated
  610    '$initialization'(restore_state, Goal, Source, Ctx).
  611'$initialization'(restore_state, Goal, _Source, Ctx) :-
  612    (   \+ current_prolog_flag(sandboxed_load, true)
  613    ->  '$compile_init_goal'(-, Goal, Ctx)
  614    ;   '$permission_error'(register, initialization(restore), Goal)
  615    ).
  616'$initialization'(prepare_state, Goal, _Source, Ctx) :-
  617    (   \+ current_prolog_flag(sandboxed_load, true)
  618    ->  '$compile_init_goal'(when(prepare_state), Goal, Ctx)
  619    ;   '$permission_error'(register, initialization(restore), Goal)
  620    ).
  621'$initialization'(program, Goal, _Source, Ctx) :-
  622    (   \+ current_prolog_flag(sandboxed_load, true)
  623    ->  '$compile_init_goal'(when(program), Goal, Ctx)
  624    ;   '$permission_error'(register, initialization(restore), Goal)
  625    ).
  626'$initialization'(main, Goal, _Source, Ctx) :-
  627    (   \+ current_prolog_flag(sandboxed_load, true)
  628    ->  '$compile_init_goal'(when(main), Goal, Ctx)
  629    ;   '$permission_error'(register, initialization(restore), Goal)
  630    ).
  631
  632
  633'$compile_init_goal'(Source, Goal, Ctx) :-
  634    atom(Source),
  635    Source \== (-),
  636    !,
  637    '$store_admin_clause'(system:'$init_goal'(Source, Goal, Ctx),
  638                          _Layout, Source, Ctx).
  639'$compile_init_goal'(Source, Goal, Ctx) :-
  640    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.

  652'$run_initialization'(_, loaded, _) :- !.
  653'$run_initialization'(File, _Action, Options) :-
  654    '$run_initialization'(File, Options).
  655
  656'$run_initialization'(File, Options) :-
  657    setup_call_cleanup(
  658        '$start_run_initialization'(Options, Restore),
  659        '$run_initialization_2'(File),
  660        '$end_run_initialization'(Restore)).
  661
  662'$start_run_initialization'(Options, OldSandBoxed) :-
  663    '$push_input_context'(initialization),
  664    '$set_sandboxed_load'(Options, OldSandBoxed).
  665'$end_run_initialization'(OldSandBoxed) :-
  666    set_prolog_flag(sandboxed_load, OldSandBoxed),
  667    '$pop_input_context'.
  668
  669'$run_initialization_2'(File) :-
  670    (   '$init_goal'(File, Goal, Ctx),
  671        File \= when(_),
  672        '$run_init_goal'(Goal, Ctx),
  673        fail
  674    ;   true
  675    ).
  676
  677'$run_init_goal'(Goal, Ctx) :-
  678    (   catch_with_backtrace('$run_init_goal'(Goal), E,
  679                             '$initialization_error'(E, Goal, Ctx))
  680    ->  true
  681    ;   '$initialization_failure'(Goal, Ctx)
  682    ).
  683
  684:- multifile prolog:sandbox_allowed_goal/1.  685
  686'$run_init_goal'(Goal) :-
  687    current_prolog_flag(sandboxed_load, false),
  688    !,
  689    call(Goal).
  690'$run_init_goal'(Goal) :-
  691    prolog:sandbox_allowed_goal(Goal),
  692    call(Goal).
  693
  694'$initialization_context'(Source, Ctx) :-
  695    (   source_location(File, Line)
  696    ->  Ctx = File:Line,
  697        '$input_context'(Context),
  698        '$top_file'(Context, File, Source)
  699    ;   Ctx = (-),
  700        File = (-)
  701    ).
  702
  703'$top_file'([input(include, F1, _, _)|T], _, F) :-
  704    !,
  705    '$top_file'(T, F1, F).
  706'$top_file'(_, F, F).
  707
  708
  709'$initialization_error'(E, Goal, Ctx) :-
  710    print_message(error, initialization_error(Goal, E, Ctx)).
  711
  712'$initialization_failure'(Goal, Ctx) :-
  713    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

  721:- public '$clear_source_admin'/1.  722
  723'$clear_source_admin'(File) :-
  724    retractall('$init_goal'(_, _, File:_)),
  725    retractall('$load_context_module'(File, _, _)),
  726    retractall('$resolved_source_path'(_, File)).
  727
  728
  729                 /*******************************
  730                 *            STREAM            *
  731                 *******************************/
  732
  733:- '$iso'(stream_property/2).  734stream_property(Stream, Property) :-
  735    nonvar(Stream),
  736    nonvar(Property),
  737    !,
  738    '$stream_property'(Stream, Property).
  739stream_property(Stream, Property) :-
  740    nonvar(Stream),
  741    !,
  742    '$stream_properties'(Stream, Properties),
  743    '$member'(Property, Properties).
  744stream_property(Stream, Property) :-
  745    nonvar(Property),
  746    !,
  747    (   Property = alias(Alias),
  748        atom(Alias)
  749    ->  '$alias_stream'(Alias, Stream)
  750    ;   '$streams_properties'(Property, Pairs),
  751        '$member'(Stream-Property, Pairs)
  752    ).
  753stream_property(Stream, Property) :-
  754    '$streams_properties'(Property, Pairs),
  755    '$member'(Stream-Properties, Pairs),
  756    '$member'(Property, Properties).
  757
  758
  759                /********************************
  760                *            MODULES            *
  761                *********************************/
  762
  763%       '$prefix_module'(+Module, +Context, +Term, -Prefixed)
  764%       Tags `Term' with `Module:' if `Module' is not the context module.
  765
  766'$prefix_module'(Module, Module, Head, Head) :- !.
  767'$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'.

  773default_module(Me, Super) :-
  774    (   atom(Me)
  775    ->  (   var(Super)
  776        ->  '$default_module'(Me, Super)
  777        ;   '$default_module'(Me, Super), !
  778        )
  779    ;   '$type_error'(module, Me)
  780    ).
  781
  782'$default_module'(Me, Me).
  783'$default_module'(Me, Super) :-
  784    import_module(Me, S),
  785    '$default_module'(S, Super).
  786
  787
  788                /********************************
  789                *      TRACE AND EXCEPTIONS     *
  790                *********************************/
  791
  792:- dynamic   user:exception/3.  793:- 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.

  802:- public
  803    '$undefined_procedure'/4.  804
  805'$undefined_procedure'(Module, Name, Arity, Action) :-
  806    '$prefix_module'(Module, user, Name/Arity, Pred),
  807    user:exception(undefined_predicate, Pred, Action0),
  808    !,
  809    Action = Action0.
  810'$undefined_procedure'(Module, Name, Arity, Action) :-
  811    current_prolog_flag(autoload, true),
  812    '$autoload'(Module, Name, Arity),
  813    !,
  814    Action = retry.
  815'$undefined_procedure'(_, _, _, error).
  816
  817'$autoload'(Module, Name, Arity) :-
  818    source_location(File, _Line),
  819    !,
  820    setup_call_cleanup(
  821        '$start_aux'(File, Context),
  822        '$autoload2'(Module, Name, Arity),
  823        '$end_aux'(File, Context)).
  824'$autoload'(Module, Name, Arity) :-
  825    '$autoload2'(Module, Name, Arity).
  826
  827'$autoload2'(Module, Name, Arity) :-
  828    '$find_library'(Module, Name, Arity, LoadModule, Library),
  829    functor(Head, Name, Arity),
  830    '$update_autoload_level'([autoload(true)], Old),
  831    (   current_prolog_flag(verbose_autoload, true)
  832    ->  Level = informational
  833    ;   Level = silent
  834    ),
  835    print_message(Level, autoload(Module:Name/Arity, Library)),
  836    '$compilation_mode'(OldComp, database),
  837    (   Module == LoadModule
  838    ->  ensure_loaded(Module:Library)
  839    ;   (   '$get_predicate_attribute'(LoadModule:Head, defined, 1),
  840            \+ '$loading'(Library)
  841        ->  Module:import(LoadModule:Name/Arity)
  842        ;   use_module(Module:Library, [Name/Arity])
  843        )
  844    ),
  845    '$set_compilation_mode'(OldComp),
  846    '$set_autoload_level'(Old),
  847    '$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.

  858'$loading'(Library) :-
  859    current_prolog_flag(threads, true),
  860    '$loading_file'(FullFile, _Queue, _LoadThread),
  861    file_name_extension(Library, _, FullFile),
  862    !.
  863
  864%        handle debugger 'w', 'p' and <N> depth options.
  865
  866'$set_debugger_write_options'(write) :-
  867    !,
  868    create_prolog_flag(debugger_write_options,
  869                       [ quoted(true),
  870                         attributes(dots),
  871                         spacing(next_argument)
  872                       ], []).
  873'$set_debugger_write_options'(print) :-
  874    !,
  875    create_prolog_flag(debugger_write_options,
  876                       [ quoted(true),
  877                         portray(true),
  878                         max_depth(10),
  879                         attributes(portray),
  880                         spacing(next_argument)
  881                       ], []).
  882'$set_debugger_write_options'(Depth) :-
  883    current_prolog_flag(debugger_write_options, Options0),
  884    (   '$select'(max_depth(_), Options0, Options)
  885    ->  true
  886    ;   Options = Options0
  887    ),
  888    create_prolog_flag(debugger_write_options,
  889                       [max_depth(Depth)|Options], []).
  890
  891
  892                /********************************
  893                *        SYSTEM MESSAGES        *
  894                *********************************/

 $confirm(Spec)

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

  901'$confirm'(Spec) :-
  902    print_message(query, Spec),
  903    between(0, 5, _),
  904        get_single_char(Answer),
  905        (   '$in_reply'(Answer, 'yYjJ \n')
  906        ->  !,
  907            print_message(query, if_tty([yes-[]]))
  908        ;   '$in_reply'(Answer, 'nN')
  909        ->  !,
  910            print_message(query, if_tty([no-[]])),
  911            fail
  912        ;   print_message(help, query(confirm)),
  913            fail
  914        ).
  915
  916'$in_reply'(Code, Atom) :-
  917    char_code(Char, Code),
  918    sub_atom(Atom, _, _, _, Char),
  919    !.
  920
  921:- dynamic
  922    user:portray/1.  923:- multifile
  924    user:portray/1.  925
  926
  927                 /*******************************
  928                 *       FILE_SEARCH_PATH       *
  929                 *******************************/
  930
  931:- dynamic user:file_search_path/2.  932:- multifile user:file_search_path/2.  933
  934user:(file_search_path(library, Dir) :-
  935        library_directory(Dir)).
  936user:file_search_path(swi, Home) :-
  937    current_prolog_flag(home, Home).
  938user:file_search_path(foreign, swi(ArchLib)) :-
  939    current_prolog_flag(arch, Arch),
  940    atom_concat('lib/', Arch, ArchLib).
  941user:file_search_path(foreign, swi(SoLib)) :-
  942    (   current_prolog_flag(windows, true)
  943    ->  SoLib = bin
  944    ;   SoLib = lib
  945    ).
  946user:file_search_path(path, Dir) :-
  947    getenv('PATH', Path),
  948    (   current_prolog_flag(windows, true)
  949    ->  atomic_list_concat(Dirs, (;), Path)
  950    ;   atomic_list_concat(Dirs, :, Path)
  951    ),
  952    '$member'(Dir, Dirs),
  953    '$no-null-bytes'(Dir).
  954
  955'$no-null-bytes'(Dir) :-
  956    sub_atom(Dir, _, _, _, '\u0000'),
  957    !,
  958    print_message(warning, null_byte_in_path(Dir)),
  959    fail.
  960'$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?

  968expand_file_search_path(Spec, Expanded) :-
  969    catch('$expand_file_search_path'(Spec, Expanded, 0, []),
  970          loop(Used),
  971          throw(error(loop_error(Spec), file_search(Used)))).
  972
  973'$expand_file_search_path'(Spec, Expanded, N, Used) :-
  974    functor(Spec, Alias, 1),
  975    !,
  976    user:file_search_path(Alias, Exp0),
  977    NN is N + 1,
  978    (   NN > 16
  979    ->  throw(loop(Used))
  980    ;   true
  981    ),
  982    '$expand_file_search_path'(Exp0, Exp1, NN, [Alias=Exp0|Used]),
  983    arg(1, Spec, Segments),
  984    '$segments_to_atom'(Segments, File),
  985    '$make_path'(Exp1, File, Expanded).
  986'$expand_file_search_path'(Spec, Path, _, _) :-
  987    '$segments_to_atom'(Spec, Path).
  988
  989'$make_path'(Dir, '.', Path) :-
  990    !,
  991    Path = Dir.
  992'$make_path'(Dir, File, Path) :-
  993    sub_atom(Dir, _, _, 0, /),
  994    !,
  995    atom_concat(Dir, File, Path).
  996'$make_path'(Dir, File, Path) :-
  997    atomic_list_concat([Dir, /, File], Path).
  998
  999
 1000                /********************************
 1001                *         FILE CHECKING         *
 1002                *********************************/

 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.

 1013absolute_file_name(Spec, Options, Path) :-
 1014    '$is_options'(Options),
 1015    \+ '$is_options'(Path),
 1016    !,
 1017    absolute_file_name(Spec, Path, Options).
 1018absolute_file_name(Spec, Path, Options) :-
 1019    '$must_be'(options, Options),
 1020                    % get the valid extensions
 1021    (   '$select_option'(extensions(Exts), Options, Options1)
 1022    ->  '$must_be'(list, Exts)
 1023    ;   '$option'(file_type(Type), Options)
 1024    ->  '$must_be'(atom, Type),
 1025        '$file_type_extensions'(Type, Exts),
 1026        Options1 = Options
 1027    ;   Options1 = Options,
 1028        Exts = ['']
 1029    ),
 1030    '$canonicalise_extensions'(Exts, Extensions),
 1031                    % unless specified otherwise, ask regular file
 1032    (   nonvar(Type)
 1033    ->  Options2 = Options1
 1034    ;   '$merge_options'(_{file_type:regular}, Options1, Options2)
 1035    ),
 1036                    % Det or nondet?
 1037    (   '$select_option'(solutions(Sols), Options2, Options3)
 1038    ->  '$must_be'(oneof(atom, solutions, [first,all]), Sols)
 1039    ;   Sols = first,
 1040        Options3 = Options2
 1041    ),
 1042                    % Errors or not?
 1043    (   '$select_option'(file_errors(FileErrors), Options3, Options4)
 1044    ->  '$must_be'(oneof(atom, file_errors, [error,fail]), FileErrors)
 1045    ;   FileErrors = error,
 1046        Options4 = Options3
 1047    ),
 1048                    % Expand shell patterns?
 1049    (   atomic(Spec),
 1050        '$select_option'(expand(Expand), Options4, Options5),
 1051        '$must_be'(boolean, Expand)
 1052    ->  expand_file_name(Spec, List),
 1053        '$member'(Spec1, List)
 1054    ;   Spec1 = Spec,
 1055        Options5 = Options4
 1056    ),
 1057                    % Search for files
 1058    (   Sols == first
 1059    ->  (   '$chk_file'(Spec1, Extensions, Options5, true, Path)
 1060        ->  !       % also kill choice point of expand_file_name/2
 1061        ;   (   FileErrors == fail
 1062            ->  fail
 1063            ;   '$current_module'('$bags', _File),
 1064                findall(P,
 1065                        '$chk_file'(Spec1, Extensions, [access(exist)],
 1066                                    false, P),
 1067                        Candidates),
 1068                '$abs_file_error'(Spec, Candidates, Options5)
 1069            )
 1070        )
 1071    ;   '$chk_file'(Spec1, Extensions, Options5, false, Path)
 1072    ).
 1073
 1074'$abs_file_error'(Spec, Candidates, Conditions) :-
 1075    '$member'(F, Candidates),
 1076    '$member'(C, Conditions),
 1077    '$file_condition'(C),
 1078    '$file_error'(C, Spec, F, E, Comment),
 1079    !,
 1080    throw(error(E, context(_, Comment))).
 1081'$abs_file_error'(Spec, _, _) :-
 1082    '$existence_error'(source_sink, Spec).
 1083
 1084'$file_error'(file_type(directory), Spec, File, Error, Comment) :-
 1085    \+ exists_directory(File),
 1086    !,
 1087    Error = existence_error(directory, Spec),
 1088    Comment = not_a_directory(File).
 1089'$file_error'(file_type(_), Spec, File, Error, Comment) :-
 1090    exists_directory(File),
 1091    !,
 1092    Error = existence_error(file, Spec),
 1093    Comment = directory(File).
 1094'$file_error'(access(OneOrList), Spec, File, Error, _) :-
 1095    '$one_or_member'(Access, OneOrList),
 1096    \+ access_file(File, Access),
 1097    Error = permission_error(Access, source_sink, Spec).
 1098
 1099'$one_or_member'(Elem, List) :-
 1100    is_list(List),
 1101    !,
 1102    '$member'(Elem, List).
 1103'$one_or_member'(Elem, Elem).
 1104
 1105
 1106'$file_type_extensions'(source, Exts) :-       % SICStus 3.9 compatibility
 1107    !,
 1108    '$file_type_extensions'(prolog, Exts).
 1109'$file_type_extensions'(Type, Exts) :-
 1110    '$current_module'('$bags', _File),
 1111    !,
 1112    findall(Ext, user:prolog_file_type(Ext, Type), Exts0),
 1113    (   Exts0 == [],
 1114        \+ '$ft_no_ext'(Type)
 1115    ->  '$domain_error'(file_type, Type)
 1116    ;   true
 1117    ),
 1118    '$append'(Exts0, [''], Exts).
 1119'$file_type_extensions'(prolog, [pl, '']). % findall is not yet defined ...
 1120
 1121'$ft_no_ext'(txt).
 1122'$ft_no_ext'(executable).
 1123'$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.

 1136:- multifile(user:prolog_file_type/2). 1137:- dynamic(user:prolog_file_type/2). 1138
 1139user:prolog_file_type(pl,       prolog).
 1140user:prolog_file_type(prolog,   prolog).
 1141user:prolog_file_type(qlf,      prolog).
 1142user:prolog_file_type(qlf,      qlf).
 1143user:prolog_file_type(Ext,      executable) :-
 1144    current_prolog_flag(shared_object_extension, Ext).
 1145user:prolog_file_type(dylib,    executable) :-
 1146    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.

 1153'$chk_file'(Spec, _Extensions, _Cond, _Cache, _FullName) :-
 1154    \+ ground(Spec),
 1155    !,
 1156    '$instantiation_error'(Spec).
 1157'$chk_file'(Spec, Extensions, Cond, Cache, FullName) :-
 1158    compound(Spec),
 1159    functor(Spec, _, 1),
 1160    !,
 1161    '$relative_to'(Cond, cwd, CWD),
 1162    '$chk_alias_file'(Spec, Extensions, Cond, Cache, CWD, FullName).
 1163'$chk_file'(Segments, Ext, Cond, Cache, FullName) :-    % allow a/b/...
 1164    \+ atomic(Segments),
 1165    !,
 1166    '$segments_to_atom'(Segments, Atom),
 1167    '$chk_file'(Atom, Ext, Cond, Cache, FullName).
 1168'$chk_file'(File, Exts, Cond, _, FullName) :-
 1169    is_absolute_file_name(File),
 1170    !,
 1171    '$extend_file'(File, Exts, Extended),
 1172    '$file_conditions'(Cond, Extended),
 1173    '$absolute_file_name'(Extended, FullName).
 1174'$chk_file'(File, Exts, Cond, _, FullName) :-
 1175    '$relative_to'(Cond, source, Dir),
 1176    atomic_list_concat([Dir, /, File], AbsFile),
 1177    '$extend_file'(AbsFile, Exts, Extended),
 1178    '$file_conditions'(Cond, Extended),
 1179    !,
 1180    '$absolute_file_name'(Extended, FullName).
 1181'$chk_file'(File, Exts, Cond, _, FullName) :-
 1182    '$extend_file'(File, Exts, Extended),
 1183    '$file_conditions'(Cond, Extended),
 1184    '$absolute_file_name'(Extended, FullName).
 1185
 1186'$segments_to_atom'(Atom, Atom) :-
 1187    atomic(Atom),
 1188    !.
 1189'$segments_to_atom'(Segments, Atom) :-
 1190    '$segments_to_list'(Segments, List, []),
 1191    !,
 1192    atomic_list_concat(List, /, Atom).
 1193
 1194'$segments_to_list'(A/B, H, T) :-
 1195    '$segments_to_list'(A, H, T0),
 1196    '$segments_to_list'(B, T0, T).
 1197'$segments_to_list'(A, [A|T], T) :-
 1198    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.

 1208'$relative_to'(Conditions, Default, Dir) :-
 1209    (   '$option'(relative_to(FileOrDir), Conditions)
 1210    *-> (   exists_directory(FileOrDir)
 1211        ->  Dir = FileOrDir
 1212        ;   atom_concat(Dir, /, FileOrDir)
 1213        ->  true
 1214        ;   file_directory_name(FileOrDir, Dir)
 1215        )
 1216    ;   Default == cwd
 1217    ->  '$cwd'(Dir)
 1218    ;   Default == source
 1219    ->  source_location(ContextFile, _Line),
 1220        file_directory_name(ContextFile, Dir)
 1221    ).

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

 1226:- dynamic
 1227    '$search_path_file_cache'/3,    % SHA1, Time, Path
 1228    '$search_path_gc_time'/1.       % Time
 1229:- volatile
 1230    '$search_path_file_cache'/3,
 1231    '$search_path_gc_time'/1. 1232
 1233:- create_prolog_flag(file_search_cache_time, 10, []). 1234
 1235'$chk_alias_file'(Spec, Exts, Cond, true, CWD, FullFile) :-
 1236    !,
 1237    findall(Exp, expand_file_search_path(Spec, Exp), Expansions),
 1238    Cache = cache(Exts, Cond, CWD, Expansions),
 1239    variant_sha1(Spec+Cache, SHA1),
 1240    get_time(Now),
 1241    current_prolog_flag(file_search_cache_time, TimeOut),
 1242    (   '$search_path_file_cache'(SHA1, CachedTime, FullFile),
 1243        CachedTime > Now - TimeOut,
 1244        '$file_conditions'(Cond, FullFile)
 1245    ->  '$search_message'(file_search(cache(Spec, Cond), FullFile))
 1246    ;   '$member'(Expanded, Expansions),
 1247        '$extend_file'(Expanded, Exts, LibFile),
 1248        (   '$file_conditions'(Cond, LibFile),
 1249            '$absolute_file_name'(LibFile, FullFile),
 1250            '$cache_file_found'(SHA1, Now, TimeOut, FullFile)
 1251        ->  '$search_message'(file_search(found(Spec, Cond), FullFile))
 1252        ;   '$search_message'(file_search(tried(Spec, Cond), LibFile)),
 1253            fail
 1254        )
 1255    ).
 1256'$chk_alias_file'(Spec, Exts, Cond, false, _CWD, FullFile) :-
 1257    expand_file_search_path(Spec, Expanded),
 1258    '$extend_file'(Expanded, Exts, LibFile),
 1259    '$file_conditions'(Cond, LibFile),
 1260    '$absolute_file_name'(LibFile, FullFile).
 1261
 1262'$cache_file_found'(_, _, TimeOut, _) :-
 1263    TimeOut =:= 0,
 1264    !.
 1265'$cache_file_found'(SHA1, Now, TimeOut, FullFile) :-
 1266    '$search_path_file_cache'(SHA1, Saved, FullFile),
 1267    !,
 1268    (   Now - Saved < TimeOut/2
 1269    ->  true
 1270    ;   retractall('$search_path_file_cache'(SHA1, _, _)),
 1271        asserta('$search_path_file_cache'(SHA1, Now, FullFile))
 1272    ).
 1273'$cache_file_found'(SHA1, Now, TimeOut, FullFile) :-
 1274    'gc_file_search_cache'(TimeOut),
 1275    asserta('$search_path_file_cache'(SHA1, Now, FullFile)).
 1276
 1277'gc_file_search_cache'(TimeOut) :-
 1278    get_time(Now),
 1279    '$search_path_gc_time'(Last),
 1280    Now-Last < TimeOut/2,
 1281    !.
 1282'gc_file_search_cache'(TimeOut) :-
 1283    get_time(Now),
 1284    retractall('$search_path_gc_time'(_)),
 1285    assertz('$search_path_gc_time'(Now)),
 1286    Before is Now - TimeOut,
 1287    (   '$search_path_file_cache'(SHA1, Cached, FullFile),
 1288        Cached < Before,
 1289        retractall('$search_path_file_cache'(SHA1, Cached, FullFile)),
 1290        fail
 1291    ;   true
 1292    ).
 1293
 1294
 1295'$search_message'(Term) :-
 1296    current_prolog_flag(verbose_file_search, true),
 1297    !,
 1298    print_message(informational, Term).
 1299'$search_message'(_).

 $file_conditions(+Condition, +Path)

Verify Path satisfies Condition.

 1306'$file_conditions'(List, File) :-
 1307    is_list(List),
 1308    !,
 1309    \+ ( '$member'(C, List),
 1310         '$file_condition'(C),
 1311         \+ '$file_condition'(C, File)
 1312       ).
 1313'$file_conditions'(Map, File) :-
 1314    \+ (  get_dict(Key, Map, Value),
 1315          C =.. [Key,Value],
 1316          '$file_condition'(C),
 1317         \+ '$file_condition'(C, File)
 1318       ).
 1319
 1320'$file_condition'(file_type(directory), File) :-
 1321    !,
 1322    exists_directory(File).
 1323'$file_condition'(file_type(_), File) :-
 1324    !,
 1325    \+ exists_directory(File).
 1326'$file_condition'(access(Accesses), File) :-
 1327    !,
 1328    \+ (  '$one_or_member'(Access, Accesses),
 1329          \+ access_file(File, Access)
 1330       ).
 1331
 1332'$file_condition'(exists).
 1333'$file_condition'(file_type(_)).
 1334'$file_condition'(access(_)).
 1335
 1336'$extend_file'(File, Exts, FileEx) :-
 1337    '$ensure_extensions'(Exts, File, Fs),
 1338    '$list_to_set'(Fs, FsSet),
 1339    '$member'(FileEx, FsSet).
 1340
 1341'$ensure_extensions'([], _, []).
 1342'$ensure_extensions'([E|E0], F, [FE|E1]) :-
 1343    file_name_extension(F, E, FE),
 1344    '$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.

 1353'$list_to_set'(List, Set) :-
 1354    '$list_to_set'(List, [], Set).
 1355
 1356'$list_to_set'([], _, []).
 1357'$list_to_set'([H|T], Seen, R) :-
 1358    memberchk(H, Seen),
 1359    !,
 1360    '$list_to_set'(T, R).
 1361'$list_to_set'([H|T], Seen, [H|R]) :-
 1362    '$list_to_set'(T, [H|Seen], R).
 1363
 1364/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
 1365Canonicalise the extension list. Old SWI-Prolog   require  `.pl', etc, which
 1366the Quintus compatibility  requests  `pl'.   This  layer  canonicalises  all
 1367extensions to .ext
 1368- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
 1369
 1370'$canonicalise_extensions'([], []) :- !.
 1371'$canonicalise_extensions'([H|T], [CH|CT]) :-
 1372    !,
 1373    '$must_be'(atom, H),
 1374    '$canonicalise_extension'(H, CH),
 1375    '$canonicalise_extensions'(T, CT).
 1376'$canonicalise_extensions'(E, [CE]) :-
 1377    '$canonicalise_extension'(E, CE).
 1378
 1379'$canonicalise_extension'('', '') :- !.
 1380'$canonicalise_extension'(DotAtom, DotAtom) :-
 1381    sub_atom(DotAtom, 0, _, _, '.'),
 1382    !.
 1383'$canonicalise_extension'(Atom, DotAtom) :-
 1384    atom_concat('.', Atom, DotAtom).
 1385
 1386
 1387                /********************************
 1388                *            CONSULT            *
 1389                *********************************/
 1390
 1391:- dynamic
 1392    user:library_directory/1,
 1393    user:prolog_load_file/2. 1394:- multifile
 1395    user:library_directory/1,
 1396    user:prolog_load_file/2. 1397
 1398:- prompt(_, '|: '). 1399
 1400:- thread_local
 1401    '$compilation_mode_store'/1,    % database, wic, qlf
 1402    '$directive_mode_store'/1.      % database, wic, qlf
 1403:- volatile
 1404    '$compilation_mode_store'/1,
 1405    '$directive_mode_store'/1. 1406
 1407'$compilation_mode'(Mode) :-
 1408    (   '$compilation_mode_store'(Val)
 1409    ->  Mode = Val
 1410    ;   Mode = database
 1411    ).
 1412
 1413'$set_compilation_mode'(Mode) :-
 1414    retractall('$compilation_mode_store'(_)),
 1415    assertz('$compilation_mode_store'(Mode)).
 1416
 1417'$compilation_mode'(Old, New) :-
 1418    '$compilation_mode'(Old),
 1419    (   New == Old
 1420    ->  true
 1421    ;   '$set_compilation_mode'(New)
 1422    ).
 1423
 1424'$directive_mode'(Mode) :-
 1425    (   '$directive_mode_store'(Val)
 1426    ->  Mode = Val
 1427    ;   Mode = database
 1428    ).
 1429
 1430'$directive_mode'(Old, New) :-
 1431    '$directive_mode'(Old),
 1432    (   New == Old
 1433    ->  true
 1434    ;   '$set_directive_mode'(New)
 1435    ).
 1436
 1437'$set_directive_mode'(Mode) :-
 1438    retractall('$directive_mode_store'(_)),
 1439    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.

 1447'$compilation_level'(Level) :-
 1448    '$input_context'(Stack),
 1449    '$compilation_level'(Stack, Level).
 1450
 1451'$compilation_level'([], 0).
 1452'$compilation_level'([Input|T], Level) :-
 1453    (   arg(1, Input, see)
 1454    ->  '$compilation_level'(T, Level)
 1455    ;   '$compilation_level'(T, Level0),
 1456        Level is Level0+1
 1457    ).

 compiling

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

 1465compiling :-
 1466    \+ (   '$compilation_mode'(database),
 1467           '$directive_mode'(database)
 1468       ).
 1469
 1470:- meta_predicate
 1471    '$ifcompiling'(0). 1472
 1473'$ifcompiling'(G) :-
 1474    (   '$compilation_mode'(database)
 1475    ->  true
 1476    ;   call(G)
 1477    ).
 1478
 1479                /********************************
 1480                *         READ SOURCE           *
 1481                *********************************/

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

 1485'$load_msg_level'(Action, Nesting, Start, Done) :-
 1486    '$update_autoload_level'([], 0),
 1487    !,
 1488    current_prolog_flag(verbose_load, Type0),
 1489    '$load_msg_compat'(Type0, Type),
 1490    (   '$load_msg_level'(Action, Nesting, Type, Start, Done)
 1491    ->  true
 1492    ).
 1493'$load_msg_level'(_, _, silent, silent).
 1494
 1495'$load_msg_compat'(true, normal) :- !.
 1496'$load_msg_compat'(false, silent) :- !.
 1497'$load_msg_compat'(X, X).
 1498
 1499'$load_msg_level'(load_file,    _, full,   informational, informational).
 1500'$load_msg_level'(include_file, _, full,   informational, informational).
 1501'$load_msg_level'(load_file,    _, normal, silent,        informational).
 1502'$load_msg_level'(include_file, _, normal, silent,        silent).
 1503'$load_msg_level'(load_file,    0, brief,  silent,        informational).
 1504'$load_msg_level'(load_file,    _, brief,  silent,        silent).
 1505'$load_msg_level'(include_file, _, brief,  silent,        silent).
 1506'$load_msg_level'(load_file,    _, silent, silent,        silent).
 1507'$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)

 1530'$source_term'(From, Read, RLayout, Term, TLayout, Stream, Options) :-
 1531    '$source_term'(From, Read, RLayout, Term, TLayout, Stream, [], Options),
 1532    (   Term == end_of_file
 1533    ->  !, fail
 1534    ;   Term \== begin_of_file
 1535    ).
 1536
 1537'$source_term'(Input, _,_,_,_,_,_,_) :-
 1538    \+ ground(Input),
 1539    !,
 1540    '$instantiation_error'(Input).
 1541'$source_term'(stream(Id, In, Opts),
 1542               Read, RLayout, Term, TLayout, Stream, Parents, Options) :-
 1543    !,
 1544    '$record_included'(Parents, Id, Id, 0.0, Message),
 1545    setup_call_cleanup(
 1546        '$open_source'(stream(Id, In, Opts), In, State, Parents, Options),
 1547        '$term_in_file'(In, Read, RLayout, Term, TLayout, Stream,
 1548                        [Id|Parents], Options),
 1549        '$close_source'(State, Message)).
 1550'$source_term'(File,
 1551               Read, RLayout, Term, TLayout, Stream, Parents, Options) :-
 1552    absolute_file_name(File, Path,
 1553                       [ file_type(prolog),
 1554                         access(read)
 1555                       ]),
 1556    time_file(Path, Time),
 1557    '$record_included'(Parents, File, Path, Time, Message),
 1558    setup_call_cleanup(
 1559        '$open_source'(Path, In, State, Parents, Options),
 1560        '$term_in_file'(In, Read, RLayout, Term, TLayout, Stream,
 1561                        [Path|Parents], Options),
 1562        '$close_source'(State, Message)).
 1563
 1564:- thread_local
 1565    '$load_input'/2. 1566:- volatile
 1567    '$load_input'/2. 1568
 1569'$open_source'(stream(Id, In, Opts), In,
 1570               restore(In, StreamState, Id, Ref, Opts), Parents, Options) :-
 1571    !,
 1572    '$context_type'(Parents, ContextType),
 1573    '$push_input_context'(ContextType),
 1574    '$set_encoding'(In, Options),
 1575    '$prepare_load_stream'(In, Id, StreamState),
 1576    asserta('$load_input'(stream(Id), In), Ref).
 1577'$open_source'(Path, In, close(In, Path, Ref), Parents, Options) :-
 1578    '$context_type'(Parents, ContextType),
 1579    '$push_input_context'(ContextType),
 1580    open(Path, read, In),
 1581    '$set_encoding'(In, Options),
 1582    asserta('$load_input'(Path, In), Ref).
 1583
 1584'$context_type'([], load_file) :- !.
 1585'$context_type'(_, include).
 1586
 1587'$close_source'(close(In, Id, Ref), Message) :-
 1588    erase(Ref),
 1589    '$end_consult'(Id),
 1590    call_cleanup(
 1591        close(In),
 1592        '$pop_input_context'),
 1593    '$close_message'(Message).
 1594'$close_source'(restore(In, StreamState, Id, Ref, Opts), Message) :-
 1595    erase(Ref),
 1596    '$end_consult'(Id),
 1597    call_cleanup(
 1598        '$restore_load_stream'(In, StreamState, Opts),
 1599        '$pop_input_context'),
 1600    '$close_message'(Message).
 1601
 1602'$close_message'(message(Level, Msg)) :-
 1603    !,
 1604    '$print_message'(Level, Msg).
 1605'$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.

 1617'$term_in_file'(In, Read, RLayout, Term, TLayout, Stream, Parents, Options) :-
 1618    Parents \= [_,_|_],
 1619    (   '$load_input'(_, Input)
 1620    ->  stream_property(Input, file_name(File))
 1621    ),
 1622    '$set_source_location'(File, 0),
 1623    '$expanded_term'(In,
 1624                     begin_of_file, 0-0, Read, RLayout, Term, TLayout,
 1625                     Stream, Parents, Options).
 1626'$term_in_file'(In, Read, RLayout, Term, TLayout, Stream, Parents, Options) :-
 1627    '$skip_script_line'(In, Options),
 1628    '$read_clause_options'(Options, ReadOptions),
 1629    repeat,
 1630      read_clause(In, Raw,
 1631                  [ variable_names(Bindings),
 1632                    term_position(Pos),
 1633                    subterm_positions(RawLayout)
 1634                  | ReadOptions
 1635                  ]),
 1636      b_setval('$term_position', Pos),
 1637      b_setval('$variable_names', Bindings),
 1638      (   Raw == end_of_file
 1639      ->  !,
 1640          (   Parents = [_,_|_]     % Included file
 1641          ->  fail
 1642          ;   '$expanded_term'(In,
 1643                               Raw, RawLayout, Read, RLayout, Term, TLayout,
 1644                               Stream, Parents, Options)
 1645          )
 1646      ;   '$expanded_term'(In, Raw, RawLayout, Read, RLayout, Term, TLayout,
 1647                           Stream, Parents, Options)
 1648      ).
 1649
 1650'$read_clause_options'([], []).
 1651'$read_clause_options'([H|T0], List) :-
 1652    (   '$read_clause_option'(H)
 1653    ->  List = [H|T]
 1654    ;   List = T
 1655    ),
 1656    '$read_clause_options'(T0, T).
 1657
 1658'$read_clause_option'(syntax_errors(_)).
 1659'$read_clause_option'(term_position(_)).
 1660'$read_clause_option'(process_comment(_)).
 1661
 1662'$expanded_term'(In, Raw, RawLayout, Read, RLayout, Term, TLayout,
 1663                 Stream, Parents, Options) :-
 1664    E = error(_,_),
 1665    catch('$expand_term'(Raw, RawLayout, Expanded, ExpandedLayout), E,
 1666          '$print_message_fail'(E)),
 1667    (   Expanded \== []
 1668    ->  '$expansion_member'(Expanded, ExpandedLayout, Term1, Layout1)
 1669    ;   Term1 = Expanded,
 1670        Layout1 = ExpandedLayout
 1671    ),
 1672    (   nonvar(Term1), Term1 = (:-Directive), nonvar(Directive)
 1673    ->  (   Directive = include(File),
 1674            '$current_source_module'(Module),
 1675            '$valid_directive'(Module:include(File))
 1676        ->  stream_property(In, encoding(Enc)),
 1677            '$add_encoding'(Enc, Options, Options1),
 1678            '$source_term'(File, Read, RLayout, Term, TLayout,
 1679                           Stream, Parents, Options1)
 1680        ;   Directive = encoding(Enc)
 1681        ->  set_stream(In, encoding(Enc)),
 1682            fail
 1683        ;   Term = Term1,
 1684            Stream = In,
 1685            Read = Raw
 1686        )
 1687    ;   Term = Term1,
 1688        TLayout = Layout1,
 1689        Stream = In,
 1690        Read = Raw,
 1691        RLayout = RawLayout
 1692    ).
 1693
 1694'$expansion_member'(Var, Layout, Var, Layout) :-
 1695    var(Var),
 1696    !.
 1697'$expansion_member'([], _, _, _) :- !, fail.
 1698'$expansion_member'(List, ListLayout, Term, Layout) :-
 1699    is_list(List),
 1700    !,
 1701    (   var(ListLayout)
 1702    ->  '$member'(Term, List)
 1703    ;   is_list(ListLayout)
 1704    ->  '$member_rep2'(Term, Layout, List, ListLayout)
 1705    ;   Layout = ListLayout,
 1706        '$member'(Term, List)
 1707    ).
 1708'$expansion_member'(X, Layout, X, Layout).
 1709
 1710% pairwise member, repeating last element of the second
 1711% list.
 1712
 1713'$member_rep2'(H1, H2, [H1|_], [H2|_]).
 1714'$member_rep2'(H1, H2, [_|T1], [T2]) :-
 1715    !,
 1716    '$member_rep2'(H1, H2, T1, [T2]).
 1717'$member_rep2'(H1, H2, [_|T1], [_|T2]) :-
 1718    '$member_rep2'(H1, H2, T1, T2).