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.638prolog_file_directives(File, Directives, Options) :- 639 option(canonical_source(Path), Options, _), 640 prolog_canonical_source(File, Path), 641 in_temporary_module( 642 TempModule, 643 true, 644 read_directives(TempModule, Path, Directives, Options)). 645 646read_directives(TempModule, Path, Directives, Options) :- 647 setup_call_cleanup( 648 read_directives_setup(TempModule, Path, In, State), 649 phrase(read_directives(In, Options, [true]), Directives), 650 read_directives_cleanup(In, State)). 651 652read_directives_setup(TempModule, Path, In, state(OldM, OldXref)) :- 653 prolog_open_source(Path, In), 654 '$set_source_module'(OldM, TempModule), 655 current_prolog_flag(xref, OldXref), 656 set_prolog_flag(xref, true). 657 658read_directives_cleanup(In, state(OldM, OldXref)) :- 659 '$set_source_module'(OldM), 660 set_prolog_flag(xref, OldXref), 661 prolog_close_source(In). 662 663read_directives(In, Options, State) --> 664 { E = error(_,_), 665 repeat, 666 catch(prolog_read_source_term(In, Term, Expanded, 667 [ process_comment(true), 668 syntax_errors(error) 669 ]), 670 E, report_syntax_error(E, Options)) 671 -> nonvar(Term), 672 Term = (:-_) 673 }, 674 !, 675 terms(Expanded, State, State1), 676 read_directives(In, Options, State1). 677read_directives(_, _, _) --> []. 678 679report_syntax_error(_, Options) :- 680 option(silent(true), Options), 681 !, 682 fail. 683report_syntax_error(E, _Options) :- 684 print_message(warning, E), 685 fail. 686 687terms(Var, State, State) --> { var(Var) }, !. 688terms([H|T], State0, State) --> 689 !, 690 terms(H, State0, State1), 691 terms(T, State1, State). 692terms((:-if(Cond)), State0, [True|State0]) --> 693 !, 694 { eval_cond(Cond, True) }. 695terms((:-elif(Cond)), [True0|State], [True|State]) --> 696 !, 697 { eval_cond(Cond, True1), 698 elif(True0, True1, True) 699 }. 700terms((:-else), [True0|State], [True|State]) --> 701 !, 702 { negate(True0, True) }. 703terms((:-endif), [_|State], State) --> !. 704terms(H, State, State) --> 705 ( {State = [true|_]} 706 -> [H] 707 ; [] 708 ). 709 710eval_cond(Cond, true) :- 711 catch(Cond, error(_,_), fail), 712 !. 713eval_cond(_, false). 714 715elif(true, _, else_false) :- !. 716elif(false, true, true) :- !. 717elif(True, _, True). 718 719negate(true, false). 720negate(false, true). 721negate(else_false, else_false). 722 723 /******************************* 724 * SOURCES * 725 *******************************/
process_source(Src) :-
prolog_open_source(Src, In),
call_cleanup(process(Src), prolog_close_source(In)).
742prolog_open_source(Src, Fd) :- 743 '$push_input_context'(source), 744 catch(( prolog:xref_open_source(Src, Fd) 745 -> Hooked = true 746 ; open(Src, read, Fd), 747 Hooked = false 748 ), E, 749 ( '$pop_input_context', 750 throw(E) 751 )), 752 skip_hashbang(Fd), 753 push_operators([]), 754 '$current_source_module'(SM), 755 '$save_lex_state'(LexState, []), 756 asserta(open_source(Fd, state(Hooked, Src, LexState, SM))). 757 758skip_hashbang(Fd) :- 759 catch(( peek_char(Fd, #) % Deal with #! script 760 -> skip(Fd, 10) 761 ; true 762 ), E, 763 ( close(Fd, [force(true)]), 764 '$pop_input_context', 765 throw(E) 766 )).
expand_term(end_of_file, _) to allow expansion
modules to clean-up.784prolog_close_source(In) :- 785 call_cleanup( 786 restore_source_context(In, Hooked, Src), 787 close_source(Hooked, Src, In)). 788 789close_source(true, Src, In) :- 790 catch(prolog:xref_close_source(Src, In), _, false), 791 !, 792 '$pop_input_context'. 793close_source(_, _Src, In) :- 794 close(In, [force(true)]), 795 '$pop_input_context'. 796 797restore_source_context(In, Hooked, Src) :- 798 ( at_end_of_stream(In) 799 -> true 800 ; ignore(catch(expand(end_of_file, _, In, _), _, true)) 801 ), 802 pop_operators, 803 retractall(mode(In, _)), 804 ( retract(open_source(In, state(Hooked, Src, LexState, SM))) 805 -> '$restore_lex_state'(LexState), 806 '$set_source_module'(SM) 807 ; assertion(fail) 808 ).
force(true) is used.823prolog_canonical_source(Source, Src) :- 824 var(Source), 825 !, 826 Src = Source. 827prolog_canonical_source(User, user) :- 828 User == user, 829 !. 830prolog_canonical_source(Src, Id) :- % Call hook 831 prolog:xref_source_identifier(Src, Id), 832 !. 833prolog_canonical_source(Source, Src) :- 834 source_file(Source), 835 !, 836 Src = Source. 837prolog_canonical_source(Source, Src) :- 838 absolute_file_name(Source, Src, 839 [ file_type(prolog), 840 access(read), 841 file_errors(fail) 842 ]), 843 !.
851file_name_on_path(Path, ShortId) :-
852 ( file_alias_path(Alias, Dir),
853 atom_concat(Dir, Local, Path)
854 -> ( Alias == '.'
855 -> ShortId = Local
856 ; file_name_extension(Base, pl, Local)
857 -> ShortId =.. [Alias, Base]
858 ; ShortId =.. [Alias, Local]
859 )
860 ; ShortId = Path
861 ).869:- dynamic 870 alias_cache/2. 871 872file_alias_path(Alias, Dir) :- 873 ( alias_cache(_, _) 874 -> true 875 ; build_alias_cache 876 ), 877 ( nonvar(Dir) 878 -> ensure_slash(Dir, DirSlash), 879 alias_cache(Alias, DirSlash) 880 ; alias_cache(Alias, Dir) 881 ). 882 883build_alias_cache :- 884 findall(t(DirLen, AliasLen, Alias, Dir), 885 search_path(Alias, Dir, AliasLen, DirLen), Ts), 886 sort(0, >, Ts, List), 887 forall(member(t(_, _, Alias, Dir), List), 888 assert(alias_cache(Alias, Dir))). 889 890search_path('.', Here, 999, DirLen) :- 891 working_directory(Here0, Here0), 892 ensure_slash(Here0, Here), 893 atom_length(Here, DirLen). 894search_path(Alias, Dir, AliasLen, DirLen) :- 895 user:file_search_path(Alias, _), 896 Alias \== autoload, % TBD: Multifile predicate? 897 Alias \== noautoload, 898 Spec =.. [Alias,'.'], 899 atom_length(Alias, AliasLen0), 900 AliasLen is 1000 - AliasLen0, % must do reverse sort 901 absolute_file_name(Spec, Dir0, 902 [ file_type(directory), 903 access(read), 904 solutions(all), 905 file_errors(fail) 906 ]), 907 ensure_slash(Dir0, Dir), 908 atom_length(Dir, DirLen). 909 910ensure_slash(Dir, Dir) :- 911 sub_atom(Dir, _, _, 0, /), 912 !. 913ensure_slash(Dir0, Dir) :- 914 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.
935path_segments_atom(Segments, Atom) :- 936 var(Atom), 937 !, 938 ( atomic(Segments) 939 -> Atom = Segments 940 ; segments_to_list(Segments, List, []) 941 -> atomic_list_concat(List, /, Atom) 942 ; throw(error(type_error(file_path, Segments), _)) 943 ). 944path_segments_atom(Segments, Atom) :- 945 atomic_list_concat(List, /, Atom), 946 parts_to_path(List, Segments). 947 948segments_to_list(Var, _, _) :- 949 var(Var), !, fail. 950segments_to_list(A/B, H, T) :- 951 segments_to_list(A, H, T0), 952 segments_to_list(B, T0, T). 953segments_to_list(A, [A|T], T) :- 954 atomic(A). 955 956parts_to_path([One], One) :- !. 957parts_to_path(List, More/T) :- 958 ( append(H, [T], List) 959 -> parts_to_path(H, More) 960 ).
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.
975directory_source_files(Dir, SrcFiles, Options) :- 976 option(if(loaded), Options, loaded), 977 !, 978 absolute_file_name(Dir, AbsDir, [file_type(directory), access(read)]), 979 ( option(recursive(true), Options) 980 -> ensure_slash(AbsDir, Prefix), 981 findall(F, ( source_file(F), 982 sub_atom(F, 0, _, _, Prefix) 983 ), 984 SrcFiles) 985 ; findall(F, ( source_file(F), 986 file_directory_name(F, AbsDir) 987 ), 988 SrcFiles) 989 ). 990directory_source_files(Dir, SrcFiles, Options) :- 991 absolute_file_name(Dir, AbsDir, [file_type(directory), access(read)]), 992 directory_files(AbsDir, Files), 993 phrase(src_files(Files, AbsDir, Options), SrcFiles). 994 995src_files([], _, _) --> 996 []. 997src_files([H|T], Dir, Options) --> 998 { file_name_extension(_, Ext, H), 999 user:prolog_file_type(Ext, prolog), 1000 \+ user:prolog_file_type(Ext, qlf), 1001 dir_file_path(Dir, H, File0), 1002 absolute_file_name(File0, File, 1003 [ file_errors(fail) 1004 | Options 1005 ]) 1006 }, 1007 !, 1008 [File], 1009 src_files(T, Dir, Options). 1010src_files([H|T], Dir, Options) --> 1011 { \+ special(H), 1012 option(recursive(true), Options), 1013 dir_file_path(Dir, H, SubDir), 1014 exists_directory(SubDir), 1015 !, 1016 catch(directory_files(SubDir, Files), _, fail) 1017 }, 1018 !, 1019 src_files(Files, SubDir, Options), 1020 src_files(T, Dir, Options). 1021src_files([_|T], Dir, Options) --> 1022 src_files(T, Dir, Options). 1023 1024special(.). 1025special(..). 1026 1027% avoid dependency on library(filesex), which also pulls a foreign 1028% dependency. 1029dir_file_path(Dir, File, Path) :- 1030 ( sub_atom(Dir, _, _, 0, /) 1031 -> atom_concat(Dir, File, Path) 1032 ; atom_concat(Dir, /, TheDir), 1033 atom_concat(TheDir, File, Path) 1034 ).
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)
1067valid_term_position(Term, TermPos) :- 1068 valid_term_position(0, 0x7fffffffffffffff, Term, TermPos). 1069 1070valid_term_position(OuterFrom, OuterTo, _Term, TermPos), 1071 var(TermPos), 1072 OuterFrom =< OuterTo => true. 1073valid_term_position(OuterFrom, OuterTo, Var, From-To), 1074 var(Var), 1075 valid_term_position_from_to(OuterFrom, OuterTo, From, To) => true. 1076valid_term_position(OuterFrom, OuterTo, Atom, From-To), 1077 atom(Atom), 1078 valid_term_position_from_to(OuterFrom, OuterTo, From, To) => true. 1079valid_term_position(OuterFrom, OuterTo, Number, From-To), 1080 number(Number), 1081 valid_term_position_from_to(OuterFrom, OuterTo, From, To) => true. 1082valid_term_position(OuterFrom, OuterTo, [], From-To), 1083 valid_term_position_from_to(OuterFrom, OuterTo, From, To) => true. 1084valid_term_position(OuterFrom, OuterTo, String, string_position(From,To)), 1085 ( string(String) 1086 -> true 1087 ; is_of_type(codes, String) 1088 -> true 1089 ; is_of_type(chars, String) 1090 -> true 1091 ; atom(String) 1092 ), 1093 valid_term_position_from_to(OuterFrom, OuterTo, From, To) => true. 1094valid_term_position(OuterFrom, OuterTo, {Arg}, 1095 brace_term_position(From,To,ArgPos)), 1096 valid_term_position_from_to(OuterFrom, OuterTo, From, To) => 1097 valid_term_position(From, To, Arg, ArgPos). 1098valid_term_position(OuterFrom, OuterTo, [Hd|Tl], 1099 list_position(From,To,ElemsPos,none)), 1100 valid_term_position_from_to(OuterFrom, OuterTo, From, To) => 1101 term_position_list_tail([Hd|Tl], _HdPart, []), 1102 maplist(valid_term_position, [Hd|Tl], ElemsPos). 1103valid_term_position(OuterFrom, OuterTo, [Hd|Tl], 1104 list_position(From, To, ElemsPos, TailPos)), 1105 valid_term_position_from_to(OuterFrom, OuterTo, From, To) => 1106 term_position_list_tail([Hd|Tl], HdPart, Tail), 1107 maplist(valid_term_position(From,To), HdPart, ElemsPos), 1108 valid_term_position(Tail, TailPos). 1109valid_term_position(OuterFrom, OuterTo, Term, 1110 term_position(From,To, FFrom,FTo,SubPos)), 1111 valid_term_position_from_to(OuterFrom, OuterTo, From, To) => 1112 compound_name_arguments(Term, Name, Arguments), 1113 valid_term_position(Name, FFrom-FTo), 1114 maplist(valid_term_position(From,To), Arguments, SubPos). 1115valid_term_position(OuterFrom, OuterTo, Dict, 1116 dict_position(From,To,TagFrom,TagTo,KeyValuePosList)), 1117 valid_term_position_from_to(OuterFrom, OuterTo, From, To) => 1118 dict_pairs(Dict, Tag, Pairs), 1119 valid_term_position(Tag, TagFrom-TagTo), 1120 foldl(valid_term_position_dict(From,To), Pairs, KeyValuePosList, []). 1121% key_value_position(From, To, SepFrom, SepTo, Key, KeyPos, ValuePos) 1122% is handled in valid_term_position_dict. 1123valid_term_position(OuterFrom, OuterTo, Term, 1124 parentheses_term_position(From,To,ContentPos)), 1125 valid_term_position_from_to(OuterFrom, OuterTo, From, To) => 1126 valid_term_position(From, To, Term, ContentPos). 1127valid_term_position(OuterFrom, OuterTo, _Term, 1128 quasi_quotation_position(From,To, 1129 SyntaxTerm,SyntaxPos,_ContentPos)), 1130 valid_term_position_from_to(OuterFrom, OuterTo, From, To) => 1131 valid_term_position(From, To, SyntaxTerm, SyntaxPos). 1132 1133valid_term_position_from_to(OuterFrom, OuterTo, From, To) :- 1134 integer(OuterFrom), 1135 integer(OuterTo), 1136 integer(From), 1137 integer(To), 1138 OuterFrom =< OuterTo, 1139 From =< To, 1140 OuterFrom =< From, 1141 To =< OuterTo. 1142 1143:- det(valid_term_position_dict/5). 1144valid_term_position_dict(OuterFrom, OuterTo, Key-Value, 1145 KeyValuePosList0, KeyValuePosList1) :- 1146 selectchk(key_value_position(From,To,SepFrom,SepTo,Key,KeyPos,ValuePos), 1147 KeyValuePosList0, KeyValuePosList1), 1148 valid_term_position_from_to(OuterFrom, OuterTo, From, To), 1149 valid_term_position_from_to(OuterFrom, OuterTo, SepFrom, SepTo), 1150 SepFrom >= OuterFrom, 1151 valid_term_position(From, SepFrom, Key, KeyPos), 1152 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].
1169:- det(term_position_list_tail/3). 1170term_position_list_tail([X|Xs], HdPart, Tail) => 1171 HdPart = [X|HdPart2], 1172 term_position_list_tail(Xs, HdPart2, Tail). 1173term_position_list_tail(Tail0, HdPart, Tail) => 1174 HdPart = [], 1175 Tail0 = Tail. 1176 1177 1178 /******************************* 1179 * MESSAGES * 1180 *******************************/ 1181 1182:- multifile 1183 prolog:message//1. 1184 1185prologmessage(quasi_quotation(undeclared, Syntax)) --> 1186 [ 'Undeclared quasi quotation syntax: ~w'-[Syntax], nl, 1187 'Autoloading can be defined using prolog:quasi_quotation_syntax/2' 1188 ]
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*/