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(html_write:html_meta_head(Head,Module,Meta), _M) :- 270 ( html_write:html_meta_head(Head,Module,Meta) 271 -> true 272 ; assertz(html_write:html_meta_head(Head,Module,Meta)) 273 ). 274update_state(_, _). 275 276update_directive(Directive, Module) :- 277 prolog:xref_update_syntax((:- Directive), Module), 278 !. 279update_directive(module(Module, Public), _) :- 280 atom(Module), 281 is_list(Public), 282 !, 283 '$set_source_module'(Module), 284 maplist(import_syntax(_,Module, _), Public). 285update_directive(M:op(P,T,N), SM) :- 286 atom(M), 287 ground(op(P,T,N)), 288 !, 289 update_directive(op(P,T,N), SM). 290update_directive(op(P,T,N), SM) :- 291 ground(op(P,T,N)), 292 !, 293 strip_module(SM:N, M, PN), 294 push_op(P,T,M:PN). 295update_directive(style_check(Style), _) :- 296 ground(Style), 297 style_check(Style), 298 !. 299update_directive(use_module(Spec), SM) :- 300 ground(Spec), 301 catch(module_decl(Spec, Path, Public), _, fail), 302 is_list(Public), 303 !, 304 maplist(import_syntax(Path, SM, _), Public). 305update_directive(use_module(Spec, Imports), SM) :- 306 ground(Spec), 307 is_list(Imports), 308 catch(module_decl(Spec, Path, Public), _, fail), 309 is_list(Public), 310 !, 311 maplist(import_syntax(Path, SM, Imports), Public). 312update_directive(pce_begin_class_definition(_,_,_,_), SM) :- 313 pce_expansion:push_compile_operators(SM), 314 !. 315update_directive(_, _).
322import_syntax(_, _, _, Var) :- 323 var(Var), 324 !. 325import_syntax(_, M, Imports, Op) :- 326 Op = op(_,_,_), 327 \+ \+ member(Op, Imports), 328 !, 329 update_directive(Op, M). 330import_syntax(Path, SM, Imports, Syntax/4) :- 331 \+ \+ member(Syntax/4, Imports), 332 load_quasi_quotation_syntax(SM:Path, Syntax), 333 !. 334import_syntax(_,_,_, _).
351load_quasi_quotation_syntax(SM:Path, Syntax) :- 352 atom(Path), atom(Syntax), 353 source_file_property(Path, module(M)), 354 functor(ST, Syntax, 4), 355 predicate_property(M:ST, quasi_quotation_syntax), 356 !, 357 use_module(SM:Path, [Syntax/4]). 358load_quasi_quotation_syntax(SM:Path, Syntax) :- 359 atom(Path), atom(Syntax), 360 prolog:quasi_quotation_syntax(Syntax, Spec), 361 absolute_file_name(Spec, Path2, 362 [ file_type(prolog), 363 file_errors(fail), 364 access(read) 365 ]), 366 Path == Path2, 367 !, 368 use_module(SM:Path, [Syntax/4]).
376module_decl(Spec, Source, Exports) :- 377 absolute_file_name(Spec, Path, 378 [ file_type(prolog), 379 file_errors(fail), 380 access(read) 381 ]), 382 module_decl_(Path, Source, Exports). 383 384module_decl_(Path, Source, Exports) :- 385 file_name_extension(_, qlf, Path), 386 !, 387 '$qlf_module'(Path, Info), 388 _{file:Source, exports:Exports} :< Info. 389module_decl_(Path, Path, Exports) :- 390 setup_call_cleanup( 391 prolog_open_source(Path, In), 392 read_module_decl(In, Exports), 393 prolog_close_source(In)). 394 395read_module_decl(In, Decl) :- 396 read(In, Term0), 397 read_module_decl(Term0, In, Decl). 398 399read_module_decl((:- module(_, DeclIn)), _In, Decl) => 400 Decl = DeclIn. 401read_module_decl((:- encoding(Enc)), In, Decl) => 402 set_stream(In, encoding(Enc)), 403 read(In, Term2), 404 read_module_decl(Term2, In, Decl). 405read_module_decl(_, _, _) => 406 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).450:- thread_local 451 last_syntax_error/2. % location, message 452 453read_source_term_at_location(Stream, Term, Options) :- 454 retractall(last_syntax_error(_,_)), 455 seek_to_start(Stream, Options), 456 stream_property(Stream, position(Here)), 457 '$current_source_module'(DefModule), 458 option(module(Module), Options, DefModule), 459 option(operators(Ops), Options, []), 460 alternate_syntax(Syntax, Module, Setup, Restore), 461 set_stream_position(Stream, Here), 462 debug(read, 'Trying with syntax ~w', [Syntax]), 463 push_operators(Module:Ops), 464 call(Setup), 465 Error = error(Formal,_), % do not catch timeout, etc. 466 setup_call_cleanup( 467 asserta(user:thread_message_hook(_,_,_), Ref), % silence messages 468 catch(qq_read_term(Stream, Term0, 469 [ module(Module) 470 | Options 471 ]), 472 Error, 473 true), 474 erase(Ref)), 475 call(Restore), 476 pop_operators, 477 ( var(Formal) 478 -> !, Term = Term0 479 ; assert_error(Error, Options), 480 fail 481 ). 482read_source_term_at_location(_, _, Options) :- 483 option(error(Error), Options), 484 !, 485 setof(CharNo:Msg, retract(last_syntax_error(CharNo, Msg)), Pairs), 486 last(Pairs, Error). 487 488assert_error(Error, Options) :- 489 option(error(_), Options), 490 !, 491 ( ( Error = error(syntax_error(Id), 492 stream(_S1, _Line1, _LinePos1, CharNo)) 493 ; Error = error(syntax_error(Id), 494 file(_S2, _Line2, _LinePos2, CharNo)) 495 ) 496 -> message_to_string(error(syntax_error(Id), _), Msg), 497 assertz(last_syntax_error(CharNo, Msg)) 498 ; debug(read, 'Error: ~q', [Error]), 499 throw(Error) 500 ). 501assert_error(_, _).
Calls the hook prolog:alternate_syntax/4 with the same signature to allow for user-defined extensions.
517alternate_syntax(prolog, _, true, true). 518alternate_syntax(Syntax, M, Setup, Restore) :- 519 prolog:alternate_syntax(Syntax, M, Setup, Restore).
526seek_to_start(Stream, Options) :- 527 option(line(Line), Options), 528 !, 529 seek(Stream, 0, bof, _), 530 seek_to_line(Stream, Line). 531seek_to_start(Stream, Options) :- 532 option(offset(Start), Options), 533 !, 534 seek(Stream, Start, bof, _). 535seek_to_start(_, _).
541seek_to_line(Fd, N) :- 542 N > 1, 543 !, 544 skip(Fd, 10), 545 NN is N - 1, 546 seek_to_line(Fd, NN). 547seek_to_line(_, _). 548 549 550 /******************************* 551 * QUASI QUOTATIONS * 552 *******************************/
560qq_read_term(Stream, Term, Options) :- 561 select(syntax_errors(ErrorMode), Options, Options1), 562 ErrorMode \== error, 563 !, 564 ( ErrorMode == dec10 565 -> repeat, 566 qq_read_syntax_ex(Stream, Term, Options1, Error), 567 ( var(Error) 568 -> ! 569 ; print_message(error, Error), 570 fail 571 ) 572 ; qq_read_syntax_ex(Stream, Term, Options1, Error), 573 ( ErrorMode == fail 574 -> print_message(error, Error), 575 fail 576 ; ErrorMode == quiet 577 -> fail 578 ; domain_error(syntax_errors, ErrorMode) 579 ) 580 ). 581qq_read_term(Stream, Term, Options) :- 582 qq_read_term_ex(Stream, Term, Options). 583 584qq_read_syntax_ex(Stream, Term, Options, Error) :- 585 catch(qq_read_term_ex(Stream, Term, Options), 586 error(syntax_error(Syntax), Context), 587 Error = error(Syntax, Context)). 588 589qq_read_term_ex(Stream, Term, Options) :- 590 stream_property(Stream, position(Here)), 591 catch(read_term(Stream, Term, Options), 592 error(syntax_error(unknown_quasi_quotation_syntax(Syntax, Module)), Context), 593 load_qq_and_retry(Here, Syntax, Module, Context, Stream, Term, Options)). 594 595load_qq_and_retry(Here, Syntax, Module, _, Stream, Term, Options) :- 596 set_stream_position(Stream, Here), 597 prolog:quasi_quotation_syntax(Syntax, Library), 598 !, 599 use_module(Module:Library, [Syntax/4]), 600 read_term(Stream, Term, Options). 601load_qq_and_retry(_Pos, Syntax, Module, Context, _Stream, _Term, _Options) :- 602 print_message(warning, quasi_quotation(undeclared, Syntax)), 603 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.
614prologquasi_quotation_syntax(html, library(http/html_write)). 615prologquasi_quotation_syntax(javascript, library(http/js_write)).
true (default false), do not report syntax errors and
other errors.632prolog_file_directives(File, Directives, Options) :- 633 option(canonical_source(Path), Options, _), 634 prolog_canonical_source(File, Path), 635 in_temporary_module( 636 TempModule, 637 true, 638 read_directives(TempModule, Path, Directives, Options)). 639 640read_directives(TempModule, Path, Directives, Options) :- 641 setup_call_cleanup( 642 read_directives_setup(TempModule, Path, In, State), 643 phrase(read_directives(In, Options, [true]), Directives), 644 read_directives_cleanup(In, State)). 645 646read_directives_setup(TempModule, Path, In, state(OldM, OldXref)) :- 647 prolog_open_source(Path, In), 648 '$set_source_module'(OldM, TempModule), 649 current_prolog_flag(xref, OldXref), 650 set_prolog_flag(xref, true). 651 652read_directives_cleanup(In, state(OldM, OldXref)) :- 653 '$set_source_module'(OldM), 654 set_prolog_flag(xref, OldXref), 655 prolog_close_source(In). 656 657read_directives(In, Options, State) --> 658 { E = error(_,_), 659 repeat, 660 catch(prolog_read_source_term(In, Term, Expanded, 661 [ process_comment(true), 662 syntax_errors(error) 663 ]), 664 E, report_syntax_error(E, Options)) 665 -> nonvar(Term), 666 Term = (:-_) 667 }, 668 !, 669 terms(Expanded, State, State1), 670 read_directives(In, Options, State1). 671read_directives(_, _, _) --> []. 672 673report_syntax_error(_, Options) :- 674 option(silent(true), Options), 675 !, 676 fail. 677report_syntax_error(E, _Options) :- 678 print_message(warning, E), 679 fail. 680 681terms(Var, State, State) --> { var(Var) }, !. 682terms([H|T], State0, State) --> 683 !, 684 terms(H, State0, State1), 685 terms(T, State1, State). 686terms((:-if(Cond)), State0, [True|State0]) --> 687 !, 688 { eval_cond(Cond, True) }. 689terms((:-elif(Cond)), [True0|State], [True|State]) --> 690 !, 691 { eval_cond(Cond, True1), 692 elif(True0, True1, True) 693 }. 694terms((:-else), [True0|State], [True|State]) --> 695 !, 696 { negate(True0, True) }. 697terms((:-endif), [_|State], State) --> !. 698terms(H, State, State) --> 699 ( {State = [true|_]} 700 -> [H] 701 ; [] 702 ). 703 704eval_cond(Cond, true) :- 705 catch(Cond, error(_,_), fail), 706 !. 707eval_cond(_, false). 708 709elif(true, _, else_false) :- !. 710elif(false, true, true) :- !. 711elif(True, _, True). 712 713negate(true, false). 714negate(false, true). 715negate(else_false, else_false). 716 717 /******************************* 718 * SOURCES * 719 *******************************/
process_source(Src) :-
prolog_open_source(Src, In),
call_cleanup(process(Src), prolog_close_source(In)).
736prolog_open_source(Src, Fd) :- 737 '$push_input_context'(source), 738 catch(( prolog:xref_open_source(Src, Fd) 739 -> Hooked = true 740 ; open(Src, read, Fd), 741 Hooked = false 742 ), E, 743 ( '$pop_input_context', 744 throw(E) 745 )), 746 skip_hashbang(Fd), 747 push_operators([]), 748 '$current_source_module'(SM), 749 '$save_lex_state'(LexState, []), 750 asserta(open_source(Fd, state(Hooked, Src, LexState, SM))). 751 752skip_hashbang(Fd) :- 753 catch(( peek_char(Fd, #) % Deal with #! script 754 -> skip(Fd, 10) 755 ; true 756 ), E, 757 ( close(Fd, [force(true)]), 758 '$pop_input_context', 759 throw(E) 760 )).
expand_term(end_of_file, _) to allow expansion
modules to clean-up.778prolog_close_source(In) :- 779 call_cleanup( 780 restore_source_context(In, Hooked, Src), 781 close_source(Hooked, Src, In)). 782 783close_source(true, Src, In) :- 784 catch(prolog:xref_close_source(Src, In), _, false), 785 !, 786 '$pop_input_context'. 787close_source(_, _Src, In) :- 788 close(In, [force(true)]), 789 '$pop_input_context'. 790 791restore_source_context(In, Hooked, Src) :- 792 ( at_end_of_stream(In) 793 -> true 794 ; ignore(catch(expand(end_of_file, _, In, _), _, true)) 795 ), 796 pop_operators, 797 retractall(mode(In, _)), 798 ( retract(open_source(In, state(Hooked, Src, LexState, SM))) 799 -> '$restore_lex_state'(LexState), 800 '$set_source_module'(SM) 801 ; assertion(fail) 802 ).
force(true) is used.817prolog_canonical_source(Source, Src) :- 818 var(Source), 819 !, 820 Src = Source. 821prolog_canonical_source(User, user) :- 822 User == user, 823 !. 824prolog_canonical_source(Src, Id) :- % Call hook 825 prolog:xref_source_identifier(Src, Id), 826 !. 827prolog_canonical_source(Source, Src) :- 828 source_file(Source), 829 !, 830 Src = Source. 831prolog_canonical_source(Source, Src) :- 832 absolute_file_name(Source, Src, 833 [ file_type(prolog), 834 access(read), 835 file_errors(fail) 836 ]), 837 !.
845file_name_on_path(Path, ShortId) :-
846 ( file_alias_path(Alias, Dir),
847 atom_concat(Dir, Local, Path)
848 -> ( Alias == '.'
849 -> ShortId = Local
850 ; file_name_extension(Base, pl, Local)
851 -> ShortId =.. [Alias, Base]
852 ; ShortId =.. [Alias, Local]
853 )
854 ; ShortId = Path
855 ).863:- dynamic 864 alias_cache/2. 865 866file_alias_path(Alias, Dir) :- 867 ( alias_cache(_, _) 868 -> true 869 ; build_alias_cache 870 ), 871 ( nonvar(Dir) 872 -> ensure_slash(Dir, DirSlash), 873 alias_cache(Alias, DirSlash) 874 ; alias_cache(Alias, Dir) 875 ). 876 877build_alias_cache :- 878 findall(t(DirLen, AliasLen, Alias, Dir), 879 search_path(Alias, Dir, AliasLen, DirLen), Ts), 880 sort(0, >, Ts, List), 881 forall(member(t(_, _, Alias, Dir), List), 882 assert(alias_cache(Alias, Dir))). 883 884search_path('.', Here, 999, DirLen) :- 885 working_directory(Here0, Here0), 886 ensure_slash(Here0, Here), 887 atom_length(Here, DirLen). 888search_path(Alias, Dir, AliasLen, DirLen) :- 889 user:file_search_path(Alias, _), 890 Alias \== autoload, % TBD: Multifile predicate? 891 Alias \== noautoload, 892 Spec =.. [Alias,'.'], 893 atom_length(Alias, AliasLen0), 894 AliasLen is 1000 - AliasLen0, % must do reverse sort 895 absolute_file_name(Spec, Dir0, 896 [ file_type(directory), 897 access(read), 898 solutions(all), 899 file_errors(fail) 900 ]), 901 ensure_slash(Dir0, Dir), 902 atom_length(Dir, DirLen). 903 904ensure_slash(Dir, Dir) :- 905 sub_atom(Dir, _, _, 0, /), 906 !. 907ensure_slash(Dir0, Dir) :- 908 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.
929path_segments_atom(Segments, Atom) :- 930 var(Atom), 931 !, 932 ( atomic(Segments) 933 -> Atom = Segments 934 ; segments_to_list(Segments, List, []) 935 -> atomic_list_concat(List, /, Atom) 936 ; throw(error(type_error(file_path, Segments), _)) 937 ). 938path_segments_atom(Segments, Atom) :- 939 atomic_list_concat(List, /, Atom), 940 parts_to_path(List, Segments). 941 942segments_to_list(Var, _, _) :- 943 var(Var), !, fail. 944segments_to_list(A/B, H, T) :- 945 segments_to_list(A, H, T0), 946 segments_to_list(B, T0, T). 947segments_to_list(A, [A|T], T) :- 948 atomic(A). 949 950parts_to_path([One], One) :- !. 951parts_to_path(List, More/T) :- 952 ( append(H, [T], List) 953 -> parts_to_path(H, More) 954 ).
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.
969directory_source_files(Dir, SrcFiles, Options) :- 970 option(if(loaded), Options, loaded), 971 !, 972 absolute_file_name(Dir, AbsDir, [file_type(directory), access(read)]), 973 ( option(recursive(true), Options) 974 -> ensure_slash(AbsDir, Prefix), 975 findall(F, ( source_file(F), 976 sub_atom(F, 0, _, _, Prefix) 977 ), 978 SrcFiles) 979 ; findall(F, ( source_file(F), 980 file_directory_name(F, AbsDir) 981 ), 982 SrcFiles) 983 ). 984directory_source_files(Dir, SrcFiles, Options) :- 985 absolute_file_name(Dir, AbsDir, [file_type(directory), access(read)]), 986 directory_files(AbsDir, Files), 987 phrase(src_files(Files, AbsDir, Options), SrcFiles). 988 989src_files([], _, _) --> 990 []. 991src_files([H|T], Dir, Options) --> 992 { file_name_extension(_, Ext, H), 993 user:prolog_file_type(Ext, prolog), 994 \+ user:prolog_file_type(Ext, qlf), 995 dir_file_path(Dir, H, File0), 996 absolute_file_name(File0, File, 997 [ file_errors(fail) 998 | Options 999 ]) 1000 }, 1001 !, 1002 [File], 1003 src_files(T, Dir, Options). 1004src_files([H|T], Dir, Options) --> 1005 { \+ special(H), 1006 option(recursive(true), Options), 1007 dir_file_path(Dir, H, SubDir), 1008 exists_directory(SubDir), 1009 !, 1010 catch(directory_files(SubDir, Files), _, fail) 1011 }, 1012 !, 1013 src_files(Files, SubDir, Options), 1014 src_files(T, Dir, Options). 1015src_files([_|T], Dir, Options) --> 1016 src_files(T, Dir, Options). 1017 1018special(.). 1019special(..). 1020 1021% avoid dependency on library(filesex), which also pulls a foreign 1022% dependency. 1023dir_file_path(Dir, File, Path) :- 1024 ( sub_atom(Dir, _, _, 0, /) 1025 -> atom_concat(Dir, File, Path) 1026 ; atom_concat(Dir, /, TheDir), 1027 atom_concat(TheDir, File, Path) 1028 ).
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)
1061valid_term_position(Term, TermPos) :- 1062 valid_term_position(0, 0x7fffffffffffffff, Term, TermPos). 1063 1064valid_term_position(OuterFrom, OuterTo, _Term, TermPos), 1065 var(TermPos), 1066 OuterFrom =< OuterTo => true. 1067valid_term_position(OuterFrom, OuterTo, Var, From-To), 1068 var(Var), 1069 valid_term_position_from_to(OuterFrom, OuterTo, From, To) => true. 1070valid_term_position(OuterFrom, OuterTo, Atom, From-To), 1071 atom(Atom), 1072 valid_term_position_from_to(OuterFrom, OuterTo, From, To) => true. 1073valid_term_position(OuterFrom, OuterTo, Number, From-To), 1074 number(Number), 1075 valid_term_position_from_to(OuterFrom, OuterTo, From, To) => true. 1076valid_term_position(OuterFrom, OuterTo, [], From-To), 1077 valid_term_position_from_to(OuterFrom, OuterTo, From, To) => true. 1078valid_term_position(OuterFrom, OuterTo, String, string_position(From,To)), 1079 ( string(String) 1080 -> true 1081 ; is_of_type(codes, String) 1082 -> true 1083 ; is_of_type(chars, String) 1084 -> true 1085 ; atom(String) 1086 ), 1087 valid_term_position_from_to(OuterFrom, OuterTo, From, To) => true. 1088valid_term_position(OuterFrom, OuterTo, {Arg}, 1089 brace_term_position(From,To,ArgPos)), 1090 valid_term_position_from_to(OuterFrom, OuterTo, From, To) => 1091 valid_term_position(From, To, Arg, ArgPos). 1092valid_term_position(OuterFrom, OuterTo, [Hd|Tl], 1093 list_position(From,To,ElemsPos,none)), 1094 valid_term_position_from_to(OuterFrom, OuterTo, From, To) => 1095 term_position_list_tail([Hd|Tl], _HdPart, []), 1096 maplist(valid_term_position, [Hd|Tl], ElemsPos). 1097valid_term_position(OuterFrom, OuterTo, [Hd|Tl], 1098 list_position(From, To, ElemsPos, TailPos)), 1099 valid_term_position_from_to(OuterFrom, OuterTo, From, To) => 1100 term_position_list_tail([Hd|Tl], HdPart, Tail), 1101 maplist(valid_term_position(From,To), HdPart, ElemsPos), 1102 valid_term_position(Tail, TailPos). 1103valid_term_position(OuterFrom, OuterTo, Term, 1104 term_position(From,To, FFrom,FTo,SubPos)), 1105 valid_term_position_from_to(OuterFrom, OuterTo, From, To) => 1106 compound_name_arguments(Term, Name, Arguments), 1107 valid_term_position(Name, FFrom-FTo), 1108 maplist(valid_term_position(From,To), Arguments, SubPos). 1109valid_term_position(OuterFrom, OuterTo, Dict, 1110 dict_position(From,To,TagFrom,TagTo,KeyValuePosList)), 1111 valid_term_position_from_to(OuterFrom, OuterTo, From, To) => 1112 dict_pairs(Dict, Tag, Pairs), 1113 valid_term_position(Tag, TagFrom-TagTo), 1114 foldl(valid_term_position_dict(From,To), Pairs, KeyValuePosList, []). 1115% key_value_position(From, To, SepFrom, SepTo, Key, KeyPos, ValuePos) 1116% is handled in valid_term_position_dict. 1117valid_term_position(OuterFrom, OuterTo, Term, 1118 parentheses_term_position(From,To,ContentPos)), 1119 valid_term_position_from_to(OuterFrom, OuterTo, From, To) => 1120 valid_term_position(From, To, Term, ContentPos). 1121valid_term_position(OuterFrom, OuterTo, _Term, 1122 quasi_quotation_position(From,To, 1123 SyntaxTerm,SyntaxPos,_ContentPos)), 1124 valid_term_position_from_to(OuterFrom, OuterTo, From, To) => 1125 valid_term_position(From, To, SyntaxTerm, SyntaxPos). 1126 1127valid_term_position_from_to(OuterFrom, OuterTo, From, To) :- 1128 integer(OuterFrom), 1129 integer(OuterTo), 1130 integer(From), 1131 integer(To), 1132 OuterFrom =< OuterTo, 1133 From =< To, 1134 OuterFrom =< From, 1135 To =< OuterTo. 1136 1137:- det(valid_term_position_dict/5). 1138valid_term_position_dict(OuterFrom, OuterTo, Key-Value, 1139 KeyValuePosList0, KeyValuePosList1) :- 1140 selectchk(key_value_position(From,To,SepFrom,SepTo,Key,KeyPos,ValuePos), 1141 KeyValuePosList0, KeyValuePosList1), 1142 valid_term_position_from_to(OuterFrom, OuterTo, From, To), 1143 valid_term_position_from_to(OuterFrom, OuterTo, SepFrom, SepTo), 1144 SepFrom >= OuterFrom, 1145 valid_term_position(From, SepFrom, Key, KeyPos), 1146 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].
1163:- det(term_position_list_tail/3). 1164term_position_list_tail([X|Xs], HdPart, Tail) => 1165 HdPart = [X|HdPart2], 1166 term_position_list_tail(Xs, HdPart2, Tail). 1167term_position_list_tail(Tail0, HdPart, Tail) => 1168 HdPart = [], 1169 Tail0 = Tail. 1170 1171 1172 /******************************* 1173 * MESSAGES * 1174 *******************************/ 1175 1176:- multifile 1177 prolog:message//1. 1178 1179prologmessage(quasi_quotation(undeclared, Syntax)) --> 1180 [ 'Undeclared quasi quotation syntax: ~w'-[Syntax], nl, 1181 'Autoloading can be defined using prolog:quasi_quotation_syntax/2' 1182 ]
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*/