--------------8556961D98DF73F92C98D9B2
Content-Type: text/plain; charset="us-ascii"

Tommy Thorn wrote:

> In an attempt to gather experience with Philip Wadlers pretty printing
> combinators, I converted a semi big pretty printer to his pretty
> printing.  My initial experiences are positive: while Phil's
> combinators are clearly less expressive, they were expressive enough
> (at least with the improvements below) and the results was subjectly
> clearer.
>
> For the utility of others which might wish to experiment I include my
> library, apologizing up front from the lack of clean-up,
> documentation, and optimization.
>
> On an unrelated note, I like to add that I consider it a feature, not
> a bug, that combinators build a Doc structure, as this enables a later
> unforseen interpretation of the document.  Such an interpretation
> could be for proportional fonts, colors, etc.
>
> /Tommy

I've also been working with Phil's combinators.  The limitations are easily
overcome by the addition of an operator for setting a new left margin.  The
`tab' operator (which I'll admit is probably not the best name) sets the left
margin to the current position, over the scope of its argument.  We can then
easily express Hughes' horizontal concatenation combinator as
    x <> y  =  x :<> tab y
This I think gives us the best of both Hughes' and Wadler's pretty printers:
simplicity, expressiveness, and efficiency.  Wadler's pretty printer has the
interesting property that layout of the current line does not effect layout of
subsequent lines.  Thus, pretty printing is optimal using the greedy strategy
of chosing the best layout one line at a time.  The addition of `tab' breaks
this.  However, that just puts us on the same footing as Hughes' combinators,
while gaining the expressiveness of Hughes' combinators, and keeping the
additional expressiveness of Wadler's combinators.

In addition, I've added an `indent' operator.  This indents out n spaces from
the current left margin, introducing a newline if necessary (i.e. if the
current position is already past the requested indentation point).  Using
`indent', we can easily express Hughes' `nest':
    nest i x  =  indent i :<> tab x
`indent' makes it easy to layout the following style:
    x      = y
           + z
    verylongidentified
           = q

I'm currently implementing a pretty printer for Haskell using these
combinators.  I've included a current draft of my combinators for your
amusement ;-)

--Jeff

--------------8556961D98DF73F92C98D9B2
Content-Disposition: inline; filename="PrettyGo"
Content-Type: text/plain; charset="us-ascii"; name="PrettyGo"

module Pretty where

infixr 6 :<>

-- the simple concatentation operator
-- chosen not to conflict with Hughes
infixr 6 <:>

-- for emulating Hughes
infixr 6 <>
infixr 6 <+>
-- I like this much better than $$
-- and it doesn't give hugs fits (hugs uses $$ as a top-level macro)
infixr 5 //

data Doc =
      Empty
    | Line
    | Indent Int
    | Text String
    | Nest Int Doc -- not used at present
    | Tab Doc
    | Doc :<> Doc
    | Group Doc
    deriving Show

empty = Empty
line = Line
indent i = Indent i
text s = Text s
tab x = Tab x
x <:> y = x :<> y
group x = Group x

-- `line <:> line', or `line <:> indent i' should flatten
-- to a single space.  In the following, the flag q (`quiet')
-- is used to indicate when additional whitespace should be
-- suppressed

-- layout simple forms
prSimple :: (Doc,Int,Bool) -> Bool -> Int -> (String,Bool,Int)
prSimple (Empty, l, f) q k =            ("", False, k)

prSimple (Line, l, True) True k =       ("", True, k)
prSimple (Line, l, True) False k =      (" ", True, k + 1)
prSimple (Line, l, f) q k =             ('\n' : copy l ' ', False, l)

prSimple (Indent i, l, True) True k =   ("", True, k)
prSimple (Indent i, l, True) False k =  (" ", True, k + 1)
prSimple (Indent i, l, f) q k =
    if k > l + i then
        ('\n' : copy (l + i) ' ', False, l + i)
    else
        (copy (l + i - k) ' ', False, l + i)

prSimple (Text s, l, f) q k =           (s, False, k + length s)

pr :: Int -> Doc -> (String,Bool,Int)
pr w x = prComb (x, 0, False) [] True 0
    where
    -- layout combining forms
    -- the second arg is an accumulator for flattening out compositions
    -- w is in scope here, so this isn't a top-level def
    prComb :: (Doc,Int,Bool) -> [(Doc,Int,Bool)] ->
              Bool -> Int -> ([Char],Bool,Int)
    prComb (Nest i x, l, f) ys q k =
        prComb (x, l + i, f) ys q k
    prComb (Tab x, l, f) ys q k =
        prComb (x, k, f) ys q k
    prComb (x :<> y, l, f) zs q k =
        prComb (x, l, f) ((y, l, f) : zs) q k
    prComb (Group x, l, True) ys q k =
        prComb (x, l, True) ys q k
    prComb (Group x, l, False) ys q k =
        let (s, q', k') = prComb (x, l, True) ys q k in
            --if fits s (w - k) then
            if fits s (w - k) (w - l) 5 then
                (s, q', k')
            else
                prComb (x, l, False) ys q k
    prComb x [] q k = prSimple x q k
    prComb x (y : ys) q k =
        let (s, q', k') = prSimple x q k
            (t, q'', k'') = prComb y ys q' k'
        in
            (s ++ t, q'', k'')

-- fits, with m lines of lookahead
fits xs n w m | n < 0 = False
fits [] n w m = True
fits ('\n':xs) n w 0 = True
fits ('\n':xs) n w m = fits xs w w (m - 1)
fits (x:xs) n w m = fits xs (n - 1) w m

pretty :: Int -> Doc -> String
pretty w x = let (s, _, _) = pr w x in s

-- Hughes

x  <> y = x <:> tab y
x <+> y = x <:> text " " <> y
x  // y = x <:> line <:> y
nest i x = indent i <> x

-- Utils

copy = replicate

par x           =  text "(" <> x <> text ")"
stack           =  foldr1 (//)

-- Phil's Test

data    Term    =  Term String [Term]

prTerm (Term n []) = text n
prTerm (Term n ts) =
    par (group (text n <+> stack (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)

--------------8556961D98DF73F92C98D9B2--


Reply via email to