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-2022, 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'(:).

 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.

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

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

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

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

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

 $pi_head(?PI, ?Head)

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

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

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

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

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

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

  521not(Goal) :-
  522    \+ Goal.

 \+ :Goal is semidet

Predicate version that allows for meta-calling.

  528\+ Goal :-
  529    \+ Goal.

 once(:Goal) is semidet

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

  535once(Goal) :-
  536    Goal,
  537    !.

 ignore(:Goal) is det

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

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

 false

Synonym for fail/0, providing a declarative reading.

  555false :-
  556    fail.

 catch(:Goal, +Catcher, :Recover)

ISO compliant exception handling.

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

 prolog_cut_to(+Choice)

Cut all choice points after Choice

  569prolog_cut_to(_Choice) :-
  570    '$cut'.                         % Maps to I_CUTCHP

 $ is det

Declare that from now on this predicate succeeds deterministically.

  576'$' :- '$'.

 $ :Goal is det

Declare that Goal must succeed deterministically.

  582$(Goal) :- $(Goal).

 notrace(:Goal) is semidet

Suspend the tracer while running Goal.

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

 reset(:Goal, ?Ball, -Continue)

Delimited continuation support.

  601reset(_Goal, _Ball, _Cont) :-
  602    '$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.

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

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

 catch_with_backtrace(:Goal, ?Ball, :Recover)

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

  642catch_with_backtrace(Goal, Ball, Recover) :-
  643    catch(Goal, Ball, Recover),
  644    '$no_lco'.
  645
  646'$no_lco'.

 $recover_and_rethrow(:Goal, +Term)

This goal is used to wrap the catch/3 recover handler if the exception is not supposed to be `catchable'. An example of an uncachable exception is '$aborted', used by abort/0. Note that we cut to ensure that the exception is not delayed forever because the recover handler leaves a choicepoint.

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

 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.

  674setup_call_catcher_cleanup(Setup, _Goal, _Catcher, _Cleanup) :-
  675    sig_atomic(Setup),
  676    '$call_cleanup'.
  677
  678setup_call_cleanup(Setup, _Goal, _Cleanup) :-
  679    sig_atomic(Setup),
  680    '$call_cleanup'.
  681
  682call_cleanup(_Goal, _Cleanup) :-
  683    '$call_cleanup'.
  684
  685
  686		 /*******************************
  687		 *       INITIALIZATION         *
  688		 *******************************/
  689
  690:- meta_predicate
  691    initialization(0, +).  692
  693:- multifile '$init_goal'/3.  694:- dynamic   '$init_goal'/3.

 initialization(:Goal, +When)

Register Goal to be executed if a saved state is restored. In addition, the goal is executed depending on When:

now

Execute immediately

after_load

Execute after loading the file in which it appears. This is initialization/1.

restore_state

Do not execute immediately, but only when restoring the state. Not allowed in a sandboxed environment.

prepare_state

Called before saving a state. Can be used to clean the environment (see also volatile/1) or eagerly execute goals that are normally executed lazily.

program

Works as -g goal goals.

main

Starts the application. Only last declaration is used.

Note that all goals are executed when a program is restored.

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

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

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

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

  937:- public
  938    '$undefined_procedure'/4.  939
  940'$undefined_procedure'(Module, Name, Arity, Action) :-
  941    '$prefix_module'(Module, user, Name/Arity, Pred),
  942    user:exception(undefined_predicate, Pred, Action0),
  943    !,
  944    Action = Action0.
  945'$undefined_procedure'(Module, Name, Arity, Action) :-
  946    \+ current_prolog_flag(autoload, false),
  947    '$autoload'(Module:Name/Arity),
  948    !,
  949    Action = retry.
  950'$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.

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

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

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

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

 1187'$expand_file_search_path'(Spec, Expanded, Cond) :-
 1188    '$option'(access(Access), Cond),
 1189    memberchk(Access, [write,append]),
 1190    !,
 1191    setup_call_cleanup(
 1192	nb_setval('$create_search_directories', true),
 1193	expand_file_search_path(Spec, Expanded),
 1194	nb_delete('$create_search_directories')).
 1195'$expand_file_search_path'(Spec, Expanded, _Cond) :-
 1196    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?

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

 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.

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

 1378:- multifile(user:prolog_file_type/2). 1379:- dynamic(user:prolog_file_type/2). 1380
 1381user:prolog_file_type(pl,       prolog).
 1382user:prolog_file_type(prolog,   prolog).
 1383user:prolog_file_type(qlf,      prolog).
 1384user:prolog_file_type(qlf,      qlf).
 1385user:prolog_file_type(Ext,      executable) :-
 1386    current_prolog_flag(shared_object_extension, Ext).
 1387user:prolog_file_type(dylib,    executable) :-
 1388    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.

 1395'$chk_file'(Spec, _Extensions, _Cond, _Cache, _FullName) :-
 1396    \+ ground(Spec),
 1397    !,
 1398    '$instantiation_error'(Spec).
 1399'$chk_file'(Spec, Extensions, Cond, Cache, FullName) :-
 1400    compound(Spec),
 1401    functor(Spec, _, 1),
 1402    !,
 1403    '$relative_to'(Cond, cwd, CWD),
 1404    '$chk_alias_file'(Spec, Extensions, Cond, Cache, CWD, FullName).
 1405'$chk_file'(Segments, Ext, Cond, Cache, FullName) :-    % allow a/b/...
 1406    \+ atomic(Segments),
 1407    !,
 1408    '$segments_to_atom'(Segments, Atom),
 1409    '$chk_file'(Atom, Ext, Cond, Cache, FullName).
 1410'$chk_file'(File, Exts, Cond, _, FullName) :-
 1411    is_absolute_file_name(File),
 1412    !,
 1413    '$extend_file'(File, Exts, Extended),
 1414    '$file_conditions'(Cond, Extended),
 1415    '$absolute_file_name'(Extended, FullName).
 1416'$chk_file'(File, Exts, Cond, _, FullName) :-
 1417    '$relative_to'(Cond, source, Dir),
 1418    atomic_list_concat([Dir, /, File], AbsFile),
 1419    '$extend_file'(AbsFile, Exts, Extended),
 1420    '$file_conditions'(Cond, Extended),
 1421    !,
 1422    '$absolute_file_name'(Extended, FullName).
 1423'$chk_file'(File, Exts, Cond, _, FullName) :-
 1424    '$extend_file'(File, Exts, Extended),
 1425    '$file_conditions'(Cond, Extended),
 1426    '$absolute_file_name'(Extended, FullName).
 1427
 1428'$segments_to_atom'(Atom, Atom) :-
 1429    atomic(Atom),
 1430    !.
 1431'$segments_to_atom'(Segments, Atom) :-
 1432    '$segments_to_list'(Segments, List, []),
 1433    !,
 1434    atomic_list_concat(List, /, Atom).
 1435
 1436'$segments_to_list'(A/B, H, T) :-
 1437    '$segments_to_list'(A, H, T0),
 1438    '$segments_to_list'(B, T0, T).
 1439'$segments_to_list'(A, [A|T], T) :-
 1440    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.

 1450'$relative_to'(Conditions, Default, Dir) :-
 1451    (   '$option'(relative_to(FileOrDir), Conditions)
 1452    *-> (   exists_directory(FileOrDir)
 1453	->  Dir = FileOrDir
 1454	;   atom_concat(Dir, /, FileOrDir)
 1455	->  true
 1456	;   file_directory_name(FileOrDir, Dir)
 1457	)
 1458    ;   Default == cwd
 1459    ->  '$cwd'(Dir)
 1460    ;   Default == source
 1461    ->  source_location(ContextFile, _Line),
 1462	file_directory_name(ContextFile, Dir)
 1463    ).

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

 1468:- dynamic
 1469    '$search_path_file_cache'/3,    % SHA1, Time, Path
 1470    '$search_path_gc_time'/1.       % Time
 1471:- volatile
 1472    '$search_path_file_cache'/3,
 1473    '$search_path_gc_time'/1. 1474
 1475:- create_prolog_flag(file_search_cache_time, 10, []). 1476
 1477'$chk_alias_file'(Spec, Exts, Cond, true, CWD, FullFile) :-
 1478    !,
 1479    findall(Exp, '$expand_file_search_path'(Spec, Exp, Cond), Expansions),
 1480    current_prolog_flag(emulated_dialect, Dialect),
 1481    Cache = cache(Exts, Cond, CWD, Expansions, Dialect),
 1482    variant_sha1(Spec+Cache, SHA1),
 1483    get_time(Now),
 1484    current_prolog_flag(file_search_cache_time, TimeOut),
 1485    (   '$search_path_file_cache'(SHA1, CachedTime, FullFile),
 1486	CachedTime > Now - TimeOut,
 1487	'$file_conditions'(Cond, FullFile)
 1488    ->  '$search_message'(file_search(cache(Spec, Cond), FullFile))
 1489    ;   '$member'(Expanded, Expansions),
 1490	'$extend_file'(Expanded, Exts, LibFile),
 1491	(   '$file_conditions'(Cond, LibFile),
 1492	    '$absolute_file_name'(LibFile, FullFile),
 1493	    '$cache_file_found'(SHA1, Now, TimeOut, FullFile)
 1494	->  '$search_message'(file_search(found(Spec, Cond), FullFile))
 1495	;   '$search_message'(file_search(tried(Spec, Cond), LibFile)),
 1496	    fail
 1497	)
 1498    ).
 1499'$chk_alias_file'(Spec, Exts, Cond, false, _CWD, FullFile) :-
 1500    '$expand_file_search_path'(Spec, Expanded, Cond),
 1501    '$extend_file'(Expanded, Exts, LibFile),
 1502    '$file_conditions'(Cond, LibFile),
 1503    '$absolute_file_name'(LibFile, FullFile).
 1504
 1505'$cache_file_found'(_, _, TimeOut, _) :-
 1506    TimeOut =:= 0,
 1507    !.
 1508'$cache_file_found'(SHA1, Now, TimeOut, FullFile) :-
 1509    '$search_path_file_cache'(SHA1, Saved, FullFile),
 1510    !,
 1511    (   Now - Saved < TimeOut/2
 1512    ->  true
 1513    ;   retractall('$search_path_file_cache'(SHA1, _, _)),
 1514	asserta('$search_path_file_cache'(SHA1, Now, FullFile))
 1515    ).
 1516'$cache_file_found'(SHA1, Now, TimeOut, FullFile) :-
 1517    'gc_file_search_cache'(TimeOut),
 1518    asserta('$search_path_file_cache'(SHA1, Now, FullFile)).
 1519
 1520'gc_file_search_cache'(TimeOut) :-
 1521    get_time(Now),
 1522    '$search_path_gc_time'(Last),
 1523    Now-Last < TimeOut/2,
 1524    !.
 1525'gc_file_search_cache'(TimeOut) :-
 1526    get_time(Now),
 1527    retractall('$search_path_gc_time'(_)),
 1528    assertz('$search_path_gc_time'(Now)),
 1529    Before is Now - TimeOut,
 1530    (   '$search_path_file_cache'(SHA1, Cached, FullFile),
 1531	Cached < Before,
 1532	retractall('$search_path_file_cache'(SHA1, Cached, FullFile)),
 1533	fail
 1534    ;   true
 1535    ).
 1536
 1537
 1538'$search_message'(Term) :-
 1539    current_prolog_flag(verbose_file_search, true),
 1540    !,
 1541    print_message(informational, Term).
 1542'$search_message'(_).

 $file_conditions(+Condition, +Path)

Verify Path satisfies Condition.

 1549'$file_conditions'(List, File) :-
 1550    is_list(List),
 1551    !,
 1552    \+ ( '$member'(C, List),
 1553	 '$file_condition'(C),
 1554	 \+ '$file_condition'(C, File)
 1555       ).
 1556'$file_conditions'(Map, File) :-
 1557    \+ (  get_dict(Key, Map, Value),
 1558	  C =.. [Key,Value],
 1559	  '$file_condition'(C),
 1560	 \+ '$file_condition'(C, File)
 1561       ).
 1562
 1563'$file_condition'(file_type(directory), File) :-
 1564    !,
 1565    exists_directory(File).
 1566'$file_condition'(file_type(_), File) :-
 1567    !,
 1568    \+ exists_directory(File).
 1569'$file_condition'(access(Accesses), File) :-
 1570    !,
 1571    \+ (  '$one_or_member'(Access, Accesses),
 1572	  \+ access_file(File, Access)
 1573       ).
 1574
 1575'$file_condition'(exists).
 1576'$file_condition'(file_type(_)).
 1577'$file_condition'(access(_)).
 1578
 1579'$extend_file'(File, Exts, FileEx) :-
 1580    '$ensure_extensions'(Exts, File, Fs),
 1581    '$list_to_set'(Fs, FsSet),
 1582    '$member'(FileEx, FsSet).
 1583
 1584'$ensure_extensions'([], _, []).
 1585'$ensure_extensions'([E|E0], F, [FE|E1]) :-
 1586    file_name_extension(F, E, FE),
 1587    '$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).

 1594'$list_to_set'(List, Set) :-
 1595    '$number_list'(List, 1, Numbered),
 1596    sort(1, @=<, Numbered, ONum),
 1597    '$remove_dup_keys'(ONum, NumSet),
 1598    sort(2, @=<, NumSet, ONumSet),
 1599    '$pairs_keys'(ONumSet, Set).
 1600
 1601'$number_list'([], _, []).
 1602'$number_list'([H|T0], N, [H-N|T]) :-
 1603    N1 is N+1,
 1604    '$number_list'(T0, N1, T).
 1605
 1606'$remove_dup_keys'([], []).
 1607'$remove_dup_keys'([H|T0], [H|T]) :-
 1608    H = V-_,
 1609    '$remove_same_key'(T0, V, T1),
 1610    '$remove_dup_keys'(T1, T).
 1611
 1612'$remove_same_key'([V1-_|T0], V, T) :-
 1613    V1 == V,
 1614    !,
 1615    '$remove_same_key'(T0, V, T).
 1616'$remove_same_key'(L, _, L).
 1617
 1618'$pairs_keys'([], []).
 1619'$pairs_keys'([K-_|T0], [K|T]) :-
 1620    '$pairs_keys'(T0, T).
 1621
 1622'$pairs_values'([], []).
 1623'$pairs_values'([_-V|T0], [V|T]) :-
 1624    '$pairs_values'(T0, T).
 1625
 1626/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
 1627Canonicalise the extension list. Old SWI-Prolog   require  `.pl', etc, which
 1628the Quintus compatibility  requests  `pl'.   This  layer  canonicalises  all
 1629extensions to .ext
 1630- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
 1631
 1632'$canonicalise_extensions'([], []) :- !.
 1633'$canonicalise_extensions'([H|T], [CH|CT]) :-
 1634    !,
 1635    '$must_be'(atom, H),
 1636    '$canonicalise_extension'(H, CH),
 1637    '$canonicalise_extensions'(T, CT).
 1638'$canonicalise_extensions'(E, [CE]) :-
 1639    '$canonicalise_extension'(E, CE).
 1640
 1641'$canonicalise_extension'('', '') :- !.
 1642'$canonicalise_extension'(DotAtom, DotAtom) :-
 1643    sub_atom(DotAtom, 0, _, _, '.'),
 1644    !.
 1645'$canonicalise_extension'(Atom, DotAtom) :-
 1646    atom_concat('.', Atom, DotAtom).
 1647
 1648
 1649		/********************************
 1650		*            CONSULT            *
 1651		*********************************/
 1652
 1653:- dynamic
 1654    user:library_directory/1,
 1655    user:prolog_load_file/2. 1656:- multifile
 1657    user:library_directory/1,
 1658    user:prolog_load_file/2. 1659
 1660:- prompt(_, '|: '). 1661
 1662:- thread_local
 1663    '$compilation_mode_store'/1,    % database, wic, qlf
 1664    '$directive_mode_store'/1.      % database, wic, qlf
 1665:- volatile
 1666    '$compilation_mode_store'/1,
 1667    '$directive_mode_store'/1. 1668
 1669'$compilation_mode'(Mode) :-
 1670    (   '$compilation_mode_store'(Val)
 1671    ->  Mode = Val
 1672    ;   Mode = database
 1673    ).
 1674
 1675'$set_compilation_mode'(Mode) :-
 1676    retractall('$compilation_mode_store'(_)),
 1677    assertz('$compilation_mode_store'(Mode)).
 1678
 1679'$compilation_mode'(Old, New) :-
 1680    '$compilation_mode'(Old),
 1681    (   New == Old
 1682    ->  true
 1683    ;   '$set_compilation_mode'(New)
 1684    ).
 1685
 1686'$directive_mode'(Mode) :-
 1687    (   '$directive_mode_store'(Val)
 1688    ->  Mode = Val
 1689    ;   Mode = database
 1690    ).
 1691
 1692'$directive_mode'(Old, New) :-
 1693    '$directive_mode'(Old),
 1694    (   New == Old
 1695    ->  true
 1696    ;   '$set_directive_mode'(New)
 1697    ).
 1698
 1699'$set_directive_mode'(Mode) :-
 1700    retractall('$directive_mode_store'(_)),
 1701    assertz('$directive_mode_store'(Mode)).