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 @(clause(Head, Body, Ref), Context), 221 list_clause(Head, Body, 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 generalise_term(Head, GenHead), 380 forall(( clause(Module:, Body, Ref), 381 \+ GenHead \= Head 382 ), 383 list_clause(Module:GenHead, Body, Ref, Source, Options)). 384 385generalise_term(Head, Gen) :- 386 compound(Head), 387 !, 388 compound_name_arity(Head, Name, Arity), 389 compound_name_arity(Gen, Name, Arity). 390generalise_term(Head, Head). 391 392list_clause(_Head, _Body, Ref, _Source, Options) :- 393 option(source(true), Options), 394 ( clause_property(Ref, file(File)), 395 clause_property(Ref, line_count(Line)), 396 catch(source_clause_string(File, Line, String, Repositioned), 397 _, fail), 398 debug(listing(source), 'Read ~w:~d: "~s"~n', [File, Line, String]) 399 -> !, 400 ( Repositioned == true 401 -> comment('% From ~w:~d~n', [ File, Line ]) 402 ; true 403 ), 404 writeln(String) 405 ; decompiled 406 -> fail 407 ; asserta(decompiled), 408 comment('% From database (decompiled)~n', []), 409 fail % try next clause 410 ). 411list_clause(Module:Head, Body, Ref, Source, Options) :- 412 restore_variable_names(Module, Head, Body, Ref, Options), 413 write_module(Module, Source, Head), 414 portray_clause((Head:-Body)).
variable_names(source) is true.421restore_variable_names(Module, Head, Body, Ref, Options) :- 422 option(variable_names(source), Options, source), 423 catch(clause_info(Ref, _, _, _, 424 [ head(QHead), 425 body(Body), 426 variable_names(Bindings) 427 ]), 428 _, true), 429 unify_head(Module, Head, QHead), 430 !, 431 bind_vars(Bindings), 432 name_other_vars((Head:-Body), Bindings). 433restore_variable_names(_,_,_,_,_). 434 435unify_head(Module, Head, Module:Head) :- 436 !. 437unify_head(_, Head, Head) :- 438 !. 439unify_head(_, _, _). 440 441bind_vars([]) :- 442 !. 443bind_vars([Name = Var|T]) :- 444 ignore(Var = '$VAR'(Name)), 445 bind_vars(T).
452name_other_vars(Term, Bindings) :- 453 term_singletons(Term, Singletons), 454 bind_singletons(Singletons), 455 term_variables(Term, Vars), 456 name_vars(Vars, 0, Bindings). 457 458bind_singletons([]). 459bind_singletons(['$VAR'('_')|T]) :- 460 bind_singletons(T). 461 462name_vars([], _, _). 463name_vars([H|T], N, Bindings) :- 464 between(N, infinite, N2), 465 var_name(N2, Name), 466 \+ memberchk(Name=_, Bindings), 467 !, 468 H = '$VAR'(N2), 469 N3 is N2 + 1, 470 name_vars(T, N3, Bindings). 471 472var_name(I, Name) :- % must be kept in sync with writeNumberVar() 473 L is (I mod 26)+0'A, 474 N is I // 26, 475 ( N == 0 476 -> char_code(Name, L) 477 ; format(atom(Name), '~c~d', [L, N]) 478 ). 479 480write_module(Module, Context, Head) :- 481 hide_module(Module, Context, Head), 482 !. 483write_module(Module, _, _) :- 484 format('~q:', [Module]). 485 486hide_module(system, Module, Head) :- 487 predicate_property(Module:Head, imported_from(M)), 488 predicate_property(system:Head, imported_from(M)), 489 !. 490hide_module(Module, Module, _) :- !. 491 492notify_changed(Pred, Context) :- 493 strip_module(Pred, user, Head), 494 predicate_property(Head, built_in), 495 \+ predicate_property(Head, (dynamic)), 496 !, 497 decl_term(Pred, Context, Decl), 498 comment('% NOTE: system definition has been overruled for ~q~n', 499 [Decl]). 500notify_changed(_, _).
507source_clause_string(File, Line, String, Repositioned) :- 508 open_source(File, Line, Stream, Repositioned), 509 stream_property(Stream, position(Start)), 510 '$raw_read'(Stream, _TextWithoutComments), 511 stream_property(Stream, position(End)), 512 stream_position_data(char_count, Start, StartChar), 513 stream_position_data(char_count, End, EndChar), 514 Length is EndChar - StartChar, 515 set_stream_position(Stream, Start), 516 read_string(Stream, Length, String), 517 skip_blanks_and_comments(Stream, blank). 518 519skip_blanks_and_comments(Stream, _) :- 520 at_end_of_stream(Stream), 521 !. 522skip_blanks_and_comments(Stream, State0) :- 523 peek_string(Stream, 80, String), 524 string_chars(String, Chars), 525 phrase(blanks_and_comments(State0, State), Chars, Rest), 526 ( Rest == [] 527 -> read_string(Stream, 80, _), 528 skip_blanks_and_comments(Stream, State) 529 ; length(Chars, All), 530 length(Rest, RLen), 531 Skip is All-RLen, 532 read_string(Stream, Skip, _) 533 ). 534 535blanks_and_comments(State0, State) --> 536 [C], 537 { transition(C, State0, State1) }, 538 !, 539 blanks_and_comments(State1, State). 540blanks_and_comments(State, State) --> 541 []. 542 543transition(C, blank, blank) :- 544 char_type(C, space). 545transition('%', blank, line_comment). 546transition('\n', line_comment, blank). 547transition(_, line_comment, line_comment). 548transition('/', blank, comment_0). 549transition('/', comment(N), comment(N,/)). 550transition('*', comment(N,/), comment(N1)) :- 551 N1 is N + 1. 552transition('*', comment_0, comment(1)). 553transition('*', comment(N), comment(N,*)). 554transition('/', comment(N,*), State) :- 555 ( N == 1 556 -> State = blank 557 ; N2 is N - 1, 558 State = comment(N2) 559 ). 560 561 562open_source(File, Line, Stream, Repositioned) :- 563 source_stream(File, Stream, Pos0, Repositioned), 564 line_count(Stream, Line0), 565 ( Line >= Line0 566 -> Skip is Line - Line0 567 ; set_stream_position(Stream, Pos0), 568 Skip is Line - 1 569 ), 570 debug(listing(source), '~w: skip ~d to ~d', [File, Line0, Line]), 571 ( Skip =\= 0 572 -> Repositioned = true 573 ; true 574 ), 575 forall(between(1, Skip, _), 576 skip(Stream, 0'\n)). 577 578:- thread_local 579 opened_source/3, 580 decompiled/0. 581 582source_stream(File, Stream, Pos0, _) :- 583 opened_source(File, Stream, Pos0), 584 !. 585source_stream(File, Stream, Pos0, true) :- 586 open(File, read, Stream), 587 stream_property(Stream, position(Pos0)), 588 asserta(opened_source(File, Stream, Pos0)). 589 590close_sources :- 591 retractall(decompiled), 592 forall(retract(opened_source(_,Stream,_)), 593 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.624% The prolog_list_goal/1 hook is a dubious as it may lead to 625% confusion if the heads relates to other bodies. For now it is 626% only used for XPCE methods and works just nice. 627% 628% Not really ... It may confuse the source-level debugger. 629 630%portray_clause(Head :- _Body) :- 631% user:prolog_list_goal(Head), !. 632portray_clause(Term) :- 633 current_output(Out), 634 portray_clause(Out, Term). 635 636portray_clause(Stream, Term) :- 637 must_be(stream, Stream), 638 portray_clause(Stream, Term, []). 639 640portray_clause(Stream, Term, M:Options) :- 641 must_be(list, Options), 642 meta_options(is_meta, M:Options, QOptions), 643 \+ \+ name_vars_and_portray_clause(Stream, Term, QOptions). 644 645name_vars_and_portray_clause(Stream, Term, Options) :- 646 term_attvars(Term, []), 647 !, 648 clause_vars(Term, Options), 649 do_portray_clause(Stream, Term, Options). 650name_vars_and_portray_clause(Stream, Term, Options) :- 651 option(variable_names(Bindings), Options), 652 !, 653 copy_term_nat(Term+Bindings, Copy+BCopy), 654 bind_vars(BCopy), 655 name_other_vars(Copy, BCopy), 656 do_portray_clause(Stream, Copy, Options). 657name_vars_and_portray_clause(Stream, Term, Options) :- 658 copy_term_nat(Term, Copy), 659 clause_vars(Copy, Options), 660 do_portray_clause(Stream, Copy, Options). 661 662clause_vars(Clause, Options) :- 663 option(variable_names(Bindings), Options), 664 !, 665 bind_vars(Bindings), 666 name_other_vars(Clause, Bindings). 667clause_vars(Clause, _) :- 668 numbervars(Clause, 0, _, 669 [ singletons(true) 670 ]). 671 672is_meta(portray_goal). 673 674do_portray_clause(Out, Var, Options) :- 675 var(Var), 676 !, 677 option(indent(LeftMargin), Options, 0), 678 indent(Out, LeftMargin), 679 pprint(Out, Var, 1200, Options). 680do_portray_clause(Out, (Head :- true), Options) :- 681 !, 682 option(indent(LeftMargin), Options, 0), 683 indent(Out, LeftMargin), 684 pprint(Out, Head, 1200, Options), 685 full_stop(Out). 686do_portray_clause(Out, Term, Options) :- 687 clause_term(Term, Head, Neck, Body), 688 !, 689 option(indent(LeftMargin), Options, 0), 690 inc_indent(LeftMargin, 1, Indent), 691 infix_op(Neck, RightPri, LeftPri), 692 indent(Out, LeftMargin), 693 pprint(Out, Head, LeftPri, Options), 694 format(Out, ' ~w', [Neck]), 695 ( nonvar(Body), 696 Body = Module:LocalBody, 697 \+ primitive(LocalBody) 698 -> nlindent(Out, Indent), 699 format(Out, '~q', [Module]), 700 '$put_token'(Out, :), 701 nlindent(Out, Indent), 702 write(Out, '( '), 703 inc_indent(Indent, 1, BodyIndent), 704 portray_body(LocalBody, BodyIndent, noindent, 1200, Out, Options), 705 nlindent(Out, Indent), 706 write(Out, ')') 707 ; setting(listing:body_indentation, BodyIndent0), 708 BodyIndent is LeftMargin+BodyIndent0, 709 portray_body(Body, BodyIndent, indent, RightPri, Out, Options) 710 ), 711 full_stop(Out). 712do_portray_clause(Out, (:-Directive), Options) :- 713 wrapped_list_directive(Directive), 714 !, 715 Directive =.. [Name, Arg, List], 716 option(indent(LeftMargin), Options, 0), 717 indent(Out, LeftMargin), 718 format(Out, ':- ~q(', [Name]), 719 line_position(Out, Indent), 720 format(Out, '~q,', [Arg]), 721 nlindent(Out, Indent), 722 portray_list(List, Indent, Out, Options), 723 write(Out, ').\n'). 724do_portray_clause(Out, (:-Directive), Options) :- 725 !, 726 option(indent(LeftMargin), Options, 0), 727 indent(Out, LeftMargin), 728 write(Out, ':- '), 729 DIndent is LeftMargin+3, 730 portray_body(Directive, DIndent, noindent, 1199, Out, Options), 731 full_stop(Out). 732do_portray_clause(Out, Fact, Options) :- 733 option(indent(LeftMargin), Options, 0), 734 indent(Out, LeftMargin), 735 portray_body(Fact, LeftMargin, noindent, 1200, Out, Options), 736 full_stop(Out). 737 738clause_term((Head:-Body), Head, :-, Body). 739clause_term((Head-->Body), Head, -->, Body). 740 741full_stop(Out) :- 742 '$put_token'(Out, '.'), 743 nl(Out). 744 745wrapped_list_directive(module(_,_)). 746%wrapped_list_directive(use_module(_,_)). 747%wrapped_list_directive(autoload(_,_)).
754portray_body(Var, _, _, Pri, Out, Options) :- 755 var(Var), 756 !, 757 pprint(Out, Var, Pri, Options). 758portray_body(!, _, _, _, Out, _) :- 759 setting(listing:cut_on_same_line, true), 760 !, 761 write(Out, ' !'). 762portray_body((!, Clause), Indent, _, Pri, Out, Options) :- 763 setting(listing:cut_on_same_line, true), 764 \+ term_needs_braces((_,_), Pri), 765 !, 766 write(Out, ' !,'), 767 portray_body(Clause, Indent, indent, 1000, Out, Options). 768portray_body(Term, Indent, indent, Pri, Out, Options) :- 769 !, 770 nlindent(Out, Indent), 771 portray_body(Term, Indent, noindent, Pri, Out, Options). 772portray_body(Or, Indent, _, _, Out, Options) :- 773 or_layout(Or), 774 !, 775 write(Out, '( '), 776 portray_or(Or, Indent, 1200, Out, Options), 777 nlindent(Out, Indent), 778 write(Out, ')'). 779portray_body(Term, Indent, _, Pri, Out, Options) :- 780 term_needs_braces(Term, Pri), 781 !, 782 write(Out, '( '), 783 ArgIndent is Indent + 2, 784 portray_body(Term, ArgIndent, noindent, 1200, Out, Options), 785 nlindent(Out, Indent), 786 write(Out, ')'). 787portray_body(((AB),C), Indent, _, _Pri, Out, Options) :- 788 nonvar(AB), 789 AB = (A,B), 790 !, 791 infix_op(',', LeftPri, RightPri), 792 portray_body(A, Indent, noindent, LeftPri, Out, Options), 793 write(Out, ','), 794 portray_body((B,C), Indent, indent, RightPri, Out, Options). 795portray_body((A,B), Indent, _, _Pri, Out, Options) :- 796 !, 797 infix_op(',', LeftPri, RightPri), 798 portray_body(A, Indent, noindent, LeftPri, Out, Options), 799 write(Out, ','), 800 portray_body(B, Indent, indent, RightPri, Out, Options). 801portray_body(\+(Goal), Indent, _, _Pri, Out, Options) :- 802 !, 803 write(Out, \+), write(Out, ' '), 804 prefix_op(\+, ArgPri), 805 ArgIndent is Indent+3, 806 portray_body(Goal, ArgIndent, noindent, ArgPri, Out, Options). 807portray_body(Call, _, _, _, Out, Options) :- % requires knowledge on the module! 808 m_callable(Call), 809 option(module(M), Options, user), 810 predicate_property(M:Call, meta_predicate(Meta)), 811 !, 812 portray_meta(Out, Call, Meta, Options). 813portray_body(Clause, _, _, Pri, Out, Options) :- 814 pprint(Out, Clause, Pri, Options). 815 816m_callable(Term) :- 817 strip_module(Term, _, Plain), 818 callable(Plain), 819 Plain \= (_:_). 820 821term_needs_braces(Term, Pri) :- 822 callable(Term), 823 functor(Term, Name, _Arity), 824 current_op(OpPri, _Type, Name), 825 OpPri > Pri, 826 !.
830portray_or(Term, Indent, Pri, Out, Options) :- 831 term_needs_braces(Term, Pri), 832 !, 833 inc_indent(Indent, 1, NewIndent), 834 write(Out, '( '), 835 portray_or(Term, NewIndent, Out, Options), 836 nlindent(Out, NewIndent), 837 write(Out, ')'). 838portray_or(Term, Indent, _Pri, Out, Options) :- 839 or_layout(Term), 840 !, 841 portray_or(Term, Indent, Out, Options). 842portray_or(Term, Indent, Pri, Out, Options) :- 843 inc_indent(Indent, 1, NestIndent), 844 portray_body(Term, NestIndent, noindent, Pri, Out, Options). 845 846 847portray_or((If -> Then ; Else), Indent, Out, Options) :- 848 !, 849 inc_indent(Indent, 1, NestIndent), 850 infix_op((->), LeftPri, RightPri), 851 portray_body(If, NestIndent, noindent, LeftPri, Out, Options), 852 nlindent(Out, Indent), 853 write(Out, '-> '), 854 portray_body(Then, NestIndent, noindent, RightPri, Out, Options), 855 nlindent(Out, Indent), 856 write(Out, '; '), 857 infix_op(;, _LeftPri, RightPri2), 858 portray_or(Else, Indent, RightPri2, Out, Options). 859portray_or((If *-> Then ; Else), Indent, Out, Options) :- 860 !, 861 inc_indent(Indent, 1, NestIndent), 862 infix_op((*->), LeftPri, RightPri), 863 portray_body(If, NestIndent, noindent, LeftPri, Out, Options), 864 nlindent(Out, Indent), 865 write(Out, '*-> '), 866 portray_body(Then, NestIndent, noindent, RightPri, Out, Options), 867 nlindent(Out, Indent), 868 write(Out, '; '), 869 infix_op(;, _LeftPri, RightPri2), 870 portray_or(Else, Indent, RightPri2, Out, Options). 871portray_or((If -> Then), 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_or(Then, Indent, RightPri, Out, Options). 879portray_or((If *-> Then), Indent, Out, Options) :- 880 !, 881 inc_indent(Indent, 1, NestIndent), 882 infix_op((->), LeftPri, RightPri), 883 portray_body(If, NestIndent, noindent, LeftPri, Out, Options), 884 nlindent(Out, Indent), 885 write(Out, '*-> '), 886 portray_or(Then, Indent, RightPri, Out, Options). 887portray_or((A;B), Indent, Out, Options) :- 888 !, 889 inc_indent(Indent, 1, NestIndent), 890 infix_op(;, LeftPri, RightPri), 891 portray_body(A, NestIndent, noindent, LeftPri, Out, Options), 892 nlindent(Out, Indent), 893 write(Out, '; '), 894 portray_or(B, Indent, RightPri, Out, Options). 895portray_or((A|B), Indent, Out, Options) :- 896 !, 897 inc_indent(Indent, 1, NestIndent), 898 infix_op('|', LeftPri, RightPri), 899 portray_body(A, NestIndent, noindent, LeftPri, Out, Options), 900 nlindent(Out, Indent), 901 write(Out, '| '), 902 portray_or(B, Indent, RightPri, Out, Options).
910infix_op(Op, Left, Right) :- 911 current_op(Pri, Assoc, Op), 912 infix_assoc(Assoc, LeftMin, RightMin), 913 !, 914 Left is Pri - LeftMin, 915 Right is Pri - RightMin. 916 917infix_assoc(xfx, 1, 1). 918infix_assoc(xfy, 1, 0). 919infix_assoc(yfx, 0, 1). 920 921prefix_op(Op, ArgPri) :- 922 current_op(Pri, Assoc, Op), 923 pre_assoc(Assoc, ArgMin), 924 !, 925 ArgPri is Pri - ArgMin. 926 927pre_assoc(fx, 1). 928pre_assoc(fy, 0). 929 930postfix_op(Op, ArgPri) :- 931 current_op(Pri, Assoc, Op), 932 post_assoc(Assoc, ArgMin), 933 !, 934 ArgPri is Pri - ArgMin. 935 936post_assoc(xf, 1). 937post_assoc(yf, 0).
946or_layout(Var) :- 947 var(Var), !, fail. 948or_layout((_;_)). 949or_layout((_->_)). 950or_layout((_*->_)). 951 952primitive(G) :- 953 or_layout(G), !, fail. 954primitive((_,_)) :- !, fail. 955primitive(_).
964portray_meta(Out, Call, Meta, Options) :- 965 contains_non_primitive_meta_arg(Call, Meta), 966 !, 967 Call =.. [Name|Args], 968 Meta =.. [_|Decls], 969 format(Out, '~q(', [Name]), 970 line_position(Out, Indent), 971 portray_meta_args(Decls, Args, Indent, Out, Options), 972 format(Out, ')', []). 973portray_meta(Out, Call, _, Options) :- 974 pprint(Out, Call, 999, Options). 975 976contains_non_primitive_meta_arg(Call, Decl) :- 977 arg(I, Call, CA), 978 arg(I, Decl, DA), 979 integer(DA), 980 \+ primitive(CA), 981 !. 982 983portray_meta_args([], [], _, _, _). 984portray_meta_args([D|DT], [A|AT], Indent, Out, Options) :- 985 portray_meta_arg(D, A, Out, Options), 986 ( DT == [] 987 -> true 988 ; format(Out, ',', []), 989 nlindent(Out, Indent), 990 portray_meta_args(DT, AT, Indent, Out, Options) 991 ). 992 993portray_meta_arg(I, A, Out, Options) :- 994 integer(I), 995 !, 996 line_position(Out, Indent), 997 portray_body(A, Indent, noindent, 999, Out, Options). 998portray_meta_arg(_, A, Out, Options) :- 999 pprint(Out, A, 999, Options).
[ element1, [ element1 element2, OR | tail ] ]
1009portray_list([], _, Out, _) :- 1010 !, 1011 write(Out, []). 1012portray_list(List, Indent, Out, Options) :- 1013 write(Out, '[ '), 1014 EIndent is Indent + 2, 1015 portray_list_elements(List, EIndent, Out, Options), 1016 nlindent(Out, Indent), 1017 write(Out, ']'). 1018 1019portray_list_elements([H|T], EIndent, Out, Options) :- 1020 pprint(Out, H, 999, Options), 1021 ( T == [] 1022 -> true 1023 ; nonvar(T), T = [_|_] 1024 -> write(Out, ','), 1025 nlindent(Out, EIndent), 1026 portray_list_elements(T, EIndent, Out, Options) 1027 ; Indent is EIndent - 2, 1028 nlindent(Out, Indent), 1029 write(Out, '| '), 1030 pprint(Out, T, 999, Options) 1031 ).
1045pprint(Out, Term, _, Options) :- 1046 nonvar(Term), 1047 Term = {}(Arg), 1048 line_position(Out, Indent), 1049 ArgIndent is Indent + 2, 1050 format(Out, '{ ', []), 1051 portray_body(Arg, ArgIndent, noident, 1000, Out, Options), 1052 nlindent(Out, Indent), 1053 format(Out, '}', []). 1054pprint(Out, Term, Pri, Options) :- 1055 ( compound(Term) 1056 -> compound_name_arity(Term, _, Arity), 1057 Arity > 0 1058 ; is_dict(Term) 1059 ), 1060 \+ nowrap_term(Term), 1061 setting(listing:line_width, Width), 1062 Width > 0, 1063 ( write_length(Term, Len, [max_length(Width)|Options]) 1064 -> true 1065 ; Len = Width 1066 ), 1067 line_position(Out, Indent), 1068 Indent + Len > Width, 1069 Len > Width/4, % ad-hoc rule for deeply nested goals 1070 !, 1071 pprint_wrapped(Out, Term, Pri, Options). 1072pprint(Out, Term, Pri, Options) :- 1073 listing_write_options(Pri, WrtOptions, Options), 1074 write_term(Out, Term, 1075 [ blobs(portray), 1076 portray_goal(portray_blob) 1077 | WrtOptions 1078 ]). 1079 1080portray_blob(Blob, _Options) :- 1081 blob(Blob, _), 1082 \+ atom(Blob), 1083 !, 1084 format(string(S), '~q', [Blob]), 1085 format('~q', ['$BLOB'(S)]). 1086 1087nowrap_term('$VAR'(_)) :- !. 1088nowrap_term(_{}) :- !. % empty dict 1089nowrap_term(Term) :- 1090 functor(Term, Name, Arity), 1091 current_op(_, _, Name), 1092 ( Arity == 2 1093 -> infix_op(Name, _, _) 1094 ; Arity == 1 1095 -> ( prefix_op(Name, _) 1096 -> true 1097 ; postfix_op(Name, _) 1098 ) 1099 ). 1100 1101 1102pprint_wrapped(Out, Term, _, Options) :- 1103 Term = [_|_], 1104 !, 1105 line_position(Out, Indent), 1106 portray_list(Term, Indent, Out, Options). 1107pprint_wrapped(Out, Dict, _, Options) :- 1108 is_dict(Dict), 1109 !, 1110 dict_pairs(Dict, Tag, Pairs), 1111 pprint(Out, Tag, 1200, Options), 1112 format(Out, '{ ', []), 1113 line_position(Out, Indent), 1114 pprint_nv(Pairs, Indent, Out, Options), 1115 nlindent(Out, Indent-2), 1116 format(Out, '}', []). 1117pprint_wrapped(Out, Term, _, Options) :- 1118 Term =.. [Name|Args], 1119 format(Out, '~q(', Name), 1120 line_position(Out, Indent), 1121 pprint_args(Args, Indent, Out, Options), 1122 format(Out, ')', []). 1123 1124pprint_args([], _, _, _). 1125pprint_args([H|T], Indent, Out, Options) :- 1126 pprint(Out, H, 999, Options), 1127 ( T == [] 1128 -> true 1129 ; format(Out, ',', []), 1130 nlindent(Out, Indent), 1131 pprint_args(T, Indent, Out, Options) 1132 ). 1133 1134 1135pprint_nv([], _, _, _). 1136pprint_nv([Name-Value|T], Indent, Out, Options) :- 1137 pprint(Out, Name, 999, Options), 1138 format(Out, ':', []), 1139 pprint(Out, Value, 999, Options), 1140 ( T == [] 1141 -> true 1142 ; format(Out, ',', []), 1143 nlindent(Out, Indent), 1144 pprint_nv(T, Indent, Out, Options) 1145 ).
1153listing_write_options(Pri,
1154 [ quoted(true),
1155 numbervars(true),
1156 priority(Pri),
1157 spacing(next_argument)
1158 | Options
1159 ],
1160 Options).1168nlindent(Out, N) :- 1169 nl(Out), 1170 indent(Out, N). 1171 1172indent(Out, N) :- 1173 setting(listing:tab_distance, D), 1174 ( D =:= 0 1175 -> tab(Out, N) 1176 ; Tab is N // D, 1177 Space is N mod D, 1178 put_tabs(Out, Tab), 1179 tab(Out, Space) 1180 ). 1181 1182put_tabs(Out, N) :- 1183 N > 0, 1184 !, 1185 put(Out, 0'\t), 1186 NN is N - 1, 1187 put_tabs(Out, NN). 1188put_tabs(_, _).
1195inc_indent(Indent0, Inc, Indent) :- 1196 Indent is Indent0 + Inc*4. 1197 1198:- multifile 1199 sandbox:safe_meta/2. 1200 1201sandbox:safe_meta(listing(What), []) :- 1202 not_qualified(What). 1203 1204not_qualified(Var) :- 1205 var(Var), 1206 !. 1207not_qualified(_:_) :- !, fail. 1208not_qualified(_).
1215comment(Format, Args) :- 1216 stream_property(current_output, tty(true)), 1217 setting(listing:comment_ansi_attributes, Attributes), 1218 Attributes \== [], 1219 !, 1220 ansi_format(Attributes, Format, Args). 1221comment(Format, Args) :- 1222 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.