Visitor

src/Singleton.hs

@@ -1,20 +1,22 @@
+{-# LANGUAGE DatatypeContexts #-}
 module Singleton 
     (
         singletonDemo
     )
 where
 
-data Exp = Var String
-    | Val Double
-    | Add Exp Exp
-    | Mul Exp Exp
+data (Num a) => Exp a = 
+      Var String
+    | Val a
+    | Add (Exp a) (Exp a)
+    | Mul (Exp a) (Exp a)
 
-type Env = [(String, Double)]
+type Env a = [(String, a)]
 
 -- the naive implementation of eval:
 -- the environment is threaded into each recursive call of eval
 -- as an explicit parameter e
-eval :: Exp -> Env -> Double
+eval :: (Num a) => Exp a -> Env a -> a
 eval (Var x)   e = fetch x e
 eval (Val i)   e = i
 eval (Add p q) e = eval p e + eval q e
@@ -30,7 +32,7 @@ s ef es e = ef e (es e)
 -- the SK combinator based implementation
 -- the threading of the env into recursive calls is by the S combinator
 -- currying allows to omit the explicit parameter e
-eval1 :: Exp -> Env -> Double
+eval1 :: (Num a) => Exp a -> Env a -> a
 eval1 (Var x)   = fetch x
 eval1 (Val i)   = k i
 eval1 (Add p q) = k (+) `s` eval1 p `s` eval1 q
@@ -42,14 +44,14 @@ eval1 (Mul p q) = k (*) `s` eval1 p `s` eval1 q
 
 -- applicative functor based implementation
 -- the K and S magic is now done by pure and <*>
-eval2 :: Exp -> Env -> Double
+eval2 :: (Num a) => Exp a -> Env a -> a
 eval2 (Var x)   = fetch x
 eval2 (Val i)   = pure i
 eval2 (Add p q) = pure (+) <*> eval2 p  <*> eval2 q
 eval2 (Mul p q) = pure (*) <*> eval2 p  <*> eval2 q
 
 -- simple environment lookup
-fetch :: String -> Env -> Double
+fetch :: String -> Env a -> a
 fetch x []        = error $ "variable " ++ x ++ " is not defined"
 fetch x ((y,v):ys)
     | x == y    = v
@@ -62,4 +64,6 @@ singletonDemo = do
                   (Mul (Val 2) (Var "pi"))
         env = [("pi", pi)]
     print $ eval exp env
+    print $ eval1 exp env
+    print $ eval2 exp env
     putStrLn ""

src/Visitor.hs

@@ -1,26 +1,32 @@
 {-# LANGUAGE DeriveFoldable #-}
 module Visitor where
---import Data.Foldable
+import Data.Monoid
 
 data Exp a = 
     Val a
-    | Add (Exp a) (Exp a)
-    | Mul (Exp a) (Exp a)
+  | Add (Exp a) (Exp a)
+  | Mul (Exp a) (Exp a)
     deriving (Show, Foldable)
+
 {-
 instance Foldable Exp where
-    foldMap f Empty = mempty
-    foldMap f (Val x) = f x
+    foldMap f (Val x)   = f x
     foldMap f (Add x y) = foldMap f x ++ foldMap f y
         where (++) = mappend
     foldMap f (Mul x y) = foldMap f x ++ foldMap f y
         where (++) = mappend
 -}
 
+size :: Foldable f => f a -> Int
+size = getSum . foldMap (Sum . const 1)
+
+exp = Mul (Add (Val 3) (Val 1)) 
+          (Mul (Val 4) (Val pi))
+
 visitorDemo = do
     putStrLn "Visitor vs. Foldable, Traversable"
     let exp = Mul (Add (Val 3) (Val 1)) 
                   (Mul (Val 4) (Val pi))
     print exp
     putStr "size of exp: "
-    print (length exp)
+    print (size exp)