[m-rev.] For review: user-configurable pretty printer
Ralph Becket
rafe at csse.unimelb.edu.au
Tue Jun 5 17:20:34 AEST 2007
I'm putting this up for review before integrating it into the pprint
module (if that's the right thing to do).
The pp module below is a replacement pretty-printer with support for
the following:
- user controllable pretty-printing via mutables;
- limits on the maximum number of lines output;
- limits on how much output is generated ("number of functors" and
"triangular number of functors").
It improves on pprint in two ways:
- doc construction and formatting is linear in the number of functors
output, rather than the size of the input. This should be
noticably faster than pprint for large terms.
- It does a much better job of line-breaking (pprint would regularly
erroneously overrun lines).
- It's much shorter.
I'd appreciate swift feedback on this one because I want to start using
it to improve the G12 output.
New files: pp.m, test_pp.m, test_pp.exp.
::: New file pp.m :::
%-----------------------------------------------------------------------------%
% pp.m
% Ralph Becket <rafe at csse.unimelb.edu.au>
% Fri Jun 1 14:49:30 EST 2007
% vim: ft=mercury ts=4 sw=4 et wm=0 tw=0
%
% Generic pretty-printing support.
%
%-----------------------------------------------------------------------------%
:- module pp.
:- interface.
:- import_module io.
:- import_module list.
:- import_module ops.
:- import_module string.
:- import_module univ.
:- type doc
---> s(string) % Output a literal string.
; nl % Output a newline if the enclosing
% group does not fit on the current
% line.
; open_group % Open a new group (groups control
% how nls are handled).
; close_group % Close a group.
; indent % Increase indent level.
; outdent % Decrease indent level.
; docs(docs) % A sequence of docs.
; pp(univ) % Use a specialised pretty printer
% if available, otherwise use the
% generic pretty printer.
; pp_list(list(univ), docs) % Pretty print a list of items
% using the given docs as a
% separator between items. Each
% item - separator pair is placed
% inside its own group.
; pp_term(string, list(univ)) % Pretty print a term with zero or
% more arguments. If the term
% corresponds to a Mercury operator
% it will be printed with appropriate
% fixity and, if necessary, in
% parentheses. The term name will be
% quoted and escaped if necessary.
; set_op_priority(ops.priority)
% Set the current priority for printing
% operator terms with the correct
% parenthesisation.
; set_limit(limit). % Set the truncation limit. This
% should not be necessary for user
% defined pretty printers!
:- type docs == list(doc).
% The pretty-printer limit type, used to truncate conversion to docs
% after the limit has been reached. The linear version simply emits
% the first N functors before truncating. The triangular version
% allocates N - 1 "units" to printing the first argument of the current
% term, N - 2 "units" to printing the second argument of the current
% term, and so forth. [The term "functor" is not quite correct here:
% strictly speaking one "unit" is consumed every time a user defined
% pretty printer or the generic term printer is used.] Truncation is
% indicated by "..." in the output.
%
:- type limit
---> linear(int) % Print this many functors.
; triangular(int). % Print first arg with limit n-1,
% second arg with limit n-2, ...
% The type and inst of pretty-printer converters.
%
:- type pp == ( pred(univ, docs) ).
:- inst pp == ( pred(in, out) is semidet ).
:- type pps == list(pp).
:- inst pps == list(pp).
% format_docs(PPs, LineWidth, MaxLines, Limit, Docs, !IO).
% Output Docs to fit on lines of LineWidth chars, truncating after
% MaxLines lines, fomatting pp(_) docs using pretty-printer converters
% PPs starting with pretty-printer limits Limit.
%
:- pred format_docs(pps::in(pps), int::in, int::in, limit::in, docs::in,
io::di, io::uo) is det.
% Add a user-defined pretty-printer to the list used by format_docs/6
% and format_docs/3.
%
:- pred add_user_defined_pp(pp::in(pp), io::di, io::uo) is det.
% Set the default line width (78), max lines (100), and limit
% (triangular(100)) used by format_docs/3.
%
:- pred set_line_width(int::in, io::di, io::uo) is det.
:- pred set_max_lines(int::in, io::di, io::uo) is det.
:- pred set_limit(limit::in, io::di, io::uo) is det.
% format_docs(LineWidth, MaxLines, Limit, Docs, !IO).
% As format_docs/7, except the user-defined pretty printers are
% those specified via add_user_defined_pp/3.
%
:- pred format_docs(int::in, int::in, limit::in, docs::in,
io::di, io::uo) is det.
% format_docs(Docs, !IO).
% As format_docs/6, except the line width, max lines, and limit are
% those those specified via set_line_width/3,
% set_max_lines/3, and set_limit/3.
%
:- pred format_docs(docs::in, io::di, io::uo) is det.
%-----------------------------------------------------------------------------%
%-----------------------------------------------------------------------------%
:- implementation.
:- import_module bool.
:- import_module deconstruct.
:- import_module exception.
:- import_module int.
:- import_module term_io.
:- mutable(user_defined_pps, pps, [], pps,
[attach_to_io_state, untrailed]).
:- mutable(default_line_width, int, 78, ground,
[attach_to_io_state, untrailed]).
:- mutable(default_max_lines, int, 100, ground,
[attach_to_io_state, untrailed]).
:- mutable(default_limit, limit, triangular(100), ground,
[attach_to_io_state, untrailed]).
%-----------------------------------------------------------------------------%
add_user_defined_pp(PP, !IO) :-
get_user_defined_pps(PPs, !IO),
set_user_defined_pps([PP | PPs], !IO).
%-----------------------------------------------------------------------------%
set_line_width(LineWidth, !IO) :-
set_default_line_width(LineWidth, !IO).
%-----------------------------------------------------------------------------%
set_max_lines(MaxLines, !IO) :-
set_default_max_lines(MaxLines, !IO).
%-----------------------------------------------------------------------------%
set_limit(Limit, !IO) :-
set_default_limit(Limit, !IO).
%-----------------------------------------------------------------------------%
format_docs(PPs, LineWidth, MaxLines, Limit, Docs, !IO) :-
Pri = ops.max_priority(ops.init_mercury_op_table),
RemainingWidth = LineWidth,
IndentLevel = 0,
format_docs(PPs, LineWidth, Docs, RemainingWidth, _, IndentLevel, _,
MaxLines, _, Limit, _, Pri, _, !IO).
%-----------------------------------------------------------------------------%
format_docs(LineWidth, MaxLines, Limit, Docs, !IO) :-
get_user_defined_pps(PPs, !IO),
format_docs(PPs, LineWidth, MaxLines, Limit, Docs, !IO).
%-----------------------------------------------------------------------------%
format_docs(Docs, !IO) :-
get_user_defined_pps(PPs, !IO),
get_default_line_width(LineWidth, !IO),
get_default_max_lines(MaxLines, !IO),
get_default_limit(Limit, !IO),
format_docs(PPs, LineWidth, MaxLines, Limit, Docs, !IO).
%-----------------------------------------------------------------------------%
% format_docs(PPs, LineWidth, Docs, !RemainingWidth, !IndentLevel,
% !RemainingLines, !Limit, !Pri, !IO)
% Format Docs to fit on LineWidth chars per line,
% - tracking !RemainingWidth chars left on the current line,
% - indenting by !IndentLevel after newlines,
% - truncating output after !RemainingLines,
% - expanding terms to at most !Limit depth before truncating,
% - tracking current operator priority !Pri.
% Assumes that Docs is the output of expand.
%
:- pred format_docs(pps::in(pps), int::in, docs::in,
int::in, int::out, int::in, int::out, int::in, int::out,
limit::in, limit::out, ops.priority::in, ops.priority::out,
io::di, io::uo) is det.
format_docs(_PPs, _LineWidth, [],
!RemainingWidth, !IndentLevel, !RemainingLines, !Limit, !Pri, !IO).
format_docs(PPs, LineWidth, [Doc | Docs0],
!RemainingWidth, !IndentLevel, !RemainingLines, !Limit, !Pri, !IO) :-
( if !.RemainingLines =< 0 then
io.write_string("...", !IO)
else
(
% Output strings directly.
%
Doc = s(String),
io.write_string(String, !IO),
!:RemainingWidth = !.RemainingWidth - string.length(String),
Docs = Docs0
;
% Output soft newlines if what follows up to the next newline
% fits on the rest of the current line. Don't bother outputting
% a newline if we're already at the start of a new line.
%
Doc = nl,
( if
not at_start_of_line(LineWidth, !.IndentLevel,
!.RemainingWidth)
then
format_nl(LineWidth, !.IndentLevel, !:RemainingWidth,
!RemainingLines, !IO)
else
true
),
Docs = Docs0
;
% Indents.
%
Doc = indent,
!:IndentLevel = !.IndentLevel + 1,
Docs = Docs0
;
% Outdents.
%
Doc = outdent,
!:IndentLevel = !.IndentLevel - 1,
Docs = Docs0
;
% Open groups: if the current group (and what follows up to the
% next nl) fits on the remainder of the current line then print
% it that way; otherwise we have to recognise the nls in the
% group.
%
Doc = open_group,
OpenGroups = 1,
CurrentRemainingWidth = !.RemainingWidth,
expand(PPs, Docs0, Docs1, OpenGroups, !Limit, !Pri,
CurrentRemainingWidth, RemainingWidthAfterGroup),
( if RemainingWidthAfterGroup >= 0 then
output_current_group(OpenGroups, Docs1, Docs,
!RemainingWidth, !IO)
else
Docs = Docs1
)
;
% Close groups.
%
Doc = close_group,
Docs = Docs0
;
Doc = docs(Docs1),
Docs = list.(Docs1 ++ Docs0)
;
Doc = pp(Univ),
expand_pp(PPs, Univ, Docs1, !Limit, !.Pri),
Docs = list.(Docs1 ++ Docs0)
;
Doc = pp_list(Univs, Sep),
expand_pp_list(Univs, Sep, Docs1, !Limit),
Docs = list.(Docs1 ++ Docs0)
;
Doc = pp_term(Name, Univs),
expand_pp_term(Name, Univs, Docs1, !Limit, !.Pri),
Docs = list.(Docs1 ++ Docs0)
;
Doc = set_limit(Lim),
!:Limit = Lim,
Docs = Docs0
;
Doc = set_op_priority(NewPri),
!:Pri = NewPri,
Docs = Docs0
),
format_docs(PPs, LineWidth, Docs, !RemainingWidth, !IndentLevel,
!RemainingLines, !Limit, !Pri, !IO)
).
%-----------------------------------------------------------------------------%
:- pred output_current_group(int::in, docs::in, docs::out, int::in, int::out,
io::di, io::uo) is det.
output_current_group(_OpenGroups, [], [], !RemainingWidth, !IO).
output_current_group(OpenGroups, [Doc | Docs0], Docs, !RemainingWidth, !IO) :-
( if Doc = s(String) then
io.write_string(String, !IO),
!:RemainingWidth = !.RemainingWidth - string.length(String),
output_current_group(OpenGroups, Docs0, Docs, !RemainingWidth, !IO)
else if Doc = open_group then
output_current_group(OpenGroups + 1, Docs0, Docs, !RemainingWidth, !IO)
else if Doc = close_group then
( if OpenGroups = 1 then
Docs = Docs0
else
output_current_group(OpenGroups - 1, Docs0, Docs, !RemainingWidth,
!IO)
)
else
output_current_group(OpenGroups, Docs0, Docs, !RemainingWidth, !IO)
).
%-----------------------------------------------------------------------------%
% expand(Docs0, Docs, G, N0, N) expands out any doc(_), pp(_),
% pp_list(_, _), and pp_term(_) constructors in Docs0 into Docs, until
% either Docs0 has been completely expanded or a nl is encountered.
% N is the number of string characters appearing in the expansion,
% Docs, up to this point. G is used to track nested groups.
%
:- pred expand(pps::in(pps), docs::in, docs::out, int::in,
limit::in, limit::out, ops.priority::in, ops.priority::out,
int::in, int::out) is det.
expand(_PPs, [], [], _OpenGroups, !Limit, !Pri, !N).
expand(PPs, [Doc | Docs0], Docs, OpenGroups, !Limit, !Pri, !RemainingWidth) :-
( if
(
OpenGroups = 0, Doc = nl
% We have found the first nl after the close of the current
% open group.
;
!.RemainingWidth < 0
% We have run out of space on this line: the current open
% group will not fit.
)
then
Docs = [Doc | Docs0]
else
(
Doc = s(String),
!:RemainingWidth = !.RemainingWidth - string.length(String),
Docs = [Doc | Docs1],
expand(PPs, Docs0, Docs1, OpenGroups, !Limit, !Pri,
!RemainingWidth)
;
Doc = nl,
( if OpenGroups =< 0 then
Docs = [Doc | Docs0]
else
Docs = [Doc | Docs1],
expand(PPs, Docs0, Docs1, OpenGroups, !Limit, !Pri,
!RemainingWidth)
)
;
Doc = indent,
Docs = [Doc | Docs1],
expand(PPs, Docs0, Docs1, OpenGroups, !Limit, !Pri,
!RemainingWidth)
;
Doc = outdent,
Docs = [Doc | Docs1],
expand(PPs, Docs0, Docs1, OpenGroups, !Limit, !Pri,
!RemainingWidth)
;
Doc = open_group,
Docs = [Doc | Docs1],
OpenGroups1 = OpenGroups + ( if OpenGroups > 0 then 1 else 0 ),
expand(PPs, Docs0, Docs1, OpenGroups1, !Limit, !Pri,
!RemainingWidth)
;
Doc = close_group,
Docs = [Doc | Docs1],
OpenGroups1 = OpenGroups - ( if OpenGroups > 0 then 1 else 0 ),
expand(PPs, Docs0, Docs1, OpenGroups1, !Limit, !Pri,
!RemainingWidth)
;
Doc = docs(Docs1),
expand(PPs, list.(Docs1 ++ Docs0), Docs, OpenGroups, !Limit, !Pri,
!RemainingWidth)
;
Doc = pp(Univ),
expand_pp(PPs, Univ, Docs1, !Limit, !.Pri),
expand(PPs, list.(Docs1 ++ Docs0), Docs, OpenGroups, !Limit, !Pri,
!RemainingWidth)
;
Doc = pp_list(Univs, Sep),
expand_pp_list(Univs, Sep, Docs1, !Limit),
expand(PPs, list.(Docs1 ++ Docs0), Docs, OpenGroups, !Limit, !Pri,
!RemainingWidth)
;
Doc = pp_term(Name, Univs),
expand_pp_term(Name, Univs, Docs1, !Limit, !.Pri),
expand(PPs, list.(Docs1 ++ Docs0), Docs, OpenGroups, !Limit, !Pri,
!RemainingWidth)
;
Doc = set_limit(Lim),
!:Limit = Lim,
expand(PPs, Docs0, Docs, OpenGroups, !Limit, !Pri, !RemainingWidth)
;
Doc = set_op_priority(NewPri),
!:Pri = NewPri,
expand(PPs, Docs0, Docs, OpenGroups, !Limit, !Pri, !RemainingWidth)
)
).
%-----------------------------------------------------------------------------%
% We use two spaces per level of indentation.
:- pred at_start_of_line(int::in, int::in, int::in) is semidet.
at_start_of_line(LineWidth, IndentLevel, RemainingWidth) :-
RemainingWidth = LineWidth - 2 * IndentLevel.
%-----------------------------------------------------------------------------%
% We use two spaces per level of indentation.
:- pred format_nl(int::in, int::in, int::out, int::in, int::out,
io::di, io::uo) is det.
format_nl(LineWidth, IndentLevel, RemainingWidth, !RemainingLines, !IO) :-
io.nl(!IO),
output_indentation(IndentLevel, LineWidth, RemainingWidth, !IO),
!:RemainingLines = !.RemainingLines - 1.
:- pred output_indentation(int::in, int::in, int::out, io::di, io::uo) is det.
output_indentation(IndentLevel, LineWidth, RemainingWidth, !IO) :-
( if IndentLevel =< 0 then
RemainingWidth = LineWidth
else
io.write_string(" ", !IO),
output_indentation(IndentLevel - 1, LineWidth - 2, RemainingWidth, !IO)
).
%-----------------------------------------------------------------------------%
% Expand a univ into a list of docs using the first pretty-printer
% in the given list that succeeds, otherwise use the generic pretty-
% printer. If the pretty-printer limit has been exhausted then only
% "..." is produced.
%
:- pred expand_pp(pps::in(pps), univ::in, docs::out, limit::in, limit::out,
ops.priority::in) is det.
expand_pp(PPs, Univ, Docs, !Limit, CurrentPri) :-
( if limit_overrun(!.Limit) then
Docs = [s("...")]
else if expand_pp_2(PPs, Univ, Docs0) then
decrement_limit(!Limit),
Docs = Docs0
else
deconstruct(univ_value(Univ), canonicalize, Name, _Arity, Args),
expand_pp_term(Name, Args, Docs, !Limit, CurrentPri)
).
:- pred expand_pp_2(pps::in(pps), univ::in, docs::out) is semidet.
expand_pp_2([PP | PPs], Univ, Docs) :-
( if PP(Univ, Docs0) then
Docs = Docs0
else
expand_pp_2(PPs, Univ, Docs)
).
%-----------------------------------------------------------------------------%
:- pred expand_pp_list(list(univ)::in, docs::in, docs::out,
limit::in, limit::out) is det.
expand_pp_list([], _Sep, [], !Limit).
expand_pp_list([Univ | Univs], Sep, Docs, !Limit) :-
( if limit_overrun(!.Limit) then
Docs = [s("...")]
else
(
Univs = [],
Docs = [pp(Univ)]
;
Univs = [_ | _],
Docs = [open_group, pp(Univ), docs(Sep), close_group,
next_arg_limit_doc(!.Limit), pp_list(Univs, Sep)]
)
).
%-----------------------------------------------------------------------------%
:- pred expand_pp_term(string::in, list(univ)::in, docs::out,
limit::in, limit::out, ops.priority::in) is det.
expand_pp_term(Name, Args, Docs, !Limit, CurrentPri) :-
decrement_limit(!Limit),
( if Args = [] then
Docs = [s(term_io.quoted_atom(Name))]
else if limit_overrun(!.Limit) then
Docs = [s("...")]
else if expand_pp_op(Name, Args, CurrentPri, !.Limit, Docs0) then
Docs = Docs0
else
SetArgPri = set_op_priority(ops.arg_priority(ops.init_mercury_op_table)),
Docs = [
open_group, nl,
s(term_io.quoted_atom(Name)), s("("), indent,
SetArgPri, pp_list(Args, [s(", "), nl, SetArgPri]),
s(")"), outdent,
close_group
]
).
%-----------------------------------------------------------------------------%
:- pred expand_pp_op(string::in, list(univ)::in, ops.priority::in, limit::in,
docs::out) is semidet.
expand_pp_op(Op, [Arg], CurrentPri, _Limit, Docs) :-
( if ops.lookup_prefix_op(ops.init_mercury_op_table, Op, OpPri, Assoc) then
( if parens_needed(OpPri, CurrentPri) then
Docs = [
open_group,
s("("),
s(Op),
set_op_priority(adjust_priority(OpPri, Assoc)), pp(Arg),
s(")"),
close_group
]
else
Docs = [
open_group,
s(Op),
set_op_priority(adjust_priority(OpPri, Assoc)), pp(Arg),
close_group
]
)
else
ops.lookup_postfix_op(ops.init_mercury_op_table, Op, OpPri, Assoc),
( if parens_needed(OpPri, CurrentPri) then
Docs = [
open_group,
s("("),
set_op_priority(adjust_priority(OpPri, Assoc)), pp(Arg),
s(Op),
s(")"),
close_group
]
else
Docs = [
open_group,
set_op_priority(adjust_priority(OpPri, Assoc)), pp(Arg),
s(Op),
close_group
]
)
).
expand_pp_op(Op, [ArgA, ArgB], CurrentPri, Limit, Docs) :-
( if ops.lookup_infix_op(ops.init_mercury_op_table, Op, OpPri, AssocA,
AssocB) then
( if parens_needed(OpPri, CurrentPri) then
Docs = [
open_group,
s("("),
set_op_priority(adjust_priority(OpPri, AssocA)), pp(ArgA),
s(" "), s(Op), s(" "),
indent, nl,
next_arg_limit_doc(Limit),
set_op_priority(adjust_priority(OpPri, AssocB)), pp(ArgB),
outdent,
s(")"),
close_group
]
else
Docs = [
open_group,
set_op_priority(adjust_priority(OpPri, AssocA)), pp(ArgA),
s(" "), s(Op), s(" "),
indent, nl,
next_arg_limit_doc(Limit),
set_op_priority(adjust_priority(OpPri, AssocB)), pp(ArgB),
outdent,
close_group
]
)
else
ops.lookup_binary_prefix_op(ops.init_mercury_op_table, Op, OpPri,
AssocA, AssocB),
( if parens_needed(OpPri, CurrentPri) then
Docs = [
open_group,
s("("),
s(Op), s(" "),
set_op_priority(adjust_priority(OpPri, AssocA)), pp(ArgA),
s(" "),
indent, nl,
next_arg_limit_doc(Limit),
set_op_priority(adjust_priority(OpPri, AssocB)), pp(ArgB),
outdent,
s(")"),
close_group
]
else
Docs = [
open_group,
s(Op), s(" "),
set_op_priority(adjust_priority(OpPri, AssocA)), pp(ArgA),
s(" "),
indent, nl,
next_arg_limit_doc(Limit),
set_op_priority(adjust_priority(OpPri, AssocB)), pp(ArgB),
outdent,
close_group
]
)
).
%-----------------------------------------------------------------------------%
:- func next_arg_limit_doc(limit) = doc.
next_arg_limit_doc(linear(_)) = docs([]).
next_arg_limit_doc(triangular(N)) = set_limit(triangular(N - 1)).
%-----------------------------------------------------------------------------%
:- pred parens_needed(ops.priority::in, ops.priority::in) is semidet.
parens_needed(OpPriority, EnclosingPriority) :-
OpPriority > EnclosingPriority.
%-----------------------------------------------------------------------------%
:- func adjust_priority(ops.priority, ops.assoc) = ops.priority.
adjust_priority(Priority, Assoc) = AdjustedPriority :-
ops.adjust_priority_for_assoc(Priority, Assoc, AdjustedPriority).
%-----------------------------------------------------------------------------%
% Succeeds if the pretty-printer state limits have been used up.
%
:- pred limit_overrun(limit::in) is semidet.
limit_overrun(linear(N)) :-
N =< 0.
limit_overrun(triangular(N)) :-
N =< 0.
%-----------------------------------------------------------------------------%
% Reduce the pretty-printer limit by one.
%
:- pred decrement_limit(limit::in, limit::out) is det.
decrement_limit(linear(N), linear(N - 1)).
decrement_limit(triangular(N), triangular(N - 1)).
%-----------------------------------------------------------------------------%
%-----------------------------------------------------------------------------%
::: New file test_pp.m :::
%-----------------------------------------------------------------------------%
% test_pp.m
% Ralph Becket <rafe at csse.unimelb.edu.au>
% Tue Jun 5 16:19:10 EST 2007
% vim: ft=mercury ts=4 sw=4 et wm=0 tw=0
%
%-----------------------------------------------------------------------------%
:- module test_pp.
:- interface.
:- import_module io.
:- pred main(io::di, io::uo) is cc_multi.
%-----------------------------------------------------------------------------%
:- implementation.
:- import_module float.
:- import_module int.
:- import_module list.
:- import_module map.
:- import_module pp.
:- import_module solutions.
:- import_module string.
:- import_module univ.
:- type test_case
---> test_case(
line_width :: int,
max_lines :: int,
pp_limit :: limit,
docs :: docs
).
:- type op_tree
---> x
; - op_tree
; op_tree + op_tree
; op_tree - op_tree
; op_tree * op_tree
; op_tree / op_tree.
main(!IO) :-
unsorted_solutions(test_case, TestCases),
list.foldl(run_test_case, TestCases, !IO).
:- pred run_test_case(test_case::in, io::di, io::uo) is det.
run_test_case(TestCase, !IO) :-
PPs = [pp_int, pp_string, pp_float],
Limit = TestCase ^ pp_limit,
MaxLines = TestCase ^ max_lines,
LineWidth = TestCase ^ line_width,
Docs = TestCase ^ docs,
io.format("\nlimit = %s, max lines = %d, line width = %d",
[s(string.string(Limit)), i(MaxLines), i(LineWidth)], !IO),
Ruler = "\n|" ++ string.duplicate_char(('-'), LineWidth - 2) ++ "|\n",
io.write_string(Ruler, !IO),
pp.format_docs(PPs, LineWidth, MaxLines, Limit, Docs, !IO),
io.write_string(Ruler, !IO).
:- pred pp_float(univ::in, docs::out) is semidet.
pp_float(univ(Float), [s(string.float_to_string(Float))]).
:- pred pp_int(univ::in, docs::out) is semidet.
pp_int(univ(Int), [s(string.int_to_string(Int))]).
:- pred pp_string(univ::in, docs::out) is semidet.
pp_string(univ(String), [s("\""), s(String), s("\"")]).
:- pred test_case(test_case::out) is multi.
test_case(test_case(LineWidth, MaxLines, Limit, Docs)) :-
List = 1..1000,
UnivList = univ(List),
ListUniv = list.map(func(X) = univ(X), List),
MapStr = list.foldl(func(X, M) = M ^ elem(X) := int_to_base_string(X, 2),
List, map.init : map(int, string)),
UnivMapStr = univ(MapStr),
MapFloat = list.foldl(func(X, M) = M ^ elem(X) := float(X),
List, map.init : map(int, float)),
UnivMapFloat = univ(MapFloat),
OpTree = mk_op_tree(200),
UnivOpTree = univ(OpTree),
( Limit = linear(100)
; Limit = linear(10)
; Limit = triangular(100)
; Limit = triangular(10)
),
( MaxLines = 10
; MaxLines = 3
),
( LineWidth = 78
; LineWidth = 38
),
( Docs = [pp(UnivList)]
; Docs = [pp_list(ListUniv, [s(", "), nl])]
; Docs = [pp(UnivMapStr)]
; Docs = [pp(UnivMapFloat)]
; Docs = [pp(UnivOpTree)]
).
:- func mk_op_tree(int) = op_tree.
mk_op_tree(N) =
( if N =< 3 then x
else if N mod 5 = 0 then - mk_op_tree(N - 1)
else if N mod 5 = 1 then mk_op_tree(0 + N/2) + mk_op_tree(0 + N/3)
else if N mod 5 = 2 then mk_op_tree(1 + N/2) - mk_op_tree(1 + N/3)
else if N mod 5 = 3 then mk_op_tree(0 + N/2) * mk_op_tree(2 + N/3)
else mk_op_tree(1 + N/2) / mk_op_tree(0 + N/3)
).
%-----------------------------------------------------------------------------%
%-----------------------------------------------------------------------------%
::: New file test_pp.exp :::
limit = triangular(10), max lines = 3, line width = 38
|------------------------------------|
-(-(-(-(... * ... / ...) /
(... * ... + ...)) /
((x / ... * ... + -...) *
...
|------------------------------------|
limit = triangular(10), max lines = 3, line width = 38
|------------------------------------|
three(256, 256.0, 512, 512.0,
two(128, 128.0, two(64, ...), ...),
two(384, 384.0, ..., ...),
...
|------------------------------------|
limit = triangular(10), max lines = 3, line width = 38
|------------------------------------|
three(256, "100000000", 512,
"1000000000",
two(128, "10000000", two(64, ...),
...
|------------------------------------|
limit = triangular(10), max lines = 3, line width = 38
|------------------------------------|
1, 2, 3, 4, 5, 6, 7, 8, 9, 10, ...
|------------------------------------|
limit = triangular(10), max lines = 3, line width = 38
|------------------------------------|
'[|]'(1,
'[|]'(2,
'[|]'(3,
...
|------------------------------------|
limit = triangular(10), max lines = 3, line width = 78
|----------------------------------------------------------------------------|
-(-(-(-(... * ... / ...) / (... * ... + ...)) /
((x / ... * ... + -...) * ((x + ...) * ...))) /
((x / x * (x / ...) + -(x / ...)) * ((x + x) * (x + ...)) +
...
|----------------------------------------------------------------------------|
limit = triangular(10), max lines = 3, line width = 78
|----------------------------------------------------------------------------|
three(256, 256.0, 512, 512.0, two(128, 128.0, two(64, ...), ...),
two(384, 384.0, ..., ...),
three(640, 640.0, ...))
|----------------------------------------------------------------------------|
limit = triangular(10), max lines = 3, line width = 78
|----------------------------------------------------------------------------|
three(256, "100000000", 512, "1000000000",
two(128, "10000000", two(64, ...), ...),
two(384, "110000000", ..., ...), three(640, "1010000000", ...))
|----------------------------------------------------------------------------|
limit = triangular(10), max lines = 3, line width = 78
|----------------------------------------------------------------------------|
1, 2, 3, 4, 5, 6, 7, 8, 9, 10, ...
|----------------------------------------------------------------------------|
limit = triangular(10), max lines = 3, line width = 78
|----------------------------------------------------------------------------|
'[|]'(1, '[|]'(2, '[|]'(3, '[|]'(4, '[|]'(5, ...)))))
|----------------------------------------------------------------------------|
limit = triangular(10), max lines = 10, line width = 38
|------------------------------------|
-(-(-(-(... * ... / ...) /
(... * ... + ...)) /
((x / ... * ... + -...) *
((x + ...) * ...))) /
((x / x * (x / ...) + -(x / ...)) *
((x + x) * (x + ...)) +
(x / ... - x - -... -
x / ... * ...)))
|------------------------------------|
limit = triangular(10), max lines = 10, line width = 38
|------------------------------------|
three(256, 256.0, 512, 512.0,
two(128, 128.0, two(64, ...), ...),
two(384, 384.0, ..., ...),
three(640, 640.0, ...))
|------------------------------------|
limit = triangular(10), max lines = 10, line width = 38
|------------------------------------|
three(256, "100000000", 512,
"1000000000",
two(128, "10000000", two(64, ...),
...),
two(384, "110000000", ..., ...),
three(640, "1010000000", ...))
|------------------------------------|
limit = triangular(10), max lines = 10, line width = 38
|------------------------------------|
1, 2, 3, 4, 5, 6, 7, 8, 9, 10, ...
|------------------------------------|
limit = triangular(10), max lines = 10, line width = 38
|------------------------------------|
'[|]'(1,
'[|]'(2,
'[|]'(3,
'[|]'(4, '[|]'(5, ...)))))
|------------------------------------|
limit = triangular(10), max lines = 10, line width = 78
|----------------------------------------------------------------------------|
-(-(-(-(... * ... / ...) / (... * ... + ...)) /
((x / ... * ... + -...) * ((x + ...) * ...))) /
((x / x * (x / ...) + -(x / ...)) * ((x + x) * (x + ...)) +
(x / ... - x - -... - x / ... * ...)))
|----------------------------------------------------------------------------|
limit = triangular(10), max lines = 10, line width = 78
|----------------------------------------------------------------------------|
three(256, 256.0, 512, 512.0, two(128, 128.0, two(64, ...), ...),
two(384, 384.0, ..., ...),
three(640, 640.0, ...))
|----------------------------------------------------------------------------|
limit = triangular(10), max lines = 10, line width = 78
|----------------------------------------------------------------------------|
three(256, "100000000", 512, "1000000000",
two(128, "10000000", two(64, ...), ...),
two(384, "110000000", ..., ...), three(640, "1010000000", ...))
|----------------------------------------------------------------------------|
limit = triangular(10), max lines = 10, line width = 78
|----------------------------------------------------------------------------|
1, 2, 3, 4, 5, 6, 7, 8, 9, 10, ...
|----------------------------------------------------------------------------|
limit = triangular(10), max lines = 10, line width = 78
|----------------------------------------------------------------------------|
'[|]'(1, '[|]'(2, '[|]'(3, '[|]'(4, '[|]'(5, ...)))))
|----------------------------------------------------------------------------|
limit = triangular(100), max lines = 3, line width = 38
|------------------------------------|
-(-(-(-((x + x) * (x + x) /
(x / x * (x / x))) /
(x / x * (x / x) + -(x / x))) /
...
|------------------------------------|
limit = triangular(100), max lines = 3, line width = 38
|------------------------------------|
three(256, 256.0, 512, 512.0,
two(128, 128.0,
two(64, 64.0,
...
|------------------------------------|
limit = triangular(100), max lines = 3, line width = 38
|------------------------------------|
three(256, "100000000", 512,
"1000000000",
two(128, "10000000",
...
|------------------------------------|
limit = triangular(100), max lines = 3, line width = 38
|------------------------------------|
1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11,
12, 13, 14, 15, 16, 17, 18, 19, 20,
21, 22, 23, 24, 25, 26, 27, 28, 29,
...
|------------------------------------|
limit = triangular(100), max lines = 3, line width = 38
|------------------------------------|
'[|]'(1,
'[|]'(2,
'[|]'(3,
...
|------------------------------------|
limit = triangular(100), max lines = 3, line width = 78
|----------------------------------------------------------------------------|
-(-(-(-((x + x) * (x + x) / (x / x * (x / x))) /
(x / x * (x / x) + -(x / x))) /
((x / x * (x / x) + -(x / x)) * ((x + x) * (x + x)))) /
...
|----------------------------------------------------------------------------|
limit = triangular(100), max lines = 3, line width = 78
|----------------------------------------------------------------------------|
three(256, 256.0, 512, 512.0,
two(128, 128.0,
two(64, 64.0,
...
|----------------------------------------------------------------------------|
limit = triangular(100), max lines = 3, line width = 78
|----------------------------------------------------------------------------|
three(256, "100000000", 512, "1000000000",
two(128, "10000000",
two(64, "1000000",
...
|----------------------------------------------------------------------------|
limit = triangular(100), max lines = 3, line width = 78
|----------------------------------------------------------------------------|
1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 15, 16, 17, 18, 19, 20, 21,
22, 23, 24, 25, 26, 27, 28, 29, 30, 31, 32, 33, 34, 35, 36, 37, 38, 39, 40,
41, 42, 43, 44, 45, 46, 47, 48, 49, 50, 51, 52, 53, 54, 55, 56, 57, 58, 59,
...
|----------------------------------------------------------------------------|
limit = triangular(100), max lines = 3, line width = 78
|----------------------------------------------------------------------------|
'[|]'(1,
'[|]'(2,
'[|]'(3,
...
|----------------------------------------------------------------------------|
limit = triangular(100), max lines = 10, line width = 38
|------------------------------------|
-(-(-(-((x + x) * (x + x) /
(x / x * (x / x))) /
(x / x * (x / x) + -(x / x))) /
((x / x * (x / x) + -(x / x)) *
((x + x) * (x + x)))) /
((x / x * (x / x) + -(x / x)) *
((x + x) * (x + x)) +
(x / x - x - -(x / x) -
x / x * (x / x))))
|------------------------------------|
limit = triangular(100), max lines = 10, line width = 38
|------------------------------------|
three(256, 256.0, 512, 512.0,
two(128, 128.0,
two(64, 64.0,
two(32, 32.0,
two(16, 16.0,
two(8, 8.0,
two(4, 4.0,
two(2, 2.0,
two(1, 1.0, empty,
empty),
...
|------------------------------------|
limit = triangular(100), max lines = 10, line width = 38
|------------------------------------|
three(256, "100000000", 512,
"1000000000",
two(128, "10000000",
two(64, "1000000",
two(32, "100000",
two(16, "10000",
two(8, "1000",
two(4, "100",
two(2, "10",
two(1, "1", empty,
...
|------------------------------------|
limit = triangular(100), max lines = 10, line width = 38
|------------------------------------|
1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11,
12, 13, 14, 15, 16, 17, 18, 19, 20,
21, 22, 23, 24, 25, 26, 27, 28, 29,
30, 31, 32, 33, 34, 35, 36, 37, 38,
39, 40, 41, 42, 43, 44, 45, 46, 47,
48, 49, 50, 51, 52, 53, 54, 55, 56,
57, 58, 59, 60, 61, 62, 63, 64, 65,
66, 67, 68, 69, 70, 71, 72, 73, 74,
75, 76, 77, 78, 79, 80, 81, 82, 83,
84, 85, 86, 87, 88, 89, 90, 91, 92,
...
|------------------------------------|
limit = triangular(100), max lines = 10, line width = 38
|------------------------------------|
'[|]'(1,
'[|]'(2,
'[|]'(3,
'[|]'(4,
'[|]'(5,
'[|]'(6,
'[|]'(7,
'[|]'(8,
'[|]'(9,
'[|]'(10,
...
|------------------------------------|
limit = triangular(100), max lines = 10, line width = 78
|----------------------------------------------------------------------------|
-(-(-(-((x + x) * (x + x) / (x / x * (x / x))) /
(x / x * (x / x) + -(x / x))) /
((x / x * (x / x) + -(x / x)) * ((x + x) * (x + x)))) /
((x / x * (x / x) + -(x / x)) * ((x + x) * (x + x)) +
(x / x - x - -(x / x) - x / x * (x / x))))
|----------------------------------------------------------------------------|
limit = triangular(100), max lines = 10, line width = 78
|----------------------------------------------------------------------------|
three(256, 256.0, 512, 512.0,
two(128, 128.0,
two(64, 64.0,
two(32, 32.0,
two(16, 16.0,
two(8, 8.0,
two(4, 4.0,
two(2, 2.0, two(1, 1.0, empty, empty),
two(3, 3.0, empty, empty)),
two(6, 6.0, two(5, 5.0, empty, empty),
...
|----------------------------------------------------------------------------|
limit = triangular(100), max lines = 10, line width = 78
|----------------------------------------------------------------------------|
three(256, "100000000", 512, "1000000000",
two(128, "10000000",
two(64, "1000000",
two(32, "100000",
two(16, "10000",
two(8, "1000",
two(4, "100",
two(2, "10", two(1, "1", empty, empty),
two(3, "11", empty, empty)),
two(6, "110", two(5, "101", empty, empty),
...
|----------------------------------------------------------------------------|
limit = triangular(100), max lines = 10, line width = 78
|----------------------------------------------------------------------------|
1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 15, 16, 17, 18, 19, 20, 21,
22, 23, 24, 25, 26, 27, 28, 29, 30, 31, 32, 33, 34, 35, 36, 37, 38, 39, 40,
41, 42, 43, 44, 45, 46, 47, 48, 49, 50, 51, 52, 53, 54, 55, 56, 57, 58, 59,
60, 61, 62, 63, 64, 65, 66, 67, 68, 69, 70, 71, 72, 73, 74, 75, 76, 77, 78,
79, 80, 81, 82, 83, 84, 85, 86, 87, 88, 89, 90, 91, 92, 93, 94, 95, 96, 97,
98, 99, 100, ...
|----------------------------------------------------------------------------|
limit = triangular(100), max lines = 10, line width = 78
|----------------------------------------------------------------------------|
'[|]'(1,
'[|]'(2,
'[|]'(3,
'[|]'(4,
'[|]'(5,
'[|]'(6,
'[|]'(7,
'[|]'(8,
'[|]'(9,
'[|]'(10,
...
|----------------------------------------------------------------------------|
limit = linear(10), max lines = 3, line width = 38
|------------------------------------|
-(-(-(-(... * ... / ...) / ...) /
...) /
...)
|------------------------------------|
limit = linear(10), max lines = 3, line width = 38
|------------------------------------|
three(256, 256.0, 512, 512.0,
two(128, 128.0, two(64, ...), ...),
...)
|------------------------------------|
limit = linear(10), max lines = 3, line width = 38
|------------------------------------|
three(256, "100000000", 512,
"1000000000",
two(128, "10000000", two(64, ...),
...
|------------------------------------|
limit = linear(10), max lines = 3, line width = 38
|------------------------------------|
1, 2, 3, 4, 5, 6, 7, 8, 9, 10, ...
|------------------------------------|
limit = linear(10), max lines = 3, line width = 38
|------------------------------------|
'[|]'(1,
'[|]'(2,
'[|]'(3,
...
|------------------------------------|
limit = linear(10), max lines = 3, line width = 78
|----------------------------------------------------------------------------|
-(-(-(-(... * ... / ...) / ...) / ...) / ...)
|----------------------------------------------------------------------------|
limit = linear(10), max lines = 3, line width = 78
|----------------------------------------------------------------------------|
three(256, 256.0, 512, 512.0, two(128, 128.0, two(64, ...), ...), ...)
|----------------------------------------------------------------------------|
limit = linear(10), max lines = 3, line width = 78
|----------------------------------------------------------------------------|
three(256, "100000000", 512, "1000000000",
two(128, "10000000", two(64, ...), ...),
...)
|----------------------------------------------------------------------------|
limit = linear(10), max lines = 3, line width = 78
|----------------------------------------------------------------------------|
1, 2, 3, 4, 5, 6, 7, 8, 9, 10, ...
|----------------------------------------------------------------------------|
limit = linear(10), max lines = 3, line width = 78
|----------------------------------------------------------------------------|
'[|]'(1, '[|]'(2, '[|]'(3, '[|]'(4, '[|]'(5, ...)))))
|----------------------------------------------------------------------------|
limit = linear(10), max lines = 10, line width = 38
|------------------------------------|
-(-(-(-(... * ... / ...) / ...) /
...) /
...)
|------------------------------------|
limit = linear(10), max lines = 10, line width = 38
|------------------------------------|
three(256, 256.0, 512, 512.0,
two(128, 128.0, two(64, ...), ...),
...)
|------------------------------------|
limit = linear(10), max lines = 10, line width = 38
|------------------------------------|
three(256, "100000000", 512,
"1000000000",
two(128, "10000000", two(64, ...),
...),
...)
|------------------------------------|
limit = linear(10), max lines = 10, line width = 38
|------------------------------------|
1, 2, 3, 4, 5, 6, 7, 8, 9, 10, ...
|------------------------------------|
limit = linear(10), max lines = 10, line width = 38
|------------------------------------|
'[|]'(1,
'[|]'(2,
'[|]'(3,
'[|]'(4, '[|]'(5, ...)))))
|------------------------------------|
limit = linear(10), max lines = 10, line width = 78
|----------------------------------------------------------------------------|
-(-(-(-(... * ... / ...) / ...) / ...) / ...)
|----------------------------------------------------------------------------|
limit = linear(10), max lines = 10, line width = 78
|----------------------------------------------------------------------------|
three(256, 256.0, 512, 512.0, two(128, 128.0, two(64, ...), ...), ...)
|----------------------------------------------------------------------------|
limit = linear(10), max lines = 10, line width = 78
|----------------------------------------------------------------------------|
three(256, "100000000", 512, "1000000000",
two(128, "10000000", two(64, ...), ...),
...)
|----------------------------------------------------------------------------|
limit = linear(10), max lines = 10, line width = 78
|----------------------------------------------------------------------------|
1, 2, 3, 4, 5, 6, 7, 8, 9, 10, ...
|----------------------------------------------------------------------------|
limit = linear(10), max lines = 10, line width = 78
|----------------------------------------------------------------------------|
'[|]'(1, '[|]'(2, '[|]'(3, '[|]'(4, '[|]'(5, ...)))))
|----------------------------------------------------------------------------|
limit = linear(100), max lines = 3, line width = 38
|------------------------------------|
-(-(-(-((x + x) * (x + x) /
(x / x * (x / x))) /
(x / x * (x / x) + -(x / x))) /
...
|------------------------------------|
limit = linear(100), max lines = 3, line width = 38
|------------------------------------|
three(256, 256.0, 512, 512.0,
two(128, 128.0,
two(64, 64.0,
...
|------------------------------------|
limit = linear(100), max lines = 3, line width = 38
|------------------------------------|
three(256, "100000000", 512,
"1000000000",
two(128, "10000000",
...
|------------------------------------|
limit = linear(100), max lines = 3, line width = 38
|------------------------------------|
1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11,
12, 13, 14, 15, 16, 17, 18, 19, 20,
21, 22, 23, 24, 25, 26, 27, 28, 29,
...
|------------------------------------|
limit = linear(100), max lines = 3, line width = 38
|------------------------------------|
'[|]'(1,
'[|]'(2,
'[|]'(3,
...
|------------------------------------|
limit = linear(100), max lines = 3, line width = 78
|----------------------------------------------------------------------------|
-(-(-(-((x + x) * (x + x) / (x / x * (x / x))) /
(x / x * (x / x) + -(x / x))) /
((x / x * (x / x) + -(x / x)) * ((x + x) * (x + x)))) /
...
|----------------------------------------------------------------------------|
limit = linear(100), max lines = 3, line width = 78
|----------------------------------------------------------------------------|
three(256, 256.0, 512, 512.0,
two(128, 128.0,
two(64, 64.0,
...
|----------------------------------------------------------------------------|
limit = linear(100), max lines = 3, line width = 78
|----------------------------------------------------------------------------|
three(256, "100000000", 512, "1000000000",
two(128, "10000000",
two(64, "1000000",
...
|----------------------------------------------------------------------------|
limit = linear(100), max lines = 3, line width = 78
|----------------------------------------------------------------------------|
1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 15, 16, 17, 18, 19, 20, 21,
22, 23, 24, 25, 26, 27, 28, 29, 30, 31, 32, 33, 34, 35, 36, 37, 38, 39, 40,
41, 42, 43, 44, 45, 46, 47, 48, 49, 50, 51, 52, 53, 54, 55, 56, 57, 58, 59,
...
|----------------------------------------------------------------------------|
limit = linear(100), max lines = 3, line width = 78
|----------------------------------------------------------------------------|
'[|]'(1,
'[|]'(2,
'[|]'(3,
...
|----------------------------------------------------------------------------|
limit = linear(100), max lines = 10, line width = 38
|------------------------------------|
-(-(-(-((x + x) * (x + x) /
(x / x * (x / x))) /
(x / x * (x / x) + -(x / x))) /
((x / x * (x / x) + -(x / x)) *
((x + x) * (x + x)))) /
((x / x * (x / x) + -(x / x)) *
((x + x) * (x + x)) +
(x / x - x - -(x / x) -
x / x * (x / x))))
|------------------------------------|
limit = linear(100), max lines = 10, line width = 38
|------------------------------------|
three(256, 256.0, 512, 512.0,
two(128, 128.0,
two(64, 64.0,
two(32, 32.0,
two(16, 16.0,
two(8, 8.0,
two(4, 4.0,
two(2, 2.0,
two(1, 1.0, empty,
empty),
...
|------------------------------------|
limit = linear(100), max lines = 10, line width = 38
|------------------------------------|
three(256, "100000000", 512,
"1000000000",
two(128, "10000000",
two(64, "1000000",
two(32, "100000",
two(16, "10000",
two(8, "1000",
two(4, "100",
two(2, "10",
two(1, "1", empty,
...
|------------------------------------|
limit = linear(100), max lines = 10, line width = 38
|------------------------------------|
1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11,
12, 13, 14, 15, 16, 17, 18, 19, 20,
21, 22, 23, 24, 25, 26, 27, 28, 29,
30, 31, 32, 33, 34, 35, 36, 37, 38,
39, 40, 41, 42, 43, 44, 45, 46, 47,
48, 49, 50, 51, 52, 53, 54, 55, 56,
57, 58, 59, 60, 61, 62, 63, 64, 65,
66, 67, 68, 69, 70, 71, 72, 73, 74,
75, 76, 77, 78, 79, 80, 81, 82, 83,
84, 85, 86, 87, 88, 89, 90, 91, 92,
...
|------------------------------------|
limit = linear(100), max lines = 10, line width = 38
|------------------------------------|
'[|]'(1,
'[|]'(2,
'[|]'(3,
'[|]'(4,
'[|]'(5,
'[|]'(6,
'[|]'(7,
'[|]'(8,
'[|]'(9,
'[|]'(10,
...
|------------------------------------|
limit = linear(100), max lines = 10, line width = 78
|----------------------------------------------------------------------------|
-(-(-(-((x + x) * (x + x) / (x / x * (x / x))) /
(x / x * (x / x) + -(x / x))) /
((x / x * (x / x) + -(x / x)) * ((x + x) * (x + x)))) /
((x / x * (x / x) + -(x / x)) * ((x + x) * (x + x)) +
(x / x - x - -(x / x) - x / x * (x / x))))
|----------------------------------------------------------------------------|
limit = linear(100), max lines = 10, line width = 78
|----------------------------------------------------------------------------|
three(256, 256.0, 512, 512.0,
two(128, 128.0,
two(64, 64.0,
two(32, 32.0,
two(16, 16.0,
two(8, 8.0,
two(4, 4.0,
two(2, 2.0, two(1, 1.0, empty, empty),
two(3, 3.0, empty, empty)),
two(6, 6.0, two(5, 5.0, empty, empty),
...
|----------------------------------------------------------------------------|
limit = linear(100), max lines = 10, line width = 78
|----------------------------------------------------------------------------|
three(256, "100000000", 512, "1000000000",
two(128, "10000000",
two(64, "1000000",
two(32, "100000",
two(16, "10000",
two(8, "1000",
two(4, "100",
two(2, "10", two(1, "1", empty, empty),
two(3, "11", empty, empty)),
two(6, "110", two(5, "101", empty, empty),
...
|----------------------------------------------------------------------------|
limit = linear(100), max lines = 10, line width = 78
|----------------------------------------------------------------------------|
1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 15, 16, 17, 18, 19, 20, 21,
22, 23, 24, 25, 26, 27, 28, 29, 30, 31, 32, 33, 34, 35, 36, 37, 38, 39, 40,
41, 42, 43, 44, 45, 46, 47, 48, 49, 50, 51, 52, 53, 54, 55, 56, 57, 58, 59,
60, 61, 62, 63, 64, 65, 66, 67, 68, 69, 70, 71, 72, 73, 74, 75, 76, 77, 78,
79, 80, 81, 82, 83, 84, 85, 86, 87, 88, 89, 90, 91, 92, 93, 94, 95, 96, 97,
98, 99, 100, ...
|----------------------------------------------------------------------------|
limit = linear(100), max lines = 10, line width = 78
|----------------------------------------------------------------------------|
'[|]'(1,
'[|]'(2,
'[|]'(3,
'[|]'(4,
'[|]'(5,
'[|]'(6,
'[|]'(7,
'[|]'(8,
'[|]'(9,
'[|]'(10,
...
|----------------------------------------------------------------------------|
--------------------------------------------------------------------------
mercury-reviews mailing list
Post messages to: mercury-reviews at csse.unimelb.edu.au
Administrative Queries: owner-mercury-reviews at csse.unimelb.edu.au
Subscriptions: mercury-reviews-request at csse.unimelb.edu.au
--------------------------------------------------------------------------
More information about the reviews
mailing list