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-2022, University of Amsterdam 7 VU University Amsterdam 8 SWI-Prolog Solutions b.v. 9 All rights reserved. 10 11 Redistribution and use in source and binary forms, with or without 12 modification, are permitted provided that the following conditions 13 are met: 14 15 1. Redistributions of source code must retain the above copyright 16 notice, this list of conditions and the following disclaimer. 17 18 2. Redistributions in binary form must reproduce the above copyright 19 notice, this list of conditions and the following disclaimer in 20 the documentation and/or other materials provided with the 21 distribution. 22 23 THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS 24 "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT 25 LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS 26 FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE 27 COPYRIGHT OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, 28 INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, 29 BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; 30 LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER 31 CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT 32 LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN 33 ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE 34 POSSIBILITY OF SUCH DAMAGE. 35*/ 36 37:- module(prolog_source, 38 [ prolog_read_source_term/4, % +Stream, -Term, -Expanded, +Options 39 read_source_term_at_location/3, %Stream, -Term, +Options 40 prolog_open_source/2, % +Source, -Stream 41 prolog_close_source/1, % +Stream 42 prolog_canonical_source/2, % +Spec, -Id 43 44 load_quasi_quotation_syntax/2, % :Path, +Syntax 45 46 file_name_on_path/2, % +File, -PathSpec 47 file_alias_path/2, % ?Alias, ?Dir 48 path_segments_atom/2, % ?Segments, ?Atom 49 directory_source_files/3, % +Dir, -Files, +Options 50 valid_term_position/2 % +Term, +TermPos 51 ]). 52:- use_module(library(debug), [debug/3, assertion/1]). 53:- autoload(library(apply), [maplist/2, maplist/3, foldl/4]). 54:- autoload(library(error), [domain_error/2, is_of_type/2]). 55:- autoload(library(lists), [member/2, last/2, select/3, append/3, selectchk/3]). 56:- autoload(library(operators), [push_op/3, push_operators/1, pop_operators/0]). 57:- autoload(library(option), [select_option/4, option/3, option/2]).
83:- thread_local 84 open_source/2, % Stream, State 85 mode/2. % Stream, Data 86 87:- multifile 88 requires_library/2, 89 prolog:xref_source_identifier/2, % +Source, -Id 90 prolog:xref_source_time/2, % +Source, -Modified 91 prolog:xref_open_source/2, % +SourceId, -Stream 92 prolog:xref_close_source/2, % +SourceId, -Stream 93 prolog:alternate_syntax/4, % Syntax, +Module, -Setup, -Restore 94 prolog:xref_update_syntax/2, % +Directive, +Module 95 prolog:quasi_quotation_syntax/2. % Syntax, Library 96 97 98:- predicate_options(prolog_read_source_term/4, 4, 99 [ pass_to(system:read_clause/3, 3) 100 ]). 101:- predicate_options(read_source_term_at_location/3, 3, 102 [ line(integer), 103 offset(integer), 104 module(atom), 105 operators(list), 106 error(-any), 107 pass_to(system:read_term/3, 3) 108 ]). 109:- predicate_options(directory_source_files/3, 3, 110 [ recursive(boolean), 111 if(oneof([true,loaded])), 112 pass_to(system:absolute_file_name/3,3) 113 ]). 114 115 116 /******************************* 117 * READING * 118 *******************************/
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).
134prolog_read_source_term(In, Term, Expanded, Options) :- 135 maplist(read_clause_option, Options), 136 !, 137 select_option(subterm_positions(TermPos), Options, 138 RestOptions, TermPos), 139 read_clause(In, Term, 140 [ subterm_positions(TermPos) 141 | RestOptions 142 ]), 143 expand(Term, TermPos, In, Expanded), 144 '$current_source_module'(M), 145 update_state(Term, Expanded, M). 146prolog_read_source_term(In, Term, Expanded, Options) :- 147 '$current_source_module'(M), 148 select_option(syntax_errors(SE), Options, RestOptions0, dec10), 149 select_option(subterm_positions(TermPos), RestOptions0, 150 RestOptions, TermPos), 151 ( style_check(?(singleton)) 152 -> FinalOptions = [ singletons(warning) | RestOptions ] 153 ; FinalOptions = RestOptions 154 ), 155 read_term(In, Term, 156 [ module(M), 157 syntax_errors(SE), 158 subterm_positions(TermPos) 159 | FinalOptions 160 ]), 161 expand(Term, TermPos, In, Expanded), 162 update_state(Term, Expanded, M). 163 164read_clause_option(syntax_errors(_)). 165read_clause_option(term_position(_)). 166read_clause_option(process_comment(_)). 167read_clause_option(comments(_)). 168 169:- public 170 expand/3. % Used by Prolog colour 171 172expand(Term, In, Exp) :- 173 expand(Term, _, In, Exp). 174 175expand(Var, _, _, Var) :- 176 var(Var), 177 !. 178expand(Term, _, _, Term) :- 179 no_expand(Term), 180 !. 181expand(Term, _, _, _) :- 182 requires_library(Term, Lib), 183 ensure_loaded(user:Lib), 184 fail. 185expand(Term, _, In, Term) :- 186 chr_expandable(Term, In), 187 !. 188expand(Term, Pos, _, Expanded) :- 189 expand_term(Term, Pos, Expanded, _). 190 191no_expand((:- if(_))). 192no_expand((:- elif(_))). 193no_expand((:- else)). 194no_expand((:- endif)). 195no_expand((:- require(_))). 196 197chr_expandable((:- chr_constraint(_)), In) :- 198 add_mode(In, chr). 199chr_expandable((handler(_)), In) :- 200 mode(In, chr). 201chr_expandable((rules(_)), In) :- 202 mode(In, chr). 203chr_expandable(<=>(_, _), In) :- 204 mode(In, chr). 205chr_expandable(@(_, _), In) :- 206 mode(In, chr). 207chr_expandable(==>(_, _), In) :- 208 mode(In, chr). 209chr_expandable(pragma(_, _), In) :- 210 mode(In, chr). 211chr_expandable(option(_, _), In) :- 212 mode(In, chr). 213 214add_mode(Stream, Mode) :- 215 mode(Stream, Mode), 216 !. 217add_mode(Stream, Mode) :- 218 asserta(mode(Stream, Mode)).
224requires_library((:- emacs_begin_mode(_,_,_,_,_)), library(emacs_extend)). 225requires_library((:- draw_begin_shape(_,_,_,_)), library(pcedraw)). 226requires_library((:- use_module(library(pce))), library(pce)). 227requires_library((:- pce_begin_class(_,_)), library(pce)). 228requires_library((:- pce_begin_class(_,_,_)), library(pce)).
234:- multifile 235 pce_expansion:push_compile_operators/1, 236 pce_expansion:pop_compile_operators/0. 237 238update_state(Raw, _, _) :- 239 Raw == (:- pce_end_class), 240 !, 241 ignore(pce_expansion:pop_compile_operators). 242update_state(Raw, _, SM) :- 243 subsumes_term((:- pce_extend_class(_)), Raw), 244 !, 245 pce_expansion:push_compile_operators(SM). 246update_state(_Raw, Expanded, M) :- 247 update_state(Expanded, M). 248 249update_state(Var, _) :- 250 var(Var), 251 !. 252update_state([], _) :- 253 !. 254update_state([H|T], M) :- 255 !, 256 update_state(H, M), 257 update_state(T, M). 258update_state((:- Directive), M) :- 259 nonvar(Directive), 260 !, 261 catch(update_directive(Directive, M), _, true). 262update_state((?- Directive), M) :- 263 !, 264 update_state((:- Directive), M). 265update_state(_, _). 266 267update_directive(Directive, Module) :- 268 prolog:xref_update_syntax(Directive, Module), 269 !. 270update_directive(module(Module, Public), _) :- 271 atom(Module), 272 is_list(Public), 273 !, 274 '$set_source_module'(Module), 275 maplist(import_syntax(_,Module, _), Public). 276update_directive(M:op(P,T,N), SM) :- 277 atom(M), 278 ground(op(P,T,N)), 279 !, 280 update_directive(op(P,T,N), SM). 281update_directive(op(P,T,N), SM) :- 282 ground(op(P,T,N)), 283 !, 284 strip_module(SM:N, M, PN), 285 push_op(P,T,M:PN). 286update_directive(style_check(Style), _) :- 287 ground(Style), 288 style_check(Style), 289 !. 290update_directive(use_module(Spec), SM) :- 291 ground(Spec), 292 catch(module_decl(Spec, Path, Public), _, fail), 293 is_list(Public), 294 !, 295 maplist(import_syntax(Path, SM, _), Public). 296update_directive(use_module(Spec, Imports), SM) :- 297 ground(Spec), 298 is_list(Imports), 299 catch(module_decl(Spec, Path, Public), _, fail), 300 is_list(Public), 301 !, 302 maplist(import_syntax(Path, SM, Imports), Public). 303update_directive(pce_begin_class_definition(_,_,_,_), SM) :- 304 pce_expansion:push_compile_operators(SM), 305 !. 306update_directive(_, _).
313import_syntax(_, _, _, Var) :- 314 var(Var), 315 !. 316import_syntax(_, M, Imports, Op) :- 317 Op = op(_,_,_), 318 \+ \+ member(Op, Imports), 319 !, 320 update_directive(Op, M). 321import_syntax(Path, SM, Imports, Syntax/4) :- 322 \+ \+ member(Syntax/4, Imports), 323 load_quasi_quotation_syntax(SM:Path, Syntax), 324 !. 325import_syntax(_,_,_, _).
342load_quasi_quotation_syntax(SM:Path, Syntax) :- 343 atom(Path), atom(Syntax), 344 source_file_property(Path, module(M)), 345 functor(ST, Syntax, 4), 346 predicate_property(M:ST, quasi_quotation_syntax), 347 !, 348 use_module(SM:Path, [Syntax/4]). 349load_quasi_quotation_syntax(SM:Path, Syntax) :- 350 atom(Path), atom(Syntax), 351 prolog:quasi_quotation_syntax(Syntax, Spec), 352 absolute_file_name(Spec, Path2, 353 [ file_type(prolog), 354 file_errors(fail), 355 access(read) 356 ]), 357 Path == Path2, 358 !, 359 use_module(SM:Path, [Syntax/4]).
367module_decl(Spec, Source, Exports) :- 368 absolute_file_name(Spec, Path, 369 [ file_type(prolog), 370 file_errors(fail), 371 access(read) 372 ]), 373 module_decl_(Path, Source, Exports). 374 375module_decl_(Path, Source, Exports) :- 376 file_name_extension(_, qlf, Path), 377 !, 378 '$qlf_module'(Path, Info), 379 _{file:Source, exports:Exports} :< Info. 380module_decl_(Path, Path, Exports) :- 381 setup_call_cleanup( 382 prolog_open_source(Path, In), 383 read_module_decl(In, Exports), 384 prolog_close_source(In)). 385 386read_module_decl(In, Decl) :- 387 read(In, Term0), 388 read_module_decl(Term0, In, Decl). 389 390read_module_decl((:- module(_, DeclIn)), _In, Decl) => 391 Decl = DeclIn. 392read_module_decl((:- encoding(Enc)), In, Decl) => 393 set_stream(In, encoding(Enc)), 394 read(In, Term2), 395 read_module_decl(Term2, In, Decl). 396read_module_decl(_, _, _) => 397 fail.
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 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
).441:- thread_local 442 last_syntax_error/2. % location, message 443 444read_source_term_at_location(Stream, Term, Options) :- 445 retractall(last_syntax_error(_,_)), 446 seek_to_start(Stream, Options), 447 stream_property(Stream, position(Here)), 448 '$current_source_module'(DefModule), 449 option(module(Module), Options, DefModule), 450 option(operators(Ops), Options, []), 451 alternate_syntax(Syntax, Module, Setup, Restore), 452 set_stream_position(Stream, Here), 453 debug(read, 'Trying with syntax ~w', [Syntax]), 454 push_operators(Module:Ops), 455 call(Setup), 456 Error = error(Formal,_), % do not catch timeout, etc. 457 setup_call_cleanup( 458 asserta(user:thread_message_hook(_,_,_), Ref), % silence messages 459 catch(qq_read_term(Stream, Term0, 460 [ module(Module) 461 | Options 462 ]), 463 Error, 464 true), 465 erase(Ref)), 466 call(Restore), 467 pop_operators, 468 ( var(Formal) 469 -> !, Term = Term0 470 ; assert_error(Error, Options), 471 fail 472 ). 473read_source_term_at_location(_, _, Options) :- 474 option(error(Error), Options), 475 !, 476 setof(CharNo:Msg, retract(last_syntax_error(CharNo, Msg)), Pairs), 477 last(Pairs, Error). 478 479assert_error(Error, Options) :- 480 option(error(_), Options), 481 !, 482 ( ( Error = error(syntax_error(Id), 483 stream(_S1, _Line1, _LinePos1, CharNo)) 484 ; Error = error(syntax_error(Id), 485 file(_S2, _Line2, _LinePos2, CharNo)) 486 ) 487 -> message_to_string(error(syntax_error(Id), _), Msg), 488 assertz(last_syntax_error(CharNo, Msg)) 489 ; debug(read, 'Error: ~q', [Error]), 490 throw(Error) 491 ). 492assert_error(_, _).
Calls the hook alternate_syntax/4 with the same signature to allow for user-defined extensions.
508alternate_syntax(prolog, _, true, true). 509alternate_syntax(Syntax, M, Setup, Restore) :- 510 prolog:alternate_syntax(Syntax, M, Setup, Restore).
517seek_to_start(Stream, Options) :- 518 option(line(Line), Options), 519 !, 520 seek(Stream, 0, bof, _), 521 seek_to_line(Stream, Line). 522seek_to_start(Stream, Options) :- 523 option(offset(Start), Options), 524 !, 525 seek(Stream, Start, bof, _). 526seek_to_start(_, _).
532seek_to_line(Fd, N) :- 533 N > 1, 534 !, 535 skip(Fd, 10), 536 NN is N - 1, 537 seek_to_line(Fd, NN). 538seek_to_line(_, _). 539 540 541 /******************************* 542 * QUASI QUOTATIONS * 543 *******************************/
551qq_read_term(Stream, Term, Options) :- 552 select(syntax_errors(ErrorMode), Options, Options1), 553 ErrorMode \== error, 554 !, 555 ( ErrorMode == dec10 556 -> repeat, 557 qq_read_syntax_ex(Stream, Term, Options1, Error), 558 ( var(Error) 559 -> ! 560 ; print_message(error, Error), 561 fail 562 ) 563 ; qq_read_syntax_ex(Stream, Term, Options1, Error), 564 ( ErrorMode == fail 565 -> print_message(error, Error), 566 fail 567 ; ErrorMode == quiet 568 -> fail 569 ; domain_error(syntax_errors, ErrorMode) 570 ) 571 ). 572qq_read_term(Stream, Term, Options) :- 573 qq_read_term_ex(Stream, Term, Options). 574 575qq_read_syntax_ex(Stream, Term, Options, Error) :- 576 catch(qq_read_term_ex(Stream, Term, Options), 577 error(syntax_error(Syntax), Context), 578 Error = error(Syntax, Context)). 579 580qq_read_term_ex(Stream, Term, Options) :- 581 stream_property(Stream, position(Here)), 582 catch(read_term(Stream, Term, Options), 583 error(syntax_error(unknown_quasi_quotation_syntax(Syntax, Module)), Context), 584 load_qq_and_retry(Here, Syntax, Module, Context, Stream, Term, Options)). 585 586load_qq_and_retry(Here, Syntax, Module, _, Stream, Term, Options) :- 587 set_stream_position(Stream, Here), 588 prolog:quasi_quotation_syntax(Syntax, Library), 589 !, 590 use_module(Module:Library, [Syntax/4]), 591 read_term(Stream, Term, Options). 592load_qq_and_retry(_Pos, Syntax, Module, Context, _Stream, _Term, _Options) :- 593 print_message(warning, quasi_quotation(undeclared, Syntax)), 594 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.
605prologquasi_quotation_syntax(html, library(http/html_write)). 606prologquasi_quotation_syntax(javascript, library(http/js_write)). 607 608 609 /******************************* 610 * SOURCES * 611 *******************************/
process_source(Src) :- prolog_open_source(Src, In), call_cleanup(process(Src), prolog_close_source(In)).
628prolog_open_source(Src, Fd) :- 629 '$push_input_context'(source), 630 catch(( prolog:xref_open_source(Src, Fd) 631 -> Hooked = true 632 ; open(Src, read, Fd), 633 Hooked = false 634 ), E, 635 ( '$pop_input_context', 636 throw(E) 637 )), 638 skip_hashbang(Fd), 639 push_operators([]), 640 '$current_source_module'(SM), 641 '$save_lex_state'(LexState, []), 642 asserta(open_source(Fd, state(Hooked, Src, LexState, SM))). 643 644skip_hashbang(Fd) :- 645 catch(( peek_char(Fd, #) % Deal with #! script 646 -> skip(Fd, 10) 647 ; true 648 ), E, 649 ( close(Fd, [force(true)]), 650 '$pop_input_context', 651 throw(E) 652 )).
expand_term(end_of_file, _)
to allow expansion
modules to clean-up.670prolog_close_source(In) :- 671 call_cleanup( 672 restore_source_context(In, Hooked, Src), 673 close_source(Hooked, Src, In)). 674 675close_source(true, Src, In) :- 676 catch(prolog:xref_close_source(Src, In), _, false), 677 !, 678 '$pop_input_context'. 679close_source(_, _Src, In) :- 680 close(In, [force(true)]), 681 '$pop_input_context'. 682 683restore_source_context(In, Hooked, Src) :- 684 ( at_end_of_stream(In) 685 -> true 686 ; ignore(catch(expand(end_of_file, _, In, _), _, true)) 687 ), 688 pop_operators, 689 retractall(mode(In, _)), 690 ( retract(open_source(In, state(Hooked, Src, LexState, SM))) 691 -> '$restore_lex_state'(LexState), 692 '$set_source_module'(SM) 693 ; assertion(fail) 694 ).
force(true)
is used.709prolog_canonical_source(Source, Src) :- 710 var(Source), 711 !, 712 Src = Source. 713prolog_canonical_source(User, user) :- 714 User == user, 715 !. 716prolog_canonical_source(Src, Id) :- % Call hook 717 prolog:xref_source_identifier(Src, Id), 718 !. 719prolog_canonical_source(Source, Src) :- 720 source_file(Source), 721 !, 722 Src = Source. 723prolog_canonical_source(Source, Src) :- 724 absolute_file_name(Source, Src, 725 [ file_type(prolog), 726 access(read), 727 file_errors(fail) 728 ]), 729 !.
737file_name_on_path(Path, ShortId) :-
738 ( file_alias_path(Alias, Dir),
739 atom_concat(Dir, Local, Path)
740 -> ( Alias == '.'
741 -> ShortId = Local
742 ; file_name_extension(Base, pl, Local)
743 -> ShortId =.. [Alias, Base]
744 ; ShortId =.. [Alias, Local]
745 )
746 ; ShortId = Path
747 ).
755:- dynamic 756 alias_cache/2. 757 758file_alias_path(Alias, Dir) :- 759 ( alias_cache(_, _) 760 -> true 761 ; build_alias_cache 762 ), 763 ( nonvar(Dir) 764 -> ensure_slash(Dir, DirSlash), 765 alias_cache(Alias, DirSlash) 766 ; alias_cache(Alias, Dir) 767 ). 768 769build_alias_cache :- 770 findall(t(DirLen, AliasLen, Alias, Dir), 771 search_path(Alias, Dir, AliasLen, DirLen), Ts), 772 sort(0, >, Ts, List), 773 forall(member(t(_, _, Alias, Dir), List), 774 assert(alias_cache(Alias, Dir))). 775 776search_path('.', Here, 999, DirLen) :- 777 working_directory(Here0, Here0), 778 ensure_slash(Here0, Here), 779 atom_length(Here, DirLen). 780search_path(Alias, Dir, AliasLen, DirLen) :- 781 user:file_search_path(Alias, _), 782 Alias \== autoload, % TBD: Multifile predicate? 783 Alias \== noautoload, 784 Spec =.. [Alias,'.'], 785 atom_length(Alias, AliasLen0), 786 AliasLen is 1000 - AliasLen0, % must do reverse sort 787 absolute_file_name(Spec, Dir0, 788 [ file_type(directory), 789 access(read), 790 solutions(all), 791 file_errors(fail) 792 ]), 793 ensure_slash(Dir0, Dir), 794 atom_length(Dir, DirLen). 795 796ensure_slash(Dir, Dir) :- 797 sub_atom(Dir, _, _, 0, /), 798 !. 799ensure_slash(Dir0, Dir) :- 800 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.
821path_segments_atom(Segments, Atom) :- 822 var(Atom), 823 !, 824 ( atomic(Segments) 825 -> Atom = Segments 826 ; segments_to_list(Segments, List, []) 827 -> atomic_list_concat(List, /, Atom) 828 ; throw(error(type_error(file_path, Segments), _)) 829 ). 830path_segments_atom(Segments, Atom) :- 831 atomic_list_concat(List, /, Atom), 832 parts_to_path(List, Segments). 833 834segments_to_list(Var, _, _) :- 835 var(Var), !, fail. 836segments_to_list(A/B, H, T) :- 837 segments_to_list(A, H, T0), 838 segments_to_list(B, T0, T). 839segments_to_list(A, [A|T], T) :- 840 atomic(A). 841 842parts_to_path([One], One) :- !. 843parts_to_path(List, More/T) :- 844 ( append(H, [T], List) 845 -> parts_to_path(H, More) 846 ).
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.
861directory_source_files(Dir, SrcFiles, Options) :- 862 option(if(loaded), Options, loaded), 863 !, 864 absolute_file_name(Dir, AbsDir, [file_type(directory), access(read)]), 865 ( option(recursive(true), Options) 866 -> ensure_slash(AbsDir, Prefix), 867 findall(F, ( source_file(F), 868 sub_atom(F, 0, _, _, Prefix) 869 ), 870 SrcFiles) 871 ; findall(F, ( source_file(F), 872 file_directory_name(F, AbsDir) 873 ), 874 SrcFiles) 875 ). 876directory_source_files(Dir, SrcFiles, Options) :- 877 absolute_file_name(Dir, AbsDir, [file_type(directory), access(read)]), 878 directory_files(AbsDir, Files), 879 phrase(src_files(Files, AbsDir, Options), SrcFiles). 880 881src_files([], _, _) --> 882 []. 883src_files([H|T], Dir, Options) --> 884 { file_name_extension(_, Ext, H), 885 user:prolog_file_type(Ext, prolog), 886 \+ user:prolog_file_type(Ext, qlf), 887 dir_file_path(Dir, H, File0), 888 absolute_file_name(File0, File, 889 [ file_errors(fail) 890 | Options 891 ]) 892 }, 893 !, 894 [File], 895 src_files(T, Dir, Options). 896src_files([H|T], Dir, Options) --> 897 { \+ special(H), 898 option(recursive(true), Options), 899 dir_file_path(Dir, H, SubDir), 900 exists_directory(SubDir), 901 !, 902 catch(directory_files(SubDir, Files), _, fail) 903 }, 904 !, 905 src_files(Files, SubDir, Options), 906 src_files(T, Dir, Options). 907src_files([_|T], Dir, Options) --> 908 src_files(T, Dir, Options). 909 910special(.). 911special(..). 912 913% avoid dependency on library(filesex), which also pulls a foreign 914% dependency. 915dir_file_path(Dir, File, Path) :- 916 ( sub_atom(Dir, _, _, 0, /) 917 -> atom_concat(Dir, File, Path) 918 ; atom_concat(Dir, /, TheDir), 919 atom_concat(TheDir, File, Path) 920 ).
If a position in TermPos is a variable, the validation of the
corresponding part of Term succeeds. This matches the
term_expansion/4 treats "unknown" layout information. If part of a
TermPos is given, then all its "from" and "to" information must be
specified; for example, string_position(X,Y)
is an error but
string_position(0,5)
succeeds. The position values are checked for
being plausible -- e.g., string_position(5,0)
will fail.
This should always succeed:
read_term(Term, [subterm_positions(TermPos)]), valid_term_position(Term, TermPos)
953valid_term_position(Term, TermPos) :- 954 valid_term_position(0, 0x7fffffffffffffff, Term, TermPos). 955 956valid_term_position(OuterFrom, OuterTo, _Term, TermPos), 957 var(TermPos), 958 OuterFrom =< OuterTo => true. 959valid_term_position(OuterFrom, OuterTo, Var, From-To), 960 var(Var), 961 valid_term_position_from_to(OuterFrom, OuterTo, From, To) => true. 962valid_term_position(OuterFrom, OuterTo, Atom, From-To), 963 atom(Atom), 964 valid_term_position_from_to(OuterFrom, OuterTo, From, To) => true. 965valid_term_position(OuterFrom, OuterTo, Number, From-To), 966 number(Number), 967 valid_term_position_from_to(OuterFrom, OuterTo, From, To) => true. 968valid_term_position(OuterFrom, OuterTo, [], From-To), 969 valid_term_position_from_to(OuterFrom, OuterTo, From, To) => true. 970valid_term_position(OuterFrom, OuterTo, String, string_position(From,To)), 971 ( string(String) 972 -> true 973 ; is_of_type(codes, String) 974 -> true 975 ; is_of_type(chars, String) 976 -> true 977 ; atom(String) 978 ), 979 valid_term_position_from_to(OuterFrom, OuterTo, From, To) => true. 980valid_term_position(OuterFrom, OuterTo, {Arg}, 981 brace_term_position(From,To,ArgPos)), 982 valid_term_position_from_to(OuterFrom, OuterTo, From, To) => 983 valid_term_position(From, To, Arg, ArgPos). 984valid_term_position(OuterFrom, OuterTo, [Hd|Tl], 985 list_position(From,To,ElemsPos,none)), 986 valid_term_position_from_to(OuterFrom, OuterTo, From, To) => 987 term_position_list_tail([Hd|Tl], _HdPart, []), 988 maplist(valid_term_position, [Hd|Tl], ElemsPos). 989valid_term_position(OuterFrom, OuterTo, [Hd|Tl], 990 list_position(From, To, ElemsPos, TailPos)), 991 valid_term_position_from_to(OuterFrom, OuterTo, From, To) => 992 term_position_list_tail([Hd|Tl], HdPart, Tail), 993 maplist(valid_term_position(From,To), HdPart, ElemsPos), 994 valid_term_position(Tail, TailPos). 995valid_term_position(OuterFrom, OuterTo, Term, 996 term_position(From,To, FFrom,FTo,SubPos)), 997 valid_term_position_from_to(OuterFrom, OuterTo, From, To) => 998 compound_name_arguments(Term, Name, Arguments), 999 valid_term_position(Name, FFrom-FTo), 1000 maplist(valid_term_position(From,To), Arguments, SubPos). 1001valid_term_position(OuterFrom, OuterTo, Dict, 1002 dict_position(From,To,TagFrom,TagTo,KeyValuePosList)), 1003 valid_term_position_from_to(OuterFrom, OuterTo, From, To) => 1004 dict_pairs(Dict, Tag, Pairs), 1005 valid_term_position(Tag, TagFrom-TagTo), 1006 foldl(valid_term_position_dict(From,To), Pairs, KeyValuePosList, []). 1007% key_value_position(From, To, SepFrom, SepTo, Key, KeyPos, ValuePos) 1008% is handled in valid_term_position_dict. 1009valid_term_position(OuterFrom, OuterTo, Term, 1010 parentheses_term_position(From,To,ContentPos)), 1011 valid_term_position_from_to(OuterFrom, OuterTo, From, To) => 1012 valid_term_position(From, To, Term, ContentPos). 1013valid_term_position(OuterFrom, OuterTo, _Term, 1014 quasi_quotation_position(From,To, 1015 SyntaxTerm,SyntaxPos,_ContentPos)), 1016 valid_term_position_from_to(OuterFrom, OuterTo, From, To) => 1017 valid_term_position(From, To, SyntaxTerm, SyntaxPos). 1018 1019valid_term_position_from_to(OuterFrom, OuterTo, From, To) :- 1020 integer(OuterFrom), 1021 integer(OuterTo), 1022 integer(From), 1023 integer(To), 1024 OuterFrom =< OuterTo, 1025 From =< To, 1026 OuterFrom =< From, 1027 To =< OuterTo. 1028 1029:- det(valid_term_position_dict/5). 1030valid_term_position_dict(OuterFrom, OuterTo, Key-Value, 1031 KeyValuePosList0, KeyValuePosList1) :- 1032 selectchk(key_value_position(From,To,SepFrom,SepTo,Key,KeyPos,ValuePos), 1033 KeyValuePosList0, KeyValuePosList1), 1034 valid_term_position_from_to(OuterFrom, OuterTo, From, To), 1035 valid_term_position_from_to(OuterFrom, OuterTo, SepFrom, SepTo), 1036 SepFrom >= OuterFrom, 1037 valid_term_position(From, SepFrom, Key, KeyPos), 1038 valid_term_position(SepTo, To, Value, ValuePos).
append(HdPart, [Tail], List)
for proper lists, but also
works for inproper lists, in which case it unifies Tail with the
tail of the partial list. HdPart is always a proper list:
?- prolog_source:term_position_list_tail([a,b,c], Hd, Tl). Hd = [a, b, c], Tl = []. ?- prolog_source:term_position_list_tail([a,b|X], Hd, Tl). X = Tl, Hd = [a, b].
1055:- det(term_position_list_tail/3). 1056term_position_list_tail([X|Xs], HdPart, Tail) => 1057 HdPart = [X|HdPart2], 1058 term_position_list_tail(Xs, HdPart2, Tail). 1059term_position_list_tail(Tail0, HdPart, Tail) => 1060 HdPart = [], 1061 Tail0 = Tail. 1062 1063 1064 /******************************* 1065 * MESSAGES * 1066 *******************************/ 1067 1068:- multifile 1069 prolog:message//1. 1070 1071prologmessage(quasi_quotation(undeclared, Syntax)) --> 1072 [ 'Undeclared quasi quotation syntax: ~w'-[Syntax], nl, 1073 'Autoloading can be defined using prolog:quasi_quotation_syntax/2' 1074 ]
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.pl
prolog_clause.pl
prolog_colour.pl
*/