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.  874:- '$hide'(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.

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

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

 $confirm(Spec)

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

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

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

 1113'$expand_file_search_path'(Spec, Expanded, Cond) :-
 1114    '$option'(access(Access), Cond),
 1115    memberchk(Access, [write,append]),
 1116    !,
 1117    setup_call_cleanup(
 1118        nb_setval('$create_search_directories', true),
 1119        expand_file_search_path(Spec, Expanded),
 1120        nb_delete('$create_search_directories')).
 1121'$expand_file_search_path'(Spec, Expanded, _Cond) :-
 1122    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?

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

 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.

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

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

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

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

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

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

 $file_conditions(+Condition, +Path)

Verify Path satisfies Condition.

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

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

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

 compiling

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

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

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

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