Expression Language

expr.hs

{-# LANGUAGE GADTs #-}
module Expr where

data Expr' a where
  Equals'    :: Expr' Int  -> Expr' Int            -> Expr' Bool
  Add'       :: Expr' Int  -> Expr' Int            -> Expr' Int
  If'        :: Expr' Bool -> Expr' a   -> Expr' a -> Expr' a
  IntValue'  :: Int                                -> Expr' Int
  BoolValue' :: Bool                               -> Expr' Bool
  Con'       :: a                                  -> Expr' a
  Lam'       :: (Expr' a -> Expr' b)               -> Expr' (a -> b)
  App'       :: Expr' (a -> b) -> Expr' a          -> Expr' b

eval' :: Expr' a -> a
eval' (Con' a)           = a
eval' (Lam' fExpr)       = \a -> eval' $ fExpr (Con' a)
eval' (App' exprF exprA) = eval' exprF $! eval' exprA
eval' (Equals' e1 e2)    = eval' e1 == eval' e2
eval' (Add' e1 e2)       = eval' e1 + eval' e2
eval' (If' b a1 a2)      = if (eval' b) then eval' a1 else eval' a2
eval' (IntValue' i)      = i
eval' (BoolValue' b)     = b

evenExpr :: Expr' Int -> Expr' Bool
evenExpr (IntValue' i) = BoolValue' (even i)
evenExpr (Con' i)      = BoolValue' (even i)
evenExpr (Add' i1 i2)  = BoolValue' $ even ((eval' i1) + (eval' i2))
evenExpr _             = BoolValue' False

-- >>> eval' $ App' (Lam' evenExpr) (IntValue' 1)
-- False
-- >>> eval' $ App' (Lam' evenExpr) (IntValue' 2)
-- True