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

 dynamic +Spec is det

 multifile +Spec is det

 module_transparent +Spec is det

 discontiguous +Spec is det

 volatile +Spec is det

 thread_local +Spec is det

 noprofile(+Spec) is det

 public +Spec is det

 non_terminal(+Spec) is det

Predicate versions of standard directives that set predicate attributes. These predicates bail out with an error on the first failure (typically permission errors).

 $iso(+Spec) is det

Set the ISO flag. This defines that the predicate cannot be redefined inside a module.

 $clausable(+Spec) is det

Specify that we can run clause/2 on a predicate, even if it is static. ISO specifies that public also plays this role. in SWI, public means that the predicate can be called, even if we cannot find a reference to it.

 $hide(+Spec) is det

Specify that the predicate cannot be seen in the debugger.

  116dynamic(Spec)            :- '$set_pattr'(Spec, pred, dynamic(true)).
  117multifile(Spec)          :- '$set_pattr'(Spec, pred, multifile(true)).
  118module_transparent(Spec) :- '$set_pattr'(Spec, pred, transparent(true)).
  119discontiguous(Spec)      :- '$set_pattr'(Spec, pred, discontiguous(true)).
  120volatile(Spec)           :- '$set_pattr'(Spec, pred, volatile(true)).
  121thread_local(Spec)       :- '$set_pattr'(Spec, pred, thread_local(true)).
  122noprofile(Spec)          :- '$set_pattr'(Spec, pred, noprofile(true)).
  123public(Spec)             :- '$set_pattr'(Spec, pred, public(true)).
  124non_terminal(Spec)       :- '$set_pattr'(Spec, pred, non_terminal(true)).
  125'$iso'(Spec)             :- '$set_pattr'(Spec, pred, iso(true)).
  126'$clausable'(Spec)       :- '$set_pattr'(Spec, pred, clausable(true)).
  127'$hide'(Spec)            :- '$set_pattr'(Spec, pred, trace(false)).
  128
  129'$set_pattr'(M:Pred, How, Attr) :-
  130    '$set_pattr'(Pred, M, How, Attr).

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

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

  136'$set_pattr'(X, _, _, _) :-
  137    var(X),
  138    '$uninstantiation_error'(X).
  139'$set_pattr'(as(Spec,Options), M, How, Attr0) :-
  140    !,
  141    '$attr_options'(Options, Attr0, Attr),
  142    '$set_pattr'(Spec, M, How, Attr).
  143'$set_pattr'([], _, _, _) :- !.
  144'$set_pattr'([H|T], M, How, Attr) :-           % ISO
  145    !,
  146    '$set_pattr'(H, M, How, Attr),
  147    '$set_pattr'(T, M, How, Attr).
  148'$set_pattr'((A,B), M, How, Attr) :-           % ISO and traditional
  149    !,
  150    '$set_pattr'(A, M, How, Attr),
  151    '$set_pattr'(B, M, How, Attr).
  152'$set_pattr'(M:T, _, How, Attr) :-
  153    !,
  154    '$set_pattr'(T, M, How, Attr).
  155'$set_pattr'(PI, M, _, []) :-
  156    !,
  157    '$pi_head'(M:PI, Pred),
  158    (   '$get_predicate_attribute'(Pred, incremental, 1)
  159    ->  '$wrap_incremental'(Pred)
  160    ;   '$unwrap_incremental'(Pred)
  161    ).
  162'$set_pattr'(A, M, How, [O|OT]) :-
  163    !,
  164    '$set_pattr'(A, M, How, O),
  165    '$set_pattr'(A, M, How, OT).
  166'$set_pattr'(A, M, pred, Attr) :-
  167    !,
  168    Attr =.. [Name,Val],
  169    '$set_predicate_attribute'(M:A, Name, Val).
  170'$set_pattr'(A, M, directive, Attr) :-
  171    !,
  172    Attr =.. [Name,Val],
  173    catch('$set_predicate_attribute'(M:A, Name, Val),
  174          error(E, _),
  175          print_message(error, error(E, context((Name)/1,_)))).
  176
  177'$attr_options'(Var, _, _) :-
  178    var(Var),
  179    !,
  180    '$uninstantiation_error'(Var).
  181'$attr_options'((A,B), Attr0, Attr) :-
  182    !,
  183    '$attr_options'(A, Attr0, Attr1),
  184    '$attr_options'(B, Attr1, Attr).
  185'$attr_options'(Opt, Attr0, Attrs) :-
  186    '$must_be'(ground, Opt),
  187    (   '$attr_option'(Opt, AttrX)
  188    ->  (   is_list(Attr0)
  189        ->  '$join_attrs'(AttrX, Attr0, Attrs)
  190        ;   '$join_attrs'(AttrX, [Attr0], Attrs)
  191        )
  192    ;   '$domain_error'(predicate_option, Opt)
  193    ).
  194
  195'$join_attrs'(Attr, Attrs, Attrs) :-
  196    memberchk(Attr, Attrs),
  197    !.
  198'$join_attrs'(Attr, Attrs, Attrs) :-
  199    Attr =.. [Name,Value],
  200    Gen =.. [Name,Existing],
  201    memberchk(Gen, Attrs),
  202    !,
  203    throw(error(conflict_error(Name, Value, Existing), _)).
  204'$join_attrs'(Attr, Attrs0, Attrs) :-
  205    '$append'(Attrs0, [Attr], Attrs).
  206
  207'$attr_option'(incremental, incremental(true)).
  208'$attr_option'(opaque, incremental(false)).
  209'$attr_option'(abstract(Level), abstract(true)) :-
  210    '$must_be'(between(0,0), Level).
  211'$attr_option'(volatile, volatile(true)).
  212'$attr_option'(multifile, multifile(true)).
  213'$attr_option'(discontiguous, discontiguous(true)).
  214'$attr_option'(shared, thread_local(false)).
  215'$attr_option'(local, thread_local(true)).
  216'$attr_option'(private, thread_local(true)).

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

  225'$pattr_directive'(dynamic(Spec), M) :-
  226    '$set_pattr'(Spec, M, directive, dynamic(true)).
  227'$pattr_directive'(multifile(Spec), M) :-
  228    '$set_pattr'(Spec, M, directive, multifile(true)).
  229'$pattr_directive'(module_transparent(Spec), M) :-
  230    '$set_pattr'(Spec, M, directive, transparent(true)).
  231'$pattr_directive'(discontiguous(Spec), M) :-
  232    '$set_pattr'(Spec, M, directive, discontiguous(true)).
  233'$pattr_directive'(volatile(Spec), M) :-
  234    '$set_pattr'(Spec, M, directive, volatile(true)).
  235'$pattr_directive'(thread_local(Spec), M) :-
  236    '$set_pattr'(Spec, M, directive, thread_local(true)).
  237'$pattr_directive'(noprofile(Spec), M) :-
  238    '$set_pattr'(Spec, M, directive, noprofile(true)).
  239'$pattr_directive'(public(Spec), M) :-
  240    '$set_pattr'(Spec, M, directive, public(true)).
  241
  242:- '$iso'(((dynamic)/1, (multifile)/1, (discontiguous)/1)).  243
  244
  245                /********************************
  246                *       CALLING, CONTROL        *
  247                *********************************/
  248
  249:- noprofile((call/1,
  250              catch/3,
  251              once/1,
  252              ignore/1,
  253              call_cleanup/2,
  254              call_cleanup/3,
  255              setup_call_cleanup/3,
  256              setup_call_catcher_cleanup/4)).  257
  258:- meta_predicate
  259    ';'(0,0),
  260    ','(0,0),
  261    @(0,+),
  262    call(0),
  263    call(1,?),
  264    call(2,?,?),
  265    call(3,?,?,?),
  266    call(4,?,?,?,?),
  267    call(5,?,?,?,?,?),
  268    call(6,?,?,?,?,?,?),
  269    call(7,?,?,?,?,?,?,?),
  270    not(0),
  271    \+(0),
  272    '->'(0,0),
  273    '*->'(0,0),
  274    once(0),
  275    ignore(0),
  276    catch(0,?,0),
  277    reset(0,?,-),
  278    setup_call_cleanup(0,0,0),
  279    setup_call_catcher_cleanup(0,0,?,0),
  280    call_cleanup(0,0),
  281    call_cleanup(0,?,0),
  282    catch_with_backtrace(0,?,0),
  283    '$meta_call'(0).  284
  285:- '$iso'((call/1, (\+)/1, once/1, (;)/2, (',')/2, (->)/2, catch/3)).  286
  287% The control structures are always compiled, both   if they appear in a
  288% clause body and if they are handed  to   call/1.  The only way to call
  289% these predicates is by means of  call/2..   In  that case, we call the
  290% hole control structure again to get it compiled by call/1 and properly
  291% deal  with  !,  etc.  Another  reason  for  having  these  things   as
  292% predicates is to be able to define   properties for them, helping code
  293% analyzers.
  294
  295(M0:If ; M0:Then) :- !, call(M0:(If ; Then)).
  296(M1:If ; M2:Then) :-    call(M1:(If ; M2:Then)).
  297(G1   , G2)       :-    call((G1   , G2)).
  298(If  -> Then)     :-    call((If  -> Then)).
  299(If *-> Then)     :-    call((If *-> Then)).
  300@(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.

  314'$meta_call'(M:G) :-
  315    prolog_current_choice(Ch),
  316    '$meta_call'(G, M, Ch).
  317
  318'$meta_call'(Var, _, _) :-
  319    var(Var),
  320    !,
  321    '$instantiation_error'(Var).
  322'$meta_call'((A,B), M, Ch) :-
  323    !,
  324    '$meta_call'(A, M, Ch),
  325    '$meta_call'(B, M, Ch).
  326'$meta_call'((I->T;E), M, Ch) :-
  327    !,
  328    (   prolog_current_choice(Ch2),
  329        '$meta_call'(I, M, Ch2)
  330    ->  '$meta_call'(T, M, Ch)
  331    ;   '$meta_call'(E, M, Ch)
  332    ).
  333'$meta_call'((I*->T;E), M, Ch) :-
  334    !,
  335    (   prolog_current_choice(Ch2),
  336        '$meta_call'(I, M, Ch2)
  337    *-> '$meta_call'(T, M, Ch)
  338    ;   '$meta_call'(E, M, Ch)
  339    ).
  340'$meta_call'((I->T), M, Ch) :-
  341    !,
  342    (   prolog_current_choice(Ch2),
  343        '$meta_call'(I, M, Ch2)
  344    ->  '$meta_call'(T, M, Ch)
  345    ).
  346'$meta_call'((I*->T), M, Ch) :-
  347    !,
  348    prolog_current_choice(Ch2),
  349    '$meta_call'(I, M, Ch2),
  350    '$meta_call'(T, M, Ch).
  351'$meta_call'((A;B), M, Ch) :-
  352    !,
  353    (   '$meta_call'(A, M, Ch)
  354    ;   '$meta_call'(B, M, Ch)
  355    ).
  356'$meta_call'(\+(G), M, _) :-
  357    !,
  358    prolog_current_choice(Ch),
  359    \+ '$meta_call'(G, M, Ch).
  360'$meta_call'(call(G), M, _) :-
  361    !,
  362    prolog_current_choice(Ch),
  363    '$meta_call'(G, M, Ch).
  364'$meta_call'(M:G, _, Ch) :-
  365    !,
  366    '$meta_call'(G, M, Ch).
  367'$meta_call'(!, _, Ch) :-
  368    prolog_cut_to(Ch).
  369'$meta_call'(G, M, _Ch) :-
  370    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..

  386:- '$iso'((call/2,
  387           call/3,
  388           call/4,
  389           call/5,
  390           call/6,
  391           call/7,
  392           call/8)).  393
  394call(Goal) :-                           % make these available as predicates
  395    Goal.
  396call(Goal, A) :-
  397    call(Goal, A).
  398call(Goal, A, B) :-
  399    call(Goal, A, B).
  400call(Goal, A, B, C) :-
  401    call(Goal, A, B, C).
  402call(Goal, A, B, C, D) :-
  403    call(Goal, A, B, C, D).
  404call(Goal, A, B, C, D, E) :-
  405    call(Goal, A, B, C, D, E).
  406call(Goal, A, B, C, D, E, F) :-
  407    call(Goal, A, B, C, D, E, F).
  408call(Goal, A, B, C, D, E, F, G) :-
  409    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.

  416not(Goal) :-
  417    \+ Goal.

 \+ :Goal is semidet

Predicate version that allows for meta-calling.

  423\+ Goal :-
  424    \+ Goal.

 once(:Goal) is semidet

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

  430once(Goal) :-
  431    Goal,
  432    !.

 ignore(:Goal) is det

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

  439ignore(Goal) :-
  440    Goal,
  441    !.
  442ignore(_Goal).
  443
  444:- '$iso'((false/0)).

 false

Synonym for fail/0, providing a declarative reading.

  450false :-
  451    fail.

 catch(:Goal, +Catcher, :Recover)

ISO compliant exception handling.

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

 prolog_cut_to(+Choice)

Cut all choice points after Choice

  464prolog_cut_to(_Choice) :-
  465    '$cut'.                         % Maps to I_CUTCHP

 reset(:Goal, ?Ball, -Continue)

Delimited continuation support.

  471reset(_Goal, _Ball, _Cont) :-
  472    '$reset'.

 shift(+Ball)

Shift control back to the enclosing reset/3

  478shift(Ball) :-
  479    '$shift'(Ball).

 call_continuation(+Continuation:list)

Call a continuation as created by shift/1. The continuation is a list of '$cont$'(Clause, PC, EnvironmentArg, ...) structures. The predicate '$call_one_tail_body'/1 creates a frame from the continuation and calls this.

Note that we can technically also push the entire continuation onto the environment and call it. Doing it incrementally as below exploits last-call optimization and therefore possible quadratic expansion of the continuation.

  493call_continuation([]).
  494call_continuation([TB|Rest]) :-
  495    (   Rest == []
  496    ->  '$call_continuation'(TB)
  497    ;   '$call_continuation'(TB),
  498        call_continuation(Rest)
  499    ).

 catch_with_backtrace(:Goal, ?Ball, :Recover)

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

  506catch_with_backtrace(Goal, Ball, Recover) :-
  507    catch(Goal, Ball, Recover),
  508    '$no_lco'.
  509
  510'$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.

  520:- public '$recover_and_rethrow'/2.  521
  522'$recover_and_rethrow'(Goal, Exception) :-
  523    call_cleanup(Goal, throw(Exception)),
  524    !.

 setup_call_cleanup(:Setup, :Goal, :Cleanup)

 setup_call_catcher_cleanup(:Setup, :Goal, +Catcher, :Cleanup)

 call_cleanup(:Goal, :Cleanup)

 call_cleanup(:Goal, +Catcher, :Cleanup)

Call Cleanup once after Goal is finished (deterministic success, failure, exception or cut). The call to '$call_cleanup' is translated to I_CALLCLEANUP. This instruction relies on the exact stack layout left by setup_call_catcher_cleanup/4. Also the predicate name is used by the kernel cleanup mechanism and can only be changed together with the kernel.

  539setup_call_catcher_cleanup(Setup, _Goal, _Catcher, _Cleanup) :-
  540    '$sig_atomic'(Setup),
  541    '$call_cleanup'.
  542
  543setup_call_cleanup(Setup, Goal, Cleanup) :-
  544    setup_call_catcher_cleanup(Setup, Goal, _Catcher, Cleanup).
  545
  546call_cleanup(Goal, Cleanup) :-
  547    setup_call_catcher_cleanup(true, Goal, _Catcher, Cleanup).
  548
  549call_cleanup(Goal, Catcher, Cleanup) :-
  550    setup_call_catcher_cleanup(true, Goal, Catcher, Cleanup).
  551
  552                 /*******************************
  553                 *       INITIALIZATION         *
  554                 *******************************/
  555
  556:- meta_predicate
  557    initialization(0, +).  558
  559:- multifile '$init_goal'/3.  560:- 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.

  586initialization(Goal, When) :-
  587    '$must_be'(oneof(atom, initialization_type,
  588                     [ now,
  589                       after_load,
  590                       restore,
  591                       restore_state,
  592                       prepare_state,
  593                       program,
  594                       main
  595                     ]), When),
  596    '$initialization_context'(Source, Ctx),
  597    '$initialization'(When, Goal, Source, Ctx).
  598
  599'$initialization'(now, Goal, _Source, Ctx) :-
  600    '$run_init_goal'(Goal, Ctx),
  601    '$compile_init_goal'(-, Goal, Ctx).
  602'$initialization'(after_load, Goal, Source, Ctx) :-
  603    (   Source \== (-)
  604    ->  '$compile_init_goal'(Source, Goal, Ctx)
  605    ;   throw(error(context_error(nodirective,
  606                                  initialization(Goal, after_load)),
  607                    _))
  608    ).
  609'$initialization'(restore, Goal, Source, Ctx) :- % deprecated
  610    '$initialization'(restore_state, Goal, Source, Ctx).
  611'$initialization'(restore_state, Goal, _Source, Ctx) :-
  612    (   \+ current_prolog_flag(sandboxed_load, true)
  613    ->  '$compile_init_goal'(-, Goal, Ctx)
  614    ;   '$permission_error'(register, initialization(restore), Goal)
  615    ).
  616'$initialization'(prepare_state, Goal, _Source, Ctx) :-
  617    (   \+ current_prolog_flag(sandboxed_load, true)
  618    ->  '$compile_init_goal'(when(prepare_state), Goal, Ctx)
  619    ;   '$permission_error'(register, initialization(restore), Goal)
  620    ).
  621'$initialization'(program, Goal, _Source, Ctx) :-
  622    (   \+ current_prolog_flag(sandboxed_load, true)
  623    ->  '$compile_init_goal'(when(program), Goal, Ctx)
  624    ;   '$permission_error'(register, initialization(restore), Goal)
  625    ).
  626'$initialization'(main, Goal, _Source, Ctx) :-
  627    (   \+ current_prolog_flag(sandboxed_load, true)
  628    ->  '$compile_init_goal'(when(main), Goal, Ctx)
  629    ;   '$permission_error'(register, initialization(restore), Goal)
  630    ).
  631
  632
  633'$compile_init_goal'(Source, Goal, Ctx) :-
  634    atom(Source),
  635    Source \== (-),
  636    !,
  637    '$store_admin_clause'(system:'$init_goal'(Source, Goal, Ctx),
  638                          _Layout, Source, Ctx).
  639'$compile_init_goal'(Source, Goal, Ctx) :-
  640    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.

  652'$run_initialization'(_, loaded, _) :- !.
  653'$run_initialization'(File, _Action, Options) :-
  654    '$run_initialization'(File, Options).
  655
  656'$run_initialization'(File, Options) :-
  657    setup_call_cleanup(
  658        '$start_run_initialization'(Options, Restore),
  659        '$run_initialization_2'(File),
  660        '$end_run_initialization'(Restore)).
  661
  662'$start_run_initialization'(Options, OldSandBoxed) :-
  663    '$push_input_context'(initialization),
  664    '$set_sandboxed_load'(Options, OldSandBoxed).
  665'$end_run_initialization'(OldSandBoxed) :-
  666    set_prolog_flag(sandboxed_load, OldSandBoxed),
  667    '$pop_input_context'.
  668
  669'$run_initialization_2'(File) :-
  670    (   '$init_goal'(File, Goal, Ctx),
  671        File \= when(_),
  672        '$run_init_goal'(Goal, Ctx),
  673        fail
  674    ;   true
  675    ).
  676
  677'$run_init_goal'(Goal, Ctx) :-
  678    (   catch_with_backtrace('$run_init_goal'(Goal), E,
  679                             '$initialization_error'(E, Goal, Ctx))
  680    ->  true
  681    ;   '$initialization_failure'(Goal, Ctx)
  682    ).
  683
  684:- multifile prolog:sandbox_allowed_goal/1.  685
  686'$run_init_goal'(Goal) :-
  687    current_prolog_flag(sandboxed_load, false),
  688    !,
  689    call(Goal).
  690'$run_init_goal'(Goal) :-
  691    prolog:sandbox_allowed_goal(Goal),
  692    call(Goal).
  693
  694'$initialization_context'(Source, Ctx) :-
  695    (   source_location(File, Line)
  696    ->  Ctx = File:Line,
  697        '$input_context'(Context),
  698        '$top_file'(Context, File, Source)
  699    ;   Ctx = (-),
  700        File = (-)
  701    ).
  702
  703'$top_file'([input(include, F1, _, _)|T], _, F) :-
  704    !,
  705    '$top_file'(T, F1, F).
  706'$top_file'(_, F, F).
  707
  708
  709'$initialization_error'(E, Goal, Ctx) :-
  710    print_message(error, initialization_error(Goal, E, Ctx)).
  711
  712'$initialization_failure'(Goal, Ctx) :-
  713    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

  721:- public '$clear_source_admin'/1.  722
  723'$clear_source_admin'(File) :-
  724    retractall('$init_goal'(_, _, File:_)),
  725    retractall('$load_context_module'(File, _, _)),
  726    retractall('$resolved_source_path'(_, File)).
  727
  728
  729                 /*******************************
  730                 *            STREAM            *
  731                 *******************************/
  732
  733:- '$iso'(stream_property/2).  734stream_property(Stream, Property) :-
  735    nonvar(Stream),
  736    nonvar(Property),
  737    !,
  738    '$stream_property'(Stream, Property).
  739stream_property(Stream, Property) :-
  740    nonvar(Stream),
  741    !,
  742    '$stream_properties'(Stream, Properties),
  743    '$member'(Property, Properties).
  744stream_property(Stream, Property) :-
  745    nonvar(Property),
  746    !,
  747    (   Property = alias(Alias),
  748        atom(Alias)
  749    ->  '$alias_stream'(Alias, Stream)
  750    ;   '$streams_properties'(Property, Pairs),
  751        '$member'(Stream-Property, Pairs)
  752    ).
  753stream_property(Stream, Property) :-
  754    '$streams_properties'(Property, Pairs),
  755    '$member'(Stream-Properties, Pairs),
  756    '$member'(Property, Properties).
  757
  758
  759                /********************************
  760                *            MODULES            *
  761                *********************************/
  762
  763%       '$prefix_module'(+Module, +Context, +Term, -Prefixed)
  764%       Tags `Term' with `Module:' if `Module' is not the context module.
  765
  766'$prefix_module'(Module, Module, Head, Head) :- !.
  767'$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'.

  773default_module(Me, Super) :-
  774    (   atom(Me)
  775    ->  (   var(Super)
  776        ->  '$default_module'(Me, Super)
  777        ;   '$default_module'(Me, Super), !
  778        )
  779    ;   '$type_error'(module, Me)
  780    ).
  781
  782'$default_module'(Me, Me).
  783'$default_module'(Me, Super) :-
  784    import_module(Me, S),
  785    '$default_module'(S, Super).
  786
  787
  788                /********************************
  789                *      TRACE AND EXCEPTIONS     *
  790                *********************************/
  791
  792:- dynamic   user:exception/3.  793:- multifile user:exception/3.

 $undefined_procedure(+Module, +Name, +Arity, -Action) is det

This predicate is called from C on undefined predicates. First allows the user to take care of it using exception/3. Else try to give a DWIM warning. Otherwise fail. C will print an error message.

  802:- public
  803    '$undefined_procedure'/4.  804
  805'$undefined_procedure'(Module, Name, Arity, Action) :-
  806    '$prefix_module'(Module, user, Name/Arity, Pred),
  807    user:exception(undefined_predicate, Pred, Action0),
  808    !,
  809    Action = Action0.
  810'$undefined_procedure'(Module, Name, Arity, Action) :-
  811    current_prolog_flag(autoload, true),
  812    '$autoload'(Module, Name, Arity),
  813    !,
  814    Action = retry.
  815'$undefined_procedure'(_, _, _, error).
  816
  817'$autoload'(Module, Name, Arity) :-
  818    source_location(File, _Line),
  819    !,
  820    setup_call_cleanup(
  821        '$start_aux'(File, Context),
  822        '$autoload2'(Module, Name, Arity),
  823        '$end_aux'(File, Context)).
  824'$autoload'(Module, Name, Arity) :-
  825    '$autoload2'(Module, Name, Arity).
  826
  827'$autoload2'(Module, Name, Arity) :-
  828    '$find_library'(Module, Name, Arity, LoadModule, Library),
  829    functor(Head, Name, Arity),
  830    '$update_autoload_level'([autoload(true)], Old),
  831    (   current_prolog_flag(verbose_autoload, true)
  832    ->  Level = informational
  833    ;   Level = silent
  834    ),
  835    print_message(Level, autoload(Module:Name/Arity, Library)),
  836    '$compilation_mode'(OldComp, database),
  837    (   Module == LoadModule
  838    ->  ensure_loaded(Module:Library)
  839    ;   (   '$get_predicate_attribute'(LoadModule:Head, defined, 1),
  840            \+ '$loading'(Library)
  841        ->  Module:import(LoadModule:Name/Arity)
  842        ;   use_module(Module:Library, [Name/Arity])
  843        )
  844    ),
  845    '$set_compilation_mode'(OldComp),
  846    '$set_autoload_level'(Old),
  847    '$c_current_predicate'(_, Module:Head).

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

  858'$loading'(Library) :-
  859    current_prolog_flag(threads, true),
  860    '$loading_file'(FullFile, _Queue, _LoadThread),
  861    file_name_extension(Library, _, FullFile),
  862    !.
  863
  864%        handle debugger 'w', 'p' and <N> depth options.
  865
  866'$set_debugger_write_options'(write) :-
  867    !,
  868    create_prolog_flag(debugger_write_options,
  869                       [ quoted(true),
  870                         attributes(dots),
  871                         spacing(next_argument)
  872                       ], []).
  873'$set_debugger_write_options'(print) :-
  874    !,
  875    create_prolog_flag(debugger_write_options,
  876                       [ quoted(true),
  877                         portray(true),
  878                         max_depth(10),
  879                         attributes(portray),
  880                         spacing(next_argument)
  881                       ], []).
  882'$set_debugger_write_options'(Depth) :-
  883    current_prolog_flag(debugger_write_options, Options0),
  884    (   '$select'(max_depth(_), Options0, Options)
  885    ->  true
  886    ;   Options = Options0
  887    ),
  888    create_prolog_flag(debugger_write_options,
  889                       [max_depth(Depth)|Options], []).
  890
  891
  892                /********************************
  893                *        SYSTEM MESSAGES        *
  894                *********************************/

 $confirm(Spec)

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

  901'$confirm'(Spec) :-
  902    print_message(query, Spec),
  903    between(0, 5, _),
  904        get_single_char(Answer),
  905        (   '$in_reply'(Answer, 'yYjJ \n')
  906        ->  !,
  907            print_message(query, if_tty([yes-[]]))
  908        ;   '$in_reply'(Answer, 'nN')
  909        ->  !,
  910            print_message(query, if_tty([no-[]])),
  911            fail
  912        ;   print_message(help, query(confirm)),
  913            fail
  914        ).
  915
  916'$in_reply'(Code, Atom) :-
  917    char_code(Char, Code),
  918    sub_atom(Atom, _, _, _, Char),
  919    !.
  920
  921:- dynamic
  922    user:portray/1.  923:- multifile
  924    user:portray/1.  925
  926
  927                 /*******************************
  928                 *       FILE_SEARCH_PATH       *
  929                 *******************************/
  930
  931:- dynamic user:file_search_path/2.  932:- multifile user:file_search_path/2.  933
  934user:(file_search_path(library, Dir) :-
  935        library_directory(Dir)).
  936user:file_search_path(swi, Home) :-
  937    current_prolog_flag(home, Home).
  938user:file_search_path(foreign, swi(ArchLib)) :-
  939    current_prolog_flag(arch, Arch),
  940    atom_concat('lib/', Arch, ArchLib).
  941user:file_search_path(foreign, swi(SoLib)) :-
  942    (   current_prolog_flag(windows, true)
  943    ->  SoLib = bin
  944    ;   SoLib = lib
  945    ).
  946user:file_search_path(path, Dir) :-
  947    getenv('PATH', Path),
  948    (   current_prolog_flag(windows, true)
  949    ->  atomic_list_concat(Dirs, (;), Path)
  950    ;   atomic_list_concat(Dirs, :, Path)
  951    ),
  952    '$member'(Dir, Dirs).
  953user:file_search_path(user_app_data, Dir) :-
  954    '$xdg_prolog_directory'(data, Dir).
  955user:file_search_path(common_app_data, Dir) :-
  956    '$xdg_prolog_directory'(common_data, Dir).
  957user:file_search_path(user_app_config, Dir) :-
  958    '$xdg_prolog_directory'(config, Dir).
  959user:file_search_path(common_app_config, Dir) :-
  960    '$xdg_prolog_directory'(common_config, Dir).
  961user:file_search_path(app_data, user_app_data('.')).
  962user:file_search_path(app_data, common_app_data('.')).
  963user:file_search_path(app_config, user_app_config('.')).
  964user:file_search_path(app_config, common_app_config('.')).
  965% backward compatibility
  966user:file_search_path(app_preferences, user_app_config('.')).
  967user:file_search_path(user_profile, app_preferences('.')).
  968
  969'$xdg_prolog_directory'(Which, Dir) :-
  970    '$xdg_directory'(Which, XDGDir),
  971    '$make_config_dir'(XDGDir),
  972    '$ensure_slash'(XDGDir, XDGDirS),
  973    atom_concat(XDGDirS, 'swi-prolog', Dir),
  974    '$make_config_dir'(Dir).
  975
  976% config
  977'$xdg_directory'(config, Home) :-
  978    current_prolog_flag(windows, true),
  979    catch(win_folder(appdata, Home), _, fail),
  980    !.
  981'$xdg_directory'(config, Home) :-
  982    getenv('XDG_CONFIG_HOME', Home).
  983'$xdg_directory'(config, Home) :-
  984    expand_file_name('~/.config', [Home]).
  985% data
  986'$xdg_directory'(data, Home) :-
  987    current_prolog_flag(windows, true),
  988    catch(win_folder(local_appdata, Home), _, fail),
  989    !.
  990'$xdg_directory'(data, Home) :-
  991    getenv('XDG_DATA_HOME', Home).
  992'$xdg_directory'(data, Home) :-
  993    expand_file_name('~/.local', [Local]),
  994    '$make_config_dir'(Local),
  995    atom_concat(Local, '/share', Home),
  996    '$make_config_dir'(Home).
  997% common data
  998'$xdg_directory'(common_data, Dir) :-
  999    current_prolog_flag(windows, true),
 1000    catch(win_folder(common_appdata, Dir), _, fail),
 1001    !.
 1002'$xdg_directory'(common_data, Dir) :-
 1003    '$existing_dir_from_env_path'('XDG_DATA_DIRS',
 1004                                  [ '/usr/local/share',
 1005                                    '/usr/share'
 1006                                  ],
 1007                                  Dir).
 1008% common config
 1009'$xdg_directory'(common_data, Dir) :-
 1010    current_prolog_flag(windows, true),
 1011    catch(win_folder(common_appdata, Dir), _, fail),
 1012    !.
 1013'$xdg_directory'(common_data, Dir) :-
 1014    '$existing_dir_from_env_path'('XDG_CONFIG_DIRS', ['/etc/xdg'], Dir).
 1015
 1016'$existing_dir_from_env_path'(Env, Defaults, Dir) :-
 1017    (   getenv(Env, Path)
 1018    ->  '$path_sep'(Sep),
 1019        atomic_list_concat(Dirs, Sep, Path)
 1020    ;   Dirs = Defaults
 1021    ),
 1022    '$member'(Dir, Dirs),
 1023    exists_directory(Dir).
 1024
 1025'$path_sep'(Char) :-
 1026    (   current_prolog_flag(windows, true)
 1027    ->  Char = ';'
 1028    ;   Char = ':'
 1029    ).
 1030
 1031'$make_config_dir'(Dir) :-
 1032    exists_directory(Dir),
 1033    !.
 1034'$make_config_dir'(Dir) :-
 1035    file_directory_name(Dir, Parent),
 1036    '$my_file'(Parent),
 1037    catch(make_directory(Dir), _, fail).
 1038
 1039'$ensure_slash'(Dir, DirS) :-
 1040    (   sub_atom(Dir, _, _, 0, /)
 1041    ->  DirS = Dir
 1042    ;   atom_concat(Dir, /, DirS)
 1043    ).

 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?

 1052expand_file_search_path(Spec, Expanded) :-
 1053    catch('$expand_file_search_path'(Spec, Expanded, 0, []),
 1054          loop(Used),
 1055          throw(error(loop_error(Spec), file_search(Used)))).
 1056
 1057'$expand_file_search_path'(Spec, Expanded, N, Used) :-
 1058    functor(Spec, Alias, 1),
 1059    !,
 1060    user:file_search_path(Alias, Exp0),
 1061    NN is N + 1,
 1062    (   NN > 16
 1063    ->  throw(loop(Used))
 1064    ;   true
 1065    ),
 1066    '$expand_file_search_path'(Exp0, Exp1, NN, [Alias=Exp0|Used]),
 1067    arg(1, Spec, Segments),
 1068    '$segments_to_atom'(Segments, File),
 1069    '$make_path'(Exp1, File, Expanded).
 1070'$expand_file_search_path'(Spec, Path, _, _) :-
 1071    '$segments_to_atom'(Spec, Path).
 1072
 1073'$make_path'(Dir, '.', Path) :-
 1074    !,
 1075    Path = Dir.
 1076'$make_path'(Dir, File, Path) :-
 1077    sub_atom(Dir, _, _, 0, /),
 1078    !,
 1079    atom_concat(Dir, File, Path).
 1080'$make_path'(Dir, File, Path) :-
 1081    atomic_list_concat([Dir, /, File], Path).
 1082
 1083
 1084                /********************************
 1085                *         FILE CHECKING         *
 1086                *********************************/

 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.

 1097absolute_file_name(Spec, Options, Path) :-
 1098    '$is_options'(Options),
 1099    \+ '$is_options'(Path),
 1100    !,
 1101    absolute_file_name(Spec, Path, Options).
 1102absolute_file_name(Spec, Path, Options) :-
 1103    '$must_be'(options, Options),
 1104                    % get the valid extensions
 1105    (   '$select_option'(extensions(Exts), Options, Options1)
 1106    ->  '$must_be'(list, Exts)
 1107    ;   '$option'(file_type(Type), Options)
 1108    ->  '$must_be'(atom, Type),
 1109        '$file_type_extensions'(Type, Exts),
 1110        Options1 = Options
 1111    ;   Options1 = Options,
 1112        Exts = ['']
 1113    ),
 1114    '$canonicalise_extensions'(Exts, Extensions),
 1115                    % unless specified otherwise, ask regular file
 1116    (   nonvar(Type)
 1117    ->  Options2 = Options1
 1118    ;   '$merge_options'(_{file_type:regular}, Options1, Options2)
 1119    ),
 1120                    % Det or nondet?
 1121    (   '$select_option'(solutions(Sols), Options2, Options3)
 1122    ->  '$must_be'(oneof(atom, solutions, [first,all]), Sols)
 1123    ;   Sols = first,
 1124        Options3 = Options2
 1125    ),
 1126                    % Errors or not?
 1127    (   '$select_option'(file_errors(FileErrors), Options3, Options4)
 1128    ->  '$must_be'(oneof(atom, file_errors, [error,fail]), FileErrors)
 1129    ;   FileErrors = error,
 1130        Options4 = Options3
 1131    ),
 1132                    % Expand shell patterns?
 1133    (   atomic(Spec),
 1134        '$select_option'(expand(Expand), Options4, Options5),
 1135        '$must_be'(boolean, Expand)
 1136    ->  expand_file_name(Spec, List),
 1137        '$member'(Spec1, List)
 1138    ;   Spec1 = Spec,
 1139        Options5 = Options4
 1140    ),
 1141                    % Search for files
 1142    (   Sols == first
 1143    ->  (   '$chk_file'(Spec1, Extensions, Options5, true, Path)
 1144        ->  !       % also kill choice point of expand_file_name/2
 1145        ;   (   FileErrors == fail
 1146            ->  fail
 1147            ;   '$current_module'('$bags', _File),
 1148                findall(P,
 1149                        '$chk_file'(Spec1, Extensions, [access(exist)],
 1150                                    false, P),
 1151                        Candidates),
 1152                '$abs_file_error'(Spec, Candidates, Options5)
 1153            )
 1154        )
 1155    ;   '$chk_file'(Spec1, Extensions, Options5, false, Path)
 1156    ).
 1157
 1158'$abs_file_error'(Spec, Candidates, Conditions) :-
 1159    '$member'(F, Candidates),
 1160    '$member'(C, Conditions),
 1161    '$file_condition'(C),
 1162    '$file_error'(C, Spec, F, E, Comment),
 1163    !,
 1164    throw(error(E, context(_, Comment))).
 1165'$abs_file_error'(Spec, _, _) :-
 1166    '$existence_error'(source_sink, Spec).
 1167
 1168'$file_error'(file_type(directory), Spec, File, Error, Comment) :-
 1169    \+ exists_directory(File),
 1170    !,
 1171    Error = existence_error(directory, Spec),
 1172    Comment = not_a_directory(File).
 1173'$file_error'(file_type(_), Spec, File, Error, Comment) :-
 1174    exists_directory(File),
 1175    !,
 1176    Error = existence_error(file, Spec),
 1177    Comment = directory(File).
 1178'$file_error'(access(OneOrList), Spec, File, Error, _) :-
 1179    '$one_or_member'(Access, OneOrList),
 1180    \+ access_file(File, Access),
 1181    Error = permission_error(Access, source_sink, Spec).
 1182
 1183'$one_or_member'(Elem, List) :-
 1184    is_list(List),
 1185    !,
 1186    '$member'(Elem, List).
 1187'$one_or_member'(Elem, Elem).
 1188
 1189
 1190'$file_type_extensions'(source, Exts) :-       % SICStus 3.9 compatibility
 1191    !,
 1192    '$file_type_extensions'(prolog, Exts).
 1193'$file_type_extensions'(Type, Exts) :-
 1194    '$current_module'('$bags', _File),
 1195    !,
 1196    findall(Ext, user:prolog_file_type(Ext, Type), Exts0),
 1197    (   Exts0 == [],
 1198        \+ '$ft_no_ext'(Type)
 1199    ->  '$domain_error'(file_type, Type)
 1200    ;   true
 1201    ),
 1202    '$append'(Exts0, [''], Exts).
 1203'$file_type_extensions'(prolog, [pl, '']). % findall is not yet defined ...
 1204
 1205'$ft_no_ext'(txt).
 1206'$ft_no_ext'(executable).
 1207'$ft_no_ext'(directory).

 user:prolog_file_type(?Extension, ?Type)

Define type of file based on the extension. This is used by absolute_file_name/3 and may be used to extend the list of extensions used for some type.

Note that qlf must be last when searching for Prolog files. Otherwise use_module/1 will consider the file as not-loaded because the .qlf file is not the loaded file. Must be fixed elsewhere.

 1220:- multifile(user:prolog_file_type/2). 1221:- dynamic(user:prolog_file_type/2). 1222
 1223user:prolog_file_type(pl,       prolog).
 1224user:prolog_file_type(prolog,   prolog).
 1225user:prolog_file_type(qlf,      prolog).
 1226user:prolog_file_type(qlf,      qlf).
 1227user:prolog_file_type(Ext,      executable) :-
 1228    current_prolog_flag(shared_object_extension, Ext).
 1229user:prolog_file_type(dylib,    executable) :-
 1230    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.

 1237'$chk_file'(Spec, _Extensions, _Cond, _Cache, _FullName) :-
 1238    \+ ground(Spec),
 1239    !,
 1240    '$instantiation_error'(Spec).
 1241'$chk_file'(Spec, Extensions, Cond, Cache, FullName) :-
 1242    compound(Spec),
 1243    functor(Spec, _, 1),
 1244    !,
 1245    '$relative_to'(Cond, cwd, CWD),
 1246    '$chk_alias_file'(Spec, Extensions, Cond, Cache, CWD, FullName).
 1247'$chk_file'(Segments, Ext, Cond, Cache, FullName) :-    % allow a/b/...
 1248    \+ atomic(Segments),
 1249    !,
 1250    '$segments_to_atom'(Segments, Atom),
 1251    '$chk_file'(Atom, Ext, Cond, Cache, FullName).
 1252'$chk_file'(File, Exts, Cond, _, FullName) :-
 1253    is_absolute_file_name(File),
 1254    !,
 1255    '$extend_file'(File, Exts, Extended),
 1256    '$file_conditions'(Cond, Extended),
 1257    '$absolute_file_name'(Extended, FullName).
 1258'$chk_file'(File, Exts, Cond, _, FullName) :-
 1259    '$relative_to'(Cond, source, Dir),
 1260    atomic_list_concat([Dir, /, File], AbsFile),
 1261    '$extend_file'(AbsFile, Exts, Extended),
 1262    '$file_conditions'(Cond, Extended),
 1263    !,
 1264    '$absolute_file_name'(Extended, FullName).
 1265'$chk_file'(File, Exts, Cond, _, FullName) :-
 1266    '$extend_file'(File, Exts, Extended),
 1267    '$file_conditions'(Cond, Extended),
 1268    '$absolute_file_name'(Extended, FullName).
 1269
 1270'$segments_to_atom'(Atom, Atom) :-
 1271    atomic(Atom),
 1272    !.
 1273'$segments_to_atom'(Segments, Atom) :-
 1274    '$segments_to_list'(Segments, List, []),
 1275    !,
 1276    atomic_list_concat(List, /, Atom).
 1277
 1278'$segments_to_list'(A/B, H, T) :-
 1279    '$segments_to_list'(A, H, T0),
 1280    '$segments_to_list'(B, T0, T).
 1281'$segments_to_list'(A, [A|T], T) :-
 1282    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.

 1292'$relative_to'(Conditions, Default, Dir) :-
 1293    (   '$option'(relative_to(FileOrDir), Conditions)
 1294    *-> (   exists_directory(FileOrDir)
 1295        ->  Dir = FileOrDir
 1296        ;   atom_concat(Dir, /, FileOrDir)
 1297        ->  true
 1298        ;   file_directory_name(FileOrDir, Dir)
 1299        )
 1300    ;   Default == cwd
 1301    ->  '$cwd'(Dir)
 1302    ;   Default == source
 1303    ->  source_location(ContextFile, _Line),
 1304        file_directory_name(ContextFile, Dir)
 1305    ).

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

 1310:- dynamic
 1311    '$search_path_file_cache'/3,    % SHA1, Time, Path
 1312    '$search_path_gc_time'/1.       % Time
 1313:- volatile
 1314    '$search_path_file_cache'/3,
 1315    '$search_path_gc_time'/1. 1316
 1317:- create_prolog_flag(file_search_cache_time, 10, []). 1318
 1319'$chk_alias_file'(Spec, Exts, Cond, true, CWD, FullFile) :-
 1320    !,
 1321    findall(Exp, expand_file_search_path(Spec, Exp), Expansions),
 1322    Cache = cache(Exts, Cond, CWD, Expansions),
 1323    variant_sha1(Spec+Cache, SHA1),
 1324    get_time(Now),
 1325    current_prolog_flag(file_search_cache_time, TimeOut),
 1326    (   '$search_path_file_cache'(SHA1, CachedTime, FullFile),
 1327        CachedTime > Now - TimeOut,
 1328        '$file_conditions'(Cond, FullFile)
 1329    ->  '$search_message'(file_search(cache(Spec, Cond), FullFile))
 1330    ;   '$member'(Expanded, Expansions),
 1331        '$extend_file'(Expanded, Exts, LibFile),
 1332        (   '$file_conditions'(Cond, LibFile),
 1333            '$absolute_file_name'(LibFile, FullFile),
 1334            '$cache_file_found'(SHA1, Now, TimeOut, FullFile)
 1335        ->  '$search_message'(file_search(found(Spec, Cond), FullFile))
 1336        ;   '$search_message'(file_search(tried(Spec, Cond), LibFile)),
 1337            fail
 1338        )
 1339    ).
 1340'$chk_alias_file'(Spec, Exts, Cond, false, _CWD, FullFile) :-
 1341    expand_file_search_path(Spec, Expanded),
 1342    '$extend_file'(Expanded, Exts, LibFile),
 1343    '$file_conditions'(Cond, LibFile),
 1344    '$absolute_file_name'(LibFile, FullFile).
 1345
 1346'$cache_file_found'(_, _, TimeOut, _) :-
 1347    TimeOut =:= 0,
 1348    !.
 1349'$cache_file_found'(SHA1, Now, TimeOut, FullFile) :-
 1350    '$search_path_file_cache'(SHA1, Saved, FullFile),
 1351    !,
 1352    (   Now - Saved < TimeOut/2
 1353    ->  true
 1354    ;   retractall('$search_path_file_cache'(SHA1, _, _)),
 1355        asserta('$search_path_file_cache'(SHA1, Now, FullFile))
 1356    ).
 1357'$cache_file_found'(SHA1, Now, TimeOut, FullFile) :-
 1358    'gc_file_search_cache'(TimeOut),
 1359    asserta('$search_path_file_cache'(SHA1, Now, FullFile)).
 1360
 1361'gc_file_search_cache'(TimeOut) :-
 1362    get_time(Now),
 1363    '$search_path_gc_time'(Last),
 1364    Now-Last < TimeOut/2,
 1365    !.
 1366'gc_file_search_cache'(TimeOut) :-
 1367    get_time(Now),
 1368    retractall('$search_path_gc_time'(_)),
 1369    assertz('$search_path_gc_time'(Now)),
 1370    Before is Now - TimeOut,
 1371    (   '$search_path_file_cache'(SHA1, Cached, FullFile),
 1372        Cached < Before,
 1373        retractall('$search_path_file_cache'(SHA1, Cached, FullFile)),
 1374        fail
 1375    ;   true
 1376    ).
 1377
 1378
 1379'$search_message'(Term) :-
 1380    current_prolog_flag(verbose_file_search, true),
 1381    !,
 1382    print_message(informational, Term).
 1383'$search_message'(_).

 $file_conditions(+Condition, +Path)

Verify Path satisfies Condition.

 1390'$file_conditions'(List, File) :-
 1391    is_list(List),
 1392    !,
 1393    \+ ( '$member'(C, List),
 1394         '$file_condition'(C),
 1395         \+ '$file_condition'(C, File)
 1396       ).
 1397'$file_conditions'(Map, File) :-
 1398    \+ (  get_dict(Key, Map, Value),
 1399          C =.. [Key,Value],
 1400          '$file_condition'(C),
 1401         \+ '$file_condition'(C, File)
 1402       ).
 1403
 1404'$file_condition'(file_type(directory), File) :-
 1405    !,
 1406    exists_directory(File).
 1407'$file_condition'(file_type(_), File) :-
 1408    !,
 1409    \+ exists_directory(File).
 1410'$file_condition'(access(Accesses), File) :-
 1411    !,
 1412    \+ (  '$one_or_member'(Access, Accesses),
 1413          \+ access_file(File, Access)
 1414       ).
 1415
 1416'$file_condition'(exists).
 1417'$file_condition'(file_type(_)).
 1418'$file_condition'(access(_)).
 1419
 1420'$extend_file'(File, Exts, FileEx) :-
 1421    '$ensure_extensions'(Exts, File, Fs),
 1422    '$list_to_set'(Fs, FsSet),
 1423    '$member'(FileEx, FsSet).
 1424
 1425'$ensure_extensions'([], _, []).
 1426'$ensure_extensions'([E|E0], F, [FE|E1]) :-
 1427    file_name_extension(F, E, FE),
 1428    '$ensure_extensions'(E0, F, E1).

 $list_to_set(+List, -Set) is det

Turn list into a set, keeping the left-most copy of duplicate elements. Note that library(lists) provides an O(N*log(N)) version, but sets of file name extensions should be short enough for this not to matter.

 1437'$list_to_set'(List, Set) :-
 1438    '$list_to_set'(List, [], Set).
 1439
 1440'$list_to_set'([], _, []).
 1441'$list_to_set'([H|T], Seen, R) :-
 1442    memberchk(H, Seen),
 1443    !,
 1444    '$list_to_set'(T, R).
 1445'$list_to_set'([H|T], Seen, [H|R]) :-
 1446    '$list_to_set'(T, [H|Seen], R).
 1447
 1448/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
 1449Canonicalise the extension list. Old SWI-Prolog   require  `.pl', etc, which
 1450the Quintus compatibility  requests  `pl'.   This  layer  canonicalises  all
 1451extensions to .ext
 1452- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
 1453
 1454'$canonicalise_extensions'([], []) :- !.
 1455'$canonicalise_extensions'([H|T], [CH|CT]) :-
 1456    !,
 1457    '$must_be'(atom, H),
 1458    '$canonicalise_extension'(H, CH),
 1459    '$canonicalise_extensions'(T, CT).
 1460'$canonicalise_extensions'(E, [CE]) :-
 1461    '$canonicalise_extension'(E, CE).
 1462
 1463'$canonicalise_extension'('', '') :- !.
 1464'$canonicalise_extension'(DotAtom, DotAtom) :-
 1465    sub_atom(DotAtom, 0, _, _, '.'),
 1466    !.
 1467'$canonicalise_extension'(Atom, DotAtom) :-
 1468    atom_concat('.', Atom, DotAtom).
 1469
 1470
 1471                /********************************
 1472                *            CONSULT            *
 1473                *********************************/
 1474
 1475:- dynamic
 1476    user:library_directory/1,
 1477    user:prolog_load_file/2. 1478:- multifile
 1479    user:library_directory/1,
 1480    user:prolog_load_file/2. 1481
 1482:- prompt(_, '|: '). 1483
 1484:- thread_local
 1485    '$compilation_mode_store'/1,    % database, wic, qlf
 1486    '$directive_mode_store'/1.      % database, wic, qlf
 1487:- volatile
 1488    '$compilation_mode_store'/1,
 1489    '$directive_mode_store'/1. 1490
 1491'$compilation_mode'(Mode) :-
 1492    (   '$compilation_mode_store'(Val)
 1493    ->  Mode = Val
 1494    ;   Mode = database
 1495    ).
 1496
 1497'$set_compilation_mode'(Mode) :-
 1498    retractall('$compilation_mode_store'(_)),
 1499    assertz('$compilation_mode_store'(Mode)).
 1500
 1501'$compilation_mode'(Old, New) :-
 1502    '$compilation_mode'(Old),
 1503    (   New == Old
 1504    ->  true
 1505    ;   '$set_compilation_mode'(New)
 1506    ).
 1507
 1508'$directive_mode'(Mode) :-
 1509    (   '$directive_mode_store'(Val)
 1510    ->  Mode = Val
 1511    ;   Mode = database
 1512    ).
 1513
 1514'$directive_mode'(Old, New) :-
 1515    '$directive_mode'(Old),
 1516    (   New == Old
 1517    ->  true
 1518    ;   '$set_directive_mode'(New)
 1519    ).
 1520
 1521'$set_directive_mode'(Mode) :-
 1522    retractall('$directive_mode_store'(_)),
 1523    assertz('$directive_mode_store'(Mode)).

 $compilation_level(-Level) is det

True when Level reflects the nesting in files compiling other files. 0 if no files are being loaded.

 1531'$compilation_level'(Level) :-
 1532    '$input_context'(Stack),
 1533    '$compilation_level'(Stack, Level).
 1534
 1535'$compilation_level'([], 0).
 1536'$compilation_level'([Input|T], Level) :-
 1537    (   arg(1, Input, see)
 1538    ->  '$compilation_level'(T, Level)
 1539    ;   '$compilation_level'(T, Level0),
 1540        Level is Level0+1
 1541    ).

 compiling

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

 1549compiling :-
 1550    \+ (   '$compilation_mode'(database),
 1551           '$directive_mode'(database)
 1552       ).
 1553
 1554:- meta_predicate
 1555    '$ifcompiling'(0). 1556
 1557'$ifcompiling'(G) :-
 1558    (   '$compilation_mode'(database)
 1559    ->  true
 1560    ;   call(G)
 1561    ).
 1562
 1563                /********************************
 1564                *         READ SOURCE           *
 1565                *********************************/

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

 1569'$load_msg_level'(Action, Nesting, Start, Done) :-
 1570    '$update_autoload_level'([], 0),
 1571    !,
 1572    current_prolog_flag(verbose_load, Type0),
 1573    '$load_msg_compat'(Type0, Type),
 1574    (   '$load_msg_level'(Action, Nesting, Type, Start, Done)
 1575    ->  true
 1576    ).
 1577'$load_msg_level'(_, _, silent, silent).
 1578
 1579'$load_msg_compat'(true, normal) :- !.
 1580'$load_msg_compat'(false, silent) :- !.
 1581'$load_msg_compat'(X, X).
 1582
 1583'$load_msg_level'(load_file,    _, full,   informational, informational).
 1584'$load_msg_level'(include_file, _, full,   informational, informational).
 1585'$load_msg_level'(load_file,    _, normal, silent,        informational).
 1586'$load_msg_level'(include_file, _, normal, silent,        silent).
 1587'$load_msg_level'(load_file,    0, brief,  silent,        informational).
 1588'$load_msg_level'(load_file,    _, brief,  silent,        silent).
 1589'$load_msg_level'(include_file, _, brief,  silent,        silent).
 1590'$load_msg_level'(load_file,    _, silent, silent,        silent).
 1591'$load_msg_level'(include_file, _, silent, silent,        silent).

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

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

Arguments:

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

 1614'$source_term'(From, Read, RLayout, Term, TLayout, Stream, Options) :-
 1615    '$source_term'(From, Read, RLayout, Term, TLayout, Stream, [], Options),
 1616    (   Term == end_of_file
 1617    ->  !, fail
 1618    ;   Term \== begin_of_file
 1619    ).
 1620
 1621'$source_term'(Input, _,_,_,_,_,_,_) :-
 1622    \+ ground(Input),
 1623    !,
 1624    '$instantiation_error'(Input).
 1625'$source_term'(stream(Id, In, Opts),
 1626               Read, RLayout, Term, TLayout, Stream, Parents, Options) :-
 1627    !,
 1628    '$record_included'(Parents, Id, Id, 0.0, Message),
 1629    setup_call_cleanup(
 1630        '$open_source'(stream(Id, In, Opts), In, State, Parents, Options),
 1631        '$term_in_file'(In, Read, RLayout, Term, TLayout, Stream,
 1632                        [Id|Parents], Options),
 1633        '$close_source'(State, Message)).
 1634'$source_term'(File,
 1635               Read, RLayout, Term, TLayout, Stream, Parents, Options) :-
 1636    absolute_file_name(File, Path,
 1637                       [ file_type(prolog),
 1638                         access(read)
 1639                       ]),
 1640    time_file(Path, Time),
 1641    '$record_included'(Parents, File, Path, Time, Message),
 1642    setup_call_cleanup(
 1643        '$open_source'(Path, In, State, Parents, Options),
 1644        '$term_in_file'(In, Read, RLayout, Term, TLayout, Stream,
 1645                        [Path|Parents], Options),
 1646        '$close_source'(State, Message)).
 1647
 1648:- thread_local
 1649    '$load_input'/2. 1650:- volatile
 1651    '$load_input'/2. 1652
 1653'$open_source'(stream(Id, In, Opts), In,
 1654               restore(In, StreamState, Id, Ref, Opts), Parents, Options) :-
 1655    !,
 1656    '$context_type'(Parents, ContextType),
 1657    '$push_input_context'(ContextType),
 1658    '$set_encoding'(In, Options),
 1659    '$prepare_load_stream'(In, Id, StreamState),
 1660    asserta('$load_input'(stream(Id), In), Ref).
 1661'$open_source'(Path, In, close(In, Path, Ref), Parents, Options) :-
 1662    '$context_type'(Parents, ContextType),
 1663    '$push_input_context'(ContextType),
 1664    '$open_source'(Path, In, Options),
 1665    '$set_encoding'(In, Options),
 1666    asserta('$load_input'(Path, In), Ref).
 1667
 1668'$context_type'([], load_file) :- !.
 1669'$context_type'(_, include).
 1670
 1671:- multifile prolog:open_source_hook/3. 1672
 1673'$open_source'(Path, In, Options) :-
 1674    prolog:open_source_hook(Path, In, Options),
 1675    !.
 1676'$open_source'(Path, In, _Options) :-
 1677    open(Path, read, In).
 1678
 1679'$close_source'(close(In, Id, Ref), Message) :-
 1680    erase(Ref),
 1681    '$end_consult'(Id),
 1682    call_cleanup(
 1683        close(In),
 1684        '$pop_input_context'),
 1685    '$close_message'(Message).
 1686'$close_source'(restore(In, StreamState, Id, Ref, Opts), Message) :-
 1687    erase(Ref),
 1688    '$end_consult'(Id),
 1689    call_cleanup(
 1690        '$restore_load_stream'(In, StreamState, Opts),
 1691        '$pop_input_context'),
 1692    '$close_message'(Message).
 1693
 1694'$close_message'(message(Level, Msg)) :-
 1695    !,
 1696    '$print_message'(Level, Msg).
 1697'$close_message'(_).