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