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