Rossberg writes,
thinking about whether the pretty printer proposed by Wadler requires
some changes to be efficient in a strict language, I stumbled over the
the last case defining `flatten':
flatten (x :| y) = flatten x
I wonder why it is necessary here to recurse on x. The only point were a
doc (x:|y) is constructed is in the function `group':
group z = flatten z :| z
So the x above is always flat already. Wouldn't the equation
flatten (x :| y) = x
suffice? Doing recursion here seems to be unnecessary overhead. In
particular, it prevents structure sharing between alternatives when
grouping, because flatten rebuilds the whole doc tree (which might be
more of a problem without laziness).
Am I missing something?
You're not the one who missed something. I didn't spot this
optimization because I had in mind the case where the user might use
| directly. If we disallow this, your tricky optimisation is quite
sensible. As it happens, it doesn't seem to improve time or space by
much, at least for the lazy version. I include modified code below.
It's wonderful to have clever people reading and commenting on
my code. Thanks! -- P
---
Philip Wadler [EMAIL PROTECTED]
Bell Labs, Lucent Technologies http://www.cs.bell-labs.com/~wadler
600 Mountain Ave, room 2T-402 office: +1 908 582 4004
Murray Hill, NJ 07974-0636 fax: +1 908 582 5857
USA home: +1 908 626 9252
---
-- Pretty printer based on grouping
-- as in March 1998 version of `A prettier printer'
-- Philip Wadler, March 1998
-- Modified version based on suggestion of Andreas Rossberg
-- Philip Wadler, May 1998
-- Two optimized lines, marked below, exploit the invariant that
-- the left hand argument of :| must be result of applying flatten.
infixr 5 :|
infixr 6 :
infixr 6
data DOC= NIL
| DOC : DOC
| NEST Int DOC
| TEXT String
| LINE
| DOC :| DOC
data Doc= Nil
| String `Text` Doc
| Int `Line` Doc
nil = NIL
x y = x : y
nest i x = NEST i x
text s = TEXT s
line = LINE
group (x :| y) = x :| y-- *** remove line for unoptimized
group x = flatten x :| x
flatten NIL = NIL
flatten (x : y)= flatten x : flatten y
flatten (NEST i x) = NEST i (flatten x)
flatten (TEXT s) = TEXT s
flatten LINE = TEXT " "
flatten (x :| y) = x -- *** replace by (flatten x) for unoptimized
layout Nil = ""
layout (s `Text` x) = s ++ layout x
layout (i `Line` x) = '\n' : copy i ' ' ++ layout x
copy i x = [ x | _ - [1..i] ]
best w k x = be w k [(0,x)]
be w k []= Nil
be w k ((i,NIL):z) = be w k z
be w k ((i,x : y):z) = be w k ((i,x):(i,y):z)
be w k ((i,NEST j x):z) = be w k ((i+j,x):z)
be w k ((i,TEXT s):z)= s `Text` be w (k+length s) z
be w k ((i,LINE):z) = i `Line` be w i z
be w k ((i,x :| y):z) = better w k (be w k ((i,x):z)) (be w k ((i,y):z))
better w k x y = if fits (w-k) x then x else y
fits w x | w 0 = False
fits w Nil = True
fits w (s `Text` x) = fits (w - length s) x
fits w (i `Line` x) = True
pretty w x = layout (best w 0 x)
-- Utilities
space = text " "
x / y = x line y
x + y = x space y
par x = text "(" x text ")"
stack = foldr1 (/)
strip = foldr1 (+)
-- Testing
dataTerm= Term String [Term]
prTerm (Term n []) = text n
prTerm (Term n ts) = par (group (nest 2 (stack (text n : map prTerm ts
szTerm (Term n ts) = length n + length ts + sum (map szTerm ts)
mkTerm 0 i = Term (mkName i) []
mkTerm (d+1) i = Term (mkName i) (map (mkTerm d) (randoms i))
mkName i= [ 'x' | j - [1..i] ]
randoms i = [ i*j `mod` p | j - [2 .. i `mod` p] ]
