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