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