ExprInterp.hs

--
-- Each interpretation will have a type of the form `Expr a -> F a`.
-- These would be a natural transformations, except that Expr is not quite a functor in this case.
--

{-# LANGUAGE GADTs #-}

module ExprInterp where

data Expr a where
  Lit :: Int -> Expr Int

  Add :: Expr Int -> Expr Int -> Expr Int
  Mul :: Expr Int -> Expr Int -> Expr Int

  Equal :: Expr Int -> Expr Int -> Expr Bool

  Not :: Expr Bool -> Expr Bool
  And :: Expr Bool -> Expr Bool -> Expr Bool

-- We can also write this type signature as `Expr a -> Id a`, where `Id a = a` is the identity functor.
-- Note that this shows it has the form `Expr a -> F a` (in this case,
-- `F` is `Id`).
interpretNumeric :: Expr a -> a
interpretNumeric (Lit i) = i
interpretNumeric (Add x y) = interpretNumeric x + interpretNumeric y
interpretNumeric (Mul x y) = interpretNumeric x * interpretNumeric y
interpretNumeric (Equal x y) = interpretNumeric x == interpretNumeric y
interpretNumeric (Not x) = not (interpretNumeric x)
interpretNumeric (And x y) = interpretNumeric x && interpretNumeric y

-- This type signature could also be thought of as `Expr a -> (Const String) a`, where `Const a b = a` is the constant functor.
-- Writing it in that way shows that the type still fits the form `Expr a -> F a` for some `F` (in this case, `F = Const String`)
interpretString :: Expr a -> String
interpretString (Lit i) = show i
interpretString (Add x y) = binOp "+" (interpretString x) (interpretString y)
interpretString (Mul x y) = binOp "*" (interpretString x) (interpretString y)
interpretString (Equal x y) = binOp "==" (interpretString x) (interpretString y)
interpretString (Not x) = parens ("!" ++ interpretString x)
interpretString (And x y) = binOp "&&" (interpretString x) (interpretString y)

example1 :: Expr Int
example1 = Add (Mul (Lit 10) (Lit 2))
               (Lit 3)

example2 :: Expr Bool
example2 = Equal example1 (Lit 23)

example3 :: Expr Bool
example3 = Equal (Mul example1 (Lit 5)) (Lit 1)

binOp :: String -> String -> String -> String
binOp op x y = parens (x ++ " " ++ op ++ " " ++ y)

parens :: String -> String
parens x = "(" ++ x ++ ")"