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
data Term = 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] ]
where p = 7
teststring w d i = pretty w (prTerm (mkTerm d i))
testshow w d i = putStrLn (teststring w d i)
test w d i = length (teststring w d i)
{-
Pretty> test 60 8 3
11402
(377229 reductions, 640227 cells, 7 garbage collections)
Pretty> test 60 9 3
28253
(901055 reductions, 1519954 cells, 16 garbage collections)
-}
