appx/lst/example_deep.hs

   1 module Deep where
   2
   3 import Prelude hiding (print)
   4
   5 --data Value = I Int | B Bool
   6 --  deriving Show
   7 --data Expr
   8 --    = Lit  Value
   9 --    | Plus Expr Expr
  10 --    | Eq Expr Expr
  11 --  deriving Show
  12 --
  13 --type Env = String -> Expr
  14 --
  15 --initialEnv :: Env
  16 --initialEnv _ = error "Unknown variable"
  17 --
  18 --addEnv :: String -> Expr -> Env -> Env
  19 --addEnv name expr env v
  20 --    | v == name = expr
  21 --    | otherwise = env v
  22 --
  23 --eval :: Env -> Expr -> Value
  24 --eval _   (Lit i)    = Lit i
  25 --eval env (Plus l r) = case (eval env l, eval env r) of
  26 --    (Lit (I l), Lit (I r)) -> Lit (I (l+r))
  27 --    (l, r)         -> error $ "Cannot add " ++ show l ++ " to " ++ show r
  28 --eval env (Eq l r) = case (eval env l, eval env r) of
  29 --    (Lit (I l), Lit (I r)) -> Lit (B (l==r))
  30 --    (Lit (B l), Lit (B r)) -> Lit (B (l==r))
  31 --    (l, r)         -> error $ "Cannot compare " ++ show l ++ " to " ++ show r
  32 --
  33 --print :: Expr -> String
  34 --print (Lit i)    = show i
  35 --print (Plus l r) = "(" ++ print l ++ "+" ++ print r ++ ")"
  36 --print (Eq l r)   = "(" ++ print l ++ "==" ++ print r ++ ")"
  37
  38 data Expr a where
  39     Lit  :: Show a => a -> Expr a
  40     Plus :: Num a => Expr a -> Expr a -> Expr a
  41     Eq   :: Eq a => Expr a -> Expr a -> Expr Bool
  42
  43 print :: Expr a -> String
  44 print (Lit i)    = show i
  45 print (Plus l r) = "(" ++ print l ++ "+" ++ print r ++ ")"
  46 print (Eq l r)   = "(" ++ print l ++ "==" ++ print r ++ ")"
  47
  48 eval :: Expr a -> a
  49 eval (Lit i)    = i
  50 eval (Plus l r) = eval l + eval r
  51 eval (Eq l r)   = eval l == eval r