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(_)