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 48:- autoload(library(ansi_term),[ansi_format/3]). 49:- autoload(library(apply),[foldl/4]). 50:- use_module(library(debug),[debug/3]). 51:- autoload(library(error),[instantiation_error/1,must_be/2]). 52:- autoload(library(lists),[member/2, append/3]). 53:- autoload(library(option),[option/2,option/3,meta_options/3]). 54:- autoload(library(prolog_clause),[clause_info/5]). 55:- autoload(library(prolog_code), [most_general_goal/2]). 56:- if(exists_source(library(thread))). 57:- autoload(library(thread), [call_in_thread/3]). 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)]).
206listing(Spec) :- 207 listing(Spec, []). 208 209listing(Spec, Options) :- 210 call_cleanup( 211 listing_(Spec, Options), 212 close_sources). 213 214listing_(M:Spec, Options) :- 215 var(Spec), 216 !, 217 list_module(M, Options). 218listing_(M:List, Options) :- 219 is_list(List), 220 !, 221 forall(member(Spec, List), 222 listing_(M:Spec, Options)). 223listing_(M:CRef, Options) :- 224 blob(CRef, clause), 225 !, 226 list_clauserefs([CRef], M, Options). 227listing_(X, Options) :- 228 ( prolog:locate_clauses(X, ClauseRefs) 229 -> strip_module(X, Context, _), 230 list_clauserefs(ClauseRefs, Context, Options) 231 ; '$find_predicate'(X, Preds), 232 list_predicates(Preds, X, Options) 233 ). 234 235list_clauserefs([], _, _) :- !. 236list_clauserefs([H|T], Context, Options) :- 237 !, 238 list_clauserefs(H, Context, Options), 239 list_clauserefs(T, Context, Options). 240list_clauserefs(Ref, Context, Options) :- 241 @(rule(M:_, Rule, Ref), Context), 242 list_clause(M:Rule, Ref, Context, Options).
246list_predicates(PIs, Context:X, Options) :- 247 member(PI, PIs), 248 pi_to_head(PI, Pred), 249 unify_args(Pred, X), 250 list_define(Pred, DefPred), 251 list_predicate(DefPred, Context, Options), 252 nl, 253 fail. 254list_predicates(_, _, _). 255 256list_define(Head, LoadModule:Head) :- 257 compound(Head), 258 Head \= (_:_), 259 functor(Head, Name, Arity), 260 '$find_library'(_, Name, Arity, LoadModule, Library), 261 !, 262 use_module(Library, []). 263list_define(M:Pred, DefM:Pred) :- 264 '$define_predicate'(M:Pred), 265 ( predicate_property(M:Pred, imported_from(DefM)) 266 -> true 267 ; DefM = M 268 ). 269 270pi_to_head(PI, _) :- 271 var(PI), 272 !, 273 instantiation_error(PI). 274pi_to_head(M:PI, M:Head) :- 275 !, 276 pi_to_head(PI, Head). 277pi_to_head(Name/Arity, Head) :- 278 functor(Head, Name, Arity). 279 280 281% Unify the arguments of the specification with the given term, 282% so we can partially instantate the head. 283 284unify_args(_, _/_) :- !. % Name/arity spec 285unify_args(X, X) :- !. 286unify_args(_:X, X) :- !. 287unify_args(_, _). 288 289list_predicate(Pred, Context, _) :- 290 predicate_property(Pred, undefined), 291 !, 292 decl_term(Pred, Context, Decl), 293 comment('% Undefined: ~q~n', [Decl]). 294list_predicate(Pred, Context, _) :- 295 predicate_property(Pred, foreign), 296 !, 297 decl_term(Pred, Context, Decl), 298 comment('% Foreign: ~q~n', [Decl]), 299 ( '$foreign_predicate_source'(Pred, Source) 300 -> comment('% Implemented by ~w~n', [Source]) 301 ; true 302 ). 303list_predicate(Pred, Context, Options) :- 304 notify_changed(Pred, Context), 305 list_declarations(Pred, Context), 306 list_clauses(Pred, Context, Options). 307 308decl_term(Pred, Context, Decl) :- 309 strip_module(Pred, Module, Head), 310 functor(Head, Name, Arity), 311 ( hide_module(Module, Context, Head) 312 -> Decl = Name/Arity 313 ; Decl = Module:Name/Arity 314 ). 315 316 317decl(thread_local, thread_local). 318decl(dynamic, dynamic). 319decl(volatile, volatile). 320decl(multifile, multifile). 321decl(public, public).
331declaration(Pred, Source, Decl) :- 332 predicate_property(Pred, tabled), 333 Pred = M:Head, 334 ( M:'$table_mode'(Head, Head, _) 335 -> decl_term(Pred, Source, Funct), 336 table_options(Pred, Funct, TableDecl), 337 Decl = table(TableDecl) 338 ; comment('% tabled using answer subsumption~n', []), 339 fail % TBD 340 ). 341declaration(Pred, Source, Decl) :- 342 decl(Prop, Declname), 343 predicate_property(Pred, Prop), 344 decl_term(Pred, Source, Funct), 345 Decl =.. [ Declname, Funct ]. 346declaration(Pred, Source, Decl) :- 347 predicate_property(Pred, meta_predicate(Head)), 348 strip_module(Pred, Module, _), 349 ( (Module == system; Source == Module) 350 -> Decl = meta_predicate(Head) 351 ; Decl = meta_predicate(Module:Head) 352 ), 353 ( meta_implies_transparent(Head) 354 -> ! % hide transparent 355 ; true 356 ). 357declaration(Pred, Source, Decl) :- 358 predicate_property(Pred, transparent), 359 decl_term(Pred, Source, PI), 360 Decl = module_transparent(PI).
367meta_implies_transparent(Head):- 368 compound(Head), 369 arg(_, Head, Arg), 370 implies_transparent(Arg), 371 !. 372 373implies_transparent(Arg) :- 374 integer(Arg), 375 !. 376implies_transparent(:). 377implies_transparent(//). 378implies_transparent(^). 379 380table_options(Pred, Decl0, as(Decl0, Options)) :- 381 findall(Flag, predicate_property(Pred, tabled(Flag)), [F0|Flags]), 382 !, 383 foldl(table_option, Flags, F0, Options). 384table_options(_, Decl, Decl). 385 386table_option(Flag, X, (Flag,X)). 387 388list_declarations(Pred, Source) :- 389 findall(Decl, declaration(Pred, Source, Decl), Decls), 390 ( Decls == [] 391 -> true 392 ; write_declarations(Decls, Source), 393 format('~n', []) 394 ). 395 396 397write_declarations([], _) :- !. 398write_declarations([H|T], Module) :- 399 format(':- ~q.~n', [H]), 400 write_declarations(T, Module).
411list_clauses(Pred, Source, Options) :- 412 predicate_property(Pred, thread_local), 413 option(thread(Thread), Options), 414 !, 415 strip_module(Pred, Module, Head), 416 most_general_goal(Head, GenHead), 417 option(timeout(TimeOut), Options, 0.2), 418 call_in_thread( 419 Thread, 420 find_clauses(Module:GenHead, Head, Refs), 421 [ timeout(TimeOut), 422 on_timeout(print_message( 423 warning, 424 listing(thread_local(Pred, Thread, timeout(TimeOut))))) 425 ]), 426 forall(member(Ref, Refs), 427 ( rule(Module:GenHead, Rule, Ref), 428 list_clause(Module:Rule, Ref, Source, Options))). 429:- if(current_predicate('$local_definitions'/2)). 430list_clauses(Pred, Source, _Options) :- 431 predicate_property(Pred, thread_local), 432 \+ ( predicate_property(Pred, number_of_clauses(Nc)), 433 Nc > 0 434 ), 435 !, 436 decl_term(Pred, Source, Decl), 437 '$local_definitions'(Pred, Pairs), 438 ( Pairs == [] 439 -> comment('% No thread has clauses for ~p~n', [Decl]) 440 ; Top = 10, 441 length(Pairs, Count), 442 thread_self(Me), 443 thread_name(Me, MyName), 444 comment('% Calling thread (~p) has no clauses for ~p. \c 445 Other threads have:~n', [MyName, Decl]), 446 sort(2, >=, Pairs, ByNumberOfClauses), 447 ( Count > Top 448 -> length(Show, Top), 449 append(Show, _, ByNumberOfClauses) 450 ; Show = ByNumberOfClauses 451 ), 452 ( member(Thread-ClauseCount, Show), 453 thread_name(Thread, Name), 454 comment('%~t~D~8| clauses in thread ~p~n', [ClauseCount, Name]), 455 fail 456 ; true 457 ), 458 ( Count > Top 459 -> NotShown is Count-Top, 460 comment('% ~D more threads have clauses for ~p~n', 461 [NotShown, Decl]) 462 ; true 463 ) 464 ). 465:- endif. 466list_clauses(Pred, Source, Options) :- 467 strip_module(Pred, Module, Head), 468 most_general_goal(Head, GenHead), 469 forall(find_clause(Module:GenHead, Head, Rule, Ref), 470 list_clause(Module:Rule, Ref, Source, Options)). 471 472thread_name(Thread, Name) :- 473 ( atom(Thread) 474 -> Name = Thread 475 ; catch(thread_property(Thread, id(Name)), error(_,_), 476 Name = Thread) 477 ). 478 479find_clauses(GenHead, Head, Refs) :- 480 findall(Ref, find_clause(GenHead, Head, _Rule, Ref), Refs). 481 482find_clause(GenHead, Head, Rule, Ref) :- 483 rule(GenHead, Rule, Ref), 484 \+ \+ rule_head(Rule, Head). 485 486rule_head((Head0 :- _Body), Head) :- !, Head = Head0. 487rule_head((Head0,_Cond => _Body), Head) :- !, Head = Head0. 488rule_head((Head0 => _Body), Head) :- !, Head = Head0. 489rule_head(?=>(Head0, _Body), Head) :- !, Head = Head0. 490rule_head(Head, Head).
494list_clause(_Rule, Ref, _Source, Options) :- 495 option(source(true), Options), 496 ( clause_property(Ref, file(File)), 497 clause_property(Ref, line_count(Line)), 498 catch(source_clause_string(File, Line, String, Repositioned), 499 _, fail), 500 debug(listing(source), 'Read ~w:~d: "~s"~n', [File, Line, String]) 501 -> !, 502 ( Repositioned == true 503 -> comment('% From ~w:~d~n', [ File, Line ]) 504 ; true 505 ), 506 writeln(String) 507 ; decompiled 508 -> fail 509 ; asserta(decompiled), 510 comment('% From database (decompiled)~n', []), 511 fail % try next clause 512 ). 513list_clause(Module:(Head:-Body), Ref, Source, Options) :- 514 !, 515 list_clause(Module:Head, Body, :-, Ref, Source, Options). 516list_clause(Module:(Head=>Body), Ref, Source, Options) :- 517 list_clause(Module:Head, Body, =>, Ref, Source, Options). 518list_clause(Module:Head, Ref, Source, Options) :- 519 !, 520 list_clause(Module:Head, true, :-, Ref, Source, Options). 521 522list_clause(Module:Head, Body, Neck, Ref, Source, Options) :- 523 restore_variable_names(Module, Head, Body, Ref, Options), 524 write_module(Module, Source, Head), 525 Rule =.. [Neck,Head,Body], 526 portray_clause(Rule).
variable_names(source) is true.533restore_variable_names(Module, Head, Body, Ref, Options) :- 534 option(variable_names(source), Options, source), 535 catch(clause_info(Ref, _, _, _, 536 [ head(QHead), 537 body(Body), 538 variable_names(Bindings) 539 ]), 540 _, true), 541 unify_head(Module, Head, QHead), 542 !, 543 bind_vars(Bindings), 544 name_other_vars((Head:-Body), Bindings). 545restore_variable_names(_,_,_,_,_). 546 547unify_head(Module, Head, Module:Head) :- 548 !. 549unify_head(_, Head, Head) :- 550 !. 551unify_head(_, _, _). 552 553bind_vars([]) :- 554 !. 555bind_vars([Name = Var|T]) :- 556 ignore(Var = '$VAR'(Name)), 557 bind_vars(T).
564name_other_vars(Term, Bindings) :- 565 term_singletons(Term, Singletons), 566 bind_singletons(Singletons), 567 term_variables(Term, Vars), 568 name_vars(Vars, 0, Bindings). 569 570bind_singletons([]). 571bind_singletons(['$VAR'('_')|T]) :- 572 bind_singletons(T). 573 574name_vars([], _, _). 575name_vars([H|T], N, Bindings) :- 576 between(N, infinite, N2), 577 var_name(N2, Name), 578 \+ memberchk(Name=_, Bindings), 579 !, 580 H = '$VAR'(N2), 581 N3 is N2 + 1, 582 name_vars(T, N3, Bindings). 583 584var_name(I, Name) :- % must be kept in sync with writeNumberVar() 585 L is (I mod 26)+0'A, 586 N is I // 26, 587 ( N == 0 588 -> char_code(Name, L) 589 ; format(atom(Name), '~c~d', [L, N]) 590 ). 591 592write_module(Module, Context, Head) :- 593 hide_module(Module, Context, Head), 594 !. 595write_module(Module, _, _) :- 596 format('~q:', [Module]). 597 598hide_module(system, Module, Head) :- 599 predicate_property(Module:Head, imported_from(M)), 600 predicate_property(system:Head, imported_from(M)), 601 !. 602hide_module(Module, Module, _) :- !. 603 604notify_changed(Pred, Context) :- 605 strip_module(Pred, user, Head), 606 predicate_property(Head, built_in), 607 \+ predicate_property(Head, (dynamic)), 608 !, 609 decl_term(Pred, Context, Decl), 610 comment('% NOTE: system definition has been overruled for ~q~n', 611 [Decl]). 612notify_changed(_, _).
619source_clause_string(File, Line, String, Repositioned) :- 620 open_source(File, Line, Stream, Repositioned), 621 stream_property(Stream, position(Start)), 622 '$raw_read'(Stream, _TextWithoutComments), 623 stream_property(Stream, position(End)), 624 stream_position_data(char_count, Start, StartChar), 625 stream_position_data(char_count, End, EndChar), 626 Length is EndChar - StartChar, 627 set_stream_position(Stream, Start), 628 read_string(Stream, Length, String), 629 skip_blanks_and_comments(Stream, blank). 630 631skip_blanks_and_comments(Stream, _) :- 632 at_end_of_stream(Stream), 633 !. 634skip_blanks_and_comments(Stream, State0) :- 635 peek_string(Stream, 80, String), 636 string_chars(String, Chars), 637 phrase(blanks_and_comments(State0, State), Chars, Rest), 638 ( Rest == [] 639 -> read_string(Stream, 80, _), 640 skip_blanks_and_comments(Stream, State) 641 ; length(Chars, All), 642 length(Rest, RLen), 643 Skip is All-RLen, 644 read_string(Stream, Skip, _) 645 ). 646 647blanks_and_comments(State0, State) --> 648 [C], 649 { transition(C, State0, State1) }, 650 !, 651 blanks_and_comments(State1, State). 652blanks_and_comments(State, State) --> 653 []. 654 655transition(C, blank, blank) :- 656 char_type(C, space). 657transition('%', blank, line_comment). 658transition('\n', line_comment, blank). 659transition(_, line_comment, line_comment). 660transition('/', blank, comment_0). 661transition('/', comment(N), comment(N,/)). 662transition('*', comment(N,/), comment(N1)) :- 663 N1 is N + 1. 664transition('*', comment_0, comment(1)). 665transition('*', comment(N), comment(N,*)). 666transition('/', comment(N,*), State) :- 667 ( N == 1 668 -> State = blank 669 ; N2 is N - 1, 670 State = comment(N2) 671 ). 672 673 674open_source(File, Line, Stream, Repositioned) :- 675 source_stream(File, Stream, Pos0, Repositioned), 676 line_count(Stream, Line0), 677 ( Line >= Line0 678 -> Skip is Line - Line0 679 ; set_stream_position(Stream, Pos0), 680 Skip is Line - 1 681 ), 682 debug(listing(source), '~w: skip ~d to ~d', [File, Line0, Line]), 683 ( Skip =\= 0 684 -> Repositioned = true 685 ; true 686 ), 687 forall(between(1, Skip, _), 688 skip(Stream, 0'\n)). 689 690:- thread_local 691 opened_source/3, 692 decompiled/0. 693 694source_stream(File, Stream, Pos0, _) :- 695 opened_source(File, Stream, Pos0), 696 !. 697source_stream(File, Stream, Pos0, true) :- 698 open(File, read, Stream), 699 stream_property(Stream, position(Pos0)), 700 asserta(opened_source(File, Stream, Pos0)). 701 702close_sources :- 703 retractall(decompiled), 704 forall(retract(opened_source(_,Stream,_)), 705 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.736% The prolog_list_goal/1 hook is a dubious as it may lead to 737% confusion if the heads relates to other bodies. For now it is 738% only used for XPCE methods and works just nice. 739% 740% Not really ... It may confuse the source-level debugger. 741 742%portray_clause(Head :- _Body) :- 743% user:prolog_list_goal(Head), !. 744portray_clause(Term) :- 745 current_output(Out), 746 portray_clause(Out, Term). 747 748portray_clause(Stream, Term) :- 749 must_be(stream, Stream), 750 portray_clause(Stream, Term, []). 751 752portray_clause(Stream, Term, M:Options) :- 753 must_be(list, Options), 754 meta_options(is_meta, M:Options, QOptions), 755 \+ \+ name_vars_and_portray_clause(Stream, Term, QOptions). 756 757name_vars_and_portray_clause(Stream, Term, Options) :- 758 term_attvars(Term, []), 759 !, 760 clause_vars(Term, Options), 761 do_portray_clause(Stream, Term, Options). 762name_vars_and_portray_clause(Stream, Term, Options) :- 763 option(variable_names(Bindings), Options), 764 !, 765 copy_term_nat(Term+Bindings, Copy+BCopy), 766 bind_vars(BCopy), 767 name_other_vars(Copy, BCopy), 768 do_portray_clause(Stream, Copy, Options). 769name_vars_and_portray_clause(Stream, Term, Options) :- 770 copy_term_nat(Term, Copy), 771 clause_vars(Copy, Options), 772 do_portray_clause(Stream, Copy, Options). 773 774clause_vars(Clause, Options) :- 775 option(variable_names(Bindings), Options), 776 !, 777 bind_vars(Bindings), 778 name_other_vars(Clause, Bindings). 779clause_vars(Clause, _) :- 780 numbervars(Clause, 0, _, 781 [ singletons(true) 782 ]). 783 784is_meta(portray_goal). 785 786do_portray_clause(Out, Var, Options) :- 787 var(Var), 788 !, 789 option(indent(LeftMargin), Options, 0), 790 indent(Out, LeftMargin), 791 pprint(Out, Var, 1200, Options). 792do_portray_clause(Out, (Head :- true), Options) :- 793 !, 794 option(indent(LeftMargin), Options, 0), 795 indent(Out, LeftMargin), 796 pprint(Out, Head, 1200, Options), 797 full_stop(Out). 798do_portray_clause(Out, Term, Options) :- 799 clause_term(Term, Head, Neck, Body), 800 !, 801 option(indent(LeftMargin), Options, 0), 802 inc_indent(LeftMargin, 1, Indent), 803 infix_op(Neck, RightPri, LeftPri), 804 indent(Out, LeftMargin), 805 pprint(Out, Head, LeftPri, Options), 806 format(Out, ' ~w', [Neck]), 807 ( nonvar(Body), 808 Body = Module:LocalBody, 809 \+ primitive(LocalBody) 810 -> nlindent(Out, Indent), 811 format(Out, '~q', [Module]), 812 '$put_token'(Out, :), 813 nlindent(Out, Indent), 814 write(Out, '( '), 815 inc_indent(Indent, 1, BodyIndent), 816 portray_body(LocalBody, BodyIndent, noindent, 1200, Out, Options), 817 nlindent(Out, Indent), 818 write(Out, ')') 819 ; setting(listing:body_indentation, BodyIndent0), 820 BodyIndent is LeftMargin+BodyIndent0, 821 portray_body(Body, BodyIndent, indent, RightPri, Out, Options) 822 ), 823 full_stop(Out). 824do_portray_clause(Out, (:-Directive), Options) :- 825 wrapped_list_directive(Directive), 826 !, 827 Directive =.. [Name, Arg, List], 828 option(indent(LeftMargin), Options, 0), 829 indent(Out, LeftMargin), 830 format(Out, ':- ~q(', [Name]), 831 line_position(Out, Indent), 832 format(Out, '~q,', [Arg]), 833 nlindent(Out, Indent), 834 portray_list(List, Indent, Out, Options), 835 write(Out, ').\n'). 836do_portray_clause(Out, Clause, Options) :- 837 directive(Clause, Op, Directive), 838 !, 839 option(indent(LeftMargin), Options, 0), 840 indent(Out, LeftMargin), 841 format(Out, '~w ', [Op]), 842 DIndent is LeftMargin+3, 843 portray_body(Directive, DIndent, noindent, 1199, Out, Options), 844 full_stop(Out). 845do_portray_clause(Out, Fact, Options) :- 846 option(indent(LeftMargin), Options, 0), 847 indent(Out, LeftMargin), 848 portray_body(Fact, LeftMargin, noindent, 1200, Out, Options), 849 full_stop(Out). 850 851clause_term((Head:-Body), Head, :-, Body). 852clause_term((Head=>Body), Head, =>, Body). 853clause_term(?=>(Head,Body), Head, ?=>, Body). 854clause_term((Head-->Body), Head, -->, Body). 855 856full_stop(Out) :- 857 '$put_token'(Out, '.'), 858 nl(Out). 859 860directive((:- Directive), :-, Directive). 861directive((?- Directive), ?-, Directive). 862 863wrapped_list_directive(module(_,_)). 864%wrapped_list_directive(use_module(_,_)). 865%wrapped_list_directive(autoload(_,_)).
872portray_body(Var, _, _, Pri, Out, Options) :- 873 var(Var), 874 !, 875 pprint(Out, Var, Pri, Options). 876portray_body(!, _, _, _, Out, _) :- 877 setting(listing:cut_on_same_line, true), 878 !, 879 write(Out, ' !'). 880portray_body((!, Clause), Indent, _, Pri, Out, Options) :- 881 setting(listing:cut_on_same_line, true), 882 \+ term_needs_braces((_,_), Pri), 883 !, 884 write(Out, ' !,'), 885 portray_body(Clause, Indent, indent, 1000, Out, Options). 886portray_body(Term, Indent, indent, Pri, Out, Options) :- 887 !, 888 nlindent(Out, Indent), 889 portray_body(Term, Indent, noindent, Pri, Out, Options). 890portray_body(Or, Indent, _, _, Out, Options) :- 891 or_layout(Or), 892 !, 893 write(Out, '( '), 894 portray_or(Or, Indent, 1200, Out, Options), 895 nlindent(Out, Indent), 896 write(Out, ')'). 897portray_body(Term, Indent, _, Pri, Out, Options) :- 898 term_needs_braces(Term, Pri), 899 !, 900 write(Out, '( '), 901 ArgIndent is Indent + 2, 902 portray_body(Term, ArgIndent, noindent, 1200, Out, Options), 903 nlindent(Out, Indent), 904 write(Out, ')'). 905portray_body(((AB),C), Indent, _, _Pri, Out, Options) :- 906 nonvar(AB), 907 AB = (A,B), 908 !, 909 infix_op(',', LeftPri, RightPri), 910 portray_body(A, Indent, noindent, LeftPri, Out, Options), 911 write(Out, ','), 912 portray_body((B,C), Indent, indent, RightPri, Out, Options). 913portray_body((A,B), Indent, _, _Pri, Out, Options) :- 914 !, 915 infix_op(',', LeftPri, RightPri), 916 portray_body(A, Indent, noindent, LeftPri, Out, Options), 917 write(Out, ','), 918 portray_body(B, Indent, indent, RightPri, Out, Options). 919portray_body(\+(Goal), Indent, _, _Pri, Out, Options) :- 920 !, 921 write(Out, \+), write(Out, ' '), 922 prefix_op(\+, ArgPri), 923 ArgIndent is Indent+3, 924 portray_body(Goal, ArgIndent, noindent, ArgPri, Out, Options). 925portray_body(Call, _, _, _, Out, Options) :- % requires knowledge on the module! 926 m_callable(Call), 927 option(module(M), Options, user), 928 predicate_property(M:Call, meta_predicate(Meta)), 929 !, 930 portray_meta(Out, Call, Meta, Options). 931portray_body(Clause, _, _, Pri, Out, Options) :- 932 pprint(Out, Clause, Pri, Options). 933 934m_callable(Term) :- 935 strip_module(Term, _, Plain), 936 callable(Plain), 937 Plain \= (_:_). 938 939term_needs_braces(Term, Pri) :- 940 callable(Term), 941 functor(Term, Name, _Arity), 942 current_op(OpPri, _Type, Name), 943 OpPri > Pri, 944 !.
948portray_or(Term, Indent, Pri, Out, Options) :- 949 term_needs_braces(Term, Pri), 950 !, 951 inc_indent(Indent, 1, NewIndent), 952 write(Out, '( '), 953 portray_or(Term, NewIndent, Out, Options), 954 nlindent(Out, NewIndent), 955 write(Out, ')'). 956portray_or(Term, Indent, _Pri, Out, Options) :- 957 or_layout(Term), 958 !, 959 portray_or(Term, Indent, Out, Options). 960portray_or(Term, Indent, Pri, Out, Options) :- 961 inc_indent(Indent, 1, NestIndent), 962 portray_body(Term, NestIndent, noindent, Pri, Out, Options). 963 964 965portray_or((If -> Then ; Else), Indent, Out, Options) :- 966 !, 967 inc_indent(Indent, 1, NestIndent), 968 infix_op((->), LeftPri, RightPri), 969 portray_body(If, NestIndent, noindent, LeftPri, Out, Options), 970 nlindent(Out, Indent), 971 write(Out, '-> '), 972 portray_body(Then, NestIndent, noindent, RightPri, Out, Options), 973 nlindent(Out, Indent), 974 write(Out, '; '), 975 infix_op(;, _LeftPri, RightPri2), 976 portray_or(Else, Indent, RightPri2, Out, Options). 977portray_or((If *-> Then ; Else), Indent, Out, Options) :- 978 !, 979 inc_indent(Indent, 1, NestIndent), 980 infix_op((*->), LeftPri, RightPri), 981 portray_body(If, NestIndent, noindent, LeftPri, Out, Options), 982 nlindent(Out, Indent), 983 write(Out, '*-> '), 984 portray_body(Then, NestIndent, noindent, RightPri, Out, Options), 985 nlindent(Out, Indent), 986 write(Out, '; '), 987 infix_op(;, _LeftPri, RightPri2), 988 portray_or(Else, Indent, RightPri2, Out, Options). 989portray_or((If -> Then), Indent, Out, Options) :- 990 !, 991 inc_indent(Indent, 1, NestIndent), 992 infix_op((->), LeftPri, RightPri), 993 portray_body(If, NestIndent, noindent, LeftPri, Out, Options), 994 nlindent(Out, Indent), 995 write(Out, '-> '), 996 portray_or(Then, Indent, RightPri, Out, Options). 997portray_or((If *-> Then), 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_or(Then, Indent, RightPri, Out, Options). 1005portray_or((A;B), Indent, Out, Options) :- 1006 !, 1007 inc_indent(Indent, 1, NestIndent), 1008 infix_op(;, LeftPri, RightPri), 1009 portray_body(A, NestIndent, noindent, LeftPri, Out, Options), 1010 nlindent(Out, Indent), 1011 write(Out, '; '), 1012 portray_or(B, Indent, RightPri, Out, Options). 1013portray_or((A|B), Indent, Out, Options) :- 1014 !, 1015 inc_indent(Indent, 1, NestIndent), 1016 infix_op('|', LeftPri, RightPri), 1017 portray_body(A, NestIndent, noindent, LeftPri, Out, Options), 1018 nlindent(Out, Indent), 1019 write(Out, '| '), 1020 portray_or(B, Indent, RightPri, Out, Options).
1028infix_op(Op, Left, Right) :- 1029 current_op(Pri, Assoc, Op), 1030 infix_assoc(Assoc, LeftMin, RightMin), 1031 !, 1032 Left is Pri - LeftMin, 1033 Right is Pri - RightMin. 1034 1035infix_assoc(xfx, 1, 1). 1036infix_assoc(xfy, 1, 0). 1037infix_assoc(yfx, 0, 1). 1038 1039prefix_op(Op, ArgPri) :- 1040 current_op(Pri, Assoc, Op), 1041 pre_assoc(Assoc, ArgMin), 1042 !, 1043 ArgPri is Pri - ArgMin. 1044 1045pre_assoc(fx, 1). 1046pre_assoc(fy, 0). 1047 1048postfix_op(Op, ArgPri) :- 1049 current_op(Pri, Assoc, Op), 1050 post_assoc(Assoc, ArgMin), 1051 !, 1052 ArgPri is Pri - ArgMin. 1053 1054post_assoc(xf, 1). 1055post_assoc(yf, 0).
1064or_layout(Var) :- 1065 var(Var), !, fail. 1066or_layout((_;_)). 1067or_layout((_->_)). 1068or_layout((_*->_)). 1069 1070primitive(G) :- 1071 or_layout(G), !, fail. 1072primitive((_,_)) :- !, fail. 1073primitive(_).
1082portray_meta(Out, Call, Meta, Options) :- 1083 contains_non_primitive_meta_arg(Call, Meta), 1084 !, 1085 Call =.. [Name|Args], 1086 Meta =.. [_|Decls], 1087 format(Out, '~q(', [Name]), 1088 line_position(Out, Indent), 1089 portray_meta_args(Decls, Args, Indent, Out, Options), 1090 format(Out, ')', []). 1091portray_meta(Out, Call, _, Options) :- 1092 pprint(Out, Call, 999, Options). 1093 1094contains_non_primitive_meta_arg(Call, Decl) :- 1095 arg(I, Call, CA), 1096 arg(I, Decl, DA), 1097 integer(DA), 1098 \+ primitive(CA), 1099 !. 1100 1101portray_meta_args([], [], _, _, _). 1102portray_meta_args([D|DT], [A|AT], Indent, Out, Options) :- 1103 portray_meta_arg(D, A, Out, Options), 1104 ( DT == [] 1105 -> true 1106 ; format(Out, ',', []), 1107 nlindent(Out, Indent), 1108 portray_meta_args(DT, AT, Indent, Out, Options) 1109 ). 1110 1111portray_meta_arg(I, A, Out, Options) :- 1112 integer(I), 1113 !, 1114 line_position(Out, Indent), 1115 portray_body(A, Indent, noindent, 999, Out, Options). 1116portray_meta_arg(_, A, Out, Options) :- 1117 pprint(Out, A, 999, Options).
[ element1, [ element1 element2, OR | tail ] ]
1127portray_list([], _, Out, _) :- 1128 !, 1129 write(Out, []). 1130portray_list(List, Indent, Out, Options) :- 1131 write(Out, '[ '), 1132 EIndent is Indent + 2, 1133 portray_list_elements(List, EIndent, Out, Options), 1134 nlindent(Out, Indent), 1135 write(Out, ']'). 1136 1137portray_list_elements([H|T], EIndent, Out, Options) :- 1138 pprint(Out, H, 999, Options), 1139 ( T == [] 1140 -> true 1141 ; nonvar(T), T = [_|_] 1142 -> write(Out, ','), 1143 nlindent(Out, EIndent), 1144 portray_list_elements(T, EIndent, Out, Options) 1145 ; Indent is EIndent - 2, 1146 nlindent(Out, Indent), 1147 write(Out, '| '), 1148 pprint(Out, T, 999, Options) 1149 ).
1163pprint(Out, Term, _, Options) :- 1164 nonvar(Term), 1165 Term = {}(Arg), 1166 line_position(Out, Indent), 1167 ArgIndent is Indent + 2, 1168 format(Out, '{ ', []), 1169 portray_body(Arg, ArgIndent, noident, 1000, Out, Options), 1170 nlindent(Out, Indent), 1171 format(Out, '}', []). 1172pprint(Out, Term, Pri, Options) :- 1173 ( compound(Term) 1174 -> compound_name_arity(Term, _, Arity), 1175 Arity > 0 1176 ; is_dict(Term) 1177 ), 1178 \+ nowrap_term(Term), 1179 line_width(Width), 1180 Width > 0, 1181 ( write_size(Term, Len, _Height, [max_width(Width)|Options]) 1182 -> true 1183 ; Len = Width 1184 ), 1185 line_position(Out, Indent), 1186 Indent + Len > Width, 1187 Len > Width/4, % ad-hoc rule for deeply nested goals 1188 !, 1189 pprint_wrapped(Out, Term, Pri, Options). 1190pprint(Out, Term, Pri, Options) :- 1191 listing_write_options(Pri, WrtOptions, Options), 1192 write_term(Out, Term, 1193 [ blobs(portray), 1194 portray_goal(portray_blob) 1195 | WrtOptions 1196 ]). 1197 1198:- public portray_blob/2. 1199portray_blob(Blob, _Options) :- 1200 blob(Blob, _), 1201 \+ atom(Blob), 1202 !, 1203 format(string(S), '~q', [Blob]), 1204 format('~q', ['$BLOB'(S)]). 1205 1206nowrap_term('$VAR'(_)) :- !. 1207nowrap_term(_{}) :- !. % empty dict 1208nowrap_term(Term) :- 1209 functor(Term, Name, Arity), 1210 current_op(_, _, Name), 1211 ( Arity == 2 1212 -> infix_op(Name, _, _) 1213 ; Arity == 1 1214 -> ( prefix_op(Name, _) 1215 -> true 1216 ; postfix_op(Name, _) 1217 ) 1218 ). 1219 1220 1221pprint_wrapped(Out, Term, _, Options) :- 1222 Term = [_|_], 1223 !, 1224 line_position(Out, Indent), 1225 portray_list(Term, Indent, Out, Options). 1226pprint_wrapped(Out, Dict, _, Options) :- 1227 is_dict(Dict), 1228 !, 1229 dict_pairs(Dict, Tag, Pairs), 1230 pprint(Out, Tag, 1200, Options), 1231 format(Out, '{ ', []), 1232 line_position(Out, Indent), 1233 pprint_nv(Pairs, Indent, Out, Options), 1234 nlindent(Out, Indent-2), 1235 format(Out, '}', []). 1236pprint_wrapped(Out, Term, _, Options) :- 1237 Term =.. [Name|Args], 1238 format(Out, '~q(', [Name]), 1239 line_position(Out, Indent), 1240 pprint_args(Args, Indent, Out, Options), 1241 format(Out, ')', []). 1242 1243pprint_args([], _, _, _). 1244pprint_args([H|T], Indent, Out, Options) :- 1245 pprint(Out, H, 999, Options), 1246 ( T == [] 1247 -> true 1248 ; format(Out, ',', []), 1249 nlindent(Out, Indent), 1250 pprint_args(T, Indent, Out, Options) 1251 ). 1252 1253 1254pprint_nv([], _, _, _). 1255pprint_nv([Name-Value|T], Indent, Out, Options) :- 1256 pprint(Out, Name, 999, Options), 1257 format(Out, ':', []), 1258 pprint(Out, Value, 999, Options), 1259 ( T == [] 1260 -> true 1261 ; format(Out, ',', []), 1262 nlindent(Out, Indent), 1263 pprint_nv(T, Indent, Out, Options) 1264 ).
1272listing_write_options(Pri,
1273 [ quoted(true),
1274 numbervars(true),
1275 priority(Pri),
1276 spacing(next_argument)
1277 | Options
1278 ],
1279 Options).1287nlindent(Out, N) :- 1288 nl(Out), 1289 indent(Out, N). 1290 1291indent(Out, N) :- 1292 setting(listing:tab_distance, D), 1293 ( D =:= 0 1294 -> tab(Out, N) 1295 ; Tab is N // D, 1296 Space is N mod D, 1297 put_tabs(Out, Tab), 1298 tab(Out, Space) 1299 ). 1300 1301put_tabs(Out, N) :- 1302 N > 0, 1303 !, 1304 put(Out, 0'\t), 1305 NN is N - 1, 1306 put_tabs(Out, NN). 1307put_tabs(_, _). 1308 1309line_width(Width) :- 1310 stream_property(current_output, tty(true)), 1311 catch(tty_size(_Rows, Cols), error(_,_), fail), 1312 !, 1313 Width is Cols - 2. 1314line_width(Width) :- 1315 setting(listing:line_width, Width), 1316 !. 1317line_width(78).
1324inc_indent(Indent0, Inc, Indent) :- 1325 Indent is Indent0 + Inc*4. 1326 1327:- multifile 1328 sandbox:safe_meta/2. 1329 1330sandbox:safe_meta(listing(What), []) :- 1331 not_qualified(What). 1332 1333not_qualified(Var) :- 1334 var(Var), 1335 !. 1336not_qualified(_:_) :- !, fail. 1337not_qualified(_).
1344comment(Format, Args) :- 1345 stream_property(current_output, tty(true)), 1346 setting(listing:comment_ansi_attributes, Attributes), 1347 Attributes \== [], 1348 !, 1349 ansi_format(Attributes, Format, Args). 1350comment(Format, Args) :- 1351 format(Format, Args). 1352 1353 /******************************* 1354 * MESSAGES * 1355 *******************************/ 1356 1357:- multifile(prolog:message//1). 1358 1359prologmessage(listing(thread_local(Pred, Thread, timeout(TimeOut)))) --> 1360 { pi_head(PI, Pred) }, 1361 [ 'Could not list ~p for thread ~p: timeout after ~p sec.'- 1362 [PI, Thread, TimeOut] 1363 ]
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.