1/* Part of SWI-Prolog 2 3 Author: Jan Wielemaker 4 E-mail: jan@swi-prolog.org 5 WWW: https://www.swi-prolog.org 6 Copyright (c) 2001-2026, University of Amsterdam 7 VU University Amsterdam 8 CWI, Amsterdam 9 SWI-Prolog Solutions b.v. 10 All rights reserved. 11 12 Redistribution and use in source and binary forms, with or without 13 modification, are permitted provided that the following conditions 14 are met: 15 16 1. Redistributions of source code must retain the above copyright 17 notice, this list of conditions and the following disclaimer. 18 19 2. Redistributions in binary form must reproduce the above copyright 20 notice, this list of conditions and the following disclaimer in 21 the documentation and/or other materials provided with the 22 distribution. 23 24 THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS 25 "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT 26 LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS 27 FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE 28 COPYRIGHT OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, 29 INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, 30 BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; 31 LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER 32 CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT 33 LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN 34 ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE 35 POSSIBILITY OF SUCH DAMAGE. 36*/ 37 38:- module(prolog_listing, 39 [ listing/0, 40 listing/1, % :Spec 41 listing/2, % :Spec, +Options 42 portray_clause/1, % +Clause 43 portray_clause/2, % +Stream, +Clause 44 portray_clause/3 % +Stream, +Clause, +Options 45 ]). 46:- use_module(library(settings), [setting/4, setting/2]). 47:- autoload(library(ansi_term), [ansi_format/3, ansi_hyperlink/2]). 48:- autoload(library(apply), [foldl/4, exclude/3]). 49:- use_module(library(debug), [debug/3]). 50:- autoload(library(error), [instantiation_error/1, must_be/2]). 51:- autoload(library(lists), [member/2, append/3]). 52:- autoload(library(option), [option/2, option/3, meta_options/3]). 53:- autoload(library(prolog_clause), [clause_info/5]). 54:- autoload(library(prolog_code), [most_general_goal/2, pi_head/2]). 55:- if(exists_source(library(thread))). 56:- autoload(library(thread), [call_in_thread/3]). 57 58:- endif. 59 60%:- set_prolog_flag(generate_debug_info, false). 61 62:- module_transparent 63 listing/0. 64:- meta_predicate 65 listing(), 66 listing(, ), 67 portray_clause(,,). 68 69:- predicate_options(listing/2, 2, 70 [ thread(atom), 71 source(boolean), 72 pass_to(portray_clause/3, 3) 73 ]). 74:- predicate_options(portray_clause/3, 3, 75 [ indent(nonneg), 76 pass_to(system:write_term/3, 3) 77 ]). 78 79:- multifile 80 prolog:locate_clauses/2. % +Spec, -ClauseRefList
111:- setting(listing:body_indentation, nonneg, 4, 112 'Indentation used goals in the body'). 113:- setting(listing:tab_distance, nonneg, 0, 114 'Distance between tab-stops. 0 uses only spaces'). 115:- setting(listing:cut_on_same_line, boolean, false, 116 'Place cuts (!) on the same line'). 117:- setting(listing:line_width, nonneg, 78, 118 'Width of a line. 0 is infinite'). 119:- setting(listing:comment_ansi_attributes, list, [fg(green)], 120 'ansi_format/3 attributes to print comments').
mymodule, use one of the calls below.
?- mymodule:listing. ?- listing(mymodule:_).
134listing :- 135 context_module(Context), 136 list_module(Context, []). 137 138list_module(Module, Options) :- 139 ( current_predicate(_, Module:Pred), 140 \+ predicate_property(Module:Pred, imported_from(_)), 141 strip_module(Pred, _Module, Head), 142 functor(Head, Name, _Arity), 143 ( ( predicate_property(Module:Pred, built_in) 144 ; sub_atom(Name, 0, _, _, $) 145 ) 146 -> current_prolog_flag(access_level, system) 147 ; true 148 ), 149 nl, 150 list_predicate(Module:Head, Module, Options), 151 fail 152 ; true 153 ).
?- listing(append([], _, _)). lists:append([], L, L).
The following options are defined:
source (default) or generated. If source, for each
clause that is associated to a source location the system tries
to restore the original variable names. This may fail if macro
expansion is not reversible or the term cannot be read due to
different operator declarations. In that case variable names
are generated.true (default false), extract the lines from the source
files that produced the clauses, i.e., list the original source
text rather than the decompiled clauses. Each set of contiguous
clauses is preceded by a comment that indicates the file and
line of origin. Clauses that cannot be related to source code
are decompiled where the comment indicates the decompiled state.
This is notably practical for collecting the state of multifile
predicates. For example:
?- listing(file_search_path, [source(true)]).
Other options are passed to portray_clause/3 and from there to write_term/3.
216listing(Spec) :- 217 listing(Spec, []). 218 219listing(Spec, Options) :- 220 call_cleanup( 221 listing_(Spec, Options), 222 close_sources). 223 224listing_(M:Spec, Options) :- 225 var(Spec), 226 !, 227 list_module(M, Options). 228listing_(M:List, Options) :- 229 is_list(List), 230 !, 231 forall(member(Spec, List), 232 listing_(M:Spec, Options)). 233listing_(M:CRef, Options) :- 234 blob(CRef, clause), 235 !, 236 list_clauserefs([CRef], M, Options). 237listing_(X, Options) :- 238 ( prolog:locate_clauses(X, ClauseRefs) 239 -> strip_module(X, Context, _), 240 list_clauserefs(ClauseRefs, Context, Options) 241 ; '$find_predicate'(X, Preds), 242 list_predicates(Preds, X, Options) 243 ). 244 245list_clauserefs([], _, _) :- !. 246list_clauserefs([H|T], Context, Options) :- 247 !, 248 list_clauserefs(H, Context, Options), 249 list_clauserefs(T, Context, Options). 250list_clauserefs(Ref, Context, Options) :- 251 @(rule(M:_, Rule, Ref), Context), 252 list_clause(M:Rule, Ref, Context, Options).
256list_predicates(PIs, Context:X, Options) :- 257 member(PI, PIs), 258 pi_to_head(PI, Pred), 259 unify_args(Pred, X), 260 list_define(Pred, DefPred), 261 list_predicate(DefPred, Context, Options), 262 nl, 263 fail. 264list_predicates(_, _, _). 265 266list_define(Head, LoadModule:Head) :- 267 compound(Head), 268 Head \= (_:_), 269 functor(Head, Name, Arity), 270 '$find_library'(_, Name, Arity, LoadModule, Library), 271 !, 272 use_module(Library, []). 273list_define(M:Pred, DefM:Pred) :- 274 '$define_predicate'(M:Pred), 275 ( predicate_property(M:Pred, imported_from(DefM)) 276 -> true 277 ; DefM = M 278 ). 279 280pi_to_head(PI, _) :- 281 var(PI), 282 !, 283 instantiation_error(PI). 284pi_to_head(M:PI, M:Head) :- 285 !, 286 pi_to_head(PI, Head). 287pi_to_head(Name/Arity, Head) :- 288 functor(Head, Name, Arity). 289 290 291% Unify the arguments of the specification with the given term, 292% so we can partially instantate the head. 293 294unify_args(_, _/_) :- !. % Name/arity spec 295unify_args(X, X) :- !. 296unify_args(_:X, X) :- !. 297unify_args(_, _). 298 299list_predicate(Pred, Context, _) :- 300 predicate_property(Pred, undefined), 301 !, 302 decl_term(Pred, Context, Decl), 303 comment(['% Undefined: ~q~n'-[Decl]]). 304list_predicate(Pred, Context, _) :- 305 predicate_property(Pred, foreign), 306 !, 307 decl_term(Pred, Context, Decl), 308 comment(['% Foreign: ~q~n'-[Decl]]), 309 ( '$foreign_predicate_source'(Pred, Source) 310 -> comment(['% Implemented by ~w~n'-[Source]]) 311 ; true 312 ). 313list_predicate(Pred, Context, Options) :- 314 notify_changed(Pred, Context), 315 list_declarations(Pred, Context), 316 list_clauses(Pred, Context, Options). 317 318decl_term(Pred, Context, Decl) :- 319 strip_module(Pred, Module, Head), 320 functor(Head, Name, Arity), 321 ( hide_module(Module, Context, Head) 322 -> Decl = Name/Arity 323 ; Decl = Module:Name/Arity 324 ). 325 326 327decl(thread_local, thread_local). 328decl(dynamic, dynamic). 329decl(volatile, volatile). 330decl(multifile, multifile). 331decl(public, public).
341declaration(Pred, Source, Decl) :- 342 predicate_property(Pred, tabled), 343 Pred = M:Head, 344 ( M:'$table_mode'(Head, Head, _) 345 -> decl_term(Pred, Source, Funct), 346 table_options(Pred, Funct, TableDecl), 347 Decl = table(TableDecl) 348 ; comment('[% tabled using answer subsumption~n]'), 349 fail % TBD 350 ). 351declaration(Pred, Source, Decl) :- 352 decl(Prop, Declname), 353 predicate_property(Pred, Prop), 354 decl_term(Pred, Source, Funct), 355 Decl =.. [ Declname, Funct ]. 356declaration(Pred, Source, Decl) :- 357 predicate_property(Pred, meta_predicate(Head)), 358 strip_module(Pred, Module, _), 359 ( (Module == system; Source == Module) 360 -> Decl = meta_predicate(Head) 361 ; Decl = meta_predicate(Module:Head) 362 ), 363 ( meta_implies_transparent(Head) 364 -> ! % hide transparent 365 ; true 366 ). 367declaration(Pred, Source, Decl) :- 368 predicate_property(Pred, transparent), 369 decl_term(Pred, Source, PI), 370 Decl = module_transparent(PI).
377meta_implies_transparent(Head):- 378 compound(Head), 379 arg(_, Head, Arg), 380 implies_transparent(Arg), 381 !. 382 383implies_transparent(Arg) :- 384 integer(Arg), 385 !. 386implies_transparent(:). 387implies_transparent(//). 388implies_transparent(^). 389 390table_options(Pred, Decl0, as(Decl0, Options)) :- 391 findall(Flag, predicate_property(Pred, tabled(Flag)), [F0|Flags]), 392 !, 393 foldl(table_option, Flags, F0, Options). 394table_options(_, Decl, Decl). 395 396table_option(Flag, X, (Flag,X)). 397 398list_declarations(Pred, Source) :- 399 findall(Decl, declaration(Pred, Source, Decl), Decls), 400 ( Decls == [] 401 -> true 402 ; write_declarations(Decls, Source), 403 format('~n', []) 404 ). 405 406 407write_declarations([], _) :- !. 408write_declarations([H|T], Module) :- 409 format(':- ~q.~n', [H]), 410 write_declarations(T, Module).
421list_clauses(Pred, Source, Options) :- 422 predicate_property(Pred, thread_local), 423 option(thread(Thread), Options), 424 !, 425 strip_module(Pred, Module, Head), 426 most_general_goal(Head, GenHead), 427 option(timeout(TimeOut), Options, 0.2), 428 call_in_thread( 429 Thread, 430 find_clauses(Module:GenHead, Head, Refs), 431 [ timeout(TimeOut), 432 on_timeout(print_message( 433 warning, 434 listing(thread_local(Pred, Thread, timeout(TimeOut))))) 435 ]), 436 forall(member(Ref, Refs), 437 ( rule(Module:GenHead, Rule, Ref), 438 list_clause(Module:Rule, Ref, Source, Options))). 439:- if(current_predicate('$local_definitions'/2)). 440list_clauses(Pred, Source, _Options) :- 441 predicate_property(Pred, thread_local), 442 \+ ( predicate_property(Pred, number_of_clauses(Nc)), 443 Nc > 0 444 ), 445 !, 446 decl_term(Pred, Source, Decl), 447 '$local_definitions'(Pred, Pairs), 448 ( Pairs == [] 449 -> comment(['% No thread has clauses for ~p~n'-[Decl]]) 450 ; Top = 10, 451 length(Pairs, Count), 452 thread_self(Me), 453 thread_name(Me, MyName), 454 comment(['% Calling thread (~p) has no clauses for ~p. \c 455 Other threads have:~n'-[MyName, Decl]]), 456 sort(2, >=, Pairs, ByNumberOfClauses), 457 ( Count > Top 458 -> length(Show, Top), 459 append(Show, _, ByNumberOfClauses) 460 ; Show = ByNumberOfClauses 461 ), 462 ( member(Thread-ClauseCount, Show), 463 thread_name(Thread, Name), 464 comment(['%~t~D~8| clauses in thread ~p~n'-[ClauseCount, Name]]), 465 fail 466 ; true 467 ), 468 ( Count > Top 469 -> NotShown is Count-Top, 470 comment(['% ~D more threads have clauses for ~p~n'- 471 [NotShown, Decl]]) 472 ; true 473 ) 474 ). 475:- endif. 476list_clauses(Pred, Source, Options) :- 477 strip_module(Pred, Module, Head), 478 most_general_goal(Head, GenHead), 479 forall(find_clause(Module:GenHead, Head, Rule, Ref), 480 list_clause(Module:Rule, Ref, Source, Options)). 481 482thread_name(Thread, Name) :- 483 ( atom(Thread) 484 -> Name = Thread 485 ; catch(thread_property(Thread, id(Name)), error(_,_), 486 Name = Thread) 487 ). 488 489find_clauses(GenHead, Head, Refs) :- 490 findall(Ref, find_clause(GenHead, Head, _Rule, Ref), Refs). 491 492find_clause(GenHead, Head, Rule, Ref) :- 493 rule(GenHead, Rule, Ref), 494 \+ \+ rule_head(Rule, Head). 495 496rule_head((Head0 :- _Body), Head) :- !, Head = Head0. 497rule_head((Head0,_Cond => _Body), Head) :- !, Head = Head0. 498rule_head((Head0 => _Body), Head) :- !, Head = Head0. 499rule_head(?=>(Head0, _Body), Head) :- !, Head = Head0. 500rule_head(Head, Head).
504list_clause(_Rule, Ref, _Source, Options) :- 505 option(source(true), Options), 506 ( clause_property(Ref, file(File)), 507 clause_property(Ref, line_count(Line)), 508 catch(source_clause_string(File, Line, String, Repositioned), 509 _, fail), 510 debug(listing(source), 'Read ~w:~d: "~s"~n', [File, Line, String]) 511 -> !, 512 ( Repositioned == true 513 -> comment(['% From ', url(File:Line), '~n']) 514 ; true 515 ), 516 writeln(String) 517 ; decompiled 518 -> fail 519 ; asserta(decompiled), 520 comment('[% From database (decompiled)~n]'), 521 fail % try next clause 522 ). 523list_clause(Module:(Head:-Body), Ref, Source, Options) :- 524 !, 525 list_clause(Module:Head, Body, :-, Ref, Source, Options). 526list_clause(Module:(Head=>Body), Ref, Source, Options) :- 527 list_clause(Module:Head, Body, =>, Ref, Source, Options). 528list_clause(Module:Head, Ref, Source, Options) :- 529 !, 530 list_clause(Module:Head, true, :-, Ref, Source, Options). 531 532list_clause(Module:Head, Body, Neck, Ref, Source, Options) :- 533 restore_variable_names(Module, Head, Body, Ref, Options), 534 write_module(Module, Source, Head), 535 Rule =.. [Neck,Head,Body], 536 write_options(Options, WriteOptions), 537 current_output(Out), 538 portray_clause(Out, Rule, WriteOptions).
pass_to(portray_clause/3, 3) of the
predicate_options/3 declaration above. The options listing/2 handles
itself are removed; variable_names/1 notably means something else
here (source or generated) than it does to write_term/3.548write_options(Options, WriteOptions) :- 549 exclude(listing_option, Options, WriteOptions). 550 551listing_option(Option) :- 552 functor(Option, Name, 1), 553 listing_option_name(Name). 554 555listing_option_name(variable_names). 556listing_option_name(source). 557listing_option_name(thread). 558listing_option_name(timeout).
variable_names(source) is true.565restore_variable_names(Module, Head, Body, Ref, Options) :- 566 option(variable_names(source), Options, source), 567 catch(clause_info(Ref, _, _, _, 568 [ head(QHead), 569 body(Body), 570 variable_names(Bindings) 571 ]), 572 _, true), 573 unify_head(Module, Head, QHead), 574 !, 575 bind_vars(Bindings), 576 name_other_vars((Head:-Body), Bindings). 577restore_variable_names(_,_,_,_,_). 578 579unify_head(Module, Head, Module:Head) :- 580 !. 581unify_head(_, Head, Head) :- 582 !. 583unify_head(_, _, _). 584 585bind_vars([]) :- 586 !. 587bind_vars([Name = Var|T]) :- 588 ignore(Var = '$VAR'(Name)), 589 bind_vars(T).
596name_other_vars(Term, Bindings) :- 597 term_singletons(Term, Singletons), 598 bind_singletons(Singletons), 599 term_variables(Term, Vars), 600 name_vars(Vars, 0, Bindings). 601 602bind_singletons([]). 603bind_singletons(['$VAR'('_')|T]) :- 604 bind_singletons(T). 605 606name_vars([], _, _). 607name_vars([H|T], N, Bindings) :- 608 between(N, infinite, N2), 609 var_name(N2, Name), 610 \+ memberchk(Name=_, Bindings), 611 !, 612 H = '$VAR'(N2), 613 N3 is N2 + 1, 614 name_vars(T, N3, Bindings). 615 616var_name(I, Name) :- % must be kept in sync with writeNumberVar() 617 L is (I mod 26)+0'A, 618 N is I // 26, 619 ( N == 0 620 -> char_code(Name, L) 621 ; format(atom(Name), '~c~d', [L, N]) 622 ). 623 624write_module(Module, Context, Head) :- 625 hide_module(Module, Context, Head), 626 !. 627write_module(Module, _, _) :- 628 format('~q:', [Module]). 629 630hide_module(system, Module, Head) :- 631 predicate_property(Module:Head, imported_from(M)), 632 predicate_property(system:Head, imported_from(M)), 633 !. 634hide_module(Module, Module, _) :- !. 635 636notify_changed(Pred, Context) :- 637 strip_module(Pred, user, Head), 638 predicate_property(Head, built_in), 639 \+ predicate_property(Head, (dynamic)), 640 !, 641 decl_term(Pred, Context, Decl), 642 comment(['% NOTE: system definition has been overruled for ~q~n'- 643 [Decl]]). 644notify_changed(_, _).
651source_clause_string(File, Line, String, Repositioned) :- 652 open_source(File, Line, Stream, Repositioned), 653 stream_property(Stream, position(Start)), 654 '$raw_read'(Stream, _TextWithoutComments), 655 stream_property(Stream, position(End)), 656 stream_position_data(char_count, Start, StartChar), 657 stream_position_data(char_count, End, EndChar), 658 Length is EndChar - StartChar, 659 set_stream_position(Stream, Start), 660 read_string(Stream, Length, String), 661 skip_blanks_and_comments(Stream, blank). 662 663skip_blanks_and_comments(Stream, _) :- 664 at_end_of_stream(Stream), 665 !. 666skip_blanks_and_comments(Stream, State0) :- 667 peek_string(Stream, 80, String), 668 string_chars(String, Chars), 669 phrase(blanks_and_comments(State0, State), Chars, Rest), 670 ( Rest == [] 671 -> read_string(Stream, 80, _), 672 skip_blanks_and_comments(Stream, State) 673 ; length(Chars, All), 674 length(Rest, RLen), 675 Skip is All-RLen, 676 read_string(Stream, Skip, _) 677 ). 678 679blanks_and_comments(State0, State) --> 680 [C], 681 { transition(C, State0, State1) }, 682 !, 683 blanks_and_comments(State1, State). 684blanks_and_comments(State, State) --> 685 []. 686 687transition(C, blank, blank) :- 688 char_type(C, space). 689transition('%', blank, line_comment). 690transition('\n', line_comment, blank). 691transition(_, line_comment, line_comment). 692transition('/', blank, comment_0). 693transition('/', comment(N), comment(N,/)). 694transition('*', comment(N,/), comment(N1)) :- 695 N1 is N + 1. 696transition('*', comment_0, comment(1)). 697transition('*', comment(N), comment(N,*)). 698transition('/', comment(N,*), State) :- 699 ( N == 1 700 -> State = blank 701 ; N2 is N - 1, 702 State = comment(N2) 703 ). 704 705 706open_source(File, Line, Stream, Repositioned) :- 707 source_stream(File, Stream, Pos0, Repositioned), 708 line_count(Stream, Line0), 709 ( Line >= Line0 710 -> Skip is Line - Line0 711 ; set_stream_position(Stream, Pos0), 712 Skip is Line - 1 713 ), 714 debug(listing(source), '~w: skip ~d to ~d', [File, Line0, Line]), 715 ( Skip =\= 0 716 -> Repositioned = true 717 ; true 718 ), 719 forall(between(1, Skip, _), 720 skip(Stream, 0'\n)). 721 722:- thread_local 723 opened_source/3, 724 decompiled/0. 725 726source_stream(File, Stream, Pos0, _) :- 727 opened_source(File, Stream, Pos0), 728 !. 729source_stream(File, Stream, Pos0, true) :- 730 open(File, read, Stream), 731 stream_property(Stream, position(Pos0)), 732 asserta(opened_source(File, Stream, Pos0)). 733 734close_sources :- 735 retractall(decompiled), 736 forall(retract(opened_source(_,Stream,_)), 737 close(Stream)).
Variable names are by default generated using numbervars/4 using the
option singletons(true). This names the variables A, B, ... and
the singletons _. Variables can be named explicitly by binding
them to a term '$VAR'(Name), where Name is an atom denoting a
valid variable name (see the option numbervars(true) from
write_term/2) as well as by using the variable_names(Bindings)
option from write_term/2.
Options processed in addition to write_term/2 options:
0.user.768% The prolog_list_goal/1 hook is a dubious as it may lead to 769% confusion if the heads relates to other bodies. For now it is 770% only used for XPCE methods and works just nice. 771% 772% Not really ... It may confuse the source-level debugger. 773 774%portray_clause(Head :- _Body) :- 775% user:prolog_list_goal(Head), !. 776portray_clause(Term) :- 777 current_output(Out), 778 portray_clause(Out, Term). 779 780portray_clause(Stream, Term) :- 781 must_be(stream, Stream), 782 portray_clause(Stream, Term, []). 783 784portray_clause(Stream, Term, M:Options) :- 785 must_be(list, Options), 786 meta_options(is_meta, M:Options, QOptions), 787 \+ \+ name_vars_and_portray_clause(Stream, Term, QOptions). 788 789name_vars_and_portray_clause(Stream, Term, Options) :- 790 term_attvars(Term, []), 791 !, 792 clause_vars(Term, Options), 793 do_portray_clause(Stream, Term, Options). 794name_vars_and_portray_clause(Stream, Term, Options) :- 795 option(variable_names(Bindings), Options), 796 !, 797 copy_term_nat(Term+Bindings, Copy+BCopy), 798 bind_vars(BCopy), 799 name_other_vars(Copy, BCopy), 800 do_portray_clause(Stream, Copy, Options). 801name_vars_and_portray_clause(Stream, Term, Options) :- 802 copy_term_nat(Term, Copy), 803 clause_vars(Copy, Options), 804 do_portray_clause(Stream, Copy, Options). 805 806clause_vars(Clause, Options) :- 807 option(variable_names(Bindings), Options), 808 !, 809 bind_vars(Bindings), 810 name_other_vars(Clause, Bindings). 811clause_vars(Clause, _) :- 812 numbervars(Clause, 0, _, 813 [ singletons(true) 814 ]). 815 816is_meta(portray_goal). 817 818do_portray_clause(Out, Var, Options) :- 819 var(Var), 820 !, 821 option(indent(LeftMargin), Options, 0), 822 indent(Out, LeftMargin), 823 pprint(Out, Var, 1200, Options). 824do_portray_clause(Out, (Head :- true), Options) :- 825 !, 826 option(indent(LeftMargin), Options, 0), 827 indent(Out, LeftMargin), 828 pprint(Out, Head, 1200, Options), 829 full_stop(Out). 830do_portray_clause(Out, Term, Options) :- 831 clause_term(Term, Head, Neck, Body), 832 !, 833 option(indent(LeftMargin), Options, 0), 834 inc_indent(LeftMargin, 1, Indent), 835 infix_op(Neck, RightPri, LeftPri), 836 indent(Out, LeftMargin), 837 pprint(Out, Head, LeftPri, Options), 838 format(Out, ' ~w', [Neck]), 839 ( nonvar(Body), 840 Body = Module:LocalBody, 841 \+ primitive(LocalBody) 842 -> nlindent(Out, Indent), 843 format(Out, '~q', [Module]), 844 '$put_token'(Out, :), 845 nlindent(Out, Indent), 846 write(Out, '( '), 847 inc_indent(Indent, 1, BodyIndent), 848 portray_body(LocalBody, BodyIndent, noindent, 1200, Out, Options), 849 nlindent(Out, Indent), 850 write(Out, ')') 851 ; setting(listing:body_indentation, BodyIndent0), 852 BodyIndent is LeftMargin+BodyIndent0, 853 portray_body(Body, BodyIndent, indent, RightPri, Out, Options) 854 ), 855 full_stop(Out). 856do_portray_clause(Out, (:-Directive), Options) :- 857 wrapped_list_directive(Directive), 858 !, 859 Directive =.. [Name, Arg, List], 860 option(indent(LeftMargin), Options, 0), 861 indent(Out, LeftMargin), 862 format(Out, ':- ~q(', [Name]), 863 line_position(Out, Indent), 864 format(Out, '~q,', [Arg]), 865 nlindent(Out, Indent), 866 portray_list(List, Indent, Out, Options), 867 write(Out, ').\n'). 868do_portray_clause(Out, Clause, Options) :- 869 directive(Clause, Op, Directive), 870 !, 871 option(indent(LeftMargin), Options, 0), 872 indent(Out, LeftMargin), 873 format(Out, '~w ', [Op]), 874 DIndent is LeftMargin+3, 875 portray_body(Directive, DIndent, noindent, 1199, Out, Options), 876 full_stop(Out). 877do_portray_clause(Out, Fact, Options) :- 878 option(indent(LeftMargin), Options, 0), 879 indent(Out, LeftMargin), 880 portray_body(Fact, LeftMargin, noindent, 1200, Out, Options), 881 full_stop(Out). 882 883clause_term((Head:-Body), Head, :-, Body). 884clause_term((Head=>Body), Head, =>, Body). 885clause_term(?=>(Head,Body), Head, ?=>, Body). 886clause_term((Head-->Body), Head, -->, Body). 887 888full_stop(Out) :- 889 '$put_token'(Out, '.'), 890 nl(Out). 891 892directive((:- Directive), :-, Directive). 893directive((?- Directive), ?-, Directive). 894 895wrapped_list_directive(module(_,_)). 896%wrapped_list_directive(use_module(_,_)). 897%wrapped_list_directive(autoload(_,_)).
904portray_body(Var, _, _, Pri, Out, Options) :- 905 var(Var), 906 !, 907 pprint(Out, Var, Pri, Options). 908portray_body(!, _, _, _, Out, _) :- 909 setting(listing:cut_on_same_line, true), 910 !, 911 write(Out, ' !'). 912portray_body((!, Clause), Indent, _, Pri, Out, Options) :- 913 setting(listing:cut_on_same_line, true), 914 \+ term_needs_braces((_,_), Pri), 915 !, 916 write(Out, ' !,'), 917 portray_body(Clause, Indent, indent, 1000, Out, Options). 918portray_body(Term, Indent, indent, Pri, Out, Options) :- 919 !, 920 nlindent(Out, Indent), 921 portray_body(Term, Indent, noindent, Pri, Out, Options). 922portray_body(Or, Indent, _, _, Out, Options) :- 923 or_layout(Or), 924 !, 925 write(Out, '( '), 926 portray_or(Or, Indent, 1200, Out, Options), 927 nlindent(Out, Indent), 928 write(Out, ')'). 929portray_body(Term, Indent, _, Pri, Out, Options) :- 930 term_needs_braces(Term, Pri), 931 !, 932 write(Out, '( '), 933 ArgIndent is Indent + 2, 934 portray_body(Term, ArgIndent, noindent, 1200, Out, Options), 935 nlindent(Out, Indent), 936 write(Out, ')'). 937portray_body(((AB),C), Indent, _, _Pri, Out, Options) :- 938 nonvar(AB), 939 AB = (A,B), 940 !, 941 infix_op(',', LeftPri, RightPri), 942 portray_body(A, Indent, noindent, LeftPri, Out, Options), 943 write(Out, ','), 944 portray_body((B,C), Indent, indent, RightPri, Out, Options). 945portray_body((A,B), Indent, _, _Pri, Out, Options) :- 946 !, 947 infix_op(',', LeftPri, RightPri), 948 portray_body(A, Indent, noindent, LeftPri, Out, Options), 949 write(Out, ','), 950 portray_body(B, Indent, indent, RightPri, Out, Options). 951portray_body(\+(Goal), Indent, _, _Pri, Out, Options) :- 952 !, 953 write(Out, \+), write(Out, ' '), 954 prefix_op(\+, ArgPri), 955 ArgIndent is Indent+3, 956 portray_body(Goal, ArgIndent, noindent, ArgPri, Out, Options). 957portray_body(Call, _, _, _, Out, Options) :- % requires knowledge on the module! 958 m_callable(Call), 959 option(module(M), Options, user), 960 predicate_property(M:Call, meta_predicate(Meta)), 961 !, 962 portray_meta(Out, Call, Meta, Options). 963portray_body(Clause, _, _, Pri, Out, Options) :- 964 pprint(Out, Clause, Pri, Options). 965 966m_callable(Term) :- 967 strip_module(Term, _, Plain), 968 callable(Plain), 969 Plain \= (_:_). 970 971term_needs_braces(Term, Pri) :- 972 callable(Term), 973 functor(Term, Name, _Arity), 974 current_op(OpPri, _Type, Name), 975 OpPri > Pri, 976 !.
980portray_or(Term, Indent, Pri, Out, Options) :- 981 term_needs_braces(Term, Pri), 982 !, 983 inc_indent(Indent, 1, NewIndent), 984 write(Out, '( '), 985 portray_or(Term, NewIndent, Out, Options), 986 nlindent(Out, NewIndent), 987 write(Out, ')'). 988portray_or(Term, Indent, _Pri, Out, Options) :- 989 or_layout(Term), 990 !, 991 portray_or(Term, Indent, Out, Options). 992portray_or(Term, Indent, Pri, Out, Options) :- 993 inc_indent(Indent, 1, NestIndent), 994 portray_body(Term, NestIndent, noindent, Pri, Out, Options). 995 996 997portray_or((If -> Then ; Else), Indent, Out, Options) :- 998 !, 999 inc_indent(Indent, 1, NestIndent), 1000 infix_op((->), LeftPri, RightPri), 1001 portray_body(If, NestIndent, noindent, LeftPri, Out, Options), 1002 nlindent(Out, Indent), 1003 write(Out, '-> '), 1004 portray_body(Then, NestIndent, noindent, RightPri, Out, Options), 1005 nlindent(Out, Indent), 1006 write(Out, '; '), 1007 infix_op(;, _LeftPri, RightPri2), 1008 portray_or(Else, Indent, RightPri2, Out, Options). 1009portray_or((If *-> Then ; Else), Indent, Out, Options) :- 1010 !, 1011 inc_indent(Indent, 1, NestIndent), 1012 infix_op((*->), LeftPri, RightPri), 1013 portray_body(If, NestIndent, noindent, LeftPri, Out, Options), 1014 nlindent(Out, Indent), 1015 write(Out, '*-> '), 1016 portray_body(Then, NestIndent, noindent, RightPri, Out, Options), 1017 nlindent(Out, Indent), 1018 write(Out, '; '), 1019 infix_op(;, _LeftPri, RightPri2), 1020 portray_or(Else, Indent, RightPri2, Out, Options). 1021portray_or((If -> Then), Indent, Out, Options) :- 1022 !, 1023 inc_indent(Indent, 1, NestIndent), 1024 infix_op((->), LeftPri, RightPri), 1025 portray_body(If, NestIndent, noindent, LeftPri, Out, Options), 1026 nlindent(Out, Indent), 1027 write(Out, '-> '), 1028 portray_or(Then, Indent, RightPri, Out, Options). 1029portray_or((If *-> Then), Indent, Out, Options) :- 1030 !, 1031 inc_indent(Indent, 1, NestIndent), 1032 infix_op((->), LeftPri, RightPri), 1033 portray_body(If, NestIndent, noindent, LeftPri, Out, Options), 1034 nlindent(Out, Indent), 1035 write(Out, '*-> '), 1036 portray_or(Then, Indent, RightPri, Out, Options). 1037portray_or((A;B), Indent, Out, Options) :- 1038 !, 1039 inc_indent(Indent, 1, NestIndent), 1040 infix_op(;, LeftPri, RightPri), 1041 portray_body(A, NestIndent, noindent, LeftPri, Out, Options), 1042 nlindent(Out, Indent), 1043 write(Out, '; '), 1044 portray_or(B, Indent, RightPri, Out, Options). 1045portray_or((A|B), Indent, Out, Options) :- 1046 !, 1047 inc_indent(Indent, 1, NestIndent), 1048 infix_op('|', LeftPri, RightPri), 1049 portray_body(A, NestIndent, noindent, LeftPri, Out, Options), 1050 nlindent(Out, Indent), 1051 write(Out, '| '), 1052 portray_or(B, Indent, RightPri, Out, Options).
1060infix_op(Op, Left, Right) :- 1061 current_op(Pri, Assoc, Op), 1062 infix_assoc(Assoc, LeftMin, RightMin), 1063 !, 1064 Left is Pri - LeftMin, 1065 Right is Pri - RightMin. 1066 1067infix_assoc(xfx, 1, 1). 1068infix_assoc(xfy, 1, 0). 1069infix_assoc(yfx, 0, 1). 1070 1071prefix_op(Op, ArgPri) :- 1072 current_op(Pri, Assoc, Op), 1073 pre_assoc(Assoc, ArgMin), 1074 !, 1075 ArgPri is Pri - ArgMin. 1076 1077pre_assoc(fx, 1). 1078pre_assoc(fy, 0). 1079 1080postfix_op(Op, ArgPri) :- 1081 current_op(Pri, Assoc, Op), 1082 post_assoc(Assoc, ArgMin), 1083 !, 1084 ArgPri is Pri - ArgMin. 1085 1086post_assoc(xf, 1). 1087post_assoc(yf, 0).
1096or_layout(Var) :- 1097 var(Var), !, fail. 1098or_layout((_;_)). 1099or_layout((_->_)). 1100or_layout((_*->_)). 1101 1102primitive(G) :- 1103 or_layout(G), !, fail. 1104primitive((_,_)) :- !, fail. 1105primitive(_).
1114portray_meta(Out, Call, Meta, Options) :- 1115 contains_non_primitive_meta_arg(Call, Meta), 1116 !, 1117 Call =.. [Name|Args], 1118 Meta =.. [_|Decls], 1119 format(Out, '~q(', [Name]), 1120 line_position(Out, Indent), 1121 portray_meta_args(Decls, Args, Indent, Out, Options), 1122 format(Out, ')', []). 1123portray_meta(Out, Call, _, Options) :- 1124 pprint(Out, Call, 999, Options). 1125 1126contains_non_primitive_meta_arg(Call, Decl) :- 1127 arg(I, Call, CA), 1128 arg(I, Decl, DA), 1129 integer(DA), 1130 \+ primitive(CA), 1131 !. 1132 1133portray_meta_args([], [], _, _, _). 1134portray_meta_args([D|DT], [A|AT], Indent, Out, Options) :- 1135 portray_meta_arg(D, A, Out, Options), 1136 ( DT == [] 1137 -> true 1138 ; format(Out, ',', []), 1139 nlindent(Out, Indent), 1140 portray_meta_args(DT, AT, Indent, Out, Options) 1141 ). 1142 1143portray_meta_arg(I, A, Out, Options) :- 1144 integer(I), 1145 !, 1146 line_position(Out, Indent), 1147 portray_body(A, Indent, noindent, 999, Out, Options). 1148portray_meta_arg(_, A, Out, Options) :- 1149 pprint(Out, A, 999, Options).
[ element1, [ element1 element2, OR | tail ] ]
1159portray_list([], _, Out, _) :- 1160 !, 1161 write(Out, []). 1162portray_list(List, Indent, Out, Options) :- 1163 write(Out, '[ '), 1164 EIndent is Indent + 2, 1165 portray_list_elements(List, EIndent, Out, Options), 1166 nlindent(Out, Indent), 1167 write(Out, ']'). 1168 1169portray_list_elements([H|T], EIndent, Out, Options) :- 1170 pprint(Out, H, 999, Options), 1171 ( T == [] 1172 -> true 1173 ; nonvar(T), T = [_|_] 1174 -> write(Out, ','), 1175 nlindent(Out, EIndent), 1176 portray_list_elements(T, EIndent, Out, Options) 1177 ; Indent is EIndent - 2, 1178 nlindent(Out, Indent), 1179 write(Out, '| '), 1180 pprint(Out, T, 999, Options) 1181 ).
1195pprint(Out, Term, _, Options) :- 1196 nonvar(Term), 1197 Term = {}(Arg), 1198 line_position(Out, Indent), 1199 ArgIndent is Indent + 2, 1200 format(Out, '{ ', []), 1201 portray_body(Arg, ArgIndent, noident, 1000, Out, Options), 1202 nlindent(Out, Indent), 1203 format(Out, '}', []). 1204pprint(Out, Term, Pri, Options) :- 1205 ( compound(Term) 1206 -> compound_name_arity(Term, _, Arity), 1207 Arity > 0 1208 ; is_dict(Term) 1209 ), 1210 \+ nowrap_term(Term), 1211 line_width(Width), 1212 Width > 0, 1213 ( write_size(Term, Len, _Height, [max_width(Width)|Options]) 1214 -> true 1215 ; Len = Width 1216 ), 1217 line_position(Out, Indent), 1218 Indent + Len > Width, 1219 Len > Width/4, % ad-hoc rule for deeply nested goals 1220 !, 1221 pprint_wrapped(Out, Term, Pri, Options). 1222pprint(Out, Term, Pri, Options) :- 1223 listing_write_options(Pri, WrtOptions, Options), 1224 write_term(Out, Term, 1225 [ blobs(portray), 1226 portray_goal(portray_blob) 1227 | WrtOptions 1228 ]). 1229 1230:- public portray_blob/2. 1231portray_blob(Blob, _Options) :- 1232 blob(Blob, _), 1233 \+ atom(Blob), 1234 !, 1235 format(string(S), '~q', [Blob]), 1236 format('~q', ['$BLOB'(S)]). 1237 1238nowrap_term('$VAR'(_)) :- !. 1239nowrap_term(_{}) :- !. % empty dict 1240nowrap_term(Term) :- 1241 functor(Term, Name, Arity), 1242 current_op(_, _, Name), 1243 ( Arity == 2 1244 -> infix_op(Name, _, _) 1245 ; Arity == 1 1246 -> ( prefix_op(Name, _) 1247 -> true 1248 ; postfix_op(Name, _) 1249 ) 1250 ). 1251 1252 1253pprint_wrapped(Out, Term, _, Options) :- 1254 Term = [_|_], 1255 !, 1256 line_position(Out, Indent), 1257 portray_list(Term, Indent, Out, Options). 1258pprint_wrapped(Out, Dict, _, Options) :- 1259 is_dict(Dict), 1260 !, 1261 dict_pairs(Dict, Tag, Pairs), 1262 pprint(Out, Tag, 1200, Options), 1263 format(Out, '{ ', []), 1264 line_position(Out, Indent), 1265 pprint_nv(Pairs, Indent, Out, Options), 1266 nlindent(Out, Indent-2), 1267 format(Out, '}', []). 1268pprint_wrapped(Out, Term, _, Options) :- 1269 Term =.. [Name|Args], 1270 format(Out, '~q(', [Name]), 1271 line_position(Out, Indent), 1272 pprint_args(Args, Indent, Out, Options), 1273 format(Out, ')', []). 1274 1275pprint_args([], _, _, _). 1276pprint_args([H|T], Indent, Out, Options) :- 1277 pprint(Out, H, 999, Options), 1278 ( T == [] 1279 -> true 1280 ; format(Out, ',', []), 1281 nlindent(Out, Indent), 1282 pprint_args(T, Indent, Out, Options) 1283 ). 1284 1285 1286pprint_nv([], _, _, _). 1287pprint_nv([Name-Value|T], Indent, Out, Options) :- 1288 pprint(Out, Name, 999, Options), 1289 format(Out, ':', []), 1290 pprint(Out, Value, 999, Options), 1291 ( T == [] 1292 -> true 1293 ; format(Out, ',', []), 1294 nlindent(Out, Indent), 1295 pprint_nv(T, Indent, Out, Options) 1296 ).
1304listing_write_options(Pri,
1305 [ quoted(true),
1306 numbervars(true),
1307 priority(Pri),
1308 spacing(next_argument)
1309 | Options
1310 ],
1311 Options).1319nlindent(Out, N) :- 1320 nl(Out), 1321 indent(Out, N). 1322 1323indent(Out, N) :- 1324 setting(listing:tab_distance, D), 1325 ( D =:= 0 1326 -> tab(Out, N) 1327 ; Tab is N // D, 1328 Space is N mod D, 1329 put_tabs(Out, Tab), 1330 tab(Out, Space) 1331 ). 1332 1333put_tabs(Out, N) :- 1334 N > 0, 1335 !, 1336 put(Out, 0'\t), 1337 NN is N - 1, 1338 put_tabs(Out, NN). 1339put_tabs(_, _). 1340 1341line_width(Width) :- 1342 stream_property(current_output, tty(true)), 1343 catch(tty_size(_Rows, Cols), error(_,_), fail), 1344 !, 1345 Width is Cols - 2. 1346line_width(Width) :- 1347 setting(listing:line_width, Width), 1348 !. 1349line_width(78).
1356inc_indent(Indent0, Inc, Indent) :- 1357 Indent is Indent0 + Inc*4. 1358 1359:- multifile 1360 sandbox:safe_meta/2. 1361 1362sandbox:safe_meta(listing(What), []) :- 1363 not_qualified(What). 1364 1365not_qualified(Var) :- 1366 var(Var), 1367 !. 1368not_qualified(_:_) :- !, fail. 1369not_qualified(_).
1376comment(List) :- 1377 stream_property(current_output, tty(true)), 1378 setting(listing:comment_ansi_attributes, Attributes), 1379 Attributes \== [], 1380 !, 1381 forall(member(X, List), 1382 ansi_comment_element(Attributes, X)). 1383comment(List) :- 1384 forall(member(X, List), 1385 comment_element(X)). 1386 1387ansi_comment_element(Attributes, Fmt-Args) => 1388 ansi_format(Attributes, Fmt, Args). 1389ansi_comment_element(_, url(URL)) => 1390 ansi_hyperlink(current_output, URL). 1391ansi_comment_element(Attributes, Fmt), atomic(Fmt) => 1392 ansi_format(Attributes, Fmt, []). 1393 1394comment_element(Fmt-Args) => 1395 format(Fmt, Args). 1396comment_element(url(File:Line)) => 1397 format('~w:~d', [File, Line]). 1398comment_element(Fmt), atomic(Fmt) => 1399 format(Fmt, []). 1400 1401 1402 /******************************* 1403 * MESSAGES * 1404 *******************************/ 1405 1406:- multifile(prolog:message//1). 1407 1408prologmessage(listing(thread_local(Pred, Thread, timeout(TimeOut)))) --> 1409 { pi_head(PI, Pred) }, 1410 [ 'Could not list ~p for thread ~p: timeout after ~p sec.'- 1411 [PI, Thread, TimeOut] 1412 ]
List programs and pretty print clauses
This module implements listing code from the internal representation in a human readable format.
Layout can be customized using library(settings). The effective settings can be listed using list_settings/1 as illustrated below. Settings can be changed using set_setting/2.