1/* Part of SWI-Prolog 2 3 Author: Jan Wielemaker 4 E-mail: jan@swi-prolog.org 5 WWW: https://www.swi-prolog.org 6 Copyright (c) 2001-2026, University of Amsterdam 7 VU University Amsterdam 8 CWI, Amsterdam 9 SWI-Prolog Solutions b.v. 10 All rights reserved. 11 12 Redistribution and use in source and binary forms, with or without 13 modification, are permitted provided that the following conditions 14 are met: 15 16 1. Redistributions of source code must retain the above copyright 17 notice, this list of conditions and the following disclaimer. 18 19 2. Redistributions in binary form must reproduce the above copyright 20 notice, this list of conditions and the following disclaimer in 21 the documentation and/or other materials provided with the 22 distribution. 23 24 THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS 25 "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT 26 LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS 27 FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE 28 COPYRIGHT OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, 29 INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, 30 BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; 31 LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER 32 CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT 33 LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN 34 ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE 35 POSSIBILITY OF SUCH DAMAGE. 36*/ 37 38:- module(prolog_listing, 39 [ listing/0, 40 listing/1, % :Spec 41 listing/2, % :Spec, +Options 42 portray_clause/1, % +Clause 43 portray_clause/2, % +Stream, +Clause 44 portray_clause/3 % +Stream, +Clause, +Options 45 ]). 46:- use_module(library(settings),[setting/4,setting/2]). 47 48:- autoload(library(ansi_term),[ansi_format/3]). 49:- autoload(library(apply),[foldl/4]). 50:- use_module(library(debug),[debug/3]). 51:- autoload(library(error),[instantiation_error/1,must_be/2]). 52:- autoload(library(lists),[member/2, append/3]). 53:- autoload(library(option),[option/2,option/3,meta_options/3]). 54:- autoload(library(prolog_clause),[clause_info/5]). 55:- autoload(library(prolog_code), [most_general_goal/2]). 56:- if(exists_source(library(thread))). 57:- autoload(library(thread), [call_in_thread/3]). 58:- endif. 59 60%:- set_prolog_flag(generate_debug_info, false). 61 62:- module_transparent 63 listing/0. 64:- meta_predicate 65 listing(), 66 listing(, ), 67 portray_clause(,,). 68 69:- predicate_options(listing/2, 2, 70 [ thread(atom), 71 pass_to(portray_clause/3, 3) 72 ]). 73:- predicate_options(portray_clause/3, 3, 74 [ indent(nonneg), 75 pass_to(system:write_term/3, 3) 76 ]). 77 78:- multifile 79 prolog:locate_clauses/2. % +Spec, -ClauseRefList
110:- setting(listing:body_indentation, nonneg, 4, 111 'Indentation used goals in the body'). 112:- setting(listing:tab_distance, nonneg, 0, 113 'Distance between tab-stops. 0 uses only spaces'). 114:- setting(listing:cut_on_same_line, boolean, false, 115 'Place cuts (!) on the same line'). 116:- setting(listing:line_width, nonneg, 78, 117 'Width of a line. 0 is infinite'). 118:- setting(listing:comment_ansi_attributes, list, [fg(green)], 119 'ansi_format/3 attributes to print comments').
mymodule, use one of the calls below.
?- mymodule:listing. ?- listing(mymodule:_).
133listing :- 134 context_module(Context), 135 list_module(Context, []). 136 137list_module(Module, Options) :- 138 ( current_predicate(_, Module:Pred), 139 \+ predicate_property(Module:Pred, imported_from(_)), 140 strip_module(Pred, _Module, Head), 141 functor(Head, Name, _Arity), 142 ( ( predicate_property(Module:Pred, built_in) 143 ; sub_atom(Name, 0, _, _, $) 144 ) 145 -> current_prolog_flag(access_level, system) 146 ; true 147 ), 148 nl, 149 list_predicate(Module:Head, Module, Options), 150 fail 151 ; true 152 ).
?- 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)]).
205listing(Spec) :- 206 listing(Spec, []). 207 208listing(Spec, Options) :- 209 call_cleanup( 210 listing_(Spec, Options), 211 close_sources). 212 213listing_(M:Spec, Options) :- 214 var(Spec), 215 !, 216 list_module(M, Options). 217listing_(M:List, Options) :- 218 is_list(List), 219 !, 220 forall(member(Spec, List), 221 listing_(M:Spec, Options)). 222listing_(M:CRef, Options) :- 223 blob(CRef, clause), 224 !, 225 list_clauserefs([CRef], M, Options). 226listing_(X, Options) :- 227 ( prolog:locate_clauses(X, ClauseRefs) 228 -> strip_module(X, Context, _), 229 list_clauserefs(ClauseRefs, Context, Options) 230 ; '$find_predicate'(X, Preds), 231 list_predicates(Preds, X, Options) 232 ). 233 234list_clauserefs([], _, _) :- !. 235list_clauserefs([H|T], Context, Options) :- 236 !, 237 list_clauserefs(H, Context, Options), 238 list_clauserefs(T, Context, Options). 239list_clauserefs(Ref, Context, Options) :- 240 @(rule(M:_, Rule, Ref), Context), 241 list_clause(M:Rule, Ref, Context, Options).
245list_predicates(PIs, Context:X, Options) :- 246 member(PI, PIs), 247 pi_to_head(PI, Pred), 248 unify_args(Pred, X), 249 list_define(Pred, DefPred), 250 list_predicate(DefPred, Context, Options), 251 nl, 252 fail. 253list_predicates(_, _, _). 254 255list_define(Head, LoadModule:Head) :- 256 compound(Head), 257 Head \= (_:_), 258 functor(Head, Name, Arity), 259 '$find_library'(_, Name, Arity, LoadModule, Library), 260 !, 261 use_module(Library, []). 262list_define(M:Pred, DefM:Pred) :- 263 '$define_predicate'(M:Pred), 264 ( predicate_property(M:Pred, imported_from(DefM)) 265 -> true 266 ; DefM = M 267 ). 268 269pi_to_head(PI, _) :- 270 var(PI), 271 !, 272 instantiation_error(PI). 273pi_to_head(M:PI, M:Head) :- 274 !, 275 pi_to_head(PI, Head). 276pi_to_head(Name/Arity, Head) :- 277 functor(Head, Name, Arity). 278 279 280% Unify the arguments of the specification with the given term, 281% so we can partially instantate the head. 282 283unify_args(_, _/_) :- !. % Name/arity spec 284unify_args(X, X) :- !. 285unify_args(_:X, X) :- !. 286unify_args(_, _). 287 288list_predicate(Pred, Context, _) :- 289 predicate_property(Pred, undefined), 290 !, 291 decl_term(Pred, Context, Decl), 292 comment('% Undefined: ~q~n', [Decl]). 293list_predicate(Pred, Context, _) :- 294 predicate_property(Pred, foreign), 295 !, 296 decl_term(Pred, Context, Decl), 297 comment('% Foreign: ~q~n', [Decl]), 298 ( '$foreign_predicate_source'(Pred, Source) 299 -> comment('% Implemented by ~w~n', [Source]) 300 ; true 301 ). 302list_predicate(Pred, Context, Options) :- 303 notify_changed(Pred, Context), 304 list_declarations(Pred, Context), 305 list_clauses(Pred, Context, Options). 306 307decl_term(Pred, Context, Decl) :- 308 strip_module(Pred, Module, Head), 309 functor(Head, Name, Arity), 310 ( hide_module(Module, Context, Head) 311 -> Decl = Name/Arity 312 ; Decl = Module:Name/Arity 313 ). 314 315 316decl(thread_local, thread_local). 317decl(dynamic, dynamic). 318decl(volatile, volatile). 319decl(multifile, multifile). 320decl(public, public).
330declaration(Pred, Source, Decl) :- 331 predicate_property(Pred, tabled), 332 Pred = M:Head, 333 ( M:'$table_mode'(Head, Head, _) 334 -> decl_term(Pred, Source, Funct), 335 table_options(Pred, Funct, TableDecl), 336 Decl = table(TableDecl) 337 ; comment('% tabled using answer subsumption~n', []), 338 fail % TBD 339 ). 340declaration(Pred, Source, Decl) :- 341 decl(Prop, Declname), 342 predicate_property(Pred, Prop), 343 decl_term(Pred, Source, Funct), 344 Decl =.. [ Declname, Funct ]. 345declaration(Pred, Source, Decl) :- 346 predicate_property(Pred, meta_predicate(Head)), 347 strip_module(Pred, Module, _), 348 ( (Module == system; Source == Module) 349 -> Decl = meta_predicate(Head) 350 ; Decl = meta_predicate(Module:Head) 351 ), 352 ( meta_implies_transparent(Head) 353 -> ! % hide transparent 354 ; true 355 ). 356declaration(Pred, Source, Decl) :- 357 predicate_property(Pred, transparent), 358 decl_term(Pred, Source, PI), 359 Decl = module_transparent(PI).
366meta_implies_transparent(Head):- 367 compound(Head), 368 arg(_, Head, Arg), 369 implies_transparent(Arg), 370 !. 371 372implies_transparent(Arg) :- 373 integer(Arg), 374 !. 375implies_transparent(:). 376implies_transparent(//). 377implies_transparent(^). 378 379table_options(Pred, Decl0, as(Decl0, Options)) :- 380 findall(Flag, predicate_property(Pred, tabled(Flag)), [F0|Flags]), 381 !, 382 foldl(table_option, Flags, F0, Options). 383table_options(_, Decl, Decl). 384 385table_option(Flag, X, (Flag,X)). 386 387list_declarations(Pred, Source) :- 388 findall(Decl, declaration(Pred, Source, Decl), Decls), 389 ( Decls == [] 390 -> true 391 ; write_declarations(Decls, Source), 392 format('~n', []) 393 ). 394 395 396write_declarations([], _) :- !. 397write_declarations([H|T], Module) :- 398 format(':- ~q.~n', [H]), 399 write_declarations(T, Module).
410list_clauses(Pred, Source, Options) :- 411 predicate_property(Pred, thread_local), 412 option(thread(Thread), Options), 413 !, 414 strip_module(Pred, Module, Head), 415 most_general_goal(Head, GenHead), 416 option(timeout(TimeOut), Options, 0.2), 417 call_in_thread( 418 Thread, 419 find_clauses(Module:GenHead, Head, Refs), 420 [ timeout(TimeOut), 421 on_timeout(print_message( 422 warning, 423 listing(thread_local(Pred, Thread, timeout(TimeOut))))) 424 ]), 425 forall(member(Ref, Refs), 426 ( rule(Module:GenHead, Rule, Ref), 427 list_clause(Module:Rule, Ref, Source, Options))). 428:- if(current_predicate('$local_definitions'/2)). 429list_clauses(Pred, Source, _Options) :- 430 predicate_property(Pred, thread_local), 431 \+ ( predicate_property(Pred, number_of_clauses(Nc)), 432 Nc > 0 433 ), 434 !, 435 decl_term(Pred, Source, Decl), 436 '$local_definitions'(Pred, Pairs), 437 ( Pairs == [] 438 -> comment('% No thread has clauses for ~p~n', [Decl]) 439 ; Top = 10, 440 length(Pairs, Count), 441 thread_self(Me), 442 thread_name(Me, MyName), 443 comment('% Calling thread (~p) has no clauses for ~p. \c 444 Other threads have:~n', [MyName, Decl]), 445 sort(2, >=, Pairs, ByNumberOfClauses), 446 ( Count > Top 447 -> length(Show, Top), 448 append(Show, _, ByNumberOfClauses) 449 ; Show = ByNumberOfClauses 450 ), 451 ( member(Thread-ClauseCount, Show), 452 thread_name(Thread, Name), 453 comment('%~t~D~8| clauses in thread ~p~n', [ClauseCount, Name]), 454 fail 455 ; true 456 ), 457 ( Count > Top 458 -> NotShown is Count-Top, 459 comment('% ~D more threads have clauses for ~p~n', 460 [NotShown, Decl]) 461 ; true 462 ) 463 ). 464:- endif. 465list_clauses(Pred, Source, Options) :- 466 strip_module(Pred, Module, Head), 467 most_general_goal(Head, GenHead), 468 forall(find_clause(Module:GenHead, Head, Rule, Ref), 469 list_clause(Module:Rule, Ref, Source, Options)). 470 471thread_name(Thread, Name) :- 472 ( atom(Thread) 473 -> Name = Thread 474 ; catch(thread_property(Thread, id(Name)), error(_,_), 475 Name = Thread) 476 ). 477 478find_clauses(GenHead, Head, Refs) :- 479 findall(Ref, find_clause(GenHead, Head, _Rule, Ref), Refs). 480 481find_clause(GenHead, Head, Rule, Ref) :- 482 rule(GenHead, Rule, Ref), 483 \+ \+ rule_head(Rule, Head). 484 485rule_head((Head0 :- _Body), Head) :- !, Head = Head0. 486rule_head((Head0,_Cond => _Body), Head) :- !, Head = Head0. 487rule_head((Head0 => _Body), Head) :- !, Head = Head0. 488rule_head(?=>(Head0, _Body), Head) :- !, Head = Head0. 489rule_head(Head, Head).
493list_clause(_Rule, Ref, _Source, Options) :- 494 option(source(true), Options), 495 ( clause_property(Ref, file(File)), 496 clause_property(Ref, line_count(Line)), 497 catch(source_clause_string(File, Line, String, Repositioned), 498 _, fail), 499 debug(listing(source), 'Read ~w:~d: "~s"~n', [File, Line, String]) 500 -> !, 501 ( Repositioned == true 502 -> comment('% From ~w:~d~n', [ File, Line ]) 503 ; true 504 ), 505 writeln(String) 506 ; decompiled 507 -> fail 508 ; asserta(decompiled), 509 comment('% From database (decompiled)~n', []), 510 fail % try next clause 511 ). 512list_clause(Module:(Head:-Body), Ref, Source, Options) :- 513 !, 514 list_clause(Module:Head, Body, :-, Ref, Source, Options). 515list_clause(Module:(Head=>Body), Ref, Source, Options) :- 516 list_clause(Module:Head, Body, =>, Ref, Source, Options). 517list_clause(Module:Head, Ref, Source, Options) :- 518 !, 519 list_clause(Module:Head, true, :-, Ref, Source, Options). 520 521list_clause(Module:Head, Body, Neck, Ref, Source, Options) :- 522 restore_variable_names(Module, Head, Body, Ref, Options), 523 write_module(Module, Source, Head), 524 Rule =.. [Neck,Head,Body], 525 portray_clause(Rule).
variable_names(source) is true.532restore_variable_names(Module, Head, Body, Ref, Options) :- 533 option(variable_names(source), Options, source), 534 catch(clause_info(Ref, _, _, _, 535 [ head(QHead), 536 body(Body), 537 variable_names(Bindings) 538 ]), 539 _, true), 540 unify_head(Module, Head, QHead), 541 !, 542 bind_vars(Bindings), 543 name_other_vars((Head:-Body), Bindings). 544restore_variable_names(_,_,_,_,_). 545 546unify_head(Module, Head, Module:Head) :- 547 !. 548unify_head(_, Head, Head) :- 549 !. 550unify_head(_, _, _). 551 552bind_vars([]) :- 553 !. 554bind_vars([Name = Var|T]) :- 555 ignore(Var = '$VAR'(Name)), 556 bind_vars(T).
563name_other_vars(Term, Bindings) :- 564 term_singletons(Term, Singletons), 565 bind_singletons(Singletons), 566 term_variables(Term, Vars), 567 name_vars(Vars, 0, Bindings). 568 569bind_singletons([]). 570bind_singletons(['$VAR'('_')|T]) :- 571 bind_singletons(T). 572 573name_vars([], _, _). 574name_vars([H|T], N, Bindings) :- 575 between(N, infinite, N2), 576 var_name(N2, Name), 577 \+ memberchk(Name=_, Bindings), 578 !, 579 H = '$VAR'(N2), 580 N3 is N2 + 1, 581 name_vars(T, N3, Bindings). 582 583var_name(I, Name) :- % must be kept in sync with writeNumberVar() 584 L is (I mod 26)+0'A, 585 N is I // 26, 586 ( N == 0 587 -> char_code(Name, L) 588 ; format(atom(Name), '~c~d', [L, N]) 589 ). 590 591write_module(Module, Context, Head) :- 592 hide_module(Module, Context, Head), 593 !. 594write_module(Module, _, _) :- 595 format('~q:', [Module]). 596 597hide_module(system, Module, Head) :- 598 predicate_property(Module:Head, imported_from(M)), 599 predicate_property(system:Head, imported_from(M)), 600 !. 601hide_module(Module, Module, _) :- !. 602 603notify_changed(Pred, Context) :- 604 strip_module(Pred, user, Head), 605 predicate_property(Head, built_in), 606 \+ predicate_property(Head, (dynamic)), 607 !, 608 decl_term(Pred, Context, Decl), 609 comment('% NOTE: system definition has been overruled for ~q~n', 610 [Decl]). 611notify_changed(_, _).
618source_clause_string(File, Line, String, Repositioned) :- 619 open_source(File, Line, Stream, Repositioned), 620 stream_property(Stream, position(Start)), 621 '$raw_read'(Stream, _TextWithoutComments), 622 stream_property(Stream, position(End)), 623 stream_position_data(char_count, Start, StartChar), 624 stream_position_data(char_count, End, EndChar), 625 Length is EndChar - StartChar, 626 set_stream_position(Stream, Start), 627 read_string(Stream, Length, String), 628 skip_blanks_and_comments(Stream, blank). 629 630skip_blanks_and_comments(Stream, _) :- 631 at_end_of_stream(Stream), 632 !. 633skip_blanks_and_comments(Stream, State0) :- 634 peek_string(Stream, 80, String), 635 string_chars(String, Chars), 636 phrase(blanks_and_comments(State0, State), Chars, Rest), 637 ( Rest == [] 638 -> read_string(Stream, 80, _), 639 skip_blanks_and_comments(Stream, State) 640 ; length(Chars, All), 641 length(Rest, RLen), 642 Skip is All-RLen, 643 read_string(Stream, Skip, _) 644 ). 645 646blanks_and_comments(State0, State) --> 647 [C], 648 { transition(C, State0, State1) }, 649 !, 650 blanks_and_comments(State1, State). 651blanks_and_comments(State, State) --> 652 []. 653 654transition(C, blank, blank) :- 655 char_type(C, space). 656transition('%', blank, line_comment). 657transition('\n', line_comment, blank). 658transition(_, line_comment, line_comment). 659transition('/', blank, comment_0). 660transition('/', comment(N), comment(N,/)). 661transition('*', comment(N,/), comment(N1)) :- 662 N1 is N + 1. 663transition('*', comment_0, comment(1)). 664transition('*', comment(N), comment(N,*)). 665transition('/', comment(N,*), State) :- 666 ( N == 1 667 -> State = blank 668 ; N2 is N - 1, 669 State = comment(N2) 670 ). 671 672 673open_source(File, Line, Stream, Repositioned) :- 674 source_stream(File, Stream, Pos0, Repositioned), 675 line_count(Stream, Line0), 676 ( Line >= Line0 677 -> Skip is Line - Line0 678 ; set_stream_position(Stream, Pos0), 679 Skip is Line - 1 680 ), 681 debug(listing(source), '~w: skip ~d to ~d', [File, Line0, Line]), 682 ( Skip =\= 0 683 -> Repositioned = true 684 ; true 685 ), 686 forall(between(1, Skip, _), 687 skip(Stream, 0'\n)). 688 689:- thread_local 690 opened_source/3, 691 decompiled/0. 692 693source_stream(File, Stream, Pos0, _) :- 694 opened_source(File, Stream, Pos0), 695 !. 696source_stream(File, Stream, Pos0, true) :- 697 open(File, read, Stream), 698 stream_property(Stream, position(Pos0)), 699 asserta(opened_source(File, Stream, Pos0)). 700 701close_sources :- 702 retractall(decompiled), 703 forall(retract(opened_source(_,Stream,_)), 704 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.735% The prolog_list_goal/1 hook is a dubious as it may lead to 736% confusion if the heads relates to other bodies. For now it is 737% only used for XPCE methods and works just nice. 738% 739% Not really ... It may confuse the source-level debugger. 740 741%portray_clause(Head :- _Body) :- 742% user:prolog_list_goal(Head), !. 743portray_clause(Term) :- 744 current_output(Out), 745 portray_clause(Out, Term). 746 747portray_clause(Stream, Term) :- 748 must_be(stream, Stream), 749 portray_clause(Stream, Term, []). 750 751portray_clause(Stream, Term, M:Options) :- 752 must_be(list, Options), 753 meta_options(is_meta, M:Options, QOptions), 754 \+ \+ name_vars_and_portray_clause(Stream, Term, QOptions). 755 756name_vars_and_portray_clause(Stream, Term, Options) :- 757 term_attvars(Term, []), 758 !, 759 clause_vars(Term, Options), 760 do_portray_clause(Stream, Term, Options). 761name_vars_and_portray_clause(Stream, Term, Options) :- 762 option(variable_names(Bindings), Options), 763 !, 764 copy_term_nat(Term+Bindings, Copy+BCopy), 765 bind_vars(BCopy), 766 name_other_vars(Copy, BCopy), 767 do_portray_clause(Stream, Copy, Options). 768name_vars_and_portray_clause(Stream, Term, Options) :- 769 copy_term_nat(Term, Copy), 770 clause_vars(Copy, Options), 771 do_portray_clause(Stream, Copy, Options). 772 773clause_vars(Clause, Options) :- 774 option(variable_names(Bindings), Options), 775 !, 776 bind_vars(Bindings), 777 name_other_vars(Clause, Bindings). 778clause_vars(Clause, _) :- 779 numbervars(Clause, 0, _, 780 [ singletons(true) 781 ]). 782 783is_meta(portray_goal). 784 785do_portray_clause(Out, Var, Options) :- 786 var(Var), 787 !, 788 option(indent(LeftMargin), Options, 0), 789 indent(Out, LeftMargin), 790 pprint(Out, Var, 1200, Options). 791do_portray_clause(Out, (Head :- true), Options) :- 792 !, 793 option(indent(LeftMargin), Options, 0), 794 indent(Out, LeftMargin), 795 pprint(Out, Head, 1200, Options), 796 full_stop(Out). 797do_portray_clause(Out, Term, Options) :- 798 clause_term(Term, Head, Neck, Body), 799 !, 800 option(indent(LeftMargin), Options, 0), 801 inc_indent(LeftMargin, 1, Indent), 802 infix_op(Neck, RightPri, LeftPri), 803 indent(Out, LeftMargin), 804 pprint(Out, Head, LeftPri, Options), 805 format(Out, ' ~w', [Neck]), 806 ( nonvar(Body), 807 Body = Module:LocalBody, 808 \+ primitive(LocalBody) 809 -> nlindent(Out, Indent), 810 format(Out, '~q', [Module]), 811 '$put_token'(Out, :), 812 nlindent(Out, Indent), 813 write(Out, '( '), 814 inc_indent(Indent, 1, BodyIndent), 815 portray_body(LocalBody, BodyIndent, noindent, 1200, Out, Options), 816 nlindent(Out, Indent), 817 write(Out, ')') 818 ; setting(listing:body_indentation, BodyIndent0), 819 BodyIndent is LeftMargin+BodyIndent0, 820 portray_body(Body, BodyIndent, indent, RightPri, Out, Options) 821 ), 822 full_stop(Out). 823do_portray_clause(Out, (:-Directive), Options) :- 824 wrapped_list_directive(Directive), 825 !, 826 Directive =.. [Name, Arg, List], 827 option(indent(LeftMargin), Options, 0), 828 indent(Out, LeftMargin), 829 format(Out, ':- ~q(', [Name]), 830 line_position(Out, Indent), 831 format(Out, '~q,', [Arg]), 832 nlindent(Out, Indent), 833 portray_list(List, Indent, Out, Options), 834 write(Out, ').\n'). 835do_portray_clause(Out, Clause, Options) :- 836 directive(Clause, Op, Directive), 837 !, 838 option(indent(LeftMargin), Options, 0), 839 indent(Out, LeftMargin), 840 format(Out, '~w ', [Op]), 841 DIndent is LeftMargin+3, 842 portray_body(Directive, DIndent, noindent, 1199, Out, Options), 843 full_stop(Out). 844do_portray_clause(Out, Fact, Options) :- 845 option(indent(LeftMargin), Options, 0), 846 indent(Out, LeftMargin), 847 portray_body(Fact, LeftMargin, noindent, 1200, Out, Options), 848 full_stop(Out). 849 850clause_term((Head:-Body), Head, :-, Body). 851clause_term((Head=>Body), Head, =>, Body). 852clause_term(?=>(Head,Body), Head, ?=>, Body). 853clause_term((Head-->Body), Head, -->, Body). 854 855full_stop(Out) :- 856 '$put_token'(Out, '.'), 857 nl(Out). 858 859directive((:- Directive), :-, Directive). 860directive((?- Directive), ?-, Directive). 861 862wrapped_list_directive(module(_,_)). 863%wrapped_list_directive(use_module(_,_)). 864%wrapped_list_directive(autoload(_,_)).
871portray_body(Var, _, _, Pri, Out, Options) :- 872 var(Var), 873 !, 874 pprint(Out, Var, Pri, Options). 875portray_body(!, _, _, _, Out, _) :- 876 setting(listing:cut_on_same_line, true), 877 !, 878 write(Out, ' !'). 879portray_body((!, Clause), Indent, _, Pri, Out, Options) :- 880 setting(listing:cut_on_same_line, true), 881 \+ term_needs_braces((_,_), Pri), 882 !, 883 write(Out, ' !,'), 884 portray_body(Clause, Indent, indent, 1000, Out, Options). 885portray_body(Term, Indent, indent, Pri, Out, Options) :- 886 !, 887 nlindent(Out, Indent), 888 portray_body(Term, Indent, noindent, Pri, Out, Options). 889portray_body(Or, Indent, _, _, Out, Options) :- 890 or_layout(Or), 891 !, 892 write(Out, '( '), 893 portray_or(Or, Indent, 1200, Out, Options), 894 nlindent(Out, Indent), 895 write(Out, ')'). 896portray_body(Term, Indent, _, Pri, Out, Options) :- 897 term_needs_braces(Term, Pri), 898 !, 899 write(Out, '( '), 900 ArgIndent is Indent + 2, 901 portray_body(Term, ArgIndent, noindent, 1200, Out, Options), 902 nlindent(Out, Indent), 903 write(Out, ')'). 904portray_body(((AB),C), Indent, _, _Pri, Out, Options) :- 905 nonvar(AB), 906 AB = (A,B), 907 !, 908 infix_op(',', LeftPri, RightPri), 909 portray_body(A, Indent, noindent, LeftPri, Out, Options), 910 write(Out, ','), 911 portray_body((B,C), Indent, indent, RightPri, Out, Options). 912portray_body((A,B), Indent, _, _Pri, Out, Options) :- 913 !, 914 infix_op(',', LeftPri, RightPri), 915 portray_body(A, Indent, noindent, LeftPri, Out, Options), 916 write(Out, ','), 917 portray_body(B, Indent, indent, RightPri, Out, Options). 918portray_body(\+(Goal), Indent, _, _Pri, Out, Options) :- 919 !, 920 write(Out, \+), write(Out, ' '), 921 prefix_op(\+, ArgPri), 922 ArgIndent is Indent+3, 923 portray_body(Goal, ArgIndent, noindent, ArgPri, Out, Options). 924portray_body(Call, _, _, _, Out, Options) :- % requires knowledge on the module! 925 m_callable(Call), 926 option(module(M), Options, user), 927 predicate_property(M:Call, meta_predicate(Meta)), 928 !, 929 portray_meta(Out, Call, Meta, Options). 930portray_body(Clause, _, _, Pri, Out, Options) :- 931 pprint(Out, Clause, Pri, Options). 932 933m_callable(Term) :- 934 strip_module(Term, _, Plain), 935 callable(Plain), 936 Plain \= (_:_). 937 938term_needs_braces(Term, Pri) :- 939 callable(Term), 940 functor(Term, Name, _Arity), 941 current_op(OpPri, _Type, Name), 942 OpPri > Pri, 943 !.
947portray_or(Term, Indent, Pri, Out, Options) :- 948 term_needs_braces(Term, Pri), 949 !, 950 inc_indent(Indent, 1, NewIndent), 951 write(Out, '( '), 952 portray_or(Term, NewIndent, Out, Options), 953 nlindent(Out, NewIndent), 954 write(Out, ')'). 955portray_or(Term, Indent, _Pri, Out, Options) :- 956 or_layout(Term), 957 !, 958 portray_or(Term, Indent, Out, Options). 959portray_or(Term, Indent, Pri, Out, Options) :- 960 inc_indent(Indent, 1, NestIndent), 961 portray_body(Term, NestIndent, noindent, Pri, Out, Options). 962 963 964portray_or((If -> Then ; Else), Indent, Out, Options) :- 965 !, 966 inc_indent(Indent, 1, NestIndent), 967 infix_op((->), LeftPri, RightPri), 968 portray_body(If, NestIndent, noindent, LeftPri, Out, Options), 969 nlindent(Out, Indent), 970 write(Out, '-> '), 971 portray_body(Then, NestIndent, noindent, RightPri, Out, Options), 972 nlindent(Out, Indent), 973 write(Out, '; '), 974 infix_op(;, _LeftPri, RightPri2), 975 portray_or(Else, Indent, RightPri2, Out, Options). 976portray_or((If *-> Then ; Else), Indent, Out, Options) :- 977 !, 978 inc_indent(Indent, 1, NestIndent), 979 infix_op((*->), LeftPri, RightPri), 980 portray_body(If, NestIndent, noindent, LeftPri, Out, Options), 981 nlindent(Out, Indent), 982 write(Out, '*-> '), 983 portray_body(Then, NestIndent, noindent, RightPri, Out, Options), 984 nlindent(Out, Indent), 985 write(Out, '; '), 986 infix_op(;, _LeftPri, RightPri2), 987 portray_or(Else, Indent, RightPri2, Out, Options). 988portray_or((If -> Then), Indent, Out, Options) :- 989 !, 990 inc_indent(Indent, 1, NestIndent), 991 infix_op((->), LeftPri, RightPri), 992 portray_body(If, NestIndent, noindent, LeftPri, Out, Options), 993 nlindent(Out, Indent), 994 write(Out, '-> '), 995 portray_or(Then, Indent, RightPri, Out, Options). 996portray_or((If *-> Then), Indent, Out, Options) :- 997 !, 998 inc_indent(Indent, 1, NestIndent), 999 infix_op((->), LeftPri, RightPri), 1000 portray_body(If, NestIndent, noindent, LeftPri, Out, Options), 1001 nlindent(Out, Indent), 1002 write(Out, '*-> '), 1003 portray_or(Then, Indent, RightPri, Out, Options). 1004portray_or((A;B), Indent, Out, Options) :- 1005 !, 1006 inc_indent(Indent, 1, NestIndent), 1007 infix_op(;, LeftPri, RightPri), 1008 portray_body(A, NestIndent, noindent, LeftPri, Out, Options), 1009 nlindent(Out, Indent), 1010 write(Out, '; '), 1011 portray_or(B, Indent, RightPri, Out, Options). 1012portray_or((A|B), Indent, Out, Options) :- 1013 !, 1014 inc_indent(Indent, 1, NestIndent), 1015 infix_op('|', LeftPri, RightPri), 1016 portray_body(A, NestIndent, noindent, LeftPri, Out, Options), 1017 nlindent(Out, Indent), 1018 write(Out, '| '), 1019 portray_or(B, Indent, RightPri, Out, Options).
1027infix_op(Op, Left, Right) :- 1028 current_op(Pri, Assoc, Op), 1029 infix_assoc(Assoc, LeftMin, RightMin), 1030 !, 1031 Left is Pri - LeftMin, 1032 Right is Pri - RightMin. 1033 1034infix_assoc(xfx, 1, 1). 1035infix_assoc(xfy, 1, 0). 1036infix_assoc(yfx, 0, 1). 1037 1038prefix_op(Op, ArgPri) :- 1039 current_op(Pri, Assoc, Op), 1040 pre_assoc(Assoc, ArgMin), 1041 !, 1042 ArgPri is Pri - ArgMin. 1043 1044pre_assoc(fx, 1). 1045pre_assoc(fy, 0). 1046 1047postfix_op(Op, ArgPri) :- 1048 current_op(Pri, Assoc, Op), 1049 post_assoc(Assoc, ArgMin), 1050 !, 1051 ArgPri is Pri - ArgMin. 1052 1053post_assoc(xf, 1). 1054post_assoc(yf, 0).
1063or_layout(Var) :- 1064 var(Var), !, fail. 1065or_layout((_;_)). 1066or_layout((_->_)). 1067or_layout((_*->_)). 1068 1069primitive(G) :- 1070 or_layout(G), !, fail. 1071primitive((_,_)) :- !, fail. 1072primitive(_).
1081portray_meta(Out, Call, Meta, Options) :- 1082 contains_non_primitive_meta_arg(Call, Meta), 1083 !, 1084 Call =.. [Name|Args], 1085 Meta =.. [_|Decls], 1086 format(Out, '~q(', [Name]), 1087 line_position(Out, Indent), 1088 portray_meta_args(Decls, Args, Indent, Out, Options), 1089 format(Out, ')', []). 1090portray_meta(Out, Call, _, Options) :- 1091 pprint(Out, Call, 999, Options). 1092 1093contains_non_primitive_meta_arg(Call, Decl) :- 1094 arg(I, Call, CA), 1095 arg(I, Decl, DA), 1096 integer(DA), 1097 \+ primitive(CA), 1098 !. 1099 1100portray_meta_args([], [], _, _, _). 1101portray_meta_args([D|DT], [A|AT], Indent, Out, Options) :- 1102 portray_meta_arg(D, A, Out, Options), 1103 ( DT == [] 1104 -> true 1105 ; format(Out, ',', []), 1106 nlindent(Out, Indent), 1107 portray_meta_args(DT, AT, Indent, Out, Options) 1108 ). 1109 1110portray_meta_arg(I, A, Out, Options) :- 1111 integer(I), 1112 !, 1113 line_position(Out, Indent), 1114 portray_body(A, Indent, noindent, 999, Out, Options). 1115portray_meta_arg(_, A, Out, Options) :- 1116 pprint(Out, A, 999, Options).
[ element1, [ element1 element2, OR | tail ] ]
1126portray_list([], _, Out, _) :- 1127 !, 1128 write(Out, []). 1129portray_list(List, Indent, Out, Options) :- 1130 write(Out, '[ '), 1131 EIndent is Indent + 2, 1132 portray_list_elements(List, EIndent, Out, Options), 1133 nlindent(Out, Indent), 1134 write(Out, ']'). 1135 1136portray_list_elements([H|T], EIndent, Out, Options) :- 1137 pprint(Out, H, 999, Options), 1138 ( T == [] 1139 -> true 1140 ; nonvar(T), T = [_|_] 1141 -> write(Out, ','), 1142 nlindent(Out, EIndent), 1143 portray_list_elements(T, EIndent, Out, Options) 1144 ; Indent is EIndent - 2, 1145 nlindent(Out, Indent), 1146 write(Out, '| '), 1147 pprint(Out, T, 999, Options) 1148 ).
1162pprint(Out, Term, _, Options) :- 1163 nonvar(Term), 1164 Term = {}(Arg), 1165 line_position(Out, Indent), 1166 ArgIndent is Indent + 2, 1167 format(Out, '{ ', []), 1168 portray_body(Arg, ArgIndent, noident, 1000, Out, Options), 1169 nlindent(Out, Indent), 1170 format(Out, '}', []). 1171pprint(Out, Term, Pri, Options) :- 1172 ( compound(Term) 1173 -> compound_name_arity(Term, _, Arity), 1174 Arity > 0 1175 ; is_dict(Term) 1176 ), 1177 \+ nowrap_term(Term), 1178 line_width(Width), 1179 Width > 0, 1180 ( write_length(Term, Len, [max_length(Width)|Options]) 1181 -> true 1182 ; Len = Width 1183 ), 1184 line_position(Out, Indent), 1185 Indent + Len > Width, 1186 Len > Width/4, % ad-hoc rule for deeply nested goals 1187 !, 1188 pprint_wrapped(Out, Term, Pri, Options). 1189pprint(Out, Term, Pri, Options) :- 1190 listing_write_options(Pri, WrtOptions, Options), 1191 write_term(Out, Term, 1192 [ blobs(portray), 1193 portray_goal(portray_blob) 1194 | WrtOptions 1195 ]). 1196 1197:- public portray_blob/2. 1198portray_blob(Blob, _Options) :- 1199 blob(Blob, _), 1200 \+ atom(Blob), 1201 !, 1202 format(string(S), '~q', [Blob]), 1203 format('~q', ['$BLOB'(S)]). 1204 1205nowrap_term('$VAR'(_)) :- !. 1206nowrap_term(_{}) :- !. % empty dict 1207nowrap_term(Term) :- 1208 functor(Term, Name, Arity), 1209 current_op(_, _, Name), 1210 ( Arity == 2 1211 -> infix_op(Name, _, _) 1212 ; Arity == 1 1213 -> ( prefix_op(Name, _) 1214 -> true 1215 ; postfix_op(Name, _) 1216 ) 1217 ). 1218 1219 1220pprint_wrapped(Out, Term, _, Options) :- 1221 Term = [_|_], 1222 !, 1223 line_position(Out, Indent), 1224 portray_list(Term, Indent, Out, Options). 1225pprint_wrapped(Out, Dict, _, Options) :- 1226 is_dict(Dict), 1227 !, 1228 dict_pairs(Dict, Tag, Pairs), 1229 pprint(Out, Tag, 1200, Options), 1230 format(Out, '{ ', []), 1231 line_position(Out, Indent), 1232 pprint_nv(Pairs, Indent, Out, Options), 1233 nlindent(Out, Indent-2), 1234 format(Out, '}', []). 1235pprint_wrapped(Out, Term, _, Options) :- 1236 Term =.. [Name|Args], 1237 format(Out, '~q(', [Name]), 1238 line_position(Out, Indent), 1239 pprint_args(Args, Indent, Out, Options), 1240 format(Out, ')', []). 1241 1242pprint_args([], _, _, _). 1243pprint_args([H|T], Indent, Out, Options) :- 1244 pprint(Out, H, 999, Options), 1245 ( T == [] 1246 -> true 1247 ; format(Out, ',', []), 1248 nlindent(Out, Indent), 1249 pprint_args(T, Indent, Out, Options) 1250 ). 1251 1252 1253pprint_nv([], _, _, _). 1254pprint_nv([Name-Value|T], Indent, Out, Options) :- 1255 pprint(Out, Name, 999, Options), 1256 format(Out, ':', []), 1257 pprint(Out, Value, 999, Options), 1258 ( T == [] 1259 -> true 1260 ; format(Out, ',', []), 1261 nlindent(Out, Indent), 1262 pprint_nv(T, Indent, Out, Options) 1263 ).
1271listing_write_options(Pri,
1272 [ quoted(true),
1273 numbervars(true),
1274 priority(Pri),
1275 spacing(next_argument)
1276 | Options
1277 ],
1278 Options).1286nlindent(Out, N) :- 1287 nl(Out), 1288 indent(Out, N). 1289 1290indent(Out, N) :- 1291 setting(listing:tab_distance, D), 1292 ( D =:= 0 1293 -> tab(Out, N) 1294 ; Tab is N // D, 1295 Space is N mod D, 1296 put_tabs(Out, Tab), 1297 tab(Out, Space) 1298 ). 1299 1300put_tabs(Out, N) :- 1301 N > 0, 1302 !, 1303 put(Out, 0'\t), 1304 NN is N - 1, 1305 put_tabs(Out, NN). 1306put_tabs(_, _). 1307 1308line_width(Width) :- 1309 stream_property(current_output, tty(true)), 1310 catch(tty_size(_Rows, Cols), error(_,_), fail), 1311 !, 1312 Width is Cols - 2. 1313line_width(Width) :- 1314 setting(listing:line_width, Width), 1315 !. 1316line_width(78).
1323inc_indent(Indent0, Inc, Indent) :- 1324 Indent is Indent0 + Inc*4. 1325 1326:- multifile 1327 sandbox:safe_meta/2. 1328 1329sandbox:safe_meta(listing(What), []) :- 1330 not_qualified(What). 1331 1332not_qualified(Var) :- 1333 var(Var), 1334 !. 1335not_qualified(_:_) :- !, fail. 1336not_qualified(_).
1343comment(Format, Args) :- 1344 stream_property(current_output, tty(true)), 1345 setting(listing:comment_ansi_attributes, Attributes), 1346 Attributes \== [], 1347 !, 1348 ansi_format(Attributes, Format, Args). 1349comment(Format, Args) :- 1350 format(Format, Args). 1351 1352 /******************************* 1353 * MESSAGES * 1354 *******************************/ 1355 1356:- multifile(prolog:message//1). 1357 1358prologmessage(listing(thread_local(Pred, Thread, timeout(TimeOut)))) --> 1359 { pi_head(PI, Pred) }, 1360 [ 'Could not list ~p for thread ~p: timeout after ~p sec.'- 1361 [PI, Thread, TimeOut] 1362 ]
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.