\begin{code}
{-# OPTIONS_GHC -Wall #-}
{-# LANGUAGE KindSignatures #-}
module Mar22 where
— import Control.Applicative
import Text.PrettyPrint (Doc, text, hsep, parens, (<+>))
import qualified Text.PrettyPrint as P
import Mar18
\end{code}
Learning objectives:
\begin{itemize}
\item more instances (pretty printing)
\item traversals
\end{itemize}
\begin{code}
— convention: the |Int| will be a level counter
— and we will call it |ctr|
newtype PP a = PP {unPP :: Int -> Doc }
— ‘b’ for before
liftP1b :: String -> PP a -> PP b
liftP1b s = \x -> PP $ \ctr -> parens $ text s <+> unPP x ctr
— infix
liftP2 :: String -> PP a1 -> PP a2 -> PP a3
liftP2 s = \x y -> PP $ \ctr -> parens $ hsep [ unPP x ctr, text s, unPP y ctr]
instance IntSy PP where
int = \i -> PP $ \_ -> (if (i<0) then parens else id) $ P.integer i
add = liftP2 "+"
sub = liftP2 "-"
mul = liftP2 "*"
instance BoolSy PP where
bool = \b -> PP $ \_ -> text $ show b
and_ = liftP2 “&&”
or_ = liftP2 “||”
if_ = \b tc ec -> PP $ \ctr -> parens $
hsep [text “if”, unPP b ctr,
text “then”, unPP tc ctr,
text “else”, unPP ec ctr]
instance OrderSy PP where
leq = liftP2 “<="
instance FunctionSy PP where
app = liftP2 ""
lam f = PP $ \ctr ->
let v = ctr
var = PP (\_ -> text (“x” ++ show v))
body = unPP (f var) (v + 1)
in text (“\\x”++show ctr) <+> text “->” <+> body
instance PairSy PP where
pair = liftP2 “,”
fst_ = liftP1b “fst”
snd_ = liftP1b “snd”
instance FixSy PP where
fix_ f = PP $ \ctr ->
let v = ctr
var = PP (\_ -> text (“self” ++ show v))
body = unPP (f var) (v + 1)
in text (“fix (\\self”++show ctr) <+> text “->” <+> body <+> text “)”
\end{code}