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

 dynamic +Spec is det

 multifile +Spec is det

 module_transparent +Spec is det

 discontiguous +Spec is det

 volatile +Spec is det

 thread_local +Spec is det

 noprofile(+Spec) is det

 public +Spec is det

 non_terminal(+Spec) is det

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

 $iso(+Spec) is det

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

 $clausable(+Spec) is det

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

 $hide(+Spec) is det

Specify that the predicate cannot be seen in the debugger.

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

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

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

  136'$set_pattr'(X, _, _, _) :-
  137    var(X),
  138    '$uninstantiation_error'(X).
  139'$set_pattr'(as(Spec,Options), M, How, Attr0) :-
  140    !,
  141    '$attr_options'(Options, Attr0, Attr),
  142    '$set_pattr'(Spec, M, How, Attr).
  143'$set_pattr'([], _, _, _) :- !.
  144'$set_pattr'([H|T], M, How, Attr) :-           % ISO
  145    !,
  146    '$set_pattr'(H, M, How, Attr),
  147    '$set_pattr'(T, M, How, Attr).
  148'$set_pattr'((A,B), M, How, Attr) :-           % ISO and traditional
  149    !,
  150    '$set_pattr'(A, M, How, Attr),
  151    '$set_pattr'(B, M, How, Attr).
  152'$set_pattr'(M:T, _, How, Attr) :-
  153    !,
  154    '$set_pattr'(T, M, How, Attr).
  155'$set_pattr'(PI, M, _, []) :-
  156    !,
  157    '$pi_head'(M:PI, Pred),
  158    (   '$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(Level0), abstract(Level)) :-
  210    '$table_option'(Level0, Level).
  211'$attr_option'(subgoal_abstract(Level0), subgoal_abstract(Level)) :-
  212    '$table_option'(Level0, Level).
  213'$attr_option'(answer_abstract(Level0), answer_abstract(Level)) :-
  214    '$table_option'(Level0, Level).
  215'$attr_option'(max_answers(Level0), max_answers(Level)) :-
  216    '$table_option'(Level0, Level).
  217'$attr_option'(volatile, volatile(true)).
  218'$attr_option'(multifile, multifile(true)).
  219'$attr_option'(discontiguous, discontiguous(true)).
  220'$attr_option'(shared, thread_local(false)).
  221'$attr_option'(local, thread_local(true)).
  222'$attr_option'(private, thread_local(true)).
  223
  224'$table_option'(Value0, _Value) :-
  225    var(Value0),
  226    !,
  227    '$instantiation_error'(Value0).
  228'$table_option'(Value0, Value) :-
  229    integer(Value0),
  230    Value0 >= 0,
  231    !,
  232    Value = Value0.
  233'$table_option'(off, -1) :-
  234    !.
  235'$table_option'(false, -1) :-
  236    !.
  237'$table_option'(infinite, -1) :-
  238    !.
  239'$table_option'(Value, _) :-
  240    '$domain_error'(nonneg_or_false, Value).

 $pattr_directive(+Spec, +Module) is det

This implements the directive version of dynamic/1, multifile/1, etc. This version catches and prints errors. If the directive specifies multiple predicates, processing after an error continues with the remaining predicates.

  250'$pattr_directive'(dynamic(Spec), M) :-
  251    '$set_pattr'(Spec, M, directive, dynamic(true)).
  252'$pattr_directive'(multifile(Spec), M) :-
  253    '$set_pattr'(Spec, M, directive, multifile(true)).
  254'$pattr_directive'(module_transparent(Spec), M) :-
  255    '$set_pattr'(Spec, M, directive, transparent(true)).
  256'$pattr_directive'(discontiguous(Spec), M) :-
  257    '$set_pattr'(Spec, M, directive, discontiguous(true)).
  258'$pattr_directive'(volatile(Spec), M) :-
  259    '$set_pattr'(Spec, M, directive, volatile(true)).
  260'$pattr_directive'(thread_local(Spec), M) :-
  261    '$set_pattr'(Spec, M, directive, thread_local(true)).
  262'$pattr_directive'(noprofile(Spec), M) :-
  263    '$set_pattr'(Spec, M, directive, noprofile(true)).
  264'$pattr_directive'(public(Spec), M) :-
  265    '$set_pattr'(Spec, M, directive, public(true)).
  266
  267:- '$iso'(((dynamic)/1, (multifile)/1, (discontiguous)/1)).  268
  269
  270                /********************************
  271                *       CALLING, CONTROL        *
  272                *********************************/
  273
  274:- noprofile((call/1,
  275              catch/3,
  276              once/1,
  277              ignore/1,
  278              call_cleanup/2,
  279              call_cleanup/3,
  280              setup_call_cleanup/3,
  281              setup_call_catcher_cleanup/4)).  282
  283:- meta_predicate
  284    ';'(0,0),
  285    ','(0,0),
  286    @(0,+),
  287    call(0),
  288    call(1,?),
  289    call(2,?,?),
  290    call(3,?,?,?),
  291    call(4,?,?,?,?),
  292    call(5,?,?,?,?,?),
  293    call(6,?,?,?,?,?,?),
  294    call(7,?,?,?,?,?,?,?),
  295    not(0),
  296    \+(0),
  297    '->'(0,0),
  298    '*->'(0,0),
  299    once(0),
  300    ignore(0),
  301    catch(0,?,0),
  302    reset(0,?,-),
  303    setup_call_cleanup(0,0,0),
  304    setup_call_catcher_cleanup(0,0,?,0),
  305    call_cleanup(0,0),
  306    call_cleanup(0,?,0),
  307    catch_with_backtrace(0,?,0),
  308    '$meta_call'(0).  309
  310:- '$iso'((call/1, (\+)/1, once/1, (;)/2, (',')/2, (->)/2, catch/3)).  311
  312% The control structures are always compiled, both   if they appear in a
  313% clause body and if they are handed  to   call/1.  The only way to call
  314% these predicates is by means of  call/2..   In  that case, we call the
  315% hole control structure again to get it compiled by call/1 and properly
  316% deal  with  !,  etc.  Another  reason  for  having  these  things   as
  317% predicates is to be able to define   properties for them, helping code
  318% analyzers.
  319
  320(M0:If ; M0:Then) :- !, call(M0:(If ; Then)).
  321(M1:If ; M2:Then) :-    call(M1:(If ; M2:Then)).
  322(G1   , G2)       :-    call((G1   , G2)).
  323(If  -> Then)     :-    call((If  -> Then)).
  324(If *-> Then)     :-    call((If *-> Then)).
  325@(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.

  339'$meta_call'(M:G) :-
  340    prolog_current_choice(Ch),
  341    '$meta_call'(G, M, Ch).
  342
  343'$meta_call'(Var, _, _) :-
  344    var(Var),
  345    !,
  346    '$instantiation_error'(Var).
  347'$meta_call'((A,B), M, Ch) :-
  348    !,
  349    '$meta_call'(A, M, Ch),
  350    '$meta_call'(B, M, Ch).
  351'$meta_call'((I->T;E), M, Ch) :-
  352    !,
  353    (   prolog_current_choice(Ch2),
  354        '$meta_call'(I, M, Ch2)
  355    ->  '$meta_call'(T, M, Ch)
  356    ;   '$meta_call'(E, M, Ch)
  357    ).
  358'$meta_call'((I*->T;E), M, Ch) :-
  359    !,
  360    (   prolog_current_choice(Ch2),
  361        '$meta_call'(I, M, Ch2)
  362    *-> '$meta_call'(T, M, Ch)
  363    ;   '$meta_call'(E, M, Ch)
  364    ).
  365'$meta_call'((I->T), M, Ch) :-
  366    !,
  367    (   prolog_current_choice(Ch2),
  368        '$meta_call'(I, M, Ch2)
  369    ->  '$meta_call'(T, M, Ch)
  370    ).
  371'$meta_call'((I*->T), M, Ch) :-
  372    !,
  373    prolog_current_choice(Ch2),
  374    '$meta_call'(I, M, Ch2),
  375    '$meta_call'(T, M, Ch).
  376'$meta_call'((A;B), M, Ch) :-
  377    !,
  378    (   '$meta_call'(A, M, Ch)
  379    ;   '$meta_call'(B, M, Ch)
  380    ).
  381'$meta_call'(\+(G), M, _) :-
  382    !,
  383    prolog_current_choice(Ch),
  384    \+ '$meta_call'(G, M, Ch).
  385'$meta_call'(call(G), M, _) :-
  386    !,
  387    prolog_current_choice(Ch),
  388    '$meta_call'(G, M, Ch).
  389'$meta_call'(M:G, _, Ch) :-
  390    !,
  391    '$meta_call'(G, M, Ch).
  392'$meta_call'(!, _, Ch) :-
  393    prolog_cut_to(Ch).
  394'$meta_call'(G, M, _Ch) :-
  395    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..

  411:- '$iso'((call/2,
  412           call/3,
  413           call/4,
  414           call/5,
  415           call/6,
  416           call/7,
  417           call/8)).  418
  419call(Goal) :-                           % make these available as predicates
  420    Goal.
  421call(Goal, A) :-
  422    call(Goal, A).
  423call(Goal, A, B) :-
  424    call(Goal, A, B).
  425call(Goal, A, B, C) :-
  426    call(Goal, A, B, C).
  427call(Goal, A, B, C, D) :-
  428    call(Goal, A, B, C, D).
  429call(Goal, A, B, C, D, E) :-
  430    call(Goal, A, B, C, D, E).
  431call(Goal, A, B, C, D, E, F) :-
  432    call(Goal, A, B, C, D, E, F).
  433call(Goal, A, B, C, D, E, F, G) :-
  434    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.

  441not(Goal) :-
  442    \+ Goal.

 \+ :Goal is semidet

Predicate version that allows for meta-calling.

  448\+ Goal :-
  449    \+ Goal.

 once(:Goal) is semidet

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

  455once(Goal) :-
  456    Goal,
  457    !.

 ignore(:Goal) is det

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

  464ignore(Goal) :-
  465    Goal,
  466    !.
  467ignore(_Goal).
  468
  469:- '$iso'((false/0)).

 false

Synonym for fail/0, providing a declarative reading.

  475false :-
  476    fail.

 catch(:Goal, +Catcher, :Recover)

ISO compliant exception handling.

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

 prolog_cut_to(+Choice)

Cut all choice points after Choice

  489prolog_cut_to(_Choice) :-
  490    '$cut'.                         % Maps to I_CUTCHP

 reset(:Goal, ?Ball, -Continue)

Delimited continuation support.

  496reset(_Goal, _Ball, _Cont) :-
  497    '$reset'.

 shift(+Ball)

Shift control back to the enclosing reset/3

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

  518call_continuation([]).
  519call_continuation([TB|Rest]) :-
  520    (   Rest == []
  521    ->  '$call_continuation'(TB)
  522    ;   '$call_continuation'(TB),
  523        call_continuation(Rest)
  524    ).

 catch_with_backtrace(:Goal, ?Ball, :Recover)

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

  531catch_with_backtrace(Goal, Ball, Recover) :-
  532    catch(Goal, Ball, Recover),
  533    '$no_lco'.
  534
  535'$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.

  545:- public '$recover_and_rethrow'/2.  546
  547'$recover_and_rethrow'(Goal, Exception) :-
  548    call_cleanup(Goal, throw(Exception)),
  549    !.

 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.

  564setup_call_catcher_cleanup(Setup, _Goal, _Catcher, _Cleanup) :-
  565    '$sig_atomic'(Setup),
  566    '$call_cleanup'.
  567
  568setup_call_cleanup(Setup, Goal, Cleanup) :-
  569    setup_call_catcher_cleanup(Setup, Goal, _Catcher, Cleanup).
  570
  571call_cleanup(Goal, Cleanup) :-
  572    setup_call_catcher_cleanup(true, Goal, _Catcher, Cleanup).
  573
  574call_cleanup(Goal, Catcher, Cleanup) :-
  575    setup_call_catcher_cleanup(true, Goal, Catcher, Cleanup).
  576
  577                 /*******************************
  578                 *       INITIALIZATION         *
  579                 *******************************/
  580
  581:- meta_predicate
  582    initialization(0, +).  583
  584:- multifile '$init_goal'/3.  585:- 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.

  611initialization(Goal, When) :-
  612    '$must_be'(oneof(atom, initialization_type,
  613                     [ now,
  614                       after_load,
  615                       restore,
  616                       restore_state,
  617                       prepare_state,
  618                       program,
  619                       main
  620                     ]), When),
  621    '$initialization_context'(Source, Ctx),
  622    '$initialization'(When, Goal, Source, Ctx).
  623
  624'$initialization'(now, Goal, _Source, Ctx) :-
  625    '$run_init_goal'(Goal, Ctx),
  626    '$compile_init_goal'(-, Goal, Ctx).
  627'$initialization'(after_load, Goal, Source, Ctx) :-
  628    (   Source \== (-)
  629    ->  '$compile_init_goal'(Source, Goal, Ctx)
  630    ;   throw(error(context_error(nodirective,
  631                                  initialization(Goal, after_load)),
  632                    _))
  633    ).
  634'$initialization'(restore, Goal, Source, Ctx) :- % deprecated
  635    '$initialization'(restore_state, Goal, Source, Ctx).
  636'$initialization'(restore_state, Goal, _Source, Ctx) :-
  637    (   \+ current_prolog_flag(sandboxed_load, true)
  638    ->  '$compile_init_goal'(-, Goal, Ctx)
  639    ;   '$permission_error'(register, initialization(restore), Goal)
  640    ).
  641'$initialization'(prepare_state, Goal, _Source, Ctx) :-
  642    (   \+ current_prolog_flag(sandboxed_load, true)
  643    ->  '$compile_init_goal'(when(prepare_state), Goal, Ctx)
  644    ;   '$permission_error'(register, initialization(restore), Goal)
  645    ).
  646'$initialization'(program, Goal, _Source, Ctx) :-
  647    (   \+ current_prolog_flag(sandboxed_load, true)
  648    ->  '$compile_init_goal'(when(program), Goal, Ctx)
  649    ;   '$permission_error'(register, initialization(restore), Goal)
  650    ).
  651'$initialization'(main, Goal, _Source, Ctx) :-
  652    (   \+ current_prolog_flag(sandboxed_load, true)
  653    ->  '$compile_init_goal'(when(main), Goal, Ctx)
  654    ;   '$permission_error'(register, initialization(restore), Goal)
  655    ).
  656
  657
  658'$compile_init_goal'(Source, Goal, Ctx) :-
  659    atom(Source),
  660    Source \== (-),
  661    !,
  662    '$store_admin_clause'(system:'$init_goal'(Source, Goal, Ctx),
  663                          _Layout, Source, Ctx).
  664'$compile_init_goal'(Source, Goal, Ctx) :-
  665    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.

  677'$run_initialization'(_, loaded, _) :- !.
  678'$run_initialization'(File, _Action, Options) :-
  679    '$run_initialization'(File, Options).
  680
  681'$run_initialization'(File, Options) :-
  682    setup_call_cleanup(
  683        '$start_run_initialization'(Options, Restore),
  684        '$run_initialization_2'(File),
  685        '$end_run_initialization'(Restore)).
  686
  687'$start_run_initialization'(Options, OldSandBoxed) :-
  688    '$push_input_context'(initialization),
  689    '$set_sandboxed_load'(Options, OldSandBoxed).
  690'$end_run_initialization'(OldSandBoxed) :-
  691    set_prolog_flag(sandboxed_load, OldSandBoxed),
  692    '$pop_input_context'.
  693
  694'$run_initialization_2'(File) :-
  695    (   '$init_goal'(File, Goal, Ctx),
  696        File \= when(_),
  697        '$run_init_goal'(Goal, Ctx),
  698        fail
  699    ;   true
  700    ).
  701
  702'$run_init_goal'(Goal, Ctx) :-
  703    (   catch_with_backtrace('$run_init_goal'(Goal), E,
  704                             '$initialization_error'(E, Goal, Ctx))
  705    ->  true
  706    ;   '$initialization_failure'(Goal, Ctx)
  707    ).
  708
  709:- multifile prolog:sandbox_allowed_goal/1.  710
  711'$run_init_goal'(Goal) :-
  712    current_prolog_flag(sandboxed_load, false),
  713    !,
  714    call(Goal).
  715'$run_init_goal'(Goal) :-
  716    prolog:sandbox_allowed_goal(Goal),
  717    call(Goal).
  718
  719'$initialization_context'(Source, Ctx) :-
  720    (   source_location(File, Line)
  721    ->  Ctx = File:Line,
  722        '$input_context'(Context),
  723        '$top_file'(Context, File, Source)
  724    ;   Ctx = (-),
  725        File = (-)
  726    ).
  727
  728'$top_file'([input(include, F1, _, _)|T], _, F) :-
  729    !,
  730    '$top_file'(T, F1, F).
  731'$top_file'(_, F, F).
  732
  733
  734'$initialization_error'(E, Goal, Ctx) :-
  735    print_message(error, initialization_error(Goal, E, Ctx)).
  736
  737'$initialization_failure'(Goal, Ctx) :-
  738    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

  746:- public '$clear_source_admin'/1.  747
  748'$clear_source_admin'(File) :-
  749    retractall('$init_goal'(_, _, File:_)),
  750    retractall('$load_context_module'(File, _, _)),
  751    retractall('$resolved_source_path'(_, File)).
  752
  753
  754                 /*******************************
  755                 *            STREAM            *
  756                 *******************************/
  757
  758:- '$iso'(stream_property/2).  759stream_property(Stream, Property) :-
  760    nonvar(Stream),
  761    nonvar(Property),
  762    !,
  763    '$stream_property'(Stream, Property).
  764stream_property(Stream, Property) :-
  765    nonvar(Stream),
  766    !,
  767    '$stream_properties'(Stream, Properties),
  768    '$member'(Property, Properties).
  769stream_property(Stream, Property) :-
  770    nonvar(Property),
  771    !,
  772    (   Property = alias(Alias),
  773        atom(Alias)
  774    ->  '$alias_stream'(Alias, Stream)
  775    ;   '$streams_properties'(Property, Pairs),
  776        '$member'(Stream-Property, Pairs)
  777    ).
  778stream_property(Stream, Property) :-
  779    '$streams_properties'(Property, Pairs),
  780    '$member'(Stream-Properties, Pairs),
  781    '$member'(Property, Properties).
  782
  783
  784                /********************************
  785                *            MODULES            *
  786                *********************************/
  787
  788%       '$prefix_module'(+Module, +Context, +Term, -Prefixed)
  789%       Tags `Term' with `Module:' if `Module' is not the context module.
  790
  791'$prefix_module'(Module, Module, Head, Head) :- !.
  792'$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'.

  798default_module(Me, Super) :-
  799    (   atom(Me)
  800    ->  (   var(Super)
  801        ->  '$default_module'(Me, Super)
  802        ;   '$default_module'(Me, Super), !
  803        )
  804    ;   '$type_error'(module, Me)
  805    ).
  806
  807'$default_module'(Me, Me).
  808'$default_module'(Me, Super) :-
  809    import_module(Me, S),
  810    '$default_module'(S, Super).
  811
  812
  813                /********************************
  814                *      TRACE AND EXCEPTIONS     *
  815                *********************************/
  816
  817:- dynamic   user:exception/3.  818:- 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.

  827:- public
  828    '$undefined_procedure'/4.  829
  830'$undefined_procedure'(Module, Name, Arity, Action) :-
  831    '$prefix_module'(Module, user, Name/Arity, Pred),
  832    user:exception(undefined_predicate, Pred, Action0),
  833    !,
  834    Action = Action0.
  835'$undefined_procedure'(Module, Name, Arity, Action) :-
  836    \+ current_prolog_flag(autoload, false),
  837    '$autoload'(Module:Name/Arity),
  838    !,
  839    Action = retry.
  840'$undefined_procedure'(_, _, _, error).

 $loading(+Library)

True if the library is being loaded. Just testing that the predicate is defined is not good enough as the file may be partly loaded. Calling use_module/2 at any time has two drawbacks: it queries the filesystem, causing slowdown and it stops libraries being autoloaded from a saved state where the library is already loaded, but the source may not be accessible.

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

 $confirm(Spec)

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

  895'$confirm'(Spec) :-
  896    print_message(query, Spec),
  897    between(0, 5, _),
  898        get_single_char(Answer),
  899        (   '$in_reply'(Answer, 'yYjJ \n')
  900        ->  !,
  901            print_message(query, if_tty([yes-[]]))
  902        ;   '$in_reply'(Answer, 'nN')
  903        ->  !,
  904            print_message(query, if_tty([no-[]])),
  905            fail
  906        ;   print_message(help, query(confirm)),
  907            fail
  908        ).
  909
  910'$in_reply'(Code, Atom) :-
  911    char_code(Char, Code),
  912    sub_atom(Atom, _, _, _, Char),
  913    !.
  914
  915:- dynamic
  916    user:portray/1.  917:- multifile
  918    user:portray/1.  919
  920
  921                 /*******************************
  922                 *       FILE_SEARCH_PATH       *
  923                 *******************************/
  924
  925:- dynamic user:file_search_path/2.  926:- multifile user:file_search_path/2.  927
  928user:(file_search_path(library, Dir) :-
  929        library_directory(Dir)).
  930user:file_search_path(swi, Home) :-
  931    current_prolog_flag(home, Home).
  932user:file_search_path(swi, Home) :-
  933    current_prolog_flag(shared_home, Home).
  934user:file_search_path(foreign, swi(ArchLib)) :-
  935    \+ current_prolog_flag(windows, true),
  936    current_prolog_flag(arch, Arch),
  937    atom_concat('lib/', Arch, ArchLib).
  938user:file_search_path(foreign, swi(SoLib)) :-
  939    (   current_prolog_flag(windows, true)
  940    ->  SoLib = bin
  941    ;   SoLib = lib
  942    ).
  943user:file_search_path(path, Dir) :-
  944    getenv('PATH', Path),
  945    (   current_prolog_flag(windows, true)
  946    ->  atomic_list_concat(Dirs, (;), Path)
  947    ;   atomic_list_concat(Dirs, :, Path)
  948    ),
  949    '$member'(Dir, Dirs).
  950user:file_search_path(user_app_data, Dir) :-
  951    '$xdg_prolog_directory'(data, Dir).
  952user:file_search_path(common_app_data, Dir) :-
  953    '$xdg_prolog_directory'(common_data, Dir).
  954user:file_search_path(user_app_config, Dir) :-
  955    '$xdg_prolog_directory'(config, Dir).
  956user:file_search_path(common_app_config, Dir) :-
  957    '$xdg_prolog_directory'(common_config, Dir).
  958user:file_search_path(app_data, user_app_data('.')).
  959user:file_search_path(app_data, common_app_data('.')).
  960user:file_search_path(app_config, user_app_config('.')).
  961user:file_search_path(app_config, common_app_config('.')).
  962% backward compatibility
  963user:file_search_path(app_preferences, user_app_config('.')).
  964user:file_search_path(user_profile, app_preferences('.')).
  965
  966'$xdg_prolog_directory'(Which, Dir) :-
  967    '$xdg_directory'(Which, XDGDir),
  968    '$make_config_dir'(XDGDir),
  969    '$ensure_slash'(XDGDir, XDGDirS),
  970    atom_concat(XDGDirS, 'swi-prolog', Dir),
  971    '$make_config_dir'(Dir).
  972
  973% config
  974'$xdg_directory'(config, Home) :-
  975    current_prolog_flag(windows, true),
  976    catch(win_folder(appdata, Home), _, fail),
  977    !.
  978'$xdg_directory'(config, Home) :-
  979    getenv('XDG_CONFIG_HOME', Home).
  980'$xdg_directory'(config, Home) :-
  981    expand_file_name('~/.config', [Home]).
  982% data
  983'$xdg_directory'(data, Home) :-
  984    current_prolog_flag(windows, true),
  985    catch(win_folder(local_appdata, Home), _, fail),
  986    !.
  987'$xdg_directory'(data, Home) :-
  988    getenv('XDG_DATA_HOME', Home).
  989'$xdg_directory'(data, Home) :-
  990    expand_file_name('~/.local', [Local]),
  991    '$make_config_dir'(Local),
  992    atom_concat(Local, '/share', Home),
  993    '$make_config_dir'(Home).
  994% common data
  995'$xdg_directory'(common_data, Dir) :-
  996    current_prolog_flag(windows, true),
  997    catch(win_folder(common_appdata, Dir), _, fail),
  998    !.
  999'$xdg_directory'(common_data, Dir) :-
 1000    '$existing_dir_from_env_path'('XDG_DATA_DIRS',
 1001                                  [ '/usr/local/share',
 1002                                    '/usr/share'
 1003                                  ],
 1004                                  Dir).
 1005% common config
 1006'$xdg_directory'(common_data, Dir) :-
 1007    current_prolog_flag(windows, true),
 1008    catch(win_folder(common_appdata, Dir), _, fail),
 1009    !.
 1010'$xdg_directory'(common_data, Dir) :-
 1011    '$existing_dir_from_env_path'('XDG_CONFIG_DIRS', ['/etc/xdg'], Dir).
 1012
 1013'$existing_dir_from_env_path'(Env, Defaults, Dir) :-
 1014    (   getenv(Env, Path)
 1015    ->  '$path_sep'(Sep),
 1016        atomic_list_concat(Dirs, Sep, Path)
 1017    ;   Dirs = Defaults
 1018    ),
 1019    '$member'(Dir, Dirs),
 1020    exists_directory(Dir).
 1021
 1022'$path_sep'(Char) :-
 1023    (   current_prolog_flag(windows, true)
 1024    ->  Char = ';'
 1025    ;   Char = ':'
 1026    ).
 1027
 1028'$make_config_dir'(Dir) :-
 1029    exists_directory(Dir),
 1030    !.
 1031'$make_config_dir'(Dir) :-
 1032    file_directory_name(Dir, Parent),
 1033    '$my_file'(Parent),
 1034    catch(make_directory(Dir), _, fail).
 1035
 1036'$ensure_slash'(Dir, DirS) :-
 1037    (   sub_atom(Dir, _, _, 0, /)
 1038    ->  DirS = Dir
 1039    ;   atom_concat(Dir, /, DirS)
 1040    ).

 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?

 1049expand_file_search_path(Spec, Expanded) :-
 1050    catch('$expand_file_search_path'(Spec, Expanded, 0, []),
 1051          loop(Used),
 1052          throw(error(loop_error(Spec), file_search(Used)))).
 1053
 1054'$expand_file_search_path'(Spec, Expanded, N, Used) :-
 1055    functor(Spec, Alias, 1),
 1056    !,
 1057    user:file_search_path(Alias, Exp0),
 1058    NN is N + 1,
 1059    (   NN > 16
 1060    ->  throw(loop(Used))
 1061    ;   true
 1062    ),
 1063    '$expand_file_search_path'(Exp0, Exp1, NN, [Alias=Exp0|Used]),
 1064    arg(1, Spec, Segments),
 1065    '$segments_to_atom'(Segments, File),
 1066    '$make_path'(Exp1, File, Expanded).
 1067'$expand_file_search_path'(Spec, Path, _, _) :-
 1068    '$segments_to_atom'(Spec, Path).
 1069
 1070'$make_path'(Dir, '.', Path) :-
 1071    !,
 1072    Path = Dir.
 1073'$make_path'(Dir, File, Path) :-
 1074    sub_atom(Dir, _, _, 0, /),
 1075    !,
 1076    atom_concat(Dir, File, Path).
 1077'$make_path'(Dir, File, Path) :-
 1078    atomic_list_concat([Dir, /, File], Path).
 1079
 1080
 1081                /********************************
 1082                *         FILE CHECKING         *
 1083                *********************************/

 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.

 1094absolute_file_name(Spec, Options, Path) :-
 1095    '$is_options'(Options),
 1096    \+ '$is_options'(Path),
 1097    !,
 1098    absolute_file_name(Spec, Path, Options).
 1099absolute_file_name(Spec, Path, Options) :-
 1100    '$must_be'(options, Options),
 1101                    % get the valid extensions
 1102    (   '$select_option'(extensions(Exts), Options, Options1)
 1103    ->  '$must_be'(list, Exts)
 1104    ;   '$option'(file_type(Type), Options)
 1105    ->  '$must_be'(atom, Type),
 1106        '$file_type_extensions'(Type, Exts),
 1107        Options1 = Options
 1108    ;   Options1 = Options,
 1109        Exts = ['']
 1110    ),
 1111    '$canonicalise_extensions'(Exts, Extensions),
 1112                    % unless specified otherwise, ask regular file
 1113    (   nonvar(Type)
 1114    ->  Options2 = Options1
 1115    ;   '$merge_options'(_{file_type:regular}, Options1, Options2)
 1116    ),
 1117                    % Det or nondet?
 1118    (   '$select_option'(solutions(Sols), Options2, Options3)
 1119    ->  '$must_be'(oneof(atom, solutions, [first,all]), Sols)
 1120    ;   Sols = first,
 1121        Options3 = Options2
 1122    ),
 1123                    % Errors or not?
 1124    (   '$select_option'(file_errors(FileErrors), Options3, Options4)
 1125    ->  '$must_be'(oneof(atom, file_errors, [error,fail]), FileErrors)
 1126    ;   FileErrors = error,
 1127        Options4 = Options3
 1128    ),
 1129                    % Expand shell patterns?
 1130    (   atomic(Spec),
 1131        '$select_option'(expand(Expand), Options4, Options5),
 1132        '$must_be'(boolean, Expand)
 1133    ->  expand_file_name(Spec, List),
 1134        '$member'(Spec1, List)
 1135    ;   Spec1 = Spec,
 1136        Options5 = Options4
 1137    ),
 1138                    % Search for files
 1139    (   Sols == first
 1140    ->  (   '$chk_file'(Spec1, Extensions, Options5, true, Path)
 1141        ->  !       % also kill choice point of expand_file_name/2
 1142        ;   (   FileErrors == fail
 1143            ->  fail
 1144            ;   '$current_module'('$bags', _File),
 1145                findall(P,
 1146                        '$chk_file'(Spec1, Extensions, [access(exist)],
 1147                                    false, P),
 1148                        Candidates),
 1149                '$abs_file_error'(Spec, Candidates, Options5)
 1150            )
 1151        )
 1152    ;   '$chk_file'(Spec1, Extensions, Options5, false, Path)
 1153    ).
 1154
 1155'$abs_file_error'(Spec, Candidates, Conditions) :-
 1156    '$member'(F, Candidates),
 1157    '$member'(C, Conditions),
 1158    '$file_condition'(C),
 1159    '$file_error'(C, Spec, F, E, Comment),
 1160    !,
 1161    throw(error(E, context(_, Comment))).
 1162'$abs_file_error'(Spec, _, _) :-
 1163    '$existence_error'(source_sink, Spec).
 1164
 1165'$file_error'(file_type(directory), Spec, File, Error, Comment) :-
 1166    \+ exists_directory(File),
 1167    !,
 1168    Error = existence_error(directory, Spec),
 1169    Comment = not_a_directory(File).
 1170'$file_error'(file_type(_), Spec, File, Error, Comment) :-
 1171    exists_directory(File),
 1172    !,
 1173    Error = existence_error(file, Spec),
 1174    Comment = directory(File).
 1175'$file_error'(access(OneOrList), Spec, File, Error, _) :-
 1176    '$one_or_member'(Access, OneOrList),
 1177    \+ access_file(File, Access),
 1178    Error = permission_error(Access, source_sink, Spec).
 1179
 1180'$one_or_member'(Elem, List) :-
 1181    is_list(List),
 1182    !,
 1183    '$member'(Elem, List).
 1184'$one_or_member'(Elem, Elem).
 1185
 1186
 1187'$file_type_extensions'(source, Exts) :-       % SICStus 3.9 compatibility
 1188    !,
 1189    '$file_type_extensions'(prolog, Exts).
 1190'$file_type_extensions'(Type, Exts) :-
 1191    '$current_module'('$bags', _File),
 1192    !,
 1193    findall(Ext, user:prolog_file_type(Ext, Type), Exts0),
 1194    (   Exts0 == [],
 1195        \+ '$ft_no_ext'(Type)
 1196    ->  '$domain_error'(file_type, Type)
 1197    ;   true
 1198    ),
 1199    '$append'(Exts0, [''], Exts).
 1200'$file_type_extensions'(prolog, [pl, '']). % findall is not yet defined ...
 1201
 1202'$ft_no_ext'(txt).
 1203'$ft_no_ext'(executable).
 1204'$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.

 1217:- multifile(user:prolog_file_type/2). 1218:- dynamic(user:prolog_file_type/2). 1219
 1220user:prolog_file_type(pl,       prolog).
 1221user:prolog_file_type(prolog,   prolog).
 1222user:prolog_file_type(qlf,      prolog).
 1223user:prolog_file_type(qlf,      qlf).
 1224user:prolog_file_type(Ext,      executable) :-
 1225    current_prolog_flag(shared_object_extension, Ext).
 1226user:prolog_file_type(dylib,    executable) :-
 1227    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.

 1234'$chk_file'(Spec, _Extensions, _Cond, _Cache, _FullName) :-
 1235    \+ ground(Spec),
 1236    !,
 1237    '$instantiation_error'(Spec).
 1238'$chk_file'(Spec, Extensions, Cond, Cache, FullName) :-
 1239    compound(Spec),
 1240    functor(Spec, _, 1),
 1241    !,
 1242    '$relative_to'(Cond, cwd, CWD),
 1243    '$chk_alias_file'(Spec, Extensions, Cond, Cache, CWD, FullName).
 1244'$chk_file'(Segments, Ext, Cond, Cache, FullName) :-    % allow a/b/...
 1245    \+ atomic(Segments),
 1246    !,
 1247    '$segments_to_atom'(Segments, Atom),
 1248    '$chk_file'(Atom, Ext, Cond, Cache, FullName).
 1249'$chk_file'(File, Exts, Cond, _, FullName) :-
 1250    is_absolute_file_name(File),
 1251    !,
 1252    '$extend_file'(File, Exts, Extended),
 1253    '$file_conditions'(Cond, Extended),
 1254    '$absolute_file_name'(Extended, FullName).
 1255'$chk_file'(File, Exts, Cond, _, FullName) :-
 1256    '$relative_to'(Cond, source, Dir),
 1257    atomic_list_concat([Dir, /, File], AbsFile),
 1258    '$extend_file'(AbsFile, Exts, Extended),
 1259    '$file_conditions'(Cond, Extended),
 1260    !,
 1261    '$absolute_file_name'(Extended, FullName).
 1262'$chk_file'(File, Exts, Cond, _, FullName) :-
 1263    '$extend_file'(File, Exts, Extended),
 1264    '$file_conditions'(Cond, Extended),
 1265    '$absolute_file_name'(Extended, FullName).
 1266
 1267'$segments_to_atom'(Atom, Atom) :-
 1268    atomic(Atom),
 1269    !.
 1270'$segments_to_atom'(Segments, Atom) :-
 1271    '$segments_to_list'(Segments, List, []),
 1272    !,
 1273    atomic_list_concat(List, /, Atom).
 1274
 1275'$segments_to_list'(A/B, H, T) :-
 1276    '$segments_to_list'(A, H, T0),
 1277    '$segments_to_list'(B, T0, T).
 1278'$segments_to_list'(A, [A|T], T) :-
 1279    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.

 1289'$relative_to'(Conditions, Default, Dir) :-
 1290    (   '$option'(relative_to(FileOrDir), Conditions)
 1291    *-> (   exists_directory(FileOrDir)
 1292        ->  Dir = FileOrDir
 1293        ;   atom_concat(Dir, /, FileOrDir)
 1294        ->  true
 1295        ;   file_directory_name(FileOrDir, Dir)
 1296        )
 1297    ;   Default == cwd
 1298    ->  '$cwd'(Dir)
 1299    ;   Default == source
 1300    ->  source_location(ContextFile, _Line),
 1301        file_directory_name(ContextFile, Dir)
 1302    ).

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

 1307:- dynamic
 1308    '$search_path_file_cache'/3,    % SHA1, Time, Path
 1309    '$search_path_gc_time'/1.       % Time
 1310:- volatile
 1311    '$search_path_file_cache'/3,
 1312    '$search_path_gc_time'/1. 1313
 1314:- create_prolog_flag(file_search_cache_time, 10, []). 1315
 1316'$chk_alias_file'(Spec, Exts, Cond, true, CWD, FullFile) :-
 1317    !,
 1318    findall(Exp, expand_file_search_path(Spec, Exp), Expansions),
 1319    Cache = cache(Exts, Cond, CWD, Expansions),
 1320    variant_sha1(Spec+Cache, SHA1),
 1321    get_time(Now),
 1322    current_prolog_flag(file_search_cache_time, TimeOut),
 1323    (   '$search_path_file_cache'(SHA1, CachedTime, FullFile),
 1324        CachedTime > Now - TimeOut,
 1325        '$file_conditions'(Cond, FullFile)
 1326    ->  '$search_message'(file_search(cache(Spec, Cond), FullFile))
 1327    ;   '$member'(Expanded, Expansions),
 1328        '$extend_file'(Expanded, Exts, LibFile),
 1329        (   '$file_conditions'(Cond, LibFile),
 1330            '$absolute_file_name'(LibFile, FullFile),
 1331            '$cache_file_found'(SHA1, Now, TimeOut, FullFile)
 1332        ->  '$search_message'(file_search(found(Spec, Cond), FullFile))
 1333        ;   '$search_message'(file_search(tried(Spec, Cond), LibFile)),
 1334            fail
 1335        )
 1336    ).
 1337'$chk_alias_file'(Spec, Exts, Cond, false, _CWD, FullFile) :-
 1338    expand_file_search_path(Spec, Expanded),
 1339    '$extend_file'(Expanded, Exts, LibFile),
 1340    '$file_conditions'(Cond, LibFile),
 1341    '$absolute_file_name'(LibFile, FullFile).
 1342
 1343'$cache_file_found'(_, _, TimeOut, _) :-
 1344    TimeOut =:= 0,
 1345    !.
 1346'$cache_file_found'(SHA1, Now, TimeOut, FullFile) :-
 1347    '$search_path_file_cache'(SHA1, Saved, FullFile),
 1348    !,
 1349    (   Now - Saved < TimeOut/2
 1350    ->  true
 1351    ;   retractall('$search_path_file_cache'(SHA1, _, _)),
 1352        asserta('$search_path_file_cache'(SHA1, Now, FullFile))
 1353    ).
 1354'$cache_file_found'(SHA1, Now, TimeOut, FullFile) :-
 1355    'gc_file_search_cache'(TimeOut),
 1356    asserta('$search_path_file_cache'(SHA1, Now, FullFile)).
 1357
 1358'gc_file_search_cache'(TimeOut) :-
 1359    get_time(Now),
 1360    '$search_path_gc_time'(Last),
 1361    Now-Last < TimeOut/2,
 1362    !.
 1363'gc_file_search_cache'(TimeOut) :-
 1364    get_time(Now),
 1365    retractall('$search_path_gc_time'(_)),
 1366    assertz('$search_path_gc_time'(Now)),
 1367    Before is Now - TimeOut,
 1368    (   '$search_path_file_cache'(SHA1, Cached, FullFile),
 1369        Cached < Before,
 1370        retractall('$search_path_file_cache'(SHA1, Cached, FullFile)),
 1371        fail
 1372    ;   true
 1373    ).
 1374
 1375
 1376'$search_message'(Term) :-
 1377    current_prolog_flag(verbose_file_search, true),
 1378    !,
 1379    print_message(informational, Term).
 1380'$search_message'(_).

 $file_conditions(+Condition, +Path)

Verify Path satisfies Condition.

 1387'$file_conditions'(List, File) :-
 1388    is_list(List),
 1389    !,
 1390    \+ ( '$member'(C, List),
 1391         '$file_condition'(C),
 1392         \+ '$file_condition'(C, File)
 1393       ).
 1394'$file_conditions'(Map, File) :-
 1395    \+ (  get_dict(Key, Map, Value),
 1396          C =.. [Key,Value],
 1397          '$file_condition'(C),
 1398         \+ '$file_condition'(C, File)
 1399       ).
 1400
 1401'$file_condition'(file_type(directory), File) :-
 1402    !,
 1403    exists_directory(File).
 1404'$file_condition'(file_type(_), File) :-
 1405    !,
 1406    \+ exists_directory(File).
 1407'$file_condition'(access(Accesses), File) :-
 1408    !,
 1409    \+ (  '$one_or_member'(Access, Accesses),
 1410          \+ access_file(File, Access)
 1411       ).
 1412
 1413'$file_condition'(exists).
 1414'$file_condition'(file_type(_)).
 1415'$file_condition'(access(_)).
 1416
 1417'$extend_file'(File, Exts, FileEx) :-
 1418    '$ensure_extensions'(Exts, File, Fs),
 1419    '$list_to_set'(Fs, FsSet),
 1420    '$member'(FileEx, FsSet).
 1421
 1422'$ensure_extensions'([], _, []).
 1423'$ensure_extensions'([E|E0], F, [FE|E1]) :-
 1424    file_name_extension(F, E, FE),
 1425    '$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.

 1434'$list_to_set'(List, Set) :-
 1435    '$list_to_set'(List, [], Set).
 1436
 1437'$list_to_set'([], _, []).
 1438'$list_to_set'([H|T], Seen, R) :-
 1439    memberchk(H, Seen),
 1440    !,
 1441    '$list_to_set'(T, R).
 1442'$list_to_set'([H|T], Seen, [H|R]) :-
 1443    '$list_to_set'(T, [H|Seen], R).
 1444
 1445/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
 1446Canonicalise the extension list. Old SWI-Prolog   require  `.pl', etc, which
 1447the Quintus compatibility  requests  `pl'.   This  layer  canonicalises  all
 1448extensions to .ext
 1449- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
 1450
 1451'$canonicalise_extensions'([], []) :- !.
 1452'$canonicalise_extensions'([H|T], [CH|CT]) :-
 1453    !,
 1454    '$must_be'(atom, H),
 1455    '$canonicalise_extension'(H, CH),
 1456    '$canonicalise_extensions'(T, CT).
 1457'$canonicalise_extensions'(E, [CE]) :-
 1458    '$canonicalise_extension'(E, CE).
 1459
 1460'$canonicalise_extension'('', '') :- !.
 1461'$canonicalise_extension'(DotAtom, DotAtom) :-
 1462    sub_atom(DotAtom, 0, _, _, '.'),
 1463    !.
 1464'$canonicalise_extension'(Atom, DotAtom) :-
 1465    atom_concat('.', Atom, DotAtom).
 1466
 1467
 1468                /********************************
 1469                *            CONSULT            *
 1470                *********************************/
 1471
 1472:- dynamic
 1473    user:library_directory/1,
 1474    user:prolog_load_file/2. 1475:- multifile
 1476    user:library_directory/1,
 1477    user:prolog_load_file/2. 1478
 1479:- prompt(_, '|: '). 1480
 1481:- thread_local
 1482    '$compilation_mode_store'/1,    % database, wic, qlf
 1483    '$directive_mode_store'/1.      % database, wic, qlf
 1484:- volatile
 1485    '$compilation_mode_store'/1,
 1486    '$directive_mode_store'/1. 1487
 1488'$compilation_mode'(Mode) :-
 1489    (   '$compilation_mode_store'(Val)
 1490    ->  Mode = Val
 1491    ;   Mode = database
 1492    ).
 1493
 1494'$set_compilation_mode'(Mode) :-
 1495    retractall('$compilation_mode_store'(_)),
 1496    assertz('$compilation_mode_store'(Mode)).
 1497
 1498'$compilation_mode'(Old, New) :-
 1499    '$compilation_mode'(Old),
 1500    (   New == Old
 1501    ->  true
 1502    ;   '$set_compilation_mode'(New)
 1503    ).
 1504
 1505'$directive_mode'(Mode) :-
 1506    (   '$directive_mode_store'(Val)
 1507    ->  Mode = Val
 1508    ;   Mode = database
 1509    ).
 1510
 1511'$directive_mode'(Old, New) :-
 1512    '$directive_mode'(Old),
 1513    (   New == Old
 1514    ->  true
 1515    ;   '$set_directive_mode'(New)
 1516    ).
 1517
 1518'$set_directive_mode'(Mode) :-
 1519    retractall('$directive_mode_store'(_)),
 1520    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.

 1528'$compilation_level'(Level) :-
 1529    '$input_context'(Stack),
 1530    '$compilation_level'(Stack, Level).
 1531
 1532'$compilation_level'([], 0).
 1533'$compilation_level'([Input|T], Level) :-
 1534    (   arg(1, Input, see)
 1535    ->  '$compilation_level'(T, Level)
 1536    ;   '$compilation_level'(T, Level0),
 1537        Level is Level0+1
 1538    ).

 compiling

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

 1546compiling :-
 1547    \+ (   '$compilation_mode'(database),
 1548           '$directive_mode'(database)
 1549       ).
 1550
 1551:- meta_predicate
 1552    '$ifcompiling'(0). 1553
 1554'$ifcompiling'(G) :-
 1555    (   '$compilation_mode'(database)
 1556    ->  true
 1557    ;   call(G)
 1558    ).
 1559
 1560                /********************************
 1561                *         READ SOURCE           *
 1562                *********************************/

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

 1566'$load_msg_level'(Action, Nesting, Start, Done) :-
 1567    '$update_autoload_level'([], 0),
 1568    !,
 1569    current_prolog_flag(verbose_load, Type0),
 1570    '$load_msg_compat'(Type0, Type),
 1571    (   '$load_msg_level'(Action, Nesting, Type, Start, Done)
 1572    ->  true
 1573    ).
 1574'$load_msg_level'(_, _, silent, silent).
 1575
 1576'$load_msg_compat'(true, normal) :- !.
 1577'$load_msg_compat'(false, silent) :- !.
 1578'$load_msg_compat'(X, X).
 1579
 1580'$load_msg_level'(load_file,    _, full,   informational, informational).
 1581'$load_msg_level'(include_file, _, full,   informational, informational).
 1582'$load_msg_level'(load_file,    _, normal, silent,        informational).
 1583'$load_msg_level'(include_file, _, normal, silent,        silent).
 1584'$load_msg_level'(load_file,    0, brief,  silent,        informational).
 1585'$load_msg_level'(load_file,    _, brief,  silent,        silent).
 1586'$load_msg_level'(include_file, _, brief,  silent,        silent).
 1587'$load_msg_level'(load_file,    _, silent, silent,        silent).
 1588'$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)

 1611'$source_term'(From, Read, RLayout, Term, TLayout, Stream, Options) :-
 1612    '$source_term'(From, Read, RLayout, Term, TLayout, Stream, [], Options),
 1613    (   Term == end_of_file
 1614    ->  !, fail
 1615    ;   Term \== begin_of_file
 1616    ).
 1617
 1618'$source_term'(Input, _,_,_,_,_,_,_) :-
 1619    \+ ground(Input),
 1620    !,
 1621    '$instantiation_error'(Input).
 1622'$source_term'(stream(Id, In, Opts),
 1623               Read, RLayout, Term, TLayout, Stream, Parents, Options) :-
 1624    !,
 1625    '$record_included'(Parents, Id, Id, 0.0, Message),
 1626    setup_call_cleanup(
 1627        '$open_source'(stream(Id, In, Opts), In, State, Parents, Options),
 1628        '$term_in_file'(In, Read, RLayout, Term, TLayout, Stream,
 1629                        [Id|Parents], Options),
 1630        '$close_source'(State, Message)).
 1631'$source_term'(File,
 1632               Read, RLayout, Term, TLayout, Stream, Parents, Options) :-
 1633    absolute_file_name(File, Path,
 1634                       [ file_type(prolog),
 1635                         access(read)
 1636                       ]),
 1637    time_file(Path, Time),
 1638    '$record_included'(Parents, File, Path, Time, Message),
 1639    setup_call_cleanup(
 1640        '$open_source'(Path, In, State, Parents, Options),
 1641        '$term_in_file'(In, Read, RLayout, Term, TLayout, Stream,
 1642                        [Path|Parents], Options),
 1643        '$close_source'(State, Message)).
 1644
 1645:- thread_local
 1646    '$load_input'/2. 1647:- volatile
 1648    '$load_input'/2. 1649
 1650'$open_source'(stream(Id, In, Opts), In,
 1651               restore(In, StreamState, Id, Ref, Opts), Parents, _Options) :-
 1652    !,
 1653    '$context_type'(Parents, ContextType),
 1654    '$push_input_context'(ContextType),
 1655    '$prepare_load_stream'(In, Id, StreamState),
 1656    asserta('$load_input'(stream(Id), In), Ref).
 1657'$open_source'(Path, In, close(In, Path, Ref), Parents, Options) :-
 1658    '$context_type'(Parents, ContextType),
 1659    '$push_input_context'(ContextType),
 1660    '$open_source'(Path, In, Options),
 1661    '$set_encoding'(In, Options),
 1662    asserta('$load_input'(Path, In), Ref).
 1663
 1664'$context_type'([], load_file) :- !.
 1665'$context_type'(_, include).
 1666
 1667:- multifile prolog:open_source_hook/3. 1668
 1669'$open_source'(Path, In, Options) :-
 1670    prolog:open_source_hook(Path, In, Options),
 1671    !.
 1672'$open_source'(Path, In, _Options) :-
 1673    open(Path, read, In).
 1674
 1675'$close_source'(close(In, Id, Ref), Message) :-
 1676    erase(Ref),
 1677    '$end_consult'(Id),
 1678    call_cleanup(
 1679        close(In),
 1680        '$pop_input_context'),
 1681    '$close_message'(Message).
 1682'$close_source'(restore(In, StreamState, Id, Ref, Opts), Message) :-
 1683    erase(Ref),
 1684    '$end_consult'(Id),
 1685    call_cleanup(
 1686        '$restore_load_stream'(In, StreamState, Opts),
 1687        '$pop_input_context'),
 1688    '$close_message'(Message).
 1689
 1690'$close_message'(message(Level, Msg)) :-
 1691    !,
 1692    '$print_message'(Level, Msg).
 1693'$close_message'(_).