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:- use_module(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)]).
192listing(Spec) :- 193 listing(Spec, []). 194 195listing(Spec, Options) :- 196 call_cleanup( 197 listing_(Spec, Options), 198 close_sources). 199 200listing_(M:Spec, Options) :- 201 var(Spec), 202 !, 203 list_module(M, Options). 204listing_(M:List, Options) :- 205 is_list(List), 206 !, 207 forall(member(Spec, List), 208 listing_(M:Spec, Options)). 209listing_(M:CRef, Options) :- 210 blob(CRef, clause), 211 !, 212 list_clauserefs([CRef], M, Options). 213listing_(X, Options) :- 214 ( prolog:locate_clauses(X, ClauseRefs) 215 -> strip_module(X, Context, _), 216 list_clauserefs(ClauseRefs, Context, Options) 217 ; '$find_predicate'(X, Preds), 218 list_predicates(Preds, X, Options) 219 ). 220 221list_clauserefs([], _, _) :- !. 222list_clauserefs([H|T], Context, Options) :- 223 !, 224 list_clauserefs(H, Context, Options), 225 list_clauserefs(T, Context, Options). 226list_clauserefs(Ref, Context, Options) :- 227 @(rule(M:_, Rule, Ref), Context), 228 list_clause(M:Rule, Ref, Context, Options).
232list_predicates(PIs, Context:X, Options) :- 233 member(PI, PIs), 234 pi_to_head(PI, Pred), 235 unify_args(Pred, X), 236 list_define(Pred, DefPred), 237 list_predicate(DefPred, Context, Options), 238 nl, 239 fail. 240list_predicates(_, _, _). 241 242list_define(Head, LoadModule:Head) :- 243 compound(Head), 244 Head \= (_:_), 245 functor(Head, Name, Arity), 246 '$find_library'(_, Name, Arity, LoadModule, Library), 247 !, 248 use_module(Library, []). 249list_define(M:Pred, DefM:Pred) :- 250 '$define_predicate'(M:Pred), 251 ( predicate_property(M:Pred, imported_from(DefM)) 252 -> true 253 ; DefM = M 254 ). 255 256pi_to_head(PI, _) :- 257 var(PI), 258 !, 259 instantiation_error(PI). 260pi_to_head(M:PI, M:Head) :- 261 !, 262 pi_to_head(PI, Head). 263pi_to_head(Name/Arity, Head) :- 264 functor(Head, Name, Arity). 265 266 267% Unify the arguments of the specification with the given term, 268% so we can partially instantate the head. 269 270unify_args(_, _/_) :- !. % Name/arity spec 271unify_args(X, X) :- !. 272unify_args(_:X, X) :- !. 273unify_args(_, _). 274 275list_predicate(Pred, Context, _) :- 276 predicate_property(Pred, undefined), 277 !, 278 decl_term(Pred, Context, Decl), 279 comment('% Undefined: ~q~n', [Decl]). 280list_predicate(Pred, Context, _) :- 281 predicate_property(Pred, foreign), 282 !, 283 decl_term(Pred, Context, Decl), 284 comment('% Foreign: ~q~n', [Decl]), 285 ( '$foreign_predicate_source'(Pred, Source) 286 -> comment('% Implemented by ~w~n', [Source]) 287 ; true 288 ). 289list_predicate(Pred, Context, Options) :- 290 notify_changed(Pred, Context), 291 list_declarations(Pred, Context), 292 list_clauses(Pred, Context, Options). 293 294decl_term(Pred, Context, Decl) :- 295 strip_module(Pred, Module, Head), 296 functor(Head, Name, Arity), 297 ( hide_module(Module, Context, Head) 298 -> Decl = Name/Arity 299 ; Decl = Module:Name/Arity 300 ). 301 302 303decl(thread_local, thread_local). 304decl(dynamic, dynamic). 305decl(volatile, volatile). 306decl(multifile, multifile). 307decl(public, public).
317declaration(Pred, Source, Decl) :- 318 predicate_property(Pred, tabled), 319 Pred = M:Head, 320 ( M:'$table_mode'(Head, Head, _) 321 -> decl_term(Pred, Source, Funct), 322 table_options(Pred, Funct, TableDecl), 323 Decl = table(TableDecl) 324 ; comment('% tabled using answer subsumption~n', []), 325 fail % TBD 326 ). 327declaration(Pred, Source, Decl) :- 328 decl(Prop, Declname), 329 predicate_property(Pred, Prop), 330 decl_term(Pred, Source, Funct), 331 Decl =.. [ Declname, Funct ]. 332declaration(Pred, Source, Decl) :- 333 predicate_property(Pred, meta_predicate(Head)), 334 strip_module(Pred, Module, _), 335 ( (Module == system; Source == Module) 336 -> Decl = meta_predicate(Head) 337 ; Decl = meta_predicate(Module:Head) 338 ), 339 ( meta_implies_transparent(Head) 340 -> ! % hide transparent 341 ; true 342 ). 343declaration(Pred, Source, Decl) :- 344 predicate_property(Pred, transparent), 345 decl_term(Pred, Source, PI), 346 Decl = module_transparent(PI).
353meta_implies_transparent(Head):- 354 compound(Head), 355 arg(_, Head, Arg), 356 implies_transparent(Arg), 357 !. 358 359implies_transparent(Arg) :- 360 integer(Arg), 361 !. 362implies_transparent(:). 363implies_transparent(//). 364implies_transparent(^). 365 366table_options(Pred, Decl0, as(Decl0, Options)) :- 367 findall(Flag, predicate_property(Pred, tabled(Flag)), [F0|Flags]), 368 !, 369 foldl(table_option, Flags, F0, Options). 370table_options(_, Decl, Decl). 371 372table_option(Flag, X, (Flag,X)). 373 374list_declarations(Pred, Source) :- 375 findall(Decl, declaration(Pred, Source, Decl), Decls), 376 ( Decls == [] 377 -> true 378 ; write_declarations(Decls, Source), 379 format('~n', []) 380 ). 381 382 383write_declarations([], _) :- !. 384write_declarations([H|T], Module) :- 385 format(':- ~q.~n', [H]), 386 write_declarations(T, Module). 387 388list_clauses(Pred, Source, Options) :- 389 strip_module(Pred, Module, Head), 390 most_general_goal(Head, GenHead), 391 forall(( rule(Module:GenHead, Rule, Ref), 392 \+ \+ rule_head(Rule, Head) 393 ), 394 list_clause(Module:Rule, Ref, Source, Options)). 395 396rule_head((Head0 :- _Body), Head) :- !, Head = Head0. 397rule_head((Head0,_Cond => _Body), Head) :- !, Head = Head0. 398rule_head((Head0 => _Body), Head) :- !, Head = Head0. 399rule_head(?=>(Head0, _Body), Head) :- !, Head = Head0. 400rule_head(Head, Head).
404list_clause(_Rule, Ref, _Source, Options) :- 405 option(source(true), Options), 406 ( clause_property(Ref, file(File)), 407 clause_property(Ref, line_count(Line)), 408 catch(source_clause_string(File, Line, String, Repositioned), 409 _, fail), 410 debug(listing(source), 'Read ~w:~d: "~s"~n', [File, Line, String]) 411 -> !, 412 ( Repositioned == true 413 -> comment('% From ~w:~d~n', [ File, Line ]) 414 ; true 415 ), 416 writeln(String) 417 ; decompiled 418 -> fail 419 ; asserta(decompiled), 420 comment('% From database (decompiled)~n', []), 421 fail % try next clause 422 ). 423list_clause(Module:(Head:-Body), Ref, Source, Options) :- 424 !, 425 list_clause(Module:Head, Body, :-, Ref, Source, Options). 426list_clause(Module:(Head=>Body), Ref, Source, Options) :- 427 list_clause(Module:Head, Body, =>, Ref, Source, Options). 428list_clause(Module:Head, Ref, Source, Options) :- 429 !, 430 list_clause(Module:Head, true, :-, Ref, Source, Options). 431 432list_clause(Module:Head, Body, Neck, Ref, Source, Options) :- 433 restore_variable_names(Module, Head, Body, Ref, Options), 434 write_module(Module, Source, Head), 435 Rule =.. [Neck,Head,Body], 436 portray_clause(Rule).
variable_names(source) is true.443restore_variable_names(Module, Head, Body, Ref, Options) :- 444 option(variable_names(source), Options, source), 445 catch(clause_info(Ref, _, _, _, 446 [ head(QHead), 447 body(Body), 448 variable_names(Bindings) 449 ]), 450 _, true), 451 unify_head(Module, Head, QHead), 452 !, 453 bind_vars(Bindings), 454 name_other_vars((Head:-Body), Bindings). 455restore_variable_names(_,_,_,_,_). 456 457unify_head(Module, Head, Module:Head) :- 458 !. 459unify_head(_, Head, Head) :- 460 !. 461unify_head(_, _, _). 462 463bind_vars([]) :- 464 !. 465bind_vars([Name = Var|T]) :- 466 ignore(Var = '$VAR'(Name)), 467 bind_vars(T).
474name_other_vars(Term, Bindings) :- 475 term_singletons(Term, Singletons), 476 bind_singletons(Singletons), 477 term_variables(Term, Vars), 478 name_vars(Vars, 0, Bindings). 479 480bind_singletons([]). 481bind_singletons(['$VAR'('_')|T]) :- 482 bind_singletons(T). 483 484name_vars([], _, _). 485name_vars([H|T], N, Bindings) :- 486 between(N, infinite, N2), 487 var_name(N2, Name), 488 \+ memberchk(Name=_, Bindings), 489 !, 490 H = '$VAR'(N2), 491 N3 is N2 + 1, 492 name_vars(T, N3, Bindings). 493 494var_name(I, Name) :- % must be kept in sync with writeNumberVar() 495 L is (I mod 26)+0'A, 496 N is I // 26, 497 ( N == 0 498 -> char_code(Name, L) 499 ; format(atom(Name), '~c~d', [L, N]) 500 ). 501 502write_module(Module, Context, Head) :- 503 hide_module(Module, Context, Head), 504 !. 505write_module(Module, _, _) :- 506 format('~q:', [Module]). 507 508hide_module(system, Module, Head) :- 509 predicate_property(Module:Head, imported_from(M)), 510 predicate_property(system:Head, imported_from(M)), 511 !. 512hide_module(Module, Module, _) :- !. 513 514notify_changed(Pred, Context) :- 515 strip_module(Pred, user, Head), 516 predicate_property(Head, built_in), 517 \+ predicate_property(Head, (dynamic)), 518 !, 519 decl_term(Pred, Context, Decl), 520 comment('% NOTE: system definition has been overruled for ~q~n', 521 [Decl]). 522notify_changed(_, _).
529source_clause_string(File, Line, String, Repositioned) :- 530 open_source(File, Line, Stream, Repositioned), 531 stream_property(Stream, position(Start)), 532 '$raw_read'(Stream, _TextWithoutComments), 533 stream_property(Stream, position(End)), 534 stream_position_data(char_count, Start, StartChar), 535 stream_position_data(char_count, End, EndChar), 536 Length is EndChar - StartChar, 537 set_stream_position(Stream, Start), 538 read_string(Stream, Length, String), 539 skip_blanks_and_comments(Stream, blank). 540 541skip_blanks_and_comments(Stream, _) :- 542 at_end_of_stream(Stream), 543 !. 544skip_blanks_and_comments(Stream, State0) :- 545 peek_string(Stream, 80, String), 546 string_chars(String, Chars), 547 phrase(blanks_and_comments(State0, State), Chars, Rest), 548 ( Rest == [] 549 -> read_string(Stream, 80, _), 550 skip_blanks_and_comments(Stream, State) 551 ; length(Chars, All), 552 length(Rest, RLen), 553 Skip is All-RLen, 554 read_string(Stream, Skip, _) 555 ). 556 557blanks_and_comments(State0, State) --> 558 [C], 559 { transition(C, State0, State1) }, 560 !, 561 blanks_and_comments(State1, State). 562blanks_and_comments(State, State) --> 563 []. 564 565transition(C, blank, blank) :- 566 char_type(C, space). 567transition('%', blank, line_comment). 568transition('\n', line_comment, blank). 569transition(_, line_comment, line_comment). 570transition('/', blank, comment_0). 571transition('/', comment(N), comment(N,/)). 572transition('*', comment(N,/), comment(N1)) :- 573 N1 is N + 1. 574transition('*', comment_0, comment(1)). 575transition('*', comment(N), comment(N,*)). 576transition('/', comment(N,*), State) :- 577 ( N == 1 578 -> State = blank 579 ; N2 is N - 1, 580 State = comment(N2) 581 ). 582 583 584open_source(File, Line, Stream, Repositioned) :- 585 source_stream(File, Stream, Pos0, Repositioned), 586 line_count(Stream, Line0), 587 ( Line >= Line0 588 -> Skip is Line - Line0 589 ; set_stream_position(Stream, Pos0), 590 Skip is Line - 1 591 ), 592 debug(listing(source), '~w: skip ~d to ~d', [File, Line0, Line]), 593 ( Skip =\= 0 594 -> Repositioned = true 595 ; true 596 ), 597 forall(between(1, Skip, _), 598 skip(Stream, 0'\n)). 599 600:- thread_local 601 opened_source/3, 602 decompiled/0. 603 604source_stream(File, Stream, Pos0, _) :- 605 opened_source(File, Stream, Pos0), 606 !. 607source_stream(File, Stream, Pos0, true) :- 608 open(File, read, Stream), 609 stream_property(Stream, position(Pos0)), 610 asserta(opened_source(File, Stream, Pos0)). 611 612close_sources :- 613 retractall(decompiled), 614 forall(retract(opened_source(_,Stream,_)), 615 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.646% The prolog_list_goal/1 hook is a dubious as it may lead to 647% confusion if the heads relates to other bodies. For now it is 648% only used for XPCE methods and works just nice. 649% 650% Not really ... It may confuse the source-level debugger. 651 652%portray_clause(Head :- _Body) :- 653% user:prolog_list_goal(Head), !. 654portray_clause(Term) :- 655 current_output(Out), 656 portray_clause(Out, Term). 657 658portray_clause(Stream, Term) :- 659 must_be(stream, Stream), 660 portray_clause(Stream, Term, []). 661 662portray_clause(Stream, Term, M:Options) :- 663 must_be(list, Options), 664 meta_options(is_meta, M:Options, QOptions), 665 \+ \+ name_vars_and_portray_clause(Stream, Term, QOptions). 666 667name_vars_and_portray_clause(Stream, Term, Options) :- 668 term_attvars(Term, []), 669 !, 670 clause_vars(Term, Options), 671 do_portray_clause(Stream, Term, Options). 672name_vars_and_portray_clause(Stream, Term, Options) :- 673 option(variable_names(Bindings), Options), 674 !, 675 copy_term_nat(Term+Bindings, Copy+BCopy), 676 bind_vars(BCopy), 677 name_other_vars(Copy, BCopy), 678 do_portray_clause(Stream, Copy, Options). 679name_vars_and_portray_clause(Stream, Term, Options) :- 680 copy_term_nat(Term, Copy), 681 clause_vars(Copy, Options), 682 do_portray_clause(Stream, Copy, Options). 683 684clause_vars(Clause, Options) :- 685 option(variable_names(Bindings), Options), 686 !, 687 bind_vars(Bindings), 688 name_other_vars(Clause, Bindings). 689clause_vars(Clause, _) :- 690 numbervars(Clause, 0, _, 691 [ singletons(true) 692 ]). 693 694is_meta(portray_goal). 695 696do_portray_clause(Out, Var, Options) :- 697 var(Var), 698 !, 699 option(indent(LeftMargin), Options, 0), 700 indent(Out, LeftMargin), 701 pprint(Out, Var, 1200, Options). 702do_portray_clause(Out, (Head :- true), Options) :- 703 !, 704 option(indent(LeftMargin), Options, 0), 705 indent(Out, LeftMargin), 706 pprint(Out, Head, 1200, Options), 707 full_stop(Out). 708do_portray_clause(Out, Term, Options) :- 709 clause_term(Term, Head, Neck, Body), 710 !, 711 option(indent(LeftMargin), Options, 0), 712 inc_indent(LeftMargin, 1, Indent), 713 infix_op(Neck, RightPri, LeftPri), 714 indent(Out, LeftMargin), 715 pprint(Out, Head, LeftPri, Options), 716 format(Out, ' ~w', [Neck]), 717 ( nonvar(Body), 718 Body = Module:LocalBody, 719 \+ primitive(LocalBody) 720 -> nlindent(Out, Indent), 721 format(Out, '~q', [Module]), 722 '$put_token'(Out, :), 723 nlindent(Out, Indent), 724 write(Out, '( '), 725 inc_indent(Indent, 1, BodyIndent), 726 portray_body(LocalBody, BodyIndent, noindent, 1200, Out, Options), 727 nlindent(Out, Indent), 728 write(Out, ')') 729 ; setting(listing:body_indentation, BodyIndent0), 730 BodyIndent is LeftMargin+BodyIndent0, 731 portray_body(Body, BodyIndent, indent, RightPri, Out, Options) 732 ), 733 full_stop(Out). 734do_portray_clause(Out, (:-Directive), Options) :- 735 wrapped_list_directive(Directive), 736 !, 737 Directive =.. [Name, Arg, List], 738 option(indent(LeftMargin), Options, 0), 739 indent(Out, LeftMargin), 740 format(Out, ':- ~q(', [Name]), 741 line_position(Out, Indent), 742 format(Out, '~q,', [Arg]), 743 nlindent(Out, Indent), 744 portray_list(List, Indent, Out, Options), 745 write(Out, ').\n'). 746do_portray_clause(Out, Clause, Options) :- 747 directive(Clause, Op, Directive), 748 !, 749 option(indent(LeftMargin), Options, 0), 750 indent(Out, LeftMargin), 751 format(Out, '~w ', [Op]), 752 DIndent is LeftMargin+3, 753 portray_body(Directive, DIndent, noindent, 1199, Out, Options), 754 full_stop(Out). 755do_portray_clause(Out, Fact, Options) :- 756 option(indent(LeftMargin), Options, 0), 757 indent(Out, LeftMargin), 758 portray_body(Fact, LeftMargin, noindent, 1200, Out, Options), 759 full_stop(Out). 760 761clause_term((Head:-Body), Head, :-, Body). 762clause_term((Head=>Body), Head, =>, Body). 763clause_term(?=>(Head,Body), Head, ?=>, Body). 764clause_term((Head-->Body), Head, -->, Body). 765 766full_stop(Out) :- 767 '$put_token'(Out, '.'), 768 nl(Out). 769 770directive((:- Directive), :-, Directive). 771directive((?- Directive), ?-, Directive). 772 773wrapped_list_directive(module(_,_)). 774%wrapped_list_directive(use_module(_,_)). 775%wrapped_list_directive(autoload(_,_)).
782portray_body(Var, _, _, Pri, Out, Options) :- 783 var(Var), 784 !, 785 pprint(Out, Var, Pri, Options). 786portray_body(!, _, _, _, Out, _) :- 787 setting(listing:cut_on_same_line, true), 788 !, 789 write(Out, ' !'). 790portray_body((!, Clause), Indent, _, Pri, Out, Options) :- 791 setting(listing:cut_on_same_line, true), 792 \+ term_needs_braces((_,_), Pri), 793 !, 794 write(Out, ' !,'), 795 portray_body(Clause, Indent, indent, 1000, Out, Options). 796portray_body(Term, Indent, indent, Pri, Out, Options) :- 797 !, 798 nlindent(Out, Indent), 799 portray_body(Term, Indent, noindent, Pri, Out, Options). 800portray_body(Or, Indent, _, _, Out, Options) :- 801 or_layout(Or), 802 !, 803 write(Out, '( '), 804 portray_or(Or, Indent, 1200, Out, Options), 805 nlindent(Out, Indent), 806 write(Out, ')'). 807portray_body(Term, Indent, _, Pri, Out, Options) :- 808 term_needs_braces(Term, Pri), 809 !, 810 write(Out, '( '), 811 ArgIndent is Indent + 2, 812 portray_body(Term, ArgIndent, noindent, 1200, Out, Options), 813 nlindent(Out, Indent), 814 write(Out, ')'). 815portray_body(((AB),C), Indent, _, _Pri, Out, Options) :- 816 nonvar(AB), 817 AB = (A,B), 818 !, 819 infix_op(',', LeftPri, RightPri), 820 portray_body(A, Indent, noindent, LeftPri, Out, Options), 821 write(Out, ','), 822 portray_body((B,C), Indent, indent, RightPri, Out, Options). 823portray_body((A,B), Indent, _, _Pri, Out, Options) :- 824 !, 825 infix_op(',', LeftPri, RightPri), 826 portray_body(A, Indent, noindent, LeftPri, Out, Options), 827 write(Out, ','), 828 portray_body(B, Indent, indent, RightPri, Out, Options). 829portray_body(\+(Goal), Indent, _, _Pri, Out, Options) :- 830 !, 831 write(Out, \+), write(Out, ' '), 832 prefix_op(\+, ArgPri), 833 ArgIndent is Indent+3, 834 portray_body(Goal, ArgIndent, noindent, ArgPri, Out, Options). 835portray_body(Call, _, _, _, Out, Options) :- % requires knowledge on the module! 836 m_callable(Call), 837 option(module(M), Options, user), 838 predicate_property(M:Call, meta_predicate(Meta)), 839 !, 840 portray_meta(Out, Call, Meta, Options). 841portray_body(Clause, _, _, Pri, Out, Options) :- 842 pprint(Out, Clause, Pri, Options). 843 844m_callable(Term) :- 845 strip_module(Term, _, Plain), 846 callable(Plain), 847 Plain \= (_:_). 848 849term_needs_braces(Term, Pri) :- 850 callable(Term), 851 functor(Term, Name, _Arity), 852 current_op(OpPri, _Type, Name), 853 OpPri > Pri, 854 !.
858portray_or(Term, Indent, Pri, Out, Options) :- 859 term_needs_braces(Term, Pri), 860 !, 861 inc_indent(Indent, 1, NewIndent), 862 write(Out, '( '), 863 portray_or(Term, NewIndent, Out, Options), 864 nlindent(Out, NewIndent), 865 write(Out, ')'). 866portray_or(Term, Indent, _Pri, Out, Options) :- 867 or_layout(Term), 868 !, 869 portray_or(Term, Indent, Out, Options). 870portray_or(Term, Indent, Pri, Out, Options) :- 871 inc_indent(Indent, 1, NestIndent), 872 portray_body(Term, NestIndent, noindent, Pri, Out, Options). 873 874 875portray_or((If -> Then ; Else), Indent, Out, Options) :- 876 !, 877 inc_indent(Indent, 1, NestIndent), 878 infix_op((->), LeftPri, RightPri), 879 portray_body(If, NestIndent, noindent, LeftPri, Out, Options), 880 nlindent(Out, Indent), 881 write(Out, '-> '), 882 portray_body(Then, NestIndent, noindent, RightPri, Out, Options), 883 nlindent(Out, Indent), 884 write(Out, '; '), 885 infix_op(;, _LeftPri, RightPri2), 886 portray_or(Else, Indent, RightPri2, Out, Options). 887portray_or((If *-> Then ; Else), Indent, Out, Options) :- 888 !, 889 inc_indent(Indent, 1, NestIndent), 890 infix_op((*->), LeftPri, RightPri), 891 portray_body(If, NestIndent, noindent, LeftPri, Out, Options), 892 nlindent(Out, Indent), 893 write(Out, '*-> '), 894 portray_body(Then, NestIndent, noindent, RightPri, Out, Options), 895 nlindent(Out, Indent), 896 write(Out, '; '), 897 infix_op(;, _LeftPri, RightPri2), 898 portray_or(Else, Indent, RightPri2, Out, Options). 899portray_or((If -> Then), Indent, Out, Options) :- 900 !, 901 inc_indent(Indent, 1, NestIndent), 902 infix_op((->), LeftPri, RightPri), 903 portray_body(If, NestIndent, noindent, LeftPri, Out, Options), 904 nlindent(Out, Indent), 905 write(Out, '-> '), 906 portray_or(Then, Indent, RightPri, Out, Options). 907portray_or((If *-> Then), Indent, Out, Options) :- 908 !, 909 inc_indent(Indent, 1, NestIndent), 910 infix_op((->), LeftPri, RightPri), 911 portray_body(If, NestIndent, noindent, LeftPri, Out, Options), 912 nlindent(Out, Indent), 913 write(Out, '*-> '), 914 portray_or(Then, Indent, RightPri, Out, Options). 915portray_or((A;B), Indent, Out, Options) :- 916 !, 917 inc_indent(Indent, 1, NestIndent), 918 infix_op(;, LeftPri, RightPri), 919 portray_body(A, NestIndent, noindent, LeftPri, Out, Options), 920 nlindent(Out, Indent), 921 write(Out, '; '), 922 portray_or(B, Indent, RightPri, Out, Options). 923portray_or((A|B), Indent, Out, Options) :- 924 !, 925 inc_indent(Indent, 1, NestIndent), 926 infix_op('|', LeftPri, RightPri), 927 portray_body(A, NestIndent, noindent, LeftPri, Out, Options), 928 nlindent(Out, Indent), 929 write(Out, '| '), 930 portray_or(B, Indent, RightPri, Out, Options).
938infix_op(Op, Left, Right) :- 939 current_op(Pri, Assoc, Op), 940 infix_assoc(Assoc, LeftMin, RightMin), 941 !, 942 Left is Pri - LeftMin, 943 Right is Pri - RightMin. 944 945infix_assoc(xfx, 1, 1). 946infix_assoc(xfy, 1, 0). 947infix_assoc(yfx, 0, 1). 948 949prefix_op(Op, ArgPri) :- 950 current_op(Pri, Assoc, Op), 951 pre_assoc(Assoc, ArgMin), 952 !, 953 ArgPri is Pri - ArgMin. 954 955pre_assoc(fx, 1). 956pre_assoc(fy, 0). 957 958postfix_op(Op, ArgPri) :- 959 current_op(Pri, Assoc, Op), 960 post_assoc(Assoc, ArgMin), 961 !, 962 ArgPri is Pri - ArgMin. 963 964post_assoc(xf, 1). 965post_assoc(yf, 0).
974or_layout(Var) :- 975 var(Var), !, fail. 976or_layout((_;_)). 977or_layout((_->_)). 978or_layout((_*->_)). 979 980primitive(G) :- 981 or_layout(G), !, fail. 982primitive((_,_)) :- !, fail. 983primitive(_).
992portray_meta(Out, Call, Meta, Options) :- 993 contains_non_primitive_meta_arg(Call, Meta), 994 !, 995 Call =.. [Name|Args], 996 Meta =.. [_|Decls], 997 format(Out, '~q(', [Name]), 998 line_position(Out, Indent), 999 portray_meta_args(Decls, Args, Indent, Out, Options), 1000 format(Out, ')', []). 1001portray_meta(Out, Call, _, Options) :- 1002 pprint(Out, Call, 999, Options). 1003 1004contains_non_primitive_meta_arg(Call, Decl) :- 1005 arg(I, Call, CA), 1006 arg(I, Decl, DA), 1007 integer(DA), 1008 \+ primitive(CA), 1009 !. 1010 1011portray_meta_args([], [], _, _, _). 1012portray_meta_args([D|DT], [A|AT], Indent, Out, Options) :- 1013 portray_meta_arg(D, A, Out, Options), 1014 ( DT == [] 1015 -> true 1016 ; format(Out, ',', []), 1017 nlindent(Out, Indent), 1018 portray_meta_args(DT, AT, Indent, Out, Options) 1019 ). 1020 1021portray_meta_arg(I, A, Out, Options) :- 1022 integer(I), 1023 !, 1024 line_position(Out, Indent), 1025 portray_body(A, Indent, noindent, 999, Out, Options). 1026portray_meta_arg(_, A, Out, Options) :- 1027 pprint(Out, A, 999, Options).
[ element1, [ element1 element2, OR | tail ] ]
1037portray_list([], _, Out, _) :- 1038 !, 1039 write(Out, []). 1040portray_list(List, Indent, Out, Options) :- 1041 write(Out, '[ '), 1042 EIndent is Indent + 2, 1043 portray_list_elements(List, EIndent, Out, Options), 1044 nlindent(Out, Indent), 1045 write(Out, ']'). 1046 1047portray_list_elements([H|T], EIndent, Out, Options) :- 1048 pprint(Out, H, 999, Options), 1049 ( T == [] 1050 -> true 1051 ; nonvar(T), T = [_|_] 1052 -> write(Out, ','), 1053 nlindent(Out, EIndent), 1054 portray_list_elements(T, EIndent, Out, Options) 1055 ; Indent is EIndent - 2, 1056 nlindent(Out, Indent), 1057 write(Out, '| '), 1058 pprint(Out, T, 999, Options) 1059 ).
1073pprint(Out, Term, _, Options) :- 1074 nonvar(Term), 1075 Term = {}(Arg), 1076 line_position(Out, Indent), 1077 ArgIndent is Indent + 2, 1078 format(Out, '{ ', []), 1079 portray_body(Arg, ArgIndent, noident, 1000, Out, Options), 1080 nlindent(Out, Indent), 1081 format(Out, '}', []). 1082pprint(Out, Term, Pri, Options) :- 1083 ( compound(Term) 1084 -> compound_name_arity(Term, _, Arity), 1085 Arity > 0 1086 ; is_dict(Term) 1087 ), 1088 \+ nowrap_term(Term), 1089 line_width(Width), 1090 Width > 0, 1091 ( write_length(Term, Len, [max_length(Width)|Options]) 1092 -> true 1093 ; Len = Width 1094 ), 1095 line_position(Out, Indent), 1096 Indent + Len > Width, 1097 Len > Width/4, % ad-hoc rule for deeply nested goals 1098 !, 1099 pprint_wrapped(Out, Term, Pri, Options). 1100pprint(Out, Term, Pri, Options) :- 1101 listing_write_options(Pri, WrtOptions, Options), 1102 write_term(Out, Term, 1103 [ blobs(portray), 1104 portray_goal(portray_blob) 1105 | WrtOptions 1106 ]). 1107 1108:- public portray_blob/2. 1109portray_blob(Blob, _Options) :- 1110 blob(Blob, _), 1111 \+ atom(Blob), 1112 !, 1113 format(string(S), '~q', [Blob]), 1114 format('~q', ['$BLOB'(S)]). 1115 1116nowrap_term('$VAR'(_)) :- !. 1117nowrap_term(_{}) :- !. % empty dict 1118nowrap_term(Term) :- 1119 functor(Term, Name, Arity), 1120 current_op(_, _, Name), 1121 ( Arity == 2 1122 -> infix_op(Name, _, _) 1123 ; Arity == 1 1124 -> ( prefix_op(Name, _) 1125 -> true 1126 ; postfix_op(Name, _) 1127 ) 1128 ). 1129 1130 1131pprint_wrapped(Out, Term, _, Options) :- 1132 Term = [_|_], 1133 !, 1134 line_position(Out, Indent), 1135 portray_list(Term, Indent, Out, Options). 1136pprint_wrapped(Out, Dict, _, Options) :- 1137 is_dict(Dict), 1138 !, 1139 dict_pairs(Dict, Tag, Pairs), 1140 pprint(Out, Tag, 1200, Options), 1141 format(Out, '{ ', []), 1142 line_position(Out, Indent), 1143 pprint_nv(Pairs, Indent, Out, Options), 1144 nlindent(Out, Indent-2), 1145 format(Out, '}', []). 1146pprint_wrapped(Out, Term, _, Options) :- 1147 Term =.. [Name|Args], 1148 format(Out, '~q(', [Name]), 1149 line_position(Out, Indent), 1150 pprint_args(Args, Indent, Out, Options), 1151 format(Out, ')', []). 1152 1153pprint_args([], _, _, _). 1154pprint_args([H|T], Indent, Out, Options) :- 1155 pprint(Out, H, 999, Options), 1156 ( T == [] 1157 -> true 1158 ; format(Out, ',', []), 1159 nlindent(Out, Indent), 1160 pprint_args(T, Indent, Out, Options) 1161 ). 1162 1163 1164pprint_nv([], _, _, _). 1165pprint_nv([Name-Value|T], Indent, Out, Options) :- 1166 pprint(Out, Name, 999, Options), 1167 format(Out, ':', []), 1168 pprint(Out, Value, 999, Options), 1169 ( T == [] 1170 -> true 1171 ; format(Out, ',', []), 1172 nlindent(Out, Indent), 1173 pprint_nv(T, Indent, Out, Options) 1174 ).
1182listing_write_options(Pri,
1183 [ quoted(true),
1184 numbervars(true),
1185 priority(Pri),
1186 spacing(next_argument)
1187 | Options
1188 ],
1189 Options).1197nlindent(Out, N) :- 1198 nl(Out), 1199 indent(Out, N). 1200 1201indent(Out, N) :- 1202 setting(listing:tab_distance, D), 1203 ( D =:= 0 1204 -> tab(Out, N) 1205 ; Tab is N // D, 1206 Space is N mod D, 1207 put_tabs(Out, Tab), 1208 tab(Out, Space) 1209 ). 1210 1211put_tabs(Out, N) :- 1212 N > 0, 1213 !, 1214 put(Out, 0'\t), 1215 NN is N - 1, 1216 put_tabs(Out, NN). 1217put_tabs(_, _). 1218 1219line_width(Width) :- 1220 stream_property(current_output, tty(true)), 1221 catch(tty_size(_Rows, Cols), error(_,_), fail), 1222 !, 1223 Width is Cols - 2. 1224line_width(Width) :- 1225 setting(listing:line_width, Width), 1226 !. 1227line_width(78).
1234inc_indent(Indent0, Inc, Indent) :- 1235 Indent is Indent0 + Inc*4. 1236 1237:- multifile 1238 sandbox:safe_meta/2. 1239 1240sandbox:safe_meta(listing(What), []) :- 1241 not_qualified(What). 1242 1243not_qualified(Var) :- 1244 var(Var), 1245 !. 1246not_qualified(_:_) :- !, fail. 1247not_qualified(_).
1254comment(Format, Args) :- 1255 stream_property(current_output, tty(true)), 1256 setting(listing:comment_ansi_attributes, Attributes), 1257 Attributes \== [], 1258 !, 1259 ansi_format(Attributes, Format, Args). 1260comment(Format, Args) :- 1261 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.