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