escher: eval

escher.hs

@@ -0,0 +1,101 @@
+data Value = BoolV Bool
+           | IntV Int
+           | ListV [Value]
+           | TreeV Tree
+    deriving (Read, Show, Eq)
+
+data Tree = TNode { treeLeft :: Tree, treeRoot :: Value, treeRight :: Tree }
+          | TLeaf Value
+    deriving (Read, Show, Eq)
+
+data Type = BoolT
+          | IntT
+          | ListT
+          | TreeT
+    deriving (Read, Show, Eq)
+
+data Expr = Expr :&&: Expr -- Bool
+          | Expr :||: Expr
+          | NotE Expr
+          | Expr :+: Expr -- Int
+          | Expr :-: Expr
+          | IncE Expr
+          | DecE Expr
+          | ZeroE
+          | Div2E Expr
+          | TailE Expr -- List
+          | HeadE Expr
+          | Expr :++: Expr -- cat 
+          | Expr ::: Expr -- cons
+          | EmptyListE
+          | IsLeafE Expr -- Tree
+          | TreeValE Expr
+          | TreeLeftE Expr
+          | TreeRightE Expr
+          | CreateNodeE { nodeLeft :: Expr, nodeRoot :: Expr, nodeRight :: Expr }
+          | CreateLeafE Expr
+    deriving (Read, Show, Eq)
+
+typeOf :: Value -> Type
+typeOf (BoolV {}) = BoolT
+typeOf (IntV {}) = IntT
+typeOf (ListV {}) = ListT
+typeOf (TreeV {}) = TreeT
+
+isBool = (== BoolT) . typeOf
+isInt = (== IntT) . typeOf
+isList = (== ListT) . typeOf
+isTree = (== TreeT) . typeOf
+
+eval :: Expr -> Maybe Value
+eval (left :&&: right) = do BoolV leftB <- eval left
+                            BoolV rightB <- eval right
+                            return $ BoolV $ leftB && rightB 
+eval (left :||: right) = do BoolV leftB <- eval left
+                            BoolV rightB <- eval right
+                            return $ BoolV $ leftB || rightB 
+eval (NotE e) = do BoolV b <- eval e
+                   return $ BoolV $ not b
+eval (left :+: right) = do IntV leftI <- eval left
+                           IntV rightI <- eval right
+                           return $ IntV $ leftI + rightI 
+eval (left :-: right) = do IntV leftI <- eval left
+                           IntV rightI <- eval right
+                           return $ IntV $ leftI - rightI 
+eval (IncE e) = do IntV i <- eval e
+                   return $ IntV $ i + 1
+eval (DecE e) = do IntV i <- eval e
+                   return $ IntV $ i - 1
+eval ZeroE = Just $ IntV 0
+eval (Div2E e) = do IntV i <- eval e
+                    return $ IntV $ i `div` 2
+eval (TailE e) = do ListV (_ : t) <- eval e
+                    return $ ListV t
+eval (HeadE e) = do ListV (h : _) <- eval e
+                    return h
+eval (left :++: right) = do ListV leftL <- eval left
+                            ListV rightL <- eval right
+                            return $ ListV $ leftL ++ rightL
+eval (left ::: right) = do leftV <- eval left
+                           ListV rightL <- eval right
+                           return $ ListV $ leftV : rightL
+eval EmptyListE = Just $ ListV []
+eval (IsLeafE e) = do TreeV t <- eval e
+                      return $ BoolV $ case t of
+                        TNode {} ->  False
+                        TLeaf {} -> True
+eval (TreeValE e) = do TreeV t <- eval e
+                       return $ case t of
+                         n@TNode {}  -> treeRoot n
+                         TLeaf e -> e
+eval (TreeLeftE e) = do TreeV n@(TNode {}) <- eval e
+                        return $ TreeV $ treeLeft n
+eval (TreeRightE e) = do TreeV n@(TNode {}) <- eval e
+                         return $ TreeV $ treeRight n
+eval (CreateNodeE { nodeLeft, nodeRoot, nodeRight }) = do TreeV treeLeft <- eval nodeLeft
+                                                          treeRoot <- eval nodeRoot
+                                                          TreeV treeRight <- eval nodeRight
+                                                          return $ TreeV $ TNode { treeLeft, treeRoot, treeRight }
+eval (CreateLeafE e) = do v <- eval e
+                          return $ TreeV $ TLeaf v
+-- eval _ = Nothing