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_pi_attr'(M:A, Name, Val).
  167'$set_pattr'(A, M, directive, Attr) :-
  168    !,
  169    Attr =.. [Name,Val],
  170    catch('$set_pi_attr'(M:A, Name, Val),
  171          error(E, _),
  172          print_message(error, error(E, context((Name)/1,_)))).
  173
  174'$set_pi_attr'(PI, Name, Val) :-
  175    '$pi_head'(PI, Head),
  176    '$set_predicate_attribute'(Head, Name, Val).
  177
  178'$attr_options'(Var, _, _) :-
  179    var(Var),
  180    !,
  181    '$uninstantiation_error'(Var).
  182'$attr_options'((A,B), Attr0, Attr) :-
  183    !,
  184    '$attr_options'(A, Attr0, Attr1),
  185    '$attr_options'(B, Attr1, Attr).
  186'$attr_options'(Opt, Attr0, Attrs) :-
  187    '$must_be'(ground, Opt),
  188    (   '$attr_option'(Opt, AttrX)
  189    ->  (   is_list(Attr0)
  190        ->  '$join_attrs'(AttrX, Attr0, Attrs)
  191        ;   '$join_attrs'(AttrX, [Attr0], Attrs)
  192        )
  193    ;   '$domain_error'(predicate_option, Opt)
  194    ).
  195
  196'$join_attrs'([], Attrs, Attrs) :-
  197    !.
  198'$join_attrs'([H|T], Attrs0, Attrs) :-
  199    !,
  200    '$join_attrs'(H, Attrs0, Attrs1),
  201    '$join_attrs'(T, Attrs1, Attrs).
  202'$join_attrs'(Attr, Attrs, Attrs) :-
  203    memberchk(Attr, Attrs),
  204    !.
  205'$join_attrs'(Attr, Attrs, Attrs) :-
  206    Attr =.. [Name,Value],
  207    Gen =.. [Name,Existing],
  208    memberchk(Gen, Attrs),
  209    !,
  210    throw(error(conflict_error(Name, Value, Existing), _)).
  211'$join_attrs'(Attr, Attrs0, Attrs) :-
  212    '$append'(Attrs0, [Attr], Attrs).
  213
  214'$attr_option'(incremental, [incremental(true),opaque(false)]).
  215'$attr_option'(monotonic, monotonic(true)).
  216'$attr_option'(lazy, lazy(true)).
  217'$attr_option'(opaque, [incremental(false),opaque(true)]).
  218'$attr_option'(abstract(Level0), abstract(Level)) :-
  219    '$table_option'(Level0, Level).
  220'$attr_option'(subgoal_abstract(Level0), subgoal_abstract(Level)) :-
  221    '$table_option'(Level0, Level).
  222'$attr_option'(answer_abstract(Level0), answer_abstract(Level)) :-
  223    '$table_option'(Level0, Level).
  224'$attr_option'(max_answers(Level0), max_answers(Level)) :-
  225    '$table_option'(Level0, Level).
  226'$attr_option'(volatile, volatile(true)).
  227'$attr_option'(multifile, multifile(true)).
  228'$attr_option'(discontiguous, discontiguous(true)).
  229'$attr_option'(shared, thread_local(false)).
  230'$attr_option'(local, thread_local(true)).
  231'$attr_option'(private, thread_local(true)).
  232
  233'$table_option'(Value0, _Value) :-
  234    var(Value0),
  235    !,
  236    '$instantiation_error'(Value0).
  237'$table_option'(Value0, Value) :-
  238    integer(Value0),
  239    Value0 >= 0,
  240    !,
  241    Value = Value0.
  242'$table_option'(off, -1) :-
  243    !.
  244'$table_option'(false, -1) :-
  245    !.
  246'$table_option'(infinite, -1) :-
  247    !.
  248'$table_option'(Value, _) :-
  249    '$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.

  259'$pattr_directive'(dynamic(Spec), M) :-
  260    '$set_pattr'(Spec, M, directive, dynamic(true)).
  261'$pattr_directive'(multifile(Spec), M) :-
  262    '$set_pattr'(Spec, M, directive, multifile(true)).
  263'$pattr_directive'(module_transparent(Spec), M) :-
  264    '$set_pattr'(Spec, M, directive, transparent(true)).
  265'$pattr_directive'(discontiguous(Spec), M) :-
  266    '$set_pattr'(Spec, M, directive, discontiguous(true)).
  267'$pattr_directive'(volatile(Spec), M) :-
  268    '$set_pattr'(Spec, M, directive, volatile(true)).
  269'$pattr_directive'(thread_local(Spec), M) :-
  270    '$set_pattr'(Spec, M, directive, thread_local(true)).
  271'$pattr_directive'(noprofile(Spec), M) :-
  272    '$set_pattr'(Spec, M, directive, noprofile(true)).
  273'$pattr_directive'(public(Spec), M) :-
  274    '$set_pattr'(Spec, M, directive, public(true)).

 $pi_head(?PI, ?Head)

  278'$pi_head'(PI, Head) :-
  279    var(PI),
  280    var(Head),
  281    '$instantiation_error'([PI,Head]).
  282'$pi_head'(M:PI, M:Head) :-
  283    !,
  284    '$pi_head'(PI, Head).
  285'$pi_head'(Name/Arity, Head) :-
  286    !,
  287    '$head_name_arity'(Head, Name, Arity).
  288'$pi_head'(Name//DCGArity, Head) :-
  289    !,
  290    (   nonvar(DCGArity)
  291    ->  Arity is DCGArity+2,
  292        '$head_name_arity'(Head, Name, Arity)
  293    ;   '$head_name_arity'(Head, Name, Arity),
  294        DCGArity is Arity - 2
  295    ).
  296'$pi_head'(PI, _) :-
  297    '$type_error'(predicate_indicator, PI).

 $head_name_arity(+Goal, -Name, -Arity)

$head_name_arity(-Goal, +Name, +Arity)

  302'$head_name_arity'(Goal, Name, Arity) :-
  303    (   atom(Goal)
  304    ->  Name = Goal, Arity = 0
  305    ;   compound(Goal)
  306    ->  compound_name_arity(Goal, Name, Arity)
  307    ;   var(Goal)
  308    ->  (   Arity == 0
  309        ->  (   atom(Name)
  310            ->  Goal = Name
  311            ;   Name == []
  312            ->  Goal = Name
  313            ;   blob(Name, closure)
  314            ->  Goal = Name
  315            ;   '$type_error'(atom, Name)
  316            )
  317        ;   compound_name_arity(Goal, Name, Arity)
  318        )
  319    ;   '$type_error'(callable, Goal)
  320    ).
  321
  322:- '$iso'(((dynamic)/1, (multifile)/1, (discontiguous)/1)).  323
  324
  325                /********************************
  326                *       CALLING, CONTROL        *
  327                *********************************/
  328
  329:- noprofile((call/1,
  330              catch/3,
  331              once/1,
  332              ignore/1,
  333              call_cleanup/2,
  334              call_cleanup/3,
  335              setup_call_cleanup/3,
  336              setup_call_catcher_cleanup/4)).  337
  338:- meta_predicate
  339    ';'(0,0),
  340    ','(0,0),
  341    @(0,+),
  342    call(0),
  343    call(1,?),
  344    call(2,?,?),
  345    call(3,?,?,?),
  346    call(4,?,?,?,?),
  347    call(5,?,?,?,?,?),
  348    call(6,?,?,?,?,?,?),
  349    call(7,?,?,?,?,?,?,?),
  350    not(0),
  351    \+(0),
  352    '->'(0,0),
  353    '*->'(0,0),
  354    once(0),
  355    ignore(0),
  356    catch(0,?,0),
  357    reset(0,?,-),
  358    setup_call_cleanup(0,0,0),
  359    setup_call_catcher_cleanup(0,0,?,0),
  360    call_cleanup(0,0),
  361    call_cleanup(0,?,0),
  362    catch_with_backtrace(0,?,0),
  363    '$meta_call'(0).  364
  365:- '$iso'((call/1, (\+)/1, once/1, (;)/2, (',')/2, (->)/2, catch/3)).  366
  367% The control structures are always compiled, both   if they appear in a
  368% clause body and if they are handed  to   call/1.  The only way to call
  369% these predicates is by means of  call/2..   In  that case, we call the
  370% hole control structure again to get it compiled by call/1 and properly
  371% deal  with  !,  etc.  Another  reason  for  having  these  things   as
  372% predicates is to be able to define   properties for them, helping code
  373% analyzers.
  374
  375(M0:If ; M0:Then) :- !, call(M0:(If ; Then)).
  376(M1:If ; M2:Then) :-    call(M1:(If ; M2:Then)).
  377(G1   , G2)       :-    call((G1   , G2)).
  378(If  -> Then)     :-    call((If  -> Then)).
  379(If *-> Then)     :-    call((If *-> Then)).
  380@(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.

  394'$meta_call'(M:G) :-
  395    prolog_current_choice(Ch),
  396    '$meta_call'(G, M, Ch).
  397
  398'$meta_call'(Var, _, _) :-
  399    var(Var),
  400    !,
  401    '$instantiation_error'(Var).
  402'$meta_call'((A,B), M, Ch) :-
  403    !,
  404    '$meta_call'(A, M, Ch),
  405    '$meta_call'(B, M, Ch).
  406'$meta_call'((I->T;E), M, Ch) :-
  407    !,
  408    (   prolog_current_choice(Ch2),
  409        '$meta_call'(I, M, Ch2)
  410    ->  '$meta_call'(T, M, Ch)
  411    ;   '$meta_call'(E, M, Ch)
  412    ).
  413'$meta_call'((I*->T;E), M, Ch) :-
  414    !,
  415    (   prolog_current_choice(Ch2),
  416        '$meta_call'(I, M, Ch2)
  417    *-> '$meta_call'(T, M, Ch)
  418    ;   '$meta_call'(E, M, Ch)
  419    ).
  420'$meta_call'((I->T), M, Ch) :-
  421    !,
  422    (   prolog_current_choice(Ch2),
  423        '$meta_call'(I, M, Ch2)
  424    ->  '$meta_call'(T, M, Ch)
  425    ).
  426'$meta_call'((I*->T), M, Ch) :-
  427    !,
  428    prolog_current_choice(Ch2),
  429    '$meta_call'(I, M, Ch2),
  430    '$meta_call'(T, M, Ch).
  431'$meta_call'((A;B), M, Ch) :-
  432    !,
  433    (   '$meta_call'(A, M, Ch)
  434    ;   '$meta_call'(B, M, Ch)
  435    ).
  436'$meta_call'(\+(G), M, _) :-
  437    !,
  438    prolog_current_choice(Ch),
  439    \+ '$meta_call'(G, M, Ch).
  440'$meta_call'(call(G), M, _) :-
  441    !,
  442    prolog_current_choice(Ch),
  443    '$meta_call'(G, M, Ch).
  444'$meta_call'(M:G, _, Ch) :-
  445    !,
  446    '$meta_call'(G, M, Ch).
  447'$meta_call'(!, _, Ch) :-
  448    prolog_cut_to(Ch).
  449'$meta_call'(G, M, _Ch) :-
  450    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..

  466:- '$iso'((call/2,
  467           call/3,
  468           call/4,
  469           call/5,
  470           call/6,
  471           call/7,
  472           call/8)).  473
  474call(Goal) :-                           % make these available as predicates
  475    Goal.
  476call(Goal, A) :-
  477    call(Goal, A).
  478call(Goal, A, B) :-
  479    call(Goal, A, B).
  480call(Goal, A, B, C) :-
  481    call(Goal, A, B, C).
  482call(Goal, A, B, C, D) :-
  483    call(Goal, A, B, C, D).
  484call(Goal, A, B, C, D, E) :-
  485    call(Goal, A, B, C, D, E).
  486call(Goal, A, B, C, D, E, F) :-
  487    call(Goal, A, B, C, D, E, F).
  488call(Goal, A, B, C, D, E, F, G) :-
  489    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.

  496not(Goal) :-
  497    \+ Goal.

 \+ :Goal is semidet

Predicate version that allows for meta-calling.

  503\+ Goal :-
  504    \+ Goal.

 once(:Goal) is semidet

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

  510once(Goal) :-
  511    Goal,
  512    !.

 ignore(:Goal) is det

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

  519ignore(Goal) :-
  520    Goal,
  521    !.
  522ignore(_Goal).
  523
  524:- '$iso'((false/0)).

 false

Synonym for fail/0, providing a declarative reading.

  530false :-
  531    fail.

 catch(:Goal, +Catcher, :Recover)

ISO compliant exception handling.

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

 prolog_cut_to(+Choice)

Cut all choice points after Choice

  544prolog_cut_to(_Choice) :-
  545    '$cut'.                         % Maps to I_CUTCHP

 reset(:Goal, ?Ball, -Continue)

Delimited continuation support.

  551reset(_Goal, _Ball, _Cont) :-
  552    '$reset'.

 shift(+Ball)

Shift control back to the enclosing reset/3

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

  573call_continuation([]).
  574call_continuation([TB|Rest]) :-
  575    (   Rest == []
  576    ->  '$call_continuation'(TB)
  577    ;   '$call_continuation'(TB),
  578        call_continuation(Rest)
  579    ).

 catch_with_backtrace(:Goal, ?Ball, :Recover)

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

  586catch_with_backtrace(Goal, Ball, Recover) :-
  587    catch(Goal, Ball, Recover),
  588    '$no_lco'.
  589
  590'$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.

  600:- public '$recover_and_rethrow'/2.  601
  602'$recover_and_rethrow'(Goal, Exception) :-
  603    call_cleanup(Goal, throw(Exception)),
  604    !.

 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.

  619setup_call_catcher_cleanup(Setup, _Goal, _Catcher, _Cleanup) :-
  620    '$sig_atomic'(Setup),
  621    '$call_cleanup'.
  622
  623setup_call_cleanup(Setup, Goal, Cleanup) :-
  624    setup_call_catcher_cleanup(Setup, Goal, _Catcher, Cleanup).
  625
  626call_cleanup(Goal, Cleanup) :-
  627    setup_call_catcher_cleanup(true, Goal, _Catcher, Cleanup).
  628
  629call_cleanup(Goal, Catcher, Cleanup) :-
  630    setup_call_catcher_cleanup(true, Goal, Catcher, Cleanup).
  631
  632                 /*******************************
  633                 *       INITIALIZATION         *
  634                 *******************************/
  635
  636:- meta_predicate
  637    initialization(0, +).  638
  639:- multifile '$init_goal'/3.  640:- 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.

  666initialization(Goal, When) :-
  667    '$must_be'(oneof(atom, initialization_type,
  668                     [ now,
  669                       after_load,
  670                       restore,
  671                       restore_state,
  672                       prepare_state,
  673                       program,
  674                       main
  675                     ]), When),
  676    '$initialization_context'(Source, Ctx),
  677    '$initialization'(When, Goal, Source, Ctx).
  678
  679'$initialization'(now, Goal, _Source, Ctx) :-
  680    '$run_init_goal'(Goal, Ctx),
  681    '$compile_init_goal'(-, Goal, Ctx).
  682'$initialization'(after_load, Goal, Source, Ctx) :-
  683    (   Source \== (-)
  684    ->  '$compile_init_goal'(Source, Goal, Ctx)
  685    ;   throw(error(context_error(nodirective,
  686                                  initialization(Goal, after_load)),
  687                    _))
  688    ).
  689'$initialization'(restore, Goal, Source, Ctx) :- % deprecated
  690    '$initialization'(restore_state, Goal, Source, Ctx).
  691'$initialization'(restore_state, Goal, _Source, Ctx) :-
  692    (   \+ current_prolog_flag(sandboxed_load, true)
  693    ->  '$compile_init_goal'(-, Goal, Ctx)
  694    ;   '$permission_error'(register, initialization(restore), Goal)
  695    ).
  696'$initialization'(prepare_state, Goal, _Source, Ctx) :-
  697    (   \+ current_prolog_flag(sandboxed_load, true)
  698    ->  '$compile_init_goal'(when(prepare_state), Goal, Ctx)
  699    ;   '$permission_error'(register, initialization(restore), Goal)
  700    ).
  701'$initialization'(program, Goal, _Source, Ctx) :-
  702    (   \+ current_prolog_flag(sandboxed_load, true)
  703    ->  '$compile_init_goal'(when(program), Goal, Ctx)
  704    ;   '$permission_error'(register, initialization(restore), Goal)
  705    ).
  706'$initialization'(main, Goal, _Source, Ctx) :-
  707    (   \+ current_prolog_flag(sandboxed_load, true)
  708    ->  '$compile_init_goal'(when(main), Goal, Ctx)
  709    ;   '$permission_error'(register, initialization(restore), Goal)
  710    ).
  711
  712
  713'$compile_init_goal'(Source, Goal, Ctx) :-
  714    atom(Source),
  715    Source \== (-),
  716    !,
  717    '$store_admin_clause'(system:'$init_goal'(Source, Goal, Ctx),
  718                          _Layout, Source, Ctx).
  719'$compile_init_goal'(Source, Goal, Ctx) :-
  720    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.

  732'$run_initialization'(_, loaded, _) :- !.
  733'$run_initialization'(File, _Action, Options) :-
  734    '$run_initialization'(File, Options).
  735
  736'$run_initialization'(File, Options) :-
  737    setup_call_cleanup(
  738        '$start_run_initialization'(Options, Restore),
  739        '$run_initialization_2'(File),
  740        '$end_run_initialization'(Restore)).
  741
  742'$start_run_initialization'(Options, OldSandBoxed) :-
  743    '$push_input_context'(initialization),
  744    '$set_sandboxed_load'(Options, OldSandBoxed).
  745'$end_run_initialization'(OldSandBoxed) :-
  746    set_prolog_flag(sandboxed_load, OldSandBoxed),
  747    '$pop_input_context'.
  748
  749'$run_initialization_2'(File) :-
  750    (   '$init_goal'(File, Goal, Ctx),
  751        File \= when(_),
  752        '$run_init_goal'(Goal, Ctx),
  753        fail
  754    ;   true
  755    ).
  756
  757'$run_init_goal'(Goal, Ctx) :-
  758    (   catch_with_backtrace('$run_init_goal'(Goal), E,
  759                             '$initialization_error'(E, Goal, Ctx))
  760    ->  true
  761    ;   '$initialization_failure'(Goal, Ctx)
  762    ).
  763
  764:- multifile prolog:sandbox_allowed_goal/1.  765
  766'$run_init_goal'(Goal) :-
  767    current_prolog_flag(sandboxed_load, false),
  768    !,
  769    call(Goal).
  770'$run_init_goal'(Goal) :-
  771    prolog:sandbox_allowed_goal(Goal),
  772    call(Goal).
  773
  774'$initialization_context'(Source, Ctx) :-
  775    (   source_location(File, Line)
  776    ->  Ctx = File:Line,
  777        '$input_context'(Context),
  778        '$top_file'(Context, File, Source)
  779    ;   Ctx = (-),
  780        File = (-)
  781    ).
  782
  783'$top_file'([input(include, F1, _, _)|T], _, F) :-
  784    !,
  785    '$top_file'(T, F1, F).
  786'$top_file'(_, F, F).
  787
  788
  789'$initialization_error'(E, Goal, Ctx) :-
  790    print_message(error, initialization_error(Goal, E, Ctx)).
  791
  792'$initialization_failure'(Goal, Ctx) :-
  793    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

  801:- public '$clear_source_admin'/1.  802
  803'$clear_source_admin'(File) :-
  804    retractall('$init_goal'(_, _, File:_)),
  805    retractall('$load_context_module'(File, _, _)),
  806    retractall('$resolved_source_path_db'(_, _, File)).
  807
  808
  809                 /*******************************
  810                 *            STREAM            *
  811                 *******************************/
  812
  813:- '$iso'(stream_property/2).  814stream_property(Stream, Property) :-
  815    nonvar(Stream),
  816    nonvar(Property),
  817    !,
  818    '$stream_property'(Stream, Property).
  819stream_property(Stream, Property) :-
  820    nonvar(Stream),
  821    !,
  822    '$stream_properties'(Stream, Properties),
  823    '$member'(Property, Properties).
  824stream_property(Stream, Property) :-
  825    nonvar(Property),
  826    !,
  827    (   Property = alias(Alias),
  828        atom(Alias)
  829    ->  '$alias_stream'(Alias, Stream)
  830    ;   '$streams_properties'(Property, Pairs),
  831        '$member'(Stream-Property, Pairs)
  832    ).
  833stream_property(Stream, Property) :-
  834    '$streams_properties'(Property, Pairs),
  835    '$member'(Stream-Properties, Pairs),
  836    '$member'(Property, Properties).
  837
  838
  839                /********************************
  840                *            MODULES            *
  841                *********************************/
  842
  843%       '$prefix_module'(+Module, +Context, +Term, -Prefixed)
  844%       Tags `Term' with `Module:' if `Module' is not the context module.
  845
  846'$prefix_module'(Module, Module, Head, Head) :- !.
  847'$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'.

  853default_module(Me, Super) :-
  854    (   atom(Me)
  855    ->  (   var(Super)
  856        ->  '$default_module'(Me, Super)
  857        ;   '$default_module'(Me, Super), !
  858        )
  859    ;   '$type_error'(module, Me)
  860    ).
  861
  862'$default_module'(Me, Me).
  863'$default_module'(Me, Super) :-
  864    import_module(Me, S),
  865    '$default_module'(S, Super).
  866
  867
  868                /********************************
  869                *      TRACE AND EXCEPTIONS     *
  870                *********************************/
  871
  872:- dynamic   user:exception/3.  873:- 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.

  882:- public
  883    '$undefined_procedure'/4.  884
  885'$undefined_procedure'(Module, Name, Arity, Action) :-
  886    '$prefix_module'(Module, user, Name/Arity, Pred),
  887    user:exception(undefined_predicate, Pred, Action0),
  888    !,
  889    Action = Action0.
  890'$undefined_procedure'(Module, Name, Arity, Action) :-
  891    \+ current_prolog_flag(autoload, false),
  892    '$autoload'(Module:Name/Arity),
  893    !,
  894    Action = retry.
  895'$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.

  907'$loading'(Library) :-
  908    current_prolog_flag(threads, true),
  909    (   '$loading_file'(Library, _Queue, _LoadThread)
  910    ->  true
  911    ;   '$loading_file'(FullFile, _Queue, _LoadThread),
  912        file_name_extension(Library, _, FullFile)
  913    ->  true
  914    ).
  915
  916%        handle debugger 'w', 'p' and <N> depth options.
  917
  918'$set_debugger_write_options'(write) :-
  919    !,
  920    create_prolog_flag(debugger_write_options,
  921                       [ quoted(true),
  922                         attributes(dots),
  923                         spacing(next_argument)
  924                       ], []).
  925'$set_debugger_write_options'(print) :-
  926    !,
  927    create_prolog_flag(debugger_write_options,
  928                       [ quoted(true),
  929                         portray(true),
  930                         max_depth(10),
  931                         attributes(portray),
  932                         spacing(next_argument)
  933                       ], []).
  934'$set_debugger_write_options'(Depth) :-
  935    current_prolog_flag(debugger_write_options, Options0),
  936    (   '$select'(max_depth(_), Options0, Options)
  937    ->  true
  938    ;   Options = Options0
  939    ),
  940    create_prolog_flag(debugger_write_options,
  941                       [max_depth(Depth)|Options], []).
  942
  943
  944                /********************************
  945                *        SYSTEM MESSAGES        *
  946                *********************************/

 $confirm(Spec)

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

  953'$confirm'(Spec) :-
  954    print_message(query, Spec),
  955    between(0, 5, _),
  956        get_single_char(Answer),
  957        (   '$in_reply'(Answer, 'yYjJ \n')
  958        ->  !,
  959            print_message(query, if_tty([yes-[]]))
  960        ;   '$in_reply'(Answer, 'nN')
  961        ->  !,
  962            print_message(query, if_tty([no-[]])),
  963            fail
  964        ;   print_message(help, query(confirm)),
  965            fail
  966        ).
  967
  968'$in_reply'(Code, Atom) :-
  969    char_code(Char, Code),
  970    sub_atom(Atom, _, _, _, Char),
  971    !.
  972
  973:- dynamic
  974    user:portray/1.  975:- multifile
  976    user:portray/1.  977
  978
  979                 /*******************************
  980                 *       FILE_SEARCH_PATH       *
  981                 *******************************/
  982
  983:- dynamic
  984    user:file_search_path/2,
  985    user:library_directory/1.  986:- multifile
  987    user:file_search_path/2,
  988    user:library_directory/1.  989
  990user:(file_search_path(library, Dir) :-
  991        library_directory(Dir)).
  992user:file_search_path(swi, Home) :-
  993    current_prolog_flag(home, Home).
  994user:file_search_path(swi, Home) :-
  995    current_prolog_flag(shared_home, Home).
  996user:file_search_path(library, app_config(lib)).
  997user:file_search_path(library, swi(library)).
  998user:file_search_path(library, swi(library/clp)).
  999user:file_search_path(foreign, swi(ArchLib)) :-
 1000    \+ current_prolog_flag(windows, true),
 1001    current_prolog_flag(arch, Arch),
 1002    atom_concat('lib/', Arch, ArchLib).
 1003user:file_search_path(foreign, swi(SoLib)) :-
 1004    (   current_prolog_flag(windows, true)
 1005    ->  SoLib = bin
 1006    ;   SoLib = lib
 1007    ).
 1008user:file_search_path(path, Dir) :-
 1009    getenv('PATH', Path),
 1010    (   current_prolog_flag(windows, true)
 1011    ->  atomic_list_concat(Dirs, (;), Path)
 1012    ;   atomic_list_concat(Dirs, :, Path)
 1013    ),
 1014    '$member'(Dir, Dirs).
 1015user:file_search_path(user_app_data, Dir) :-
 1016    '$xdg_prolog_directory'(data, Dir).
 1017user:file_search_path(common_app_data, Dir) :-
 1018    '$xdg_prolog_directory'(common_data, Dir).
 1019user:file_search_path(user_app_config, Dir) :-
 1020    '$xdg_prolog_directory'(config, Dir).
 1021user:file_search_path(common_app_config, Dir) :-
 1022    '$xdg_prolog_directory'(common_config, Dir).
 1023user:file_search_path(app_data, user_app_data('.')).
 1024user:file_search_path(app_data, common_app_data('.')).
 1025user:file_search_path(app_config, user_app_config('.')).
 1026user:file_search_path(app_config, common_app_config('.')).
 1027% backward compatibility
 1028user:file_search_path(app_preferences, user_app_config('.')).
 1029user:file_search_path(user_profile, app_preferences('.')).
 1030
 1031'$xdg_prolog_directory'(Which, Dir) :-
 1032    '$xdg_directory'(Which, XDGDir),
 1033    '$make_config_dir'(XDGDir),
 1034    '$ensure_slash'(XDGDir, XDGDirS),
 1035    atom_concat(XDGDirS, 'swi-prolog', Dir),
 1036    '$make_config_dir'(Dir).
 1037
 1038% config
 1039'$xdg_directory'(config, Home) :-
 1040    current_prolog_flag(windows, true),
 1041    catch(win_folder(appdata, Home), _, fail),
 1042    !.
 1043'$xdg_directory'(config, Home) :-
 1044    getenv('XDG_CONFIG_HOME', Home).
 1045'$xdg_directory'(config, Home) :-
 1046    expand_file_name('~/.config', [Home]).
 1047% data
 1048'$xdg_directory'(data, Home) :-
 1049    current_prolog_flag(windows, true),
 1050    catch(win_folder(local_appdata, Home), _, fail),
 1051    !.
 1052'$xdg_directory'(data, Home) :-
 1053    getenv('XDG_DATA_HOME', Home).
 1054'$xdg_directory'(data, Home) :-
 1055    expand_file_name('~/.local', [Local]),
 1056    '$make_config_dir'(Local),
 1057    atom_concat(Local, '/share', Home),
 1058    '$make_config_dir'(Home).
 1059% common data
 1060'$xdg_directory'(common_data, Dir) :-
 1061    current_prolog_flag(windows, true),
 1062    catch(win_folder(common_appdata, Dir), _, fail),
 1063    !.
 1064'$xdg_directory'(common_data, Dir) :-
 1065    '$existing_dir_from_env_path'('XDG_DATA_DIRS',
 1066                                  [ '/usr/local/share',
 1067                                    '/usr/share'
 1068                                  ],
 1069                                  Dir).
 1070% common config
 1071'$xdg_directory'(common_config, Dir) :-
 1072    current_prolog_flag(windows, true),
 1073    catch(win_folder(common_appdata, Dir), _, fail),
 1074    !.
 1075'$xdg_directory'(common_config, Dir) :-
 1076    '$existing_dir_from_env_path'('XDG_CONFIG_DIRS', ['/etc/xdg'], Dir).
 1077
 1078'$existing_dir_from_env_path'(Env, Defaults, Dir) :-
 1079    (   getenv(Env, Path)
 1080    ->  '$path_sep'(Sep),
 1081        atomic_list_concat(Dirs, Sep, Path)
 1082    ;   Dirs = Defaults
 1083    ),
 1084    '$member'(Dir, Dirs),
 1085    Dir \== '',
 1086    exists_directory(Dir).
 1087
 1088'$path_sep'(Char) :-
 1089    (   current_prolog_flag(windows, true)
 1090    ->  Char = ';'
 1091    ;   Char = ':'
 1092    ).
 1093
 1094'$make_config_dir'(Dir) :-
 1095    exists_directory(Dir),
 1096    !.
 1097'$make_config_dir'(Dir) :-
 1098    nb_current('$create_search_directories', true),
 1099    file_directory_name(Dir, Parent),
 1100    '$my_file'(Parent),
 1101    catch(make_directory(Dir), _, fail).
 1102
 1103'$ensure_slash'(Dir, DirS) :-
 1104    (   sub_atom(Dir, _, _, 0, /)
 1105    ->  DirS = Dir
 1106    ;   atom_concat(Dir, /, DirS)
 1107    ).

 $expand_file_search_path(+Spec, -Expanded, +Cond) is nondet

 1112'$expand_file_search_path'(Spec, Expanded, Cond) :-
 1113    '$option'(access(Access), Cond),
 1114    memberchk(Access, [write,append]),
 1115    !,
 1116    setup_call_cleanup(
 1117        nb_setval('$create_search_directories', true),
 1118        expand_file_search_path(Spec, Expanded),
 1119        nb_delete('$create_search_directories')).
 1120'$expand_file_search_path'(Spec, Expanded, _Cond) :-
 1121    expand_file_search_path(Spec, Expanded).

 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?

 1129expand_file_search_path(Spec, Expanded) :-
 1130    catch('$expand_file_search_path'(Spec, Expanded, 0, []),
 1131          loop(Used),
 1132          throw(error(loop_error(Spec), file_search(Used)))).
 1133
 1134'$expand_file_search_path'(Spec, Expanded, N, Used) :-
 1135    functor(Spec, Alias, 1),
 1136    !,
 1137    user:file_search_path(Alias, Exp0),
 1138    NN is N + 1,
 1139    (   NN > 16
 1140    ->  throw(loop(Used))
 1141    ;   true
 1142    ),
 1143    '$expand_file_search_path'(Exp0, Exp1, NN, [Alias=Exp0|Used]),
 1144    arg(1, Spec, Segments),
 1145    '$segments_to_atom'(Segments, File),
 1146    '$make_path'(Exp1, File, Expanded).
 1147'$expand_file_search_path'(Spec, Path, _, _) :-
 1148    '$segments_to_atom'(Spec, Path).
 1149
 1150'$make_path'(Dir, '.', Path) :-
 1151    !,
 1152    Path = Dir.
 1153'$make_path'(Dir, File, Path) :-
 1154    sub_atom(Dir, _, _, 0, /),
 1155    !,
 1156    atom_concat(Dir, File, Path).
 1157'$make_path'(Dir, File, Path) :-
 1158    atomic_list_concat([Dir, /, File], Path).
 1159
 1160
 1161                /********************************
 1162                *         FILE CHECKING         *
 1163                *********************************/

 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.

 1174absolute_file_name(Spec, Options, Path) :-
 1175    '$is_options'(Options),
 1176    \+ '$is_options'(Path),
 1177    !,
 1178    absolute_file_name(Spec, Path, Options).
 1179absolute_file_name(Spec, Path, Options) :-
 1180    '$must_be'(options, Options),
 1181                    % get the valid extensions
 1182    (   '$select_option'(extensions(Exts), Options, Options1)
 1183    ->  '$must_be'(list, Exts)
 1184    ;   '$option'(file_type(Type), Options)
 1185    ->  '$must_be'(atom, Type),
 1186        '$file_type_extensions'(Type, Exts),
 1187        Options1 = Options
 1188    ;   Options1 = Options,
 1189        Exts = ['']
 1190    ),
 1191    '$canonicalise_extensions'(Exts, Extensions),
 1192                    % unless specified otherwise, ask regular file
 1193    (   nonvar(Type)
 1194    ->  Options2 = Options1
 1195    ;   '$merge_options'(_{file_type:regular}, Options1, Options2)
 1196    ),
 1197                    % Det or nondet?
 1198    (   '$select_option'(solutions(Sols), Options2, Options3)
 1199    ->  '$must_be'(oneof(atom, solutions, [first,all]), Sols)
 1200    ;   Sols = first,
 1201        Options3 = Options2
 1202    ),
 1203                    % Errors or not?
 1204    (   '$select_option'(file_errors(FileErrors), Options3, Options4)
 1205    ->  '$must_be'(oneof(atom, file_errors, [error,fail]), FileErrors)
 1206    ;   FileErrors = error,
 1207        Options4 = Options3
 1208    ),
 1209                    % Expand shell patterns?
 1210    (   atomic(Spec),
 1211        '$select_option'(expand(Expand), Options4, Options5),
 1212        '$must_be'(boolean, Expand)
 1213    ->  expand_file_name(Spec, List),
 1214        '$member'(Spec1, List)
 1215    ;   Spec1 = Spec,
 1216        Options5 = Options4
 1217    ),
 1218                    % Search for files
 1219    (   Sols == first
 1220    ->  (   '$chk_file'(Spec1, Extensions, Options5, true, Path)
 1221        ->  !       % also kill choice point of expand_file_name/2
 1222        ;   (   FileErrors == fail
 1223            ->  fail
 1224            ;   '$current_module'('$bags', _File),
 1225                findall(P,
 1226                        '$chk_file'(Spec1, Extensions, [access(exist)],
 1227                                    false, P),
 1228                        Candidates),
 1229                '$abs_file_error'(Spec, Candidates, Options5)
 1230            )
 1231        )
 1232    ;   '$chk_file'(Spec1, Extensions, Options5, false, Path)
 1233    ).
 1234
 1235'$abs_file_error'(Spec, Candidates, Conditions) :-
 1236    '$member'(F, Candidates),
 1237    '$member'(C, Conditions),
 1238    '$file_condition'(C),
 1239    '$file_error'(C, Spec, F, E, Comment),
 1240    !,
 1241    throw(error(E, context(_, Comment))).
 1242'$abs_file_error'(Spec, _, _) :-
 1243    '$existence_error'(source_sink, Spec).
 1244
 1245'$file_error'(file_type(directory), Spec, File, Error, Comment) :-
 1246    \+ exists_directory(File),
 1247    !,
 1248    Error = existence_error(directory, Spec),
 1249    Comment = not_a_directory(File).
 1250'$file_error'(file_type(_), Spec, File, Error, Comment) :-
 1251    exists_directory(File),
 1252    !,
 1253    Error = existence_error(file, Spec),
 1254    Comment = directory(File).
 1255'$file_error'(access(OneOrList), Spec, File, Error, _) :-
 1256    '$one_or_member'(Access, OneOrList),
 1257    \+ access_file(File, Access),
 1258    Error = permission_error(Access, source_sink, Spec).
 1259
 1260'$one_or_member'(Elem, List) :-
 1261    is_list(List),
 1262    !,
 1263    '$member'(Elem, List).
 1264'$one_or_member'(Elem, Elem).
 1265
 1266
 1267'$file_type_extensions'(source, Exts) :-       % SICStus 3.9 compatibility
 1268    !,
 1269    '$file_type_extensions'(prolog, Exts).
 1270'$file_type_extensions'(Type, Exts) :-
 1271    '$current_module'('$bags', _File),
 1272    !,
 1273    findall(Ext, user:prolog_file_type(Ext, Type), Exts0),
 1274    (   Exts0 == [],
 1275        \+ '$ft_no_ext'(Type)
 1276    ->  '$domain_error'(file_type, Type)
 1277    ;   true
 1278    ),
 1279    '$append'(Exts0, [''], Exts).
 1280'$file_type_extensions'(prolog, [pl, '']). % findall is not yet defined ...
 1281
 1282'$ft_no_ext'(txt).
 1283'$ft_no_ext'(executable).
 1284'$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.

 1297:- multifile(user:prolog_file_type/2). 1298:- dynamic(user:prolog_file_type/2). 1299
 1300user:prolog_file_type(pl,       prolog).
 1301user:prolog_file_type(prolog,   prolog).
 1302user:prolog_file_type(qlf,      prolog).
 1303user:prolog_file_type(qlf,      qlf).
 1304user:prolog_file_type(Ext,      executable) :-
 1305    current_prolog_flag(shared_object_extension, Ext).
 1306user:prolog_file_type(dylib,    executable) :-
 1307    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.

 1314'$chk_file'(Spec, _Extensions, _Cond, _Cache, _FullName) :-
 1315    \+ ground(Spec),
 1316    !,
 1317    '$instantiation_error'(Spec).
 1318'$chk_file'(Spec, Extensions, Cond, Cache, FullName) :-
 1319    compound(Spec),
 1320    functor(Spec, _, 1),
 1321    !,
 1322    '$relative_to'(Cond, cwd, CWD),
 1323    '$chk_alias_file'(Spec, Extensions, Cond, Cache, CWD, FullName).
 1324'$chk_file'(Segments, Ext, Cond, Cache, FullName) :-    % allow a/b/...
 1325    \+ atomic(Segments),
 1326    !,
 1327    '$segments_to_atom'(Segments, Atom),
 1328    '$chk_file'(Atom, Ext, Cond, Cache, FullName).
 1329'$chk_file'(File, Exts, Cond, _, FullName) :-
 1330    is_absolute_file_name(File),
 1331    !,
 1332    '$extend_file'(File, Exts, Extended),
 1333    '$file_conditions'(Cond, Extended),
 1334    '$absolute_file_name'(Extended, FullName).
 1335'$chk_file'(File, Exts, Cond, _, FullName) :-
 1336    '$relative_to'(Cond, source, Dir),
 1337    atomic_list_concat([Dir, /, File], AbsFile),
 1338    '$extend_file'(AbsFile, Exts, Extended),
 1339    '$file_conditions'(Cond, Extended),
 1340    !,
 1341    '$absolute_file_name'(Extended, FullName).
 1342'$chk_file'(File, Exts, Cond, _, FullName) :-
 1343    '$extend_file'(File, Exts, Extended),
 1344    '$file_conditions'(Cond, Extended),
 1345    '$absolute_file_name'(Extended, FullName).
 1346
 1347'$segments_to_atom'(Atom, Atom) :-
 1348    atomic(Atom),
 1349    !.
 1350'$segments_to_atom'(Segments, Atom) :-
 1351    '$segments_to_list'(Segments, List, []),
 1352    !,
 1353    atomic_list_concat(List, /, Atom).
 1354
 1355'$segments_to_list'(A/B, H, T) :-
 1356    '$segments_to_list'(A, H, T0),
 1357    '$segments_to_list'(B, T0, T).
 1358'$segments_to_list'(A, [A|T], T) :-
 1359    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.

 1369'$relative_to'(Conditions, Default, Dir) :-
 1370    (   '$option'(relative_to(FileOrDir), Conditions)
 1371    *-> (   exists_directory(FileOrDir)
 1372        ->  Dir = FileOrDir
 1373        ;   atom_concat(Dir, /, FileOrDir)
 1374        ->  true
 1375        ;   file_directory_name(FileOrDir, Dir)
 1376        )
 1377    ;   Default == cwd
 1378    ->  '$cwd'(Dir)
 1379    ;   Default == source
 1380    ->  source_location(ContextFile, _Line),
 1381        file_directory_name(ContextFile, Dir)
 1382    ).

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

 1387:- dynamic
 1388    '$search_path_file_cache'/3,    % SHA1, Time, Path
 1389    '$search_path_gc_time'/1.       % Time
 1390:- volatile
 1391    '$search_path_file_cache'/3,
 1392    '$search_path_gc_time'/1. 1393
 1394:- create_prolog_flag(file_search_cache_time, 10, []). 1395
 1396'$chk_alias_file'(Spec, Exts, Cond, true, CWD, FullFile) :-
 1397    !,
 1398    findall(Exp, '$expand_file_search_path'(Spec, Exp, Cond), Expansions),
 1399    current_prolog_flag(emulated_dialect, Dialect),
 1400    Cache = cache(Exts, Cond, CWD, Expansions, Dialect),
 1401    variant_sha1(Spec+Cache, SHA1),
 1402    get_time(Now),
 1403    current_prolog_flag(file_search_cache_time, TimeOut),
 1404    (   '$search_path_file_cache'(SHA1, CachedTime, FullFile),
 1405        CachedTime > Now - TimeOut,
 1406        '$file_conditions'(Cond, FullFile)
 1407    ->  '$search_message'(file_search(cache(Spec, Cond), FullFile))
 1408    ;   '$member'(Expanded, Expansions),
 1409        '$extend_file'(Expanded, Exts, LibFile),
 1410        (   '$file_conditions'(Cond, LibFile),
 1411            '$absolute_file_name'(LibFile, FullFile),
 1412            '$cache_file_found'(SHA1, Now, TimeOut, FullFile)
 1413        ->  '$search_message'(file_search(found(Spec, Cond), FullFile))
 1414        ;   '$search_message'(file_search(tried(Spec, Cond), LibFile)),
 1415            fail
 1416        )
 1417    ).
 1418'$chk_alias_file'(Spec, Exts, Cond, false, _CWD, FullFile) :-
 1419    '$expand_file_search_path'(Spec, Expanded, Cond),
 1420    '$extend_file'(Expanded, Exts, LibFile),
 1421    '$file_conditions'(Cond, LibFile),
 1422    '$absolute_file_name'(LibFile, FullFile).
 1423
 1424'$cache_file_found'(_, _, TimeOut, _) :-
 1425    TimeOut =:= 0,
 1426    !.
 1427'$cache_file_found'(SHA1, Now, TimeOut, FullFile) :-
 1428    '$search_path_file_cache'(SHA1, Saved, FullFile),
 1429    !,
 1430    (   Now - Saved < TimeOut/2
 1431    ->  true
 1432    ;   retractall('$search_path_file_cache'(SHA1, _, _)),
 1433        asserta('$search_path_file_cache'(SHA1, Now, FullFile))
 1434    ).
 1435'$cache_file_found'(SHA1, Now, TimeOut, FullFile) :-
 1436    'gc_file_search_cache'(TimeOut),
 1437    asserta('$search_path_file_cache'(SHA1, Now, FullFile)).
 1438
 1439'gc_file_search_cache'(TimeOut) :-
 1440    get_time(Now),
 1441    '$search_path_gc_time'(Last),
 1442    Now-Last < TimeOut/2,
 1443    !.
 1444'gc_file_search_cache'(TimeOut) :-
 1445    get_time(Now),
 1446    retractall('$search_path_gc_time'(_)),
 1447    assertz('$search_path_gc_time'(Now)),
 1448    Before is Now - TimeOut,
 1449    (   '$search_path_file_cache'(SHA1, Cached, FullFile),
 1450        Cached < Before,
 1451        retractall('$search_path_file_cache'(SHA1, Cached, FullFile)),
 1452        fail
 1453    ;   true
 1454    ).
 1455
 1456
 1457'$search_message'(Term) :-
 1458    current_prolog_flag(verbose_file_search, true),
 1459    !,
 1460    print_message(informational, Term).
 1461'$search_message'(_).

 $file_conditions(+Condition, +Path)

Verify Path satisfies Condition.

 1468'$file_conditions'(List, File) :-
 1469    is_list(List),
 1470    !,
 1471    \+ ( '$member'(C, List),
 1472         '$file_condition'(C),
 1473         \+ '$file_condition'(C, File)
 1474       ).
 1475'$file_conditions'(Map, File) :-
 1476    \+ (  get_dict(Key, Map, Value),
 1477          C =.. [Key,Value],
 1478          '$file_condition'(C),
 1479         \+ '$file_condition'(C, File)
 1480       ).
 1481
 1482'$file_condition'(file_type(directory), File) :-
 1483    !,
 1484    exists_directory(File).
 1485'$file_condition'(file_type(_), File) :-
 1486    !,
 1487    \+ exists_directory(File).
 1488'$file_condition'(access(Accesses), File) :-
 1489    !,
 1490    \+ (  '$one_or_member'(Access, Accesses),
 1491          \+ access_file(File, Access)
 1492       ).
 1493
 1494'$file_condition'(exists).
 1495'$file_condition'(file_type(_)).
 1496'$file_condition'(access(_)).
 1497
 1498'$extend_file'(File, Exts, FileEx) :-
 1499    '$ensure_extensions'(Exts, File, Fs),
 1500    '$list_to_set'(Fs, FsSet),
 1501    '$member'(FileEx, FsSet).
 1502
 1503'$ensure_extensions'([], _, []).
 1504'$ensure_extensions'([E|E0], F, [FE|E1]) :-
 1505    file_name_extension(F, E, FE),
 1506    '$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.

 1515'$list_to_set'(List, Set) :-
 1516    '$list_to_set'(List, [], Set).
 1517
 1518'$list_to_set'([], _, []).
 1519'$list_to_set'([H|T], Seen, R) :-
 1520    memberchk(H, Seen),
 1521    !,
 1522    '$list_to_set'(T, R).
 1523'$list_to_set'([H|T], Seen, [H|R]) :-
 1524    '$list_to_set'(T, [H|Seen], R).
 1525
 1526/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
 1527Canonicalise the extension list. Old SWI-Prolog   require  `.pl', etc, which
 1528the Quintus compatibility  requests  `pl'.   This  layer  canonicalises  all
 1529extensions to .ext
 1530- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
 1531
 1532'$canonicalise_extensions'([], []) :- !.
 1533'$canonicalise_extensions'([H|T], [CH|CT]) :-
 1534    !,
 1535    '$must_be'(atom, H),
 1536    '$canonicalise_extension'(H, CH),
 1537    '$canonicalise_extensions'(T, CT).
 1538'$canonicalise_extensions'(E, [CE]) :-
 1539    '$canonicalise_extension'(E, CE).
 1540
 1541'$canonicalise_extension'('', '') :- !.
 1542'$canonicalise_extension'(DotAtom, DotAtom) :-
 1543    sub_atom(DotAtom, 0, _, _, '.'),
 1544    !.
 1545'$canonicalise_extension'(Atom, DotAtom) :-
 1546    atom_concat('.', Atom, DotAtom).
 1547
 1548
 1549                /********************************
 1550                *            CONSULT            *
 1551                *********************************/
 1552
 1553:- dynamic
 1554    user:library_directory/1,
 1555    user:prolog_load_file/2. 1556:- multifile
 1557    user:library_directory/1,
 1558    user:prolog_load_file/2. 1559
 1560:- prompt(_, '|: '). 1561
 1562:- thread_local
 1563    '$compilation_mode_store'/1,    % database, wic, qlf
 1564    '$directive_mode_store'/1.      % database, wic, qlf
 1565:- volatile
 1566    '$compilation_mode_store'/1,
 1567    '$directive_mode_store'/1. 1568
 1569'$compilation_mode'(Mode) :-
 1570    (   '$compilation_mode_store'(Val)
 1571    ->  Mode = Val
 1572    ;   Mode = database
 1573    ).
 1574
 1575'$set_compilation_mode'(Mode) :-
 1576    retractall('$compilation_mode_store'(_)),
 1577    assertz('$compilation_mode_store'(Mode)).
 1578
 1579'$compilation_mode'(Old, New) :-
 1580    '$compilation_mode'(Old),
 1581    (   New == Old
 1582    ->  true
 1583    ;   '$set_compilation_mode'(New)
 1584    ).
 1585
 1586'$directive_mode'(Mode) :-
 1587    (   '$directive_mode_store'(Val)
 1588    ->  Mode = Val
 1589    ;   Mode = database
 1590    ).
 1591
 1592'$directive_mode'(Old, New) :-
 1593    '$directive_mode'(Old),
 1594    (   New == Old
 1595    ->  true
 1596    ;   '$set_directive_mode'(New)
 1597    ).
 1598
 1599'$set_directive_mode'(Mode) :-
 1600    retractall('$directive_mode_store'(_)),
 1601    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.

 1609'$compilation_level'(Level) :-
 1610    '$input_context'(Stack),
 1611    '$compilation_level'(Stack, Level).
 1612
 1613'$compilation_level'([], 0).
 1614'$compilation_level'([Input|T], Level) :-
 1615    (   arg(1, Input, see)
 1616    ->  '$compilation_level'(T, Level)
 1617    ;   '$compilation_level'(T, Level0),
 1618        Level is Level0+1
 1619    ).

 compiling

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

 1627compiling :-
 1628    \+ (   '$compilation_mode'(database),
 1629           '$directive_mode'(database)
 1630       ).
 1631
 1632:- meta_predicate
 1633    '$ifcompiling'(0). 1634
 1635'$ifcompiling'(G) :-
 1636    (   '$compilation_mode'(database)
 1637    ->  true
 1638    ;   call(G)
 1639    ).
 1640
 1641                /********************************
 1642                *         READ SOURCE           *
 1643                *********************************/

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

 1647'$load_msg_level'(Action, Nesting, Start, Done) :-
 1648    '$update_autoload_level'([], 0),
 1649    !,
 1650    current_prolog_flag(verbose_load, Type0),
 1651    '$load_msg_compat'(Type0, Type),
 1652    (   '$load_msg_level'(Action, Nesting, Type, Start, Done)
 1653    ->  true
 1654    ).
 1655'$load_msg_level'(_, _, silent, silent).
 1656
 1657'$load_msg_compat'(true, normal) :- !.
 1658'$load_msg_compat'(false, silent) :- !.
 1659'$load_msg_compat'(X, X).
 1660
 1661'$load_msg_level'(load_file,    _, full,   informational, informational).
 1662'$load_msg_level'(include_file, _, full,   informational, informational).
 1663'$load_msg_level'(load_file,    _, normal, silent,        informational).
 1664'$load_msg_level'(include_file, _, normal, silent,        silent).
 1665'$load_msg_level'(load_file,    0, brief,  silent,        informational).
 1666'$load_msg_level'(load_file,    _, brief,  silent,        silent).
 1667'$load_msg_level'(include_file, _, brief,  silent,        silent).
 1668'$load_msg_level'(load_file,    _, silent, silent,        silent).
 1669'$load_msg_level'(include_file, _, silent, silent,        silent).