arith.hs

-- GistID: 5038439
data Term
    = TmTrue
    | TmFalse
    | TmZero
    | TmIf Term Term Term
    | TmSucc Term
    | TmPred Term
    | TmIsZero Term
    | PreviousWasNormalForm
    deriving (Show, Read)

data NormalForm = NormalForm Term deriving (Show, Read)


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



is_val :: Term -> Bool
is_val TmTrue = True
is_val TmFalse = True
is_val t
    | is_numeric_val t = True
    | otherwise = False


-- ///////////// Single step eval

reduce :: Term -> Term
reduce (TmIf TmFalse t f) = f
reduce (TmIf TmTrue t f) = t
reduce (TmIf cond t f) = TmIf (reduce cond) t f
reduce (TmSucc t) = TmSucc (reduce t)
reduce (TmPred TmZero) = TmZero
reduce (TmPred (TmSucc t)) = t
reduce (TmPred t) = TmPred (reduce t)
reduce (TmIsZero TmZero) = TmTrue
reduce (TmIsZero (TmSucc t))
    | is_numeric_val t = TmFalse
reduce (TmIsZero t) = TmIsZero (reduce t)
reduce nf = nf

evalr :: Term -> Term
evalr t
    | is_val t' = t'
    | otherwise = evalr t'
    where t' = reduce t


-- /////////////// Multi-step eval

eval :: Term -> Term
eval (TmIf TmFalse t f) = eval f
eval (TmIf TmTrue t f) = eval t
eval (TmIf cond t f) = eval $ TmIf (eval cond) t f
eval (TmSucc t)
    | is_val t' = t'
    | otherwise = eval $ TmSucc t'
    where t' = eval t

eval (TmPred TmZero) = TmZero
eval (TmPred (TmSucc t)) = eval t
eval (TmPred t)
    | is_val t' = TmPred t'
    | otherwise = eval $ TmPred t'
    where t' = eval t

eval (TmIsZero TmZero) = TmTrue
eval (TmIsZero (TmSucc t))
    | is_numeric_val t = TmFalse
eval (TmIsZero t) = eval $ TmIsZero (eval t)
eval nf = nf


-- //////////////// testing statements

tt = TmPred $ TmSucc $ TmIf (TmIf TmFalse TmFalse TmTrue) TmZero (TmSucc (TmSucc TmZero))
--			    TmTrue
--		       TmZero
--   TmZero

Snyggare formattering!!

data Term
  = TmTrue Info
  | TmFalse Info
  | TmZero Info
  | TmIf Info Term Term Term
  | TmSucc Info Term
  | TmPred Info Term
  | TmIsZero Info Term
  deriving (Show, Read)