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

 memberchk(?E, ?List) is semidet

Semantically equivalent to once(member(E,List)). Implemented in C. If List is partial though we need to do the work in Prolog to get the proper constraint behavior. Needs to be defined early as the boot code uses it.

   76memberchk(E, List) :-
   77    '$memberchk'(E, List, Tail),
   78    (   nonvar(Tail)
   79    ->  true
   80    ;   Tail = [_|_],
   81	memberchk(E, Tail)
   82    ).
   83
   84		/********************************
   85		*          DIRECTIVES           *
   86		*********************************/
   87
   88:- meta_predicate
   89    dynamic(:),
   90    multifile(:),
   91    public(:),
   92    module_transparent(:),
   93    discontiguous(:),
   94    volatile(:),
   95    thread_local(:),
   96    noprofile(:),
   97    non_terminal(:),
   98    det(:),
   99    '$clausable'(:),
  100    '$iso'(:),
  101    '$hide'(:),
  102    '$notransact'(:).

 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.

  134dynamic(Spec)            :- '$set_pattr'(Spec, pred, dynamic(true)).
  135multifile(Spec)          :- '$set_pattr'(Spec, pred, multifile(true)).
  136module_transparent(Spec) :- '$set_pattr'(Spec, pred, transparent(true)).
  137discontiguous(Spec)      :- '$set_pattr'(Spec, pred, discontiguous(true)).
  138volatile(Spec)           :- '$set_pattr'(Spec, pred, volatile(true)).
  139thread_local(Spec)       :- '$set_pattr'(Spec, pred, thread_local(true)).
  140noprofile(Spec)          :- '$set_pattr'(Spec, pred, noprofile(true)).
  141public(Spec)             :- '$set_pattr'(Spec, pred, public(true)).
  142non_terminal(Spec)       :- '$set_pattr'(Spec, pred, non_terminal(true)).
  143det(Spec)                :- '$set_pattr'(Spec, pred, det(true)).
  144'$iso'(Spec)             :- '$set_pattr'(Spec, pred, iso(true)).
  145'$clausable'(Spec)       :- '$set_pattr'(Spec, pred, clausable(true)).
  146'$hide'(Spec)            :- '$set_pattr'(Spec, pred, trace(false)).
  147'$notransact'(Spec)      :- '$set_pattr'(Spec, pred, transact(false)).
  148
  149'$set_pattr'(M:Pred, How, Attr) :-
  150    '$set_pattr'(Pred, M, How, Attr).

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

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

  156'$set_pattr'(X, _, _, _) :-
  157    var(X),
  158    '$uninstantiation_error'(X).
  159'$set_pattr'(as(Spec,Options), M, How, Attr0) :-
  160    !,
  161    '$attr_options'(Options, Attr0, Attr),
  162    '$set_pattr'(Spec, M, How, Attr).
  163'$set_pattr'([], _, _, _) :- !.
  164'$set_pattr'([H|T], M, How, Attr) :-           % ISO
  165    !,
  166    '$set_pattr'(H, M, How, Attr),
  167    '$set_pattr'(T, M, How, Attr).
  168'$set_pattr'((A,B), M, How, Attr) :-           % ISO and traditional
  169    !,
  170    '$set_pattr'(A, M, How, Attr),
  171    '$set_pattr'(B, M, How, Attr).
  172'$set_pattr'(M:T, _, How, Attr) :-
  173    !,
  174    '$set_pattr'(T, M, How, Attr).
  175'$set_pattr'(PI, M, _, []) :-
  176    !,
  177    '$pi_head'(M:PI, Pred),
  178    '$set_table_wrappers'(Pred).
  179'$set_pattr'(A, M, How, [O|OT]) :-
  180    !,
  181    '$set_pattr'(A, M, How, O),
  182    '$set_pattr'(A, M, How, OT).
  183'$set_pattr'(A, M, pred, Attr) :-
  184    !,
  185    Attr =.. [Name,Val],
  186    '$set_pi_attr'(M:A, Name, Val).
  187'$set_pattr'(A, M, directive, Attr) :-
  188    !,
  189    Attr =.. [Name,Val],
  190    catch('$set_pi_attr'(M:A, Name, Val),
  191	  error(E, _),
  192	  print_message(error, error(E, context((Name)/1,_)))).
  193
  194'$set_pi_attr'(PI, Name, Val) :-
  195    '$pi_head'(PI, Head),
  196    '$set_predicate_attribute'(Head, Name, Val).
  197
  198'$attr_options'(Var, _, _) :-
  199    var(Var),
  200    !,
  201    '$uninstantiation_error'(Var).
  202'$attr_options'((A,B), Attr0, Attr) :-
  203    !,
  204    '$attr_options'(A, Attr0, Attr1),
  205    '$attr_options'(B, Attr1, Attr).
  206'$attr_options'(Opt, Attr0, Attrs) :-
  207    '$must_be'(ground, Opt),
  208    (   '$attr_option'(Opt, AttrX)
  209    ->  (   is_list(Attr0)
  210	->  '$join_attrs'(AttrX, Attr0, Attrs)
  211	;   '$join_attrs'(AttrX, [Attr0], Attrs)
  212	)
  213    ;   '$domain_error'(predicate_option, Opt)
  214    ).
  215
  216'$join_attrs'([], Attrs, Attrs) :-
  217    !.
  218'$join_attrs'([H|T], Attrs0, Attrs) :-
  219    !,
  220    '$join_attrs'(H, Attrs0, Attrs1),
  221    '$join_attrs'(T, Attrs1, Attrs).
  222'$join_attrs'(Attr, Attrs, Attrs) :-
  223    memberchk(Attr, Attrs),
  224    !.
  225'$join_attrs'(Attr, Attrs, Attrs) :-
  226    Attr =.. [Name,Value],
  227    Gen =.. [Name,Existing],
  228    memberchk(Gen, Attrs),
  229    !,
  230    throw(error(conflict_error(Name, Value, Existing), _)).
  231'$join_attrs'(Attr, Attrs0, Attrs) :-
  232    '$append'(Attrs0, [Attr], Attrs).
  233
  234'$attr_option'(incremental, [incremental(true),opaque(false)]).
  235'$attr_option'(monotonic, monotonic(true)).
  236'$attr_option'(lazy, lazy(true)).
  237'$attr_option'(opaque, [incremental(false),opaque(true)]).
  238'$attr_option'(abstract(Level0), abstract(Level)) :-
  239    '$table_option'(Level0, Level).
  240'$attr_option'(subgoal_abstract(Level0), subgoal_abstract(Level)) :-
  241    '$table_option'(Level0, Level).
  242'$attr_option'(answer_abstract(Level0), answer_abstract(Level)) :-
  243    '$table_option'(Level0, Level).
  244'$attr_option'(max_answers(Level0), max_answers(Level)) :-
  245    '$table_option'(Level0, Level).
  246'$attr_option'(volatile, volatile(true)).
  247'$attr_option'(multifile, multifile(true)).
  248'$attr_option'(discontiguous, discontiguous(true)).
  249'$attr_option'(shared, thread_local(false)).
  250'$attr_option'(local, thread_local(true)).
  251'$attr_option'(private, thread_local(true)).
  252
  253'$table_option'(Value0, _Value) :-
  254    var(Value0),
  255    !,
  256    '$instantiation_error'(Value0).
  257'$table_option'(Value0, Value) :-
  258    integer(Value0),
  259    Value0 >= 0,
  260    !,
  261    Value = Value0.
  262'$table_option'(off, -1) :-
  263    !.
  264'$table_option'(false, -1) :-
  265    !.
  266'$table_option'(infinite, -1) :-
  267    !.
  268'$table_option'(Value, _) :-
  269    '$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.

  279'$pattr_directive'(dynamic(Spec), M) :-
  280    '$set_pattr'(Spec, M, directive, dynamic(true)).
  281'$pattr_directive'(multifile(Spec), M) :-
  282    '$set_pattr'(Spec, M, directive, multifile(true)).
  283'$pattr_directive'(module_transparent(Spec), M) :-
  284    '$set_pattr'(Spec, M, directive, transparent(true)).
  285'$pattr_directive'(discontiguous(Spec), M) :-
  286    '$set_pattr'(Spec, M, directive, discontiguous(true)).
  287'$pattr_directive'(volatile(Spec), M) :-
  288    '$set_pattr'(Spec, M, directive, volatile(true)).
  289'$pattr_directive'(thread_local(Spec), M) :-
  290    '$set_pattr'(Spec, M, directive, thread_local(true)).
  291'$pattr_directive'(noprofile(Spec), M) :-
  292    '$set_pattr'(Spec, M, directive, noprofile(true)).
  293'$pattr_directive'(public(Spec), M) :-
  294    '$set_pattr'(Spec, M, directive, public(true)).
  295'$pattr_directive'(det(Spec), M) :-
  296    '$set_pattr'(Spec, M, directive, det(true)).

 $pi_head(?PI, ?Head)

  300'$pi_head'(PI, Head) :-
  301    var(PI),
  302    var(Head),
  303    '$instantiation_error'([PI,Head]).
  304'$pi_head'(M:PI, M:Head) :-
  305    !,
  306    '$pi_head'(PI, Head).
  307'$pi_head'(Name/Arity, Head) :-
  308    !,
  309    '$head_name_arity'(Head, Name, Arity).
  310'$pi_head'(Name//DCGArity, Head) :-
  311    !,
  312    (   nonvar(DCGArity)
  313    ->  Arity is DCGArity+2,
  314	'$head_name_arity'(Head, Name, Arity)
  315    ;   '$head_name_arity'(Head, Name, Arity),
  316	DCGArity is Arity - 2
  317    ).
  318'$pi_head'(PI, _) :-
  319    '$type_error'(predicate_indicator, PI).

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

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

  324'$head_name_arity'(Goal, Name, Arity) :-
  325    (   atom(Goal)
  326    ->  Name = Goal, Arity = 0
  327    ;   compound(Goal)
  328    ->  compound_name_arity(Goal, Name, Arity)
  329    ;   var(Goal)
  330    ->  (   Arity == 0
  331	->  (   atom(Name)
  332	    ->  Goal = Name
  333	    ;   Name == []
  334	    ->  Goal = Name
  335	    ;   blob(Name, closure)
  336	    ->  Goal = Name
  337	    ;   '$type_error'(atom, Name)
  338	    )
  339	;   compound_name_arity(Goal, Name, Arity)
  340	)
  341    ;   '$type_error'(callable, Goal)
  342    ).
  343
  344:- '$iso'(((dynamic)/1, (multifile)/1, (discontiguous)/1)).  345
  346
  347		/********************************
  348		*       CALLING, CONTROL        *
  349		*********************************/
  350
  351:- noprofile((call/1,
  352	      catch/3,
  353	      once/1,
  354	      ignore/1,
  355	      call_cleanup/2,
  356	      setup_call_cleanup/3,
  357	      setup_call_catcher_cleanup/4,
  358	      notrace/1)).  359
  360:- meta_predicate
  361    ';'(0,0),
  362    ','(0,0),
  363    @(0,+),
  364    call(0),
  365    call(1,?),
  366    call(2,?,?),
  367    call(3,?,?,?),
  368    call(4,?,?,?,?),
  369    call(5,?,?,?,?,?),
  370    call(6,?,?,?,?,?,?),
  371    call(7,?,?,?,?,?,?,?),
  372    not(0),
  373    \+(0),
  374    $(0),
  375    '->'(0,0),
  376    '*->'(0,0),
  377    once(0),
  378    ignore(0),
  379    catch(0,?,0),
  380    reset(0,?,-),
  381    setup_call_cleanup(0,0,0),
  382    setup_call_catcher_cleanup(0,0,?,0),
  383    call_cleanup(0,0),
  384    catch_with_backtrace(0,?,0),
  385    notrace(0),
  386    '$meta_call'(0).  387
  388:- '$iso'((call/1, (\+)/1, once/1, (;)/2, (',')/2, (->)/2, catch/3)).  389
  390% The control structures are always compiled, both   if they appear in a
  391% clause body and if they are handed  to   call/1.  The only way to call
  392% these predicates is by means of  call/2..   In  that case, we call the
  393% hole control structure again to get it compiled by call/1 and properly
  394% deal  with  !,  etc.  Another  reason  for  having  these  things   as
  395% predicates is to be able to define   properties for them, helping code
  396% analyzers.
  397
  398(M0:If ; M0:Then) :- !, call(M0:(If ; Then)).
  399(M1:If ; M2:Then) :-    call(M1:(If ; M2:Then)).
  400(G1   , G2)       :-    call((G1   , G2)).
  401(If  -> Then)     :-    call((If  -> Then)).
  402(If *-> Then)     :-    call((If *-> Then)).
  403@(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.

  417'$meta_call'(M:G) :-
  418    prolog_current_choice(Ch),
  419    '$meta_call'(G, M, Ch).
  420
  421'$meta_call'(Var, _, _) :-
  422    var(Var),
  423    !,
  424    '$instantiation_error'(Var).
  425'$meta_call'((A,B), M, Ch) :-
  426    !,
  427    '$meta_call'(A, M, Ch),
  428    '$meta_call'(B, M, Ch).
  429'$meta_call'((I->T;E), M, Ch) :-
  430    !,
  431    (   prolog_current_choice(Ch2),
  432	'$meta_call'(I, M, Ch2)
  433    ->  '$meta_call'(T, M, Ch)
  434    ;   '$meta_call'(E, M, Ch)
  435    ).
  436'$meta_call'((I*->T;E), M, Ch) :-
  437    !,
  438    (   prolog_current_choice(Ch2),
  439	'$meta_call'(I, M, Ch2)
  440    *-> '$meta_call'(T, M, Ch)
  441    ;   '$meta_call'(E, M, Ch)
  442    ).
  443'$meta_call'((I->T), M, Ch) :-
  444    !,
  445    (   prolog_current_choice(Ch2),
  446	'$meta_call'(I, M, Ch2)
  447    ->  '$meta_call'(T, M, Ch)
  448    ).
  449'$meta_call'((I*->T), M, Ch) :-
  450    !,
  451    prolog_current_choice(Ch2),
  452    '$meta_call'(I, M, Ch2),
  453    '$meta_call'(T, M, Ch).
  454'$meta_call'((A;B), M, Ch) :-
  455    !,
  456    (   '$meta_call'(A, M, Ch)
  457    ;   '$meta_call'(B, M, Ch)
  458    ).
  459'$meta_call'(\+(G), M, _) :-
  460    !,
  461    prolog_current_choice(Ch),
  462    \+ '$meta_call'(G, M, Ch).
  463'$meta_call'($(G), M, _) :-
  464    !,
  465    prolog_current_choice(Ch),
  466    $('$meta_call'(G, M, Ch)).
  467'$meta_call'(call(G), M, _) :-
  468    !,
  469    prolog_current_choice(Ch),
  470    '$meta_call'(G, M, Ch).
  471'$meta_call'(M:G, _, Ch) :-
  472    !,
  473    '$meta_call'(G, M, Ch).
  474'$meta_call'(!, _, Ch) :-
  475    prolog_cut_to(Ch).
  476'$meta_call'(G, M, _Ch) :-
  477    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..

  493:- '$iso'((call/2,
  494	   call/3,
  495	   call/4,
  496	   call/5,
  497	   call/6,
  498	   call/7,
  499	   call/8)).  500
  501call(Goal) :-                           % make these available as predicates
  502    Goal.
  503call(Goal, A) :-
  504    call(Goal, A).
  505call(Goal, A, B) :-
  506    call(Goal, A, B).
  507call(Goal, A, B, C) :-
  508    call(Goal, A, B, C).
  509call(Goal, A, B, C, D) :-
  510    call(Goal, A, B, C, D).
  511call(Goal, A, B, C, D, E) :-
  512    call(Goal, A, B, C, D, E).
  513call(Goal, A, B, C, D, E, F) :-
  514    call(Goal, A, B, C, D, E, F).
  515call(Goal, A, B, C, D, E, F, G) :-
  516    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.

  523not(Goal) :-
  524    \+ Goal.

 \+ :Goal is semidet

Predicate version that allows for meta-calling.

  530\+ Goal :-
  531    \+ Goal.

 once(:Goal) is semidet

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

  537once(Goal) :-
  538    Goal,
  539    !.

 ignore(:Goal) is det

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

  546ignore(Goal) :-
  547    Goal,
  548    !.
  549ignore(_Goal).
  550
  551:- '$iso'((false/0)).

 false

Synonym for fail/0, providing a declarative reading.

  557false :-
  558    fail.

 catch(:Goal, +Catcher, :Recover)

ISO compliant exception handling.

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

 prolog_cut_to(+Choice)

Cut all choice points after Choice

  571prolog_cut_to(_Choice) :-
  572    '$cut'.                         % Maps to I_CUTCHP

 $ is det

Declare that from now on this predicate succeeds deterministically.

  578'$' :- '$'.

 $ :Goal is det

Declare that Goal must succeed deterministically.

  584$(Goal) :- $(Goal).

 notrace(:Goal) is semidet

Suspend the tracer while running Goal.

  590:- '$hide'(notrace/1).  591
  592notrace(Goal) :-
  593    setup_call_cleanup(
  594	'$notrace'(Flags, SkipLevel),
  595	once(Goal),
  596	'$restore_trace'(Flags, SkipLevel)).

 reset(:Goal, ?Ball, -Continue)

Delimited continuation support.

  603reset(_Goal, _Ball, _Cont) :-
  604    '$reset'.

 shift(+Ball)

 shift_for_copy(+Ball)

Shift control back to the enclosing reset/3. The second version assumes the continuation will be saved to be reused in a different context.

  613shift(Ball) :-
  614    '$shift'(Ball).
  615
  616shift_for_copy(Ball) :-
  617    '$shift_for_copy'(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.

  631call_continuation([]).
  632call_continuation([TB|Rest]) :-
  633    (   Rest == []
  634    ->  '$call_continuation'(TB)
  635    ;   '$call_continuation'(TB),
  636	call_continuation(Rest)
  637    ).

 catch_with_backtrace(:Goal, ?Ball, :Recover)

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

  644catch_with_backtrace(Goal, Ball, Recover) :-
  645    catch(Goal, Ball, Recover),
  646    '$no_lco'.
  647
  648'$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'. This applies to exceptions of the shape unwind(Term). Note that we cut to ensure that the exception is not delayed forever because the recover handler leaves a choicepoint.

  658:- public '$recover_and_rethrow'/2.  659
  660'$recover_and_rethrow'(Goal, Exception) :-
  661    call_cleanup(Goal, throw(Exception)),
  662    !.

 call_cleanup(:Goal, :Cleanup)

 setup_call_cleanup(:Setup, :Goal, :Cleanup)

 setup_call_catcher_cleanup(:Setup, :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, I_EXITCLEANUP. These instructions rely on the exact stack layout left by these predicates, where the variant is determined by the arity. See also callCleanupHandler() in pl-wam.c.

  676setup_call_catcher_cleanup(Setup, _Goal, _Catcher, _Cleanup) :-
  677    sig_atomic(Setup),
  678    '$call_cleanup'.
  679
  680setup_call_cleanup(Setup, _Goal, _Cleanup) :-
  681    sig_atomic(Setup),
  682    '$call_cleanup'.
  683
  684call_cleanup(_Goal, _Cleanup) :-
  685    '$call_cleanup'.
  686
  687
  688		 /*******************************
  689		 *       INITIALIZATION         *
  690		 *******************************/
  691
  692:- meta_predicate
  693    initialization(0, +).  694
  695:- multifile '$init_goal'/3.  696:- dynamic   '$init_goal'/3.  697:- '$notransact'('$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.

  723initialization(Goal, When) :-
  724    '$must_be'(oneof(atom, initialization_type,
  725		     [ now,
  726		       after_load,
  727		       restore,
  728		       restore_state,
  729		       prepare_state,
  730		       program,
  731		       main
  732		     ]), When),
  733    '$initialization_context'(Source, Ctx),
  734    '$initialization'(When, Goal, Source, Ctx).
  735
  736'$initialization'(now, Goal, _Source, Ctx) :-
  737    '$run_init_goal'(Goal, Ctx),
  738    '$compile_init_goal'(-, Goal, Ctx).
  739'$initialization'(after_load, Goal, Source, Ctx) :-
  740    (   Source \== (-)
  741    ->  '$compile_init_goal'(Source, Goal, Ctx)
  742    ;   throw(error(context_error(nodirective,
  743				  initialization(Goal, after_load)),
  744		    _))
  745    ).
  746'$initialization'(restore, Goal, Source, Ctx) :- % deprecated
  747    '$initialization'(restore_state, Goal, Source, Ctx).
  748'$initialization'(restore_state, Goal, _Source, Ctx) :-
  749    (   \+ current_prolog_flag(sandboxed_load, true)
  750    ->  '$compile_init_goal'(-, Goal, Ctx)
  751    ;   '$permission_error'(register, initialization(restore), Goal)
  752    ).
  753'$initialization'(prepare_state, Goal, _Source, Ctx) :-
  754    (   \+ current_prolog_flag(sandboxed_load, true)
  755    ->  '$compile_init_goal'(when(prepare_state), Goal, Ctx)
  756    ;   '$permission_error'(register, initialization(restore), Goal)
  757    ).
  758'$initialization'(program, Goal, _Source, Ctx) :-
  759    (   \+ current_prolog_flag(sandboxed_load, true)
  760    ->  '$compile_init_goal'(when(program), Goal, Ctx)
  761    ;   '$permission_error'(register, initialization(restore), Goal)
  762    ).
  763'$initialization'(main, Goal, _Source, Ctx) :-
  764    (   \+ current_prolog_flag(sandboxed_load, true)
  765    ->  '$compile_init_goal'(when(main), Goal, Ctx)
  766    ;   '$permission_error'(register, initialization(restore), Goal)
  767    ).
  768
  769
  770'$compile_init_goal'(Source, Goal, Ctx) :-
  771    atom(Source),
  772    Source \== (-),
  773    !,
  774    '$store_admin_clause'(system:'$init_goal'(Source, Goal, Ctx),
  775			  _Layout, Source, Ctx).
  776'$compile_init_goal'(Source, Goal, Ctx) :-
  777    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.

  789'$run_initialization'(_, loaded, _) :- !.
  790'$run_initialization'(File, _Action, Options) :-
  791    '$run_initialization'(File, Options).
  792
  793'$run_initialization'(File, Options) :-
  794    setup_call_cleanup(
  795	'$start_run_initialization'(Options, Restore),
  796	'$run_initialization_2'(File),
  797	'$end_run_initialization'(Restore)).
  798
  799'$start_run_initialization'(Options, OldSandBoxed) :-
  800    '$push_input_context'(initialization),
  801    '$set_sandboxed_load'(Options, OldSandBoxed).
  802'$end_run_initialization'(OldSandBoxed) :-
  803    set_prolog_flag(sandboxed_load, OldSandBoxed),
  804    '$pop_input_context'.
  805
  806'$run_initialization_2'(File) :-
  807    (   '$init_goal'(File, Goal, Ctx),
  808	File \= when(_),
  809	'$run_init_goal'(Goal, Ctx),
  810	fail
  811    ;   true
  812    ).
  813
  814'$run_init_goal'(Goal, Ctx) :-
  815    (   catch_with_backtrace('$run_init_goal'(Goal), E,
  816			     '$initialization_error'(E, Goal, Ctx))
  817    ->  true
  818    ;   '$initialization_failure'(Goal, Ctx)
  819    ).
  820
  821:- multifile prolog:sandbox_allowed_goal/1.  822
  823'$run_init_goal'(Goal) :-
  824    current_prolog_flag(sandboxed_load, false),
  825    !,
  826    call(Goal).
  827'$run_init_goal'(Goal) :-
  828    prolog:sandbox_allowed_goal(Goal),
  829    call(Goal).
  830
  831'$initialization_context'(Source, Ctx) :-
  832    (   source_location(File, Line)
  833    ->  Ctx = File:Line,
  834	'$input_context'(Context),
  835	'$top_file'(Context, File, Source)
  836    ;   Ctx = (-),
  837	File = (-)
  838    ).
  839
  840'$top_file'([input(include, F1, _, _)|T], _, F) :-
  841    !,
  842    '$top_file'(T, F1, F).
  843'$top_file'(_, F, F).
  844
  845
  846'$initialization_error'(unwind(halt(Status)), Goal, Ctx) :-
  847    !,
  848    print_message(warning, initialization(halt(Status), Goal, Ctx)).
  849'$initialization_error'(E, Goal, Ctx) :-
  850    print_message(error, initialization_error(Goal, E, Ctx)).
  851
  852'$initialization_failure'(Goal, Ctx) :-
  853    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

  861:- public '$clear_source_admin'/1.  862
  863'$clear_source_admin'(File) :-
  864    retractall('$init_goal'(_, _, File:_)),
  865    retractall('$load_context_module'(File, _, _)),
  866    retractall('$resolved_source_path_db'(_, _, File)).
  867
  868
  869		 /*******************************
  870		 *            STREAM            *
  871		 *******************************/
  872
  873:- '$iso'(stream_property/2).  874stream_property(Stream, Property) :-
  875    nonvar(Stream),
  876    nonvar(Property),
  877    !,
  878    '$stream_property'(Stream, Property).
  879stream_property(Stream, Property) :-
  880    nonvar(Stream),
  881    !,
  882    '$stream_properties'(Stream, Properties),
  883    '$member'(Property, Properties).
  884stream_property(Stream, Property) :-
  885    nonvar(Property),
  886    !,
  887    (   Property = alias(Alias),
  888	atom(Alias)
  889    ->  '$alias_stream'(Alias, Stream)
  890    ;   '$streams_properties'(Property, Pairs),
  891	'$member'(Stream-Property, Pairs)
  892    ).
  893stream_property(Stream, Property) :-
  894    '$streams_properties'(Property, Pairs),
  895    '$member'(Stream-Properties, Pairs),
  896    '$member'(Property, Properties).
  897
  898
  899		/********************************
  900		*            MODULES            *
  901		*********************************/
  902
  903%       '$prefix_module'(+Module, +Context, +Term, -Prefixed)
  904%       Tags `Term' with `Module:' if `Module' is not the context module.
  905
  906'$prefix_module'(Module, Module, Head, Head) :- !.
  907'$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'.

  913default_module(Me, Super) :-
  914    (   atom(Me)
  915    ->  (   var(Super)
  916	->  '$default_module'(Me, Super)
  917	;   '$default_module'(Me, Super), !
  918	)
  919    ;   '$type_error'(module, Me)
  920    ).
  921
  922'$default_module'(Me, Me).
  923'$default_module'(Me, Super) :-
  924    import_module(Me, S),
  925    '$default_module'(S, Super).
  926
  927
  928		/********************************
  929		*      TRACE AND EXCEPTIONS     *
  930		*********************************/
  931
  932:- dynamic   user:exception/3.  933:- multifile user:exception/3.  934:- '$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.

  943:- public
  944    '$undefined_procedure'/4.  945
  946'$undefined_procedure'(Module, Name, Arity, Action) :-
  947    '$prefix_module'(Module, user, Name/Arity, Pred),
  948    user:exception(undefined_predicate, Pred, Action0),
  949    !,
  950    Action = Action0.
  951'$undefined_procedure'(Module, Name, Arity, Action) :-
  952    \+ current_prolog_flag(autoload, false),
  953    '$autoload'(Module:Name/Arity),
  954    !,
  955    Action = retry.
  956'$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.

  968'$loading'(Library) :-
  969    current_prolog_flag(threads, true),
  970    (   '$loading_file'(Library, _Queue, _LoadThread)
  971    ->  true
  972    ;   '$loading_file'(FullFile, _Queue, _LoadThread),
  973	file_name_extension(Library, _, FullFile)
  974    ->  true
  975    ).
  976
  977%        handle debugger 'w', 'p' and <N> depth options.
  978
  979'$set_debugger_write_options'(write) :-
  980    !,
  981    create_prolog_flag(debugger_write_options,
  982		       [ quoted(true),
  983			 attributes(dots),
  984			 spacing(next_argument)
  985		       ], []).
  986'$set_debugger_write_options'(print) :-
  987    !,
  988    create_prolog_flag(debugger_write_options,
  989		       [ quoted(true),
  990			 portray(true),
  991			 max_depth(10),
  992			 attributes(portray),
  993			 spacing(next_argument)
  994		       ], []).
  995'$set_debugger_write_options'(Depth) :-
  996    current_prolog_flag(debugger_write_options, Options0),
  997    (   '$select'(max_depth(_), Options0, Options)
  998    ->  true
  999    ;   Options = Options0
 1000    ),
 1001    create_prolog_flag(debugger_write_options,
 1002		       [max_depth(Depth)|Options], []).
 1003
 1004
 1005		/********************************
 1006		*        SYSTEM MESSAGES        *
 1007		*********************************/

 $confirm(Spec) is semidet

Ask the user to confirm a question. Spec is a term as used for print_message/2. It is printed the the query channel. This predicate may be hooked using confirm/2, which must return a boolean.

 1016:- multifile
 1017    prolog:confirm/2. 1018
 1019'$confirm'(Spec) :-
 1020    prolog:confirm(Spec, Result),
 1021    !,
 1022    Result == true.
 1023'$confirm'(Spec) :-
 1024    print_message(query, Spec),
 1025    between(0, 5, _),
 1026	get_single_char(Answer),
 1027	(   '$in_reply'(Answer, 'yYjJ \n')
 1028	->  !,
 1029	    print_message(query, if_tty([yes-[]]))
 1030	;   '$in_reply'(Answer, 'nN')
 1031	->  !,
 1032	    print_message(query, if_tty([no-[]])),
 1033	    fail
 1034	;   print_message(help, query(confirm)),
 1035	    fail
 1036	).
 1037
 1038'$in_reply'(Code, Atom) :-
 1039    char_code(Char, Code),
 1040    sub_atom(Atom, _, _, _, Char),
 1041    !.
 1042
 1043:- dynamic
 1044    user:portray/1. 1045:- multifile
 1046    user:portray/1. 1047:- '$notransact'(user:portray/1). 1048
 1049
 1050		 /*******************************
 1051		 *       FILE_SEARCH_PATH       *
 1052		 *******************************/
 1053
 1054:- dynamic
 1055    user:file_search_path/2,
 1056    user:library_directory/1. 1057:- multifile
 1058    user:file_search_path/2,
 1059    user:library_directory/1. 1060:- '$notransact'((user:file_search_path/2,
 1061                  user:library_directory/1)). 1062
 1063user:(file_search_path(library, Dir) :-
 1064	library_directory(Dir)).
 1065user:file_search_path(swi, Home) :-
 1066    current_prolog_flag(home, Home).
 1067user:file_search_path(swi, Home) :-
 1068    current_prolog_flag(shared_home, Home).
 1069user:file_search_path(library, app_config(lib)).
 1070user:file_search_path(library, swi(library)).
 1071user:file_search_path(library, swi(library/clp)).
 1072user:file_search_path(library, Dir) :-
 1073    '$ext_library_directory'(Dir).
 1074user:file_search_path(path, Dir) :-
 1075    getenv('PATH', Path),
 1076    current_prolog_flag(path_sep, Sep),
 1077    atomic_list_concat(Dirs, Sep, Path),
 1078    '$member'(Dir, Dirs).
 1079user:file_search_path(user_app_data, Dir) :-
 1080    '$xdg_prolog_directory'(data, Dir).
 1081user:file_search_path(common_app_data, Dir) :-
 1082    '$xdg_prolog_directory'(common_data, Dir).
 1083user:file_search_path(user_app_config, Dir) :-
 1084    '$xdg_prolog_directory'(config, Dir).
 1085user:file_search_path(common_app_config, Dir) :-
 1086    '$xdg_prolog_directory'(common_config, Dir).
 1087user:file_search_path(app_data, user_app_data('.')).
 1088user:file_search_path(app_data, common_app_data('.')).
 1089user:file_search_path(app_config, user_app_config('.')).
 1090user:file_search_path(app_config, common_app_config('.')).
 1091% backward compatibility
 1092user:file_search_path(app_preferences, user_app_config('.')).
 1093user:file_search_path(user_profile, app_preferences('.')).
 1094user:file_search_path(app, swi(app)).
 1095user:file_search_path(app, app_data(app)).
 1096user:file_search_path(demo, swi(demo)).
 1097user:file_search_path(working_directory, CWD) :-
 1098    working_directory(CWD, CWD).
 1099
 1100'$xdg_prolog_directory'(Which, Dir) :-
 1101    '$xdg_directory'(Which, XDGDir),
 1102    '$make_config_dir'(XDGDir),
 1103    '$ensure_slash'(XDGDir, XDGDirS),
 1104    atom_concat(XDGDirS, 'swi-prolog', Dir),
 1105    '$make_config_dir'(Dir).
 1106
 1107'$xdg_directory'(Which, Dir) :-
 1108    '$xdg_directory_search'(Where),
 1109    '$xdg_directory'(Which, Where, Dir).
 1110
 1111'$xdg_directory_search'(xdg) :-
 1112    current_prolog_flag(xdg, true),
 1113    !.
 1114'$xdg_directory_search'(Where) :-
 1115    current_prolog_flag(windows, true),
 1116    (   current_prolog_flag(xdg, false)
 1117    ->  Where = windows
 1118    ;   '$member'(Where, [windows, xdg])
 1119    ).
 1120
 1121% config
 1122'$xdg_directory'(config, windows, Home) :-
 1123    catch(win_folder(appdata, Home), _, fail).
 1124'$xdg_directory'(config, xdg, Home) :-
 1125    getenv('XDG_CONFIG_HOME', Home).
 1126'$xdg_directory'(config, xdg, Home) :-
 1127    expand_file_name('~/.config', [Home]).
 1128% data
 1129'$xdg_directory'(data, windows, Home) :-
 1130    catch(win_folder(local_appdata, Home), _, fail).
 1131'$xdg_directory'(data, xdg, Home) :-
 1132    getenv('XDG_DATA_HOME', Home).
 1133'$xdg_directory'(data, xdg, Home) :-
 1134    expand_file_name('~/.local', [Local]),
 1135    '$make_config_dir'(Local),
 1136    atom_concat(Local, '/share', Home),
 1137    '$make_config_dir'(Home).
 1138% common data
 1139'$xdg_directory'(common_data, windows, Dir) :-
 1140    catch(win_folder(common_appdata, Dir), _, fail).
 1141'$xdg_directory'(common_data, xdg, Dir) :-
 1142    '$existing_dir_from_env_path'('XDG_DATA_DIRS',
 1143				  [ '/usr/local/share',
 1144				    '/usr/share'
 1145				  ],
 1146				  Dir).
 1147% common config
 1148'$xdg_directory'(common_config, windows, Dir) :-
 1149    catch(win_folder(common_appdata, Dir), _, fail).
 1150'$xdg_directory'(common_config, xdg, Dir) :-
 1151    '$existing_dir_from_env_path'('XDG_CONFIG_DIRS', ['/etc/xdg'], Dir).
 1152
 1153'$existing_dir_from_env_path'(Env, Defaults, Dir) :-
 1154    (   getenv(Env, Path)
 1155    ->  current_prolog_flag(path_sep, Sep),
 1156	atomic_list_concat(Dirs, Sep, Path)
 1157    ;   Dirs = Defaults
 1158    ),
 1159    '$member'(Dir, Dirs),
 1160    Dir \== '',
 1161    exists_directory(Dir).
 1162
 1163'$make_config_dir'(Dir) :-
 1164    exists_directory(Dir),
 1165    !.
 1166'$make_config_dir'(Dir) :-
 1167    nb_current('$create_search_directories', true),
 1168    file_directory_name(Dir, Parent),
 1169    '$my_file'(Parent),
 1170    catch(make_directory(Dir), _, fail).
 1171
 1172'$ensure_slash'(Dir, DirS) :-
 1173    (   sub_atom(Dir, _, _, 0, /)
 1174    ->  DirS = Dir
 1175    ;   atom_concat(Dir, /, DirS)
 1176    ).
 1177
 1178:- dynamic '$ext_lib_dirs'/1. 1179:- volatile '$ext_lib_dirs'/1. 1180
 1181'$ext_library_directory'(Dir) :-
 1182    '$ext_lib_dirs'(Dirs),
 1183    !,
 1184    '$member'(Dir, Dirs).
 1185'$ext_library_directory'(Dir) :-
 1186    current_prolog_flag(home, Home),
 1187    atom_concat(Home, '/library/ext/*', Pattern),
 1188    expand_file_name(Pattern, Dirs0),
 1189    '$include'(exists_directory, Dirs0, Dirs),
 1190    asserta('$ext_lib_dirs'(Dirs)),
 1191    '$member'(Dir, Dirs).

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

 1196'$expand_file_search_path'(Spec, Expanded, Cond) :-
 1197    '$option'(access(Access), Cond),
 1198    memberchk(Access, [write,append]),
 1199    !,
 1200    setup_call_cleanup(
 1201	nb_setval('$create_search_directories', true),
 1202	expand_file_search_path(Spec, Expanded),
 1203	nb_delete('$create_search_directories')).
 1204'$expand_file_search_path'(Spec, Expanded, _Cond) :-
 1205    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?

 1213expand_file_search_path(Spec, Expanded) :-
 1214    catch('$expand_file_search_path'(Spec, Expanded, 0, []),
 1215	  loop(Used),
 1216	  throw(error(loop_error(Spec), file_search(Used)))).
 1217
 1218'$expand_file_search_path'(Spec, Expanded, N, Used) :-
 1219    functor(Spec, Alias, 1),
 1220    !,
 1221    user:file_search_path(Alias, Exp0),
 1222    NN is N + 1,
 1223    (   NN > 16
 1224    ->  throw(loop(Used))
 1225    ;   true
 1226    ),
 1227    '$expand_file_search_path'(Exp0, Exp1, NN, [Alias=Exp0|Used]),
 1228    arg(1, Spec, Segments),
 1229    '$segments_to_atom'(Segments, File),
 1230    '$make_path'(Exp1, File, Expanded).
 1231'$expand_file_search_path'(Spec, Path, _, _) :-
 1232    '$segments_to_atom'(Spec, Path).
 1233
 1234'$make_path'(Dir, '.', Path) :-
 1235    !,
 1236    Path = Dir.
 1237'$make_path'(Dir, File, Path) :-
 1238    sub_atom(Dir, _, _, 0, /),
 1239    !,
 1240    atom_concat(Dir, File, Path).
 1241'$make_path'(Dir, File, Path) :-
 1242    atomic_list_concat([Dir, /, File], Path).
 1243
 1244
 1245		/********************************
 1246		*         FILE CHECKING         *
 1247		*********************************/

 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.

 1258absolute_file_name(Spec, Options, Path) :-
 1259    '$is_options'(Options),
 1260    \+ '$is_options'(Path),
 1261    !,
 1262    '$absolute_file_name'(Spec, Path, Options).
 1263absolute_file_name(Spec, Path, Options) :-
 1264    '$absolute_file_name'(Spec, Path, Options).
 1265
 1266'$absolute_file_name'(Spec, Path, Options0) :-
 1267    '$options_dict'(Options0, Options),
 1268		    % get the valid extensions
 1269    (   '$select_option'(extensions(Exts), Options, Options1)
 1270    ->  '$must_be'(list, Exts)
 1271    ;   '$option'(file_type(Type), Options)
 1272    ->  '$must_be'(atom, Type),
 1273	'$file_type_extensions'(Type, Exts),
 1274	Options1 = Options
 1275    ;   Options1 = Options,
 1276	Exts = ['']
 1277    ),
 1278    '$canonicalise_extensions'(Exts, Extensions),
 1279		    % unless specified otherwise, ask regular file
 1280    (   (   nonvar(Type)
 1281	;   '$option'(access(none), Options, none)
 1282	)
 1283    ->  Options2 = Options1
 1284    ;   '$merge_options'(_{file_type:regular}, Options1, Options2)
 1285    ),
 1286		    % Det or nondet?
 1287    (   '$select_option'(solutions(Sols), Options2, Options3)
 1288    ->  '$must_be'(oneof(atom, solutions, [first,all]), Sols)
 1289    ;   Sols = first,
 1290	Options3 = Options2
 1291    ),
 1292		    % Errors or not?
 1293    (   '$select_option'(file_errors(FileErrors), Options3, Options4)
 1294    ->  '$must_be'(oneof(atom, file_errors, [error,fail]), FileErrors)
 1295    ;   FileErrors = error,
 1296	Options4 = Options3
 1297    ),
 1298		    % Expand shell patterns?
 1299    (   atomic(Spec),
 1300	'$select_option'(expand(Expand), Options4, Options5),
 1301	'$must_be'(boolean, Expand)
 1302    ->  expand_file_name(Spec, List),
 1303	'$member'(Spec1, List)
 1304    ;   Spec1 = Spec,
 1305	Options5 = Options4
 1306    ),
 1307		    % Search for files
 1308    (   Sols == first
 1309    ->  (   '$chk_file'(Spec1, Extensions, Options5, true, Path)
 1310	->  !       % also kill choice point of expand_file_name/2
 1311	;   (   FileErrors == fail
 1312	    ->  fail
 1313	    ;   '$current_module'('$bags', _File),
 1314		findall(P,
 1315			'$chk_file'(Spec1, Extensions, [access(exist)],
 1316				    false, P),
 1317			Candidates),
 1318		'$abs_file_error'(Spec, Candidates, Options5)
 1319	    )
 1320	)
 1321    ;   '$chk_file'(Spec1, Extensions, Options5, false, Path)
 1322    ).
 1323
 1324'$abs_file_error'(Spec, Candidates, Conditions) :-
 1325    '$member'(F, Candidates),
 1326    '$member'(C, Conditions),
 1327    '$file_condition'(C),
 1328    '$file_error'(C, Spec, F, E, Comment),
 1329    !,
 1330    throw(error(E, context(_, Comment))).
 1331'$abs_file_error'(Spec, _, _) :-
 1332    '$existence_error'(source_sink, Spec).
 1333
 1334'$file_error'(file_type(directory), Spec, File, Error, Comment) :-
 1335    \+ exists_directory(File),
 1336    !,
 1337    Error = existence_error(directory, Spec),
 1338    Comment = not_a_directory(File).
 1339'$file_error'(file_type(_), Spec, File, Error, Comment) :-
 1340    exists_directory(File),
 1341    !,
 1342    Error = existence_error(file, Spec),
 1343    Comment = directory(File).
 1344'$file_error'(access(OneOrList), Spec, File, Error, _) :-
 1345    '$one_or_member'(Access, OneOrList),
 1346    \+ access_file(File, Access),
 1347    Error = permission_error(Access, source_sink, Spec).
 1348
 1349'$one_or_member'(Elem, List) :-
 1350    is_list(List),
 1351    !,
 1352    '$member'(Elem, List).
 1353'$one_or_member'(Elem, Elem).
 1354
 1355'$file_type_extensions'(Type, Exts) :-
 1356    '$current_module'('$bags', _File),
 1357    !,
 1358    findall(Ext, user:prolog_file_type(Ext, Type), Exts0),
 1359    (   Exts0 == [],
 1360	\+ '$ft_no_ext'(Type)
 1361    ->  '$domain_error'(file_type, Type)
 1362    ;   true
 1363    ),
 1364    '$append'(Exts0, [''], Exts).
 1365'$file_type_extensions'(prolog, [pl, '']). % findall is not yet defined ...
 1366
 1367'$ft_no_ext'(txt).
 1368'$ft_no_ext'(executable).
 1369'$ft_no_ext'(directory).
 1370'$ft_no_ext'(regular).

 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.

 1383:- multifile(user:prolog_file_type/2). 1384:- dynamic(user:prolog_file_type/2). 1385
 1386user:prolog_file_type(pl,       prolog).
 1387user:prolog_file_type(prolog,   prolog).
 1388user:prolog_file_type(qlf,      prolog).
 1389user:prolog_file_type(pl,       source).
 1390user:prolog_file_type(prolog,   source).
 1391user:prolog_file_type(qlf,      qlf).
 1392user:prolog_file_type(Ext,      executable) :-
 1393    current_prolog_flag(shared_object_extension, Ext).
 1394user:prolog_file_type(dylib,    executable) :-
 1395    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.

 1402'$chk_file'(Spec, _Extensions, _Cond, _Cache, _FullName) :-
 1403    \+ ground(Spec),
 1404    !,
 1405    '$instantiation_error'(Spec).
 1406'$chk_file'(Spec, Extensions, Cond, Cache, FullName) :-
 1407    compound(Spec),
 1408    functor(Spec, _, 1),
 1409    !,
 1410    '$relative_to'(Cond, cwd, CWD),
 1411    '$chk_alias_file'(Spec, Extensions, Cond, Cache, CWD, FullName).
 1412'$chk_file'(Segments, Ext, Cond, Cache, FullName) :-    % allow a/b/...
 1413    \+ atomic(Segments),
 1414    !,
 1415    '$segments_to_atom'(Segments, Atom),
 1416    '$chk_file'(Atom, Ext, Cond, Cache, FullName).
 1417'$chk_file'(File, Exts, Cond, _, FullName) :-           % Absolute files
 1418    is_absolute_file_name(File),
 1419    !,
 1420    '$extend_file'(File, Exts, Extended),
 1421    '$file_conditions'(Cond, Extended),
 1422    '$absolute_file_name'(Extended, FullName).
 1423'$chk_file'(File, Exts, Cond, _, FullName) :-           % Explicit relative_to
 1424    '$option'(relative_to(_), Cond),
 1425    !,
 1426    '$relative_to'(Cond, none, Dir),
 1427    '$chk_file_relative_to'(File, Exts, Cond, Dir, FullName).
 1428'$chk_file'(File, Exts, Cond, _Cache, FullName) :-      % From source
 1429    source_location(ContextFile, _Line),
 1430    !,
 1431    (   file_directory_name(ContextFile, Dir),
 1432        '$chk_file_relative_to'(File, Exts, Cond, Dir, FullName)
 1433    *-> true
 1434    ;   current_prolog_flag(source_search_working_directory, true),
 1435	'$extend_file'(File, Exts, Extended),
 1436	'$file_conditions'(Cond, Extended),
 1437	'$absolute_file_name'(Extended, FullName),
 1438        '$print_message'(warning,
 1439                         deprecated(source_search_working_directory(
 1440                                        File, FullName)))
 1441    ).
 1442'$chk_file'(File, Exts, Cond, _Cache, FullName) :-      % Not loading source
 1443    '$extend_file'(File, Exts, Extended),
 1444    '$file_conditions'(Cond, Extended),
 1445    '$absolute_file_name'(Extended, FullName).
 1446
 1447'$chk_file_relative_to'(File, Exts, Cond, Dir, FullName) :-
 1448    atomic_list_concat([Dir, /, File], AbsFile),
 1449    '$extend_file'(AbsFile, Exts, Extended),
 1450    '$file_conditions'(Cond, Extended),
 1451    '$absolute_file_name'(Extended, FullName).
 1452
 1453
 1454'$segments_to_atom'(Atom, Atom) :-
 1455    atomic(Atom),
 1456    !.
 1457'$segments_to_atom'(Segments, Atom) :-
 1458    '$segments_to_list'(Segments, List, []),
 1459    !,
 1460    atomic_list_concat(List, /, Atom).
 1461
 1462'$segments_to_list'(A/B, H, T) :-
 1463    '$segments_to_list'(A, H, T0),
 1464    '$segments_to_list'(B, T0, T).
 1465'$segments_to_list'(A, [A|T], T) :-
 1466    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.

 1476'$relative_to'(Conditions, Default, Dir) :-
 1477    (   '$option'(relative_to(FileOrDir), Conditions)
 1478    *-> (   exists_directory(FileOrDir)
 1479	->  Dir = FileOrDir
 1480	;   atom_concat(Dir, /, FileOrDir)
 1481	->  true
 1482	;   file_directory_name(FileOrDir, Dir)
 1483	)
 1484    ;   Default == cwd
 1485    ->  working_directory(Dir, Dir)
 1486    ;   Default == source
 1487    ->  source_location(ContextFile, _Line),
 1488	file_directory_name(ContextFile, Dir)
 1489    ).

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

 1494:- dynamic
 1495    '$search_path_file_cache'/3,    % SHA1, Time, Path
 1496    '$search_path_gc_time'/1.       % Time
 1497:- volatile
 1498    '$search_path_file_cache'/3,
 1499    '$search_path_gc_time'/1. 1500:- '$notransact'(('$search_path_file_cache'/3,
 1501                  '$search_path_gc_time'/1)). 1502
 1503:- create_prolog_flag(file_search_cache_time, 10, []). 1504
 1505'$chk_alias_file'(Spec, Exts, Cond, true, CWD, FullFile) :-
 1506    !,
 1507    findall(Exp, '$expand_file_search_path'(Spec, Exp, Cond), Expansions),
 1508    current_prolog_flag(emulated_dialect, Dialect),
 1509    Cache = cache(Exts, Cond, CWD, Expansions, Dialect),
 1510    variant_sha1(Spec+Cache, SHA1),
 1511    get_time(Now),
 1512    current_prolog_flag(file_search_cache_time, TimeOut),
 1513    (   '$search_path_file_cache'(SHA1, CachedTime, FullFile),
 1514	CachedTime > Now - TimeOut,
 1515	'$file_conditions'(Cond, FullFile)
 1516    ->  '$search_message'(file_search(cache(Spec, Cond), FullFile))
 1517    ;   '$member'(Expanded, Expansions),
 1518	'$extend_file'(Expanded, Exts, LibFile),
 1519	(   '$file_conditions'(Cond, LibFile),
 1520	    '$absolute_file_name'(LibFile, FullFile),
 1521	    '$cache_file_found'(SHA1, Now, TimeOut, FullFile)
 1522	->  '$search_message'(file_search(found(Spec, Cond), FullFile))
 1523	;   '$search_message'(file_search(tried(Spec, Cond), LibFile)),
 1524	    fail
 1525	)
 1526    ).
 1527'$chk_alias_file'(Spec, Exts, Cond, false, _CWD, FullFile) :-
 1528    '$expand_file_search_path'(Spec, Expanded, Cond),
 1529    '$extend_file'(Expanded, Exts, LibFile),
 1530    '$file_conditions'(Cond, LibFile),
 1531    '$absolute_file_name'(LibFile, FullFile).
 1532
 1533'$cache_file_found'(_, _, TimeOut, _) :-
 1534    TimeOut =:= 0,
 1535    !.
 1536'$cache_file_found'(SHA1, Now, TimeOut, FullFile) :-
 1537    '$search_path_file_cache'(SHA1, Saved, FullFile),
 1538    !,
 1539    (   Now - Saved < TimeOut/2
 1540    ->  true
 1541    ;   retractall('$search_path_file_cache'(SHA1, _, _)),
 1542	asserta('$search_path_file_cache'(SHA1, Now, FullFile))
 1543    ).
 1544'$cache_file_found'(SHA1, Now, TimeOut, FullFile) :-
 1545    'gc_file_search_cache'(TimeOut),
 1546    asserta('$search_path_file_cache'(SHA1, Now, FullFile)).
 1547
 1548'gc_file_search_cache'(TimeOut) :-
 1549    get_time(Now),
 1550    '$search_path_gc_time'(Last),
 1551    Now-Last < TimeOut/2,
 1552    !.
 1553'gc_file_search_cache'(TimeOut) :-
 1554    get_time(Now),
 1555    retractall('$search_path_gc_time'(_)),
 1556    assertz('$search_path_gc_time'(Now)),
 1557    Before is Now - TimeOut,
 1558    (   '$search_path_file_cache'(SHA1, Cached, FullFile),
 1559	Cached < Before,
 1560	retractall('$search_path_file_cache'(SHA1, Cached, FullFile)),
 1561	fail
 1562    ;   true
 1563    ).
 1564
 1565
 1566'$search_message'(Term) :-
 1567    current_prolog_flag(verbose_file_search, true),
 1568    !,
 1569    print_message(informational, Term).
 1570'$search_message'(_).

 $file_conditions(+Condition, +Path)

Verify Path satisfies Condition.

 1577'$file_conditions'(List, File) :-
 1578    is_list(List),
 1579    !,
 1580    \+ ( '$member'(C, List),
 1581	 '$file_condition'(C),
 1582	 \+ '$file_condition'(C, File)
 1583       ).
 1584'$file_conditions'(Map, File) :-
 1585    \+ (  get_dict(Key, Map, Value),
 1586	  C =.. [Key,Value],
 1587	  '$file_condition'(C),
 1588	 \+ '$file_condition'(C, File)
 1589       ).
 1590
 1591'$file_condition'(file_type(directory), File) :-
 1592    !,
 1593    exists_directory(File).
 1594'$file_condition'(file_type(_), File) :-
 1595    !,
 1596    \+ exists_directory(File).
 1597'$file_condition'(access(Accesses), File) :-
 1598    !,
 1599    \+ (  '$one_or_member'(Access, Accesses),
 1600	  \+ access_file(File, Access)
 1601       ).
 1602
 1603'$file_condition'(exists).
 1604'$file_condition'(file_type(_)).
 1605'$file_condition'(access(_)).
 1606
 1607'$extend_file'(File, Exts, FileEx) :-
 1608    '$ensure_extensions'(Exts, File, Fs),
 1609    '$list_to_set'(Fs, FsSet),
 1610    '$member'(FileEx, FsSet).
 1611
 1612'$ensure_extensions'([], _, []).
 1613'$ensure_extensions'([E|E0], F, [FE|E1]) :-
 1614    file_name_extension(F, E, FE),
 1615    '$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. Copied from library(lists).

 1622'$list_to_set'(List, Set) :-
 1623    '$number_list'(List, 1, Numbered),
 1624    sort(1, @=<, Numbered, ONum),
 1625    '$remove_dup_keys'(ONum, NumSet),
 1626    sort(2, @=<, NumSet, ONumSet),
 1627    '$pairs_keys'(ONumSet, Set).
 1628
 1629'$number_list'([], _, []).
 1630'$number_list'([H|T0], N, [H-N|T]) :-
 1631    N1 is N+1,
 1632    '$number_list'(T0, N1, T).
 1633
 1634'$remove_dup_keys'([], []).
 1635'$remove_dup_keys'([H|T0], [H|T]) :-
 1636    H = V-_,
 1637    '$remove_same_key'(T0, V, T1),
 1638    '$remove_dup_keys'(T1, T).
 1639
 1640'$remove_same_key'([V1-_|T0], V, T) :-
 1641    V1 == V,
 1642    !,
 1643    '$remove_same_key'(T0, V, T).
 1644'$remove_same_key'(L, _, L).
 1645
 1646'$pairs_keys'([], []).
 1647'$pairs_keys'([K-_|T0], [K|T]) :-
 1648    '$pairs_keys'(T0, T).
 1649
 1650'$pairs_values'([], []).
 1651'$pairs_values'([_-V|T0], [V|T]) :-
 1652    '$pairs_values'(T0, T).
 1653
 1654/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
 1655Canonicalise the extension list. Old SWI-Prolog   require  `.pl', etc, which
 1656the Quintus compatibility  requests  `pl'.   This  layer  canonicalises  all
 1657extensions to .ext
 1658- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
 1659
 1660'$canonicalise_extensions'([], []) :- !.
 1661'$canonicalise_extensions'([H|T], [CH|CT]) :-
 1662    !,
 1663    '$must_be'(atom, H),
 1664    '$canonicalise_extension'(H, CH),
 1665    '$canonicalise_extensions'(T, CT).
 1666'$canonicalise_extensions'(E, [CE]) :-
 1667    '$canonicalise_extension'(E, CE).
 1668
 1669'$canonicalise_extension'('', '') :- !.
 1670'$canonicalise_extension'(DotAtom, DotAtom) :-
 1671    sub_atom(DotAtom, 0, _, _, '.'),
 1672    !.
 1673'$canonicalise_extension'(Atom, DotAtom) :-
 1674    atom_concat('.', Atom, DotAtom).
 1675
 1676
 1677		/********************************
 1678		*            CONSULT            *
 1679		*********************************/
 1680
 1681:- dynamic
 1682    user:library_directory/1,
 1683    user:prolog_load_file/2. 1684:- multifile
 1685    user:library_directory/1,
 1686    user:prolog_load_file/2. 1687
 1688:- prompt(_, '|: '). 1689
 1690:- thread_local
 1691    '$compilation_mode_store'/1,    % database, wic, qlf
 1692    '$directive_mode_store'/1.      % database, wic, qlf
 1693:- volatile
 1694    '$compilation_mode_store'/1,
 1695    '$directive_mode_store'/1. 1696:- '$notransact'(('$compilation_mode_store'/1,
 1697                  '$directive_mode_store'/1)). 1698
 1699'$compilation_mode'(Mode) :-
 1700    (   '$compilation_mode_store'(Val)
 1701    ->  Mode = Val
 1702    ;   Mode = database
 1703    ).
 1704
 1705'$set_compilation_mode'(Mode) :-
 1706    retractall('$compilation_mode_store'(_)),
 1707    assertz('$compilation_mode_store'(Mode)).
 1708
 1709'$compilation_mode'(Old, New) :-
 1710    '$compilation_mode'(Old),
 1711    (   New == Old
 1712    ->  true
 1713    ;   '$set_compilation_mode'(New)
 1714    ).
 1715
 1716'$directive_mode'(Mode) :-
 1717    (   '$directive_mode_store'(Val)
 1718    ->  Mode = Val
 1719    ;   Mode = database
 1720    ).
 1721
 1722'$directive_mode'(Old, New) :-
 1723    '$directive_mode'(Old),
 1724    (   New == Old
 1725    ->  true
 1726    ;   '$set_directive_mode'(New)
 1727    ).
 1728
 1729'$set_directive_mode'(Mode) :-
 1730    retractall('$directive_mode_store'(_)),
 1731    assertz('$directive_mode_store'(Mode)).