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), 59 [select_option/4, option/3, option/2, merge_options/3]). 60:- autoload(library(modules),[in_temporary_module/3]).
86:- thread_local 87 open_source/2, % Stream, State 88 mode/2, % Stream, Data 89 syntax_option/2. % Stream, ReadOption 90 91:- multifile 92 requires_library/2, 93 prolog:xref_source_identifier/2, % +Source, -Id 94 prolog:xref_source_time/2, % +Source, -Modified 95 prolog:xref_open_source/2, % +SourceId, -Stream 96 prolog:xref_close_source/2, % +SourceId, -Stream 97 prolog:alternate_syntax/4, % Syntax, +Module, -Setup, -Restore 98 prolog:xref_update_syntax/2, % +Directive, +Module 99 prolog:quasi_quotation_syntax/2. % Syntax, Library 100 101 102:- predicate_options(prolog_read_source_term/4, 4, 103 [ pass_to(system:read_clause/3, 3) 104 ]). 105:- predicate_options(read_source_term_at_location/3, 3, 106 [ line(integer), 107 offset(integer), 108 module(atom), 109 operators(list), 110 error(-any), 111 pass_to(system:read_term/3, 3) 112 ]). 113:- predicate_options(directory_source_files/3, 3, 114 [ recursive(boolean), 115 if(oneof([true,loaded])), 116 pass_to(system:absolute_file_name/3,3) 117 ]). 118 119 120 /******************************* 121 * READING * 122 *******************************/
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).
138prolog_read_source_term(In, Term, Expanded, Options0) :- 139 add_syntax_options(In, Options0, Options), 140 read_source_term(In, Term, Expanded, Options). 141 142read_source_term(In, Term, Expanded, Options) :- 143 maplist(read_clause_option, Options), 144 !, 145 select_option(subterm_positions(TermPos), Options, 146 RestOptions, TermPos), 147 read_clause(In, Term, 148 [ subterm_positions(TermPos) 149 | RestOptions 150 ]), 151 expand(Term, TermPos, In, Expanded), 152 '$current_source_module'(M), 153 update_state(Term, Expanded, M, In). 154read_source_term(In, Term, Expanded, Options) :- 155 '$current_source_module'(M), 156 select_option(syntax_errors(SE), Options, RestOptions0, dec10), 157 select_option(subterm_positions(TermPos), RestOptions0, 158 RestOptions, TermPos), 159 ( style_check(?(singleton)) 160 -> FinalOptions = [ singletons(warning) | RestOptions ] 161 ; FinalOptions = RestOptions 162 ), 163 read_term(In, Term, 164 [ module(M), 165 syntax_errors(SE), 166 subterm_positions(TermPos) 167 | FinalOptions 168 ]), 169 expand(Term, TermPos, In, Expanded), 170 update_state(Term, Expanded, M, In). 171 172read_clause_option(syntax_errors(_)). 173read_clause_option(term_position(_)). 174read_clause_option(process_comment(_)). 175read_clause_option(comments(_)). 176read_clause_option(var_prefix(_)). 177read_clause_option(variable_names(_)).
user.185add_syntax_options(In, Options0, Options) :- 186 findall(Opt, syntax_option(In, Opt), Opts), 187 merge_options(Options0, Opts, Options). 188 189:- public 190 expand/3. % Used by Prolog colour 191 192expand(Term, In, Exp) :- 193 expand(Term, _, In, Exp). 194 195expand(Var, _, _, Var) :- 196 var(Var), 197 !. 198expand(Term, _, _, Term) :- 199 no_expand(Term), 200 !. 201expand(Term, _, _, _) :- 202 requires_library(Term, Lib), 203 ensure_loaded(user:Lib), 204 fail. 205expand(Term, _, In, Term) :- 206 chr_expandable(Term, In), 207 !. 208expand(Term, Pos, _, Expanded) :- 209 expand_term(Term, Pos, Expanded, _). 210 211no_expand((:- if(_))). 212no_expand((:- elif(_))). 213no_expand((:- else)). 214no_expand((:- endif)). 215no_expand((:- require(_))). 216 217chr_expandable((:- chr_constraint(_)), In) :- 218 add_mode(In, chr). 219chr_expandable((handler(_)), In) :- 220 mode(In, chr). 221chr_expandable((rules(_)), In) :- 222 mode(In, chr). 223chr_expandable(<=>(_, _), In) :- 224 mode(In, chr). 225chr_expandable(@(_, _), In) :- 226 mode(In, chr). 227chr_expandable(==>(_, _), In) :- 228 mode(In, chr). 229chr_expandable(pragma(_, _), In) :- 230 mode(In, chr). 231chr_expandable(option(_, _), In) :- 232 mode(In, chr). 233 234add_mode(Stream, Mode) :- 235 mode(Stream, Mode), 236 !. 237add_mode(Stream, Mode) :- 238 asserta(mode(Stream, Mode)).
244requires_library((:- emacs_begin_mode(_,_,_,_,_)), library(emacs_extend)). 245requires_library((:- draw_begin_shape(_,_,_,_)), library(pcedraw)). 246requires_library((:- use_module(library(pce))), library(pce)). 247requires_library((:- pce_begin_class(_,_)), library(pce)). 248requires_library((:- pce_begin_class(_,_,_)), library(pce)). 249requires_library((:- html_meta(_)), library(http/html_decl)).
255:- multifile 256 pce_expansion:push_compile_operators/1, 257 pce_expansion:pop_compile_operators/0. 258 259update_state((:- pce_end_class), _, _, _) => 260 ignore(pce_expansion:pop_compile_operators). 261update_state((:- pce_extend_class(_)), _, SM, _) => 262 pce_expansion:push_compile_operators(SM). 263update_state(Raw, _, Module, _), 264 catch(prolog:xref_update_syntax(Raw, Module), 265 error(_,_), 266 fail) => 267 true. 268update_state(_Raw, Expanded, M, In) => 269 update_state(Expanded, M, In). 270 271update_state(Var, _, _) :- 272 var(Var), 273 !. 274update_state([], _, _) :- 275 !. 276update_state([H|T], M, In) :- 277 !, 278 update_state(H, M, In), 279 update_state(T, M, In). 280update_state((:- Directive), M, In) :- 281 nonvar(Directive), 282 !, 283 catch(update_directive(Directive, M, In), _, true). 284update_state((?- Directive), M, In) :- 285 !, 286 update_state((:- Directive), M, In). 287update_state(MetaDecl, _M, _) :- 288 MetaDecl = html_write:html_meta_head(_Head,_Module,_Meta), 289 ( clause(MetaDecl, true) 290 -> true 291 ; assertz(MetaDecl) 292 ). 293update_state(_, _, _).
297update_directive(Directive, Module, _) :- 298 prolog:xref_update_syntax((:- Directive), Module), 299 !. 300update_directive(encoding(Enc), _, In) :- 301 !, 302 set_stream(In, encoding(Enc)). 303update_directive(module(Module, Public), _, _) :- 304 atom(Module), 305 is_list(Public), 306 !, 307 '$set_source_module'(Module), 308 maplist(import_syntax(_,Module, _), Public). 309update_directive(M:op(P,T,N), SM, In) :- 310 atom(M), 311 ground(op(P,T,N)), 312 !, 313 update_directive(op(P,T,N), SM, In). 314update_directive(op(P,T,N), SM, _) :- 315 ground(op(P,T,N)), 316 !, 317 strip_module(SM:N, M, PN), 318 push_op(P,T,M:PN). 319update_directive(set_prolog_flag(var_prefix, Prefix), _, In) :- 320 atom(Prefix), 321 !, 322 retractall(syntax_option(In, var_prefix(_))), 323 assertz(syntax_option(In, var_prefix(Prefix))). 324update_directive(style_check(Style), _, _) :- 325 ground(Style), 326 style_check(Style), 327 !. 328update_directive(use_module(Spec), SM, _) :- 329 ground(Spec), 330 catch(module_decl(Spec, Path, Public), _, fail), 331 is_list(Public), 332 !, 333 maplist(import_syntax(Path, SM, _), Public). 334update_directive(use_module(Spec, Imports), SM, _) :- 335 ground(Spec), 336 is_list(Imports), 337 catch(module_decl(Spec, Path, Public), _, fail), 338 is_list(Public), 339 !, 340 maplist(import_syntax(Path, SM, Imports), Public). 341update_directive(pce_begin_class_definition(_,_,_,_), SM, _) :- 342 pce_expansion:push_compile_operators(SM), 343 !. 344update_directive(_, _, _).
351import_syntax(_, _, _, Var) :- 352 var(Var), 353 !. 354import_syntax(_, M, Imports, Op) :- 355 Op = op(_,_,_), 356 \+ \+ member(Op, Imports), 357 !, 358 update_directive(Op, M, _). 359import_syntax(Path, SM, Imports, Syntax/4) :- 360 \+ \+ member(Syntax/4, Imports), 361 load_quasi_quotation_syntax(SM:Path, Syntax), 362 !. 363import_syntax(_,_,_, _).
380load_quasi_quotation_syntax(SM:Path, Syntax) :- 381 atom(Path), atom(Syntax), 382 source_file_property(Path, module(M)), 383 functor(ST, Syntax, 4), 384 predicate_property(M:ST, quasi_quotation_syntax), 385 !, 386 use_module(SM:Path, [Syntax/4]). 387load_quasi_quotation_syntax(SM:Path, Syntax) :- 388 atom(Path), atom(Syntax), 389 prolog:quasi_quotation_syntax(Syntax, Spec), 390 absolute_file_name(Spec, Path2, 391 [ file_type(prolog), 392 file_errors(fail), 393 access(read) 394 ]), 395 Path == Path2, 396 !, 397 use_module(SM:Path, [Syntax/4]).
405module_decl(Spec, Source, Exports) :- 406 absolute_file_name(Spec, Path, 407 [ file_type(prolog), 408 file_errors(fail), 409 access(read) 410 ]), 411 module_decl_(Path, Source, Exports). 412 413module_decl_(Path, Source, Exports) :- 414 file_name_extension(_, qlf, Path), 415 !, 416 '$qlf_module'(Path, Info), 417 _{file:Source, exports:Exports} :< Info. 418module_decl_(Path, Path, Exports) :- 419 setup_call_cleanup( 420 prolog_open_source(Path, In), 421 read_module_decl(In, Exports), 422 prolog_close_source(In)). 423 424read_module_decl(In, Decl) :- 425 read(In, Term0), 426 read_module_decl(Term0, In, Decl). 427 428read_module_decl((:- module(_, DeclIn)), _In, Decl) => 429 Decl = DeclIn. 430read_module_decl((:- encoding(Enc)), In, Decl) => 431 set_stream(In, encoding(Enc)), 432 read(In, Term2), 433 read_module_decl(Term2, In, Decl). 434read_module_decl(_, _, _) => 435 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).479:- thread_local 480 last_syntax_error/2. % location, message 481 482read_source_term_at_location(Stream, Term, Options) :- 483 retractall(last_syntax_error(_,_)), 484 seek_to_start(Stream, Options), 485 stream_property(Stream, position(Here)), 486 '$current_source_module'(DefModule), 487 option(module(Module), Options, DefModule), 488 option(operators(Ops), Options, []), 489 alternate_syntax(Syntax, Module, Setup, Restore), 490 set_stream_position(Stream, Here), 491 debug(read, 'Trying with syntax ~w', [Syntax]), 492 push_operators(Module:Ops), 493 call(Setup), 494 Error = error(Formal,_), % do not catch timeout, etc. 495 setup_call_cleanup( 496 asserta(user:thread_message_hook(_,_,_), Ref), % silence messages 497 catch(qq_read_term(Stream, Term0, 498 [ module(Module) 499 | Options 500 ]), 501 Error, 502 true), 503 erase(Ref)), 504 call(Restore), 505 pop_operators, 506 ( var(Formal) 507 -> !, Term = Term0 508 ; assert_error(Error, Options), 509 fail 510 ). 511read_source_term_at_location(_, _, Options) :- 512 option(error(Error), Options), 513 !, 514 setof(CharNo:Msg, retract(last_syntax_error(CharNo, Msg)), Pairs), 515 last(Pairs, Error). 516 517assert_error(Error, Options) :- 518 option(error(_), Options), 519 !, 520 ( ( Error = error(syntax_error(Id), 521 stream(_S1, _Line1, _LinePos1, CharNo)) 522 ; Error = error(syntax_error(Id), 523 file(_S2, _Line2, _LinePos2, CharNo)) 524 ) 525 -> message_to_string(error(syntax_error(Id), _), Msg), 526 assertz(last_syntax_error(CharNo, Msg)) 527 ; debug(read, 'Error: ~q', [Error]), 528 throw(Error) 529 ). 530assert_error(_, _).
Calls the hook alternate_syntax/4 with the same signature to allow for user-defined extensions.
546alternate_syntax(prolog, _, true, true). 547alternate_syntax(Syntax, M, Setup, Restore) :- 548 prolog:alternate_syntax(Syntax, M, Setup, Restore).
555seek_to_start(Stream, Options) :- 556 option(line(Line), Options), 557 !, 558 seek(Stream, 0, bof, _), 559 seek_to_line(Stream, Line). 560seek_to_start(Stream, Options) :- 561 option(offset(Start), Options), 562 !, 563 seek(Stream, Start, bof, _). 564seek_to_start(_, _).
570seek_to_line(Fd, N) :- 571 N > 1, 572 !, 573 skip(Fd, 10), 574 NN is N - 1, 575 seek_to_line(Fd, NN). 576seek_to_line(_, _). 577 578 579 /******************************* 580 * QUASI QUOTATIONS * 581 *******************************/
589qq_read_term(Stream, Term, Options) :- 590 select(syntax_errors(ErrorMode), Options, Options1), 591 ErrorMode \== error, 592 !, 593 ( ErrorMode == dec10 594 -> repeat, 595 qq_read_syntax_ex(Stream, Term, Options1, Error), 596 ( var(Error) 597 -> ! 598 ; print_message(error, Error), 599 fail 600 ) 601 ; qq_read_syntax_ex(Stream, Term, Options1, Error), 602 ( ErrorMode == fail 603 -> print_message(error, Error), 604 fail 605 ; ErrorMode == quiet 606 -> fail 607 ; domain_error(syntax_errors, ErrorMode) 608 ) 609 ). 610qq_read_term(Stream, Term, Options) :- 611 qq_read_term_ex(Stream, Term, Options). 612 613qq_read_syntax_ex(Stream, Term, Options, Error) :- 614 catch(qq_read_term_ex(Stream, Term, Options), 615 error(syntax_error(Syntax), Context), 616 Error = error(Syntax, Context)). 617 618qq_read_term_ex(Stream, Term, Options) :- 619 stream_property(Stream, position(Here)), 620 catch(read_term(Stream, Term, Options), 621 error(syntax_error(unknown_quasi_quotation_syntax(Syntax, Module)), Context), 622 load_qq_and_retry(Here, Syntax, Module, Context, Stream, Term, Options)). 623 624load_qq_and_retry(Here, Syntax, Module, _, Stream, Term, Options) :- 625 set_stream_position(Stream, Here), 626 prolog:quasi_quotation_syntax(Syntax, Library), 627 !, 628 use_module(Module:Library, [Syntax/4]), 629 read_term(Stream, Term, Options). 630load_qq_and_retry(_Pos, Syntax, Module, Context, _Stream, _Term, _Options) :- 631 print_message(warning, quasi_quotation(undeclared, Syntax)), 632 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.
643prologquasi_quotation_syntax(html, library(http/html_write)). 644prologquasi_quotation_syntax(javascript, library(http/js_write)).
true (default false), do not report syntax errors and
other errors.663prolog_file_directives(File, Directives, Options) :- 664 option(canonical_source(Path), Options, _), 665 prolog_canonical_source(File, Path), 666 in_temporary_module( 667 TempModule, 668 true, 669 read_directives(TempModule, Path, Directives, Options)). 670 671read_directives(TempModule, Path, Directives, Options) :- 672 setup_call_cleanup( 673 read_directives_setup(TempModule, Path, In, State), 674 phrase(read_directives(In, Options, [true]), Directives), 675 read_directives_cleanup(In, State)). 676 677read_directives_setup(TempModule, Path, In, OldM) :- 678 prolog_open_source(Path, In), 679 '$set_source_module'(OldM, TempModule), 680 push_prolog_flag(xref, true). 681 682read_directives_cleanup(In, OldM) :- 683 '$set_source_module'(OldM), 684 pop_prolog_flag(xref), 685 prolog_close_source(In). 686 687read_directives(In, Options, State) --> 688 { E = error(_,_), 689 repeat, 690 catch(prolog_read_source_term(In, Term, Expanded, 691 [ process_comment(true), 692 syntax_errors(error) 693 ]), 694 E, report_syntax_error(E, Options)) 695 -> nonvar(Term), 696 Term = (:-_) 697 }, 698 !, 699 terms(Expanded, State, State1), 700 read_directives(In, Options, State1). 701read_directives(_, _, _) --> []. 702 703report_syntax_error(_, Options) :- 704 option(silent(true), Options), 705 !, 706 fail. 707report_syntax_error(E, _Options) :- 708 print_message(warning, E), 709 fail. 710 711terms(Var, State, State) --> { var(Var) }, !. 712terms([H|T], State0, State) --> 713 !, 714 terms(H, State0, State1), 715 terms(T, State1, State). 716terms((:-if(Cond)), State0, [True|State0]) --> 717 !, 718 { eval_cond(Cond, True) }. 719terms((:-elif(Cond)), [True0|State], [True|State]) --> 720 !, 721 { eval_cond(Cond, True1), 722 elif(True0, True1, True) 723 }. 724terms((:-else), [True0|State], [True|State]) --> 725 !, 726 { negate(True0, True) }. 727terms((:-endif), [_|State], State) --> !. 728terms(H, State, State) --> 729 ( {State = [true|_]} 730 -> [H] 731 ; [] 732 ). 733 734eval_cond(Cond, true) :- 735 catch(Cond, error(_,_), fail), 736 !. 737eval_cond(_, false). 738 739elif(true, _, else_false) :- !. 740elif(false, true, true) :- !. 741elif(True, _, True). 742 743negate(true, false). 744negate(false, true). 745negate(else_false, else_false). 746 747 /******************************* 748 * SOURCES * 749 *******************************/
process_source(Src) :-
prolog_open_source(Src, In),
call_cleanup(process(Src), prolog_close_source(In)).
771prolog_open_source(Src, Fd) :- 772 '$push_input_context'(source), 773 catch(do_open_source(Src, Fd, Hooked), 774 E, 775 ( '$pop_input_context', 776 throw(E) 777 )), 778 skip_hashbang(Fd), 779 push_operators([]), 780 '$current_source_module'(SM), 781 '$save_lex_state'(LexState, []), 782 asserta(open_source(Fd, state(Hooked, Src, LexState, SM))). 783 784do_open_source(Src, Stream, stream) :- 785 is_stream(Src), 786 !, 787 Stream = Src. 788do_open_source(Src, Stream, hooked) :- 789 prolog:xref_open_source(Src, Stream), 790 !. 791do_open_source(Src, Stream, opened) :- 792 open(Src, read, Stream). 793 794 795skip_hashbang(Fd) :- 796 catch(( peek_char(Fd, #) % Deal with #! script 797 -> skip(Fd, 10) 798 ; true 799 ), E, 800 ( close(Fd, [force(true)]), 801 '$pop_input_context', 802 throw(E) 803 )).
expand_term(end_of_file, _) to allow expansion
modules to clean-up.821prolog_close_source(In) :- 822 call_cleanup( 823 restore_source_context(In, Hooked, Src), 824 close_source(Hooked, Src, In)). 825 826close_source(stream, _Src, _Stream) :- 827 !, 828 '$pop_input_context'. 829close_source(hooked, Src, In) :- 830 catch(prolog:xref_close_source(Src, In), _, false), 831 !, 832 '$pop_input_context'. 833close_source(_, _Src, In) :- % If hook fails we must do normal close 834 close(In, [force(true)]), 835 '$pop_input_context'. 836 837restore_source_context(In, Hooked, Src) :- 838 ( at_end_of_stream(In) 839 -> true 840 ; ignore(catch(expand(end_of_file, _, In, _), _, true)) 841 ), 842 pop_operators, 843 retractall(mode(In, _)), 844 retractall(syntax_option(In, _)), 845 ( retract(open_source(In, state(Hooked, Src, LexState, SM))) 846 -> '$restore_lex_state'(LexState), 847 '$set_source_module'(SM) 848 ; assertion(fail) 849 ).
force(true) is used.864prolog_canonical_source(Source, Src) :- 865 var(Source), 866 !, 867 Src = Source. 868prolog_canonical_source(User, user) :- 869 User == user, 870 !. 871prolog_canonical_source(Stream, Src) :- 872 is_stream(Stream), 873 !, 874 Src = Stream. 875prolog_canonical_source(Src, Id) :- % Call hook 876 prolog:xref_source_identifier(Src, Id), 877 !. 878prolog_canonical_source(Source, Src) :- 879 source_file(Source), 880 !, 881 Src = Source. 882prolog_canonical_source(Source, Src) :- 883 absolute_file_name(Source, Src, 884 [ file_type(prolog), 885 access(read), 886 file_errors(fail) 887 ]), 888 !.
896file_name_on_path(Path, ShortId) :-
897 ( file_alias_path(Alias, Dir),
898 atom_concat(Dir, Local, Path)
899 -> ( Alias == '.'
900 -> ShortId = Local
901 ; file_name_extension(Base, pl, Local)
902 -> ShortId =.. [Alias, Base]
903 ; ShortId =.. [Alias, Local]
904 )
905 ; ShortId = Path
906 ).914:- dynamic 915 alias_cache/2. 916 917file_alias_path(Alias, Dir) :- 918 ( alias_cache(_, _) 919 -> true 920 ; build_alias_cache 921 ), 922 ( nonvar(Dir) 923 -> ensure_slash(Dir, DirSlash), 924 alias_cache(Alias, DirSlash) 925 ; alias_cache(Alias, Dir) 926 ). 927 928build_alias_cache :- 929 findall(t(DirLen, AliasLen, Alias, Dir), 930 search_path(Alias, Dir, AliasLen, DirLen), Ts), 931 sort(0, >, Ts, List), 932 forall(member(t(_, _, Alias, Dir), List), 933 assert(alias_cache(Alias, Dir))). 934 935search_path('.', Here, 999, DirLen) :- 936 working_directory(Here0, Here0), 937 ensure_slash(Here0, Here), 938 atom_length(Here, DirLen). 939search_path(Alias, Dir, AliasLen, DirLen) :- 940 user:file_search_path(Alias, _), 941 Alias \== autoload, % TBD: Multifile predicate? 942 Alias \== noautoload, 943 Spec =.. [Alias,'.'], 944 atom_length(Alias, AliasLen0), 945 AliasLen is 1000 - AliasLen0, % must do reverse sort 946 absolute_file_name(Spec, Dir0, 947 [ file_type(directory), 948 access(read), 949 solutions(all), 950 file_errors(fail) 951 ]), 952 ensure_slash(Dir0, Dir), 953 atom_length(Dir, DirLen). 954 955ensure_slash(Dir, Dir) :- 956 sub_atom(Dir, _, _, 0, /), 957 !. 958ensure_slash(Dir0, Dir) :- 959 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.
980path_segments_atom(Segments, Atom) :- 981 var(Atom), 982 !, 983 ( atomic(Segments) 984 -> Atom = Segments 985 ; segments_to_list(Segments, List, []) 986 -> atomic_list_concat(List, /, Atom) 987 ; throw(error(type_error(file_path, Segments), _)) 988 ). 989path_segments_atom(Segments, Atom) :- 990 atomic_list_concat(List, /, Atom), 991 parts_to_path(List, Segments). 992 993segments_to_list(Var, _, _) :- 994 var(Var), !, fail. 995segments_to_list(A/B, H, T) :- 996 segments_to_list(A, H, T0), 997 segments_to_list(B, T0, T). 998segments_to_list(A, [A|T], T) :- 999 atomic(A). 1000 1001parts_to_path([One], One) :- !. 1002parts_to_path(List, More/T) :- 1003 ( append(H, [T], List) 1004 -> parts_to_path(H, More) 1005 ).
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.
1020directory_source_files(Dir, SrcFiles, Options) :- 1021 option(if(loaded), Options, loaded), 1022 !, 1023 absolute_file_name(Dir, AbsDir, [file_type(directory), access(read)]), 1024 ( option(recursive(true), Options) 1025 -> ensure_slash(AbsDir, Prefix), 1026 findall(F, ( source_file(F), 1027 sub_atom(F, 0, _, _, Prefix) 1028 ), 1029 SrcFiles) 1030 ; findall(F, ( source_file(F), 1031 file_directory_name(F, AbsDir) 1032 ), 1033 SrcFiles) 1034 ). 1035directory_source_files(Dir, SrcFiles, Options) :- 1036 absolute_file_name(Dir, AbsDir, [file_type(directory), access(read)]), 1037 directory_files(AbsDir, Files), 1038 phrase(src_files(Files, AbsDir, Options), SrcFiles). 1039 1040src_files([], _, _) --> 1041 []. 1042src_files([H|T], Dir, Options) --> 1043 { file_name_extension(_, Ext, H), 1044 user:prolog_file_type(Ext, prolog), 1045 \+ user:prolog_file_type(Ext, qlf), 1046 dir_file_path(Dir, H, File0), 1047 absolute_file_name(File0, File, 1048 [ file_errors(fail) 1049 | Options 1050 ]) 1051 }, 1052 !, 1053 [File], 1054 src_files(T, Dir, Options). 1055src_files([H|T], Dir, Options) --> 1056 { \+ special(H), 1057 option(recursive(true), Options), 1058 dir_file_path(Dir, H, SubDir), 1059 exists_directory(SubDir), 1060 !, 1061 catch(directory_files(SubDir, Files), _, fail) 1062 }, 1063 !, 1064 src_files(Files, SubDir, Options), 1065 src_files(T, Dir, Options). 1066src_files([_|T], Dir, Options) --> 1067 src_files(T, Dir, Options). 1068 1069special(.). 1070special(..). 1071 1072% avoid dependency on library(filesex), which also pulls a foreign 1073% dependency. 1074dir_file_path(Dir, File, Path) :- 1075 ( sub_atom(Dir, _, _, 0, /) 1076 -> atom_concat(Dir, File, Path) 1077 ; atom_concat(Dir, /, TheDir), 1078 atom_concat(TheDir, File, Path) 1079 ).
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)
1112valid_term_position(Term, TermPos) :- 1113 valid_term_position(0, 0x7fffffffffffffff, Term, TermPos). 1114 1115valid_term_position(OuterFrom, OuterTo, _Term, TermPos), 1116 var(TermPos), 1117 OuterFrom =< OuterTo => true. 1118valid_term_position(OuterFrom, OuterTo, Var, From-To), 1119 var(Var), 1120 valid_term_position_from_to(OuterFrom, OuterTo, From, To) => true. 1121valid_term_position(OuterFrom, OuterTo, Atom, From-To), 1122 atom(Atom), 1123 valid_term_position_from_to(OuterFrom, OuterTo, From, To) => true. 1124valid_term_position(OuterFrom, OuterTo, Number, From-To), 1125 number(Number), 1126 valid_term_position_from_to(OuterFrom, OuterTo, From, To) => true. 1127valid_term_position(OuterFrom, OuterTo, [], From-To), 1128 valid_term_position_from_to(OuterFrom, OuterTo, From, To) => true. 1129valid_term_position(OuterFrom, OuterTo, String, string_position(From,To)), 1130 ( string(String) 1131 -> true 1132 ; is_of_type(codes, String) 1133 -> true 1134 ; is_of_type(chars, String) 1135 -> true 1136 ; atom(String) 1137 ), 1138 valid_term_position_from_to(OuterFrom, OuterTo, From, To) => true. 1139valid_term_position(OuterFrom, OuterTo, {Arg}, 1140 brace_term_position(From,To,ArgPos)), 1141 valid_term_position_from_to(OuterFrom, OuterTo, From, To) => 1142 valid_term_position(From, To, Arg, ArgPos). 1143valid_term_position(OuterFrom, OuterTo, [Hd|Tl], 1144 list_position(From,To,ElemsPos,none)), 1145 valid_term_position_from_to(OuterFrom, OuterTo, From, To) => 1146 term_position_list_tail([Hd|Tl], _HdPart, []), 1147 maplist(valid_term_position, [Hd|Tl], ElemsPos). 1148valid_term_position(OuterFrom, OuterTo, [Hd|Tl], 1149 list_position(From, To, ElemsPos, TailPos)), 1150 valid_term_position_from_to(OuterFrom, OuterTo, From, To) => 1151 term_position_list_tail([Hd|Tl], HdPart, Tail), 1152 maplist(valid_term_position(From,To), HdPart, ElemsPos), 1153 valid_term_position(Tail, TailPos). 1154valid_term_position(OuterFrom, OuterTo, Term, 1155 term_position(From,To, FFrom,FTo,SubPos)), 1156 valid_term_position_from_to(OuterFrom, OuterTo, From, To) => 1157 compound_name_arguments(Term, Name, Arguments), 1158 valid_term_position(Name, FFrom-FTo), 1159 maplist(valid_term_position(From,To), Arguments, SubPos). 1160valid_term_position(OuterFrom, OuterTo, Dict, 1161 dict_position(From,To,TagFrom,TagTo,KeyValuePosList)), 1162 valid_term_position_from_to(OuterFrom, OuterTo, From, To) => 1163 dict_pairs(Dict, Tag, Pairs), 1164 valid_term_position(Tag, TagFrom-TagTo), 1165 foldl(valid_term_position_dict(From,To), Pairs, KeyValuePosList, []). 1166% key_value_position(From, To, SepFrom, SepTo, Key, KeyPos, ValuePos) 1167% is handled in valid_term_position_dict. 1168valid_term_position(OuterFrom, OuterTo, Term, 1169 parentheses_term_position(From,To,ContentPos)), 1170 valid_term_position_from_to(OuterFrom, OuterTo, From, To) => 1171 valid_term_position(From, To, Term, ContentPos). 1172valid_term_position(OuterFrom, OuterTo, _Term, 1173 quasi_quotation_position(From,To, 1174 SyntaxTerm,SyntaxPos,_ContentPos)), 1175 valid_term_position_from_to(OuterFrom, OuterTo, From, To) => 1176 valid_term_position(From, To, SyntaxTerm, SyntaxPos). 1177 1178valid_term_position_from_to(OuterFrom, OuterTo, From, To) :- 1179 integer(OuterFrom), 1180 integer(OuterTo), 1181 integer(From), 1182 integer(To), 1183 OuterFrom =< OuterTo, 1184 From =< To, 1185 OuterFrom =< From, 1186 To =< OuterTo. 1187 1188:- det(valid_term_position_dict/5). 1189valid_term_position_dict(OuterFrom, OuterTo, Key-Value, 1190 KeyValuePosList0, KeyValuePosList1) :- 1191 selectchk(key_value_position(From,To,SepFrom,SepTo,Key,KeyPos,ValuePos), 1192 KeyValuePosList0, KeyValuePosList1), 1193 valid_term_position_from_to(OuterFrom, OuterTo, From, To), 1194 valid_term_position_from_to(OuterFrom, OuterTo, SepFrom, SepTo), 1195 SepFrom >= OuterFrom, 1196 valid_term_position(From, SepFrom, Key, KeyPos), 1197 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].
1214:- det(term_position_list_tail/3). 1215term_position_list_tail([X|Xs], HdPart, Tail) => 1216 HdPart = [X|HdPart2], 1217 term_position_list_tail(Xs, HdPart2, Tail). 1218term_position_list_tail(Tail0, HdPart, Tail) => 1219 HdPart = [], 1220 Tail0 = Tail. 1221 1222 1223 /******************************* 1224 * MESSAGES * 1225 *******************************/ 1226 1227:- multifile 1228 prolog:message//1. 1229 1230prologmessage(quasi_quotation(undeclared, Syntax)) --> 1231 [ 'Undeclared quasi quotation syntax: ~w'-[Syntax], nl, 1232 'Autoloading can be defined using prolog:quasi_quotation_syntax/2' 1233 ]
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