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)).

   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                     ]).

 print_term(+Term, +Options) is det

Pretty print a Prolog term. The following options are processed:

output(+Stream)

Define the output stream. Default is user_output

right_margin(+Integer)

Width of a line. Default is 72 characters.

left_margin(+Integer)

Left margin for continuation lines. Default is 0.

tab_width(+Integer)

Distance between tab-stops. Default is 8 characters.

indent_arguments(+Spec)

Defines how arguments of compound terms are placed. Defined values are:

false

Simply place them left to right (no line-breaks)

true

Place them vertically, aligned with the open bracket (not implemented)

auto (default)

As horizontal if line-width is not exceeded, vertical otherwise.

An integer

Place them vertically aligned, <N> spaces to the right of the beginning of the head.

operators(+Boolean)

This is the inverse of the write_term/3 option ignore_ops. Default is to respect them.

write_options(+List)

List of options passed to write_term/3 for terms that are not further processed. Default:

    [ numbervars(true),
      quoted(true),
      portray(true)
    ]

  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    ).

 prepare_term(+Term, -Template, -Cycles, -Constraints)

Prepare a term, possibly holding cycles and constraints for printing.

  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    functor(Term, Name, Arity),
  301    current_op(Prec, Type, Name),
  302    match_op(Type, Arity, Kind, Prec, Left, Right),
  303    option(operators(true), Options),
  304    !,
  305    option(output(Out), Options),
  306    context(Ctx, indent, Indent),
  307    context(Ctx, depth, Depth),
  308    context(Ctx, precedence, CPrec),
  309    NDepth is Depth + 1,
  310    modify_context(Ctx, [depth=NDepth], Ctx1),
  311    dec_depth(Ctx1, Ctx2),
  312    (   Kind == prefix
  313    ->  arg(1, Term, Arg),
  314        (   CPrec >= Prec
  315        ->  format(atom(Buf), '~q ', Name),
  316            atom_length(Buf, AL),
  317            NIndent is Indent + AL,
  318            write(Out, Buf),
  319            modify_context(Ctx2, [indent=NIndent, precedence=Right], Ctx3),
  320            pp(Arg, Ctx3, Options)
  321        ;   format(atom(Buf), '(~q ', Name),
  322            atom_length(Buf, AL),
  323            NIndent is Indent + AL,
  324            write(Out, Buf),
  325            modify_context(Ctx2, [indent=NIndent, precedence=Right], Ctx3),
  326            pp(Arg, Ctx3, Options),
  327            format(Out, ')', [])
  328        )
  329    ;   Kind == postfix
  330    ->  arg(1, Term, Arg),
  331        (   CPrec >= Prec
  332        ->  modify_context(Ctx2, [precedence=Left], Ctx3),
  333            pp(Arg, Ctx3, Options),
  334            format(Out, ' ~q', Name)
  335        ;   format(Out, '(', []),
  336            NIndent is Indent + 1,
  337            modify_context(Ctx2, [indent=NIndent, precedence=Left], Ctx3),
  338            pp(Arg, Ctx3, Options),
  339            format(Out, ' ~q)', [Name])
  340        )
  341    ;   arg(1, Term, Arg1),
  342        arg(2, Term, Arg2),
  343        (   CPrec >= Prec
  344        ->  modify_context(Ctx2, [precedence=Left], Ctx3),
  345            pp(Arg1, Ctx3, Options),
  346            format(Out, ' ~q ', Name),
  347            modify_context(Ctx2, [precedence=Right], Ctx4),
  348            pp(Arg2, Ctx4, Options)
  349        ;   format(Out, '(', []),
  350            NIndent is Indent + 1,
  351            modify_context(Ctx2, [indent=NIndent, precedence=Left], Ctx3),
  352            pp(Arg1, Ctx3, Options),
  353            format(Out, ' ~q ', Name),
  354            modify_context(Ctx2, [precedence=Right], Ctx4),
  355            pp(Arg2, Ctx4, Options),
  356            format(Out, ')', [])
  357        )
  358    ).
  359pp(Term, Ctx, Options) :-               % compound
  360    option(output(Out), Options),
  361    option(indent_arguments(IndentStyle), Options),
  362    context(Ctx, indent, Indent),
  363    (   IndentStyle == false
  364    ->  pprint(Term, Ctx, Options)
  365    ;   IndentStyle == auto,
  366        print_width(Term, Width, Options),
  367        option(right_margin(RM), Options),
  368        Indent + Width < RM         % fits on a line, simply write
  369    ->  pprint(Term, Ctx, Options)
  370    ;   Term =.. [Name|Args],
  371        format(atom(Buf2), '~q(', [Name]),
  372        write(Out, Buf2),
  373        atom_length(Buf2, FunctorIndent),
  374        (   integer(IndentStyle)
  375        ->  Nindent is Indent + IndentStyle,
  376            (   FunctorIndent > IndentStyle
  377            ->  indent(Out, Nindent, Options)
  378            ;   true
  379            )
  380        ;   Nindent is Indent + FunctorIndent
  381        ),
  382        context(Ctx, depth, Depth),
  383        NDepth is Depth + 1,
  384        modify_context(Ctx, [indent=Nindent, depth=NDepth], NCtx0),
  385        dec_depth(NCtx0, NCtx),
  386        pp_compound_args(Args, NCtx, Options),
  387        write(Out, ')')
  388    ).
  389
  390
  391pp_list_elements(_, Ctx, Options) :-
  392    context(Ctx, max_depth, 0),
  393    !,
  394    option(output(Out), Options),
  395    write(Out, '...').
  396pp_list_elements([H|T], Ctx0, Options) :-
  397    dec_depth(Ctx0, Ctx),
  398    pp(H, Ctx, Options),
  399    (   T == []
  400    ->  true
  401    ;   nonvar(T),
  402        T = [_|_]
  403    ->  option(output(Out), Options),
  404        write(Out, ','),
  405        context(Ctx, indent, Indent),
  406        indent(Out, Indent, Options),
  407        pp_list_elements(T, Ctx, Options)
  408    ;   option(output(Out), Options),
  409        context(Ctx, indent, Indent),
  410        indent(Out, Indent-2, Options),
  411        write(Out, '| '),
  412        pp(T, Ctx, Options)
  413    ).
  414
  415
  416pp_compound_args([H|T], Ctx, Options) :-
  417    pp(H, Ctx, Options),
  418    (   T == []
  419    ->  true
  420    ;   T = [_|_]
  421    ->  option(output(Out), Options),
  422        write(Out, ','),
  423        context(Ctx, indent, Indent),
  424        indent(Out, Indent, Options),
  425        pp_compound_args(T, Ctx, Options)
  426    ;   option(output(Out), Options),
  427        context(Ctx, indent, Indent),
  428        indent(Out, Indent-2, Options),
  429        write(Out, '| '),
  430        pp(T, Ctx, Options)
  431    ).
  432
  433
  434:- if(current_predicate(is_dict/1)).  435pp_dict_args([Name-Value|T], Ctx, Options) :-
  436    option(output(Out), Options),
  437    line_position(Out, Pos0),
  438    pp(Name, Ctx, Options),
  439    write(Out, ':'),
  440    line_position(Out, Pos1),
  441    context(Ctx, indent, Indent),
  442    Indent2 is Indent + Pos1-Pos0,
  443    modify_context(Ctx, [indent=Indent2], Ctx2),
  444    pp(Value, Ctx2, Options),
  445    (   T == []
  446    ->  true
  447    ;   option(output(Out), Options),
  448        write(Out, ','),
  449        indent(Out, Indent, Options),
  450        pp_dict_args(T, Ctx, Options)
  451    ).
  452:- endif.  453
  454%       match_op(+Type, +Arity, +Precedence, -LeftPrec, -RightPrec
  455
  456match_op(fx,    1, prefix,  P, _, R) :- R is P - 1.
  457match_op(fy,    1, prefix,  P, _, P).
  458match_op(xf,    1, postfix, P, _, L) :- L is P - 1.
  459match_op(yf,    1, postfix, P, P, _).
  460match_op(xfx,   2, infix,   P, A, A) :- A is P - 1.
  461match_op(xfy,   2, infix,   P, L, P) :- L is P - 1.
  462match_op(yfx,   2, infix,   P, P, R) :- R is P - 1.

 indent(+Out, +Indent, +Options)

Newline and indent to the indicated column. Respects the option tab_width. Default is 8. If the tab-width equals zero, indentation is emitted using spaces.

  471indent(Out, Indent, Options) :-
  472    option(tab_width(TW), Options, 8),
  473    nl(Out),
  474    (   TW =:= 0
  475    ->  tab(Out, Indent)
  476    ;   Tabs is Indent // TW,
  477        Spaces is Indent mod TW,
  478        forall(between(1, Tabs, _), put(Out, 9)),
  479        tab(Out, Spaces)
  480    ).

 print_width(+Term, -W, +Options) is det

Width required when printing `normally' left-to-right.

  486print_width(Term, W, Options) :-
  487    option(right_margin(RM), Options),
  488    (   write_length(Term, W, [max_length(RM)|Options])
  489    ->  true
  490    ;   W = RM
  491    ).

 pprint(+Term, +Context, +Options)

The bottom-line print-routine.

  497pprint(Term, Ctx, Options) :-
  498    option(output(Out), Options),
  499    pprint(Out, Term, Ctx, Options).
  500
  501pprint(Out, Term, Ctx, Options) :-
  502    option(write_options(WriteOptions), Options),
  503    context(Ctx, max_depth, MaxDepth),
  504    (   MaxDepth == infinite
  505    ->  write_term(Out, Term, WriteOptions)
  506    ;   MaxDepth =< 0
  507    ->  format(Out, '...', [])
  508    ;   write_term(Out, Term, [max_depth(MaxDepth)|WriteOptions])
  509    )