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) 2001-2019, University of Amsterdam 7 VU University Amsterdam 8 CWI, Amsterdam 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_listing, 38 [ listing/0, 39 listing/1, % :Spec 40 listing/2, % :Spec, +Options 41 portray_clause/1, % +Clause 42 portray_clause/2, % +Stream, +Clause 43 portray_clause/3 % +Stream, +Clause, +Options 44 ]). 45:- use_module(library(settings),[setting/4,setting/2]). 46 47:- autoload(library(ansi_term),[ansi_format/3]). 48:- autoload(library(apply),[foldl/4]). 49:- autoload(library(debug),[debug/3]). 50:- autoload(library(error),[instantiation_error/1,must_be/2]). 51:- autoload(library(lists),[member/2]). 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]). 55 56%:- set_prolog_flag(generate_debug_info, false). 57 58:- module_transparent 59 listing/0. 60:- meta_predicate 61 listing(), 62 listing(, ), 63 portray_clause(,,). 64 65:- predicate_options(portray_clause/3, 3, 66 [ indent(nonneg), 67 pass_to(system:write_term/3, 3) 68 ]). 69 70:- multifile 71 prolog:locate_clauses/2. % +Spec, -ClauseRefList
102:- setting(listing:body_indentation, nonneg, 4, 103 'Indentation used goals in the body'). 104:- setting(listing:tab_distance, nonneg, 0, 105 'Distance between tab-stops. 0 uses only spaces'). 106:- setting(listing:cut_on_same_line, boolean, false, 107 'Place cuts (!) on the same line'). 108:- setting(listing:line_width, nonneg, 78, 109 'Width of a line. 0 is infinite'). 110:- setting(listing:comment_ansi_attributes, list, [fg(green)], 111 'ansi_format/3 attributes to print comments').
mymodule, use one of the calls below.
?- mymodule:listing. ?- listing(mymodule:_).
125listing :- 126 context_module(Context), 127 list_module(Context, []). 128 129list_module(Module, Options) :- 130 ( current_predicate(_, Module:Pred), 131 \+ predicate_property(Module:Pred, imported_from(_)), 132 strip_module(Pred, _Module, Head), 133 functor(Head, Name, _Arity), 134 ( ( predicate_property(Module:Pred, built_in) 135 ; sub_atom(Name, 0, _, _, $) 136 ) 137 -> current_prolog_flag(access_level, system) 138 ; true 139 ), 140 nl, 141 list_predicate(Module:Head, Module, Options), 142 fail 143 ; true 144 ).
?- 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)]).
190listing(Spec) :- 191 listing(Spec, []). 192 193listing(Spec, Options) :- 194 call_cleanup( 195 listing_(Spec, Options), 196 close_sources). 197 198listing_(M:Spec, Options) :- 199 var(Spec), 200 !, 201 list_module(M, Options). 202listing_(M:List, Options) :- 203 is_list(List), 204 !, 205 forall(member(Spec, List), 206 listing_(M:Spec, Options)). 207listing_(X, Options) :- 208 ( prolog:locate_clauses(X, ClauseRefs) 209 -> strip_module(X, Context, _), 210 list_clauserefs(ClauseRefs, Context, Options) 211 ; '$find_predicate'(X, Preds), 212 list_predicates(Preds, X, Options) 213 ). 214 215list_clauserefs([], _, _) :- !. 216list_clauserefs([H|T], Context, Options) :- 217 !, 218 list_clauserefs(H, Context, Options), 219 list_clauserefs(T, Context, Options). 220list_clauserefs(Ref, Context, Options) :- 221 @(rule(_, Rule, Ref), Context), 222 list_clause(Rule, Ref, Context, Options).
226list_predicates(PIs, Context:X, Options) :- 227 member(PI, PIs), 228 pi_to_head(PI, Pred), 229 unify_args(Pred, X), 230 list_define(Pred, DefPred), 231 list_predicate(DefPred, Context, Options), 232 nl, 233 fail. 234list_predicates(_, _, _). 235 236list_define(Head, LoadModule:Head) :- 237 compound(Head), 238 Head \= (_:_), 239 functor(Head, Name, Arity), 240 '$find_library'(_, Name, Arity, LoadModule, Library), 241 !, 242 use_module(Library, []). 243list_define(M:Pred, DefM:Pred) :- 244 '$define_predicate'(M:Pred), 245 ( predicate_property(M:Pred, imported_from(DefM)) 246 -> true 247 ; DefM = M 248 ). 249 250pi_to_head(PI, _) :- 251 var(PI), 252 !, 253 instantiation_error(PI). 254pi_to_head(M:PI, M:Head) :- 255 !, 256 pi_to_head(PI, Head). 257pi_to_head(Name/Arity, Head) :- 258 functor(Head, Name, Arity). 259 260 261% Unify the arguments of the specification with the given term, 262% so we can partially instantate the head. 263 264unify_args(_, _/_) :- !. % Name/arity spec 265unify_args(X, X) :- !. 266unify_args(_:X, X) :- !. 267unify_args(_, _). 268 269list_predicate(Pred, Context, _) :- 270 predicate_property(Pred, undefined), 271 !, 272 decl_term(Pred, Context, Decl), 273 comment('% Undefined: ~q~n', [Decl]). 274list_predicate(Pred, Context, _) :- 275 predicate_property(Pred, foreign), 276 !, 277 decl_term(Pred, Context, Decl), 278 comment('% Foreign: ~q~n', [Decl]). 279list_predicate(Pred, Context, Options) :- 280 notify_changed(Pred, Context), 281 list_declarations(Pred, Context), 282 list_clauses(Pred, Context, Options). 283 284decl_term(Pred, Context, Decl) :- 285 strip_module(Pred, Module, Head), 286 functor(Head, Name, Arity), 287 ( hide_module(Module, Context, Head) 288 -> Decl = Name/Arity 289 ; Decl = Module:Name/Arity 290 ). 291 292 293decl(thread_local, thread_local). 294decl(dynamic, dynamic). 295decl(volatile, volatile). 296decl(multifile, multifile). 297decl(public, public).
307declaration(Pred, Source, Decl) :- 308 predicate_property(Pred, tabled), 309 Pred = M:Head, 310 ( M:'$table_mode'(Head, Head, _) 311 -> decl_term(Pred, Source, Funct), 312 table_options(Pred, Funct, TableDecl), 313 Decl = table(TableDecl) 314 ; comment('% tabled using answer subsumption~n', []), 315 fail % TBD 316 ). 317declaration(Pred, Source, Decl) :- 318 decl(Prop, Declname), 319 predicate_property(Pred, Prop), 320 decl_term(Pred, Source, Funct), 321 Decl =.. [ Declname, Funct ]. 322declaration(Pred, Source, Decl) :- 323 predicate_property(Pred, meta_predicate(Head)), 324 strip_module(Pred, Module, _), 325 ( (Module == system; Source == Module) 326 -> Decl = meta_predicate(Head) 327 ; Decl = meta_predicate(Module:Head) 328 ), 329 ( meta_implies_transparent(Head) 330 -> ! % hide transparent 331 ; true 332 ). 333declaration(Pred, Source, Decl) :- 334 predicate_property(Pred, transparent), 335 decl_term(Pred, Source, PI), 336 Decl = module_transparent(PI).
343meta_implies_transparent(Head):- 344 compound(Head), 345 arg(_, Head, Arg), 346 implies_transparent(Arg), 347 !. 348 349implies_transparent(Arg) :- 350 integer(Arg), 351 !. 352implies_transparent(:). 353implies_transparent(//). 354implies_transparent(^). 355 356table_options(Pred, Decl0, as(Decl0, Options)) :- 357 findall(Flag, predicate_property(Pred, tabled(Flag)), [F0|Flags]), 358 !, 359 foldl(table_option, Flags, F0, Options). 360table_options(_, Decl, Decl). 361 362table_option(Flag, X, (Flag,X)). 363 364list_declarations(Pred, Source) :- 365 findall(Decl, declaration(Pred, Source, Decl), Decls), 366 ( Decls == [] 367 -> true 368 ; write_declarations(Decls, Source), 369 format('~n', []) 370 ). 371 372 373write_declarations([], _) :- !. 374write_declarations([H|T], Module) :- 375 format(':- ~q.~n', [H]), 376 write_declarations(T, Module). 377 378list_clauses(Pred, Source, Options) :- 379 strip_module(Pred, Module, Head), 380 most_general_goal(Head, GenHead), 381 forall(( rule(Module:GenHead, Rule, Ref), 382 \+ \+ rule_head(Rule, Head) 383 ), 384 list_clause(Module:Rule, Ref, Source, Options)). 385 386rule_head((Head0 :- _Body), Head) :- !, Head = Head0. 387rule_head((Head0,_Cond => _Body), Head) :- !, Head = Head0. 388rule_head((Head0 => _Body), Head) :- !, Head = Head0. 389rule_head(?=>(Head0, _Body), Head) :- !, Head = Head0. 390rule_head(Head, Head). 391 392list_clause(_Rule, Ref, _Source, Options) :- 393 option(source(true), Options), 394 ( clause_property(Ref, file(File)), 395 clause_property(Ref, line_count(Line)), 396 catch(source_clause_string(File, Line, String, Repositioned), 397 _, fail), 398 debug(listing(source), 'Read ~w:~d: "~s"~n', [File, Line, String]) 399 -> !, 400 ( Repositioned == true 401 -> comment('% From ~w:~d~n', [ File, Line ]) 402 ; true 403 ), 404 writeln(String) 405 ; decompiled 406 -> fail 407 ; asserta(decompiled), 408 comment('% From database (decompiled)~n', []), 409 fail % try next clause 410 ). 411list_clause(Module:(Head:-Body), Ref, Source, Options) :- 412 !, 413 list_clause(Module:Head, Body, :-, Ref, Source, Options). 414list_clause(Module:(Head=>Body), Ref, Source, Options) :- 415 list_clause(Module:Head, Body, =>, Ref, Source, Options). 416list_clause(Module:Head, Ref, Source, Options) :- 417 !, 418 list_clause(Module:Head, true, :-, Ref, Source, Options). 419 420list_clause(Module:Head, Body, Neck, Ref, Source, Options) :- 421 restore_variable_names(Module, Head, Body, Ref, Options), 422 write_module(Module, Source, Head), 423 Rule =.. [Neck,Head,Body], 424 portray_clause(Rule).
variable_names(source) is true.431restore_variable_names(Module, Head, Body, Ref, Options) :- 432 option(variable_names(source), Options, source), 433 catch(clause_info(Ref, _, _, _, 434 [ head(QHead), 435 body(Body), 436 variable_names(Bindings) 437 ]), 438 _, true), 439 unify_head(Module, Head, QHead), 440 !, 441 bind_vars(Bindings), 442 name_other_vars((Head:-Body), Bindings). 443restore_variable_names(_,_,_,_,_). 444 445unify_head(Module, Head, Module:Head) :- 446 !. 447unify_head(_, Head, Head) :- 448 !. 449unify_head(_, _, _). 450 451bind_vars([]) :- 452 !. 453bind_vars([Name = Var|T]) :- 454 ignore(Var = '$VAR'(Name)), 455 bind_vars(T).
462name_other_vars(Term, Bindings) :- 463 term_singletons(Term, Singletons), 464 bind_singletons(Singletons), 465 term_variables(Term, Vars), 466 name_vars(Vars, 0, Bindings). 467 468bind_singletons([]). 469bind_singletons(['$VAR'('_')|T]) :- 470 bind_singletons(T). 471 472name_vars([], _, _). 473name_vars([H|T], N, Bindings) :- 474 between(N, infinite, N2), 475 var_name(N2, Name), 476 \+ memberchk(Name=_, Bindings), 477 !, 478 H = '$VAR'(N2), 479 N3 is N2 + 1, 480 name_vars(T, N3, Bindings). 481 482var_name(I, Name) :- % must be kept in sync with writeNumberVar() 483 L is (I mod 26)+0'A, 484 N is I // 26, 485 ( N == 0 486 -> char_code(Name, L) 487 ; format(atom(Name), '~c~d', [L, N]) 488 ). 489 490write_module(Module, Context, Head) :- 491 hide_module(Module, Context, Head), 492 !. 493write_module(Module, _, _) :- 494 format('~q:', [Module]). 495 496hide_module(system, Module, Head) :- 497 predicate_property(Module:Head, imported_from(M)), 498 predicate_property(system:Head, imported_from(M)), 499 !. 500hide_module(Module, Module, _) :- !. 501 502notify_changed(Pred, Context) :- 503 strip_module(Pred, user, Head), 504 predicate_property(Head, built_in), 505 \+ predicate_property(Head, (dynamic)), 506 !, 507 decl_term(Pred, Context, Decl), 508 comment('% NOTE: system definition has been overruled for ~q~n', 509 [Decl]). 510notify_changed(_, _).
517source_clause_string(File, Line, String, Repositioned) :- 518 open_source(File, Line, Stream, Repositioned), 519 stream_property(Stream, position(Start)), 520 '$raw_read'(Stream, _TextWithoutComments), 521 stream_property(Stream, position(End)), 522 stream_position_data(char_count, Start, StartChar), 523 stream_position_data(char_count, End, EndChar), 524 Length is EndChar - StartChar, 525 set_stream_position(Stream, Start), 526 read_string(Stream, Length, String), 527 skip_blanks_and_comments(Stream, blank). 528 529skip_blanks_and_comments(Stream, _) :- 530 at_end_of_stream(Stream), 531 !. 532skip_blanks_and_comments(Stream, State0) :- 533 peek_string(Stream, 80, String), 534 string_chars(String, Chars), 535 phrase(blanks_and_comments(State0, State), Chars, Rest), 536 ( Rest == [] 537 -> read_string(Stream, 80, _), 538 skip_blanks_and_comments(Stream, State) 539 ; length(Chars, All), 540 length(Rest, RLen), 541 Skip is All-RLen, 542 read_string(Stream, Skip, _) 543 ). 544 545blanks_and_comments(State0, State) --> 546 [C], 547 { transition(C, State0, State1) }, 548 !, 549 blanks_and_comments(State1, State). 550blanks_and_comments(State, State) --> 551 []. 552 553transition(C, blank, blank) :- 554 char_type(C, space). 555transition('%', blank, line_comment). 556transition('\n', line_comment, blank). 557transition(_, line_comment, line_comment). 558transition('/', blank, comment_0). 559transition('/', comment(N), comment(N,/)). 560transition('*', comment(N,/), comment(N1)) :- 561 N1 is N + 1. 562transition('*', comment_0, comment(1)). 563transition('*', comment(N), comment(N,*)). 564transition('/', comment(N,*), State) :- 565 ( N == 1 566 -> State = blank 567 ; N2 is N - 1, 568 State = comment(N2) 569 ). 570 571 572open_source(File, Line, Stream, Repositioned) :- 573 source_stream(File, Stream, Pos0, Repositioned), 574 line_count(Stream, Line0), 575 ( Line >= Line0 576 -> Skip is Line - Line0 577 ; set_stream_position(Stream, Pos0), 578 Skip is Line - 1 579 ), 580 debug(listing(source), '~w: skip ~d to ~d', [File, Line0, Line]), 581 ( Skip =\= 0 582 -> Repositioned = true 583 ; true 584 ), 585 forall(between(1, Skip, _), 586 skip(Stream, 0'\n)). 587 588:- thread_local 589 opened_source/3, 590 decompiled/0. 591 592source_stream(File, Stream, Pos0, _) :- 593 opened_source(File, Stream, Pos0), 594 !. 595source_stream(File, Stream, Pos0, true) :- 596 open(File, read, Stream), 597 stream_property(Stream, position(Pos0)), 598 asserta(opened_source(File, Stream, Pos0)). 599 600close_sources :- 601 retractall(decompiled), 602 forall(retract(opened_source(_,Stream,_)), 603 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.634% The prolog_list_goal/1 hook is a dubious as it may lead to 635% confusion if the heads relates to other bodies. For now it is 636% only used for XPCE methods and works just nice. 637% 638% Not really ... It may confuse the source-level debugger. 639 640%portray_clause(Head :- _Body) :- 641% user:prolog_list_goal(Head), !. 642portray_clause(Term) :- 643 current_output(Out), 644 portray_clause(Out, Term). 645 646portray_clause(Stream, Term) :- 647 must_be(stream, Stream), 648 portray_clause(Stream, Term, []). 649 650portray_clause(Stream, Term, M:Options) :- 651 must_be(list, Options), 652 meta_options(is_meta, M:Options, QOptions), 653 \+ \+ name_vars_and_portray_clause(Stream, Term, QOptions). 654 655name_vars_and_portray_clause(Stream, Term, Options) :- 656 term_attvars(Term, []), 657 !, 658 clause_vars(Term, Options), 659 do_portray_clause(Stream, Term, Options). 660name_vars_and_portray_clause(Stream, Term, Options) :- 661 option(variable_names(Bindings), Options), 662 !, 663 copy_term_nat(Term+Bindings, Copy+BCopy), 664 bind_vars(BCopy), 665 name_other_vars(Copy, BCopy), 666 do_portray_clause(Stream, Copy, Options). 667name_vars_and_portray_clause(Stream, Term, Options) :- 668 copy_term_nat(Term, Copy), 669 clause_vars(Copy, Options), 670 do_portray_clause(Stream, Copy, Options). 671 672clause_vars(Clause, Options) :- 673 option(variable_names(Bindings), Options), 674 !, 675 bind_vars(Bindings), 676 name_other_vars(Clause, Bindings). 677clause_vars(Clause, _) :- 678 numbervars(Clause, 0, _, 679 [ singletons(true) 680 ]). 681 682is_meta(portray_goal). 683 684do_portray_clause(Out, Var, Options) :- 685 var(Var), 686 !, 687 option(indent(LeftMargin), Options, 0), 688 indent(Out, LeftMargin), 689 pprint(Out, Var, 1200, Options). 690do_portray_clause(Out, (Head :- true), Options) :- 691 !, 692 option(indent(LeftMargin), Options, 0), 693 indent(Out, LeftMargin), 694 pprint(Out, Head, 1200, Options), 695 full_stop(Out). 696do_portray_clause(Out, Term, Options) :- 697 clause_term(Term, Head, Neck, Body), 698 !, 699 option(indent(LeftMargin), Options, 0), 700 inc_indent(LeftMargin, 1, Indent), 701 infix_op(Neck, RightPri, LeftPri), 702 indent(Out, LeftMargin), 703 pprint(Out, Head, LeftPri, Options), 704 format(Out, ' ~w', [Neck]), 705 ( nonvar(Body), 706 Body = Module:LocalBody, 707 \+ primitive(LocalBody) 708 -> nlindent(Out, Indent), 709 format(Out, '~q', [Module]), 710 '$put_token'(Out, :), 711 nlindent(Out, Indent), 712 write(Out, '( '), 713 inc_indent(Indent, 1, BodyIndent), 714 portray_body(LocalBody, BodyIndent, noindent, 1200, Out, Options), 715 nlindent(Out, Indent), 716 write(Out, ')') 717 ; setting(listing:body_indentation, BodyIndent0), 718 BodyIndent is LeftMargin+BodyIndent0, 719 portray_body(Body, BodyIndent, indent, RightPri, Out, Options) 720 ), 721 full_stop(Out). 722do_portray_clause(Out, (:-Directive), Options) :- 723 wrapped_list_directive(Directive), 724 !, 725 Directive =.. [Name, Arg, List], 726 option(indent(LeftMargin), Options, 0), 727 indent(Out, LeftMargin), 728 format(Out, ':- ~q(', [Name]), 729 line_position(Out, Indent), 730 format(Out, '~q,', [Arg]), 731 nlindent(Out, Indent), 732 portray_list(List, Indent, Out, Options), 733 write(Out, ').\n'). 734do_portray_clause(Out, (:-Directive), Options) :- 735 !, 736 option(indent(LeftMargin), Options, 0), 737 indent(Out, LeftMargin), 738 write(Out, ':- '), 739 DIndent is LeftMargin+3, 740 portray_body(Directive, DIndent, noindent, 1199, Out, Options), 741 full_stop(Out). 742do_portray_clause(Out, Fact, Options) :- 743 option(indent(LeftMargin), Options, 0), 744 indent(Out, LeftMargin), 745 portray_body(Fact, LeftMargin, noindent, 1200, Out, Options), 746 full_stop(Out). 747 748clause_term((Head:-Body), Head, :-, Body). 749clause_term((Head=>Body), Head, =>, Body). 750clause_term(?=>(Head,Body), Head, ?=>, Body). 751clause_term((Head-->Body), Head, -->, Body). 752 753full_stop(Out) :- 754 '$put_token'(Out, '.'), 755 nl(Out). 756 757wrapped_list_directive(module(_,_)). 758%wrapped_list_directive(use_module(_,_)). 759%wrapped_list_directive(autoload(_,_)).
766portray_body(Var, _, _, Pri, Out, Options) :- 767 var(Var), 768 !, 769 pprint(Out, Var, Pri, Options). 770portray_body(!, _, _, _, Out, _) :- 771 setting(listing:cut_on_same_line, true), 772 !, 773 write(Out, ' !'). 774portray_body((!, Clause), Indent, _, Pri, Out, Options) :- 775 setting(listing:cut_on_same_line, true), 776 \+ term_needs_braces((_,_), Pri), 777 !, 778 write(Out, ' !,'), 779 portray_body(Clause, Indent, indent, 1000, Out, Options). 780portray_body(Term, Indent, indent, Pri, Out, Options) :- 781 !, 782 nlindent(Out, Indent), 783 portray_body(Term, Indent, noindent, Pri, Out, Options). 784portray_body(Or, Indent, _, _, Out, Options) :- 785 or_layout(Or), 786 !, 787 write(Out, '( '), 788 portray_or(Or, Indent, 1200, Out, Options), 789 nlindent(Out, Indent), 790 write(Out, ')'). 791portray_body(Term, Indent, _, Pri, Out, Options) :- 792 term_needs_braces(Term, Pri), 793 !, 794 write(Out, '( '), 795 ArgIndent is Indent + 2, 796 portray_body(Term, ArgIndent, noindent, 1200, Out, Options), 797 nlindent(Out, Indent), 798 write(Out, ')'). 799portray_body(((AB),C), Indent, _, _Pri, Out, Options) :- 800 nonvar(AB), 801 AB = (A,B), 802 !, 803 infix_op(',', LeftPri, RightPri), 804 portray_body(A, Indent, noindent, LeftPri, Out, Options), 805 write(Out, ','), 806 portray_body((B,C), Indent, indent, RightPri, Out, Options). 807portray_body((A,B), Indent, _, _Pri, Out, Options) :- 808 !, 809 infix_op(',', LeftPri, RightPri), 810 portray_body(A, Indent, noindent, LeftPri, Out, Options), 811 write(Out, ','), 812 portray_body(B, Indent, indent, RightPri, Out, Options). 813portray_body(\+(Goal), Indent, _, _Pri, Out, Options) :- 814 !, 815 write(Out, \+), write(Out, ' '), 816 prefix_op(\+, ArgPri), 817 ArgIndent is Indent+3, 818 portray_body(Goal, ArgIndent, noindent, ArgPri, Out, Options). 819portray_body(Call, _, _, _, Out, Options) :- % requires knowledge on the module! 820 m_callable(Call), 821 option(module(M), Options, user), 822 predicate_property(M:Call, meta_predicate(Meta)), 823 !, 824 portray_meta(Out, Call, Meta, Options). 825portray_body(Clause, _, _, Pri, Out, Options) :- 826 pprint(Out, Clause, Pri, Options). 827 828m_callable(Term) :- 829 strip_module(Term, _, Plain), 830 callable(Plain), 831 Plain \= (_:_). 832 833term_needs_braces(Term, Pri) :- 834 callable(Term), 835 functor(Term, Name, _Arity), 836 current_op(OpPri, _Type, Name), 837 OpPri > Pri, 838 !.
842portray_or(Term, Indent, Pri, Out, Options) :- 843 term_needs_braces(Term, Pri), 844 !, 845 inc_indent(Indent, 1, NewIndent), 846 write(Out, '( '), 847 portray_or(Term, NewIndent, Out, Options), 848 nlindent(Out, NewIndent), 849 write(Out, ')'). 850portray_or(Term, Indent, _Pri, Out, Options) :- 851 or_layout(Term), 852 !, 853 portray_or(Term, Indent, Out, Options). 854portray_or(Term, Indent, Pri, Out, Options) :- 855 inc_indent(Indent, 1, NestIndent), 856 portray_body(Term, NestIndent, noindent, Pri, Out, Options). 857 858 859portray_or((If -> Then ; Else), Indent, Out, Options) :- 860 !, 861 inc_indent(Indent, 1, NestIndent), 862 infix_op((->), LeftPri, RightPri), 863 portray_body(If, NestIndent, noindent, LeftPri, Out, Options), 864 nlindent(Out, Indent), 865 write(Out, '-> '), 866 portray_body(Then, NestIndent, noindent, RightPri, Out, Options), 867 nlindent(Out, Indent), 868 write(Out, '; '), 869 infix_op(;, _LeftPri, RightPri2), 870 portray_or(Else, Indent, RightPri2, Out, Options). 871portray_or((If *-> Then ; Else), Indent, Out, Options) :- 872 !, 873 inc_indent(Indent, 1, NestIndent), 874 infix_op((*->), LeftPri, RightPri), 875 portray_body(If, NestIndent, noindent, LeftPri, Out, Options), 876 nlindent(Out, Indent), 877 write(Out, '*-> '), 878 portray_body(Then, NestIndent, noindent, RightPri, Out, Options), 879 nlindent(Out, Indent), 880 write(Out, '; '), 881 infix_op(;, _LeftPri, RightPri2), 882 portray_or(Else, Indent, RightPri2, Out, Options). 883portray_or((If -> Then), Indent, Out, Options) :- 884 !, 885 inc_indent(Indent, 1, NestIndent), 886 infix_op((->), LeftPri, RightPri), 887 portray_body(If, NestIndent, noindent, LeftPri, Out, Options), 888 nlindent(Out, Indent), 889 write(Out, '-> '), 890 portray_or(Then, Indent, RightPri, Out, Options). 891portray_or((If *-> Then), Indent, Out, Options) :- 892 !, 893 inc_indent(Indent, 1, NestIndent), 894 infix_op((->), LeftPri, RightPri), 895 portray_body(If, NestIndent, noindent, LeftPri, Out, Options), 896 nlindent(Out, Indent), 897 write(Out, '*-> '), 898 portray_or(Then, Indent, RightPri, Out, Options). 899portray_or((A;B), Indent, Out, Options) :- 900 !, 901 inc_indent(Indent, 1, NestIndent), 902 infix_op(;, LeftPri, RightPri), 903 portray_body(A, NestIndent, noindent, LeftPri, Out, Options), 904 nlindent(Out, Indent), 905 write(Out, '; '), 906 portray_or(B, Indent, RightPri, Out, Options). 907portray_or((A|B), Indent, Out, Options) :- 908 !, 909 inc_indent(Indent, 1, NestIndent), 910 infix_op('|', LeftPri, RightPri), 911 portray_body(A, NestIndent, noindent, LeftPri, Out, Options), 912 nlindent(Out, Indent), 913 write(Out, '| '), 914 portray_or(B, Indent, RightPri, Out, Options).
922infix_op(Op, Left, Right) :- 923 current_op(Pri, Assoc, Op), 924 infix_assoc(Assoc, LeftMin, RightMin), 925 !, 926 Left is Pri - LeftMin, 927 Right is Pri - RightMin. 928 929infix_assoc(xfx, 1, 1). 930infix_assoc(xfy, 1, 0). 931infix_assoc(yfx, 0, 1). 932 933prefix_op(Op, ArgPri) :- 934 current_op(Pri, Assoc, Op), 935 pre_assoc(Assoc, ArgMin), 936 !, 937 ArgPri is Pri - ArgMin. 938 939pre_assoc(fx, 1). 940pre_assoc(fy, 0). 941 942postfix_op(Op, ArgPri) :- 943 current_op(Pri, Assoc, Op), 944 post_assoc(Assoc, ArgMin), 945 !, 946 ArgPri is Pri - ArgMin. 947 948post_assoc(xf, 1). 949post_assoc(yf, 0).
958or_layout(Var) :- 959 var(Var), !, fail. 960or_layout((_;_)). 961or_layout((_->_)). 962or_layout((_*->_)). 963 964primitive(G) :- 965 or_layout(G), !, fail. 966primitive((_,_)) :- !, fail. 967primitive(_).
976portray_meta(Out, Call, Meta, Options) :- 977 contains_non_primitive_meta_arg(Call, Meta), 978 !, 979 Call =.. [Name|Args], 980 Meta =.. [_|Decls], 981 format(Out, '~q(', [Name]), 982 line_position(Out, Indent), 983 portray_meta_args(Decls, Args, Indent, Out, Options), 984 format(Out, ')', []). 985portray_meta(Out, Call, _, Options) :- 986 pprint(Out, Call, 999, Options). 987 988contains_non_primitive_meta_arg(Call, Decl) :- 989 arg(I, Call, CA), 990 arg(I, Decl, DA), 991 integer(DA), 992 \+ primitive(CA), 993 !. 994 995portray_meta_args([], [], _, _, _). 996portray_meta_args([D|DT], [A|AT], Indent, Out, Options) :- 997 portray_meta_arg(D, A, Out, Options), 998 ( DT == [] 999 -> true 1000 ; format(Out, ',', []), 1001 nlindent(Out, Indent), 1002 portray_meta_args(DT, AT, Indent, Out, Options) 1003 ). 1004 1005portray_meta_arg(I, A, Out, Options) :- 1006 integer(I), 1007 !, 1008 line_position(Out, Indent), 1009 portray_body(A, Indent, noindent, 999, Out, Options). 1010portray_meta_arg(_, A, Out, Options) :- 1011 pprint(Out, A, 999, Options).
[ element1, [ element1 element2, OR | tail ] ]
1021portray_list([], _, Out, _) :- 1022 !, 1023 write(Out, []). 1024portray_list(List, Indent, Out, Options) :- 1025 write(Out, '[ '), 1026 EIndent is Indent + 2, 1027 portray_list_elements(List, EIndent, Out, Options), 1028 nlindent(Out, Indent), 1029 write(Out, ']'). 1030 1031portray_list_elements([H|T], EIndent, Out, Options) :- 1032 pprint(Out, H, 999, Options), 1033 ( T == [] 1034 -> true 1035 ; nonvar(T), T = [_|_] 1036 -> write(Out, ','), 1037 nlindent(Out, EIndent), 1038 portray_list_elements(T, EIndent, Out, Options) 1039 ; Indent is EIndent - 2, 1040 nlindent(Out, Indent), 1041 write(Out, '| '), 1042 pprint(Out, T, 999, Options) 1043 ).
1057pprint(Out, Term, _, Options) :- 1058 nonvar(Term), 1059 Term = {}(Arg), 1060 line_position(Out, Indent), 1061 ArgIndent is Indent + 2, 1062 format(Out, '{ ', []), 1063 portray_body(Arg, ArgIndent, noident, 1000, Out, Options), 1064 nlindent(Out, Indent), 1065 format(Out, '}', []). 1066pprint(Out, Term, Pri, Options) :- 1067 ( compound(Term) 1068 -> compound_name_arity(Term, _, Arity), 1069 Arity > 0 1070 ; is_dict(Term) 1071 ), 1072 \+ nowrap_term(Term), 1073 setting(listing:line_width, Width), 1074 Width > 0, 1075 ( write_length(Term, Len, [max_length(Width)|Options]) 1076 -> true 1077 ; Len = Width 1078 ), 1079 line_position(Out, Indent), 1080 Indent + Len > Width, 1081 Len > Width/4, % ad-hoc rule for deeply nested goals 1082 !, 1083 pprint_wrapped(Out, Term, Pri, Options). 1084pprint(Out, Term, Pri, Options) :- 1085 listing_write_options(Pri, WrtOptions, Options), 1086 write_term(Out, Term, 1087 [ blobs(portray), 1088 portray_goal(portray_blob) 1089 | WrtOptions 1090 ]). 1091 1092portray_blob(Blob, _Options) :- 1093 blob(Blob, _), 1094 \+ atom(Blob), 1095 !, 1096 format(string(S), '~q', [Blob]), 1097 format('~q', ['$BLOB'(S)]). 1098 1099nowrap_term('$VAR'(_)) :- !. 1100nowrap_term(_{}) :- !. % empty dict 1101nowrap_term(Term) :- 1102 functor(Term, Name, Arity), 1103 current_op(_, _, Name), 1104 ( Arity == 2 1105 -> infix_op(Name, _, _) 1106 ; Arity == 1 1107 -> ( prefix_op(Name, _) 1108 -> true 1109 ; postfix_op(Name, _) 1110 ) 1111 ). 1112 1113 1114pprint_wrapped(Out, Term, _, Options) :- 1115 Term = [_|_], 1116 !, 1117 line_position(Out, Indent), 1118 portray_list(Term, Indent, Out, Options). 1119pprint_wrapped(Out, Dict, _, Options) :- 1120 is_dict(Dict), 1121 !, 1122 dict_pairs(Dict, Tag, Pairs), 1123 pprint(Out, Tag, 1200, Options), 1124 format(Out, '{ ', []), 1125 line_position(Out, Indent), 1126 pprint_nv(Pairs, Indent, Out, Options), 1127 nlindent(Out, Indent-2), 1128 format(Out, '}', []). 1129pprint_wrapped(Out, Term, _, Options) :- 1130 Term =.. [Name|Args], 1131 format(Out, '~q(', [Name]), 1132 line_position(Out, Indent), 1133 pprint_args(Args, Indent, Out, Options), 1134 format(Out, ')', []). 1135 1136pprint_args([], _, _, _). 1137pprint_args([H|T], Indent, Out, Options) :- 1138 pprint(Out, H, 999, Options), 1139 ( T == [] 1140 -> true 1141 ; format(Out, ',', []), 1142 nlindent(Out, Indent), 1143 pprint_args(T, Indent, Out, Options) 1144 ). 1145 1146 1147pprint_nv([], _, _, _). 1148pprint_nv([Name-Value|T], Indent, Out, Options) :- 1149 pprint(Out, Name, 999, Options), 1150 format(Out, ':', []), 1151 pprint(Out, Value, 999, Options), 1152 ( T == [] 1153 -> true 1154 ; format(Out, ',', []), 1155 nlindent(Out, Indent), 1156 pprint_nv(T, Indent, Out, Options) 1157 ).
1165listing_write_options(Pri,
1166 [ quoted(true),
1167 numbervars(true),
1168 priority(Pri),
1169 spacing(next_argument)
1170 | Options
1171 ],
1172 Options).1180nlindent(Out, N) :- 1181 nl(Out), 1182 indent(Out, N). 1183 1184indent(Out, N) :- 1185 setting(listing:tab_distance, D), 1186 ( D =:= 0 1187 -> tab(Out, N) 1188 ; Tab is N // D, 1189 Space is N mod D, 1190 put_tabs(Out, Tab), 1191 tab(Out, Space) 1192 ). 1193 1194put_tabs(Out, N) :- 1195 N > 0, 1196 !, 1197 put(Out, 0'\t), 1198 NN is N - 1, 1199 put_tabs(Out, NN). 1200put_tabs(_, _).
1207inc_indent(Indent0, Inc, Indent) :- 1208 Indent is Indent0 + Inc*4. 1209 1210:- multifile 1211 sandbox:safe_meta/2. 1212 1213sandbox:safe_meta(listing(What), []) :- 1214 not_qualified(What). 1215 1216not_qualified(Var) :- 1217 var(Var), 1218 !. 1219not_qualified(_:_) :- !, fail. 1220not_qualified(_).
1227comment(Format, Args) :- 1228 stream_property(current_output, tty(true)), 1229 setting(listing:comment_ansi_attributes, Attributes), 1230 Attributes \== [], 1231 !, 1232 ansi_format(Attributes, Format, Args). 1233comment(Format, Args) :- 1234 format(Format, Args)
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.