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'(opaque, [incremental(false),opaque(true)]).
  217'$attr_option'(abstract(Level0), abstract(Level)) :-
  218    '$table_option'(Level0, Level).
  219'$attr_option'(subgoal_abstract(Level0), subgoal_abstract(Level)) :-
  220    '$table_option'(Level0, Level).
  221'$attr_option'(answer_abstract(Level0), answer_abstract(Level)) :-
  222    '$table_option'(Level0, Level).
  223'$attr_option'(max_answers(Level0), max_answers(Level)) :-
  224    '$table_option'(Level0, Level).
  225'$attr_option'(volatile, volatile(true)).
  226'$attr_option'(multifile, multifile(true)).
  227'$attr_option'(discontiguous, discontiguous(true)).
  228'$attr_option'(shared, thread_local(false)).
  229'$attr_option'(local, thread_local(true)).
  230'$attr_option'(private, thread_local(true)).
  231
  232'$table_option'(Value0, _Value) :-
  233    var(Value0),
  234    !,
  235    '$instantiation_error'(Value0).
  236'$table_option'(Value0, Value) :-
  237    integer(Value0),
  238    Value0 >= 0,
  239    !,
  240    Value = Value0.
  241'$table_option'(off, -1) :-
  242    !.
  243'$table_option'(false, -1) :-
  244    !.
  245'$table_option'(infinite, -1) :-
  246    !.
  247'$table_option'(Value, _) :-
  248    '$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.

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

 $pi_head(?PI, ?Head)

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

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

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

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

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

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

  493not(Goal) :-
  494    \+ Goal.

 \+ :Goal is semidet

Predicate version that allows for meta-calling.

  500\+ Goal :-
  501    \+ Goal.

 once(:Goal) is semidet

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

  507once(Goal) :-
  508    Goal,
  509    !.

 ignore(:Goal) is det

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

  516ignore(Goal) :-
  517    Goal,
  518    !.
  519ignore(_Goal).
  520
  521:- '$iso'((false/0)).

 false

Synonym for fail/0, providing a declarative reading.

  527false :-
  528    fail.

 catch(:Goal, +Catcher, :Recover)

ISO compliant exception handling.

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

 prolog_cut_to(+Choice)

Cut all choice points after Choice

  541prolog_cut_to(_Choice) :-
  542    '$cut'.                         % Maps to I_CUTCHP

 reset(:Goal, ?Ball, -Continue)

Delimited continuation support.

  548reset(_Goal, _Ball, _Cont) :-
  549    '$reset'.

 shift(+Ball)

Shift control back to the enclosing reset/3

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

  570call_continuation([]).
  571call_continuation([TB|Rest]) :-
  572    (   Rest == []
  573    ->  '$call_continuation'(TB)
  574    ;   '$call_continuation'(TB),
  575        call_continuation(Rest)
  576    ).

 catch_with_backtrace(:Goal, ?Ball, :Recover)

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

  583catch_with_backtrace(Goal, Ball, Recover) :-
  584    catch(Goal, Ball, Recover),
  585    '$no_lco'.
  586
  587'$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.

  597:- public '$recover_and_rethrow'/2.  598
  599'$recover_and_rethrow'(Goal, Exception) :-
  600    call_cleanup(Goal, throw(Exception)),
  601    !.

 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.

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

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

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

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

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

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

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

 $confirm(Spec)

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

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

 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?

 1108expand_file_search_path(Spec, Expanded) :-
 1109    catch('$expand_file_search_path'(Spec, Expanded, 0, []),
 1110          loop(Used),
 1111          throw(error(loop_error(Spec), file_search(Used)))).
 1112
 1113'$expand_file_search_path'(Spec, Expanded, N, Used) :-
 1114    functor(Spec, Alias, 1),
 1115    !,
 1116    user:file_search_path(Alias, Exp0),
 1117    NN is N + 1,
 1118    (   NN > 16
 1119    ->  throw(loop(Used))
 1120    ;   true
 1121    ),
 1122    '$expand_file_search_path'(Exp0, Exp1, NN, [Alias=Exp0|Used]),
 1123    arg(1, Spec, Segments),
 1124    '$segments_to_atom'(Segments, File),
 1125    '$make_path'(Exp1, File, Expanded).
 1126'$expand_file_search_path'(Spec, Path, _, _) :-
 1127    '$segments_to_atom'(Spec, Path).
 1128
 1129'$make_path'(Dir, '.', Path) :-
 1130    !,
 1131    Path = Dir.
 1132'$make_path'(Dir, File, Path) :-
 1133    sub_atom(Dir, _, _, 0, /),
 1134    !,
 1135    atom_concat(Dir, File, Path).
 1136'$make_path'(Dir, File, Path) :-
 1137    atomic_list_concat([Dir, /, File], Path).
 1138
 1139
 1140                /********************************
 1141                *         FILE CHECKING         *
 1142                *********************************/

 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.

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

 1276:- multifile(user:prolog_file_type/2). 1277:- dynamic(user:prolog_file_type/2). 1278
 1279user:prolog_file_type(pl,       prolog).
 1280user:prolog_file_type(prolog,   prolog).
 1281user:prolog_file_type(qlf,      prolog).
 1282user:prolog_file_type(qlf,      qlf).
 1283user:prolog_file_type(Ext,      executable) :-
 1284    current_prolog_flag(shared_object_extension, Ext).
 1285user:prolog_file_type(dylib,    executable) :-
 1286    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.

 1293'$chk_file'(Spec, _Extensions, _Cond, _Cache, _FullName) :-
 1294    \+ ground(Spec),
 1295    !,
 1296    '$instantiation_error'(Spec).
 1297'$chk_file'(Spec, Extensions, Cond, Cache, FullName) :-
 1298    compound(Spec),
 1299    functor(Spec, _, 1),
 1300    !,
 1301    '$relative_to'(Cond, cwd, CWD),
 1302    '$chk_alias_file'(Spec, Extensions, Cond, Cache, CWD, FullName).
 1303'$chk_file'(Segments, Ext, Cond, Cache, FullName) :-    % allow a/b/...
 1304    \+ atomic(Segments),
 1305    !,
 1306    '$segments_to_atom'(Segments, Atom),
 1307    '$chk_file'(Atom, Ext, Cond, Cache, FullName).
 1308'$chk_file'(File, Exts, Cond, _, FullName) :-
 1309    is_absolute_file_name(File),
 1310    !,
 1311    '$extend_file'(File, Exts, Extended),
 1312    '$file_conditions'(Cond, Extended),
 1313    '$absolute_file_name'(Extended, FullName).
 1314'$chk_file'(File, Exts, Cond, _, FullName) :-
 1315    '$relative_to'(Cond, source, Dir),
 1316    atomic_list_concat([Dir, /, File], AbsFile),
 1317    '$extend_file'(AbsFile, Exts, Extended),
 1318    '$file_conditions'(Cond, Extended),
 1319    !,
 1320    '$absolute_file_name'(Extended, FullName).
 1321'$chk_file'(File, Exts, Cond, _, FullName) :-
 1322    '$extend_file'(File, Exts, Extended),
 1323    '$file_conditions'(Cond, Extended),
 1324    '$absolute_file_name'(Extended, FullName).
 1325
 1326'$segments_to_atom'(Atom, Atom) :-
 1327    atomic(Atom),
 1328    !.
 1329'$segments_to_atom'(Segments, Atom) :-
 1330    '$segments_to_list'(Segments, List, []),
 1331    !,
 1332    atomic_list_concat(List, /, Atom).
 1333
 1334'$segments_to_list'(A/B, H, T) :-
 1335    '$segments_to_list'(A, H, T0),
 1336    '$segments_to_list'(B, T0, T).
 1337'$segments_to_list'(A, [A|T], T) :-
 1338    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.

 1348'$relative_to'(Conditions, Default, Dir) :-
 1349    (   '$option'(relative_to(FileOrDir), Conditions)
 1350    *-> (   exists_directory(FileOrDir)
 1351        ->  Dir = FileOrDir
 1352        ;   atom_concat(Dir, /, FileOrDir)
 1353        ->  true
 1354        ;   file_directory_name(FileOrDir, Dir)
 1355        )
 1356    ;   Default == cwd
 1357    ->  '$cwd'(Dir)
 1358    ;   Default == source
 1359    ->  source_location(ContextFile, _Line),
 1360        file_directory_name(ContextFile, Dir)
 1361    ).

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

 1366:- dynamic
 1367    '$search_path_file_cache'/3,    % SHA1, Time, Path
 1368    '$search_path_gc_time'/1.       % Time
 1369:- volatile
 1370    '$search_path_file_cache'/3,
 1371    '$search_path_gc_time'/1. 1372
 1373:- create_prolog_flag(file_search_cache_time, 10, []). 1374
 1375'$chk_alias_file'(Spec, Exts, Cond, true, CWD, FullFile) :-
 1376    !,
 1377    findall(Exp, expand_file_search_path(Spec, Exp), Expansions),
 1378    Cache = cache(Exts, Cond, CWD, Expansions),
 1379    variant_sha1(Spec+Cache, SHA1),
 1380    get_time(Now),
 1381    current_prolog_flag(file_search_cache_time, TimeOut),
 1382    (   '$search_path_file_cache'(SHA1, CachedTime, FullFile),
 1383        CachedTime > Now - TimeOut,
 1384        '$file_conditions'(Cond, FullFile)
 1385    ->  '$search_message'(file_search(cache(Spec, Cond), FullFile))
 1386    ;   '$member'(Expanded, Expansions),
 1387        '$extend_file'(Expanded, Exts, LibFile),
 1388        (   '$file_conditions'(Cond, LibFile),
 1389            '$absolute_file_name'(LibFile, FullFile),
 1390            '$cache_file_found'(SHA1, Now, TimeOut, FullFile)
 1391        ->  '$search_message'(file_search(found(Spec, Cond), FullFile))
 1392        ;   '$search_message'(file_search(tried(Spec, Cond), LibFile)),
 1393            fail
 1394        )
 1395    ).
 1396'$chk_alias_file'(Spec, Exts, Cond, false, _CWD, FullFile) :-
 1397    expand_file_search_path(Spec, Expanded),
 1398    '$extend_file'(Expanded, Exts, LibFile),
 1399    '$file_conditions'(Cond, LibFile),
 1400    '$absolute_file_name'(LibFile, FullFile).
 1401
 1402'$cache_file_found'(_, _, TimeOut, _) :-
 1403    TimeOut =:= 0,
 1404    !.
 1405'$cache_file_found'(SHA1, Now, TimeOut, FullFile) :-
 1406    '$search_path_file_cache'(SHA1, Saved, FullFile),
 1407    !,
 1408    (   Now - Saved < TimeOut/2
 1409    ->  true
 1410    ;   retractall('$search_path_file_cache'(SHA1, _, _)),
 1411        asserta('$search_path_file_cache'(SHA1, Now, FullFile))
 1412    ).
 1413'$cache_file_found'(SHA1, Now, TimeOut, FullFile) :-
 1414    'gc_file_search_cache'(TimeOut),
 1415    asserta('$search_path_file_cache'(SHA1, Now, FullFile)).
 1416
 1417'gc_file_search_cache'(TimeOut) :-
 1418    get_time(Now),
 1419    '$search_path_gc_time'(Last),
 1420    Now-Last < TimeOut/2,
 1421    !.
 1422'gc_file_search_cache'(TimeOut) :-
 1423    get_time(Now),
 1424    retractall('$search_path_gc_time'(_)),
 1425    assertz('$search_path_gc_time'(Now)),
 1426    Before is Now - TimeOut,
 1427    (   '$search_path_file_cache'(SHA1, Cached, FullFile),
 1428        Cached < Before,
 1429        retractall('$search_path_file_cache'(SHA1, Cached, FullFile)),
 1430        fail
 1431    ;   true
 1432    ).
 1433
 1434
 1435'$search_message'(Term) :-
 1436    current_prolog_flag(verbose_file_search, true),
 1437    !,
 1438    print_message(informational, Term).
 1439'$search_message'(_).

 $file_conditions(+Condition, +Path)

Verify Path satisfies Condition.

 1446'$file_conditions'(List, File) :-
 1447    is_list(List),
 1448    !,
 1449    \+ ( '$member'(C, List),
 1450         '$file_condition'(C),
 1451         \+ '$file_condition'(C, File)
 1452       ).
 1453'$file_conditions'(Map, File) :-
 1454    \+ (  get_dict(Key, Map, Value),
 1455          C =.. [Key,Value],
 1456          '$file_condition'(C),
 1457         \+ '$file_condition'(C, File)
 1458       ).
 1459
 1460'$file_condition'(file_type(directory), File) :-
 1461    !,
 1462    exists_directory(File).
 1463'$file_condition'(file_type(_), File) :-
 1464    !,
 1465    \+ exists_directory(File).
 1466'$file_condition'(access(Accesses), File) :-
 1467    !,
 1468    \+ (  '$one_or_member'(Access, Accesses),
 1469          \+ access_file(File, Access)
 1470       ).
 1471
 1472'$file_condition'(exists).
 1473'$file_condition'(file_type(_)).
 1474'$file_condition'(access(_)).
 1475
 1476'$extend_file'(File, Exts, FileEx) :-
 1477    '$ensure_extensions'(Exts, File, Fs),
 1478    '$list_to_set'(Fs, FsSet),
 1479    '$member'(FileEx, FsSet).
 1480
 1481'$ensure_extensions'([], _, []).
 1482'$ensure_extensions'([E|E0], F, [FE|E1]) :-
 1483    file_name_extension(F, E, FE),
 1484    '$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.

 1493'$list_to_set'(List, Set) :-
 1494    '$list_to_set'(List, [], Set).
 1495
 1496'$list_to_set'([], _, []).
 1497'$list_to_set'([H|T], Seen, R) :-
 1498    memberchk(H, Seen),
 1499    !,
 1500    '$list_to_set'(T, R).
 1501'$list_to_set'([H|T], Seen, [H|R]) :-
 1502    '$list_to_set'(T, [H|Seen], R).
 1503
 1504/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
 1505Canonicalise the extension list. Old SWI-Prolog   require  `.pl', etc, which
 1506the Quintus compatibility  requests  `pl'.   This  layer  canonicalises  all
 1507extensions to .ext
 1508- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
 1509
 1510'$canonicalise_extensions'([], []) :- !.
 1511'$canonicalise_extensions'([H|T], [CH|CT]) :-
 1512    !,
 1513    '$must_be'(atom, H),
 1514    '$canonicalise_extension'(H, CH),
 1515    '$canonicalise_extensions'(T, CT).
 1516'$canonicalise_extensions'(E, [CE]) :-
 1517    '$canonicalise_extension'(E, CE).
 1518
 1519'$canonicalise_extension'('', '') :- !.
 1520'$canonicalise_extension'(DotAtom, DotAtom) :-
 1521    sub_atom(DotAtom, 0, _, _, '.'),
 1522    !.
 1523'$canonicalise_extension'(Atom, DotAtom) :-
 1524    atom_concat('.', Atom, DotAtom).
 1525
 1526
 1527                /********************************
 1528                *            CONSULT            *
 1529                *********************************/
 1530
 1531:- dynamic
 1532    user:library_directory/1,
 1533    user:prolog_load_file/2. 1534:- multifile
 1535    user:library_directory/1,
 1536    user:prolog_load_file/2. 1537
 1538:- prompt(_, '|: '). 1539
 1540:- thread_local
 1541    '$compilation_mode_store'/1,    % database, wic, qlf
 1542    '$directive_mode_store'/1.      % database, wic, qlf
 1543:- volatile
 1544    '$compilation_mode_store'/1,
 1545    '$directive_mode_store'/1. 1546
 1547'$compilation_mode'(Mode) :-
 1548    (   '$compilation_mode_store'(Val)
 1549    ->  Mode = Val
 1550    ;   Mode = database
 1551    ).
 1552
 1553'$set_compilation_mode'(Mode) :-
 1554    retractall('$compilation_mode_store'(_)),
 1555    assertz('$compilation_mode_store'(Mode)).
 1556
 1557'$compilation_mode'(Old, New) :-
 1558    '$compilation_mode'(Old),
 1559    (   New == Old
 1560    ->  true
 1561    ;   '$set_compilation_mode'(New)
 1562    ).
 1563
 1564'$directive_mode'(Mode) :-
 1565    (   '$directive_mode_store'(Val)
 1566    ->  Mode = Val
 1567    ;   Mode = database
 1568    ).
 1569
 1570'$directive_mode'(Old, New) :-
 1571    '$directive_mode'(Old),
 1572    (   New == Old
 1573    ->  true
 1574    ;   '$set_directive_mode'(New)
 1575    ).
 1576
 1577'$set_directive_mode'(Mode) :-
 1578    retractall('$directive_mode_store'(_)),
 1579    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.

 1587'$compilation_level'(Level) :-
 1588    '$input_context'(Stack),
 1589    '$compilation_level'(Stack, Level).
 1590
 1591'$compilation_level'([], 0).
 1592'$compilation_level'([Input|T], Level) :-
 1593    (   arg(1, Input, see)
 1594    ->  '$compilation_level'(T, Level)
 1595    ;   '$compilation_level'(T, Level0),
 1596        Level is Level0+1
 1597    ).

 compiling

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

 1605compiling :-
 1606    \+ (   '$compilation_mode'(database),
 1607           '$directive_mode'(database)
 1608       ).
 1609
 1610:- meta_predicate
 1611    '$ifcompiling'(0). 1612
 1613'$ifcompiling'(G) :-
 1614    (   '$compilation_mode'(database)
 1615    ->  true
 1616    ;   call(G)
 1617    ).
 1618
 1619                /********************************
 1620                *         READ SOURCE           *
 1621                *********************************/

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

 1625'$load_msg_level'(Action, Nesting, Start, Done) :-
 1626    '$update_autoload_level'([], 0),
 1627    !,
 1628    current_prolog_flag(verbose_load, Type0),
 1629    '$load_msg_compat'(Type0, Type),
 1630    (   '$load_msg_level'(Action, Nesting, Type, Start, Done)
 1631    ->  true
 1632    ).
 1633'$load_msg_level'(_, _, silent, silent).
 1634
 1635'$load_msg_compat'(true, normal) :- !.
 1636'$load_msg_compat'(false, silent) :- !.
 1637'$load_msg_compat'(X, X).
 1638
 1639'$load_msg_level'(load_file,    _, full,   informational, informational).
 1640'$load_msg_level'(include_file, _, full,   informational, informational).
 1641'$load_msg_level'(load_file,    _, normal, silent,        informational).
 1642'$load_msg_level'(include_file, _, normal, silent,        silent).
 1643'$load_msg_level'(load_file,    0, brief,  silent,        informational).
 1644'$load_msg_level'(load_file,    _, brief,  silent,        silent).
 1645'$load_msg_level'(include_file, _, brief,  silent,        silent).
 1646'$load_msg_level'(load_file,    _, silent, silent,        silent).
 1647'$load_msg_level'(include_file, _, silent, silent,        silent).

 $source_term(+From, -Read, -RLayout, -Term, -TLayout, -Stream, +Options) is nondet

Read Prolog terms from the input From. Terms are returned on backtracking. Associated resources (i.e., streams) are closed due to setup_call_cleanup/3.

Arguments:

From	- is either a term stream(Id, Stream) or a file specification.
Read	- is the raw term as read from the input.
Term	- is the term after term-expansion. If a term is expanded into the empty list, this is returned too. This is required to be able to return the raw term in Read
Stream	- is the stream from which Read is read
Options	- provides additional options: encoding(Enc) Encoding used to open From syntax_errors(+ErrorMode) process_comments(+Boolean) term_position(-Pos)