tapl4.hs

data Term
    = TmTrue
    | TmFalse
    | TmIf Term Term Term
    | TmZero
    | TmSucc Term
    | TmPred Term
    | TmIsZero Term
    deriving Show

isNumericVal :: Term -> Bool
isNumericVal TmZero     = True
isNumericVal (TmSucc t) = isNumericVal t
isNumericVal _          = False

isVal :: Term -> Bool
isVal TmTrue  = True
isVal TmFalse = True
isVal t       | isNumericVal t = True
isVal _       = False

eval1 :: Term -> Maybe Term
eval1 (TmIf TmTrue t2 _)      = Just t2
eval1 (TmIf TmFalse _ t3)     = Just t3
eval1 (TmIf t1 t2 t3)         = eval1 t1 >>= \x -> Just (TmIf x t2 t3)
eval1 (TmSucc t1)             = eval1 t1 >>= Just . TmSucc
eval1 (TmPred TmZero)         = Just TmZero
eval1 (TmPred (TmSucc nv1))   | isNumericVal nv1 = Just nv1
eval1 (TmPred t1)             = eval1 t1 >>= Just . TmPred
eval1 (TmIsZero TmZero)       = Just TmTrue
eval1 (TmIsZero (TmSucc nv1)) | isNumericVal nv1 = Just TmFalse
eval1 (TmIsZero t1)           = eval1 t1 >>= Just . TmIsZero
eval1 _                       = Nothing

eval :: Term -> Term
eval t = case eval1 t of
    Just t' -> eval t'
    Nothing -> t