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