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]). 285list_predicate(Pred, Context, Options) :- 286 notify_changed(Pred, Context), 287 list_declarations(Pred, Context), 288 list_clauses(Pred, Context, Options). 289 290decl_term(Pred, Context, Decl) :- 291 strip_module(Pred, Module, Head), 292 functor(Head, Name, Arity), 293 ( hide_module(Module, Context, Head) 294 -> Decl = Name/Arity 295 ; Decl = Module:Name/Arity 296 ). 297 298 299decl(thread_local, thread_local). 300decl(dynamic, dynamic). 301decl(volatile, volatile). 302decl(multifile, multifile). 303decl(public, public).
313declaration(Pred, Source, Decl) :- 314 predicate_property(Pred, tabled), 315 Pred = M:Head, 316 ( M:'$table_mode'(Head, Head, _) 317 -> decl_term(Pred, Source, Funct), 318 table_options(Pred, Funct, TableDecl), 319 Decl = table(TableDecl) 320 ; comment('% tabled using answer subsumption~n', []), 321 fail % TBD 322 ). 323declaration(Pred, Source, Decl) :- 324 decl(Prop, Declname), 325 predicate_property(Pred, Prop), 326 decl_term(Pred, Source, Funct), 327 Decl =.. [ Declname, Funct ]. 328declaration(Pred, Source, Decl) :- 329 predicate_property(Pred, meta_predicate(Head)), 330 strip_module(Pred, Module, _), 331 ( (Module == system; Source == Module) 332 -> Decl = meta_predicate(Head) 333 ; Decl = meta_predicate(Module:Head) 334 ), 335 ( meta_implies_transparent(Head) 336 -> ! % hide transparent 337 ; true 338 ). 339declaration(Pred, Source, Decl) :- 340 predicate_property(Pred, transparent), 341 decl_term(Pred, Source, PI), 342 Decl = module_transparent(PI).
349meta_implies_transparent(Head):- 350 compound(Head), 351 arg(_, Head, Arg), 352 implies_transparent(Arg), 353 !. 354 355implies_transparent(Arg) :- 356 integer(Arg), 357 !. 358implies_transparent(:). 359implies_transparent(//). 360implies_transparent(^). 361 362table_options(Pred, Decl0, as(Decl0, Options)) :- 363 findall(Flag, predicate_property(Pred, tabled(Flag)), [F0|Flags]), 364 !, 365 foldl(table_option, Flags, F0, Options). 366table_options(_, Decl, Decl). 367 368table_option(Flag, X, (Flag,X)). 369 370list_declarations(Pred, Source) :- 371 findall(Decl, declaration(Pred, Source, Decl), Decls), 372 ( Decls == [] 373 -> true 374 ; write_declarations(Decls, Source), 375 format('~n', []) 376 ). 377 378 379write_declarations([], _) :- !. 380write_declarations([H|T], Module) :- 381 format(':- ~q.~n', [H]), 382 write_declarations(T, Module). 383 384list_clauses(Pred, Source, Options) :- 385 strip_module(Pred, Module, Head), 386 most_general_goal(Head, GenHead), 387 forall(( rule(Module:GenHead, Rule, Ref), 388 \+ \+ rule_head(Rule, Head) 389 ), 390 list_clause(Module:Rule, Ref, Source, Options)). 391 392rule_head((Head0 :- _Body), Head) :- !, Head = Head0. 393rule_head((Head0,_Cond => _Body), Head) :- !, Head = Head0. 394rule_head((Head0 => _Body), Head) :- !, Head = Head0. 395rule_head(?=>(Head0, _Body), Head) :- !, Head = Head0. 396rule_head(Head, Head).
400list_clause(_Rule, Ref, _Source, Options) :- 401 option(source(true), Options), 402 ( clause_property(Ref, file(File)), 403 clause_property(Ref, line_count(Line)), 404 catch(source_clause_string(File, Line, String, Repositioned), 405 _, fail), 406 debug(listing(source), 'Read ~w:~d: "~s"~n', [File, Line, String]) 407 -> !, 408 ( Repositioned == true 409 -> comment('% From ~w:~d~n', [ File, Line ]) 410 ; true 411 ), 412 writeln(String) 413 ; decompiled 414 -> fail 415 ; asserta(decompiled), 416 comment('% From database (decompiled)~n', []), 417 fail % try next clause 418 ). 419list_clause(Module:(Head:-Body), Ref, Source, Options) :- 420 !, 421 list_clause(Module:Head, Body, :-, Ref, Source, Options). 422list_clause(Module:(Head=>Body), Ref, Source, Options) :- 423 list_clause(Module:Head, Body, =>, Ref, Source, Options). 424list_clause(Module:Head, Ref, Source, Options) :- 425 !, 426 list_clause(Module:Head, true, :-, Ref, Source, Options). 427 428list_clause(Module:Head, Body, Neck, Ref, Source, Options) :- 429 restore_variable_names(Module, Head, Body, Ref, Options), 430 write_module(Module, Source, Head), 431 Rule =.. [Neck,Head,Body], 432 portray_clause(Rule).
variable_names(source) is true.439restore_variable_names(Module, Head, Body, Ref, Options) :- 440 option(variable_names(source), Options, source), 441 catch(clause_info(Ref, _, _, _, 442 [ head(QHead), 443 body(Body), 444 variable_names(Bindings) 445 ]), 446 _, true), 447 unify_head(Module, Head, QHead), 448 !, 449 bind_vars(Bindings), 450 name_other_vars((Head:-Body), Bindings). 451restore_variable_names(_,_,_,_,_). 452 453unify_head(Module, Head, Module:Head) :- 454 !. 455unify_head(_, Head, Head) :- 456 !. 457unify_head(_, _, _). 458 459bind_vars([]) :- 460 !. 461bind_vars([Name = Var|T]) :- 462 ignore(Var = '$VAR'(Name)), 463 bind_vars(T).
470name_other_vars(Term, Bindings) :- 471 term_singletons(Term, Singletons), 472 bind_singletons(Singletons), 473 term_variables(Term, Vars), 474 name_vars(Vars, 0, Bindings). 475 476bind_singletons([]). 477bind_singletons(['$VAR'('_')|T]) :- 478 bind_singletons(T). 479 480name_vars([], _, _). 481name_vars([H|T], N, Bindings) :- 482 between(N, infinite, N2), 483 var_name(N2, Name), 484 \+ memberchk(Name=_, Bindings), 485 !, 486 H = '$VAR'(N2), 487 N3 is N2 + 1, 488 name_vars(T, N3, Bindings). 489 490var_name(I, Name) :- % must be kept in sync with writeNumberVar() 491 L is (I mod 26)+0'A, 492 N is I // 26, 493 ( N == 0 494 -> char_code(Name, L) 495 ; format(atom(Name), '~c~d', [L, N]) 496 ). 497 498write_module(Module, Context, Head) :- 499 hide_module(Module, Context, Head), 500 !. 501write_module(Module, _, _) :- 502 format('~q:', [Module]). 503 504hide_module(system, Module, Head) :- 505 predicate_property(Module:Head, imported_from(M)), 506 predicate_property(system:Head, imported_from(M)), 507 !. 508hide_module(Module, Module, _) :- !. 509 510notify_changed(Pred, Context) :- 511 strip_module(Pred, user, Head), 512 predicate_property(Head, built_in), 513 \+ predicate_property(Head, (dynamic)), 514 !, 515 decl_term(Pred, Context, Decl), 516 comment('% NOTE: system definition has been overruled for ~q~n', 517 [Decl]). 518notify_changed(_, _).
525source_clause_string(File, Line, String, Repositioned) :- 526 open_source(File, Line, Stream, Repositioned), 527 stream_property(Stream, position(Start)), 528 '$raw_read'(Stream, _TextWithoutComments), 529 stream_property(Stream, position(End)), 530 stream_position_data(char_count, Start, StartChar), 531 stream_position_data(char_count, End, EndChar), 532 Length is EndChar - StartChar, 533 set_stream_position(Stream, Start), 534 read_string(Stream, Length, String), 535 skip_blanks_and_comments(Stream, blank). 536 537skip_blanks_and_comments(Stream, _) :- 538 at_end_of_stream(Stream), 539 !. 540skip_blanks_and_comments(Stream, State0) :- 541 peek_string(Stream, 80, String), 542 string_chars(String, Chars), 543 phrase(blanks_and_comments(State0, State), Chars, Rest), 544 ( Rest == [] 545 -> read_string(Stream, 80, _), 546 skip_blanks_and_comments(Stream, State) 547 ; length(Chars, All), 548 length(Rest, RLen), 549 Skip is All-RLen, 550 read_string(Stream, Skip, _) 551 ). 552 553blanks_and_comments(State0, State) --> 554 [C], 555 { transition(C, State0, State1) }, 556 !, 557 blanks_and_comments(State1, State). 558blanks_and_comments(State, State) --> 559 []. 560 561transition(C, blank, blank) :- 562 char_type(C, space). 563transition('%', blank, line_comment). 564transition('\n', line_comment, blank). 565transition(_, line_comment, line_comment). 566transition('/', blank, comment_0). 567transition('/', comment(N), comment(N,/)). 568transition('*', comment(N,/), comment(N1)) :- 569 N1 is N + 1. 570transition('*', comment_0, comment(1)). 571transition('*', comment(N), comment(N,*)). 572transition('/', comment(N,*), State) :- 573 ( N == 1 574 -> State = blank 575 ; N2 is N - 1, 576 State = comment(N2) 577 ). 578 579 580open_source(File, Line, Stream, Repositioned) :- 581 source_stream(File, Stream, Pos0, Repositioned), 582 line_count(Stream, Line0), 583 ( Line >= Line0 584 -> Skip is Line - Line0 585 ; set_stream_position(Stream, Pos0), 586 Skip is Line - 1 587 ), 588 debug(listing(source), '~w: skip ~d to ~d', [File, Line0, Line]), 589 ( Skip =\= 0 590 -> Repositioned = true 591 ; true 592 ), 593 forall(between(1, Skip, _), 594 skip(Stream, 0'\n)). 595 596:- thread_local 597 opened_source/3, 598 decompiled/0. 599 600source_stream(File, Stream, Pos0, _) :- 601 opened_source(File, Stream, Pos0), 602 !. 603source_stream(File, Stream, Pos0, true) :- 604 open(File, read, Stream), 605 stream_property(Stream, position(Pos0)), 606 asserta(opened_source(File, Stream, Pos0)). 607 608close_sources :- 609 retractall(decompiled), 610 forall(retract(opened_source(_,Stream,_)), 611 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.642% The prolog_list_goal/1 hook is a dubious as it may lead to 643% confusion if the heads relates to other bodies. For now it is 644% only used for XPCE methods and works just nice. 645% 646% Not really ... It may confuse the source-level debugger. 647 648%portray_clause(Head :- _Body) :- 649% user:prolog_list_goal(Head), !. 650portray_clause(Term) :- 651 current_output(Out), 652 portray_clause(Out, Term). 653 654portray_clause(Stream, Term) :- 655 must_be(stream, Stream), 656 portray_clause(Stream, Term, []). 657 658portray_clause(Stream, Term, M:Options) :- 659 must_be(list, Options), 660 meta_options(is_meta, M:Options, QOptions), 661 \+ \+ name_vars_and_portray_clause(Stream, Term, QOptions). 662 663name_vars_and_portray_clause(Stream, Term, Options) :- 664 term_attvars(Term, []), 665 !, 666 clause_vars(Term, Options), 667 do_portray_clause(Stream, Term, Options). 668name_vars_and_portray_clause(Stream, Term, Options) :- 669 option(variable_names(Bindings), Options), 670 !, 671 copy_term_nat(Term+Bindings, Copy+BCopy), 672 bind_vars(BCopy), 673 name_other_vars(Copy, BCopy), 674 do_portray_clause(Stream, Copy, Options). 675name_vars_and_portray_clause(Stream, Term, Options) :- 676 copy_term_nat(Term, Copy), 677 clause_vars(Copy, Options), 678 do_portray_clause(Stream, Copy, Options). 679 680clause_vars(Clause, Options) :- 681 option(variable_names(Bindings), Options), 682 !, 683 bind_vars(Bindings), 684 name_other_vars(Clause, Bindings). 685clause_vars(Clause, _) :- 686 numbervars(Clause, 0, _, 687 [ singletons(true) 688 ]). 689 690is_meta(portray_goal). 691 692do_portray_clause(Out, Var, Options) :- 693 var(Var), 694 !, 695 option(indent(LeftMargin), Options, 0), 696 indent(Out, LeftMargin), 697 pprint(Out, Var, 1200, Options). 698do_portray_clause(Out, (Head :- true), Options) :- 699 !, 700 option(indent(LeftMargin), Options, 0), 701 indent(Out, LeftMargin), 702 pprint(Out, Head, 1200, Options), 703 full_stop(Out). 704do_portray_clause(Out, Term, Options) :- 705 clause_term(Term, Head, Neck, Body), 706 !, 707 option(indent(LeftMargin), Options, 0), 708 inc_indent(LeftMargin, 1, Indent), 709 infix_op(Neck, RightPri, LeftPri), 710 indent(Out, LeftMargin), 711 pprint(Out, Head, LeftPri, Options), 712 format(Out, ' ~w', [Neck]), 713 ( nonvar(Body), 714 Body = Module:LocalBody, 715 \+ primitive(LocalBody) 716 -> nlindent(Out, Indent), 717 format(Out, '~q', [Module]), 718 '$put_token'(Out, :), 719 nlindent(Out, Indent), 720 write(Out, '( '), 721 inc_indent(Indent, 1, BodyIndent), 722 portray_body(LocalBody, BodyIndent, noindent, 1200, Out, Options), 723 nlindent(Out, Indent), 724 write(Out, ')') 725 ; setting(listing:body_indentation, BodyIndent0), 726 BodyIndent is LeftMargin+BodyIndent0, 727 portray_body(Body, BodyIndent, indent, RightPri, Out, Options) 728 ), 729 full_stop(Out). 730do_portray_clause(Out, (:-Directive), Options) :- 731 wrapped_list_directive(Directive), 732 !, 733 Directive =.. [Name, Arg, List], 734 option(indent(LeftMargin), Options, 0), 735 indent(Out, LeftMargin), 736 format(Out, ':- ~q(', [Name]), 737 line_position(Out, Indent), 738 format(Out, '~q,', [Arg]), 739 nlindent(Out, Indent), 740 portray_list(List, Indent, Out, Options), 741 write(Out, ').\n'). 742do_portray_clause(Out, Clause, Options) :- 743 directive(Clause, Op, Directive), 744 !, 745 option(indent(LeftMargin), Options, 0), 746 indent(Out, LeftMargin), 747 format(Out, '~w ', [Op]), 748 DIndent is LeftMargin+3, 749 portray_body(Directive, DIndent, noindent, 1199, Out, Options), 750 full_stop(Out). 751do_portray_clause(Out, Fact, Options) :- 752 option(indent(LeftMargin), Options, 0), 753 indent(Out, LeftMargin), 754 portray_body(Fact, LeftMargin, noindent, 1200, Out, Options), 755 full_stop(Out). 756 757clause_term((Head:-Body), Head, :-, Body). 758clause_term((Head=>Body), Head, =>, Body). 759clause_term(?=>(Head,Body), Head, ?=>, Body). 760clause_term((Head-->Body), Head, -->, Body). 761 762full_stop(Out) :- 763 '$put_token'(Out, '.'), 764 nl(Out). 765 766directive((:- Directive), :-, Directive). 767directive((?- Directive), ?-, Directive). 768 769wrapped_list_directive(module(_,_)). 770%wrapped_list_directive(use_module(_,_)). 771%wrapped_list_directive(autoload(_,_)).
778portray_body(Var, _, _, Pri, Out, Options) :- 779 var(Var), 780 !, 781 pprint(Out, Var, Pri, Options). 782portray_body(!, _, _, _, Out, _) :- 783 setting(listing:cut_on_same_line, true), 784 !, 785 write(Out, ' !'). 786portray_body((!, Clause), Indent, _, Pri, Out, Options) :- 787 setting(listing:cut_on_same_line, true), 788 \+ term_needs_braces((_,_), Pri), 789 !, 790 write(Out, ' !,'), 791 portray_body(Clause, Indent, indent, 1000, Out, Options). 792portray_body(Term, Indent, indent, Pri, Out, Options) :- 793 !, 794 nlindent(Out, Indent), 795 portray_body(Term, Indent, noindent, Pri, Out, Options). 796portray_body(Or, Indent, _, _, Out, Options) :- 797 or_layout(Or), 798 !, 799 write(Out, '( '), 800 portray_or(Or, Indent, 1200, Out, Options), 801 nlindent(Out, Indent), 802 write(Out, ')'). 803portray_body(Term, Indent, _, Pri, Out, Options) :- 804 term_needs_braces(Term, Pri), 805 !, 806 write(Out, '( '), 807 ArgIndent is Indent + 2, 808 portray_body(Term, ArgIndent, noindent, 1200, Out, Options), 809 nlindent(Out, Indent), 810 write(Out, ')'). 811portray_body(((AB),C), Indent, _, _Pri, Out, Options) :- 812 nonvar(AB), 813 AB = (A,B), 814 !, 815 infix_op(',', LeftPri, RightPri), 816 portray_body(A, Indent, noindent, LeftPri, Out, Options), 817 write(Out, ','), 818 portray_body((B,C), Indent, indent, RightPri, Out, Options). 819portray_body((A,B), Indent, _, _Pri, Out, Options) :- 820 !, 821 infix_op(',', LeftPri, RightPri), 822 portray_body(A, Indent, noindent, LeftPri, Out, Options), 823 write(Out, ','), 824 portray_body(B, Indent, indent, RightPri, Out, Options). 825portray_body(\+(Goal), Indent, _, _Pri, Out, Options) :- 826 !, 827 write(Out, \+), write(Out, ' '), 828 prefix_op(\+, ArgPri), 829 ArgIndent is Indent+3, 830 portray_body(Goal, ArgIndent, noindent, ArgPri, Out, Options). 831portray_body(Call, _, _, _, Out, Options) :- % requires knowledge on the module! 832 m_callable(Call), 833 option(module(M), Options, user), 834 predicate_property(M:Call, meta_predicate(Meta)), 835 !, 836 portray_meta(Out, Call, Meta, Options). 837portray_body(Clause, _, _, Pri, Out, Options) :- 838 pprint(Out, Clause, Pri, Options). 839 840m_callable(Term) :- 841 strip_module(Term, _, Plain), 842 callable(Plain), 843 Plain \= (_:_). 844 845term_needs_braces(Term, Pri) :- 846 callable(Term), 847 functor(Term, Name, _Arity), 848 current_op(OpPri, _Type, Name), 849 OpPri > Pri, 850 !.
854portray_or(Term, Indent, Pri, Out, Options) :- 855 term_needs_braces(Term, Pri), 856 !, 857 inc_indent(Indent, 1, NewIndent), 858 write(Out, '( '), 859 portray_or(Term, NewIndent, Out, Options), 860 nlindent(Out, NewIndent), 861 write(Out, ')'). 862portray_or(Term, Indent, _Pri, Out, Options) :- 863 or_layout(Term), 864 !, 865 portray_or(Term, Indent, Out, Options). 866portray_or(Term, Indent, Pri, Out, Options) :- 867 inc_indent(Indent, 1, NestIndent), 868 portray_body(Term, NestIndent, noindent, Pri, Out, Options). 869 870 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 ; Else), 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_body(Then, NestIndent, noindent, RightPri, Out, Options), 891 nlindent(Out, Indent), 892 write(Out, '; '), 893 infix_op(;, _LeftPri, RightPri2), 894 portray_or(Else, Indent, RightPri2, Out, Options). 895portray_or((If -> Then), Indent, Out, Options) :- 896 !, 897 inc_indent(Indent, 1, NestIndent), 898 infix_op((->), LeftPri, RightPri), 899 portray_body(If, NestIndent, noindent, LeftPri, Out, Options), 900 nlindent(Out, Indent), 901 write(Out, '-> '), 902 portray_or(Then, Indent, RightPri, Out, Options). 903portray_or((If *-> Then), Indent, Out, Options) :- 904 !, 905 inc_indent(Indent, 1, NestIndent), 906 infix_op((->), LeftPri, RightPri), 907 portray_body(If, NestIndent, noindent, LeftPri, Out, Options), 908 nlindent(Out, Indent), 909 write(Out, '*-> '), 910 portray_or(Then, Indent, RightPri, Out, Options). 911portray_or((A;B), Indent, Out, Options) :- 912 !, 913 inc_indent(Indent, 1, NestIndent), 914 infix_op(;, LeftPri, RightPri), 915 portray_body(A, NestIndent, noindent, LeftPri, Out, Options), 916 nlindent(Out, Indent), 917 write(Out, '; '), 918 portray_or(B, Indent, RightPri, Out, Options). 919portray_or((A|B), Indent, Out, Options) :- 920 !, 921 inc_indent(Indent, 1, NestIndent), 922 infix_op('|', LeftPri, RightPri), 923 portray_body(A, NestIndent, noindent, LeftPri, Out, Options), 924 nlindent(Out, Indent), 925 write(Out, '| '), 926 portray_or(B, Indent, RightPri, Out, Options).
934infix_op(Op, Left, Right) :- 935 current_op(Pri, Assoc, Op), 936 infix_assoc(Assoc, LeftMin, RightMin), 937 !, 938 Left is Pri - LeftMin, 939 Right is Pri - RightMin. 940 941infix_assoc(xfx, 1, 1). 942infix_assoc(xfy, 1, 0). 943infix_assoc(yfx, 0, 1). 944 945prefix_op(Op, ArgPri) :- 946 current_op(Pri, Assoc, Op), 947 pre_assoc(Assoc, ArgMin), 948 !, 949 ArgPri is Pri - ArgMin. 950 951pre_assoc(fx, 1). 952pre_assoc(fy, 0). 953 954postfix_op(Op, ArgPri) :- 955 current_op(Pri, Assoc, Op), 956 post_assoc(Assoc, ArgMin), 957 !, 958 ArgPri is Pri - ArgMin. 959 960post_assoc(xf, 1). 961post_assoc(yf, 0).
970or_layout(Var) :- 971 var(Var), !, fail. 972or_layout((_;_)). 973or_layout((_->_)). 974or_layout((_*->_)). 975 976primitive(G) :- 977 or_layout(G), !, fail. 978primitive((_,_)) :- !, fail. 979primitive(_).
988portray_meta(Out, Call, Meta, Options) :- 989 contains_non_primitive_meta_arg(Call, Meta), 990 !, 991 Call =.. [Name|Args], 992 Meta =.. [_|Decls], 993 format(Out, '~q(', [Name]), 994 line_position(Out, Indent), 995 portray_meta_args(Decls, Args, Indent, Out, Options), 996 format(Out, ')', []). 997portray_meta(Out, Call, _, Options) :- 998 pprint(Out, Call, 999, Options). 999 1000contains_non_primitive_meta_arg(Call, Decl) :- 1001 arg(I, Call, CA), 1002 arg(I, Decl, DA), 1003 integer(DA), 1004 \+ primitive(CA), 1005 !. 1006 1007portray_meta_args([], [], _, _, _). 1008portray_meta_args([D|DT], [A|AT], Indent, Out, Options) :- 1009 portray_meta_arg(D, A, Out, Options), 1010 ( DT == [] 1011 -> true 1012 ; format(Out, ',', []), 1013 nlindent(Out, Indent), 1014 portray_meta_args(DT, AT, Indent, Out, Options) 1015 ). 1016 1017portray_meta_arg(I, A, Out, Options) :- 1018 integer(I), 1019 !, 1020 line_position(Out, Indent), 1021 portray_body(A, Indent, noindent, 999, Out, Options). 1022portray_meta_arg(_, A, Out, Options) :- 1023 pprint(Out, A, 999, Options).
[ element1, [ element1 element2, OR | tail ] ]
1033portray_list([], _, Out, _) :- 1034 !, 1035 write(Out, []). 1036portray_list(List, Indent, Out, Options) :- 1037 write(Out, '[ '), 1038 EIndent is Indent + 2, 1039 portray_list_elements(List, EIndent, Out, Options), 1040 nlindent(Out, Indent), 1041 write(Out, ']'). 1042 1043portray_list_elements([H|T], EIndent, Out, Options) :- 1044 pprint(Out, H, 999, Options), 1045 ( T == [] 1046 -> true 1047 ; nonvar(T), T = [_|_] 1048 -> write(Out, ','), 1049 nlindent(Out, EIndent), 1050 portray_list_elements(T, EIndent, Out, Options) 1051 ; Indent is EIndent - 2, 1052 nlindent(Out, Indent), 1053 write(Out, '| '), 1054 pprint(Out, T, 999, Options) 1055 ).
1069pprint(Out, Term, _, Options) :- 1070 nonvar(Term), 1071 Term = {}(Arg), 1072 line_position(Out, Indent), 1073 ArgIndent is Indent + 2, 1074 format(Out, '{ ', []), 1075 portray_body(Arg, ArgIndent, noident, 1000, Out, Options), 1076 nlindent(Out, Indent), 1077 format(Out, '}', []). 1078pprint(Out, Term, Pri, Options) :- 1079 ( compound(Term) 1080 -> compound_name_arity(Term, _, Arity), 1081 Arity > 0 1082 ; is_dict(Term) 1083 ), 1084 \+ nowrap_term(Term), 1085 setting(listing:line_width, Width), 1086 Width > 0, 1087 ( write_length(Term, Len, [max_length(Width)|Options]) 1088 -> true 1089 ; Len = Width 1090 ), 1091 line_position(Out, Indent), 1092 Indent + Len > Width, 1093 Len > Width/4, % ad-hoc rule for deeply nested goals 1094 !, 1095 pprint_wrapped(Out, Term, Pri, Options). 1096pprint(Out, Term, Pri, Options) :- 1097 listing_write_options(Pri, WrtOptions, Options), 1098 write_term(Out, Term, 1099 [ blobs(portray), 1100 portray_goal(portray_blob) 1101 | WrtOptions 1102 ]). 1103 1104portray_blob(Blob, _Options) :- 1105 blob(Blob, _), 1106 \+ atom(Blob), 1107 !, 1108 format(string(S), '~q', [Blob]), 1109 format('~q', ['$BLOB'(S)]). 1110 1111nowrap_term('$VAR'(_)) :- !. 1112nowrap_term(_{}) :- !. % empty dict 1113nowrap_term(Term) :- 1114 functor(Term, Name, Arity), 1115 current_op(_, _, Name), 1116 ( Arity == 2 1117 -> infix_op(Name, _, _) 1118 ; Arity == 1 1119 -> ( prefix_op(Name, _) 1120 -> true 1121 ; postfix_op(Name, _) 1122 ) 1123 ). 1124 1125 1126pprint_wrapped(Out, Term, _, Options) :- 1127 Term = [_|_], 1128 !, 1129 line_position(Out, Indent), 1130 portray_list(Term, Indent, Out, Options). 1131pprint_wrapped(Out, Dict, _, Options) :- 1132 is_dict(Dict), 1133 !, 1134 dict_pairs(Dict, Tag, Pairs), 1135 pprint(Out, Tag, 1200, Options), 1136 format(Out, '{ ', []), 1137 line_position(Out, Indent), 1138 pprint_nv(Pairs, Indent, Out, Options), 1139 nlindent(Out, Indent-2), 1140 format(Out, '}', []). 1141pprint_wrapped(Out, Term, _, Options) :- 1142 Term =.. [Name|Args], 1143 format(Out, '~q(', [Name]), 1144 line_position(Out, Indent), 1145 pprint_args(Args, Indent, Out, Options), 1146 format(Out, ')', []). 1147 1148pprint_args([], _, _, _). 1149pprint_args([H|T], Indent, Out, Options) :- 1150 pprint(Out, H, 999, Options), 1151 ( T == [] 1152 -> true 1153 ; format(Out, ',', []), 1154 nlindent(Out, Indent), 1155 pprint_args(T, Indent, Out, Options) 1156 ). 1157 1158 1159pprint_nv([], _, _, _). 1160pprint_nv([Name-Value|T], Indent, Out, Options) :- 1161 pprint(Out, Name, 999, Options), 1162 format(Out, ':', []), 1163 pprint(Out, Value, 999, Options), 1164 ( T == [] 1165 -> true 1166 ; format(Out, ',', []), 1167 nlindent(Out, Indent), 1168 pprint_nv(T, Indent, Out, Options) 1169 ).
1177listing_write_options(Pri,
1178 [ quoted(true),
1179 numbervars(true),
1180 priority(Pri),
1181 spacing(next_argument)
1182 | Options
1183 ],
1184 Options).1192nlindent(Out, N) :- 1193 nl(Out), 1194 indent(Out, N). 1195 1196indent(Out, N) :- 1197 setting(listing:tab_distance, D), 1198 ( D =:= 0 1199 -> tab(Out, N) 1200 ; Tab is N // D, 1201 Space is N mod D, 1202 put_tabs(Out, Tab), 1203 tab(Out, Space) 1204 ). 1205 1206put_tabs(Out, N) :- 1207 N > 0, 1208 !, 1209 put(Out, 0'\t), 1210 NN is N - 1, 1211 put_tabs(Out, NN). 1212put_tabs(_, _).
1219inc_indent(Indent0, Inc, Indent) :- 1220 Indent is Indent0 + Inc*4. 1221 1222:- multifile 1223 sandbox:safe_meta/2. 1224 1225sandbox:safe_meta(listing(What), []) :- 1226 not_qualified(What). 1227 1228not_qualified(Var) :- 1229 var(Var), 1230 !. 1231not_qualified(_:_) :- !, fail. 1232not_qualified(_).
1239comment(Format, Args) :- 1240 stream_property(current_output, tty(true)), 1241 setting(listing:comment_ansi_attributes, Attributes), 1242 Attributes \== [], 1243 !, 1244 ansi_format(Attributes, Format, Args). 1245comment(Format, Args) :- 1246 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.