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(lists)). 46:- use_module(library(apply)). 47:- use_module(library(settings)). 48:- use_module(library(option)). 49:- use_module(library(error)). 50:- use_module(library(debug)). 51:- use_module(library(ansi_term)). 52:- use_module(library(prolog_clause)). 53:- set_prolog_flag(generate_debug_info, false). 54 55:- module_transparent 56 listing/0. 57:- meta_predicate 58 listing(), 59 listing(, ), 60 portray_clause(,,). 61 62:- predicate_options(portray_clause/3, 3, [pass_to(system:write_term/3, 3)]). 63 64:- multifile 65 prolog:locate_clauses/2. % +Spec, -ClauseRefList
96:- setting(listing:body_indentation, nonneg, 4, 97 'Indentation used goals in the body'). 98:- setting(listing:tab_distance, nonneg, 0, 99 'Distance between tab-stops. 0 uses only spaces'). 100:- setting(listing:cut_on_same_line, boolean, false, 101 'Place cuts (!) on the same line'). 102:- setting(listing:line_width, nonneg, 78, 103 'Width of a line. 0 is infinite'). 104:- setting(listing:comment_ansi_attributes, list, [fg(green)], 105 'ansi_format/3 attributes to print comments').
mymodule, use one of the calls below.
?- mymodule:listing. ?- listing(mymodule:_).
119listing :- 120 context_module(Context), 121 list_module(Context, []). 122 123list_module(Module, Options) :- 124 ( current_predicate(_, Module:Pred), 125 \+ predicate_property(Module:Pred, imported_from(_)), 126 strip_module(Pred, _Module, Head), 127 functor(Head, Name, _Arity), 128 ( ( predicate_property(Module:Pred, built_in) 129 ; sub_atom(Name, 0, _, _, $) 130 ) 131 -> current_prolog_flag(access_level, system) 132 ; true 133 ), 134 nl, 135 list_predicate(Module:Head, Module, Options), 136 fail 137 ; true 138 ).
?- 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)]).
184listing(Spec) :- 185 listing(Spec, []). 186 187listing(Spec, Options) :- 188 call_cleanup( 189 listing_(Spec, Options), 190 close_sources). 191 192listing_(M:Spec, Options) :- 193 var(Spec), 194 !, 195 list_module(M, Options). 196listing_(M:List, Options) :- 197 is_list(List), 198 !, 199 forall(member(Spec, List), 200 listing_(M:Spec, Options)). 201listing_(X, Options) :- 202 ( prolog:locate_clauses(X, ClauseRefs) 203 -> strip_module(X, Context, _), 204 list_clauserefs(ClauseRefs, Context, Options) 205 ; '$find_predicate'(X, Preds), 206 list_predicates(Preds, X, Options) 207 ). 208 209list_clauserefs([], _, _) :- !. 210list_clauserefs([H|T], Context, Options) :- 211 !, 212 list_clauserefs(H, Context, Options), 213 list_clauserefs(T, Context, Options). 214list_clauserefs(Ref, Context, Options) :- 215 @(clause(Head, Body, Ref), Context), 216 list_clause(Head, Body, Ref, Context, Options).
220list_predicates(PIs, Context:X, Options) :- 221 member(PI, PIs), 222 pi_to_head(PI, Pred), 223 unify_args(Pred, X), 224 list_define(Pred, DefPred), 225 list_predicate(DefPred, Context, Options), 226 nl, 227 fail. 228list_predicates(_, _, _). 229 230list_define(Head, LoadModule:Head) :- 231 compound(Head), 232 Head \= (_:_), 233 functor(Head, Name, Arity), 234 '$find_library'(_, Name, Arity, LoadModule, Library), 235 !, 236 use_module(Library, []). 237list_define(M:Pred, DefM:Pred) :- 238 '$define_predicate'(M:Pred), 239 ( predicate_property(M:Pred, imported_from(DefM)) 240 -> true 241 ; DefM = M 242 ). 243 244pi_to_head(PI, _) :- 245 var(PI), 246 !, 247 instantiation_error(PI). 248pi_to_head(M:PI, M:Head) :- 249 !, 250 pi_to_head(PI, Head). 251pi_to_head(Name/Arity, Head) :- 252 functor(Head, Name, Arity). 253 254 255% Unify the arguments of the specification with the given term, 256% so we can partially instantate the head. 257 258unify_args(_, _/_) :- !. % Name/arity spec 259unify_args(X, X) :- !. 260unify_args(_:X, X) :- !. 261unify_args(_, _). 262 263list_predicate(Pred, Context, _) :- 264 predicate_property(Pred, undefined), 265 !, 266 decl_term(Pred, Context, Decl), 267 comment('% Undefined: ~q~n', [Decl]). 268list_predicate(Pred, Context, _) :- 269 predicate_property(Pred, foreign), 270 !, 271 decl_term(Pred, Context, Decl), 272 comment('% Foreign: ~q~n', [Decl]). 273list_predicate(Pred, Context, Options) :- 274 notify_changed(Pred, Context), 275 list_declarations(Pred, Context), 276 list_clauses(Pred, Context, Options). 277 278decl_term(Pred, Context, Decl) :- 279 strip_module(Pred, Module, Head), 280 functor(Head, Name, Arity), 281 ( hide_module(Module, Context, Head) 282 -> Decl = Name/Arity 283 ; Decl = Module:Name/Arity 284 ). 285 286 287decl(thread_local, thread_local). 288decl(dynamic, dynamic). 289decl(volatile, volatile). 290decl(multifile, multifile). 291decl(public, public).
301declaration(Pred, Source, Decl) :- 302 predicate_property(Pred, tabled), 303 Pred = M:Head, 304 ( M:'$table_mode'(Head, Head, _) 305 -> decl_term(Pred, Source, Funct), 306 table_options(Pred, Funct, TableDecl), 307 Decl = table(TableDecl) 308 ; comment('% tabled using answer subsumption', []), 309 fail % TBD 310 ). 311declaration(Pred, Source, Decl) :- 312 decl(Prop, Declname), 313 predicate_property(Pred, Prop), 314 decl_term(Pred, Source, Funct), 315 Decl =.. [ Declname, Funct ]. 316declaration(Pred, Source, Decl) :- 317 predicate_property(Pred, meta_predicate(Head)), 318 strip_module(Pred, Module, _), 319 ( (Module == system; Source == Module) 320 -> Decl = meta_predicate(Head) 321 ; Decl = meta_predicate(Module:Head) 322 ), 323 ( meta_implies_transparent(Head) 324 -> ! % hide transparent 325 ; true 326 ). 327declaration(Pred, Source, Decl) :- 328 predicate_property(Pred, transparent), 329 decl_term(Pred, Source, PI), 330 Decl = module_transparent(PI).
337meta_implies_transparent(Head):- 338 compound(Head), 339 arg(_, Head, Arg), 340 implies_transparent(Arg), 341 !. 342 343implies_transparent(Arg) :- 344 integer(Arg), 345 !. 346implies_transparent(:). 347implies_transparent(//). 348implies_transparent(^). 349 350table_options(Pred, Decl0, as(Decl0, Options)) :- 351 findall(Flag, predicate_property(Pred, tabled(Flag)), [F0|Flags]), 352 !, 353 foldl(table_option, Flags, F0, Options). 354table_options(_, Decl, Decl). 355 356table_option(Flag, X, (Flag,X)). 357 358list_declarations(Pred, Source) :- 359 findall(Decl, declaration(Pred, Source, Decl), Decls), 360 ( Decls == [] 361 -> true 362 ; write_declarations(Decls, Source), 363 format('~n', []) 364 ). 365 366 367write_declarations([], _) :- !. 368write_declarations([H|T], Module) :- 369 format(':- ~q.~n', [H]), 370 write_declarations(T, Module). 371 372list_clauses(Pred, Source, Options) :- 373 strip_module(Pred, Module, Head), 374 forall(clause(Pred, Body, Ref), 375 list_clause(Module:Head, Body, Ref, Source, Options)). 376 377list_clause(_Head, _Body, Ref, _Source, Options) :- 378 option(source(true), Options), 379 ( clause_property(Ref, file(File)), 380 clause_property(Ref, line_count(Line)), 381 catch(source_clause_string(File, Line, String, Repositioned), 382 _, fail), 383 debug(listing(source), 'Read ~w:~d: "~s"~n', [File, Line, String]) 384 -> !, 385 ( Repositioned == true 386 -> comment('% From ~w:~d~n', [ File, Line ]) 387 ; true 388 ), 389 writeln(String) 390 ; decompiled 391 -> fail 392 ; asserta(decompiled), 393 comment('% From database (decompiled)~n', []), 394 fail % try next clause 395 ). 396list_clause(Module:Head, Body, Ref, Source, Options) :- 397 restore_variable_names(Module, Head, Body, Ref, Options), 398 write_module(Module, Source, Head), 399 portray_clause((Head:-Body)).
variable_names(source) is true.406restore_variable_names(Module, Head, Body, Ref, Options) :- 407 option(variable_names(source), Options, source), 408 catch(clause_info(Ref, _, _, _, 409 [ head(QHead), 410 body(Body), 411 variable_names(Bindings) 412 ]), 413 _, true), 414 unify_head(Module, Head, QHead), 415 !, 416 bind_vars(Bindings), 417 name_other_vars((Head:-Body), Bindings). 418restore_variable_names(_,_,_,_,_). 419 420unify_head(Module, Head, Module:Head) :- 421 !. 422unify_head(_, Head, Head) :- 423 !. 424unify_head(_, _, _). 425 426bind_vars([]) :- 427 !. 428bind_vars([Name = Var|T]) :- 429 ignore(Var = '$VAR'(Name)), 430 bind_vars(T).
437name_other_vars(Term, Bindings) :- 438 term_singletons(Term, Singletons), 439 bind_singletons(Singletons), 440 term_variables(Term, Vars), 441 name_vars(Vars, 0, Bindings). 442 443bind_singletons([]). 444bind_singletons(['$VAR'('_')|T]) :- 445 bind_singletons(T). 446 447name_vars([], _, _). 448name_vars([H|T], N, Bindings) :- 449 between(N, infinite, N2), 450 var_name(N2, Name), 451 \+ memberchk(Name=_, Bindings), 452 !, 453 H = '$VAR'(N2), 454 N3 is N2 + 1, 455 name_vars(T, N3, Bindings). 456 457var_name(I, Name) :- % must be kept in sync with writeNumberVar() 458 L is (I mod 26)+0'A, 459 N is I // 26, 460 ( N == 0 461 -> char_code(Name, L) 462 ; format(atom(Name), '~c~d', [L, N]) 463 ). 464 465write_module(Module, Context, Head) :- 466 hide_module(Module, Context, Head), 467 !. 468write_module(Module, _, _) :- 469 format('~q:', [Module]). 470 471hide_module(system, Module, Head) :- 472 predicate_property(Module:Head, imported_from(M)), 473 predicate_property(system:Head, imported_from(M)), 474 !. 475hide_module(Module, Module, _) :- !. 476 477notify_changed(Pred, Context) :- 478 strip_module(Pred, user, Head), 479 predicate_property(Head, built_in), 480 \+ predicate_property(Head, (dynamic)), 481 !, 482 decl_term(Pred, Context, Decl), 483 comment('% NOTE: system definition has been overruled for ~q~n', 484 [Decl]). 485notify_changed(_, _).
492source_clause_string(File, Line, String, Repositioned) :- 493 open_source(File, Line, Stream, Repositioned), 494 stream_property(Stream, position(Start)), 495 '$raw_read'(Stream, _TextWithoutComments), 496 stream_property(Stream, position(End)), 497 stream_position_data(char_count, Start, StartChar), 498 stream_position_data(char_count, End, EndChar), 499 Length is EndChar - StartChar, 500 set_stream_position(Stream, Start), 501 read_string(Stream, Length, String), 502 skip_blanks_and_comments(Stream, blank). 503 504skip_blanks_and_comments(Stream, _) :- 505 at_end_of_stream(Stream), 506 !. 507skip_blanks_and_comments(Stream, State0) :- 508 peek_string(Stream, 80, String), 509 string_chars(String, Chars), 510 phrase(blanks_and_comments(State0, State), Chars, Rest), 511 ( Rest == [] 512 -> read_string(Stream, 80, _), 513 skip_blanks_and_comments(Stream, State) 514 ; length(Chars, All), 515 length(Rest, RLen), 516 Skip is All-RLen, 517 read_string(Stream, Skip, _) 518 ). 519 520blanks_and_comments(State0, State) --> 521 [C], 522 { transition(C, State0, State1) }, 523 !, 524 blanks_and_comments(State1, State). 525blanks_and_comments(State, State) --> 526 []. 527 528transition(C, blank, blank) :- 529 char_type(C, space). 530transition('%', blank, line_comment). 531transition('\n', line_comment, blank). 532transition(_, line_comment, line_comment). 533transition('/', blank, comment_0). 534transition('/', comment(N), comment(N,/)). 535transition('*', comment(N,/), comment(N1)) :- 536 N1 is N + 1. 537transition('*', comment_0, comment(1)). 538transition('*', comment(N), comment(N,*)). 539transition('/', comment(N,*), State) :- 540 ( N == 1 541 -> State = blank 542 ; N2 is N - 1, 543 State = comment(N2) 544 ). 545 546 547open_source(File, Line, Stream, Repositioned) :- 548 source_stream(File, Stream, Pos0, Repositioned), 549 line_count(Stream, Line0), 550 ( Line >= Line0 551 -> Skip is Line - Line0 552 ; set_stream_position(Stream, Pos0), 553 Skip is Line - 1 554 ), 555 debug(listing(source), '~w: skip ~d to ~d', [File, Line0, Line]), 556 ( Skip =\= 0 557 -> Repositioned = true 558 ; true 559 ), 560 forall(between(1, Skip, _), 561 skip(Stream, 0'\n)). 562 563:- thread_local 564 opened_source/3, 565 decompiled/0. 566 567source_stream(File, Stream, Pos0, _) :- 568 opened_source(File, Stream, Pos0), 569 !. 570source_stream(File, Stream, Pos0, true) :- 571 open(File, read, Stream), 572 stream_property(Stream, position(Pos0)), 573 asserta(opened_source(File, Stream, Pos0)). 574 575close_sources :- 576 retractall(decompiled), 577 forall(retract(opened_source(_,Stream,_)), 578 close(Stream)).
If Options is provided, the option-list is passed to write_term/3 that does the final writing of arguments.
595% The prolog_list_goal/1 hook is a dubious as it may lead to 596% confusion if the heads relates to other bodies. For now it is 597% only used for XPCE methods and works just nice. 598% 599% Not really ... It may confuse the source-level debugger. 600 601%portray_clause(Head :- _Body) :- 602% user:prolog_list_goal(Head), !. 603portray_clause(Term) :- 604 current_output(Out), 605 portray_clause(Out, Term). 606 607portray_clause(Stream, Term) :- 608 must_be(stream, Stream), 609 portray_clause(Stream, Term, []). 610 611portray_clause(Stream, Term, M:Options) :- 612 must_be(list, Options), 613 meta_options(is_meta, M:Options, QOptions), 614 \+ \+ ( copy_term_nat(Term, Copy), 615 numbervars(Copy, 0, _, 616 [ singletons(true) 617 ]), 618 do_portray_clause(Stream, Copy, QOptions) 619 ). 620 621is_meta(portray_goal). 622 623do_portray_clause(Out, Var, Options) :- 624 var(Var), 625 !, 626 option(indent(LeftMargin), Options, 0), 627 indent(Out, LeftMargin), 628 pprint(Out, Var, 1200, Options). 629do_portray_clause(Out, (Head :- true), Options) :- 630 !, 631 option(indent(LeftMargin), Options, 0), 632 indent(Out, LeftMargin), 633 pprint(Out, Head, 1200, Options), 634 full_stop(Out). 635do_portray_clause(Out, Term, Options) :- 636 clause_term(Term, Head, Neck, Body), 637 !, 638 option(indent(LeftMargin), Options, 0), 639 inc_indent(LeftMargin, 1, Indent), 640 infix_op(Neck, RightPri, LeftPri), 641 indent(Out, LeftMargin), 642 pprint(Out, Head, LeftPri, Options), 643 format(Out, ' ~w', [Neck]), 644 ( nonvar(Body), 645 Body = Module:LocalBody, 646 \+ primitive(LocalBody) 647 -> nlindent(Out, Indent), 648 format(Out, '~q', [Module]), 649 '$put_token'(Out, :), 650 nlindent(Out, Indent), 651 write(Out, '( '), 652 inc_indent(Indent, 1, BodyIndent), 653 portray_body(LocalBody, BodyIndent, noindent, 1200, Out, Options), 654 nlindent(Out, Indent), 655 write(Out, ')') 656 ; setting(listing:body_indentation, BodyIndent0), 657 BodyIndent is LeftMargin+BodyIndent0, 658 portray_body(Body, BodyIndent, indent, RightPri, Out, Options) 659 ), 660 full_stop(Out). 661do_portray_clause(Out, (:-use_module(File, Imports)), Options) :- 662 length(Imports, Len), 663 Len > 3, 664 !, 665 option(indent(LeftMargin), Options, 0), 666 indent(Out, LeftMargin), 667 ListIndent is LeftMargin+14, 668 format(Out, ':- use_module(~q,', [File]), 669 portray_list(Imports, ListIndent, Out, Options), 670 write(Out, ').\n'). 671do_portray_clause(Out, (:-module(Module, Exports)), Options) :- 672 !, 673 option(indent(LeftMargin), Options, 0), 674 indent(Out, LeftMargin), 675 ModuleIndent is LeftMargin+10, 676 format(Out, ':- module(~q,', [Module]), 677 portray_list(Exports, ModuleIndent, Out, Options), 678 write(Out, ').\n'). 679do_portray_clause(Out, (:-Directive), Options) :- 680 !, 681 option(indent(LeftMargin), Options, 0), 682 indent(Out, LeftMargin), 683 write(Out, ':- '), 684 DIndent is LeftMargin+3, 685 portray_body(Directive, DIndent, noindent, 1199, Out, Options), 686 full_stop(Out). 687do_portray_clause(Out, Fact, Options) :- 688 option(indent(LeftMargin), Options, 0), 689 indent(Out, LeftMargin), 690 portray_body(Fact, LeftMargin, noindent, 1200, Out, Options), 691 full_stop(Out). 692 693clause_term((Head:-Body), Head, :-, Body). 694clause_term((Head-->Body), Head, -->, Body). 695 696full_stop(Out) :- 697 '$put_token'(Out, '.'), 698 nl(Out).
706portray_body(Var, _, _, Pri, Out, Options) :- 707 var(Var), 708 !, 709 pprint(Out, Var, Pri, Options). 710portray_body(!, _, _, _, Out, _) :- 711 setting(listing:cut_on_same_line, true), 712 !, 713 write(Out, ' !'). 714portray_body((!, Clause), Indent, _, Pri, Out, Options) :- 715 setting(listing:cut_on_same_line, true), 716 \+ term_needs_braces((_,_), Pri), 717 !, 718 write(Out, ' !,'), 719 portray_body(Clause, Indent, indent, 1000, Out, Options). 720portray_body(Term, Indent, indent, Pri, Out, Options) :- 721 !, 722 nlindent(Out, Indent), 723 portray_body(Term, Indent, noindent, Pri, Out, Options). 724portray_body(Or, Indent, _, _, Out, Options) :- 725 or_layout(Or), 726 !, 727 write(Out, '( '), 728 portray_or(Or, Indent, 1200, Out, Options), 729 nlindent(Out, Indent), 730 write(Out, ')'). 731portray_body(Term, Indent, _, Pri, Out, Options) :- 732 term_needs_braces(Term, Pri), 733 !, 734 write(Out, '( '), 735 ArgIndent is Indent + 2, 736 portray_body(Term, ArgIndent, noindent, 1200, Out, Options), 737 nlindent(Out, Indent), 738 write(Out, ')'). 739portray_body((A,B), Indent, _, _Pri, Out, Options) :- 740 !, 741 infix_op(',', LeftPri, RightPri), 742 portray_body(A, Indent, noindent, LeftPri, Out, Options), 743 write(Out, ','), 744 portray_body(B, Indent, indent, RightPri, Out, Options). 745portray_body(\+(Goal), Indent, _, _Pri, Out, Options) :- 746 !, 747 write(Out, \+), write(Out, ' '), 748 prefix_op(\+, ArgPri), 749 ArgIndent is Indent+3, 750 portray_body(Goal, ArgIndent, noindent, ArgPri, Out, Options). 751portray_body(Call, _, _, _, Out, Options) :- % requires knowledge on the module! 752 m_callable(Call), 753 option(module(M), Options, user), 754 predicate_property(M:Call, meta_predicate(Meta)), 755 !, 756 portray_meta(Out, Call, Meta, Options). 757portray_body(Clause, _, _, Pri, Out, Options) :- 758 pprint(Out, Clause, Pri, Options). 759 760m_callable(Term) :- 761 strip_module(Term, _, Plain), 762 callable(Plain), 763 Plain \= (_:_). 764 765term_needs_braces(Term, Pri) :- 766 callable(Term), 767 functor(Term, Name, _Arity), 768 current_op(OpPri, _Type, Name), 769 OpPri > Pri, 770 !.
774portray_or(Term, Indent, Pri, Out, Options) :- 775 term_needs_braces(Term, Pri), 776 !, 777 inc_indent(Indent, 1, NewIndent), 778 write(Out, '( '), 779 portray_or(Term, NewIndent, Out, Options), 780 nlindent(Out, NewIndent), 781 write(Out, ')'). 782portray_or(Term, Indent, _Pri, Out, Options) :- 783 or_layout(Term), 784 !, 785 portray_or(Term, Indent, Out, Options). 786portray_or(Term, Indent, Pri, Out, Options) :- 787 inc_indent(Indent, 1, NestIndent), 788 portray_body(Term, NestIndent, noindent, Pri, Out, Options). 789 790 791portray_or((If -> Then ; Else), Indent, Out, Options) :- 792 !, 793 inc_indent(Indent, 1, NestIndent), 794 infix_op((->), LeftPri, RightPri), 795 portray_body(If, NestIndent, noindent, LeftPri, Out, Options), 796 nlindent(Out, Indent), 797 write(Out, '-> '), 798 portray_body(Then, NestIndent, noindent, RightPri, Out, Options), 799 nlindent(Out, Indent), 800 write(Out, '; '), 801 infix_op(;, _LeftPri, RightPri2), 802 portray_or(Else, Indent, RightPri2, Out, Options). 803portray_or((If *-> Then ; Else), Indent, Out, Options) :- 804 !, 805 inc_indent(Indent, 1, NestIndent), 806 infix_op((*->), LeftPri, RightPri), 807 portray_body(If, NestIndent, noindent, LeftPri, Out, Options), 808 nlindent(Out, Indent), 809 write(Out, '*-> '), 810 portray_body(Then, NestIndent, noindent, RightPri, Out, Options), 811 nlindent(Out, Indent), 812 write(Out, '; '), 813 infix_op(;, _LeftPri, RightPri2), 814 portray_or(Else, Indent, RightPri2, Out, Options). 815portray_or((If -> Then), Indent, Out, Options) :- 816 !, 817 inc_indent(Indent, 1, NestIndent), 818 infix_op((->), LeftPri, RightPri), 819 portray_body(If, NestIndent, noindent, LeftPri, Out, Options), 820 nlindent(Out, Indent), 821 write(Out, '-> '), 822 portray_or(Then, Indent, RightPri, Out, Options). 823portray_or((If *-> Then), Indent, Out, Options) :- 824 !, 825 inc_indent(Indent, 1, NestIndent), 826 infix_op((->), LeftPri, RightPri), 827 portray_body(If, NestIndent, noindent, LeftPri, Out, Options), 828 nlindent(Out, Indent), 829 write(Out, '*-> '), 830 portray_or(Then, Indent, RightPri, Out, Options). 831portray_or((A;B), Indent, Out, Options) :- 832 !, 833 inc_indent(Indent, 1, NestIndent), 834 infix_op(;, LeftPri, RightPri), 835 portray_body(A, NestIndent, noindent, LeftPri, Out, Options), 836 nlindent(Out, Indent), 837 write(Out, '; '), 838 portray_or(B, Indent, RightPri, Out, Options). 839portray_or((A|B), Indent, Out, Options) :- 840 !, 841 inc_indent(Indent, 1, NestIndent), 842 infix_op('|', LeftPri, RightPri), 843 portray_body(A, NestIndent, noindent, LeftPri, Out, Options), 844 nlindent(Out, Indent), 845 write(Out, '| '), 846 portray_or(B, Indent, RightPri, Out, Options).
854infix_op(Op, Left, Right) :- 855 current_op(Pri, Assoc, Op), 856 infix_assoc(Assoc, LeftMin, RightMin), 857 !, 858 Left is Pri - LeftMin, 859 Right is Pri - RightMin. 860 861infix_assoc(xfx, 1, 1). 862infix_assoc(xfy, 1, 0). 863infix_assoc(yfx, 0, 1). 864 865prefix_op(Op, ArgPri) :- 866 current_op(Pri, Assoc, Op), 867 pre_assoc(Assoc, ArgMin), 868 !, 869 ArgPri is Pri - ArgMin. 870 871pre_assoc(fx, 1). 872pre_assoc(fy, 0). 873 874postfix_op(Op, ArgPri) :- 875 current_op(Pri, Assoc, Op), 876 post_assoc(Assoc, ArgMin), 877 !, 878 ArgPri is Pri - ArgMin. 879 880post_assoc(xf, 1). 881post_assoc(yf, 0).
890or_layout(Var) :- 891 var(Var), !, fail. 892or_layout((_;_)). 893or_layout((_->_)). 894or_layout((_*->_)). 895 896primitive(G) :- 897 or_layout(G), !, fail. 898primitive((_,_)) :- !, fail. 899primitive(_).
908portray_meta(Out, Call, Meta, Options) :- 909 contains_non_primitive_meta_arg(Call, Meta), 910 !, 911 Call =.. [Name|Args], 912 Meta =.. [_|Decls], 913 format(Out, '~q(', [Name]), 914 line_position(Out, Indent), 915 portray_meta_args(Decls, Args, Indent, Out, Options), 916 format(Out, ')', []). 917portray_meta(Out, Call, _, Options) :- 918 pprint(Out, Call, 999, Options). 919 920contains_non_primitive_meta_arg(Call, Decl) :- 921 arg(I, Call, CA), 922 arg(I, Decl, DA), 923 integer(DA), 924 \+ primitive(CA), 925 !. 926 927portray_meta_args([], [], _, _, _). 928portray_meta_args([D|DT], [A|AT], Indent, Out, Options) :- 929 portray_meta_arg(D, A, Out, Options), 930 ( DT == [] 931 -> true 932 ; format(Out, ',', []), 933 nlindent(Out, Indent), 934 portray_meta_args(DT, AT, Indent, Out, Options) 935 ). 936 937portray_meta_arg(I, A, Out, Options) :- 938 integer(I), 939 !, 940 line_position(Out, Indent), 941 portray_body(A, Indent, noindent, 999, Out, Options). 942portray_meta_arg(_, A, Out, Options) :- 943 pprint(Out, A, 999, Options).
[ element1, [ element1 element2, OR | tail ] ]
953portray_list([], _, Out, _) :- 954 !, 955 write(Out, []). 956portray_list(List, Indent, Out, Options) :- 957 nlindent(Out, Indent), 958 write(Out, '[ '), 959 EIndent is Indent + 2, 960 portray_list_elements(List, EIndent, Out, Options), 961 nlindent(Out, Indent), 962 write(Out, ']'). 963 964portray_list_elements([H|T], EIndent, Out, Options) :- 965 pprint(Out, H, 999, Options), 966 ( T == [] 967 -> true 968 ; nonvar(T), T = [_|_] 969 -> write(Out, ','), 970 nlindent(Out, EIndent), 971 portray_list_elements(T, EIndent, Out, Options) 972 ; Indent is EIndent - 2, 973 nlindent(Out, Indent), 974 write(Out, '| '), 975 pprint(Out, T, 999, Options) 976 ).
990pprint(Out, Term, _, Options) :- 991 nonvar(Term), 992 Term = {}(Arg), 993 line_position(Out, Indent), 994 ArgIndent is Indent + 2, 995 format(Out, '{ ', []), 996 portray_body(Arg, ArgIndent, noident, 1000, Out, Options), 997 nlindent(Out, Indent), 998 format(Out, '}', []). 999pprint(Out, Term, Pri, Options) :- 1000 ( compound(Term) 1001 -> compound_name_arity(Term, _, Arity), 1002 Arity > 0 1003 ; is_dict(Term) 1004 ), 1005 \+ nowrap_term(Term), 1006 setting(listing:line_width, Width), 1007 Width > 0, 1008 ( write_length(Term, Len, [max_length(Width)|Options]) 1009 -> true 1010 ; Len = Width 1011 ), 1012 line_position(Out, Indent), 1013 Indent + Len > Width, 1014 Len > Width/4, % ad-hoc rule for deeply nested goals 1015 !, 1016 pprint_wrapped(Out, Term, Pri, Options). 1017pprint(Out, Term, Pri, Options) :- 1018 listing_write_options(Pri, WrtOptions, Options), 1019 write_term(Out, Term, WrtOptions). 1020 1021nowrap_term('$VAR'(_)) :- !. 1022nowrap_term(_{}) :- !. % empty dict 1023nowrap_term(Term) :- 1024 functor(Term, Name, Arity), 1025 current_op(_, _, Name), 1026 ( Arity == 2 1027 -> infix_op(Name, _, _) 1028 ; Arity == 1 1029 -> ( prefix_op(Name, _) 1030 -> true 1031 ; postfix_op(Name, _) 1032 ) 1033 ). 1034 1035 1036pprint_wrapped(Out, Term, _, Options) :- 1037 Term = [_|_], 1038 !, 1039 line_position(Out, Indent), 1040 portray_list(Term, Indent, Out, Options). 1041pprint_wrapped(Out, Dict, _, Options) :- 1042 is_dict(Dict), 1043 !, 1044 dict_pairs(Dict, Tag, Pairs), 1045 pprint(Out, Tag, 1200, Options), 1046 format(Out, '{ ', []), 1047 line_position(Out, Indent), 1048 pprint_nv(Pairs, Indent, Out, Options), 1049 nlindent(Out, Indent-2), 1050 format(Out, '}', []). 1051pprint_wrapped(Out, Term, _, Options) :- 1052 Term =.. [Name|Args], 1053 format(Out, '~q(', Name), 1054 line_position(Out, Indent), 1055 pprint_args(Args, Indent, Out, Options), 1056 format(Out, ')', []). 1057 1058pprint_args([], _, _, _). 1059pprint_args([H|T], Indent, Out, Options) :- 1060 pprint(Out, H, 999, Options), 1061 ( T == [] 1062 -> true 1063 ; format(Out, ',', []), 1064 nlindent(Out, Indent), 1065 pprint_args(T, Indent, Out, Options) 1066 ). 1067 1068 1069pprint_nv([], _, _, _). 1070pprint_nv([Name-Value|T], Indent, Out, Options) :- 1071 pprint(Out, Name, 999, Options), 1072 format(Out, ':', []), 1073 pprint(Out, Value, 999, Options), 1074 ( T == [] 1075 -> true 1076 ; format(Out, ',', []), 1077 nlindent(Out, Indent), 1078 pprint_nv(T, Indent, Out, Options) 1079 ).
1087listing_write_options(Pri,
1088 [ quoted(true),
1089 numbervars(true),
1090 priority(Pri),
1091 spacing(next_argument)
1092 | Options
1093 ],
1094 Options).1102nlindent(Out, N) :- 1103 nl(Out), 1104 indent(Out, N). 1105 1106indent(Out, N) :- 1107 setting(listing:tab_distance, D), 1108 ( D =:= 0 1109 -> tab(Out, N) 1110 ; Tab is N // D, 1111 Space is N mod D, 1112 put_tabs(Out, Tab), 1113 tab(Out, Space) 1114 ). 1115 1116put_tabs(Out, N) :- 1117 N > 0, 1118 !, 1119 put(Out, 0'\t), 1120 NN is N - 1, 1121 put_tabs(Out, NN). 1122put_tabs(_, _).
1129inc_indent(Indent0, Inc, Indent) :- 1130 Indent is Indent0 + Inc*4. 1131 1132:- multifile 1133 sandbox:safe_meta/2. 1134 1135sandbox:safe_meta(listing(What), []) :- 1136 not_qualified(What). 1137 1138not_qualified(Var) :- 1139 var(Var), 1140 !. 1141not_qualified(_:_) :- !, fail. 1142not_qualified(_).
1149comment(Format, Args) :- 1150 stream_property(current_output, tty(true)), 1151 setting(listing:comment_ansi_attributes, Attributes), 1152 Attributes \== [], 1153 !, 1154 ansi_format(Attributes, Format, Args). 1155comment(Format, Args) :- 1156 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.