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