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, -Source, -Exports) 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, Source, Exports) :-
  368    absolute_file_name(Spec, Path,
  369                       [ file_type(prolog),
  370                         file_errors(fail),
  371                         access(read)
  372                       ]),
  373    module_decl_(Path, Source, Exports).
  374
  375module_decl_(Path, Source, Exports) :-
  376    file_name_extension(_, qlf, Path),
  377    !,
  378    '$qlf_module'(Path, Info),
  379    _{file:Source, exports:Exports} :< Info.
  380module_decl_(Path, Path, Exports) :-
  381    setup_call_cleanup(
  382        prolog_open_source(Path, In),
  383        read_module_decl(In, Exports),
  384        prolog_close_source(In)).
  385
  386read_module_decl(In, Decl) :-
  387    read(In, Term0),
  388    read_module_decl(Term0, In, Decl).
  389
  390read_module_decl((:- module(_, DeclIn)), _In, Decl) =>
  391    Decl = DeclIn.
  392read_module_decl((:- encoding(Enc)), In, Decl) =>
  393    set_stream(In, encoding(Enc)),
  394    read(In, Term2),
  395    read_module_decl(Term2, In, Decl).
  396read_module_decl(_, _, _) =>
  397    fail.
  398
  399
  400%!  read_source_term_at_location(+Stream, -Term, +Options) is semidet.
  401%
  402%   Try to read a Prolog term form   an  arbitrary location inside a
  403%   file. Due to Prolog's dynamic  syntax,   e.g.,  due  to operator
  404%   declarations that may change anywhere inside   the file, this is
  405%   theoreticaly   impossible.   Therefore,   this    predicate   is
  406%   fundamentally _heuristic_ and may fail.   This predicate is used
  407%   by e.g., clause_info/4 and by  PceEmacs   to  colour the current
  408%   clause.
  409%
  410%   This predicate has two ways to  find   the  right syntax. If the
  411%   file is loaded, it can be  passed   the  module using the module
  412%   option. This deals with  module  files   that  define  the  used
  413%   operators globally for  the  file.  Second,   there  is  a  hook
  414%   prolog:alternate_syntax/4 that can be used to temporary redefine
  415%   the syntax.
  416%
  417%   The options below are processed in   addition  to the options of
  418%   read_term/3. Note that  the  =line=   and  =offset=  options are
  419%   mutually exclusive.
  420%
  421%     * line(+Line)
  422%     If present, start reading at line Line.
  423%     * offset(+Characters)
  424%     Use seek/4 to go to the indicated location.  See seek/4
  425%     for limitations of seeking in text-files.
  426%     * module(+Module)
  427%     Use syntax from the given module. Default is the current
  428%     `source module'.
  429%     * operators(+List)
  430%     List of additional operator declarations to enforce while
  431%     reading the term.
  432%     * error(-Error)
  433%     If no correct parse can be found, unify Error with a term
  434%     Offset:Message that indicates the (character) location of
  435%     the error and the related message.  Adding this option
  436%     makes read_source_term_at_location/3 deterministic (=det=).
  437%
  438%   @see Use read_source_term/4 to read a file from the start.
  439%   @see prolog:alternate_syntax/4 for locally scoped operators.
  440
  441:- thread_local
  442    last_syntax_error/2.            % location, message
  443
  444read_source_term_at_location(Stream, Term, Options) :-
  445    retractall(last_syntax_error(_,_)),
  446    seek_to_start(Stream, Options),
  447    stream_property(Stream, position(Here)),
  448    '$current_source_module'(DefModule),
  449    option(module(Module), Options, DefModule),
  450    option(operators(Ops), Options, []),
  451    alternate_syntax(Syntax, Module, Setup, Restore),
  452    set_stream_position(Stream, Here),
  453    debug(read, 'Trying with syntax ~w', [Syntax]),
  454    push_operators(Module:Ops),
  455    call(Setup),
  456    Error = error(Formal,_),                 % do not catch timeout, etc.
  457    setup_call_cleanup(
  458        asserta(user:thread_message_hook(_,_,_), Ref), % silence messages
  459        catch(qq_read_term(Stream, Term0,
  460                           [ module(Module)
  461                           | Options
  462                           ]),
  463              Error,
  464              true),
  465        erase(Ref)),
  466    call(Restore),
  467    pop_operators,
  468    (   var(Formal)
  469    ->  !, Term = Term0
  470    ;   assert_error(Error, Options),
  471        fail
  472    ).
  473read_source_term_at_location(_, _, Options) :-
  474    option(error(Error), Options),
  475    !,
  476    setof(CharNo:Msg, retract(last_syntax_error(CharNo, Msg)), Pairs),
  477    last(Pairs, Error).
  478
  479assert_error(Error, Options) :-
  480    option(error(_), Options),
  481    !,
  482    (   (   Error = error(syntax_error(Id),
  483                          stream(_S1, _Line1, _LinePos1, CharNo))
  484        ;   Error = error(syntax_error(Id),
  485                          file(_S2, _Line2, _LinePos2, CharNo))
  486        )
  487    ->  message_to_string(error(syntax_error(Id), _), Msg),
  488        assertz(last_syntax_error(CharNo, Msg))
  489    ;   debug(read, 'Error: ~q', [Error]),
  490        throw(Error)
  491    ).
  492assert_error(_, _).
  493
  494
  495%!  alternate_syntax(?Syntax, +Module, -Setup, -Restore) is nondet.
  496%
  497%   Define an alternative  syntax  to  try   reading  a  term  at an
  498%   arbitrary location in module Module.
  499%
  500%   Calls the hook prolog:alternate_syntax/4 with the same signature
  501%   to allow for user-defined extensions.
  502%
  503%   @param  Setup is a deterministic goal to enable this syntax in
  504%           module.
  505%   @param  Restore is a deterministic goal to revert the actions of
  506%           Setup.
  507
  508alternate_syntax(prolog, _, true,  true).
  509alternate_syntax(Syntax, M, Setup, Restore) :-
  510    prolog:alternate_syntax(Syntax, M, Setup, Restore).
  511
  512
  513%!  seek_to_start(+Stream, +Options) is det.
  514%
  515%   Go to the location from where to start reading.
  516
  517seek_to_start(Stream, Options) :-
  518    option(line(Line), Options),
  519    !,
  520    seek(Stream, 0, bof, _),
  521    seek_to_line(Stream, Line).
  522seek_to_start(Stream, Options) :-
  523    option(offset(Start), Options),
  524    !,
  525    seek(Stream, Start, bof, _).
  526seek_to_start(_, _).
  527
  528%!  seek_to_line(+Stream, +Line)
  529%
  530%   Seek to indicated line-number.
  531
  532seek_to_line(Fd, N) :-
  533    N > 1,
  534    !,
  535    skip(Fd, 10),
  536    NN is N - 1,
  537    seek_to_line(Fd, NN).
  538seek_to_line(_, _).
  539
  540
  541                 /*******************************
  542                 *       QUASI QUOTATIONS       *
  543                 *******************************/
  544
  545%!  qq_read_term(+Stream, -Term, +Options)
  546%
  547%   Same  as  read_term/3,  but  dynamically    loads   known  quasi
  548%   quotations. Quasi quotations that  can   be  autoloaded  must be
  549%   defined using prolog:quasi_quotation_syntax/2.
  550
  551qq_read_term(Stream, Term, Options) :-
  552    select(syntax_errors(ErrorMode), Options, Options1),
  553    ErrorMode \== error,
  554    !,
  555    (   ErrorMode == dec10
  556    ->  repeat,
  557        qq_read_syntax_ex(Stream, Term, Options1, Error),
  558        (   var(Error)
  559        ->  !
  560        ;   print_message(error, Error),
  561            fail
  562        )
  563    ;   qq_read_syntax_ex(Stream, Term, Options1, Error),
  564        (   ErrorMode == fail
  565        ->  print_message(error, Error),
  566            fail
  567        ;   ErrorMode == quiet
  568        ->  fail
  569        ;   domain_error(syntax_errors, ErrorMode)
  570        )
  571    ).
  572qq_read_term(Stream, Term, Options) :-
  573    qq_read_term_ex(Stream, Term, Options).
  574
  575qq_read_syntax_ex(Stream, Term, Options, Error) :-
  576    catch(qq_read_term_ex(Stream, Term, Options),
  577          error(syntax_error(Syntax), Context),
  578          Error = error(Syntax, Context)).
  579
  580qq_read_term_ex(Stream, Term, Options) :-
  581    stream_property(Stream, position(Here)),
  582    catch(read_term(Stream, Term, Options),
  583          error(syntax_error(unknown_quasi_quotation_syntax(Syntax, Module)), Context),
  584          load_qq_and_retry(Here, Syntax, Module, Context, Stream, Term, Options)).
  585
  586load_qq_and_retry(Here, Syntax, Module, _, Stream, Term, Options) :-
  587    set_stream_position(Stream, Here),
  588    prolog:quasi_quotation_syntax(Syntax, Library),
  589    !,
  590    use_module(Module:Library, [Syntax/4]),
  591    read_term(Stream, Term, Options).
  592load_qq_and_retry(_Pos, Syntax, Module, Context, _Stream, _Term, _Options) :-
  593    print_message(warning, quasi_quotation(undeclared, Syntax)),
  594    throw(error(syntax_error(unknown_quasi_quotation_syntax(Syntax, Module)), Context)).
  595
  596%!  prolog:quasi_quotation_syntax(+Syntax, -Library) is semidet.
  597%
  598%   True when the quasi quotation syntax   Syntax can be loaded from
  599%   Library.  Library  must  be   a    valid   first   argument  for
  600%   use_module/2.
  601%
  602%   This multifile hook is used   by  library(prolog_source) to load
  603%   quasi quotation handlers on demand.
  604
  605prolog:quasi_quotation_syntax(html,       library(http/html_write)).
  606prolog:quasi_quotation_syntax(javascript, library(http/js_write)).
  607
  608
  609                 /*******************************
  610                 *           SOURCES            *
  611                 *******************************/
  612
  613%!  prolog_open_source(+CanonicalId:atomic, -Stream:stream) is det.
  614%
  615%   Open     source     with     given     canonical     id     (see
  616%   prolog_canonical_source/2)  and  remove  the  #!  line  if  any.
  617%   Streams  opened  using  this  predicate  must  be  closed  using
  618%   prolog_close_source/1. Typically using the skeleton below. Using
  619%   this   skeleton,   operator   and    style-check   options   are
  620%   automatically restored to the values before opening the source.
  621%
  622%   ==
  623%   process_source(Src) :-
  624%           prolog_open_source(Src, In),
  625%           call_cleanup(process(Src), prolog_close_source(In)).
  626%   ==
  627
  628prolog_open_source(Src, Fd) :-
  629    '$push_input_context'(source),
  630    catch((   prolog:xref_open_source(Src, Fd)
  631          ->  Hooked = true
  632          ;   open(Src, read, Fd),
  633              Hooked = false
  634          ), E,
  635          (   '$pop_input_context',
  636              throw(E)
  637          )),
  638    skip_hashbang(Fd),
  639    push_operators([]),
  640    '$current_source_module'(SM),
  641    '$save_lex_state'(LexState, []),
  642    asserta(open_source(Fd, state(Hooked, Src, LexState, SM))).
  643
  644skip_hashbang(Fd) :-
  645    catch((   peek_char(Fd, #)              % Deal with #! script
  646          ->  skip(Fd, 10)
  647          ;   true
  648          ), E,
  649          (   close(Fd, [force(true)]),
  650              '$pop_input_context',
  651              throw(E)
  652          )).
  653
  654%!  prolog:xref_open_source(+SourceID, -Stream)
  655%
  656%   Hook  to  open   an   xref   SourceID.    This   is   used   for
  657%   cross-referencing non-files, such as XPCE   buffers,  files from
  658%   archives,  git  repositories,   etc.    When   successful,   the
  659%   corresponding  prolog:xref_close_source/2  hook  is  called  for
  660%   closing the source.
  661
  662
  663%!  prolog_close_source(+In:stream) is det.
  664%
  665%   Close  a  stream  opened  using  prolog_open_source/2.  Restores
  666%   operator and style options. If the stream   has not been read to
  667%   the end, we call expand_term(end_of_file,  _) to allow expansion
  668%   modules to clean-up.
  669
  670prolog_close_source(In) :-
  671    call_cleanup(
  672        restore_source_context(In, Hooked, Src),
  673        close_source(Hooked, Src, In)).
  674
  675close_source(true, Src, In) :-
  676    catch(prolog:xref_close_source(Src, In), _, false),
  677    !,
  678    '$pop_input_context'.
  679close_source(_, _Src, In) :-
  680    close(In, [force(true)]),
  681    '$pop_input_context'.
  682
  683restore_source_context(In, Hooked, Src) :-
  684    (   at_end_of_stream(In)
  685    ->  true
  686    ;   ignore(catch(expand(end_of_file, _, In, _), _, true))
  687    ),
  688    pop_operators,
  689    retractall(mode(In, _)),
  690    (   retract(open_source(In, state(Hooked, Src, LexState, SM)))
  691    ->  '$restore_lex_state'(LexState),
  692        '$set_source_module'(SM)
  693    ;   assertion(fail)
  694    ).
  695
  696%!  prolog:xref_close_source(+SourceID, +Stream) is semidet.
  697%
  698%   Called by prolog_close_source/1 to  close   a  source previously
  699%   opened by the hook prolog:xref_open_source/2.  If the hook fails
  700%   close/2 using the option force(true) is used.
  701
  702%!  prolog_canonical_source(+SourceSpec:ground, -Id:atomic) is semidet.
  703%
  704%   Given a user-specification of a source,   generate  a unique and
  705%   indexable  identifier  for   it.   For    files   we   use   the
  706%   prolog_canonical absolute filename. Id must   be valid input for
  707%   prolog_open_source/2.
  708
  709prolog_canonical_source(Source, Src) :-
  710    var(Source),
  711    !,
  712    Src = Source.
  713prolog_canonical_source(User, user) :-
  714    User == user,
  715    !.
  716prolog_canonical_source(Src, Id) :-             % Call hook
  717    prolog:xref_source_identifier(Src, Id),
  718    !.
  719prolog_canonical_source(Source, Src) :-
  720    source_file(Source),
  721    !,
  722    Src = Source.
  723prolog_canonical_source(Source, Src) :-
  724    absolute_file_name(Source, Src,
  725                       [ file_type(prolog),
  726                         access(read),
  727                         file_errors(fail)
  728                       ]),
  729    !.
  730
  731
  732%!  file_name_on_path(+File:atom, -OnPath) is det.
  733%
  734%   True if OnPath a description of File   based  on the file search
  735%   path. This performs the inverse of absolute_file_name/3.
  736
  737file_name_on_path(Path, ShortId) :-
  738    (   file_alias_path(Alias, Dir),
  739        atom_concat(Dir, Local, Path)
  740    ->  (   Alias == '.'
  741        ->  ShortId = Local
  742        ;   file_name_extension(Base, pl, Local)
  743        ->  ShortId =.. [Alias, Base]
  744        ;   ShortId =.. [Alias, Local]
  745        )
  746    ;   ShortId = Path
  747    ).
  748
  749
  750%!  file_alias_path(-Alias, ?Dir) is nondet.
  751%
  752%   True if file Alias points to Dir.  Multiple solutions are
  753%   generated with the longest directory first.
  754
  755:- dynamic
  756    alias_cache/2.  757
  758file_alias_path(Alias, Dir) :-
  759    (   alias_cache(_, _)
  760    ->  true
  761    ;   build_alias_cache
  762    ),
  763    (   nonvar(Dir)
  764    ->  ensure_slash(Dir, DirSlash),
  765        alias_cache(Alias, DirSlash)
  766    ;   alias_cache(Alias, Dir)
  767    ).
  768
  769build_alias_cache :-
  770    findall(t(DirLen, AliasLen, Alias, Dir),
  771            search_path(Alias, Dir, AliasLen, DirLen), Ts),
  772    sort(0, >, Ts, List),
  773    forall(member(t(_, _, Alias, Dir), List),
  774           assert(alias_cache(Alias, Dir))).
  775
  776search_path('.', Here, 999, DirLen) :-
  777    working_directory(Here0, Here0),
  778    ensure_slash(Here0, Here),
  779    atom_length(Here, DirLen).
  780search_path(Alias, Dir, AliasLen, DirLen) :-
  781    user:file_search_path(Alias, _),
  782    Alias \== autoload,             % TBD: Multifile predicate?
  783    Alias \== noautoload,
  784    Spec =.. [Alias,'.'],
  785    atom_length(Alias, AliasLen0),
  786    AliasLen is 1000 - AliasLen0,   % must do reverse sort
  787    absolute_file_name(Spec, Dir0,
  788                       [ file_type(directory),
  789                         access(read),
  790                         solutions(all),
  791                         file_errors(fail)
  792                       ]),
  793    ensure_slash(Dir0, Dir),
  794    atom_length(Dir, DirLen).
  795
  796ensure_slash(Dir, Dir) :-
  797    sub_atom(Dir, _, _, 0, /),
  798    !.
  799ensure_slash(Dir0, Dir) :-
  800    atom_concat(Dir0, /, Dir).
  801
  802
  803%!  path_segments_atom(+Segments, -Atom) is det.
  804%!  path_segments_atom(-Segments, +Atom) is det.
  805%
  806%   Translate between a path  represented  as   a/b/c  and  an  atom
  807%   representing the same path. For example:
  808%
  809%     ==
  810%     ?- path_segments_atom(a/b/c, X).
  811%     X = 'a/b/c'.
  812%     ?- path_segments_atom(S, 'a/b/c'), display(S).
  813%     /(/(a,b),c)
  814%     S = a/b/c.
  815%     ==
  816%
  817%   This predicate is part of  the   Prolog  source  library because
  818%   SWI-Prolog  allows  writing  paths   as    /-nested   terms  and
  819%   source-code analysis programs often need this.
  820
  821path_segments_atom(Segments, Atom) :-
  822    var(Atom),
  823    !,
  824    (   atomic(Segments)
  825    ->  Atom = Segments
  826    ;   segments_to_list(Segments, List, [])
  827    ->  atomic_list_concat(List, /, Atom)
  828    ;   throw(error(type_error(file_path, Segments), _))
  829    ).
  830path_segments_atom(Segments, Atom) :-
  831    atomic_list_concat(List, /, Atom),
  832    parts_to_path(List, Segments).
  833
  834segments_to_list(Var, _, _) :-
  835    var(Var), !, fail.
  836segments_to_list(A/B, H, T) :-
  837    segments_to_list(A, H, T0),
  838    segments_to_list(B, T0, T).
  839segments_to_list(A, [A|T], T) :-
  840    atomic(A).
  841
  842parts_to_path([One], One) :- !.
  843parts_to_path(List, More/T) :-
  844    (   append(H, [T], List)
  845    ->  parts_to_path(H, More)
  846    ).
  847
  848%!  directory_source_files(+Dir, -Files, +Options) is det.
  849%
  850%   True when Files is a sorted list  of Prolog source files in Dir.
  851%   Options:
  852%
  853%     * recursive(boolean)
  854%     If =true= (default =false=), recurse into subdirectories
  855%     * if(Condition)
  856%     If =true= (default =loaded=), only report loaded files.
  857%
  858%   Other  options  are  passed    to  absolute_file_name/3,  unless
  859%   loaded(true) is passed.
  860
  861directory_source_files(Dir, SrcFiles, Options) :-
  862    option(if(loaded), Options, loaded),
  863    !,
  864    absolute_file_name(Dir, AbsDir, [file_type(directory), access(read)]),
  865    (   option(recursive(true), Options)
  866    ->  ensure_slash(AbsDir, Prefix),
  867        findall(F, (  source_file(F),
  868                      sub_atom(F, 0, _, _, Prefix)
  869                   ),
  870                SrcFiles)
  871    ;   findall(F, ( source_file(F),
  872                     file_directory_name(F, AbsDir)
  873                   ),
  874                SrcFiles)
  875    ).
  876directory_source_files(Dir, SrcFiles, Options) :-
  877    absolute_file_name(Dir, AbsDir, [file_type(directory), access(read)]),
  878    directory_files(AbsDir, Files),
  879    phrase(src_files(Files, AbsDir, Options), SrcFiles).
  880
  881src_files([], _, _) -->
  882    [].
  883src_files([H|T], Dir, Options) -->
  884    { file_name_extension(_, Ext, H),
  885      user:prolog_file_type(Ext, prolog),
  886      \+ user:prolog_file_type(Ext, qlf),
  887      dir_file_path(Dir, H, File0),
  888      absolute_file_name(File0, File,
  889                         [ file_errors(fail)
  890                         | Options
  891                         ])
  892    },
  893    !,
  894    [File],
  895    src_files(T, Dir, Options).
  896src_files([H|T], Dir, Options) -->
  897    { \+ special(H),
  898      option(recursive(true), Options),
  899      dir_file_path(Dir, H, SubDir),
  900      exists_directory(SubDir),
  901      !,
  902      catch(directory_files(SubDir, Files), _, fail)
  903    },
  904    !,
  905    src_files(Files, SubDir, Options),
  906    src_files(T, Dir, Options).
  907src_files([_|T], Dir, Options) -->
  908    src_files(T, Dir, Options).
  909
  910special(.).
  911special(..).
  912
  913% avoid dependency on library(filesex), which also pulls a foreign
  914% dependency.
  915dir_file_path(Dir, File, Path) :-
  916    (   sub_atom(Dir, _, _, 0, /)
  917    ->  atom_concat(Dir, File, Path)
  918    ;   atom_concat(Dir, /, TheDir),
  919        atom_concat(TheDir, File, Path)
  920    ).
  921
  922
  923%!  valid_term_position(@Term, @TermPos) is semidet.
  924%
  925%   Check that a Term has an   appropriate  TermPos layout. An incorrect
  926%   TermPos results in either failure of this predicate or an error.
  927%
  928%   If a position in TermPos  is  a   variable,  the  validation  of the
  929%   corresponding   part   of   Term   succeeds.    This   matches   the
  930%   term_expansion/4 treats "unknown" layout information.   If part of a
  931%   TermPos is given, then all its "from"   and "to" information must be
  932%   specified; for example,    string_position(X,Y)   is   an  error but
  933%   string_position(0,5) succeeds.   The position values are checked for
  934%   being plausible -- e.g., string_position(5,0) will fail.
  935%
  936%   This should always succeed:
  937%
  938%       read_term(Term, [subterm_positions(TermPos)]),
  939%       valid_term_position(Term, TermPos)
  940%
  941%   @arg Term Any Prolog term including a variable).
  942%   @arg TermPos The detailed layout of the term, for example
  943%        from using =|read_term(Term, subterm_positions(TermPos)|=.
  944%
  945%   @error existence_error(matching_rule, Subterm) if a subterm of Term
  946%          is inconsistent with the corresponding part of TermPos.
  947%
  948%   @see read_term/2, read_term/3, term_string/3
  949%   @see expand_term/4, term_expansion/4, expand_goal/4, expand_term/4
  950%   @see clause_info/4, clause_info/5
  951%   @see prolog_clause:unify_clause_hook/5
  952
  953valid_term_position(Term, TermPos) :-
  954    valid_term_position(0, 0x7fffffffffffffff, Term, TermPos).
  955
  956valid_term_position(OuterFrom, OuterTo, _Term, TermPos),
  957        var(TermPos),
  958        OuterFrom =< OuterTo => true.
  959valid_term_position(OuterFrom, OuterTo, Var, From-To),
  960        var(Var),
  961        valid_term_position_from_to(OuterFrom, OuterTo, From, To) => true.
  962valid_term_position(OuterFrom, OuterTo, Atom, From-To),
  963        atom(Atom),
  964        valid_term_position_from_to(OuterFrom, OuterTo, From, To) => true.
  965valid_term_position(OuterFrom, OuterTo, Number, From-To),
  966        number(Number),
  967        valid_term_position_from_to(OuterFrom, OuterTo, From, To) => true.
  968valid_term_position(OuterFrom, OuterTo, [], From-To),
  969        valid_term_position_from_to(OuterFrom, OuterTo, From, To) => true.
  970valid_term_position(OuterFrom, OuterTo, String, string_position(From,To)),
  971        (   string(String)
  972        ->  true
  973        ;   is_of_type(codes, String)
  974        ->  true
  975        ;   is_of_type(chars, String)
  976        ->  true
  977        ;   atom(String)
  978        ),
  979        valid_term_position_from_to(OuterFrom, OuterTo, From, To) => true.
  980valid_term_position(OuterFrom, OuterTo, {Arg},
  981                    brace_term_position(From,To,ArgPos)),
  982        valid_term_position_from_to(OuterFrom, OuterTo, From, To) =>
  983    valid_term_position(From, To, Arg, ArgPos).
  984valid_term_position(OuterFrom, OuterTo, [Hd|Tl],
  985                    list_position(From,To,ElemsPos,none)),
  986        valid_term_position_from_to(OuterFrom, OuterTo, From, To) =>
  987    term_position_list_tail([Hd|Tl], _HdPart, []),
  988    maplist(valid_term_position, [Hd|Tl], ElemsPos).
  989valid_term_position(OuterFrom, OuterTo, [Hd|Tl],
  990                    list_position(From, To, ElemsPos, TailPos)),
  991        valid_term_position_from_to(OuterFrom, OuterTo, From, To) =>
  992    term_position_list_tail([Hd|Tl], HdPart, Tail),
  993    maplist(valid_term_position(From,To), HdPart, ElemsPos),
  994    valid_term_position(Tail, TailPos).
  995valid_term_position(OuterFrom, OuterTo, Term,
  996                    term_position(From,To, FFrom,FTo,SubPos)),
  997        valid_term_position_from_to(OuterFrom, OuterTo, From, To) =>
  998    compound_name_arguments(Term, Name, Arguments),
  999    valid_term_position(Name, FFrom-FTo),
 1000    maplist(valid_term_position(From,To), Arguments, SubPos).
 1001valid_term_position(OuterFrom, OuterTo, Dict,
 1002                    dict_position(From,To,TagFrom,TagTo,KeyValuePosList)),
 1003        valid_term_position_from_to(OuterFrom, OuterTo, From, To) =>
 1004    dict_pairs(Dict, Tag, Pairs),
 1005    valid_term_position(Tag, TagFrom-TagTo),
 1006    foldl(valid_term_position_dict(From,To), Pairs, KeyValuePosList, []).
 1007% key_value_position(From, To, SepFrom, SepTo, Key, KeyPos, ValuePos)
 1008% is handled in valid_term_position_dict.
 1009valid_term_position(OuterFrom, OuterTo, Term,
 1010                    parentheses_term_position(From,To,ContentPos)),
 1011        valid_term_position_from_to(OuterFrom, OuterTo, From, To) =>
 1012    valid_term_position(From, To, Term, ContentPos).
 1013valid_term_position(OuterFrom, OuterTo, _Term,
 1014                    quasi_quotation_position(From,To,
 1015                                             SyntaxTerm,SyntaxPos,_ContentPos)),
 1016        valid_term_position_from_to(OuterFrom, OuterTo, From, To) =>
 1017    valid_term_position(From, To, SyntaxTerm, SyntaxPos).
 1018
 1019valid_term_position_from_to(OuterFrom, OuterTo, From, To) :-
 1020    integer(OuterFrom),
 1021    integer(OuterTo),
 1022    integer(From),
 1023    integer(To),
 1024    OuterFrom =< OuterTo,
 1025    From =< To,
 1026    OuterFrom =< From,
 1027    To =< OuterTo.
 1028
 1029:- det(valid_term_position_dict/5). 1030valid_term_position_dict(OuterFrom, OuterTo, Key-Value,
 1031                         KeyValuePosList0, KeyValuePosList1) :-
 1032    selectchk(key_value_position(From,To,SepFrom,SepTo,Key,KeyPos,ValuePos),
 1033              KeyValuePosList0, KeyValuePosList1),
 1034    valid_term_position_from_to(OuterFrom, OuterTo, From, To),
 1035    valid_term_position_from_to(OuterFrom, OuterTo, SepFrom, SepTo),
 1036    SepFrom >= OuterFrom,
 1037    valid_term_position(From, SepFrom, Key, KeyPos),
 1038    valid_term_position(SepTo, To, Value, ValuePos).
 1039
 1040%!  term_position_list_tail(@List, -HdPart, -Tail) is det.
 1041%
 1042%   Similar to append(HdPart, [Tail], List) for   proper lists, but also
 1043%   works for inproper lists, in which  case   it  unifies Tail with the
 1044%   tail of the partial list. HdPart is always a proper list:
 1045%
 1046%   ```
 1047%   ?- prolog_source:term_position_list_tail([a,b,c], Hd, Tl).
 1048%   Hd = [a, b, c],
 1049%   Tl = [].
 1050%   ?- prolog_source:term_position_list_tail([a,b|X], Hd, Tl).
 1051%   X = Tl,
 1052%   Hd = [a, b].
 1053%   ```
 1054
 1055:- det(term_position_list_tail/3). 1056term_position_list_tail([X|Xs], HdPart, Tail) =>
 1057    HdPart = [X|HdPart2],
 1058    term_position_list_tail(Xs, HdPart2, Tail).
 1059term_position_list_tail(Tail0, HdPart, Tail) =>
 1060    HdPart = [],
 1061    Tail0 = Tail.
 1062
 1063
 1064                 /*******************************
 1065                 *           MESSAGES           *
 1066                 *******************************/
 1067
 1068:- multifile
 1069    prolog:message//1. 1070
 1071prolog:message(quasi_quotation(undeclared, Syntax)) -->
 1072    [ 'Undeclared quasi quotation syntax: ~w'-[Syntax], nl,
 1073      'Autoloading can be defined using prolog:quasi_quotation_syntax/2'
 1074    ]