View source with raw 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-2024, University of Amsterdam
    7                              VU University Amsterdam
    8                              CWI, Amsterdam
    9                              SWI-Prolog Solutions b.v.
   10    All rights reserved.
   11
   12    Redistribution and use in source and binary forms, with or without
   13    modification, are permitted provided that the following conditions
   14    are met:
   15
   16    1. Redistributions of source code must retain the above copyright
   17       notice, this list of conditions and the following disclaimer.
   18
   19    2. Redistributions in binary form must reproduce the above copyright
   20       notice, this list of conditions and the following disclaimer in
   21       the documentation and/or other materials provided with the
   22       distribution.
   23
   24    THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
   25    "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
   26    LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS
   27    FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE
   28    COPYRIGHT OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT,
   29    INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING,
   30    BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES;
   31    LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER
   32    CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
   33    LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN
   34    ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
   35    POSSIBILITY OF SUCH DAMAGE.
   36*/
   37
   38:- module(prolog_pretty_print,
   39          [ print_term/2        % +Term, +Options
   40          ]).   41:- autoload(library(option),
   42            [merge_options/3, select_option/3, select_option/4,
   43             option/2, option/3]).   44:- autoload(library(error), [must_be/2]).

Pretty Print Prolog terms

This module is a first start of what should become a full-featured pretty printer for Prolog terms with many options and parameters. Eventually, it should replace portray_clause/1 and various other special-purpose predicates.

To be done
- This is just a quicky. We need proper handling of portray/1, avoid printing very long terms multiple times, spacing (around operators), etc.
- Use a record for the option-processing.
- The current approach is far too simple, often resulting in illegal terms. */
   63:- predicate_options(print_term/2, 2,
   64                     [ output(stream),
   65                       right_margin(integer),
   66                       left_margin(integer),
   67                       tab_width(integer),
   68                       indent_arguments(integer),
   69                       auto_indent_arguments(integer),
   70                       operators(boolean),
   71                       write_options(list),
   72                       fullstop(boolean),
   73                       nl(boolean)
   74                     ]).
 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(?Column)
Width of a line. If the output is a tty and tty_size/2 can produce a size the default is the number of columns minus 8. Otherwise the default is 72 characters. If the Column is unbound it is unified with the computed value.
left_margin(+Integer)
Left margin for continuation lines. Default is the current line position or 0 if that is not available.
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. See also auto_indent_arguments(Int)
  • An integer
    Place them vertically aligned, <N> spaces to the right of the beginning of the head.
auto_indent_arguments(+Integer)
Used by indent_arguments(auto) to decide whether to introduce a newline after the `(` or not. If specified and > 0, this provides the default integer for indent_arguments(Int). The "hanging" mode is used if otherwise the indentation increment is twice this value.
operators(+Boolean)
Deprecated. This is the inverse of the write_term/3 option ignore_ops. Default is to respect them. If either operators or the ignore_ops in write_options is specified, both are consistently set. If both are specified, the ignore_ops options in the write_options is respected.
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)
    ]
fullstop(Boolean)
If true (default false), add a full stop (.) to the output.
nl(Boolean)
If true (default false), add a newline to the output.
  133print_term(Term, Options) :-
  134    combine_options(Options, Options1),
  135    \+ \+ print_term_2(Term, Options1).
  136
  137combine_options(Options0, Options) :-
  138    defaults(Defs0),
  139    select_option(write_options(WrtDefs), Defs0, Defs),
  140    select_option(write_options(WrtUser), Options0, Options1, []),
  141    (   option(ignore_ops(_), WrtUser)
  142    ->  WrtUser1 = WrtUser
  143    ;   option(operators(Ops), Options0)
  144    ->  must_be(boolean, Ops),
  145        neg(Ops, IgnoreOps),
  146        WrtUser1 = [ignore_ops(IgnoreOps)|WrtUser]
  147    ;   WrtUser1 = WrtUser
  148    ),
  149    merge_options(WrtUser1, WrtDefs, WrtOpts),
  150    merge_options(Options1, Defs, Options2),
  151    Options3 = [write_options(WrtOpts)|Options2],
  152    default_margin(Options3, Options).
  153
  154neg(true, false).
  155neg(false, true).
  156
  157print_term_2(Term, Options) :-
  158    prepare_term(Term, Template, Cycles, Constraints),
  159    option(write_options(WrtOpts), Options),
  160    option(max_depth(MaxDepth), WrtOpts, infinite),
  161
  162    dict_create(Context, #, [max_depth(MaxDepth)|Options]),
  163    pp(Template, Context, Options),
  164    print_extra(Cycles, Context, 'where', Options),
  165    print_extra(Constraints, Context, 'with constraints', Options),
  166    (   option(fullstop(true), Options)
  167    ->  option(output(Out), Options),
  168        put_char(Out, '.')
  169    ;   true
  170    ),
  171    (   option(nl(true), Options)
  172    ->  option(output(Out2), Options),
  173        nl(Out2)
  174    ;   true
  175    ).
  176
  177print_extra([], _, _, _) :- !.
  178print_extra(List, Context, Comment, Options) :-
  179    option(output(Out), Options),
  180    format(Out, ', % ~w', [Comment]),
  181    context(Context, indent, Indent),
  182    NewIndent is Indent+4,
  183    modify_context(Context, [indent=NewIndent], Context1),
  184    print_extra_2(List, Context1, Options).
  185
  186print_extra_2([H|T], Context, Options) :-
  187    option(output(Out), Options),
  188    context(Context, indent, Indent),
  189    indent(Out, Indent, Options),
  190    pp(H, Context, Options),
  191    (   T == []
  192    ->  true
  193    ;   format(Out, ',', []),
  194        print_extra_2(T, Context, Options)
  195    ).
 prepare_term(+Term, -Template, -Cycles, -Constraints)
Prepare a term, possibly holding cycles and constraints for printing.
  203prepare_term(Term, Template, Cycles, Constraints) :-
  204    term_attvars(Term, []),
  205    !,
  206    Constraints = [],
  207    '$factorize_term'(Term, Template, Factors),
  208    bind_non_cycles(Factors, 1, Cycles),
  209    numbervars(Template+Cycles+Constraints, 0, _,
  210               [singletons(true)]).
  211prepare_term(Term, Template, Cycles, Constraints) :-
  212    copy_term(Term, Copy, Constraints),
  213    '$factorize_term'(Copy, Template, Factors),
  214    bind_non_cycles(Factors, 1, Cycles),
  215    numbervars(Template+Cycles+Constraints, 0, _,
  216               [singletons(true)]).
  217
  218
  219bind_non_cycles([], _, []).
  220bind_non_cycles([V=Term|T], I, L) :-
  221    unify_with_occurs_check(V, Term),
  222    !,
  223    bind_non_cycles(T, I, L).
  224bind_non_cycles([H|T0], I, [H|T]) :-
  225    H = ('$VAR'(Name)=_),
  226    atom_concat('_S', I, Name),
  227    I2 is I + 1,
  228    bind_non_cycles(T0, I2, T).
  229
  230
  231defaults([ output(user_output),
  232           depth(0),
  233           indent_arguments(auto),
  234           auto_indent_arguments(4),
  235           write_options([ quoted(true),
  236                           numbervars(true),
  237                           portray(true),
  238                           attributes(portray)
  239                         ]),
  240           priority(1200)
  241         ]).
  242
  243default_margin(Options0, Options) :-
  244    default_right_margin(Options0, Options1),
  245    default_indent(Options1, Options).
  246
  247default_right_margin(Options0, Options) :-
  248    option(right_margin(Margin), Options0),
  249    !,
  250    (   var(Margin)
  251    ->  tty_right_margin(Options0, Margin)
  252    ;   true
  253    ),
  254    Options = Options0.
  255default_right_margin(Options0, [right_margin(Margin)|Options0]) :-
  256    tty_right_margin(Options0, Margin).
  257
  258tty_right_margin(Options, Margin) :-
  259    option(output(Output), Options),
  260    stream_property(Output, tty(true)),
  261    catch(tty_size(_Rows, Columns), error(_,_), fail),
  262    !,
  263    Margin is Columns - 8.
  264tty_right_margin(_, 72).
  265
  266default_indent(Options0, Options) :-
  267    option(output(Output), Options0),
  268    (   stream_property(Output, position(Pos))
  269    ->  stream_position_data(line_position, Pos, Column)
  270    ;   Column = 0
  271    ),
  272    option(left_margin(LM), Options0, Column),
  273    Options = [indent(LM)|Options0].
  274
  275
  276                 /*******************************
  277                 *             CONTEXT          *
  278                 *******************************/
  279
  280context(Ctx, Name, Value) :-
  281    get_dict(Name, Ctx, Value).
  282
  283modify_context(Ctx0, Mapping, Ctx) :-
  284    Ctx = Ctx0.put(Mapping).
  285
  286dec_depth(Ctx, Ctx) :-
  287    context(Ctx, max_depth, infinite),
  288    !.
  289dec_depth(Ctx0, Ctx) :-
  290    ND is Ctx0.max_depth - 1,
  291    Ctx = Ctx0.put(max_depth, ND).
  292
  293
  294                 /*******************************
  295                 *              PP              *
  296                 *******************************/
  297
  298pp(Primitive, Ctx, Options) :-
  299    (   atomic(Primitive)
  300    ;   var(Primitive)
  301    ;   Primitive = '$VAR'(Var),
  302        (   integer(Var)
  303        ;   atom(Var)
  304        )
  305    ),
  306    !,
  307    pprint(Primitive, Ctx, Options).
  308pp(Portray, _Ctx, Options) :-
  309    option(write_options(WriteOptions), Options),
  310    option(portray(true), WriteOptions),
  311    option(output(Out), Options),
  312    with_output_to(Out, user:portray(Portray)),
  313    !.
  314pp(List, Ctx, Options) :-
  315    List = [_|_],
  316    !,
  317    context(Ctx, indent, Indent),
  318    context(Ctx, depth, Depth),
  319    option(output(Out), Options),
  320    option(indent_arguments(IndentStyle), Options),
  321    (   (   IndentStyle == false
  322        ->  true
  323        ;   IndentStyle == auto,
  324            print_width(List, Width, Options),
  325            option(right_margin(RM), Options),
  326            Indent + Width < RM
  327        )
  328    ->  pprint(List, Ctx, Options)
  329    ;   format(Out, '[ ', []),
  330        Nindent is Indent + 2,
  331        NDepth is Depth + 1,
  332        modify_context(Ctx, [indent=Nindent, depth=NDepth, priority=999], NCtx),
  333        pp_list_elements(List, NCtx, Options),
  334        indent(Out, Indent, Options),
  335        format(Out, ']', [])
  336    ).
  337pp(Dict, Ctx, Options) :-
  338    is_dict(Dict),
  339    !,
  340    dict_pairs(Dict, Tag, Pairs),
  341    option(output(Out), Options),
  342    option(indent_arguments(IndentStyle), Options),
  343    context(Ctx, indent, Indent),
  344    (   IndentStyle == false ; Pairs == []
  345    ->  pprint(Dict, Ctx, Options)
  346    ;   IndentStyle == auto,
  347        print_width(Dict, Width, Options),
  348        option(right_margin(RM), Options),
  349        Indent + Width < RM         % fits on a line, simply write
  350    ->  pprint(Dict, Ctx, Options)
  351    ;   option(write_options(WrtOpts), Options),
  352        compound_indent(Out, '~W{ '-[Tag,WrtOpts], Indent, Nindent, Options),
  353        context(Ctx, depth, Depth),
  354        NDepth is Depth + 1,
  355        modify_context(Ctx, [indent=Nindent, depth=NDepth], NCtx0),
  356        dec_depth(NCtx0, NCtx),
  357        pp_dict_args(Pairs, NCtx, Options),
  358        BraceIndent is Nindent - 2,         % '{ '
  359        indent(Out, BraceIndent, Options),
  360        write(Out, '}')
  361    ).
  362pp(Term, Ctx, Options) :-               % handle operators
  363    compound(Term),
  364    compound_name_arity(Term, Name, Arity),
  365    current_op(Prec, Type, Name),
  366    match_op(Type, Arity, Kind, Prec, Left, Right),
  367    option(write_options(WrtOptions), Options, []),
  368    option(ignore_ops(false), WrtOptions, false),
  369    !,
  370    quoted_op(Name, QName),
  371    option(output(Out), Options),
  372    context(Ctx, indent, Indent),
  373    context(Ctx, depth, Depth),
  374    context(Ctx, priority, CPrec),
  375    NDepth is Depth + 1,
  376    modify_context(Ctx, [depth=NDepth], Ctx1),
  377    dec_depth(Ctx1, Ctx2),
  378    LeftOptions  = Ctx2.put(priority, Left),
  379    FuncOptions  = Ctx2.put(embrace, never),
  380    RightOptions = Ctx2.put(priority, Right),
  381    (   Kind == prefix
  382    ->  arg(1, Term, Arg),
  383        (   (   space_op(Name)
  384            ;   need_space(Name, Arg, FuncOptions, RightOptions)
  385            )
  386        ->  Space = ' '
  387        ;   Space = ''
  388        ),
  389        (   CPrec >= Prec
  390        ->  format(atom(Buf), '~w~w', [QName, Space]),
  391            atom_length(Buf, AL),
  392            NIndent is Indent + AL,
  393            write(Out, Buf),
  394            modify_context(Ctx2, [indent=NIndent, priority=Right], Ctx3),
  395            pp(Arg, Ctx3, Options)
  396        ;   format(atom(Buf), '(~w~w', [QName,Space]),
  397            atom_length(Buf, AL),
  398            NIndent is Indent + AL,
  399            write(Out, Buf),
  400            modify_context(Ctx2, [indent=NIndent, priority=Right], Ctx3),
  401            pp(Arg, Ctx3, Options),
  402            format(Out, ')', [])
  403        )
  404    ;   Kind == postfix
  405    ->  arg(1, Term, Arg),
  406        (   (   space_op(Name)
  407            ;   need_space(Name, Arg, FuncOptions, LeftOptions)
  408            )
  409        ->  Space = ' '
  410        ;   Space = ''
  411        ),
  412        (   CPrec >= Prec
  413        ->  modify_context(Ctx2, [priority=Left], Ctx3),
  414            pp(Arg, Ctx3, Options),
  415            format(Out, '~w~w', [Space,QName])
  416        ;   format(Out, '(', []),
  417            NIndent is Indent + 1,
  418            modify_context(Ctx2, [indent=NIndent, priority=Left], Ctx3),
  419            pp(Arg, Ctx3, Options),
  420            format(Out, '~w~w)', [Space,QName])
  421        )
  422    ;   arg(1, Term, Arg1),             % Infix operators
  423        arg(2, Term, Arg2),
  424        (   print_width(Term, Width, Options),
  425            option(right_margin(RM), Options),
  426            Indent + Width < RM
  427        ->  ToWide = false,
  428            (   (   space_op(Name)
  429                ;   need_space(Arg1, Name, LeftOptions, FuncOptions)
  430                ;   need_space(Name, Arg2, FuncOptions, RightOptions)
  431                )
  432            ->  Space = ' '
  433            ;   Space = ''
  434            )
  435        ;   ToWide = true,
  436            (   (   is_solo(Name)
  437                ;   space_op(Name)
  438                )
  439            ->  Space = ''
  440            ;   Space = ' '
  441            )
  442        ),
  443        (   CPrec >= Prec
  444        ->  (   ToWide == true,
  445                infix_list(Term, Name, List),
  446                List == [_,_|_]
  447            ->  Pri is min(Left,Right),
  448                modify_context(Ctx2, [space=Space, priority=Pri], Ctx3),
  449                pp_infix_list(List, QName, 2, Ctx3, Options)
  450            ;   modify_context(Ctx2, [priority=Left], Ctx3),
  451                pp(Arg1, Ctx3, Options),
  452                format(Out, '~w~w~w', [Space,QName,Space]),
  453                line_position(Out, NIndent),
  454                modify_context(Ctx2, [priority=Right, indent=NIndent], Ctx4),
  455                pp(Arg2, Ctx4, Options)
  456            )
  457        ;   (   ToWide == true,
  458                infix_list(Term, Name, List),
  459                List = [_,_|_]
  460            ->  Pri is min(Left,Right),
  461                format(Out, '( ', []),
  462                NIndent is Indent + 2,
  463                modify_context(Ctx2,
  464                               [space=Space, indent=NIndent, priority=Pri],
  465                               Ctx3),
  466                pp_infix_list(List, QName, 0, Ctx3, Options),
  467                indent(Out, Indent, Options),
  468                format(Out, ')', [])
  469            ;   format(Out, '(', []),
  470                NIndent is Indent + 1,
  471                modify_context(Ctx2, [indent=NIndent, priority=Left], Ctx3),
  472                pp(Arg1, Ctx3, Options),
  473                format(Out, '~w~w~w', [Space,QName,Space]),
  474                modify_context(Ctx2, [priority=Right], Ctx4),
  475                pp(Arg2, Ctx4, Options),
  476                format(Out, ')', [])
  477            )
  478        )
  479    ).
  480pp(Term, Ctx, Options) :-               % compound
  481    option(output(Out), Options),
  482    option(indent_arguments(IndentStyle), Options),
  483    context(Ctx, indent, Indent),
  484    (   IndentStyle == false
  485    ->  pprint(Term, Ctx, Options)
  486    ;   IndentStyle == auto,
  487        print_width(Term, Width, Options),
  488        option(right_margin(RM), Options),
  489        Indent + Width < RM         % fits on a line, simply write
  490    ->  pprint(Term, Ctx, Options)
  491    ;   compound_name_arguments(Term, Name, Args),
  492        option(write_options(WrtOpts), Options),
  493        compound_indent(Out, '~W('-[Name,WrtOpts], Indent, Nindent, Options),
  494        context(Ctx, depth, Depth),
  495        NDepth is Depth + 1,
  496        modify_context(Ctx,
  497                       [indent=Nindent, depth=NDepth, priority=999],
  498                       NCtx0),
  499        dec_depth(NCtx0, NCtx),
  500        pp_compound_args(Args, NCtx, Options),
  501        write(Out, ')')
  502    ).
  503
  504compound_indent(Out, Format-Args, Indent, Nindent, Options) :-
  505    option(indent_arguments(IndentStyle), Options),
  506    format(string(Buf2), Format, Args),
  507    write(Out, Buf2),
  508    atom_length(Buf2, FunctorIndent),
  509    (   IndentStyle == auto,
  510        option(auto_indent_arguments(IndentArgs), Options),
  511        IndentArgs > 0,
  512        FunctorIndent > IndentArgs*2
  513    ->  true
  514    ;   IndentArgs = IndentStyle
  515    ),
  516    (   integer(IndentArgs)
  517    ->  Nindent is Indent + IndentArgs,
  518        (   FunctorIndent > IndentArgs
  519        ->  indent(Out, Nindent, Options)
  520        ;   true
  521        )
  522    ;   Nindent is Indent + FunctorIndent
  523    ).
  524
  525
  526quoted_op(Op, Atom) :-
  527    is_solo(Op),
  528    !,
  529    Atom = Op.
  530quoted_op(Op, Q) :-
  531    format(atom(Q), '~q', [Op]).
 infix_list(+Term, ?Op, -List) is semidet
True when List is a list of subterms of Term that are the result of the nested infix operator Op. Deals both with xfy and yfx operators.
  539infix_list(Term, Op, List) :-
  540    phrase(infix_list(Term, Op), List).
  541
  542infix_list(Term, Op) -->
  543    { compound(Term),
  544      compound_name_arity(Term, Op, 2)
  545    },
  546    (   {current_op(_Pri, xfy, Op)}
  547    ->  { arg(1, Term, H),
  548          arg(2, Term, Term2)
  549        },
  550        [H],
  551        infix_list(Term2, Op)
  552    ;   {current_op(_Pri, yfx, Op)}
  553    ->  { arg(1, Term, Term2),
  554          arg(2, Term, T)
  555        },
  556        infix_list(Term2, Op),
  557        [T]
  558    ).
  559infix_list(Term, Op) -->
  560    {atom(Op)},                      % we did something before
  561    [Term].
  562
  563pp_infix_list([H|T], QName, IncrIndent, Ctx, Options) =>
  564    pp(H, Ctx, Options),
  565    context(Ctx, space, Space),
  566    (   T == []
  567    ->  true
  568    ;   option(output(Out), Options),
  569        format(Out, '~w~w', [Space,QName]),
  570        context(Ctx, indent, Indent),
  571        NIndent is Indent+IncrIndent,
  572        indent(Out, NIndent, Options),
  573        modify_context(Ctx, [indent=NIndent], Ctx2),
  574        pp_infix_list(T, QName, 0, Ctx2, Options)
  575    ).
 pp_list_elements(+List, +Ctx, +Options) is det
Print the elements of a possibly open list as a vertical list.
  582pp_list_elements(_, Ctx, Options) :-
  583    context(Ctx, max_depth, 0),
  584    !,
  585    option(output(Out), Options),
  586    write(Out, '...').
  587pp_list_elements([H|T], Ctx0, Options) :-
  588    dec_depth(Ctx0, Ctx),
  589    pp(H, Ctx, Options),
  590    (   T == []
  591    ->  true
  592    ;   nonvar(T),
  593        T = [_|_]
  594    ->  option(output(Out), Options),
  595        write(Out, ','),
  596        context(Ctx, indent, Indent),
  597        indent(Out, Indent, Options),
  598        pp_list_elements(T, Ctx, Options)
  599    ;   option(output(Out), Options),
  600        context(Ctx, indent, Indent),
  601        indent(Out, Indent-2, Options),
  602        write(Out, '| '),
  603        pp(T, Ctx, Options)
  604    ).
  605
  606
  607pp_compound_args([], _, _).
  608pp_compound_args([H|T], Ctx, Options) :-
  609    pp(H, Ctx, Options),
  610    (   T == []
  611    ->  true
  612    ;   T = [_|_]
  613    ->  option(output(Out), Options),
  614        write(Out, ','),
  615        context(Ctx, indent, Indent),
  616        indent(Out, Indent, Options),
  617        pp_compound_args(T, Ctx, Options)
  618    ;   option(output(Out), Options),
  619        context(Ctx, indent, Indent),
  620        indent(Out, Indent-2, Options),
  621        write(Out, '| '),
  622        pp(T, Ctx, Options)
  623    ).
  624
  625
  626:- if(current_predicate(is_dict/1)).  627pp_dict_args([Name-Value|T], Ctx, Options) :-
  628    option(output(Out), Options),
  629    line_position(Out, Pos0),
  630    pp(Name, Ctx, Options),
  631    write(Out, ': '),
  632    line_position(Out, Pos1),
  633    context(Ctx, indent, Indent),
  634    Indent2 is Indent + Pos1-Pos0,
  635    modify_context(Ctx, [indent=Indent2], Ctx2),
  636    pp(Value, Ctx2, Options),
  637    (   T == []
  638    ->  true
  639    ;   option(output(Out), Options),
  640        write(Out, ','),
  641        indent(Out, Indent, Options),
  642        pp_dict_args(T, Ctx, Options)
  643    ).
  644:- endif.  645
  646%       match_op(+Type, +Arity, +Precedence, -LeftPrec, -RightPrec
  647
  648match_op(fx,    1, prefix,  P, _, R) :- R is P - 1.
  649match_op(fy,    1, prefix,  P, _, P).
  650match_op(xf,    1, postfix, P, L, _) :- L is P - 1.
  651match_op(yf,    1, postfix, P, P, _).
  652match_op(xfx,   2, infix,   P, A, A) :- A is P - 1.
  653match_op(xfy,   2, infix,   P, L, P) :- L is P - 1.
  654match_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.
  663indent(Out, Indent, Options) :-
  664    option(tab_width(TW), Options, 8),
  665    nl(Out),
  666    (   TW =:= 0
  667    ->  tab(Out, Indent)
  668    ;   Tabs is Indent // TW,
  669        Spaces is Indent mod TW,
  670        forall(between(1, Tabs, _), put(Out, 9)),
  671        tab(Out, Spaces)
  672    ).
 print_width(+Term, -W, +Options) is det
Width required when printing `normally' left-to-right.
  678print_width(Term, W, Options) :-
  679    option(right_margin(RM), Options),
  680    option(write_options(WOpts), Options),
  681    (   catch(write_length(Term, W, [max_length(RM)|WOpts]),
  682              error(_,_), fail)      % silence uncaught exceptions from
  683    ->  true                         % nested portray callbacks
  684    ;   W = RM
  685    ).
 pprint(+Term, +Context, +Options)
The bottom-line print-routine.
  691pprint(Term, Ctx, Options) :-
  692    option(output(Out), Options),
  693    pprint(Out, Term, Ctx, Options).
  694
  695pprint(Out, Term, Ctx, Options) :-
  696    option(write_options(WriteOptions), Options),
  697    context(Ctx, max_depth, MaxDepth),
  698    (   MaxDepth == infinite
  699    ->  write_term(Out, Term, WriteOptions)
  700    ;   MaxDepth =< 0
  701    ->  format(Out, '...', [])
  702    ;   write_term(Out, Term, [max_depth(MaxDepth)|WriteOptions])
  703    ).
  704
  705
  706		 /*******************************
  707		 *    SHARED WITH term_html.pl	*
  708		 *******************************/
 is_op1(+Name, -Type, -Priority, -ArgPriority, +Options) is semidet
True if Name is an operator taking one argument of Type.
  715is_op1(Name, Type, Pri, ArgPri, Options) :-
  716    operator_module(Module, Options),
  717    current_op(Pri, OpType, Module:Name),
  718    argpri(OpType, Type, Pri, ArgPri),
  719    !.
  720
  721argpri(fx, prefix,  Pri0, Pri) :- Pri is Pri0 - 1.
  722argpri(fy, prefix,  Pri,  Pri).
  723argpri(xf, postfix, Pri0, Pri) :- Pri is Pri0 - 1.
  724argpri(yf, postfix, Pri,  Pri).
 is_op2(+Name, -LeftPri, -Pri, -RightPri, +Options) is semidet
True if Name is an operator taking two arguments of Type.
  730is_op2(Name, LeftPri, Pri, RightPri, Options) :-
  731    operator_module(Module, Options),
  732    current_op(Pri, Type, Module:Name),
  733    infix_argpri(Type, LeftPri, Pri, RightPri),
  734    !.
  735
  736infix_argpri(xfx, ArgPri, Pri, ArgPri) :- ArgPri is Pri - 1.
  737infix_argpri(yfx, Pri, Pri, ArgPri) :- ArgPri is Pri - 1.
  738infix_argpri(xfy, ArgPri, Pri, Pri) :- ArgPri is Pri - 1.
 need_space(@Term1, @Term2, +LeftOptions, +RightOptions)
True if a space is needed between Term1 and Term2 if they are printed using the given option lists.
  746need_space(T1, T2, _, _) :-
  747    (   is_solo(T1)
  748    ;   is_solo(T2)
  749    ),
  750    !,
  751    fail.
  752need_space(T1, T2, LeftOptions, RightOptions) :-
  753    end_code_type(T1, TypeR, LeftOptions.put(side, right)),
  754    end_code_type(T2, TypeL, RightOptions.put(side, left)),
  755    \+ no_space(TypeR, TypeL).
  756
  757no_space(punct, _).
  758no_space(_, punct).
  759no_space(quote(R), quote(L)) :-
  760    !,
  761    R \== L.
  762no_space(alnum, symbol).
  763no_space(symbol, alnum).
 end_code_type(+Term, -Code, Options)
True when code is the first/last character code that is emitted by printing Term using Options.
  770end_code_type(_, Type, Options) :-
  771    MaxDepth = Options.max_depth,
  772    integer(MaxDepth),
  773    Options.depth >= MaxDepth,
  774    !,
  775    Type = symbol.
  776end_code_type(Term, Type, Options) :-
  777    primitive(Term, _),
  778    !,
  779    quote_atomic(Term, S, Options),
  780    end_type(S, Type, Options).
  781end_code_type(Dict, Type, Options) :-
  782    is_dict(Dict, Tag),
  783    !,
  784    (   Options.side == left
  785    ->  end_code_type(Tag, Type, Options)
  786    ;   Type = punct
  787    ).
  788end_code_type('$VAR'(Var), Type, Options) :-
  789    Options.get(numbervars) == true,
  790    !,
  791    format(string(S), '~W', ['$VAR'(Var), [numbervars(true)]]),
  792    end_type(S, Type, Options).
  793end_code_type(List, Type, _) :-
  794    (   List == []
  795    ;   List = [_|_]
  796    ),
  797    !,
  798    Type = punct.
  799end_code_type(OpTerm, Type, Options) :-
  800    compound_name_arity(OpTerm, Name, 1),
  801    is_op1(Name, OpType, Pri, ArgPri, Options),
  802    \+ Options.get(ignore_ops) == true,
  803    !,
  804    (   Pri > Options.priority
  805    ->  Type = punct
  806    ;   op_or_arg(OpType, Options.side, OpArg),
  807        (   OpArg == op
  808        ->  end_code_type(Name, Type, Options)
  809        ;   arg(1, OpTerm, Arg),
  810            arg_options(Options, ArgOptions),
  811            end_code_type(Arg, Type, ArgOptions.put(priority, ArgPri))
  812        )
  813    ).
  814end_code_type(OpTerm, Type, Options) :-
  815    compound_name_arity(OpTerm, Name, 2),
  816    is_op2(Name, LeftPri, Pri, _RightPri, Options),
  817    \+ Options.get(ignore_ops) == true,
  818    !,
  819    (   Pri > Options.priority
  820    ->  Type = punct
  821    ;   arg(1, OpTerm, Arg),
  822        arg_options(Options, ArgOptions),
  823        end_code_type(Arg, Type, ArgOptions.put(priority, LeftPri))
  824    ).
  825end_code_type(Compound, Type, Options) :-
  826    compound_name_arity(Compound, Name, _),
  827    end_code_type(Name, Type, Options).
  828
  829op_or_arg(prefix,  left,  op).
  830op_or_arg(prefix,  right, arg).
  831op_or_arg(postfix, left,  arg).
  832op_or_arg(postfix, right, op).
  833
  834
  835
  836end_type(S, Type, Options) :-
  837    number(S),
  838    !,
  839    (   (S < 0 ; S == -0.0),
  840        Options.side == left
  841    ->  Type = symbol
  842    ;   Type = alnum
  843    ).
  844end_type(S, Type, Options) :-
  845    Options.side == left,
  846    !,
  847    left_type(S, Type).
  848end_type(S, Type, _) :-
  849    right_type(S, Type).
  850
  851left_type(S, Type), atom(S) =>
  852    sub_atom(S, 0, 1, _, Start),
  853    syntax_type(Start, Type).
  854left_type(S, Type), string(S) =>
  855    sub_string(S, 0, 1, _, Start),
  856    syntax_type(Start, Type).
  857left_type(S, Type), blob(S, _) =>
  858    syntax_type("<", Type).
  859
  860right_type(S, Type), atom(S) =>
  861    sub_atom(S, _, 1, 0, End),
  862    syntax_type(End, Type).
  863right_type(S, Type), string(S) =>
  864    sub_string(S, _, 1, 0, End),
  865    syntax_type(End, Type).
  866right_type(S, Type), blob(S, _) =>
  867    syntax_type(")", Type).
  868
  869syntax_type("\"", quote(double)) :- !.
  870syntax_type("\'", quote(single)) :- !.
  871syntax_type("\`", quote(back))   :- !.
  872syntax_type(S, Type) :-
  873    string_code(1, S, C),
  874    (   code_type(C, prolog_identifier_continue)
  875    ->  Type = alnum
  876    ;   code_type(C, prolog_symbol)
  877    ->  Type = symbol
  878    ;   code_type(C, space)
  879    ->  Type = layout
  880    ;   Type = punct
  881    ).
  882
  883is_solo(Var) :-
  884    var(Var), !, fail.
  885is_solo(',').
  886is_solo(';').
  887is_solo('!').
 primitive(+Term, -Class) is semidet
True if Term is a primitive term, rendered using the CSS class Class.
  894primitive(Term, Type) :- var(Term),      !, Type = 'pl-avar'.
  895primitive(Term, Type) :- atom(Term),     !, Type = 'pl-atom'.
  896primitive(Term, Type) :- blob(Term,_),   !, Type = 'pl-blob'.
  897primitive(Term, Type) :- string(Term),   !, Type = 'pl-string'.
  898primitive(Term, Type) :- integer(Term),  !, Type = 'pl-int'.
  899primitive(Term, Type) :- rational(Term), !, Type = 'pl-rational'.
  900primitive(Term, Type) :- float(Term),    !, Type = 'pl-float'.
 operator_module(-Module, +Options) is det
Find the module for evaluating operators.
  906operator_module(Module, Options) :-
  907    Module = Options.get(module),
  908    !.
  909operator_module(TypeIn, _) :-
  910    '$current_typein_module'(TypeIn).
 arg_options(+Options, -OptionsOut) is det
Increment depth in Options.
  916arg_options(Options, Options.put(depth, NewDepth)) :-
  917    NewDepth is Options.depth+1.
  918
  919quote_atomic(Float, String, Options) :-
  920    float(Float),
  921    Format = Options.get(float_format),
  922    !,
  923    format(string(String), Format, [Float]).
  924quote_atomic(Plain, Plain, _) :-
  925    number(Plain),
  926    !.
  927quote_atomic(Plain, String, Options) :-
  928    Options.get(quoted) == true,
  929    !,
  930    (   Options.get(embrace) == never
  931    ->  format(string(String), '~q', [Plain])
  932    ;   format(string(String), '~W', [Plain, Options])
  933    ).
  934quote_atomic(Var, String, Options) :-
  935    var(Var),
  936    !,
  937    format(string(String), '~W', [Var, Options]).
  938quote_atomic(Plain, Plain, _).
  939
  940space_op(:-)