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'.

 $tbl_reset(+Goal, ?Ball, -Continue, +WorkList, +Skeleton, +Delays)

As reset/3, but if Goal succeeds, add Skeleton as an answer to WorkList with Delays and fail. If the answer completes the table, first prune the choice points of Goal. Thus, this only succeeds if Goal suspends. Used by delim/4 of the tabling library. Goal is either a module-qualified goal or a continuation. This is not a meta-predicate to avoid qualifying the continuation on every resumption.

  616'$tbl_reset'(_Goal, _Ball, _Cont, _WorkList, _Skeleton, _Delays) :-
  617    '$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.

  626shift(Ball) :-
  627    '$shift'(Ball).
  628
  629shift_for_copy(Ball) :-
  630    '$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.

  644call_continuation([]).
  645call_continuation([TB|Rest]) :-
  646    (   Rest == []
  647    ->  '$call_continuation'(TB)
  648    ;   '$call_continuation'(TB),
  649	call_continuation(Rest)
  650    ).

 catch_with_backtrace(:Goal, ?Ball, :Recover)

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

  657catch_with_backtrace(Goal, Ball, Recover) :-
  658    catch(Goal, Ball, Recover),
  659    '$no_lco'.
  660
  661'$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.

  671:- public '$recover_and_rethrow'/2.  672
  673'$recover_and_rethrow'(Goal, Exception) :-
  674    call_cleanup(Goal, throw(Exception)),
  675    !.

 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.

  689setup_call_catcher_cleanup(Setup, _Goal, _Catcher, _Cleanup) :-
  690    sig_atomic(Setup),
  691    '$call_cleanup'.
  692
  693setup_call_cleanup(Setup, _Goal, _Cleanup) :-
  694    sig_atomic(Setup),
  695    '$call_cleanup'.
  696
  697call_cleanup(_Goal, _Cleanup) :-
  698    '$call_cleanup'.
  699
  700
  701		 /*******************************
  702		 *       INITIALIZATION         *
  703		 *******************************/
  704
  705:- meta_predicate
  706    initialization(0, +).  707
  708:- multifile '$init_goal'/3.  709:- dynamic   '$init_goal'/3.  710:- '$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.

  736initialization(Goal, When) :-
  737    '$must_be'(oneof(atom, initialization_type,
  738		     [ now,
  739		       after_load,
  740		       restore,
  741		       restore_state,
  742		       prepare_state,
  743		       program,
  744		       main
  745		     ]), When),
  746    '$initialization_context'(Source, Ctx),
  747    '$initialization'(When, Goal, Source, Ctx).
  748
  749'$initialization'(now, Goal, _Source, Ctx) :-
  750    '$run_init_goal'(Goal, Ctx),
  751    '$compile_init_goal'(-, Goal, Ctx).
  752'$initialization'(after_load, Goal, Source, Ctx) :-
  753    (   Source \== (-)
  754    ->  '$compile_init_goal'(Source, Goal, Ctx)
  755    ;   throw(error(context_error(nodirective,
  756				  initialization(Goal, after_load)),
  757		    _))
  758    ).
  759'$initialization'(restore, Goal, Source, Ctx) :- % deprecated
  760    '$initialization'(restore_state, Goal, Source, Ctx).
  761'$initialization'(restore_state, Goal, _Source, Ctx) :-
  762    (   \+ current_prolog_flag(sandboxed_load, true)
  763    ->  '$compile_init_goal'(-, Goal, Ctx)
  764    ;   '$permission_error'(register, initialization(restore), Goal)
  765    ).
  766'$initialization'(prepare_state, Goal, _Source, Ctx) :-
  767    (   \+ current_prolog_flag(sandboxed_load, true)
  768    ->  '$compile_init_goal'(when(prepare_state), Goal, Ctx)
  769    ;   '$permission_error'(register, initialization(restore), Goal)
  770    ).
  771'$initialization'(program, Goal, _Source, Ctx) :-
  772    (   \+ current_prolog_flag(sandboxed_load, true)
  773    ->  '$compile_init_goal'(when(program), Goal, Ctx)
  774    ;   '$permission_error'(register, initialization(restore), Goal)
  775    ).
  776'$initialization'(main, Goal, _Source, Ctx) :-
  777    (   \+ current_prolog_flag(sandboxed_load, true)
  778    ->  '$compile_init_goal'(when(main), Goal, Ctx)
  779    ;   '$permission_error'(register, initialization(restore), Goal)
  780    ).
  781
  782
  783'$compile_init_goal'(Source, Goal, Ctx) :-
  784    atom(Source),
  785    Source \== (-),
  786    !,
  787    '$store_admin_clause'(system:'$init_goal'(Source, Goal, Ctx),
  788			  _Layout, Source, Ctx).
  789'$compile_init_goal'(Source, Goal, Ctx) :-
  790    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.

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

  874:- public '$clear_source_admin'/1.  875
  876'$clear_source_admin'(File) :-
  877    retractall('$init_goal'(_, _, File:_)),
  878    retractall('$load_context_module'(File, _, _)),
  879    retractall('$resolved_source_path_db'(_, _, File)).
  880
  881
  882		 /*******************************
  883		 *            STREAM            *
  884		 *******************************/
  885
  886:- '$iso'(stream_property/2).  887stream_property(Stream, Property) :-
  888    nonvar(Stream),
  889    nonvar(Property),
  890    !,
  891    '$stream_property'(Stream, Property).
  892stream_property(Stream, Property) :-
  893    nonvar(Stream),
  894    !,
  895    '$stream_properties'(Stream, Properties),
  896    '$member'(Property, Properties).
  897stream_property(Stream, Property) :-
  898    nonvar(Property),
  899    !,
  900    (   Property = alias(Alias),
  901	atom(Alias)
  902    ->  '$alias_stream'(Alias, Stream)
  903    ;   '$streams_properties'(Property, Pairs),
  904	'$member'(Stream-Property, Pairs)
  905    ).
  906stream_property(Stream, Property) :-
  907    '$streams_properties'(Property, Pairs),
  908    '$member'(Stream-Properties, Pairs),
  909    '$member'(Property, Properties).
  910
  911
  912		/********************************
  913		*            MODULES            *
  914		*********************************/
  915
  916%       '$prefix_module'(+Module, +Context, +Term, -Prefixed)
  917%       Tags `Term' with `Module:' if `Module' is not the context module.
  918
  919'$prefix_module'(Module, Module, Head, Head) :- !.
  920'$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'.

  926default_module(Me, Super) :-
  927    (   atom(Me)
  928    ->  (   var(Super)
  929	->  '$default_module'(Me, Super)
  930	;   '$default_module'(Me, Super), !
  931	)
  932    ;   '$type_error'(module, Me)
  933    ).
  934
  935'$default_module'(Me, Me).
  936'$default_module'(Me, Super) :-
  937    import_module(Me, S),
  938    '$default_module'(S, Super).
  939
  940
  941		/********************************
  942		*      TRACE AND EXCEPTIONS     *
  943		*********************************/
  944
  945:- dynamic   user:exception/3.  946:- multifile user:exception/3.  947:- '$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.

  956:- public
  957    '$undefined_procedure'/4.  958
  959'$undefined_procedure'(Module, Name, Arity, Action) :-
  960    '$prefix_module'(Module, user, Name/Arity, Pred),
  961    user:exception(undefined_predicate, Pred, Action0),
  962    !,
  963    Action = Action0.
  964'$undefined_procedure'(Module, Name, Arity, Action) :-
  965    \+ current_prolog_flag(autoload, false),
  966    '$autoload'(Module:Name/Arity),
  967    !,
  968    Action = retry.
  969'$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.

  981'$loading'(Library) :-
  982    current_prolog_flag(threads, true),
  983    (   '$loading_file'(Library, _Queue, _LoadThread)
  984    ->  true
  985    ;   '$loading_file'(FullFile, _Queue, _LoadThread),
  986	file_name_extension(Library, _, FullFile)
  987    ->  true
  988    ).
  989
  990%        handle debugger 'w', 'p' and <N> depth options.
  991
  992'$set_debugger_write_options'(write) :-
  993    !,
  994    create_prolog_flag(debugger_write_options,
  995		       [ quoted(true),
  996			 attributes(dots),
  997			 spacing(next_argument)
  998		       ], []).
  999'$set_debugger_write_options'(print) :-
 1000    !,
 1001    create_prolog_flag(debugger_write_options,
 1002		       [ quoted(true),
 1003			 portray(true),
 1004			 max_depth(10),
 1005			 attributes(portray),
 1006			 spacing(next_argument)
 1007		       ], []).
 1008'$set_debugger_write_options'(Depth) :-
 1009    current_prolog_flag(debugger_write_options, Options0),
 1010    (   '$select'(max_depth(_), Options0, Options)
 1011    ->  true
 1012    ;   Options = Options0
 1013    ),
 1014    create_prolog_flag(debugger_write_options,
 1015		       [max_depth(Depth)|Options], []).
 1016
 1017
 1018		/********************************
 1019		*        SYSTEM MESSAGES        *
 1020		*********************************/

 $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.

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

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

 1209'$expand_file_search_path'(Spec, Expanded, Cond) :-
 1210    '$option'(access(Access), Cond),
 1211    memberchk(Access, [write,append]),
 1212    !,
 1213    setup_call_cleanup(
 1214	nb_setval('$create_search_directories', true),
 1215	expand_file_search_path(Spec, Expanded),
 1216	nb_delete('$create_search_directories')).
 1217'$expand_file_search_path'(Spec, Expanded, _Cond) :-
 1218    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?

 1226expand_file_search_path(Spec, Expanded) :-
 1227    catch('$expand_file_search_path'(Spec, Expanded, 0, []),
 1228	  loop(Used),
 1229	  throw(error(loop_error(Spec), file_search(Used)))).
 1230
 1231'$expand_file_search_path'(Spec, Expanded, N, Used) :-
 1232    functor(Spec, Alias, 1),
 1233    !,
 1234    user:file_search_path(Alias, Exp0),
 1235    NN is N + 1,
 1236    (   NN > 16
 1237    ->  throw(loop(Used))
 1238    ;   true
 1239    ),
 1240    '$expand_file_search_path'(Exp0, Exp1, NN, [Alias=Exp0|Used]),
 1241    arg(1, Spec, Segments),
 1242    '$segments_to_atom'(Segments, File),
 1243    '$make_path'(Exp1, File, Expanded).
 1244'$expand_file_search_path'(Spec, Path, _, _) :-
 1245    '$segments_to_atom'(Spec, Path).
 1246
 1247'$make_path'(Dir, '.', Path) :-
 1248    !,
 1249    Path = Dir.
 1250'$make_path'(Dir, File, Path) :-
 1251    sub_atom(Dir, _, _, 0, /),
 1252    !,
 1253    atom_concat(Dir, File, Path).
 1254'$make_path'(Dir, File, Path) :-
 1255    atomic_list_concat([Dir, /, File], Path).
 1256
 1257
 1258		/********************************
 1259		*         FILE CHECKING         *
 1260		*********************************/

 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.

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

 1396:- multifile(user:prolog_file_type/2). 1397:- dynamic(user:prolog_file_type/2). 1398
 1399user:prolog_file_type(pl,       prolog).
 1400user:prolog_file_type(prolog,   prolog).
 1401user:prolog_file_type(qlf,      prolog).
 1402user:prolog_file_type(pl,       source).
 1403user:prolog_file_type(prolog,   source).
 1404user:prolog_file_type(qlf,      qlf).
 1405user:prolog_file_type(Ext,      executable) :-
 1406    current_prolog_flag(shared_object_extension, Ext).
 1407user:prolog_file_type(dylib,    executable) :-
 1408    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.

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

 1489'$relative_to'(Conditions, Default, Dir) :-
 1490    (   '$option'(relative_to(FileOrDir), Conditions)
 1491    *-> (   exists_directory(FileOrDir)
 1492	->  Dir = FileOrDir
 1493	;   atom_concat(Dir, /, FileOrDir)
 1494	->  true
 1495	;   file_directory_name(FileOrDir, Dir)
 1496	)
 1497    ;   Default == cwd
 1498    ->  working_directory(Dir, Dir)
 1499    ;   Default == source
 1500    ->  source_location(ContextFile, _Line),
 1501	file_directory_name(ContextFile, Dir)
 1502    ).

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

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

 $file_conditions(+Condition, +Path)

Verify Path satisfies Condition.

 1590'$file_conditions'(List, File) :-
 1591    is_list(List),
 1592    !,
 1593    \+ ( '$member'(C, List),
 1594	 '$file_condition'(C),
 1595	 \+ '$file_condition'(C, File)
 1596       ).
 1597'$file_conditions'(Map, File) :-
 1598    \+ (  get_dict(Key, Map, Value),
 1599	  C =.. [Key,Value],
 1600	  '$file_condition'(C),
 1601	 \+ '$file_condition'(C, File)
 1602       ).
 1603
 1604'$file_condition'(file_type(directory), File) :-
 1605    !,
 1606    exists_directory(File).
 1607'$file_condition'(file_type(_), File) :-
 1608    !,
 1609    \+ exists_directory(File).
 1610'$file_condition'(access(Accesses), File) :-
 1611    !,
 1612    \+ (  '$one_or_member'(Access, Accesses),
 1613	  \+ access_file(File, Access)
 1614       ).
 1615
 1616'$file_condition'(exists).
 1617'$file_condition'(file_type(_)).
 1618'$file_condition'(access(_)).
 1619
 1620'$extend_file'(File, Exts, FileEx) :-
 1621    '$ensure_extensions'(Exts, File, Fs),
 1622    '$list_to_set'(Fs, FsSet),
 1623    '$member'(FileEx, FsSet).
 1624
 1625'$ensure_extensions'([], _, []).
 1626'$ensure_extensions'([E|E0], F, [FE|E1]) :-
 1627    file_name_extension(F, E, FE),
 1628    '$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).

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