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