diff --git a/src/Singleton.hs b/src/Singleton.hs index 297127c..c1aa508 100644 --- a/src/Singleton.hs +++ b/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 "" \ No newline at end of file diff --git a/src/Visitor.hs b/src/Visitor.hs index 53d6d2f..46ffc9b 100644 --- a/src/Visitor.hs +++ b/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) \ No newline at end of file + print (size exp) \ No newline at end of file