View source with formatted comments or as raw
    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)  2014, 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_pretty_print,
   37          [ print_term/2        % +Term, +Options
   38          ]).   39:- use_module(library(option)).   40
   41/** <module> Pretty Print Prolog terms
   42
   43This module is a first  start  of   what  should  become a full-featured
   44pretty printer for Prolog  terms  with   many  options  and  parameters.
   45Eventually,  it  should  replace  portray_clause/1   and  various  other
   46special-purpose predicates.
   47
   48@tbd This is just a quicky. We  need proper handling of portray/1, avoid
   49printing very long terms  multiple   times,  spacing (around operators),
   50etc.
   51
   52@tbd Use a record for the option-processing.
   53
   54@tbd The current approach is far too simple, often resulting in illegal
   55     terms.
   56*/
   57
   58:- predicate_options(print_term/2, 2,
   59                     [ output(stream),
   60                       right_margin(integer),
   61                       left_margin(integer),
   62                       tab_width(integer),
   63                       indent_arguments(integer),
   64                       operators(boolean),
   65                       write_options(list)
   66                     ]).   67
   68%!  print_term(+Term, +Options) is det.
   69%
   70%   Pretty print a Prolog term. The following options are processed:
   71%
   72%     * output(+Stream)
   73%     Define the output stream.  Default is =user_output=
   74%     * right_margin(+Integer)
   75%     Width of a line.  Default is 72 characters.
   76%     * left_margin(+Integer)
   77%     Left margin for continuation lines.  Default is 0.
   78%     * tab_width(+Integer)
   79%     Distance between tab-stops.  Default is 8 characters.
   80%     * indent_arguments(+Spec)
   81%     Defines how arguments of compound terms are placed.  Defined
   82%     values are:
   83%       $ =false= :
   84%       Simply place them left to right (no line-breaks)
   85%       $ =true= :
   86%       Place them vertically, aligned with the open bracket (not
   87%       implemented)
   88%       $ =auto= (default) :
   89%       As horizontal if line-width is not exceeded, vertical
   90%       otherwise.
   91%       $ An integer :
   92%       Place them vertically aligned, <N> spaces to the right of
   93%       the beginning of the head.
   94%     * operators(+Boolean)
   95%     This is the inverse of the write_term/3 option =ignore_ops=.
   96%     Default is to respect them.
   97%     * write_options(+List)
   98%     List of options passed to write_term/3 for terms that are
   99%     not further processed.  Default:
  100%       ==
  101%           [ numbervars(true),
  102%             quoted(true),
  103%             portray(true)
  104%           ]
  105%       ==
  106
  107print_term(Term, Options) :-
  108    \+ \+ print_term_2(Term, Options).
  109
  110print_term_2(Term, Options0) :-
  111    prepare_term(Term, Template, Cycles, Constraints),
  112    defaults(Defs),
  113    merge_options(Options0, Defs, Options),
  114    option(write_options(WrtOpts), Options),
  115    option(max_depth(MaxDepth), WrtOpts, infinite),
  116    option(left_margin(LeftMargin), Options, 0),
  117    Context = ctx(LeftMargin,0,1200,MaxDepth),
  118    pp(Template, Context, Options),
  119    print_extra(Cycles, Context, 'where', Options),
  120    print_extra(Constraints, Context, 'with constraints', Options).
  121
  122print_extra([], _, _, _) :- !.
  123print_extra(List, Context, Comment, Options) :-
  124    option(output(Out), Options),
  125    format(Out, ', % ~w', [Comment]),
  126    modify_context(Context, [indent=4], Context1),
  127    print_extra_2(List, Context1, Options).
  128
  129print_extra_2([H|T], Context, Options) :-
  130    option(output(Out), Options),
  131    context(Context, indent, Indent),
  132    indent(Out, Indent, Options),
  133    pp(H, Context, Options),
  134    (   T == []
  135    ->  true
  136    ;   format(Out, ',', []),
  137        print_extra_2(T, Context, Options)
  138    ).
  139
  140
  141%!  prepare_term(+Term, -Template, -Cycles, -Constraints)
  142%
  143%   Prepare a term, possibly  holding   cycles  and  constraints for
  144%   printing.
  145
  146prepare_term(Term, Template, Cycles, Constraints) :-
  147    term_attvars(Term, []),
  148    !,
  149    Constraints = [],
  150    '$factorize_term'(Term, Template, Factors),
  151    bind_non_cycles(Factors, 1, Cycles),
  152    numbervars(Template+Cycles+Constraints, 0, _,
  153               [singletons(true)]).
  154prepare_term(Term, Template, Cycles, Constraints) :-
  155    copy_term(Term, Copy, Constraints),
  156    !,
  157    '$factorize_term'(Copy, Template, Factors),
  158    bind_non_cycles(Factors, 1, Cycles),
  159    numbervars(Template+Cycles+Constraints, 0, _,
  160               [singletons(true)]).
  161
  162
  163bind_non_cycles([], _, []).
  164bind_non_cycles([V=Term|T], I, L) :-
  165    unify_with_occurs_check(V, Term),
  166    !,
  167    bind_non_cycles(T, I, L).
  168bind_non_cycles([H|T0], I, [H|T]) :-
  169    H = ('$VAR'(Name)=_),
  170    atom_concat('_S', I, Name),
  171    I2 is I + 1,
  172    bind_non_cycles(T0, I2, T).
  173
  174
  175defaults([ output(user_output),
  176           right_margin(72),
  177           indent_arguments(auto),
  178           operators(true),
  179           write_options([ quoted(true),
  180                           numbervars(true),
  181                           portray(true),
  182                           attributes(portray)
  183                         ])
  184         ]).
  185
  186
  187                 /*******************************
  188                 *             CONTEXT          *
  189                 *******************************/
  190
  191context_attribute(indent,     1).
  192context_attribute(depth,      2).
  193context_attribute(precedence, 3).
  194context_attribute(max_depth,  4).
  195
  196context(Ctx, Name, Value) :-
  197    context_attribute(Name, Arg),
  198    arg(Arg, Ctx, Value).
  199
  200modify_context(Ctx0, Mapping, Ctx) :-
  201    functor(Ctx0, Name, Arity),
  202    functor(Ctx,  Name, Arity),
  203    modify_context(0, Arity, Ctx0, Mapping, Ctx).
  204
  205modify_context(Arity, Arity, _, _, _) :- !.
  206modify_context(I, Arity, Ctx0, Mapping, Ctx) :-
  207    N is I + 1,
  208    (   context_attribute(Name, N),
  209        memberchk(Name=Value, Mapping)
  210    ->  true
  211    ;   arg(N, Ctx0, Value)
  212    ),
  213    arg(N, Ctx, Value),
  214    modify_context(N, Arity, Ctx0, Mapping, Ctx).
  215
  216
  217dec_depth(Ctx, Ctx) :-
  218    context(Ctx, max_depth, infinite),
  219    !.
  220dec_depth(ctx(I,D,P,MD0), ctx(I,D,P,MD)) :-
  221    MD is MD0 - 1.
  222
  223
  224                 /*******************************
  225                 *              PP              *
  226                 *******************************/
  227
  228pp(Primitive, Ctx, Options) :-
  229    (   atomic(Primitive)
  230    ;   var(Primitive)
  231    ),
  232    !,
  233    pprint(Primitive, Ctx, Options).
  234pp(Portray, _Ctx, Options) :-
  235    option(write_options(WriteOptions), Options),
  236    option(portray(true), WriteOptions),
  237    option(output(Out), Options),
  238    with_output_to(Out, user:portray(Portray)),
  239    !.
  240pp(List, Ctx, Options) :-
  241    List = [_|_],
  242    !,
  243    context(Ctx, indent, Indent),
  244    context(Ctx, depth, Depth),
  245    option(output(Out), Options),
  246    option(indent_arguments(IndentStyle), Options),
  247    (   (   IndentStyle == false
  248        ->  true
  249        ;   IndentStyle == auto,
  250            print_width(List, Width, Options),
  251            option(right_margin(RM), Options),
  252            Indent + Width < RM
  253        )
  254    ->  pprint(List, Ctx, Options)
  255    ;   format(Out, '[ ', []),
  256        Nindent is Indent + 2,
  257        NDepth is Depth + 1,
  258        modify_context(Ctx, [indent=Nindent, depth=NDepth], NCtx),
  259        pp_list_elements(List, NCtx, Options),
  260        indent(Out, Indent, Options),
  261        format(Out, ']', [])
  262    ).
  263:- if(current_predicate(is_dict/1)).  264pp(Dict, Ctx, Options) :-
  265    is_dict(Dict),
  266    !,
  267    dict_pairs(Dict, Tag, Pairs),
  268    option(output(Out), Options),
  269    option(indent_arguments(IndentStyle), Options),
  270    context(Ctx, indent, Indent),
  271    (   IndentStyle == false ; Pairs == []
  272    ->  pprint(Dict, Ctx, Options)
  273    ;   IndentStyle == auto,
  274        print_width(Dict, Width, Options),
  275        option(right_margin(RM), Options),
  276        Indent + Width < RM         % fits on a line, simply write
  277    ->  pprint(Dict, Ctx, Options)
  278    ;   format(atom(Buf2), '~q{ ', [Tag]),
  279        write(Out, Buf2),
  280        atom_length(Buf2, FunctorIndent),
  281        (   integer(IndentStyle)
  282        ->  Nindent is Indent + IndentStyle,
  283            (   FunctorIndent > IndentStyle
  284            ->  indent(Out, Nindent, Options)
  285            ;   true
  286            )
  287        ;   Nindent is Indent + FunctorIndent
  288        ),
  289        context(Ctx, depth, Depth),
  290        NDepth is Depth + 1,
  291        modify_context(Ctx, [indent=Nindent, depth=NDepth], NCtx0),
  292        dec_depth(NCtx0, NCtx),
  293        pp_dict_args(Pairs, NCtx, Options),
  294        BraceIndent is Nindent - 2,         % '{ '
  295        indent(Out, BraceIndent, Options),
  296        write(Out, '}')
  297    ).
  298:- endif.  299pp(Term, Ctx, Options) :-               % handle operators
  300    compound(Term),
  301    compound_name_arity(Term, Name, Arity),
  302    current_op(Prec, Type, Name),
  303    match_op(Type, Arity, Kind, Prec, Left, Right),
  304    option(operators(true), Options),
  305    !,
  306    option(output(Out), Options),
  307    context(Ctx, indent, Indent),
  308    context(Ctx, depth, Depth),
  309    context(Ctx, precedence, CPrec),
  310    NDepth is Depth + 1,
  311    modify_context(Ctx, [depth=NDepth], Ctx1),
  312    dec_depth(Ctx1, Ctx2),
  313    (   Kind == prefix
  314    ->  arg(1, Term, Arg),
  315        (   CPrec >= Prec
  316        ->  format(atom(Buf), '~q ', Name),
  317            atom_length(Buf, AL),
  318            NIndent is Indent + AL,
  319            write(Out, Buf),
  320            modify_context(Ctx2, [indent=NIndent, precedence=Right], Ctx3),
  321            pp(Arg, Ctx3, Options)
  322        ;   format(atom(Buf), '(~q ', Name),
  323            atom_length(Buf, AL),
  324            NIndent is Indent + AL,
  325            write(Out, Buf),
  326            modify_context(Ctx2, [indent=NIndent, precedence=Right], Ctx3),
  327            pp(Arg, Ctx3, Options),
  328            format(Out, ')', [])
  329        )
  330    ;   Kind == postfix
  331    ->  arg(1, Term, Arg),
  332        (   CPrec >= Prec
  333        ->  modify_context(Ctx2, [precedence=Left], Ctx3),
  334            pp(Arg, Ctx3, Options),
  335            format(Out, ' ~q', Name)
  336        ;   format(Out, '(', []),
  337            NIndent is Indent + 1,
  338            modify_context(Ctx2, [indent=NIndent, precedence=Left], Ctx3),
  339            pp(Arg, Ctx3, Options),
  340            format(Out, ' ~q)', [Name])
  341        )
  342    ;   arg(1, Term, Arg1),
  343        arg(2, Term, Arg2),
  344        (   CPrec >= Prec
  345        ->  modify_context(Ctx2, [precedence=Left], Ctx3),
  346            pp(Arg1, Ctx3, Options),
  347            format(Out, ' ~q ', Name),
  348            modify_context(Ctx2, [precedence=Right], Ctx4),
  349            pp(Arg2, Ctx4, Options)
  350        ;   format(Out, '(', []),
  351            NIndent is Indent + 1,
  352            modify_context(Ctx2, [indent=NIndent, precedence=Left], Ctx3),
  353            pp(Arg1, Ctx3, Options),
  354            format(Out, ' ~q ', Name),
  355            modify_context(Ctx2, [precedence=Right], Ctx4),
  356            pp(Arg2, Ctx4, Options),
  357            format(Out, ')', [])
  358        )
  359    ).
  360pp(Term, Ctx, Options) :-               % compound
  361    option(output(Out), Options),
  362    option(indent_arguments(IndentStyle), Options),
  363    context(Ctx, indent, Indent),
  364    (   IndentStyle == false
  365    ->  pprint(Term, Ctx, Options)
  366    ;   IndentStyle == auto,
  367        print_width(Term, Width, Options),
  368        option(right_margin(RM), Options),
  369        Indent + Width < RM         % fits on a line, simply write
  370    ->  pprint(Term, Ctx, Options)
  371    ;   Term =.. [Name|Args],
  372        format(atom(Buf2), '~q(', [Name]),
  373        write(Out, Buf2),
  374        atom_length(Buf2, FunctorIndent),
  375        (   integer(IndentStyle)
  376        ->  Nindent is Indent + IndentStyle,
  377            (   FunctorIndent > IndentStyle
  378            ->  indent(Out, Nindent, Options)
  379            ;   true
  380            )
  381        ;   Nindent is Indent + FunctorIndent
  382        ),
  383        context(Ctx, depth, Depth),
  384        NDepth is Depth + 1,
  385        modify_context(Ctx, [indent=Nindent, depth=NDepth], NCtx0),
  386        dec_depth(NCtx0, NCtx),
  387        pp_compound_args(Args, NCtx, Options),
  388        write(Out, ')')
  389    ).
  390
  391
  392pp_list_elements(_, Ctx, Options) :-
  393    context(Ctx, max_depth, 0),
  394    !,
  395    option(output(Out), Options),
  396    write(Out, '...').
  397pp_list_elements([H|T], Ctx0, Options) :-
  398    dec_depth(Ctx0, Ctx),
  399    pp(H, Ctx, Options),
  400    (   T == []
  401    ->  true
  402    ;   nonvar(T),
  403        T = [_|_]
  404    ->  option(output(Out), Options),
  405        write(Out, ','),
  406        context(Ctx, indent, Indent),
  407        indent(Out, Indent, Options),
  408        pp_list_elements(T, Ctx, Options)
  409    ;   option(output(Out), Options),
  410        context(Ctx, indent, Indent),
  411        indent(Out, Indent-2, Options),
  412        write(Out, '| '),
  413        pp(T, Ctx, Options)
  414    ).
  415
  416
  417pp_compound_args([H|T], Ctx, Options) :-
  418    pp(H, Ctx, Options),
  419    (   T == []
  420    ->  true
  421    ;   T = [_|_]
  422    ->  option(output(Out), Options),
  423        write(Out, ','),
  424        context(Ctx, indent, Indent),
  425        indent(Out, Indent, Options),
  426        pp_compound_args(T, Ctx, Options)
  427    ;   option(output(Out), Options),
  428        context(Ctx, indent, Indent),
  429        indent(Out, Indent-2, Options),
  430        write(Out, '| '),
  431        pp(T, Ctx, Options)
  432    ).
  433
  434
  435:- if(current_predicate(is_dict/1)).  436pp_dict_args([Name-Value|T], Ctx, Options) :-
  437    option(output(Out), Options),
  438    line_position(Out, Pos0),
  439    pp(Name, Ctx, Options),
  440    write(Out, ':'),
  441    line_position(Out, Pos1),
  442    context(Ctx, indent, Indent),
  443    Indent2 is Indent + Pos1-Pos0,
  444    modify_context(Ctx, [indent=Indent2], Ctx2),
  445    pp(Value, Ctx2, Options),
  446    (   T == []
  447    ->  true
  448    ;   option(output(Out), Options),
  449        write(Out, ','),
  450        indent(Out, Indent, Options),
  451        pp_dict_args(T, Ctx, Options)
  452    ).
  453:- endif.  454
  455%       match_op(+Type, +Arity, +Precedence, -LeftPrec, -RightPrec
  456
  457match_op(fx,    1, prefix,  P, _, R) :- R is P - 1.
  458match_op(fy,    1, prefix,  P, _, P).
  459match_op(xf,    1, postfix, P, _, L) :- L is P - 1.
  460match_op(yf,    1, postfix, P, P, _).
  461match_op(xfx,   2, infix,   P, A, A) :- A is P - 1.
  462match_op(xfy,   2, infix,   P, L, P) :- L is P - 1.
  463match_op(yfx,   2, infix,   P, P, R) :- R is P - 1.
  464
  465
  466%!  indent(+Out, +Indent, +Options)
  467%
  468%   Newline and indent to the indicated  column. Respects the option
  469%   =tab_width=.  Default  is  8.  If  the  tab-width  equals  zero,
  470%   indentation is emitted using spaces.
  471
  472indent(Out, Indent, Options) :-
  473    option(tab_width(TW), Options, 8),
  474    nl(Out),
  475    (   TW =:= 0
  476    ->  tab(Out, Indent)
  477    ;   Tabs is Indent // TW,
  478        Spaces is Indent mod TW,
  479        forall(between(1, Tabs, _), put(Out, 9)),
  480        tab(Out, Spaces)
  481    ).
  482
  483%!  print_width(+Term, -W, +Options) is det.
  484%
  485%   Width required when printing `normally' left-to-right.
  486
  487print_width(Term, W, Options) :-
  488    option(right_margin(RM), Options),
  489    (   write_length(Term, W, [max_length(RM)|Options])
  490    ->  true
  491    ;   W = RM
  492    ).
  493
  494%!  pprint(+Term, +Context, +Options)
  495%
  496%   The bottom-line print-routine.
  497
  498pprint(Term, Ctx, Options) :-
  499    option(output(Out), Options),
  500    pprint(Out, Term, Ctx, Options).
  501
  502pprint(Out, Term, Ctx, Options) :-
  503    option(write_options(WriteOptions), Options),
  504    context(Ctx, max_depth, MaxDepth),
  505    (   MaxDepth == infinite
  506    ->  write_term(Out, Term, WriteOptions)
  507    ;   MaxDepth =< 0
  508    ->  format(Out, '...', [])
  509    ;   write_term(Out, Term, [max_depth(MaxDepth)|WriteOptions])
  510    )