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-2025, 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_file_directives/3, % +File, -Directives, +Options 41 prolog_open_source/2, % +Source, -Stream 42 prolog_close_source/1, % +Stream 43 prolog_canonical_source/2, % +Spec, -Id 44 45 load_quasi_quotation_syntax/2, % :Path, +Syntax 46 47 file_name_on_path/2, % +File, -PathSpec 48 file_alias_path/2, % ?Alias, ?Dir 49 path_segments_atom/2, % ?Segments, ?Atom 50 directory_source_files/3, % +Dir, -Files, +Options 51 valid_term_position/2 % +Term, +TermPos 52 ]). 53:- use_module(library(debug), [debug/3, assertion/1]). 54:- autoload(library(apply), [maplist/2, maplist/3, foldl/4]). 55:- autoload(library(error), [domain_error/2, is_of_type/2]). 56:- autoload(library(lists), [member/2, last/2, select/3, append/3, selectchk/3]). 57:- autoload(library(operators), [push_op/3, push_operators/1, pop_operators/0]). 58:- autoload(library(option), [select_option/4, option/3, option/2]). 59:- autoload(library(modules),[in_temporary_module/3]).
85:- thread_local 86 open_source/2, % Stream, State 87 mode/2. % Stream, Data 88 89:- multifile 90 requires_library/2, 91 prolog:xref_source_identifier/2, % +Source, -Id 92 prolog:xref_source_time/2, % +Source, -Modified 93 prolog:xref_open_source/2, % +SourceId, -Stream 94 prolog:xref_close_source/2, % +SourceId, -Stream 95 prolog:alternate_syntax/4, % Syntax, +Module, -Setup, -Restore 96 prolog:xref_update_syntax/2, % +Directive, +Module 97 prolog:quasi_quotation_syntax/2. % Syntax, Library 98 99 100:- predicate_options(prolog_read_source_term/4, 4, 101 [ pass_to(system:read_clause/3, 3) 102 ]). 103:- predicate_options(read_source_term_at_location/3, 3, 104 [ line(integer), 105 offset(integer), 106 module(atom), 107 operators(list), 108 error(-any), 109 pass_to(system:read_term/3, 3) 110 ]). 111:- predicate_options(directory_source_files/3, 3, 112 [ recursive(boolean), 113 if(oneof([true,loaded])), 114 pass_to(system:absolute_file_name/3,3) 115 ]). 116 117 118 /******************************* 119 * READING * 120 *******************************/
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).
136prolog_read_source_term(In, Term, Expanded, Options) :- 137 maplist(read_clause_option, Options), 138 !, 139 select_option(subterm_positions(TermPos), Options, 140 RestOptions, TermPos), 141 read_clause(In, Term, 142 [ subterm_positions(TermPos) 143 | RestOptions 144 ]), 145 expand(Term, TermPos, In, Expanded), 146 '$current_source_module'(M), 147 update_state(Term, Expanded, M). 148prolog_read_source_term(In, Term, Expanded, Options) :- 149 '$current_source_module'(M), 150 select_option(syntax_errors(SE), Options, RestOptions0, dec10), 151 select_option(subterm_positions(TermPos), RestOptions0, 152 RestOptions, TermPos), 153 ( style_check(?(singleton)) 154 -> FinalOptions = [ singletons(warning) | RestOptions ] 155 ; FinalOptions = RestOptions 156 ), 157 read_term(In, Term, 158 [ module(M), 159 syntax_errors(SE), 160 subterm_positions(TermPos) 161 | FinalOptions 162 ]), 163 expand(Term, TermPos, In, Expanded), 164 update_state(Term, Expanded, M). 165 166read_clause_option(syntax_errors(_)). 167read_clause_option(term_position(_)). 168read_clause_option(process_comment(_)). 169read_clause_option(comments(_)). 170 171:- public 172 expand/3. % Used by Prolog colour 173 174expand(Term, In, Exp) :- 175 expand(Term, _, In, Exp). 176 177expand(Var, _, _, Var) :- 178 var(Var), 179 !. 180expand(Term, _, _, Term) :- 181 no_expand(Term), 182 !. 183expand(Term, _, _, _) :- 184 requires_library(Term, Lib), 185 ensure_loaded(user:Lib), 186 fail. 187expand(Term, _, In, Term) :- 188 chr_expandable(Term, In), 189 !. 190expand(Term, Pos, _, Expanded) :- 191 expand_term(Term, Pos, Expanded, _). 192 193no_expand((:- if(_))). 194no_expand((:- elif(_))). 195no_expand((:- else)). 196no_expand((:- endif)). 197no_expand((:- require(_))). 198 199chr_expandable((:- chr_constraint(_)), In) :- 200 add_mode(In, chr). 201chr_expandable((handler(_)), In) :- 202 mode(In, chr). 203chr_expandable((rules(_)), In) :- 204 mode(In, chr). 205chr_expandable(<=>(_, _), In) :- 206 mode(In, chr). 207chr_expandable(@(_, _), In) :- 208 mode(In, chr). 209chr_expandable(==>(_, _), In) :- 210 mode(In, chr). 211chr_expandable(pragma(_, _), In) :- 212 mode(In, chr). 213chr_expandable(option(_, _), In) :- 214 mode(In, chr). 215 216add_mode(Stream, Mode) :- 217 mode(Stream, Mode), 218 !. 219add_mode(Stream, Mode) :- 220 asserta(mode(Stream, Mode)).
226requires_library((:- emacs_begin_mode(_,_,_,_,_)), library(emacs_extend)). 227requires_library((:- draw_begin_shape(_,_,_,_)), library(pcedraw)). 228requires_library((:- use_module(library(pce))), library(pce)). 229requires_library((:- pce_begin_class(_,_)), library(pce)). 230requires_library((:- pce_begin_class(_,_,_)), library(pce)). 231requires_library((:- html_meta(_)), library(http/html_decl)).
237:- multifile 238 pce_expansion:push_compile_operators/1, 239 pce_expansion:pop_compile_operators/0. 240 241update_state((:- pce_end_class), _, _) => 242 ignore(pce_expansion:pop_compile_operators). 243update_state((:- pce_extend_class(_)), _, SM) => 244 pce_expansion:push_compile_operators(SM). 245update_state(Raw, _, Module), 246 catch(prolog:xref_update_syntax(Raw, Module), 247 error(_,_), 248 fail) => 249 true. 250update_state(_Raw, Expanded, M) => 251 update_state(Expanded, M). 252 253update_state(Var, _) :- 254 var(Var), 255 !. 256update_state([], _) :- 257 !. 258update_state([H|T], M) :- 259 !, 260 update_state(H, M), 261 update_state(T, M). 262update_state((:- Directive), M) :- 263 nonvar(Directive), 264 !, 265 catch(update_directive(Directive, M), _, true). 266update_state((?- Directive), M) :- 267 !, 268 update_state((:- Directive), M). 269update_state(MetaDecl, _M) :- 270 MetaDecl = html_write:html_meta_head(_Head,_Module,_Meta), 271 ( clause(MetaDecl, true) 272 -> true 273 ; assertz(MetaDecl) 274 ). 275update_state(_, _). 276 277update_directive(Directive, Module) :- 278 prolog:xref_update_syntax((:- Directive), Module), 279 !. 280update_directive(module(Module, Public), _) :- 281 atom(Module), 282 is_list(Public), 283 !, 284 '$set_source_module'(Module), 285 maplist(import_syntax(_,Module, _), Public). 286update_directive(M:op(P,T,N), SM) :- 287 atom(M), 288 ground(op(P,T,N)), 289 !, 290 update_directive(op(P,T,N), SM). 291update_directive(op(P,T,N), SM) :- 292 ground(op(P,T,N)), 293 !, 294 strip_module(SM:N, M, PN), 295 push_op(P,T,M:PN). 296update_directive(style_check(Style), _) :- 297 ground(Style), 298 style_check(Style), 299 !. 300update_directive(use_module(Spec), SM) :- 301 ground(Spec), 302 catch(module_decl(Spec, Path, Public), _, fail), 303 is_list(Public), 304 !, 305 maplist(import_syntax(Path, SM, _), Public). 306update_directive(use_module(Spec, Imports), SM) :- 307 ground(Spec), 308 is_list(Imports), 309 catch(module_decl(Spec, Path, Public), _, fail), 310 is_list(Public), 311 !, 312 maplist(import_syntax(Path, SM, Imports), Public). 313update_directive(pce_begin_class_definition(_,_,_,_), SM) :- 314 pce_expansion:push_compile_operators(SM), 315 !. 316update_directive(_, _).
323import_syntax(_, _, _, Var) :- 324 var(Var), 325 !. 326import_syntax(_, M, Imports, Op) :- 327 Op = op(_,_,_), 328 \+ \+ member(Op, Imports), 329 !, 330 update_directive(Op, M). 331import_syntax(Path, SM, Imports, Syntax/4) :- 332 \+ \+ member(Syntax/4, Imports), 333 load_quasi_quotation_syntax(SM:Path, Syntax), 334 !. 335import_syntax(_,_,_, _).
352load_quasi_quotation_syntax(SM:Path, Syntax) :- 353 atom(Path), atom(Syntax), 354 source_file_property(Path, module(M)), 355 functor(ST, Syntax, 4), 356 predicate_property(M:ST, quasi_quotation_syntax), 357 !, 358 use_module(SM:Path, [Syntax/4]). 359load_quasi_quotation_syntax(SM:Path, Syntax) :- 360 atom(Path), atom(Syntax), 361 prolog:quasi_quotation_syntax(Syntax, Spec), 362 absolute_file_name(Spec, Path2, 363 [ file_type(prolog), 364 file_errors(fail), 365 access(read) 366 ]), 367 Path == Path2, 368 !, 369 use_module(SM:Path, [Syntax/4]).
377module_decl(Spec, Source, Exports) :- 378 absolute_file_name(Spec, Path, 379 [ file_type(prolog), 380 file_errors(fail), 381 access(read) 382 ]), 383 module_decl_(Path, Source, Exports). 384 385module_decl_(Path, Source, Exports) :- 386 file_name_extension(_, qlf, Path), 387 !, 388 '$qlf_module'(Path, Info), 389 _{file:Source, exports:Exports} :< Info. 390module_decl_(Path, Path, Exports) :- 391 setup_call_cleanup( 392 prolog_open_source(Path, In), 393 read_module_decl(In, Exports), 394 prolog_close_source(In)). 395 396read_module_decl(In, Decl) :- 397 read(In, Term0), 398 read_module_decl(Term0, In, Decl). 399 400read_module_decl((:- module(_, DeclIn)), _In, Decl) => 401 Decl = DeclIn. 402read_module_decl((:- encoding(Enc)), In, Decl) => 403 set_stream(In, encoding(Enc)), 404 read(In, Term2), 405 read_module_decl(Term2, In, Decl). 406read_module_decl(_, _, _) => 407 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 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).451:- thread_local 452 last_syntax_error/2. % location, message 453 454read_source_term_at_location(Stream, Term, Options) :- 455 retractall(last_syntax_error(_,_)), 456 seek_to_start(Stream, Options), 457 stream_property(Stream, position(Here)), 458 '$current_source_module'(DefModule), 459 option(module(Module), Options, DefModule), 460 option(operators(Ops), Options, []), 461 alternate_syntax(Syntax, Module, Setup, Restore), 462 set_stream_position(Stream, Here), 463 debug(read, 'Trying with syntax ~w', [Syntax]), 464 push_operators(Module:Ops), 465 call(Setup), 466 Error = error(Formal,_), % do not catch timeout, etc. 467 setup_call_cleanup( 468 asserta(user:thread_message_hook(_,_,_), Ref), % silence messages 469 catch(qq_read_term(Stream, Term0, 470 [ module(Module) 471 | Options 472 ]), 473 Error, 474 true), 475 erase(Ref)), 476 call(Restore), 477 pop_operators, 478 ( var(Formal) 479 -> !, Term = Term0 480 ; assert_error(Error, Options), 481 fail 482 ). 483read_source_term_at_location(_, _, Options) :- 484 option(error(Error), Options), 485 !, 486 setof(CharNo:Msg, retract(last_syntax_error(CharNo, Msg)), Pairs), 487 last(Pairs, Error). 488 489assert_error(Error, Options) :- 490 option(error(_), Options), 491 !, 492 ( ( Error = error(syntax_error(Id), 493 stream(_S1, _Line1, _LinePos1, CharNo)) 494 ; Error = error(syntax_error(Id), 495 file(_S2, _Line2, _LinePos2, CharNo)) 496 ) 497 -> message_to_string(error(syntax_error(Id), _), Msg), 498 assertz(last_syntax_error(CharNo, Msg)) 499 ; debug(read, 'Error: ~q', [Error]), 500 throw(Error) 501 ). 502assert_error(_, _).
Calls the hook prolog:alternate_syntax/4 with the same signature to allow for user-defined extensions.
518alternate_syntax(prolog, _, true, true). 519alternate_syntax(Syntax, M, Setup, Restore) :- 520 prolog:alternate_syntax(Syntax, M, Setup, Restore).
527seek_to_start(Stream, Options) :- 528 option(line(Line), Options), 529 !, 530 seek(Stream, 0, bof, _), 531 seek_to_line(Stream, Line). 532seek_to_start(Stream, Options) :- 533 option(offset(Start), Options), 534 !, 535 seek(Stream, Start, bof, _). 536seek_to_start(_, _).
542seek_to_line(Fd, N) :- 543 N > 1, 544 !, 545 skip(Fd, 10), 546 NN is N - 1, 547 seek_to_line(Fd, NN). 548seek_to_line(_, _). 549 550 551 /******************************* 552 * QUASI QUOTATIONS * 553 *******************************/
561qq_read_term(Stream, Term, Options) :- 562 select(syntax_errors(ErrorMode), Options, Options1), 563 ErrorMode \== error, 564 !, 565 ( ErrorMode == dec10 566 -> repeat, 567 qq_read_syntax_ex(Stream, Term, Options1, Error), 568 ( var(Error) 569 -> ! 570 ; print_message(error, Error), 571 fail 572 ) 573 ; qq_read_syntax_ex(Stream, Term, Options1, Error), 574 ( ErrorMode == fail 575 -> print_message(error, Error), 576 fail 577 ; ErrorMode == quiet 578 -> fail 579 ; domain_error(syntax_errors, ErrorMode) 580 ) 581 ). 582qq_read_term(Stream, Term, Options) :- 583 qq_read_term_ex(Stream, Term, Options). 584 585qq_read_syntax_ex(Stream, Term, Options, Error) :- 586 catch(qq_read_term_ex(Stream, Term, Options), 587 error(syntax_error(Syntax), Context), 588 Error = error(Syntax, Context)). 589 590qq_read_term_ex(Stream, Term, Options) :- 591 stream_property(Stream, position(Here)), 592 catch(read_term(Stream, Term, Options), 593 error(syntax_error(unknown_quasi_quotation_syntax(Syntax, Module)), Context), 594 load_qq_and_retry(Here, Syntax, Module, Context, Stream, Term, Options)). 595 596load_qq_and_retry(Here, Syntax, Module, _, Stream, Term, Options) :- 597 set_stream_position(Stream, Here), 598 prolog:quasi_quotation_syntax(Syntax, Library), 599 !, 600 use_module(Module:Library, [Syntax/4]), 601 read_term(Stream, Term, Options). 602load_qq_and_retry(_Pos, Syntax, Module, Context, _Stream, _Term, _Options) :- 603 print_message(warning, quasi_quotation(undeclared, Syntax)), 604 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.
615prologquasi_quotation_syntax(html, library(http/html_write)). 616prologquasi_quotation_syntax(javascript, library(http/js_write)).
true (default false), do not report syntax errors and
other errors.633prolog_file_directives(File, Directives, Options) :- 634 option(canonical_source(Path), Options, _), 635 prolog_canonical_source(File, Path), 636 in_temporary_module( 637 TempModule, 638 true, 639 read_directives(TempModule, Path, Directives, Options)). 640 641read_directives(TempModule, Path, Directives, Options) :- 642 setup_call_cleanup( 643 read_directives_setup(TempModule, Path, In, State), 644 phrase(read_directives(In, Options, [true]), Directives), 645 read_directives_cleanup(In, State)). 646 647read_directives_setup(TempModule, Path, In, state(OldM, OldXref)) :- 648 prolog_open_source(Path, In), 649 '$set_source_module'(OldM, TempModule), 650 current_prolog_flag(xref, OldXref), 651 set_prolog_flag(xref, true). 652 653read_directives_cleanup(In, state(OldM, OldXref)) :- 654 '$set_source_module'(OldM), 655 set_prolog_flag(xref, OldXref), 656 prolog_close_source(In). 657 658read_directives(In, Options, State) --> 659 { E = error(_,_), 660 repeat, 661 catch(prolog_read_source_term(In, Term, Expanded, 662 [ process_comment(true), 663 syntax_errors(error) 664 ]), 665 E, report_syntax_error(E, Options)) 666 -> nonvar(Term), 667 Term = (:-_) 668 }, 669 !, 670 terms(Expanded, State, State1), 671 read_directives(In, Options, State1). 672read_directives(_, _, _) --> []. 673 674report_syntax_error(_, Options) :- 675 option(silent(true), Options), 676 !, 677 fail. 678report_syntax_error(E, _Options) :- 679 print_message(warning, E), 680 fail. 681 682terms(Var, State, State) --> { var(Var) }, !. 683terms([H|T], State0, State) --> 684 !, 685 terms(H, State0, State1), 686 terms(T, State1, State). 687terms((:-if(Cond)), State0, [True|State0]) --> 688 !, 689 { eval_cond(Cond, True) }. 690terms((:-elif(Cond)), [True0|State], [True|State]) --> 691 !, 692 { eval_cond(Cond, True1), 693 elif(True0, True1, True) 694 }. 695terms((:-else), [True0|State], [True|State]) --> 696 !, 697 { negate(True0, True) }. 698terms((:-endif), [_|State], State) --> !. 699terms(H, State, State) --> 700 ( {State = [true|_]} 701 -> [H] 702 ; [] 703 ). 704 705eval_cond(Cond, true) :- 706 catch(Cond, error(_,_), fail), 707 !. 708eval_cond(_, false). 709 710elif(true, _, else_false) :- !. 711elif(false, true, true) :- !. 712elif(True, _, True). 713 714negate(true, false). 715negate(false, true). 716negate(else_false, else_false). 717 718 /******************************* 719 * SOURCES * 720 *******************************/
process_source(Src) :-
prolog_open_source(Src, In),
call_cleanup(process(Src), prolog_close_source(In)).
737prolog_open_source(Src, Fd) :- 738 '$push_input_context'(source), 739 catch(( prolog:xref_open_source(Src, Fd) 740 -> Hooked = true 741 ; open(Src, read, Fd), 742 Hooked = false 743 ), E, 744 ( '$pop_input_context', 745 throw(E) 746 )), 747 skip_hashbang(Fd), 748 push_operators([]), 749 '$current_source_module'(SM), 750 '$save_lex_state'(LexState, []), 751 asserta(open_source(Fd, state(Hooked, Src, LexState, SM))). 752 753skip_hashbang(Fd) :- 754 catch(( peek_char(Fd, #) % Deal with #! script 755 -> skip(Fd, 10) 756 ; true 757 ), E, 758 ( close(Fd, [force(true)]), 759 '$pop_input_context', 760 throw(E) 761 )).
expand_term(end_of_file, _) to allow expansion
modules to clean-up.779prolog_close_source(In) :- 780 call_cleanup( 781 restore_source_context(In, Hooked, Src), 782 close_source(Hooked, Src, In)). 783 784close_source(true, Src, In) :- 785 catch(prolog:xref_close_source(Src, In), _, false), 786 !, 787 '$pop_input_context'. 788close_source(_, _Src, In) :- 789 close(In, [force(true)]), 790 '$pop_input_context'. 791 792restore_source_context(In, Hooked, Src) :- 793 ( at_end_of_stream(In) 794 -> true 795 ; ignore(catch(expand(end_of_file, _, In, _), _, true)) 796 ), 797 pop_operators, 798 retractall(mode(In, _)), 799 ( retract(open_source(In, state(Hooked, Src, LexState, SM))) 800 -> '$restore_lex_state'(LexState), 801 '$set_source_module'(SM) 802 ; assertion(fail) 803 ).
force(true) is used.818prolog_canonical_source(Source, Src) :- 819 var(Source), 820 !, 821 Src = Source. 822prolog_canonical_source(User, user) :- 823 User == user, 824 !. 825prolog_canonical_source(Src, Id) :- % Call hook 826 prolog:xref_source_identifier(Src, Id), 827 !. 828prolog_canonical_source(Source, Src) :- 829 source_file(Source), 830 !, 831 Src = Source. 832prolog_canonical_source(Source, Src) :- 833 absolute_file_name(Source, Src, 834 [ file_type(prolog), 835 access(read), 836 file_errors(fail) 837 ]), 838 !.
846file_name_on_path(Path, ShortId) :-
847 ( file_alias_path(Alias, Dir),
848 atom_concat(Dir, Local, Path)
849 -> ( Alias == '.'
850 -> ShortId = Local
851 ; file_name_extension(Base, pl, Local)
852 -> ShortId =.. [Alias, Base]
853 ; ShortId =.. [Alias, Local]
854 )
855 ; ShortId = Path
856 ).864:- dynamic 865 alias_cache/2. 866 867file_alias_path(Alias, Dir) :- 868 ( alias_cache(_, _) 869 -> true 870 ; build_alias_cache 871 ), 872 ( nonvar(Dir) 873 -> ensure_slash(Dir, DirSlash), 874 alias_cache(Alias, DirSlash) 875 ; alias_cache(Alias, Dir) 876 ). 877 878build_alias_cache :- 879 findall(t(DirLen, AliasLen, Alias, Dir), 880 search_path(Alias, Dir, AliasLen, DirLen), Ts), 881 sort(0, >, Ts, List), 882 forall(member(t(_, _, Alias, Dir), List), 883 assert(alias_cache(Alias, Dir))). 884 885search_path('.', Here, 999, DirLen) :- 886 working_directory(Here0, Here0), 887 ensure_slash(Here0, Here), 888 atom_length(Here, DirLen). 889search_path(Alias, Dir, AliasLen, DirLen) :- 890 user:file_search_path(Alias, _), 891 Alias \== autoload, % TBD: Multifile predicate? 892 Alias \== noautoload, 893 Spec =.. [Alias,'.'], 894 atom_length(Alias, AliasLen0), 895 AliasLen is 1000 - AliasLen0, % must do reverse sort 896 absolute_file_name(Spec, Dir0, 897 [ file_type(directory), 898 access(read), 899 solutions(all), 900 file_errors(fail) 901 ]), 902 ensure_slash(Dir0, Dir), 903 atom_length(Dir, DirLen). 904 905ensure_slash(Dir, Dir) :- 906 sub_atom(Dir, _, _, 0, /), 907 !. 908ensure_slash(Dir0, Dir) :- 909 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.
930path_segments_atom(Segments, Atom) :- 931 var(Atom), 932 !, 933 ( atomic(Segments) 934 -> Atom = Segments 935 ; segments_to_list(Segments, List, []) 936 -> atomic_list_concat(List, /, Atom) 937 ; throw(error(type_error(file_path, Segments), _)) 938 ). 939path_segments_atom(Segments, Atom) :- 940 atomic_list_concat(List, /, Atom), 941 parts_to_path(List, Segments). 942 943segments_to_list(Var, _, _) :- 944 var(Var), !, fail. 945segments_to_list(A/B, H, T) :- 946 segments_to_list(A, H, T0), 947 segments_to_list(B, T0, T). 948segments_to_list(A, [A|T], T) :- 949 atomic(A). 950 951parts_to_path([One], One) :- !. 952parts_to_path(List, More/T) :- 953 ( append(H, [T], List) 954 -> parts_to_path(H, More) 955 ).
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.
970directory_source_files(Dir, SrcFiles, Options) :- 971 option(if(loaded), Options, loaded), 972 !, 973 absolute_file_name(Dir, AbsDir, [file_type(directory), access(read)]), 974 ( option(recursive(true), Options) 975 -> ensure_slash(AbsDir, Prefix), 976 findall(F, ( source_file(F), 977 sub_atom(F, 0, _, _, Prefix) 978 ), 979 SrcFiles) 980 ; findall(F, ( source_file(F), 981 file_directory_name(F, AbsDir) 982 ), 983 SrcFiles) 984 ). 985directory_source_files(Dir, SrcFiles, Options) :- 986 absolute_file_name(Dir, AbsDir, [file_type(directory), access(read)]), 987 directory_files(AbsDir, Files), 988 phrase(src_files(Files, AbsDir, Options), SrcFiles). 989 990src_files([], _, _) --> 991 []. 992src_files([H|T], Dir, Options) --> 993 { file_name_extension(_, Ext, H), 994 user:prolog_file_type(Ext, prolog), 995 \+ user:prolog_file_type(Ext, qlf), 996 dir_file_path(Dir, H, File0), 997 absolute_file_name(File0, File, 998 [ file_errors(fail) 999 | Options 1000 ]) 1001 }, 1002 !, 1003 [File], 1004 src_files(T, Dir, Options). 1005src_files([H|T], Dir, Options) --> 1006 { \+ special(H), 1007 option(recursive(true), Options), 1008 dir_file_path(Dir, H, SubDir), 1009 exists_directory(SubDir), 1010 !, 1011 catch(directory_files(SubDir, Files), _, fail) 1012 }, 1013 !, 1014 src_files(Files, SubDir, Options), 1015 src_files(T, Dir, Options). 1016src_files([_|T], Dir, Options) --> 1017 src_files(T, Dir, Options). 1018 1019special(.). 1020special(..). 1021 1022% avoid dependency on library(filesex), which also pulls a foreign 1023% dependency. 1024dir_file_path(Dir, File, Path) :- 1025 ( sub_atom(Dir, _, _, 0, /) 1026 -> atom_concat(Dir, File, Path) 1027 ; atom_concat(Dir, /, TheDir), 1028 atom_concat(TheDir, File, Path) 1029 ).
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)
1062valid_term_position(Term, TermPos) :- 1063 valid_term_position(0, 0x7fffffffffffffff, Term, TermPos). 1064 1065valid_term_position(OuterFrom, OuterTo, _Term, TermPos), 1066 var(TermPos), 1067 OuterFrom =< OuterTo => true. 1068valid_term_position(OuterFrom, OuterTo, Var, From-To), 1069 var(Var), 1070 valid_term_position_from_to(OuterFrom, OuterTo, From, To) => true. 1071valid_term_position(OuterFrom, OuterTo, Atom, From-To), 1072 atom(Atom), 1073 valid_term_position_from_to(OuterFrom, OuterTo, From, To) => true. 1074valid_term_position(OuterFrom, OuterTo, Number, From-To), 1075 number(Number), 1076 valid_term_position_from_to(OuterFrom, OuterTo, From, To) => true. 1077valid_term_position(OuterFrom, OuterTo, [], From-To), 1078 valid_term_position_from_to(OuterFrom, OuterTo, From, To) => true. 1079valid_term_position(OuterFrom, OuterTo, String, string_position(From,To)), 1080 ( string(String) 1081 -> true 1082 ; is_of_type(codes, String) 1083 -> true 1084 ; is_of_type(chars, String) 1085 -> true 1086 ; atom(String) 1087 ), 1088 valid_term_position_from_to(OuterFrom, OuterTo, From, To) => true. 1089valid_term_position(OuterFrom, OuterTo, {Arg}, 1090 brace_term_position(From,To,ArgPos)), 1091 valid_term_position_from_to(OuterFrom, OuterTo, From, To) => 1092 valid_term_position(From, To, Arg, ArgPos). 1093valid_term_position(OuterFrom, OuterTo, [Hd|Tl], 1094 list_position(From,To,ElemsPos,none)), 1095 valid_term_position_from_to(OuterFrom, OuterTo, From, To) => 1096 term_position_list_tail([Hd|Tl], _HdPart, []), 1097 maplist(valid_term_position, [Hd|Tl], ElemsPos). 1098valid_term_position(OuterFrom, OuterTo, [Hd|Tl], 1099 list_position(From, To, ElemsPos, TailPos)), 1100 valid_term_position_from_to(OuterFrom, OuterTo, From, To) => 1101 term_position_list_tail([Hd|Tl], HdPart, Tail), 1102 maplist(valid_term_position(From,To), HdPart, ElemsPos), 1103 valid_term_position(Tail, TailPos). 1104valid_term_position(OuterFrom, OuterTo, Term, 1105 term_position(From,To, FFrom,FTo,SubPos)), 1106 valid_term_position_from_to(OuterFrom, OuterTo, From, To) => 1107 compound_name_arguments(Term, Name, Arguments), 1108 valid_term_position(Name, FFrom-FTo), 1109 maplist(valid_term_position(From,To), Arguments, SubPos). 1110valid_term_position(OuterFrom, OuterTo, Dict, 1111 dict_position(From,To,TagFrom,TagTo,KeyValuePosList)), 1112 valid_term_position_from_to(OuterFrom, OuterTo, From, To) => 1113 dict_pairs(Dict, Tag, Pairs), 1114 valid_term_position(Tag, TagFrom-TagTo), 1115 foldl(valid_term_position_dict(From,To), Pairs, KeyValuePosList, []). 1116% key_value_position(From, To, SepFrom, SepTo, Key, KeyPos, ValuePos) 1117% is handled in valid_term_position_dict. 1118valid_term_position(OuterFrom, OuterTo, Term, 1119 parentheses_term_position(From,To,ContentPos)), 1120 valid_term_position_from_to(OuterFrom, OuterTo, From, To) => 1121 valid_term_position(From, To, Term, ContentPos). 1122valid_term_position(OuterFrom, OuterTo, _Term, 1123 quasi_quotation_position(From,To, 1124 SyntaxTerm,SyntaxPos,_ContentPos)), 1125 valid_term_position_from_to(OuterFrom, OuterTo, From, To) => 1126 valid_term_position(From, To, SyntaxTerm, SyntaxPos). 1127 1128valid_term_position_from_to(OuterFrom, OuterTo, From, To) :- 1129 integer(OuterFrom), 1130 integer(OuterTo), 1131 integer(From), 1132 integer(To), 1133 OuterFrom =< OuterTo, 1134 From =< To, 1135 OuterFrom =< From, 1136 To =< OuterTo. 1137 1138:- det(valid_term_position_dict/5). 1139valid_term_position_dict(OuterFrom, OuterTo, Key-Value, 1140 KeyValuePosList0, KeyValuePosList1) :- 1141 selectchk(key_value_position(From,To,SepFrom,SepTo,Key,KeyPos,ValuePos), 1142 KeyValuePosList0, KeyValuePosList1), 1143 valid_term_position_from_to(OuterFrom, OuterTo, From, To), 1144 valid_term_position_from_to(OuterFrom, OuterTo, SepFrom, SepTo), 1145 SepFrom >= OuterFrom, 1146 valid_term_position(From, SepFrom, Key, KeyPos), 1147 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].
1164:- det(term_position_list_tail/3). 1165term_position_list_tail([X|Xs], HdPart, Tail) => 1166 HdPart = [X|HdPart2], 1167 term_position_list_tail(Xs, HdPart2, Tail). 1168term_position_list_tail(Tail0, HdPart, Tail) => 1169 HdPart = [], 1170 Tail0 = Tail. 1171 1172 1173 /******************************* 1174 * MESSAGES * 1175 *******************************/ 1176 1177:- multifile 1178 prolog:message//1. 1179 1180prologmessage(quasi_quotation(undeclared, Syntax)) --> 1181 [ 'Undeclared quasi quotation syntax: ~w'-[Syntax], nl, 1182 'Autoloading can be defined using prolog:quasi_quotation_syntax/2' 1183 ]
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*/