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, OldM) :- 655 prolog_open_source(Path, In), 656 '$set_source_module'(OldM, TempModule), 657 push_prolog_flag(xref, true). 658 659read_directives_cleanup(In, OldM) :- 660 '$set_source_module'(OldM), 661 pop_prolog_flag(xref), 662 prolog_close_source(In). 663 664read_directives(In, Options, State) --> 665 { E = error(_,_), 666 repeat, 667 catch(prolog_read_source_term(In, Term, Expanded, 668 [ process_comment(true), 669 syntax_errors(error) 670 ]), 671 E, report_syntax_error(E, Options)) 672 -> nonvar(Term), 673 Term = (:-_) 674 }, 675 !, 676 terms(Expanded, State, State1), 677 read_directives(In, Options, State1). 678read_directives(_, _, _) --> []. 679 680report_syntax_error(_, Options) :- 681 option(silent(true), Options), 682 !, 683 fail. 684report_syntax_error(E, _Options) :- 685 print_message(warning, E), 686 fail. 687 688terms(Var, State, State) --> { var(Var) }, !. 689terms([H|T], State0, State) --> 690 !, 691 terms(H, State0, State1), 692 terms(T, State1, State). 693terms((:-if(Cond)), State0, [True|State0]) --> 694 !, 695 { eval_cond(Cond, True) }. 696terms((:-elif(Cond)), [True0|State], [True|State]) --> 697 !, 698 { eval_cond(Cond, True1), 699 elif(True0, True1, True) 700 }. 701terms((:-else), [True0|State], [True|State]) --> 702 !, 703 { negate(True0, True) }. 704terms((:-endif), [_|State], State) --> !. 705terms(H, State, State) --> 706 ( {State = [true|_]} 707 -> [H] 708 ; [] 709 ). 710 711eval_cond(Cond, true) :- 712 catch(Cond, error(_,_), fail), 713 !. 714eval_cond(_, false). 715 716elif(true, _, else_false) :- !. 717elif(false, true, true) :- !. 718elif(True, _, True). 719 720negate(true, false). 721negate(false, true). 722negate(else_false, else_false). 723 724 /******************************* 725 * SOURCES * 726 *******************************/
process_source(Src) :-
prolog_open_source(Src, In),
call_cleanup(process(Src), prolog_close_source(In)).
748prolog_open_source(Src, Fd) :- 749 '$push_input_context'(source), 750 catch(do_open_source(Src, Fd, Hooked), 751 E, 752 ( '$pop_input_context', 753 throw(E) 754 )), 755 skip_hashbang(Fd), 756 push_operators([]), 757 '$current_source_module'(SM), 758 '$save_lex_state'(LexState, []), 759 asserta(open_source(Fd, state(Hooked, Src, LexState, SM))). 760 761do_open_source(Src, Stream, stream) :- 762 is_stream(Src), 763 !, 764 Stream = Src. 765do_open_source(Src, Stream, hooked) :- 766 prolog:xref_open_source(Src, Stream), 767 !. 768do_open_source(Src, Stream, opened) :- 769 open(Src, read, Stream). 770 771 772skip_hashbang(Fd) :- 773 catch(( peek_char(Fd, #) % Deal with #! script 774 -> skip(Fd, 10) 775 ; true 776 ), E, 777 ( close(Fd, [force(true)]), 778 '$pop_input_context', 779 throw(E) 780 )).
expand_term(end_of_file, _) to allow expansion
modules to clean-up.798prolog_close_source(In) :- 799 call_cleanup( 800 restore_source_context(In, Hooked, Src), 801 close_source(Hooked, Src, In)). 802 803close_source(stream, _Src, _Stream) :- 804 !, 805 '$pop_input_context'. 806close_source(hooked, Src, In) :- 807 catch(prolog:xref_close_source(Src, In), _, false), 808 !, 809 '$pop_input_context'. 810close_source(_, _Src, In) :- % If hook fails we must do normal close 811 close(In, [force(true)]), 812 '$pop_input_context'. 813 814restore_source_context(In, Hooked, Src) :- 815 ( at_end_of_stream(In) 816 -> true 817 ; ignore(catch(expand(end_of_file, _, In, _), _, true)) 818 ), 819 pop_operators, 820 retractall(mode(In, _)), 821 ( retract(open_source(In, state(Hooked, Src, LexState, SM))) 822 -> '$restore_lex_state'(LexState), 823 '$set_source_module'(SM) 824 ; assertion(fail) 825 ).
force(true) is used.840prolog_canonical_source(Source, Src) :- 841 var(Source), 842 !, 843 Src = Source. 844prolog_canonical_source(User, user) :- 845 User == user, 846 !. 847prolog_canonical_source(Stream, Src) :- 848 is_stream(Stream), 849 !, 850 Src = Stream. 851prolog_canonical_source(Src, Id) :- % Call hook 852 prolog:xref_source_identifier(Src, Id), 853 !. 854prolog_canonical_source(Source, Src) :- 855 source_file(Source), 856 !, 857 Src = Source. 858prolog_canonical_source(Source, Src) :- 859 absolute_file_name(Source, Src, 860 [ file_type(prolog), 861 access(read), 862 file_errors(fail) 863 ]), 864 !.
872file_name_on_path(Path, ShortId) :-
873 ( file_alias_path(Alias, Dir),
874 atom_concat(Dir, Local, Path)
875 -> ( Alias == '.'
876 -> ShortId = Local
877 ; file_name_extension(Base, pl, Local)
878 -> ShortId =.. [Alias, Base]
879 ; ShortId =.. [Alias, Local]
880 )
881 ; ShortId = Path
882 ).890:- dynamic 891 alias_cache/2. 892 893file_alias_path(Alias, Dir) :- 894 ( alias_cache(_, _) 895 -> true 896 ; build_alias_cache 897 ), 898 ( nonvar(Dir) 899 -> ensure_slash(Dir, DirSlash), 900 alias_cache(Alias, DirSlash) 901 ; alias_cache(Alias, Dir) 902 ). 903 904build_alias_cache :- 905 findall(t(DirLen, AliasLen, Alias, Dir), 906 search_path(Alias, Dir, AliasLen, DirLen), Ts), 907 sort(0, >, Ts, List), 908 forall(member(t(_, _, Alias, Dir), List), 909 assert(alias_cache(Alias, Dir))). 910 911search_path('.', Here, 999, DirLen) :- 912 working_directory(Here0, Here0), 913 ensure_slash(Here0, Here), 914 atom_length(Here, DirLen). 915search_path(Alias, Dir, AliasLen, DirLen) :- 916 user:file_search_path(Alias, _), 917 Alias \== autoload, % TBD: Multifile predicate? 918 Alias \== noautoload, 919 Spec =.. [Alias,'.'], 920 atom_length(Alias, AliasLen0), 921 AliasLen is 1000 - AliasLen0, % must do reverse sort 922 absolute_file_name(Spec, Dir0, 923 [ file_type(directory), 924 access(read), 925 solutions(all), 926 file_errors(fail) 927 ]), 928 ensure_slash(Dir0, Dir), 929 atom_length(Dir, DirLen). 930 931ensure_slash(Dir, Dir) :- 932 sub_atom(Dir, _, _, 0, /), 933 !. 934ensure_slash(Dir0, Dir) :- 935 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.
956path_segments_atom(Segments, Atom) :- 957 var(Atom), 958 !, 959 ( atomic(Segments) 960 -> Atom = Segments 961 ; segments_to_list(Segments, List, []) 962 -> atomic_list_concat(List, /, Atom) 963 ; throw(error(type_error(file_path, Segments), _)) 964 ). 965path_segments_atom(Segments, Atom) :- 966 atomic_list_concat(List, /, Atom), 967 parts_to_path(List, Segments). 968 969segments_to_list(Var, _, _) :- 970 var(Var), !, fail. 971segments_to_list(A/B, H, T) :- 972 segments_to_list(A, H, T0), 973 segments_to_list(B, T0, T). 974segments_to_list(A, [A|T], T) :- 975 atomic(A). 976 977parts_to_path([One], One) :- !. 978parts_to_path(List, More/T) :- 979 ( append(H, [T], List) 980 -> parts_to_path(H, More) 981 ).
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.
996directory_source_files(Dir, SrcFiles, Options) :- 997 option(if(loaded), Options, loaded), 998 !, 999 absolute_file_name(Dir, AbsDir, [file_type(directory), access(read)]), 1000 ( option(recursive(true), Options) 1001 -> ensure_slash(AbsDir, Prefix), 1002 findall(F, ( source_file(F), 1003 sub_atom(F, 0, _, _, Prefix) 1004 ), 1005 SrcFiles) 1006 ; findall(F, ( source_file(F), 1007 file_directory_name(F, AbsDir) 1008 ), 1009 SrcFiles) 1010 ). 1011directory_source_files(Dir, SrcFiles, Options) :- 1012 absolute_file_name(Dir, AbsDir, [file_type(directory), access(read)]), 1013 directory_files(AbsDir, Files), 1014 phrase(src_files(Files, AbsDir, Options), SrcFiles). 1015 1016src_files([], _, _) --> 1017 []. 1018src_files([H|T], Dir, Options) --> 1019 { file_name_extension(_, Ext, H), 1020 user:prolog_file_type(Ext, prolog), 1021 \+ user:prolog_file_type(Ext, qlf), 1022 dir_file_path(Dir, H, File0), 1023 absolute_file_name(File0, File, 1024 [ file_errors(fail) 1025 | Options 1026 ]) 1027 }, 1028 !, 1029 [File], 1030 src_files(T, Dir, Options). 1031src_files([H|T], Dir, Options) --> 1032 { \+ special(H), 1033 option(recursive(true), Options), 1034 dir_file_path(Dir, H, SubDir), 1035 exists_directory(SubDir), 1036 !, 1037 catch(directory_files(SubDir, Files), _, fail) 1038 }, 1039 !, 1040 src_files(Files, SubDir, Options), 1041 src_files(T, Dir, Options). 1042src_files([_|T], Dir, Options) --> 1043 src_files(T, Dir, Options). 1044 1045special(.). 1046special(..). 1047 1048% avoid dependency on library(filesex), which also pulls a foreign 1049% dependency. 1050dir_file_path(Dir, File, Path) :- 1051 ( sub_atom(Dir, _, _, 0, /) 1052 -> atom_concat(Dir, File, Path) 1053 ; atom_concat(Dir, /, TheDir), 1054 atom_concat(TheDir, File, Path) 1055 ).
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)
1088valid_term_position(Term, TermPos) :- 1089 valid_term_position(0, 0x7fffffffffffffff, Term, TermPos). 1090 1091valid_term_position(OuterFrom, OuterTo, _Term, TermPos), 1092 var(TermPos), 1093 OuterFrom =< OuterTo => true. 1094valid_term_position(OuterFrom, OuterTo, Var, From-To), 1095 var(Var), 1096 valid_term_position_from_to(OuterFrom, OuterTo, From, To) => true. 1097valid_term_position(OuterFrom, OuterTo, Atom, From-To), 1098 atom(Atom), 1099 valid_term_position_from_to(OuterFrom, OuterTo, From, To) => true. 1100valid_term_position(OuterFrom, OuterTo, Number, From-To), 1101 number(Number), 1102 valid_term_position_from_to(OuterFrom, OuterTo, From, To) => true. 1103valid_term_position(OuterFrom, OuterTo, [], From-To), 1104 valid_term_position_from_to(OuterFrom, OuterTo, From, To) => true. 1105valid_term_position(OuterFrom, OuterTo, String, string_position(From,To)), 1106 ( string(String) 1107 -> true 1108 ; is_of_type(codes, String) 1109 -> true 1110 ; is_of_type(chars, String) 1111 -> true 1112 ; atom(String) 1113 ), 1114 valid_term_position_from_to(OuterFrom, OuterTo, From, To) => true. 1115valid_term_position(OuterFrom, OuterTo, {Arg}, 1116 brace_term_position(From,To,ArgPos)), 1117 valid_term_position_from_to(OuterFrom, OuterTo, From, To) => 1118 valid_term_position(From, To, Arg, ArgPos). 1119valid_term_position(OuterFrom, OuterTo, [Hd|Tl], 1120 list_position(From,To,ElemsPos,none)), 1121 valid_term_position_from_to(OuterFrom, OuterTo, From, To) => 1122 term_position_list_tail([Hd|Tl], _HdPart, []), 1123 maplist(valid_term_position, [Hd|Tl], ElemsPos). 1124valid_term_position(OuterFrom, OuterTo, [Hd|Tl], 1125 list_position(From, To, ElemsPos, TailPos)), 1126 valid_term_position_from_to(OuterFrom, OuterTo, From, To) => 1127 term_position_list_tail([Hd|Tl], HdPart, Tail), 1128 maplist(valid_term_position(From,To), HdPart, ElemsPos), 1129 valid_term_position(Tail, TailPos). 1130valid_term_position(OuterFrom, OuterTo, Term, 1131 term_position(From,To, FFrom,FTo,SubPos)), 1132 valid_term_position_from_to(OuterFrom, OuterTo, From, To) => 1133 compound_name_arguments(Term, Name, Arguments), 1134 valid_term_position(Name, FFrom-FTo), 1135 maplist(valid_term_position(From,To), Arguments, SubPos). 1136valid_term_position(OuterFrom, OuterTo, Dict, 1137 dict_position(From,To,TagFrom,TagTo,KeyValuePosList)), 1138 valid_term_position_from_to(OuterFrom, OuterTo, From, To) => 1139 dict_pairs(Dict, Tag, Pairs), 1140 valid_term_position(Tag, TagFrom-TagTo), 1141 foldl(valid_term_position_dict(From,To), Pairs, KeyValuePosList, []). 1142% key_value_position(From, To, SepFrom, SepTo, Key, KeyPos, ValuePos) 1143% is handled in valid_term_position_dict. 1144valid_term_position(OuterFrom, OuterTo, Term, 1145 parentheses_term_position(From,To,ContentPos)), 1146 valid_term_position_from_to(OuterFrom, OuterTo, From, To) => 1147 valid_term_position(From, To, Term, ContentPos). 1148valid_term_position(OuterFrom, OuterTo, _Term, 1149 quasi_quotation_position(From,To, 1150 SyntaxTerm,SyntaxPos,_ContentPos)), 1151 valid_term_position_from_to(OuterFrom, OuterTo, From, To) => 1152 valid_term_position(From, To, SyntaxTerm, SyntaxPos). 1153 1154valid_term_position_from_to(OuterFrom, OuterTo, From, To) :- 1155 integer(OuterFrom), 1156 integer(OuterTo), 1157 integer(From), 1158 integer(To), 1159 OuterFrom =< OuterTo, 1160 From =< To, 1161 OuterFrom =< From, 1162 To =< OuterTo. 1163 1164:- det(valid_term_position_dict/5). 1165valid_term_position_dict(OuterFrom, OuterTo, Key-Value, 1166 KeyValuePosList0, KeyValuePosList1) :- 1167 selectchk(key_value_position(From,To,SepFrom,SepTo,Key,KeyPos,ValuePos), 1168 KeyValuePosList0, KeyValuePosList1), 1169 valid_term_position_from_to(OuterFrom, OuterTo, From, To), 1170 valid_term_position_from_to(OuterFrom, OuterTo, SepFrom, SepTo), 1171 SepFrom >= OuterFrom, 1172 valid_term_position(From, SepFrom, Key, KeyPos), 1173 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].
1190:- det(term_position_list_tail/3). 1191term_position_list_tail([X|Xs], HdPart, Tail) => 1192 HdPart = [X|HdPart2], 1193 term_position_list_tail(Xs, HdPart2, Tail). 1194term_position_list_tail(Tail0, HdPart, Tail) => 1195 HdPart = [], 1196 Tail0 = Tail. 1197 1198 1199 /******************************* 1200 * MESSAGES * 1201 *******************************/ 1202 1203:- multifile 1204 prolog:message//1. 1205 1206prologmessage(quasi_quotation(undeclared, Syntax)) --> 1207 [ 'Undeclared quasi quotation syntax: ~w'-[Syntax], nl, 1208 'Autoloading can be defined using prolog:quasi_quotation_syntax/2' 1209 ]
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