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-2016, University of Amsterdam
   7                              VU University Amsterdam
   8    All rights reserved.
   9
  10    Redistribution and use in source and binary forms, with or without
  11    modification, are permitted provided that the following conditions
  12    are met:
  13
  14    1. Redistributions of source code must retain the above copyright
  15       notice, this list of conditions and the following disclaimer.
  16
  17    2. Redistributions in binary form must reproduce the above copyright
  18       notice, this list of conditions and the following disclaimer in
  19       the documentation and/or other materials provided with the
  20       distribution.
  21
  22    THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
  23    "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
  24    LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS
  25    FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE
  26    COPYRIGHT OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT,
  27    INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING,
  28    BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES;
  29    LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER
  30    CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
  31    LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN
  32    ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
  33    POSSIBILITY OF SUCH DAMAGE.
  34*/
  35
  36:- module(prolog_listing,
  37        [ listing/0,
  38          listing/1,
  39          portray_clause/1,             % +Clause
  40          portray_clause/2,             % +Stream, +Clause
  41          portray_clause/3              % +Stream, +Clause, +Options
  42        ]).
  43:- use_module(library(lists)).
  44:- use_module(library(settings)).
  45:- use_module(library(option)).
  46:- use_module(library(error)).
  47:- set_prolog_flag(generate_debug_info, false).
  48
  49:- module_transparent
  50    listing/0.
  51:- meta_predicate
  52    listing(:),
  53    portray_clause(+,+,:).
  54
  55:- predicate_options(portray_clause/3, 3, [pass_to(system:write_term/3, 3)]).
  56
  57:- multifile
  58    prolog:locate_clauses/2.        % +Spec, -ClauseRefList
  59
  60/** <module> List programs and pretty print clauses
  61
  62This module implements listing code from  the internal representation in
  63a human readable format.
  64
  65    * listing/0 lists a module.
  66    * listing/1 lists a predicate or matching clause
  67    * portray_clause/2 pretty-prints a clause-term
  68
  69Layout can be customized using library(settings). The effective settings
  70can be listed using list_settings/1 as   illustrated below. Settings can
  71be changed using set_setting/2.
  72
  73    ==
  74    ?- list_settings(listing).
  75    ========================================================================
  76    Name                      Value (*=modified) Comment
  77    ========================================================================
  78    listing:body_indentation  8              Indentation used goals in the body
  79    listing:tab_distance      8              Distance between tab-stops.
  80    ...
  81    ==
  82
  83@tbd    More settings, support _|Coding Guidelines for Prolog|_ and make
  84        the suggestions there the default.
  85@tbd    Provide persistent user customization
  86*/
  87
  88:- setting(listing:body_indentation, nonneg, 8,
  89           'Indentation used goals in the body').
  90:- setting(listing:tab_distance, nonneg, 8,
  91           'Distance between tab-stops.  0 uses only spaces').
  92:- setting(listing:cut_on_same_line, boolean, true,
  93           'Place cuts (!) on the same line').
  94:- setting(listing:line_width, nonneg, 78,
  95           'Width of a line.  0 is infinite').
  96
  97
  98%!  listing
  99%
 100%   Lists all predicates defined  in   the  calling module. Imported
 101%   predicates are not listed. To  list   the  content of the module
 102%   =mymodule=, use:
 103%
 104%     ==
 105%     ?- mymodule:listing.
 106%     ==
 107
 108listing :-
 109    context_module(Context),
 110    list_module(Context).
 111
 112list_module(Module) :-
 113    (   current_predicate(_, Module:Pred),
 114        \+ predicate_property(Module:Pred, imported_from(_)),
 115        strip_module(Pred, _Module, Head),
 116        functor(Head, Name, _Arity),
 117        (   (   predicate_property(Pred, built_in)
 118            ;   sub_atom(Name, 0, _, _, $)
 119            )
 120        ->  current_prolog_flag(access_level, system)
 121        ;   true
 122        ),
 123        nl,
 124        list_predicate(Module:Head, Module),
 125        fail
 126    ;   true
 127    ).
 128
 129
 130%!  listing(:What)
 131%
 132%   List matching clauses. What is either a plain specification or a
 133%   list of specifications. Plain specifications are:
 134%
 135%     * Predicate indicator (Name/Arity or Name//Arity)
 136%     Lists the indicated predicate.  This also outputs relevant
 137%     _declarations_, such as multifile/1 or dynamic/1.
 138%
 139%     * A _Head_ term.  In this case, only clauses whose head
 140%     unify with _Head_ are listed.  This is illustrated in the
 141%     query below that only lists the first clause of append/3.
 142%
 143%       ==
 144%       ?- listing(append([], _, _)).
 145%       lists:append([], A, A).
 146%       ==
 147
 148listing(M:Spec) :-
 149    var(Spec),
 150    !,
 151    list_module(M).
 152listing(M:List) :-
 153    is_list(List),
 154    !,
 155    forall(member(Spec, List),
 156           listing(M:Spec)).
 157listing(X) :-
 158    (   prolog:locate_clauses(X, ClauseRefs)
 159    ->  list_clauserefs(ClauseRefs)
 160    ;   '$find_predicate'(X, Preds),
 161        list_predicates(Preds, X)
 162    ).
 163
 164list_clauserefs([]) :- !.
 165list_clauserefs([H|T]) :-
 166    !,
 167    list_clauserefs(H),
 168    list_clauserefs(T).
 169list_clauserefs(Ref) :-
 170    clause(Head, Body, Ref),
 171    portray_clause((Head :- Body)).
 172
 173%!  list_predicates(:Preds:list(pi), :Spec) is det.
 174
 175list_predicates(PIs, Context:X) :-
 176    member(PI, PIs),
 177    pi_to_head(PI, Pred),
 178    unify_args(Pred, X),
 179    list_define(Pred, DefPred),
 180    list_predicate(DefPred, Context),
 181    nl,
 182    fail.
 183list_predicates(_, _).
 184
 185list_define(Head, LoadModule:Head) :-
 186    compound(Head),
 187    Head \= (_:_),
 188    functor(Head, Name, Arity),
 189    '$find_library'(_, Name, Arity, LoadModule, Library),
 190    !,
 191    use_module(Library, []).
 192list_define(M:Pred, DefM:Pred) :-
 193    '$define_predicate'(M:Pred),
 194    (   predicate_property(M:Pred, imported_from(DefM))
 195    ->  true
 196    ;   DefM = M
 197    ).
 198
 199pi_to_head(PI, _) :-
 200    var(PI),
 201    !,
 202    instantiation_error(PI).
 203pi_to_head(M:PI, M:Head) :-
 204    !,
 205    pi_to_head(PI, Head).
 206pi_to_head(Name/Arity, Head) :-
 207    functor(Head, Name, Arity).
 208
 209
 210%       Unify the arguments of the specification with the given term,
 211%       so we can partially instantate the head.
 212
 213unify_args(_, _/_) :- !.                % Name/arity spec
 214unify_args(X, X) :- !.
 215unify_args(_:X, X) :- !.
 216unify_args(_, _).
 217
 218list_predicate(Pred, Context) :-
 219    predicate_property(Pred, undefined),
 220    !,
 221    decl_term(Pred, Context, Decl),
 222    format('%   Undefined: ~q~n', [Decl]).
 223list_predicate(Pred, Context) :-
 224    predicate_property(Pred, foreign),
 225    !,
 226    decl_term(Pred, Context, Decl),
 227    format('%   Foreign: ~q~n', [Decl]).
 228list_predicate(Pred, Context) :-
 229    notify_changed(Pred, Context),
 230    list_declarations(Pred, Context),
 231    list_clauses(Pred, Context).
 232
 233decl_term(Pred, Context, Decl) :-
 234    strip_module(Pred, Module, Head),
 235    functor(Head, Name, Arity),
 236    (   hide_module(Module, Context, Head)
 237    ->  Decl = Name/Arity
 238    ;   Decl = Module:Name/Arity
 239    ).
 240
 241
 242decl(thread_local, thread_local).
 243decl(dynamic,      dynamic).
 244decl(volatile,     volatile).
 245decl(multifile,    multifile).
 246decl(public,       public).
 247
 248declaration(Pred, Source, Decl) :-
 249    decl(Prop, Declname),
 250    predicate_property(Pred, Prop),
 251    decl_term(Pred, Source, Funct),
 252    Decl =.. [ Declname, Funct ].
 253declaration(Pred, Source, Decl) :-
 254    predicate_property(Pred, meta_predicate(Head)),
 255    strip_module(Pred, Module, _),
 256    (   (Module == system; Source == Module)
 257    ->  Decl = meta_predicate(Head)
 258    ;   Decl = meta_predicate(Module:Head)
 259    ),
 260    (   meta_implies_transparent(Head)
 261    ->  !                                   % hide transparent
 262    ;   true
 263    ).
 264declaration(Pred, Source, Decl) :-
 265    predicate_property(Pred, transparent),
 266    decl_term(Pred, Source, PI),
 267    Decl = module_transparent(PI).
 268
 269%!  meta_implies_transparent(+Head) is semidet.
 270%
 271%   True if the meta-declaration Head implies  that the predicate is
 272%   transparent.
 273
 274meta_implies_transparent(Head):-
 275    compound(Head),
 276    arg(_, Head, Arg),
 277    implies_transparent(Arg),
 278    !.
 279
 280implies_transparent(Arg) :-
 281    integer(Arg),
 282    !.
 283implies_transparent(:).
 284implies_transparent(//).
 285implies_transparent(^).
 286
 287
 288list_declarations(Pred, Source) :-
 289    findall(Decl, declaration(Pred, Source, Decl), Decls),
 290    (   Decls == []
 291    ->  true
 292    ;   write_declarations(Decls, Source),
 293        format('~n', [])
 294    ).
 295
 296
 297write_declarations([], _) :- !.
 298write_declarations([H|T], Module) :-
 299    format(':- ~q.~n', [H]),
 300    write_declarations(T, Module).
 301
 302list_clauses(Pred, Source) :-
 303    strip_module(Pred, Module, Head),
 304    (   clause(Pred, Body),
 305        write_module(Module, Source, Head),
 306        portray_clause((Head:-Body)),
 307        fail
 308    ;   true
 309    ).
 310
 311write_module(Module, Context, Head) :-
 312    hide_module(Module, Context, Head),
 313    !.
 314write_module(Module, _, _) :-
 315    format('~q:', [Module]).
 316
 317hide_module(system, Module, Head) :-
 318    predicate_property(Module:Head, imported_from(M)),
 319    predicate_property(system:Head, imported_from(M)),
 320    !.
 321hide_module(Module, Module, _) :- !.
 322
 323notify_changed(Pred, Context) :-
 324    strip_module(Pred, user, Head),
 325    predicate_property(Head, built_in),
 326    \+ predicate_property(Head, (dynamic)),
 327    !,
 328    decl_term(Pred, Context, Decl),
 329    format('%   NOTE: system definition has been overruled for ~q~n',
 330           [Decl]).
 331notify_changed(_, _).
 332
 333%!  portray_clause(+Clause) is det.
 334%!  portray_clause(+Out:stream, +Clause) is det.
 335%!  portray_clause(+Out:stream, +Clause, +Options) is det.
 336%
 337%   Portray `Clause' on the current  output   stream.  Layout of the
 338%   clause is to our best standards.   As  the actual variable names
 339%   are not available we use A, B, ... Deals with ';', '|', '->' and
 340%   calls via meta-call predicates as determined using the predicate
 341%   property   meta_predicate.   If   Clause   contains   attributed
 342%   variables, these are treated as normal variables.
 343%
 344%   If  Options  is  provided,   the    option-list   is  passed  to
 345%   write_term/3 that does the final writing of arguments.
 346
 347%       The prolog_list_goal/1 hook is  a  dubious   as  it  may lead to
 348%       confusion if the heads relates to other   bodies.  For now it is
 349%       only used for XPCE methods and works just nice.
 350%
 351%       Not really ...  It may confuse the source-level debugger.
 352
 353%portray_clause(Head :- _Body) :-
 354%       user:prolog_list_goal(Head), !.
 355portray_clause(Term) :-
 356    current_output(Out),
 357    portray_clause(Out, Term).
 358
 359portray_clause(Stream, Term) :-
 360    must_be(stream, Stream),
 361    portray_clause(Stream, Term, []).
 362
 363portray_clause(Stream, Term, M:Options) :-
 364    must_be(list, Options),
 365    meta_options(is_meta, M:Options, QOptions),
 366    \+ \+ ( copy_term_nat(Term, Copy),
 367            numbervars(Copy, 0, _,
 368                       [ singletons(true)
 369                       ]),
 370            do_portray_clause(Stream, Copy, QOptions)
 371          ).
 372
 373is_meta(portray_goal).
 374
 375do_portray_clause(Out, Var, Options) :-
 376    var(Var),
 377    !,
 378    pprint(Out, Var, 1200, Options).
 379do_portray_clause(Out, (Head :- true), Options) :-
 380    !,
 381    pprint(Out, Head, 1200, Options),
 382    full_stop(Out).
 383do_portray_clause(Out, Term, Options) :-
 384    clause_term(Term, Head, Neck, Body),
 385    !,
 386    inc_indent(0, 1, Indent),
 387    infix_op(Neck, RightPri, LeftPri),
 388    pprint(Out, Head, LeftPri, Options),
 389    format(Out, ' ~w', [Neck]),
 390    (   nonvar(Body),
 391        Body = Module:LocalBody,
 392        \+ primitive(LocalBody)
 393    ->  nlindent(Out, Indent),
 394        format(Out, '~q', [Module]),
 395        '$put_token'(Out, :),
 396        nlindent(Out, Indent),
 397        write(Out, '(   '),
 398        inc_indent(Indent, 1, BodyIndent),
 399        portray_body(LocalBody, BodyIndent, noindent, 1200, Out, Options),
 400        nlindent(Out, Indent),
 401        write(Out, ')')
 402    ;   setting(listing:body_indentation, BodyIndent),
 403        portray_body(Body, BodyIndent, indent, RightPri, Out, Options)
 404    ),
 405    full_stop(Out).
 406do_portray_clause(Out, (:-use_module(File, Imports)), Options) :-
 407    length(Imports, Len),
 408    Len > 3,
 409    !,
 410    format(Out, ':- use_module(~q,', [File]),
 411    portray_list(Imports, 14, Out, Options),
 412    write(Out, ').\n').
 413do_portray_clause(Out, (:-module(Module, Exports)), Options) :-
 414    !,
 415    format(Out, ':- module(~q,', [Module]),
 416    portray_list(Exports, 10, Out, Options),
 417    write(Out, ').\n').
 418do_portray_clause(Out, (:-Directive), Options) :-
 419    !,
 420    write(Out, ':- '),
 421    portray_body(Directive, 3, noindent, 1199, Out, Options),
 422    full_stop(Out).
 423do_portray_clause(Out, Fact, Options) :-
 424    portray_body(Fact, 0, noindent, 1200, Out, Options),
 425    full_stop(Out).
 426
 427clause_term((Head:-Body), Head, :-, Body).
 428clause_term((Head-->Body), Head, -->, Body).
 429
 430full_stop(Out) :-
 431    '$put_token'(Out, '.'),
 432    nl(Out).
 433
 434
 435%!  portray_body(+Term, +Indent, +DoIndent, +Priority, +Out, +Options)
 436%
 437%   Write Term at current indentation. If   DoIndent  is 'indent' we
 438%   must first call nlindent/2 before emitting anything.
 439
 440portray_body(Var, _, _, Pri, Out, Options) :-
 441    var(Var),
 442    !,
 443    pprint(Out, Var, Pri, Options).
 444portray_body(!, _, _, _, Out, _) :-
 445    setting(listing:cut_on_same_line, true),
 446    !,
 447    write(Out, ' !').
 448portray_body((!, Clause), Indent, _, Pri, Out, Options) :-
 449    setting(listing:cut_on_same_line, true),
 450    \+ term_needs_braces((_,_), Pri),
 451    !,
 452    write(Out, ' !,'),
 453    portray_body(Clause, Indent, indent, 1000, Out, Options).
 454portray_body(Term, Indent, indent, Pri, Out, Options) :-
 455    !,
 456    nlindent(Out, Indent),
 457    portray_body(Term, Indent, noindent, Pri, Out, Options).
 458portray_body(Or, Indent, _, _, Out, Options) :-
 459    or_layout(Or),
 460    !,
 461    write(Out, '(   '),
 462    portray_or(Or, Indent, 1200, Out, Options),
 463    nlindent(Out, Indent),
 464    write(Out, ')').
 465portray_body(Term, Indent, _, Pri, Out, Options) :-
 466    term_needs_braces(Term, Pri),
 467    !,
 468    write(Out, '( '),
 469    ArgIndent is Indent + 2,
 470    portray_body(Term, ArgIndent, noindent, 1200, Out, Options),
 471    nlindent(Out, Indent),
 472    write(Out, ')').
 473portray_body((A,B), Indent, _, _Pri, Out, Options) :-
 474    !,
 475    infix_op(',', LeftPri, RightPri),
 476    portray_body(A, Indent, noindent, LeftPri, Out, Options),
 477    write(Out, ','),
 478    portray_body(B, Indent, indent, RightPri, Out, Options).
 479portray_body(\+(Goal), Indent, _, _Pri, Out, Options) :-
 480    !,
 481    write(Out, \+), write(Out, ' '),
 482    prefix_op(\+, ArgPri),
 483    ArgIndent is Indent+3,
 484    portray_body(Goal, ArgIndent, noindent, ArgPri, Out, Options).
 485portray_body(Call, _, _, _, Out, Options) :- % requires knowledge on the module!
 486    m_callable(Call),
 487    option(module(M), Options, user),
 488    predicate_property(M:Call, meta_predicate(Meta)),
 489    !,
 490    portray_meta(Out, Call, Meta, Options).
 491portray_body(Clause, _, _, Pri, Out, Options) :-
 492    pprint(Out, Clause, Pri, Options).
 493
 494m_callable(Term) :-
 495    strip_module(Term, _, Plain),
 496    callable(Plain),
 497    Plain \= (_:_).
 498
 499term_needs_braces(Term, Pri) :-
 500    callable(Term),
 501    functor(Term, Name, _Arity),
 502    current_op(OpPri, _Type, Name),
 503    OpPri > Pri,
 504    !.
 505
 506%!  portray_or(+Term, +Indent, +Priority, +Out) is det.
 507
 508portray_or(Term, Indent, Pri, Out, Options) :-
 509    term_needs_braces(Term, Pri),
 510    !,
 511    inc_indent(Indent, 1, NewIndent),
 512    write(Out, '(   '),
 513    portray_or(Term, NewIndent, Out, Options),
 514    nlindent(Out, NewIndent),
 515    write(Out, ')').
 516portray_or(Term, Indent, _Pri, Out, Options) :-
 517    or_layout(Term),
 518    !,
 519    portray_or(Term, Indent, Out, Options).
 520portray_or(Term, Indent, Pri, Out, Options) :-
 521    inc_indent(Indent, 1, NestIndent),
 522    portray_body(Term, NestIndent, noindent, Pri, Out, Options).
 523
 524
 525portray_or((If -> Then ; Else), Indent, Out, Options) :-
 526    !,
 527    inc_indent(Indent, 1, NestIndent),
 528    infix_op((->), LeftPri, RightPri),
 529    portray_body(If, NestIndent, noindent, LeftPri, Out, Options),
 530    nlindent(Out, Indent),
 531    write(Out, '->  '),
 532    portray_body(Then, NestIndent, noindent, RightPri, Out, Options),
 533    nlindent(Out, Indent),
 534    write(Out, ';   '),
 535    infix_op(;, _LeftPri, RightPri2),
 536    portray_or(Else, Indent, RightPri2, Out, Options).
 537portray_or((If *-> Then ; Else), Indent, Out, Options) :-
 538    !,
 539    inc_indent(Indent, 1, NestIndent),
 540    infix_op((*->), LeftPri, RightPri),
 541    portray_body(If, NestIndent, noindent, LeftPri, Out, Options),
 542    nlindent(Out, Indent),
 543    write(Out, '*-> '),
 544    portray_body(Then, NestIndent, noindent, RightPri, Out, Options),
 545    nlindent(Out, Indent),
 546    write(Out, ';   '),
 547    infix_op(;, _LeftPri, RightPri2),
 548    portray_or(Else, Indent, RightPri2, Out, Options).
 549portray_or((If -> Then), Indent, Out, Options) :-
 550    !,
 551    inc_indent(Indent, 1, NestIndent),
 552    infix_op((->), LeftPri, RightPri),
 553    portray_body(If, NestIndent, noindent, LeftPri, Out, Options),
 554    nlindent(Out, Indent),
 555    write(Out, '->  '),
 556    portray_or(Then, Indent, RightPri, Out, Options).
 557portray_or((If *-> Then), Indent, Out, Options) :-
 558    !,
 559    inc_indent(Indent, 1, NestIndent),
 560    infix_op((->), LeftPri, RightPri),
 561    portray_body(If, NestIndent, noindent, LeftPri, Out, Options),
 562    nlindent(Out, Indent),
 563    write(Out, '*-> '),
 564    portray_or(Then, Indent, RightPri, Out, Options).
 565portray_or((A;B), Indent, Out, Options) :-
 566    !,
 567    inc_indent(Indent, 1, NestIndent),
 568    infix_op(;, LeftPri, RightPri),
 569    portray_body(A, NestIndent, noindent, LeftPri, Out, Options),
 570    nlindent(Out, Indent),
 571    write(Out, ';   '),
 572    portray_or(B, Indent, RightPri, Out, Options).
 573portray_or((A|B), Indent, Out, Options) :-
 574    !,
 575    inc_indent(Indent, 1, NestIndent),
 576    infix_op('|', LeftPri, RightPri),
 577    portray_body(A, NestIndent, noindent, LeftPri, Out, Options),
 578    nlindent(Out, Indent),
 579    write(Out, '|   '),
 580    portray_or(B, Indent, RightPri, Out, Options).
 581
 582
 583%!  infix_op(+Op, -Left, -Right) is semidet.
 584%
 585%   True if Op is an infix operator and Left is the max priority of its
 586%   left hand and Right is the max priority of its right hand.
 587
 588infix_op(Op, Left, Right) :-
 589    current_op(Pri, Assoc, Op),
 590    infix_assoc(Assoc, LeftMin, RightMin),
 591    !,
 592    Left is Pri - LeftMin,
 593    Right is Pri - RightMin.
 594
 595infix_assoc(xfx, 1, 1).
 596infix_assoc(xfy, 1, 0).
 597infix_assoc(yfx, 0, 1).
 598
 599prefix_op(Op, ArgPri) :-
 600    current_op(Pri, Assoc, Op),
 601    pre_assoc(Assoc, ArgMin),
 602    !,
 603    ArgPri is Pri - ArgMin.
 604
 605pre_assoc(fx, 1).
 606pre_assoc(fy, 0).
 607
 608postfix_op(Op, ArgPri) :-
 609    current_op(Pri, Assoc, Op),
 610    post_assoc(Assoc, ArgMin),
 611    !,
 612    ArgPri is Pri - ArgMin.
 613
 614post_assoc(xf, 1).
 615post_assoc(yf, 0).
 616
 617%!  or_layout(@Term) is semidet.
 618%
 619%   True if Term is a control structure for which we want to use clean
 620%   layout.
 621%
 622%   @tbd    Change name.
 623
 624or_layout(Var) :-
 625    var(Var), !, fail.
 626or_layout((_;_)).
 627or_layout((_->_)).
 628or_layout((_*->_)).
 629
 630primitive(G) :-
 631    or_layout(G), !, fail.
 632primitive((_,_)) :- !, fail.
 633primitive(_).
 634
 635
 636%!  portray_meta(+Out, +Call, +MetaDecl, +Options)
 637%
 638%   Portray a meta-call. If Call   contains non-primitive meta-calls
 639%   we put each argument on a line and layout the body. Otherwise we
 640%   simply print the goal.
 641
 642portray_meta(Out, Call, Meta, Options) :-
 643    contains_non_primitive_meta_arg(Call, Meta),
 644    !,
 645    Call =.. [Name|Args],
 646    Meta =.. [_|Decls],
 647    format(Out, '~q(', [Name]),
 648    line_position(Out, Indent),
 649    portray_meta_args(Decls, Args, Indent, Out, Options),
 650    format(Out, ')', []).
 651portray_meta(Out, Call, _, Options) :-
 652    pprint(Out, Call, 999, Options).
 653
 654contains_non_primitive_meta_arg(Call, Decl) :-
 655    arg(I, Call, CA),
 656    arg(I, Decl, DA),
 657    integer(DA),
 658    \+ primitive(CA),
 659    !.
 660
 661portray_meta_args([], [], _, _, _).
 662portray_meta_args([D|DT], [A|AT], Indent, Out, Options) :-
 663    portray_meta_arg(D, A, Out, Options),
 664    (   DT == []
 665    ->  true
 666    ;   format(Out, ',', []),
 667        nlindent(Out, Indent),
 668        portray_meta_args(DT, AT, Indent, Out, Options)
 669    ).
 670
 671portray_meta_arg(I, A, Out, Options) :-
 672    integer(I),
 673    !,
 674    line_position(Out, Indent),
 675    portray_body(A, Indent, noindent, 999, Out, Options).
 676portray_meta_arg(_, A, Out, Options) :-
 677    pprint(Out, A, 999, Options).
 678
 679%!  portray_list(+List, +Indent, +Out)
 680%
 681%   Portray a list like this.  Right side for improper lists
 682%
 683%           [ element1,             [ element1
 684%             element2,     OR      | tail
 685%           ]                       ]
 686
 687portray_list([], _, Out, _) :-
 688    !,
 689    write(Out, []).
 690portray_list(List, Indent, Out, Options) :-
 691    nlindent(Out, Indent),
 692    write(Out, '[ '),
 693    EIndent is Indent + 2,
 694    portray_list_elements(List, EIndent, Out, Options),
 695    nlindent(Out, Indent),
 696    write(Out, ']').
 697
 698portray_list_elements([H|T], EIndent, Out, Options) :-
 699    pprint(Out, H, 999, Options),
 700    (   T == []
 701    ->  true
 702    ;   nonvar(T), T = [_|_]
 703    ->  write(Out, ','),
 704        nlindent(Out, EIndent),
 705        portray_list_elements(T, EIndent, Out, Options)
 706    ;   Indent is EIndent - 2,
 707        nlindent(Out, Indent),
 708        write(Out, '| '),
 709        pprint(Out, T, 999, Options)
 710    ).
 711
 712%!  pprint(+Out, +Term, +Priority, +Options)
 713%
 714%   Print  Term  at  Priority.  This  also  takes  care  of  several
 715%   formatting options, in particular:
 716%
 717%     * {}(Arg) terms are printed with aligned arguments, assuming
 718%     that the term is a body-term.
 719%     * Terms that do not fit on the line are wrapped using
 720%     pprint_wrapped/3.
 721%
 722%   @tbd    Decide when and how to wrap long terms.
 723
 724pprint(Out, Term, _, Options) :-
 725    nonvar(Term),
 726    Term = {}(Arg),
 727    line_position(Out, Indent),
 728    ArgIndent is Indent + 2,
 729    format(Out, '{ ', []),
 730    portray_body(Arg, ArgIndent, noident, 1000, Out, Options),
 731    nlindent(Out, Indent),
 732    format(Out, '}', []).
 733pprint(Out, Term, Pri, Options) :-
 734    (   compound(Term)
 735    ->  compound_name_arity(Term, _, Arity),
 736        Arity > 0
 737    ;   is_dict(Term)
 738    ),
 739    \+ nowrap_term(Term),
 740    setting(listing:line_width, Width),
 741    Width > 0,
 742    (   write_length(Term, Len, [max_length(Width)|Options])
 743    ->  true
 744    ;   Len = Width
 745    ),
 746    line_position(Out, Indent),
 747    Indent + Len > Width,
 748    Len > Width/4,                 % ad-hoc rule for deeply nested goals
 749    !,
 750    pprint_wrapped(Out, Term, Pri, Options).
 751pprint(Out, Term, Pri, Options) :-
 752    listing_write_options(Pri, WrtOptions, Options),
 753    write_term(Out, Term, WrtOptions).
 754
 755nowrap_term('$VAR'(_)) :- !.
 756nowrap_term(_{}) :- !.                  % empty dict
 757nowrap_term(Term) :-
 758    functor(Term, Name, Arity),
 759    current_op(_, _, Name),
 760    (   Arity == 2
 761    ->  infix_op(Name, _, _)
 762    ;   Arity == 1
 763    ->  (   prefix_op(Name, _)
 764        ->  true
 765        ;   postfix_op(Name, _)
 766        )
 767    ).
 768
 769
 770pprint_wrapped(Out, Term, _, Options) :-
 771    Term = [_|_],
 772    !,
 773    line_position(Out, Indent),
 774    portray_list(Term, Indent, Out, Options).
 775pprint_wrapped(Out, Dict, _, Options) :-
 776    is_dict(Dict),
 777    !,
 778    dict_pairs(Dict, Tag, Pairs),
 779    pprint(Out, Tag, 1200, Options),
 780    format(Out, '{ ', []),
 781    line_position(Out, Indent),
 782    pprint_nv(Pairs, Indent, Out, Options),
 783    nlindent(Out, Indent-2),
 784    format(Out, '}', []).
 785pprint_wrapped(Out, Term, _, Options) :-
 786    Term =.. [Name|Args],
 787    format(Out, '~q(', Name),
 788    line_position(Out, Indent),
 789    pprint_args(Args, Indent, Out, Options),
 790    format(Out, ')', []).
 791
 792pprint_args([], _, _, _).
 793pprint_args([H|T], Indent, Out, Options) :-
 794    pprint(Out, H, 999, Options),
 795    (   T == []
 796    ->  true
 797    ;   format(Out, ',', []),
 798        nlindent(Out, Indent),
 799        pprint_args(T, Indent, Out, Options)
 800    ).
 801
 802
 803pprint_nv([], _, _, _).
 804pprint_nv([Name-Value|T], Indent, Out, Options) :-
 805    pprint(Out, Name, 999, Options),
 806    format(Out, ':', []),
 807    pprint(Out, Value, 999, Options),
 808    (   T == []
 809    ->  true
 810    ;   format(Out, ',', []),
 811        nlindent(Out, Indent),
 812        pprint_nv(T, Indent, Out, Options)
 813    ).
 814
 815
 816%!  listing_write_options(+Priority, -WriteOptions) is det.
 817%
 818%   WriteOptions are write_term/3 options for writing a term at
 819%   priority Priority.
 820
 821listing_write_options(Pri,
 822                      [ quoted(true),
 823                        numbervars(true),
 824                        priority(Pri),
 825                        spacing(next_argument)
 826                      | Options
 827                      ],
 828                      Options).
 829
 830%!  nlindent(+Out, +Indent)
 831%
 832%   Write newline and indent to  column   Indent.  Uses  the setting
 833%   listing:tab_distance to determine the mapping   between tabs and
 834%   spaces.
 835
 836nlindent(Out, N) :-
 837    nl(Out),
 838    setting(listing:tab_distance, D),
 839    (   D =:= 0
 840    ->  tab(Out, N)
 841    ;   Tab is N // D,
 842        Space is N mod D,
 843        put_tabs(Out, Tab),
 844        tab(Out, Space)
 845    ).
 846
 847put_tabs(Out, N) :-
 848    N > 0,
 849    !,
 850    put(Out, 0'\t),
 851    NN is N - 1,
 852    put_tabs(Out, NN).
 853put_tabs(_, _).
 854
 855
 856%!  inc_indent(+Indent0, +Inc, -Indent)
 857%
 858%   Increment the indent with logical steps.
 859
 860inc_indent(Indent0, Inc, Indent) :-
 861    Indent is Indent0 + Inc*4.
 862
 863:- multifile
 864    sandbox:safe_meta/2.
 865
 866sandbox:safe_meta(listing(What), []) :-
 867    not_qualified(What).
 868
 869not_qualified(Var) :-
 870    var(Var),
 871    !.
 872not_qualified(_:_) :- !, fail.
 873not_qualified(_).