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)  2006-2022, University of Amsterdam
    7                              VU University Amsterdam
    8                              SWI-Prolog Solutions b.v.
    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:- module(prolog_source,
   38          [ prolog_read_source_term/4,  % +Stream, -Term, -Expanded, +Options
   39            read_source_term_at_location/3, %Stream, -Term, +Options
   40            prolog_open_source/2,       % +Source, -Stream
   41            prolog_close_source/1,      % +Stream
   42            prolog_canonical_source/2,  % +Spec, -Id
   43
   44            load_quasi_quotation_syntax/2, % :Path, +Syntax
   45
   46            file_name_on_path/2,        % +File, -PathSpec
   47            file_alias_path/2,          % ?Alias, ?Dir
   48            path_segments_atom/2,       % ?Segments, ?Atom
   49            directory_source_files/3,   % +Dir, -Files, +Options
   50            valid_term_position/2       % +Term, +TermPos
   51          ]).   52:- use_module(library(debug), [debug/3, assertion/1]).   53:- autoload(library(apply), [maplist/2, maplist/3, foldl/4]).   54:- autoload(library(error), [domain_error/2, is_of_type/2]).   55:- autoload(library(lists), [member/2, last/2, select/3, append/3, selectchk/3]).   56:- autoload(library(operators), [push_op/3, push_operators/1, pop_operators/0]).   57:- autoload(library(option), [select_option/4, option/3, option/2]).   58
   59
   60/** <module> Examine Prolog source-files
   61
   62This module provides predicates  to  open,   close  and  read terms from
   63Prolog source-files. This may seem  easy,  but   there  are  a couple of
   64problems that must be taken care of.
   65
   66        * Source files may start with #!, supporting PrologScript
   67        * Embedded operators declarations must be taken into account
   68        * Style-check options must be taken into account
   69        * Operators and style-check options may be implied by directives
   70        * On behalf of the development environment we also wish to
   71          parse PceEmacs buffers
   72
   73This module concentrates these issues  in   a  single  library. Intended
   74users of the library are:
   75
   76        $ prolog_xref.pl :   The Prolog cross-referencer
   77        $ prolog_clause.pl : Get details about (compiled) clauses
   78        $ prolog_colour.pl : Colourise source-code
   79        $ PceEmacs :         Emacs syntax-colouring
   80        $ PlDoc :            The documentation framework
   81*/
   82
   83:- thread_local
   84    open_source/2,          % Stream, State
   85    mode/2.                 % Stream, Data
   86
   87:- multifile
   88    requires_library/2,
   89    prolog:xref_source_identifier/2, % +Source, -Id
   90    prolog:xref_source_time/2,       % +Source, -Modified
   91    prolog:xref_open_source/2,       % +SourceId, -Stream
   92    prolog:xref_close_source/2,      % +SourceId, -Stream
   93    prolog:alternate_syntax/4,       % Syntax, +Module, -Setup, -Restore
   94    prolog:xref_update_syntax/2,     % +Directive, +Module
   95    prolog:quasi_quotation_syntax/2. % Syntax, Library
   96
   97
   98:- predicate_options(prolog_read_source_term/4, 4,
   99                     [ pass_to(system:read_clause/3, 3)
  100                     ]).  101:- predicate_options(read_source_term_at_location/3, 3,
  102                     [ line(integer),
  103                       offset(integer),
  104                       module(atom),
  105                       operators(list),
  106                       error(-any),
  107                       pass_to(system:read_term/3, 3)
  108                     ]).  109:- predicate_options(directory_source_files/3, 3,
  110                     [ recursive(boolean),
  111                       if(oneof([true,loaded])),
  112                       pass_to(system:absolute_file_name/3,3)
  113                     ]).  114
  115
  116                 /*******************************
  117                 *           READING            *
  118                 *******************************/
  119
  120%!  prolog_read_source_term(+In, -Term, -Expanded, +Options) is det.
  121%
  122%   Read a term from a Prolog source-file.  Options is a option list
  123%   that is forwarded to read_clause/3.
  124%
  125%   This predicate is intended to read the   file from the start. It
  126%   tracks  directives  to  update  its   notion  of  the  currently
  127%   effective syntax (e.g., declared operators).
  128%
  129%   @param Term     Term read
  130%   @param Expanded Result of term-expansion on the term
  131%   @see   read_source_term_at_location/3 for reading at an
  132%          arbitrary location.
  133
  134prolog_read_source_term(In, Term, Expanded, Options) :-
  135    maplist(read_clause_option, Options),
  136    !,
  137    select_option(subterm_positions(TermPos), Options,
  138                  RestOptions, TermPos),
  139    read_clause(In, Term,
  140                [ subterm_positions(TermPos)
  141                | RestOptions
  142                ]),
  143    expand(Term, TermPos, In, Expanded),
  144    '$current_source_module'(M),
  145    update_state(Term, Expanded, M).
  146prolog_read_source_term(In, Term, Expanded, Options) :-
  147    '$current_source_module'(M),
  148    select_option(syntax_errors(SE), Options, RestOptions0, dec10),
  149    select_option(subterm_positions(TermPos), RestOptions0,
  150                  RestOptions, TermPos),
  151    (   style_check(?(singleton))
  152    ->  FinalOptions = [ singletons(warning) | RestOptions ]
  153    ;   FinalOptions = RestOptions
  154    ),
  155    read_term(In, Term,
  156              [ module(M),
  157                syntax_errors(SE),
  158                subterm_positions(TermPos)
  159              | FinalOptions
  160              ]),
  161    expand(Term, TermPos, In, Expanded),
  162    update_state(Term, Expanded, M).
  163
  164read_clause_option(syntax_errors(_)).
  165read_clause_option(term_position(_)).
  166read_clause_option(process_comment(_)).
  167read_clause_option(comments(_)).
  168
  169:- public
  170    expand/3.                       % Used by Prolog colour
  171
  172expand(Term, In, Exp) :-
  173    expand(Term, _, In, Exp).
  174
  175expand(Var, _, _, Var) :-
  176    var(Var),
  177    !.
  178expand(Term, _, _, Term) :-
  179    no_expand(Term),
  180    !.
  181expand(Term, _, _, _) :-
  182    requires_library(Term, Lib),
  183    ensure_loaded(user:Lib),
  184    fail.
  185expand(Term, _, In, Term) :-
  186    chr_expandable(Term, In),
  187    !.
  188expand(Term, Pos, _, Expanded) :-
  189    expand_term(Term, Pos, Expanded, _).
  190
  191no_expand((:- if(_))).
  192no_expand((:- elif(_))).
  193no_expand((:- else)).
  194no_expand((:- endif)).
  195no_expand((:- require(_))).
  196
  197chr_expandable((:- chr_constraint(_)), In) :-
  198    add_mode(In, chr).
  199chr_expandable((handler(_)), In) :-
  200    mode(In, chr).
  201chr_expandable((rules(_)), In) :-
  202    mode(In, chr).
  203chr_expandable(<=>(_, _), In) :-
  204    mode(In, chr).
  205chr_expandable(@(_, _), In) :-
  206    mode(In, chr).
  207chr_expandable(==>(_, _), In) :-
  208    mode(In, chr).
  209chr_expandable(pragma(_, _), In) :-
  210    mode(In, chr).
  211chr_expandable(option(_, _), In) :-
  212    mode(In, chr).
  213
  214add_mode(Stream, Mode) :-
  215    mode(Stream, Mode),
  216    !.
  217add_mode(Stream, Mode) :-
  218    asserta(mode(Stream, Mode)).
  219
  220%!  requires_library(+Term, -Library)
  221%
  222%   known expansion hooks.  May be expanded as multifile predicate.
  223
  224requires_library((:- emacs_begin_mode(_,_,_,_,_)), library(emacs_extend)).
  225requires_library((:- draw_begin_shape(_,_,_,_)),   library(pcedraw)).
  226requires_library((:- use_module(library(pce))),    library(pce)).
  227requires_library((:- pce_begin_class(_,_)),        library(pce)).
  228requires_library((:- pce_begin_class(_,_,_)),      library(pce)).
  229
  230%!  update_state(+Term, +Expanded, +Module) is det.
  231%
  232%   Update operators and style-check options from the expanded term.
  233
  234:- multifile
  235    pce_expansion:push_compile_operators/1,
  236    pce_expansion:pop_compile_operators/0.  237
  238update_state(Raw, _, _) :-
  239    Raw == (:- pce_end_class),
  240    !,
  241    ignore(pce_expansion:pop_compile_operators).
  242update_state(Raw, _, SM) :-
  243    subsumes_term((:- pce_extend_class(_)), Raw),
  244    !,
  245    pce_expansion:push_compile_operators(SM).
  246update_state(_Raw, Expanded, M) :-
  247    update_state(Expanded, M).
  248
  249update_state(Var, _) :-
  250    var(Var),
  251    !.
  252update_state([], _) :-
  253    !.
  254update_state([H|T], M) :-
  255    !,
  256    update_state(H, M),
  257    update_state(T, M).
  258update_state((:- Directive), M) :-
  259    nonvar(Directive),
  260    !,
  261    catch(update_directive(Directive, M), _, true).
  262update_state((?- Directive), M) :-
  263    !,
  264    update_state((:- Directive), M).
  265update_state(_, _).
  266
  267update_directive(Directive, Module) :-
  268    prolog:xref_update_syntax(Directive, Module),
  269    !.
  270update_directive(module(Module, Public), _) :-
  271    atom(Module),
  272    is_list(Public),
  273    !,
  274    '$set_source_module'(Module),
  275    maplist(import_syntax(_,Module, _), Public).
  276update_directive(M:op(P,T,N), SM) :-
  277    atom(M),
  278    ground(op(P,T,N)),
  279    !,
  280    update_directive(op(P,T,N), SM).
  281update_directive(op(P,T,N), SM) :-
  282    ground(op(P,T,N)),
  283    !,
  284    strip_module(SM:N, M, PN),
  285    push_op(P,T,M:PN).
  286update_directive(style_check(Style), _) :-
  287    ground(Style),
  288    style_check(Style),
  289    !.
  290update_directive(use_module(Spec), SM) :-
  291    ground(Spec),
  292    catch(module_decl(Spec, Path, Public), _, fail),
  293    is_list(Public),
  294    !,
  295    maplist(import_syntax(Path, SM, _), Public).
  296update_directive(use_module(Spec, Imports), SM) :-
  297    ground(Spec),
  298    is_list(Imports),
  299    catch(module_decl(Spec, Path, Public), _, fail),
  300    is_list(Public),
  301    !,
  302    maplist(import_syntax(Path, SM, Imports), Public).
  303update_directive(pce_begin_class_definition(_,_,_,_), SM) :-
  304    pce_expansion:push_compile_operators(SM),
  305    !.
  306update_directive(_, _).
  307
  308%!  import_syntax(+Path, +Module, +Imports, +ExportStatement) is det.
  309%
  310%   Import syntax affecting aspects  of   a  declaration. Deals with
  311%   op/3 terms and Syntax/4  quasi   quotation  declarations.
  312
  313import_syntax(_, _, _, Var) :-
  314    var(Var),
  315    !.
  316import_syntax(_, M, Imports, Op) :-
  317    Op = op(_,_,_),
  318    \+ \+ member(Op, Imports),
  319    !,
  320    update_directive(Op, M).
  321import_syntax(Path, SM, Imports, Syntax/4) :-
  322    \+ \+ member(Syntax/4, Imports),
  323    load_quasi_quotation_syntax(SM:Path, Syntax),
  324    !.
  325import_syntax(_,_,_, _).
  326
  327
  328%!  load_quasi_quotation_syntax(:Path, +Syntax) is semidet.
  329%
  330%   Import quasi quotation syntax Syntax from   Path into the module
  331%   specified by the  first  argument.   Quasi  quotation  syntax is
  332%   imported iff:
  333%
  334%     - It is already loaded
  335%     - It is declared with prolog:quasi_quotation_syntax/2
  336%
  337%   @tbd    We need a better way to know that an import affects the
  338%           syntax or compilation process.  This is also needed for
  339%           better compatibility with systems that provide a
  340%           separate compiler.
  341
  342load_quasi_quotation_syntax(SM:Path, Syntax) :-
  343    atom(Path), atom(Syntax),
  344    source_file_property(Path, module(M)),
  345    functor(ST, Syntax, 4),
  346    predicate_property(M:ST, quasi_quotation_syntax),
  347    !,
  348    use_module(SM:Path, [Syntax/4]).
  349load_quasi_quotation_syntax(SM:Path, Syntax) :-
  350    atom(Path), atom(Syntax),
  351    prolog:quasi_quotation_syntax(Syntax, Spec),
  352    absolute_file_name(Spec, Path2,
  353                       [ file_type(prolog),
  354                         file_errors(fail),
  355                         access(read)
  356                       ]),
  357    Path == Path2,
  358    !,
  359    use_module(SM:Path, [Syntax/4]).
  360
  361%!  module_decl(+FileSpec, -Path, -Decl) is semidet.
  362%
  363%   If FileSpec refers to a Prolog  module   file,  unify  Path with the
  364%   canonical file path to the file and Decl with the second argument of
  365%   the module declaration.
  366
  367module_decl(Spec, Path, Decl) :-
  368    absolute_file_name(Spec, Path,
  369                       [ file_type(prolog),
  370                         file_errors(fail),
  371                         access(read)
  372                       ]),
  373    setup_call_cleanup(
  374        prolog_open_source(Path, In),
  375        read_module_decl(In, Decl),
  376        prolog_close_source(In)).
  377
  378read_module_decl(In, Decl) :-
  379    read(In, Term0),
  380    read_module_decl(Term0, In, Decl).
  381
  382read_module_decl((:- module(_, DeclIn)), _In, Decl) =>
  383    Decl = DeclIn.
  384read_module_decl((:- encoding(Enc)), In, Decl) =>
  385    set_stream(In, encoding(Enc)),
  386    read(In, Term2),
  387    read_module_decl(Term2, In, Decl).
  388read_module_decl(_, _, _) =>
  389    fail.
  390
  391
  392%!  read_source_term_at_location(+Stream, -Term, +Options) is semidet.
  393%
  394%   Try to read a Prolog term form   an  arbitrary location inside a
  395%   file. Due to Prolog's dynamic  syntax,   e.g.,  due  to operator
  396%   declarations that may change anywhere inside   the file, this is
  397%   theoreticaly   impossible.   Therefore,   this    predicate   is
  398%   fundamentally _heuristic_ and may fail.   This predicate is used
  399%   by e.g., clause_info/4 and by  PceEmacs   to  colour the current
  400%   clause.
  401%
  402%   This predicate has two ways to  find   the  right syntax. If the
  403%   file is loaded, it can be  passed   the  module using the module
  404%   option. This deals with  module  files   that  define  the  used
  405%   operators globally for  the  file.  Second,   there  is  a  hook
  406%   prolog:alternate_syntax/4 that can be used to temporary redefine
  407%   the syntax.
  408%
  409%   The options below are processed in   addition  to the options of
  410%   read_term/3. Note that  the  =line=   and  =offset=  options are
  411%   mutually exclusive.
  412%
  413%     * line(+Line)
  414%     If present, start reading at line Line.
  415%     * offset(+Characters)
  416%     Use seek/4 to go to the indicated location.  See seek/4
  417%     for limitations of seeking in text-files.
  418%     * module(+Module)
  419%     Use syntax from the given module. Default is the current
  420%     `source module'.
  421%     * operators(+List)
  422%     List of additional operator declarations to enforce while
  423%     reading the term.
  424%     * error(-Error)
  425%     If no correct parse can be found, unify Error with a term
  426%     Offset:Message that indicates the (character) location of
  427%     the error and the related message.  Adding this option
  428%     makes read_source_term_at_location/3 deterministic (=det=).
  429%
  430%   @see Use read_source_term/4 to read a file from the start.
  431%   @see prolog:alternate_syntax/4 for locally scoped operators.
  432
  433:- thread_local
  434    last_syntax_error/2.            % location, message
  435
  436read_source_term_at_location(Stream, Term, Options) :-
  437    retractall(last_syntax_error(_,_)),
  438    seek_to_start(Stream, Options),
  439    stream_property(Stream, position(Here)),
  440    '$current_source_module'(DefModule),
  441    option(module(Module), Options, DefModule),
  442    option(operators(Ops), Options, []),
  443    alternate_syntax(Syntax, Module, Setup, Restore),
  444    set_stream_position(Stream, Here),
  445    debug(read, 'Trying with syntax ~w', [Syntax]),
  446    push_operators(Module:Ops),
  447    call(Setup),
  448    Error = error(Formal,_),                 % do not catch timeout, etc.
  449    setup_call_cleanup(
  450        asserta(user:thread_message_hook(_,_,_), Ref), % silence messages
  451        catch(qq_read_term(Stream, Term0,
  452                           [ module(Module)
  453                           | Options
  454                           ]),
  455              Error,
  456              true),
  457        erase(Ref)),
  458    call(Restore),
  459    pop_operators,
  460    (   var(Formal)
  461    ->  !, Term = Term0
  462    ;   assert_error(Error, Options),
  463        fail
  464    ).
  465read_source_term_at_location(_, _, Options) :-
  466    option(error(Error), Options),
  467    !,
  468    setof(CharNo:Msg, retract(last_syntax_error(CharNo, Msg)), Pairs),
  469    last(Pairs, Error).
  470
  471assert_error(Error, Options) :-
  472    option(error(_), Options),
  473    !,
  474    (   (   Error = error(syntax_error(Id),
  475                          stream(_S1, _Line1, _LinePos1, CharNo))
  476        ;   Error = error(syntax_error(Id),
  477                          file(_S2, _Line2, _LinePos2, CharNo))
  478        )
  479    ->  message_to_string(error(syntax_error(Id), _), Msg),
  480        assertz(last_syntax_error(CharNo, Msg))
  481    ;   debug(read, 'Error: ~q', [Error]),
  482        throw(Error)
  483    ).
  484assert_error(_, _).
  485
  486
  487%!  alternate_syntax(?Syntax, +Module, -Setup, -Restore) is nondet.
  488%
  489%   Define an alternative  syntax  to  try   reading  a  term  at an
  490%   arbitrary location in module Module.
  491%
  492%   Calls the hook prolog:alternate_syntax/4 with the same signature
  493%   to allow for user-defined extensions.
  494%
  495%   @param  Setup is a deterministic goal to enable this syntax in
  496%           module.
  497%   @param  Restore is a deterministic goal to revert the actions of
  498%           Setup.
  499
  500alternate_syntax(prolog, _, true,  true).
  501alternate_syntax(Syntax, M, Setup, Restore) :-
  502    prolog:alternate_syntax(Syntax, M, Setup, Restore).
  503
  504
  505%!  seek_to_start(+Stream, +Options) is det.
  506%
  507%   Go to the location from where to start reading.
  508
  509seek_to_start(Stream, Options) :-
  510    option(line(Line), Options),
  511    !,
  512    seek(Stream, 0, bof, _),
  513    seek_to_line(Stream, Line).
  514seek_to_start(Stream, Options) :-
  515    option(offset(Start), Options),
  516    !,
  517    seek(Stream, Start, bof, _).
  518seek_to_start(_, _).
  519
  520%!  seek_to_line(+Stream, +Line)
  521%
  522%   Seek to indicated line-number.
  523
  524seek_to_line(Fd, N) :-
  525    N > 1,
  526    !,
  527    skip(Fd, 10),
  528    NN is N - 1,
  529    seek_to_line(Fd, NN).
  530seek_to_line(_, _).
  531
  532
  533                 /*******************************
  534                 *       QUASI QUOTATIONS       *
  535                 *******************************/
  536
  537%!  qq_read_term(+Stream, -Term, +Options)
  538%
  539%   Same  as  read_term/3,  but  dynamically    loads   known  quasi
  540%   quotations. Quasi quotations that  can   be  autoloaded  must be
  541%   defined using prolog:quasi_quotation_syntax/2.
  542
  543qq_read_term(Stream, Term, Options) :-
  544    select(syntax_errors(ErrorMode), Options, Options1),
  545    ErrorMode \== error,
  546    !,
  547    (   ErrorMode == dec10
  548    ->  repeat,
  549        qq_read_syntax_ex(Stream, Term, Options1, Error),
  550        (   var(Error)
  551        ->  !
  552        ;   print_message(error, Error),
  553            fail
  554        )
  555    ;   qq_read_syntax_ex(Stream, Term, Options1, Error),
  556        (   ErrorMode == fail
  557        ->  print_message(error, Error),
  558            fail
  559        ;   ErrorMode == quiet
  560        ->  fail
  561        ;   domain_error(syntax_errors, ErrorMode)
  562        )
  563    ).
  564qq_read_term(Stream, Term, Options) :-
  565    qq_read_term_ex(Stream, Term, Options).
  566
  567qq_read_syntax_ex(Stream, Term, Options, Error) :-
  568    catch(qq_read_term_ex(Stream, Term, Options),
  569          error(syntax_error(Syntax), Context),
  570          Error = error(Syntax, Context)).
  571
  572qq_read_term_ex(Stream, Term, Options) :-
  573    stream_property(Stream, position(Here)),
  574    catch(read_term(Stream, Term, Options),
  575          error(syntax_error(unknown_quasi_quotation_syntax(Syntax, Module)), Context),
  576          load_qq_and_retry(Here, Syntax, Module, Context, Stream, Term, Options)).
  577
  578load_qq_and_retry(Here, Syntax, Module, _, Stream, Term, Options) :-
  579    set_stream_position(Stream, Here),
  580    prolog:quasi_quotation_syntax(Syntax, Library),
  581    !,
  582    use_module(Module:Library, [Syntax/4]),
  583    read_term(Stream, Term, Options).
  584load_qq_and_retry(_Pos, Syntax, Module, Context, _Stream, _Term, _Options) :-
  585    print_message(warning, quasi_quotation(undeclared, Syntax)),
  586    throw(error(syntax_error(unknown_quasi_quotation_syntax(Syntax, Module)), Context)).
  587
  588%!  prolog:quasi_quotation_syntax(+Syntax, -Library) is semidet.
  589%
  590%   True when the quasi quotation syntax   Syntax can be loaded from
  591%   Library.  Library  must  be   a    valid   first   argument  for
  592%   use_module/2.
  593%
  594%   This multifile hook is used   by  library(prolog_source) to load
  595%   quasi quotation handlers on demand.
  596
  597prolog:quasi_quotation_syntax(html,       library(http/html_write)).
  598prolog:quasi_quotation_syntax(javascript, library(http/js_write)).
  599
  600
  601                 /*******************************
  602                 *           SOURCES            *
  603                 *******************************/
  604
  605%!  prolog_open_source(+CanonicalId:atomic, -Stream:stream) is det.
  606%
  607%   Open     source     with     given     canonical     id     (see
  608%   prolog_canonical_source/2)  and  remove  the  #!  line  if  any.
  609%   Streams  opened  using  this  predicate  must  be  closed  using
  610%   prolog_close_source/1. Typically using the skeleton below. Using
  611%   this   skeleton,   operator   and    style-check   options   are
  612%   automatically restored to the values before opening the source.
  613%
  614%   ==
  615%   process_source(Src) :-
  616%           prolog_open_source(Src, In),
  617%           call_cleanup(process(Src), prolog_close_source(In)).
  618%   ==
  619
  620prolog_open_source(Src, Fd) :-
  621    '$push_input_context'(source),
  622    catch((   prolog:xref_open_source(Src, Fd)
  623          ->  Hooked = true
  624          ;   open(Src, read, Fd),
  625              Hooked = false
  626          ), E,
  627          (   '$pop_input_context',
  628              throw(E)
  629          )),
  630    skip_hashbang(Fd),
  631    push_operators([]),
  632    '$current_source_module'(SM),
  633    '$save_lex_state'(LexState, []),
  634    asserta(open_source(Fd, state(Hooked, Src, LexState, SM))).
  635
  636skip_hashbang(Fd) :-
  637    catch((   peek_char(Fd, #)              % Deal with #! script
  638          ->  skip(Fd, 10)
  639          ;   true
  640          ), E,
  641          (   close(Fd, [force(true)]),
  642              '$pop_input_context',
  643              throw(E)
  644          )).
  645
  646%!  prolog:xref_open_source(+SourceID, -Stream)
  647%
  648%   Hook  to  open   an   xref   SourceID.    This   is   used   for
  649%   cross-referencing non-files, such as XPCE   buffers,  files from
  650%   archives,  git  repositories,   etc.    When   successful,   the
  651%   corresponding  prolog:xref_close_source/2  hook  is  called  for
  652%   closing the source.
  653
  654
  655%!  prolog_close_source(+In:stream) is det.
  656%
  657%   Close  a  stream  opened  using  prolog_open_source/2.  Restores
  658%   operator and style options. If the stream   has not been read to
  659%   the end, we call expand_term(end_of_file,  _) to allow expansion
  660%   modules to clean-up.
  661
  662prolog_close_source(In) :-
  663    call_cleanup(
  664        restore_source_context(In, Hooked, Src),
  665        close_source(Hooked, Src, In)).
  666
  667close_source(true, Src, In) :-
  668    catch(prolog:xref_close_source(Src, In), _, false),
  669    !,
  670    '$pop_input_context'.
  671close_source(_, _Src, In) :-
  672    close(In, [force(true)]),
  673    '$pop_input_context'.
  674
  675restore_source_context(In, Hooked, Src) :-
  676    (   at_end_of_stream(In)
  677    ->  true
  678    ;   ignore(catch(expand(end_of_file, _, In, _), _, true))
  679    ),
  680    pop_operators,
  681    retractall(mode(In, _)),
  682    (   retract(open_source(In, state(Hooked, Src, LexState, SM)))
  683    ->  '$restore_lex_state'(LexState),
  684        '$set_source_module'(SM)
  685    ;   assertion(fail)
  686    ).
  687
  688%!  prolog:xref_close_source(+SourceID, +Stream) is semidet.
  689%
  690%   Called by prolog_close_source/1 to  close   a  source previously
  691%   opened by the hook prolog:xref_open_source/2.  If the hook fails
  692%   close/2 using the option force(true) is used.
  693
  694%!  prolog_canonical_source(+SourceSpec:ground, -Id:atomic) is semidet.
  695%
  696%   Given a user-specification of a source,   generate  a unique and
  697%   indexable  identifier  for   it.   For    files   we   use   the
  698%   prolog_canonical absolute filename. Id must   be valid input for
  699%   prolog_open_source/2.
  700
  701prolog_canonical_source(Source, Src) :-
  702    var(Source),
  703    !,
  704    Src = Source.
  705prolog_canonical_source(User, user) :-
  706    User == user,
  707    !.
  708prolog_canonical_source(Src, Id) :-             % Call hook
  709    prolog:xref_source_identifier(Src, Id),
  710    !.
  711prolog_canonical_source(Source, Src) :-
  712    source_file(Source),
  713    !,
  714    Src = Source.
  715prolog_canonical_source(Source, Src) :-
  716    absolute_file_name(Source, Src,
  717                       [ file_type(prolog),
  718                         access(read),
  719                         file_errors(fail)
  720                       ]),
  721    !.
  722
  723
  724%!  file_name_on_path(+File:atom, -OnPath) is det.
  725%
  726%   True if OnPath a description of File   based  on the file search
  727%   path. This performs the inverse of absolute_file_name/3.
  728
  729file_name_on_path(Path, ShortId) :-
  730    (   file_alias_path(Alias, Dir),
  731        atom_concat(Dir, Local, Path)
  732    ->  (   Alias == '.'
  733        ->  ShortId = Local
  734        ;   file_name_extension(Base, pl, Local)
  735        ->  ShortId =.. [Alias, Base]
  736        ;   ShortId =.. [Alias, Local]
  737        )
  738    ;   ShortId = Path
  739    ).
  740
  741
  742%!  file_alias_path(-Alias, ?Dir) is nondet.
  743%
  744%   True if file Alias points to Dir.  Multiple solutions are
  745%   generated with the longest directory first.
  746
  747:- dynamic
  748    alias_cache/2.  749
  750file_alias_path(Alias, Dir) :-
  751    (   alias_cache(_, _)
  752    ->  true
  753    ;   build_alias_cache
  754    ),
  755    (   nonvar(Dir)
  756    ->  ensure_slash(Dir, DirSlash),
  757        alias_cache(Alias, DirSlash)
  758    ;   alias_cache(Alias, Dir)
  759    ).
  760
  761build_alias_cache :-
  762    findall(t(DirLen, AliasLen, Alias, Dir),
  763            search_path(Alias, Dir, AliasLen, DirLen), Ts),
  764    sort(0, >, Ts, List),
  765    forall(member(t(_, _, Alias, Dir), List),
  766           assert(alias_cache(Alias, Dir))).
  767
  768search_path('.', Here, 999, DirLen) :-
  769    working_directory(Here0, Here0),
  770    ensure_slash(Here0, Here),
  771    atom_length(Here, DirLen).
  772search_path(Alias, Dir, AliasLen, DirLen) :-
  773    user:file_search_path(Alias, _),
  774    Alias \== autoload,             % TBD: Multifile predicate?
  775    Alias \== noautoload,
  776    Spec =.. [Alias,'.'],
  777    atom_length(Alias, AliasLen0),
  778    AliasLen is 1000 - AliasLen0,   % must do reverse sort
  779    absolute_file_name(Spec, Dir0,
  780                       [ file_type(directory),
  781                         access(read),
  782                         solutions(all),
  783                         file_errors(fail)
  784                       ]),
  785    ensure_slash(Dir0, Dir),
  786    atom_length(Dir, DirLen).
  787
  788ensure_slash(Dir, Dir) :-
  789    sub_atom(Dir, _, _, 0, /),
  790    !.
  791ensure_slash(Dir0, Dir) :-
  792    atom_concat(Dir0, /, Dir).
  793
  794
  795%!  path_segments_atom(+Segments, -Atom) is det.
  796%!  path_segments_atom(-Segments, +Atom) is det.
  797%
  798%   Translate between a path  represented  as   a/b/c  and  an  atom
  799%   representing the same path. For example:
  800%
  801%     ==
  802%     ?- path_segments_atom(a/b/c, X).
  803%     X = 'a/b/c'.
  804%     ?- path_segments_atom(S, 'a/b/c'), display(S).
  805%     /(/(a,b),c)
  806%     S = a/b/c.
  807%     ==
  808%
  809%   This predicate is part of  the   Prolog  source  library because
  810%   SWI-Prolog  allows  writing  paths   as    /-nested   terms  and
  811%   source-code analysis programs often need this.
  812
  813path_segments_atom(Segments, Atom) :-
  814    var(Atom),
  815    !,
  816    (   atomic(Segments)
  817    ->  Atom = Segments
  818    ;   segments_to_list(Segments, List, [])
  819    ->  atomic_list_concat(List, /, Atom)
  820    ;   throw(error(type_error(file_path, Segments), _))
  821    ).
  822path_segments_atom(Segments, Atom) :-
  823    atomic_list_concat(List, /, Atom),
  824    parts_to_path(List, Segments).
  825
  826segments_to_list(Var, _, _) :-
  827    var(Var), !, fail.
  828segments_to_list(A/B, H, T) :-
  829    segments_to_list(A, H, T0),
  830    segments_to_list(B, T0, T).
  831segments_to_list(A, [A|T], T) :-
  832    atomic(A).
  833
  834parts_to_path([One], One) :- !.
  835parts_to_path(List, More/T) :-
  836    (   append(H, [T], List)
  837    ->  parts_to_path(H, More)
  838    ).
  839
  840%!  directory_source_files(+Dir, -Files, +Options) is det.
  841%
  842%   True when Files is a sorted list  of Prolog source files in Dir.
  843%   Options:
  844%
  845%     * recursive(boolean)
  846%     If =true= (default =false=), recurse into subdirectories
  847%     * if(Condition)
  848%     If =true= (default =loaded=), only report loaded files.
  849%
  850%   Other  options  are  passed    to  absolute_file_name/3,  unless
  851%   loaded(true) is passed.
  852
  853directory_source_files(Dir, SrcFiles, Options) :-
  854    option(if(loaded), Options, loaded),
  855    !,
  856    absolute_file_name(Dir, AbsDir, [file_type(directory), access(read)]),
  857    (   option(recursive(true), Options)
  858    ->  ensure_slash(AbsDir, Prefix),
  859        findall(F, (  source_file(F),
  860                      sub_atom(F, 0, _, _, Prefix)
  861                   ),
  862                SrcFiles)
  863    ;   findall(F, ( source_file(F),
  864                     file_directory_name(F, AbsDir)
  865                   ),
  866                SrcFiles)
  867    ).
  868directory_source_files(Dir, SrcFiles, Options) :-
  869    absolute_file_name(Dir, AbsDir, [file_type(directory), access(read)]),
  870    directory_files(AbsDir, Files),
  871    phrase(src_files(Files, AbsDir, Options), SrcFiles).
  872
  873src_files([], _, _) -->
  874    [].
  875src_files([H|T], Dir, Options) -->
  876    { file_name_extension(_, Ext, H),
  877      user:prolog_file_type(Ext, prolog),
  878      \+ user:prolog_file_type(Ext, qlf),
  879      dir_file_path(Dir, H, File0),
  880      absolute_file_name(File0, File,
  881                         [ file_errors(fail)
  882                         | Options
  883                         ])
  884    },
  885    !,
  886    [File],
  887    src_files(T, Dir, Options).
  888src_files([H|T], Dir, Options) -->
  889    { \+ special(H),
  890      option(recursive(true), Options),
  891      dir_file_path(Dir, H, SubDir),
  892      exists_directory(SubDir),
  893      !,
  894      catch(directory_files(SubDir, Files), _, fail)
  895    },
  896    !,
  897    src_files(Files, SubDir, Options),
  898    src_files(T, Dir, Options).
  899src_files([_|T], Dir, Options) -->
  900    src_files(T, Dir, Options).
  901
  902special(.).
  903special(..).
  904
  905% avoid dependency on library(filesex), which also pulls a foreign
  906% dependency.
  907dir_file_path(Dir, File, Path) :-
  908    (   sub_atom(Dir, _, _, 0, /)
  909    ->  atom_concat(Dir, File, Path)
  910    ;   atom_concat(Dir, /, TheDir),
  911        atom_concat(TheDir, File, Path)
  912    ).
  913
  914
  915%!  valid_term_position(@Term, @TermPos) is semidet.
  916%
  917%   Check that a Term has an   appropriate  TermPos layout. An incorrect
  918%   TermPos results in either failure of this predicate or an error.
  919%
  920%   If a position in TermPos  is  a   variable,  the  validation  of the
  921%   corresponding   part   of   Term   succeeds.    This   matches   the
  922%   term_expansion/4 treats "unknown" layout information.   If part of a
  923%   TermPos is given, then all its "from"   and "to" information must be
  924%   specified; for example,    string_position(X,Y)   is   an  error but
  925%   string_position(0,5) succeeds.   The position values are checked for
  926%   being plausible -- e.g., string_position(5,0) will fail.
  927%
  928%   This should always succeed:
  929%
  930%       read_term(Term, [subterm_positions(TermPos)]),
  931%       valid_term_position(Term, TermPos)
  932%
  933%   @arg Term Any Prolog term including a variable).
  934%   @arg TermPos The detailed layout of the term, for example
  935%        from using =|read_term(Term, subterm_positions(TermPos)|=.
  936%
  937%   @error existence_error(matching_rule, Subterm) if a subterm of Term
  938%          is inconsistent with the corresponding part of TermPos.
  939%
  940%   @see read_term/2, read_term/3, term_string/3
  941%   @see expand_term/4, term_expansion/4, expand_goal/4, expand_term/4
  942%   @see clause_info/4, clause_info/5
  943%   @see prolog_clause:unify_clause_hook/5
  944
  945valid_term_position(Term, TermPos) :-
  946    valid_term_position(0, 0x7fffffffffffffff, Term, TermPos).
  947
  948valid_term_position(OuterFrom, OuterTo, _Term, TermPos),
  949        var(TermPos),
  950        OuterFrom =< OuterTo => true.
  951valid_term_position(OuterFrom, OuterTo, Var, From-To),
  952        var(Var),
  953        valid_term_position_from_to(OuterFrom, OuterTo, From, To) => true.
  954valid_term_position(OuterFrom, OuterTo, Atom, From-To),
  955        atom(Atom),
  956        valid_term_position_from_to(OuterFrom, OuterTo, From, To) => true.
  957valid_term_position(OuterFrom, OuterTo, Number, From-To),
  958        number(Number),
  959        valid_term_position_from_to(OuterFrom, OuterTo, From, To) => true.
  960valid_term_position(OuterFrom, OuterTo, [], From-To),
  961        valid_term_position_from_to(OuterFrom, OuterTo, From, To) => true.
  962valid_term_position(OuterFrom, OuterTo, String, string_position(From,To)),
  963        (   string(String)
  964        ->  true
  965        ;   is_of_type(codes, String)
  966        ->  true
  967        ;   is_of_type(chars, String)
  968        ->  true
  969        ;   atom(String)
  970        ),
  971        valid_term_position_from_to(OuterFrom, OuterTo, From, To) => true.
  972valid_term_position(OuterFrom, OuterTo, {Arg},
  973                    brace_term_position(From,To,ArgPos)),
  974        valid_term_position_from_to(OuterFrom, OuterTo, From, To) =>
  975    valid_term_position(From, To, Arg, ArgPos).
  976valid_term_position(OuterFrom, OuterTo, [Hd|Tl],
  977                    list_position(From,To,ElemsPos,none)),
  978        valid_term_position_from_to(OuterFrom, OuterTo, From, To) =>
  979    term_position_list_tail([Hd|Tl], _HdPart, []),
  980    maplist(valid_term_position, [Hd|Tl], ElemsPos).
  981valid_term_position(OuterFrom, OuterTo, [Hd|Tl],
  982                    list_position(From, To, ElemsPos, TailPos)),
  983        valid_term_position_from_to(OuterFrom, OuterTo, From, To) =>
  984    term_position_list_tail([Hd|Tl], HdPart, Tail),
  985    maplist(valid_term_position(From,To), HdPart, ElemsPos),
  986    valid_term_position(Tail, TailPos).
  987valid_term_position(OuterFrom, OuterTo, Term,
  988                    term_position(From,To, FFrom,FTo,SubPos)),
  989        valid_term_position_from_to(OuterFrom, OuterTo, From, To) =>
  990    compound_name_arguments(Term, Name, Arguments),
  991    valid_term_position(Name, FFrom-FTo),
  992    maplist(valid_term_position(From,To), Arguments, SubPos).
  993valid_term_position(OuterFrom, OuterTo, Dict,
  994                    dict_position(From,To,TagFrom,TagTo,KeyValuePosList)),
  995        valid_term_position_from_to(OuterFrom, OuterTo, From, To) =>
  996    dict_pairs(Dict, Tag, Pairs),
  997    valid_term_position(Tag, TagFrom-TagTo),
  998    foldl(valid_term_position_dict(From,To), Pairs, KeyValuePosList, []).
  999% key_value_position(From, To, SepFrom, SepTo, Key, KeyPos, ValuePos)
 1000% is handled in valid_term_position_dict.
 1001valid_term_position(OuterFrom, OuterTo, Term,
 1002                    parentheses_term_position(From,To,ContentPos)),
 1003        valid_term_position_from_to(OuterFrom, OuterTo, From, To) =>
 1004    valid_term_position(From, To, Term, ContentPos).
 1005valid_term_position(OuterFrom, OuterTo, _Term,
 1006                    quasi_quotation_position(From,To,
 1007                                             SyntaxTerm,SyntaxPos,_ContentPos)),
 1008        valid_term_position_from_to(OuterFrom, OuterTo, From, To) =>
 1009    valid_term_position(From, To, SyntaxTerm, SyntaxPos).
 1010
 1011valid_term_position_from_to(OuterFrom, OuterTo, From, To) :-
 1012    integer(OuterFrom),
 1013    integer(OuterTo),
 1014    integer(From),
 1015    integer(To),
 1016    OuterFrom =< OuterTo,
 1017    From =< To,
 1018    OuterFrom =< From,
 1019    To =< OuterTo.
 1020
 1021:- det(valid_term_position_dict/5). 1022valid_term_position_dict(OuterFrom, OuterTo, Key-Value,
 1023                         KeyValuePosList0, KeyValuePosList1) :-
 1024    selectchk(key_value_position(From,To,SepFrom,SepTo,Key,KeyPos,ValuePos),
 1025              KeyValuePosList0, KeyValuePosList1),
 1026    valid_term_position_from_to(OuterFrom, OuterTo, From, To),
 1027    valid_term_position_from_to(OuterFrom, OuterTo, SepFrom, SepTo),
 1028    SepFrom >= OuterFrom,
 1029    valid_term_position(From, SepFrom, Key, KeyPos),
 1030    valid_term_position(SepTo, To, Value, ValuePos).
 1031
 1032%!  term_position_list_tail(@List, -HdPart, -Tail) is det.
 1033%
 1034%   Similar to append(HdPart, [Tail], List) for   proper lists, but also
 1035%   works for inproper lists, in which  case   it  unifies Tail with the
 1036%   tail of the partial list. HdPart is always a proper list:
 1037%
 1038%   ```
 1039%   ?- prolog_source:term_position_list_tail([a,b,c], Hd, Tl).
 1040%   Hd = [a, b, c],
 1041%   Tl = [].
 1042%   ?- prolog_source:term_position_list_tail([a,b|X], Hd, Tl).
 1043%   X = Tl,
 1044%   Hd = [a, b].
 1045%   ```
 1046
 1047:- det(term_position_list_tail/3). 1048term_position_list_tail([X|Xs], HdPart, Tail) =>
 1049    HdPart = [X|HdPart2],
 1050    term_position_list_tail(Xs, HdPart2, Tail).
 1051term_position_list_tail(Tail0, HdPart, Tail) =>
 1052    HdPart = [],
 1053    Tail0 = Tail.
 1054
 1055
 1056                 /*******************************
 1057                 *           MESSAGES           *
 1058                 *******************************/
 1059
 1060:- multifile
 1061    prolog:message//1. 1062
 1063prolog:message(quasi_quotation(undeclared, Syntax)) -->
 1064    [ 'Undeclared quasi quotation syntax: ~w'-[Syntax], nl,
 1065      'Autoloading can be defined using prolog:quasi_quotation_syntax/2'
 1066    ]