diff --git a/escher.hs b/escher.hs new file mode 100644 index 0000000..aaf1011 --- /dev/null +++ b/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