TaPL 3章

gistfile1.hs

data Term = TTrue | TFalse | Zero
          | Succ Term | Pred Term | IsZero Term
          | If Term Term Term
            deriving (Eq, Show)

eval :: Term -> Term
eval (IsZero Zero)   = TTrue
eval (IsZero TTrue)  = TFalse
eval (IsZero TFalse) = TFalse
eval (IsZero t)      = isZero $ eval t
    where
        isZero Zero = TTrue
        isZero _    = TFalse 
eval (If c t f)      = if eval c == TTrue then eval t else eval f
eval (Succ (Pred t)) = eval t
eval (Succ t)        = Succ $ eval t
eval (Pred (Succ t)) = eval t
eval (Pred t)        = Pred $ eval t
eval t               = t

pretty :: Term -> String
pretty TTrue  = "True"
pretty TFalse = "False"
pretty t      = show $ num t

num :: Term -> Integer
num (Succ t) = (num t) + 1
num (Pred t) = (num t) - 1
num Zero     = 0
num _        = error "not evaluated syntax tree"

main = do
    putStrLn $ pretty $ eval $ Succ $ Zero
    putStrLn $ pretty $ eval $
            If (IsZero $ Pred $ Succ $ Zero)
               (Succ $ Succ $ Succ $ Zero)
               (Pred $ Zero)

s/pritty/pretty/