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, In). 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, In). 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, In) => 251 update_state(Expanded, M, In). 252 253update_state(Var, _, _) :- 254 var(Var), 255 !. 256update_state([], _, _) :- 257 !. 258update_state([H|T], M, In) :- 259 !, 260 update_state(H, M, In), 261 update_state(T, M, In). 262update_state((:- Directive), M, In) :- 263 nonvar(Directive), 264 !, 265 catch(update_directive(Directive, M, In), _, true). 266update_state((?- Directive), M, In) :- 267 !, 268 update_state((:- Directive), M, In). 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(_, _, _).
279update_directive(Directive, Module, _) :- 280 prolog:xref_update_syntax((:- Directive), Module), 281 !. 282update_directive(encoding(Enc), _, In) :- 283 !, 284 set_stream(In, encoding(Enc)). 285update_directive(module(Module, Public), _, _) :- 286 atom(Module), 287 is_list(Public), 288 !, 289 '$set_source_module'(Module), 290 maplist(import_syntax(_,Module, _), Public). 291update_directive(M:op(P,T,N), SM, In) :- 292 atom(M), 293 ground(op(P,T,N)), 294 !, 295 update_directive(op(P,T,N), SM, In). 296update_directive(op(P,T,N), SM, _) :- 297 ground(op(P,T,N)), 298 !, 299 strip_module(SM:N, M, PN), 300 push_op(P,T,M:PN). 301update_directive(style_check(Style), _, _) :- 302 ground(Style), 303 style_check(Style), 304 !. 305update_directive(use_module(Spec), SM, _) :- 306 ground(Spec), 307 catch(module_decl(Spec, Path, Public), _, fail), 308 is_list(Public), 309 !, 310 maplist(import_syntax(Path, SM, _), Public). 311update_directive(use_module(Spec, Imports), SM, _) :- 312 ground(Spec), 313 is_list(Imports), 314 catch(module_decl(Spec, Path, Public), _, fail), 315 is_list(Public), 316 !, 317 maplist(import_syntax(Path, SM, Imports), Public). 318update_directive(pce_begin_class_definition(_,_,_,_), SM, _) :- 319 pce_expansion:push_compile_operators(SM), 320 !. 321update_directive(_, _, _).
328import_syntax(_, _, _, Var) :- 329 var(Var), 330 !. 331import_syntax(_, M, Imports, Op) :- 332 Op = op(_,_,_), 333 \+ \+ member(Op, Imports), 334 !, 335 update_directive(Op, M, _). 336import_syntax(Path, SM, Imports, Syntax/4) :- 337 \+ \+ member(Syntax/4, Imports), 338 load_quasi_quotation_syntax(SM:Path, Syntax), 339 !. 340import_syntax(_,_,_, _).
357load_quasi_quotation_syntax(SM:Path, Syntax) :- 358 atom(Path), atom(Syntax), 359 source_file_property(Path, module(M)), 360 functor(ST, Syntax, 4), 361 predicate_property(M:ST, quasi_quotation_syntax), 362 !, 363 use_module(SM:Path, [Syntax/4]). 364load_quasi_quotation_syntax(SM:Path, Syntax) :- 365 atom(Path), atom(Syntax), 366 prolog:quasi_quotation_syntax(Syntax, Spec), 367 absolute_file_name(Spec, Path2, 368 [ file_type(prolog), 369 file_errors(fail), 370 access(read) 371 ]), 372 Path == Path2, 373 !, 374 use_module(SM:Path, [Syntax/4]).
382module_decl(Spec, Source, Exports) :- 383 absolute_file_name(Spec, Path, 384 [ file_type(prolog), 385 file_errors(fail), 386 access(read) 387 ]), 388 module_decl_(Path, Source, Exports). 389 390module_decl_(Path, Source, Exports) :- 391 file_name_extension(_, qlf, Path), 392 !, 393 '$qlf_module'(Path, Info), 394 _{file:Source, exports:Exports} :< Info. 395module_decl_(Path, Path, Exports) :- 396 setup_call_cleanup( 397 prolog_open_source(Path, In), 398 read_module_decl(In, Exports), 399 prolog_close_source(In)). 400 401read_module_decl(In, Decl) :- 402 read(In, Term0), 403 read_module_decl(Term0, In, Decl). 404 405read_module_decl((:- module(_, DeclIn)), _In, Decl) => 406 Decl = DeclIn. 407read_module_decl((:- encoding(Enc)), In, Decl) => 408 set_stream(In, encoding(Enc)), 409 read(In, Term2), 410 read_module_decl(Term2, In, Decl). 411read_module_decl(_, _, _) => 412 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).456:- thread_local 457 last_syntax_error/2. % location, message 458 459read_source_term_at_location(Stream, Term, Options) :- 460 retractall(last_syntax_error(_,_)), 461 seek_to_start(Stream, Options), 462 stream_property(Stream, position(Here)), 463 '$current_source_module'(DefModule), 464 option(module(Module), Options, DefModule), 465 option(operators(Ops), Options, []), 466 alternate_syntax(Syntax, Module, Setup, Restore), 467 set_stream_position(Stream, Here), 468 debug(read, 'Trying with syntax ~w', [Syntax]), 469 push_operators(Module:Ops), 470 call(Setup), 471 Error = error(Formal,_), % do not catch timeout, etc. 472 setup_call_cleanup( 473 asserta(user:thread_message_hook(_,_,_), Ref), % silence messages 474 catch(qq_read_term(Stream, Term0, 475 [ module(Module) 476 | Options 477 ]), 478 Error, 479 true), 480 erase(Ref)), 481 call(Restore), 482 pop_operators, 483 ( var(Formal) 484 -> !, Term = Term0 485 ; assert_error(Error, Options), 486 fail 487 ). 488read_source_term_at_location(_, _, Options) :- 489 option(error(Error), Options), 490 !, 491 setof(CharNo:Msg, retract(last_syntax_error(CharNo, Msg)), Pairs), 492 last(Pairs, Error). 493 494assert_error(Error, Options) :- 495 option(error(_), Options), 496 !, 497 ( ( Error = error(syntax_error(Id), 498 stream(_S1, _Line1, _LinePos1, CharNo)) 499 ; Error = error(syntax_error(Id), 500 file(_S2, _Line2, _LinePos2, CharNo)) 501 ) 502 -> message_to_string(error(syntax_error(Id), _), Msg), 503 assertz(last_syntax_error(CharNo, Msg)) 504 ; debug(read, 'Error: ~q', [Error]), 505 throw(Error) 506 ). 507assert_error(_, _).
Calls the hook alternate_syntax/4 with the same signature to allow for user-defined extensions.
523alternate_syntax(prolog, _, true, true). 524alternate_syntax(Syntax, M, Setup, Restore) :- 525 prolog:alternate_syntax(Syntax, M, Setup, Restore).
532seek_to_start(Stream, Options) :- 533 option(line(Line), Options), 534 !, 535 seek(Stream, 0, bof, _), 536 seek_to_line(Stream, Line). 537seek_to_start(Stream, Options) :- 538 option(offset(Start), Options), 539 !, 540 seek(Stream, Start, bof, _). 541seek_to_start(_, _).
547seek_to_line(Fd, N) :- 548 N > 1, 549 !, 550 skip(Fd, 10), 551 NN is N - 1, 552 seek_to_line(Fd, NN). 553seek_to_line(_, _). 554 555 556 /******************************* 557 * QUASI QUOTATIONS * 558 *******************************/
566qq_read_term(Stream, Term, Options) :- 567 select(syntax_errors(ErrorMode), Options, Options1), 568 ErrorMode \== error, 569 !, 570 ( ErrorMode == dec10 571 -> repeat, 572 qq_read_syntax_ex(Stream, Term, Options1, Error), 573 ( var(Error) 574 -> ! 575 ; print_message(error, Error), 576 fail 577 ) 578 ; qq_read_syntax_ex(Stream, Term, Options1, Error), 579 ( ErrorMode == fail 580 -> print_message(error, Error), 581 fail 582 ; ErrorMode == quiet 583 -> fail 584 ; domain_error(syntax_errors, ErrorMode) 585 ) 586 ). 587qq_read_term(Stream, Term, Options) :- 588 qq_read_term_ex(Stream, Term, Options). 589 590qq_read_syntax_ex(Stream, Term, Options, Error) :- 591 catch(qq_read_term_ex(Stream, Term, Options), 592 error(syntax_error(Syntax), Context), 593 Error = error(Syntax, Context)). 594 595qq_read_term_ex(Stream, Term, Options) :- 596 stream_property(Stream, position(Here)), 597 catch(read_term(Stream, Term, Options), 598 error(syntax_error(unknown_quasi_quotation_syntax(Syntax, Module)), Context), 599 load_qq_and_retry(Here, Syntax, Module, Context, Stream, Term, Options)). 600 601load_qq_and_retry(Here, Syntax, Module, _, Stream, Term, Options) :- 602 set_stream_position(Stream, Here), 603 prolog:quasi_quotation_syntax(Syntax, Library), 604 !, 605 use_module(Module:Library, [Syntax/4]), 606 read_term(Stream, Term, Options). 607load_qq_and_retry(_Pos, Syntax, Module, Context, _Stream, _Term, _Options) :- 608 print_message(warning, quasi_quotation(undeclared, Syntax)), 609 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.
620prologquasi_quotation_syntax(html, library(http/html_write)). 621prologquasi_quotation_syntax(javascript, library(http/js_write)).
true (default false), do not report syntax errors and
other errors.640prolog_file_directives(File, Directives, Options) :- 641 option(canonical_source(Path), Options, _), 642 prolog_canonical_source(File, Path), 643 in_temporary_module( 644 TempModule, 645 true, 646 read_directives(TempModule, Path, Directives, Options)). 647 648read_directives(TempModule, Path, Directives, Options) :- 649 setup_call_cleanup( 650 read_directives_setup(TempModule, Path, In, State), 651 phrase(read_directives(In, Options, [true]), Directives), 652 read_directives_cleanup(In, State)). 653 654read_directives_setup(TempModule, Path, In, state(OldM, OldXref)) :- 655 prolog_open_source(Path, In), 656 '$set_source_module'(OldM, TempModule), 657 current_prolog_flag(xref, OldXref), 658 set_prolog_flag(xref, true). 659 660read_directives_cleanup(In, state(OldM, OldXref)) :- 661 '$set_source_module'(OldM), 662 set_prolog_flag(xref, OldXref), 663 prolog_close_source(In). 664 665read_directives(In, Options, State) --> 666 { E = error(_,_), 667 repeat, 668 catch(prolog_read_source_term(In, Term, Expanded, 669 [ process_comment(true), 670 syntax_errors(error) 671 ]), 672 E, report_syntax_error(E, Options)) 673 -> nonvar(Term), 674 Term = (:-_) 675 }, 676 !, 677 terms(Expanded, State, State1), 678 read_directives(In, Options, State1). 679read_directives(_, _, _) --> []. 680 681report_syntax_error(_, Options) :- 682 option(silent(true), Options), 683 !, 684 fail. 685report_syntax_error(E, _Options) :- 686 print_message(warning, E), 687 fail. 688 689terms(Var, State, State) --> { var(Var) }, !. 690terms([H|T], State0, State) --> 691 !, 692 terms(H, State0, State1), 693 terms(T, State1, State). 694terms((:-if(Cond)), State0, [True|State0]) --> 695 !, 696 { eval_cond(Cond, True) }. 697terms((:-elif(Cond)), [True0|State], [True|State]) --> 698 !, 699 { eval_cond(Cond, True1), 700 elif(True0, True1, True) 701 }. 702terms((:-else), [True0|State], [True|State]) --> 703 !, 704 { negate(True0, True) }. 705terms((:-endif), [_|State], State) --> !. 706terms(H, State, State) --> 707 ( {State = [true|_]} 708 -> [H] 709 ; [] 710 ). 711 712eval_cond(Cond, true) :- 713 catch(Cond, error(_,_), fail), 714 !. 715eval_cond(_, false). 716 717elif(true, _, else_false) :- !. 718elif(false, true, true) :- !. 719elif(True, _, True). 720 721negate(true, false). 722negate(false, true). 723negate(else_false, else_false). 724 725 /******************************* 726 * SOURCES * 727 *******************************/
process_source(Src) :-
prolog_open_source(Src, In),
call_cleanup(process(Src), prolog_close_source(In)).
749prolog_open_source(Src, Fd) :- 750 '$push_input_context'(source), 751 catch(do_open_source(Src, Fd, Hooked), 752 E, 753 ( '$pop_input_context', 754 throw(E) 755 )), 756 skip_hashbang(Fd), 757 push_operators([]), 758 '$current_source_module'(SM), 759 '$save_lex_state'(LexState, []), 760 asserta(open_source(Fd, state(Hooked, Src, LexState, SM))). 761 762do_open_source(Src, Stream, stream) :- 763 is_stream(Src), 764 !, 765 Stream = Src. 766do_open_source(Src, Stream, hooked) :- 767 prolog:xref_open_source(Src, Stream), 768 !. 769do_open_source(Src, Stream, opened) :- 770 open(Src, read, Stream). 771 772 773skip_hashbang(Fd) :- 774 catch(( peek_char(Fd, #) % Deal with #! script 775 -> skip(Fd, 10) 776 ; true 777 ), E, 778 ( close(Fd, [force(true)]), 779 '$pop_input_context', 780 throw(E) 781 )).
expand_term(end_of_file, _) to allow expansion
modules to clean-up.799prolog_close_source(In) :- 800 call_cleanup( 801 restore_source_context(In, Hooked, Src), 802 close_source(Hooked, Src, In)). 803 804close_source(stream, _Src, _Stream) :- 805 !, 806 '$pop_input_context'. 807close_source(hooked, Src, In) :- 808 catch(prolog:xref_close_source(Src, In), _, false), 809 !, 810 '$pop_input_context'. 811close_source(_, _Src, In) :- % If hook fails we must do normal close 812 close(In, [force(true)]), 813 '$pop_input_context'. 814 815restore_source_context(In, Hooked, Src) :- 816 ( at_end_of_stream(In) 817 -> true 818 ; ignore(catch(expand(end_of_file, _, In, _), _, true)) 819 ), 820 pop_operators, 821 retractall(mode(In, _)), 822 ( retract(open_source(In, state(Hooked, Src, LexState, SM))) 823 -> '$restore_lex_state'(LexState), 824 '$set_source_module'(SM) 825 ; assertion(fail) 826 ).
force(true) is used.841prolog_canonical_source(Source, Src) :- 842 var(Source), 843 !, 844 Src = Source. 845prolog_canonical_source(User, user) :- 846 User == user, 847 !. 848prolog_canonical_source(Stream, Src) :- 849 is_stream(Stream), 850 !, 851 Src = Stream. 852prolog_canonical_source(Src, Id) :- % Call hook 853 prolog:xref_source_identifier(Src, Id), 854 !. 855prolog_canonical_source(Source, Src) :- 856 source_file(Source), 857 !, 858 Src = Source. 859prolog_canonical_source(Source, Src) :- 860 absolute_file_name(Source, Src, 861 [ file_type(prolog), 862 access(read), 863 file_errors(fail) 864 ]), 865 !.
873file_name_on_path(Path, ShortId) :-
874 ( file_alias_path(Alias, Dir),
875 atom_concat(Dir, Local, Path)
876 -> ( Alias == '.'
877 -> ShortId = Local
878 ; file_name_extension(Base, pl, Local)
879 -> ShortId =.. [Alias, Base]
880 ; ShortId =.. [Alias, Local]
881 )
882 ; ShortId = Path
883 ).891:- dynamic 892 alias_cache/2. 893 894file_alias_path(Alias, Dir) :- 895 ( alias_cache(_, _) 896 -> true 897 ; build_alias_cache 898 ), 899 ( nonvar(Dir) 900 -> ensure_slash(Dir, DirSlash), 901 alias_cache(Alias, DirSlash) 902 ; alias_cache(Alias, Dir) 903 ). 904 905build_alias_cache :- 906 findall(t(DirLen, AliasLen, Alias, Dir), 907 search_path(Alias, Dir, AliasLen, DirLen), Ts), 908 sort(0, >, Ts, List), 909 forall(member(t(_, _, Alias, Dir), List), 910 assert(alias_cache(Alias, Dir))). 911 912search_path('.', Here, 999, DirLen) :- 913 working_directory(Here0, Here0), 914 ensure_slash(Here0, Here), 915 atom_length(Here, DirLen). 916search_path(Alias, Dir, AliasLen, DirLen) :- 917 user:file_search_path(Alias, _), 918 Alias \== autoload, % TBD: Multifile predicate? 919 Alias \== noautoload, 920 Spec =.. [Alias,'.'], 921 atom_length(Alias, AliasLen0), 922 AliasLen is 1000 - AliasLen0, % must do reverse sort 923 absolute_file_name(Spec, Dir0, 924 [ file_type(directory), 925 access(read), 926 solutions(all), 927 file_errors(fail) 928 ]), 929 ensure_slash(Dir0, Dir), 930 atom_length(Dir, DirLen). 931 932ensure_slash(Dir, Dir) :- 933 sub_atom(Dir, _, _, 0, /), 934 !. 935ensure_slash(Dir0, Dir) :- 936 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.
957path_segments_atom(Segments, Atom) :- 958 var(Atom), 959 !, 960 ( atomic(Segments) 961 -> Atom = Segments 962 ; segments_to_list(Segments, List, []) 963 -> atomic_list_concat(List, /, Atom) 964 ; throw(error(type_error(file_path, Segments), _)) 965 ). 966path_segments_atom(Segments, Atom) :- 967 atomic_list_concat(List, /, Atom), 968 parts_to_path(List, Segments). 969 970segments_to_list(Var, _, _) :- 971 var(Var), !, fail. 972segments_to_list(A/B, H, T) :- 973 segments_to_list(A, H, T0), 974 segments_to_list(B, T0, T). 975segments_to_list(A, [A|T], T) :- 976 atomic(A). 977 978parts_to_path([One], One) :- !. 979parts_to_path(List, More/T) :- 980 ( append(H, [T], List) 981 -> parts_to_path(H, More) 982 ).
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.
997directory_source_files(Dir, SrcFiles, Options) :- 998 option(if(loaded), Options, loaded), 999 !, 1000 absolute_file_name(Dir, AbsDir, [file_type(directory), access(read)]), 1001 ( option(recursive(true), Options) 1002 -> ensure_slash(AbsDir, Prefix), 1003 findall(F, ( source_file(F), 1004 sub_atom(F, 0, _, _, Prefix) 1005 ), 1006 SrcFiles) 1007 ; findall(F, ( source_file(F), 1008 file_directory_name(F, AbsDir) 1009 ), 1010 SrcFiles) 1011 ). 1012directory_source_files(Dir, SrcFiles, Options) :- 1013 absolute_file_name(Dir, AbsDir, [file_type(directory), access(read)]), 1014 directory_files(AbsDir, Files), 1015 phrase(src_files(Files, AbsDir, Options), SrcFiles). 1016 1017src_files([], _, _) --> 1018 []. 1019src_files([H|T], Dir, Options) --> 1020 { file_name_extension(_, Ext, H), 1021 user:prolog_file_type(Ext, prolog), 1022 \+ user:prolog_file_type(Ext, qlf), 1023 dir_file_path(Dir, H, File0), 1024 absolute_file_name(File0, File, 1025 [ file_errors(fail) 1026 | Options 1027 ]) 1028 }, 1029 !, 1030 [File], 1031 src_files(T, Dir, Options). 1032src_files([H|T], Dir, Options) --> 1033 { \+ special(H), 1034 option(recursive(true), Options), 1035 dir_file_path(Dir, H, SubDir), 1036 exists_directory(SubDir), 1037 !, 1038 catch(directory_files(SubDir, Files), _, fail) 1039 }, 1040 !, 1041 src_files(Files, SubDir, Options), 1042 src_files(T, Dir, Options). 1043src_files([_|T], Dir, Options) --> 1044 src_files(T, Dir, Options). 1045 1046special(.). 1047special(..). 1048 1049% avoid dependency on library(filesex), which also pulls a foreign 1050% dependency. 1051dir_file_path(Dir, File, Path) :- 1052 ( sub_atom(Dir, _, _, 0, /) 1053 -> atom_concat(Dir, File, Path) 1054 ; atom_concat(Dir, /, TheDir), 1055 atom_concat(TheDir, File, Path) 1056 ).
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)
1089valid_term_position(Term, TermPos) :- 1090 valid_term_position(0, 0x7fffffffffffffff, Term, TermPos). 1091 1092valid_term_position(OuterFrom, OuterTo, _Term, TermPos), 1093 var(TermPos), 1094 OuterFrom =< OuterTo => true. 1095valid_term_position(OuterFrom, OuterTo, Var, From-To), 1096 var(Var), 1097 valid_term_position_from_to(OuterFrom, OuterTo, From, To) => true. 1098valid_term_position(OuterFrom, OuterTo, Atom, From-To), 1099 atom(Atom), 1100 valid_term_position_from_to(OuterFrom, OuterTo, From, To) => true. 1101valid_term_position(OuterFrom, OuterTo, Number, From-To), 1102 number(Number), 1103 valid_term_position_from_to(OuterFrom, OuterTo, From, To) => true. 1104valid_term_position(OuterFrom, OuterTo, [], From-To), 1105 valid_term_position_from_to(OuterFrom, OuterTo, From, To) => true. 1106valid_term_position(OuterFrom, OuterTo, String, string_position(From,To)), 1107 ( string(String) 1108 -> true 1109 ; is_of_type(codes, String) 1110 -> true 1111 ; is_of_type(chars, String) 1112 -> true 1113 ; atom(String) 1114 ), 1115 valid_term_position_from_to(OuterFrom, OuterTo, From, To) => true. 1116valid_term_position(OuterFrom, OuterTo, {Arg}, 1117 brace_term_position(From,To,ArgPos)), 1118 valid_term_position_from_to(OuterFrom, OuterTo, From, To) => 1119 valid_term_position(From, To, Arg, ArgPos). 1120valid_term_position(OuterFrom, OuterTo, [Hd|Tl], 1121 list_position(From,To,ElemsPos,none)), 1122 valid_term_position_from_to(OuterFrom, OuterTo, From, To) => 1123 term_position_list_tail([Hd|Tl], _HdPart, []), 1124 maplist(valid_term_position, [Hd|Tl], ElemsPos). 1125valid_term_position(OuterFrom, OuterTo, [Hd|Tl], 1126 list_position(From, To, ElemsPos, TailPos)), 1127 valid_term_position_from_to(OuterFrom, OuterTo, From, To) => 1128 term_position_list_tail([Hd|Tl], HdPart, Tail), 1129 maplist(valid_term_position(From,To), HdPart, ElemsPos), 1130 valid_term_position(Tail, TailPos). 1131valid_term_position(OuterFrom, OuterTo, Term, 1132 term_position(From,To, FFrom,FTo,SubPos)), 1133 valid_term_position_from_to(OuterFrom, OuterTo, From, To) => 1134 compound_name_arguments(Term, Name, Arguments), 1135 valid_term_position(Name, FFrom-FTo), 1136 maplist(valid_term_position(From,To), Arguments, SubPos). 1137valid_term_position(OuterFrom, OuterTo, Dict, 1138 dict_position(From,To,TagFrom,TagTo,KeyValuePosList)), 1139 valid_term_position_from_to(OuterFrom, OuterTo, From, To) => 1140 dict_pairs(Dict, Tag, Pairs), 1141 valid_term_position(Tag, TagFrom-TagTo), 1142 foldl(valid_term_position_dict(From,To), Pairs, KeyValuePosList, []). 1143% key_value_position(From, To, SepFrom, SepTo, Key, KeyPos, ValuePos) 1144% is handled in valid_term_position_dict. 1145valid_term_position(OuterFrom, OuterTo, Term, 1146 parentheses_term_position(From,To,ContentPos)), 1147 valid_term_position_from_to(OuterFrom, OuterTo, From, To) => 1148 valid_term_position(From, To, Term, ContentPos). 1149valid_term_position(OuterFrom, OuterTo, _Term, 1150 quasi_quotation_position(From,To, 1151 SyntaxTerm,SyntaxPos,_ContentPos)), 1152 valid_term_position_from_to(OuterFrom, OuterTo, From, To) => 1153 valid_term_position(From, To, SyntaxTerm, SyntaxPos). 1154 1155valid_term_position_from_to(OuterFrom, OuterTo, From, To) :- 1156 integer(OuterFrom), 1157 integer(OuterTo), 1158 integer(From), 1159 integer(To), 1160 OuterFrom =< OuterTo, 1161 From =< To, 1162 OuterFrom =< From, 1163 To =< OuterTo. 1164 1165:- det(valid_term_position_dict/5). 1166valid_term_position_dict(OuterFrom, OuterTo, Key-Value, 1167 KeyValuePosList0, KeyValuePosList1) :- 1168 selectchk(key_value_position(From,To,SepFrom,SepTo,Key,KeyPos,ValuePos), 1169 KeyValuePosList0, KeyValuePosList1), 1170 valid_term_position_from_to(OuterFrom, OuterTo, From, To), 1171 valid_term_position_from_to(OuterFrom, OuterTo, SepFrom, SepTo), 1172 SepFrom >= OuterFrom, 1173 valid_term_position(From, SepFrom, Key, KeyPos), 1174 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].
1191:- det(term_position_list_tail/3). 1192term_position_list_tail([X|Xs], HdPart, Tail) => 1193 HdPart = [X|HdPart2], 1194 term_position_list_tail(Xs, HdPart2, Tail). 1195term_position_list_tail(Tail0, HdPart, Tail) => 1196 HdPart = [], 1197 Tail0 = Tail. 1198 1199 1200 /******************************* 1201 * MESSAGES * 1202 *******************************/ 1203 1204:- multifile 1205 prolog:message//1. 1206 1207prologmessage(quasi_quotation(undeclared, Syntax)) --> 1208 [ 'Undeclared quasi quotation syntax: ~w'-[Syntax], nl, 1209 'Autoloading can be defined using prolog:quasi_quotation_syntax/2' 1210 ]
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*/