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).
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 *******************************/
This predicate is intended to read the file from the start. It tracks directives to update its notion of the currently effective syntax (e.g., declared operators).
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)).
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)).
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(_, _).
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(_,_,_).
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)).
This predicate has two ways to find the right syntax. If the file is loaded, it can be passed the module using the module option. This deals with module files that define the used operators globally for the file. Second, there is a hook prolog:alternate_syntax/4 that can be used to temporary redefine the syntax.
The options below are processed in addition to the options of
read_term/3. Note that the line and offset options are
mutually exclusive.
det).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(), 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(), 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(_, _).
Calls the hook prolog:alternate_syntax/4 with the same signature to allow for user-defined extensions.
452alternate_syntax(prolog, _, true, true). 453alternate_syntax(Syntax, M, Setup, Restore) :- 454 prolog:alternate_syntax(Syntax, M, Setup, Restore).
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(_, _).
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 *******************************/
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)).
This multifile hook is used by library(prolog_source) to load
quasi quotation handlers on demand.
549prologquasi_quotation_syntax(html, library(http/html_write)). 550prologquasi_quotation_syntax(javascript, library(http/js_write)). 551 552 553 /******************************* 554 * SOURCES * 555 *******************************/
process_source(Src) :-
prolog_open_source(Src, In),
call_cleanup(process(Src), prolog_close_source(In)).
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 )).
expand_term(end_of_file, _) to allow expansion
modules to clean-up.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 ).
force(true) is used.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 !.
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 ).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).
?- path_segments_atom(a/b/c, X). X = 'a/b/c'. ?- path_segments_atom(S, 'a/b/c'), display(S). /(/(a,b),c) S = a/b/c.
This predicate is part of the Prolog source library because SWI-Prolog allows writing paths as /-nested terms and source-code analysis programs often need this.
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 ).
true (default false), recurse into subdirectoriestrue (default loaded), only report loaded files.
Other options are passed to absolute_file_name/3, unless
loaded(true) is passed.
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 874prologmessage(quasi_quotation(undeclared, Syntax)) --> 875 [ 'Undeclared quasi quotation syntax: ~w'-[Syntax], nl, 876 'Autoloading can be defined using prolog:quasi_quotation_syntax/2' 877 ]
Examine Prolog source-files
This module provides predicates to open, close and read terms from Prolog source-files. This may seem easy, but there are a couple of problems that must be taken care of.
This module concentrates these issues in a single library. Intended users of the library are:
prolog_xref.plprolog_clause.plprolog_colour.pl*/