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

 dynamic +Spec is det

 multifile +Spec is det

 module_transparent +Spec is det

 discontiguous +Spec is det

 volatile +Spec is det

 thread_local +Spec is det

 noprofile(+Spec) is det

 public +Spec is det

 non_terminal(+Spec) is det

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

 $iso(+Spec) is det

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

 $clausable(+Spec) is det

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

 $hide(+Spec) is det

Specify that the predicate cannot be seen in the debugger.

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

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

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

  136'$set_pattr'(X, _, _, _) :-
  137    var(X),
  138    '$uninstantiation_error'(X).
  139'$set_pattr'(as(Spec,Options), M, How, Attr0) :-
  140    !,
  141    '$attr_options'(Options, Attr0, Attr),
  142    '$set_pattr'(Spec, M, How, Attr).
  143'$set_pattr'([], _, _, _) :- !.
  144'$set_pattr'([H|T], M, How, Attr) :-           % ISO
  145    !,
  146    '$set_pattr'(H, M, How, Attr),
  147    '$set_pattr'(T, M, How, Attr).
  148'$set_pattr'((A,B), M, How, Attr) :-           % ISO and traditional
  149    !,
  150    '$set_pattr'(A, M, How, Attr),
  151    '$set_pattr'(B, M, How, Attr).
  152'$set_pattr'(M:T, _, How, Attr) :-
  153    !,
  154    '$set_pattr'(T, M, How, Attr).
  155'$set_pattr'(PI, M, _, []) :-
  156    !,
  157    '$pi_head'(M:PI, Pred),
  158    '$set_table_wrappers'(Pred).
  159'$set_pattr'(A, M, How, [O|OT]) :-
  160    !,
  161    '$set_pattr'(A, M, How, O),
  162    '$set_pattr'(A, M, How, OT).
  163'$set_pattr'(A, M, pred, Attr) :-
  164    !,
  165    Attr =.. [Name,Val],
  166    '$set_predicate_attribute'(M:A, Name, Val).
  167'$set_pattr'(A, M, directive, Attr) :-
  168    !,
  169    Attr =.. [Name,Val],
  170    catch('$set_predicate_attribute'(M:A, Name, Val),
  171          error(E, _),
  172          print_message(error, error(E, context((Name)/1,_)))).
  173
  174'$attr_options'(Var, _, _) :-
  175    var(Var),
  176    !,
  177    '$uninstantiation_error'(Var).
  178'$attr_options'((A,B), Attr0, Attr) :-
  179    !,
  180    '$attr_options'(A, Attr0, Attr1),
  181    '$attr_options'(B, Attr1, Attr).
  182'$attr_options'(Opt, Attr0, Attrs) :-
  183    '$must_be'(ground, Opt),
  184    (   '$attr_option'(Opt, AttrX)
  185    ->  (   is_list(Attr0)
  186        ->  '$join_attrs'(AttrX, Attr0, Attrs)
  187        ;   '$join_attrs'(AttrX, [Attr0], Attrs)
  188        )
  189    ;   '$domain_error'(predicate_option, Opt)
  190    ).
  191
  192'$join_attrs'(Attr, Attrs, Attrs) :-
  193    memberchk(Attr, Attrs),
  194    !.
  195'$join_attrs'(Attr, Attrs, Attrs) :-
  196    Attr =.. [Name,Value],
  197    Gen =.. [Name,Existing],
  198    memberchk(Gen, Attrs),
  199    !,
  200    throw(error(conflict_error(Name, Value, Existing), _)).
  201'$join_attrs'(Attr, Attrs0, Attrs) :-
  202    '$append'(Attrs0, [Attr], Attrs).
  203
  204'$attr_option'(incremental, incremental(true)).
  205'$attr_option'(monotonic, monotonic(true)).
  206'$attr_option'(opaque, incremental(false)).
  207'$attr_option'(abstract(Level0), abstract(Level)) :-
  208    '$table_option'(Level0, Level).
  209'$attr_option'(subgoal_abstract(Level0), subgoal_abstract(Level)) :-
  210    '$table_option'(Level0, Level).
  211'$attr_option'(answer_abstract(Level0), answer_abstract(Level)) :-
  212    '$table_option'(Level0, Level).
  213'$attr_option'(max_answers(Level0), max_answers(Level)) :-
  214    '$table_option'(Level0, Level).
  215'$attr_option'(volatile, volatile(true)).
  216'$attr_option'(multifile, multifile(true)).
  217'$attr_option'(discontiguous, discontiguous(true)).
  218'$attr_option'(shared, thread_local(false)).
  219'$attr_option'(local, thread_local(true)).
  220'$attr_option'(private, thread_local(true)).
  221
  222'$table_option'(Value0, _Value) :-
  223    var(Value0),
  224    !,
  225    '$instantiation_error'(Value0).
  226'$table_option'(Value0, Value) :-
  227    integer(Value0),
  228    Value0 >= 0,
  229    !,
  230    Value = Value0.
  231'$table_option'(off, -1) :-
  232    !.
  233'$table_option'(false, -1) :-
  234    !.
  235'$table_option'(infinite, -1) :-
  236    !.
  237'$table_option'(Value, _) :-
  238    '$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.

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

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

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

  439not(Goal) :-
  440    \+ Goal.

 \+ :Goal is semidet

Predicate version that allows for meta-calling.

  446\+ Goal :-
  447    \+ Goal.

 once(:Goal) is semidet

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

  453once(Goal) :-
  454    Goal,
  455    !.

 ignore(:Goal) is det

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

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

 false

Synonym for fail/0, providing a declarative reading.

  473false :-
  474    fail.

 catch(:Goal, +Catcher, :Recover)

ISO compliant exception handling.

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

 prolog_cut_to(+Choice)

Cut all choice points after Choice

  487prolog_cut_to(_Choice) :-
  488    '$cut'.                         % Maps to I_CUTCHP

 reset(:Goal, ?Ball, -Continue)

Delimited continuation support.

  494reset(_Goal, _Ball, _Cont) :-
  495    '$reset'.

 shift(+Ball)

Shift control back to the enclosing reset/3

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

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

 catch_with_backtrace(:Goal, ?Ball, :Recover)

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

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

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

 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.

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

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

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

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

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

  825:- public
  826    '$undefined_procedure'/4.  827
  828'$undefined_procedure'(Module, Name, Arity, Action) :-
  829    '$prefix_module'(Module, user, Name/Arity, Pred),
  830    user:exception(undefined_predicate, Pred, Action0),
  831    !,
  832    Action = Action0.
  833'$undefined_procedure'(Module, Name, Arity, Action) :-
  834    \+ current_prolog_flag(autoload, false),
  835    '$autoload'(Module:Name/Arity),
  836    !,
  837    Action = retry.
  838'$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.

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

 $confirm(Spec)

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

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

 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?

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

 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.

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

 1222:- multifile(user:prolog_file_type/2). 1223:- dynamic(user:prolog_file_type/2). 1224
 1225user:prolog_file_type(pl,       prolog).
 1226user:prolog_file_type(prolog,   prolog).
 1227user:prolog_file_type(qlf,      prolog).
 1228user:prolog_file_type(qlf,      qlf).
 1229user:prolog_file_type(Ext,      executable) :-
 1230    current_prolog_flag(shared_object_extension, Ext).
 1231user:prolog_file_type(dylib,    executable) :-
 1232    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.

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

 1294'$relative_to'(Conditions, Default, Dir) :-
 1295    (   '$option'(relative_to(FileOrDir), Conditions)
 1296    *-> (   exists_directory(FileOrDir)
 1297        ->  Dir = FileOrDir
 1298        ;   atom_concat(Dir, /, FileOrDir)
 1299        ->  true
 1300        ;   file_directory_name(FileOrDir, Dir)
 1301        )
 1302    ;   Default == cwd
 1303    ->  '$cwd'(Dir)
 1304    ;   Default == source
 1305    ->  source_location(ContextFile, _Line),
 1306        file_directory_name(ContextFile, Dir)
 1307    ).

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

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

 $file_conditions(+Condition, +Path)

Verify Path satisfies Condition.

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

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

 1533'$compilation_level'(Level) :-
 1534    '$input_context'(Stack),
 1535    '$compilation_level'(Stack, Level).
 1536
 1537'$compilation_level'([], 0).
 1538'$compilation_level'([Input|T], Level) :-
 1539    (   arg(1, Input, see)
 1540    ->  '$compilation_level'(T, Level)
 1541    ;   '$compilation_level'(T, Level0),
 1542        Level is Level0+1
 1543    ).

 compiling

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

 1551compiling :-
 1552    \+ (   '$compilation_mode'(database),
 1553           '$directive_mode'(database)
 1554       ).
 1555
 1556:- meta_predicate
 1557    '$ifcompiling'(0). 1558
 1559'$ifcompiling'(G) :-
 1560    (   '$compilation_mode'(database)
 1561    ->  true
 1562    ;   call(G)
 1563    ).
 1564
 1565                /********************************
 1566                *         READ SOURCE           *
 1567                *********************************/

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

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

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