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