prog_synthesis/escher.hs
2025-10-04 12:58:34 +03:00

101 lines
3.7 KiB
Haskell

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