fix errors (gen InputE 0 in patterns 1, more logs), split files

2025-12-06 05:28:42 +00:00 · 2025-11-05 01:19:45 +03:00 · 2025-11-05 01:19:45 +03:00 · 83720426c1
commit 83720426c1
parent 72e32c4b1d
5 changed files with 774 additions and 0 deletions
--- a/escher/TypeCheck.hs
+++ b/escher/TypeCheck.hs
@ -0,0 +1,101 @@
+module TypeCheck where
+
+import Expr
+import Control.Monad
+
+data Type = BoolT
+          | IntT
+          | ListT Type
+          | TreeT Type
+          | AnyT
+    deriving (Read, Show, Eq, Ord)
+
+typeOf :: Value -> Type
+typeOf (BoolV {}) = BoolT
+typeOf (IntV {}) = IntT
+typeOf (ListV (v : _)) = ListT $ typeOf v
+typeOf (ListV []) = ListT AnyT
+typeOf (TreeV (TNode { treeLeft, treeRoot, treeRight })) = TreeT $ typeOf treeRoot
+typeOf (TreeV (TLeaf v)) = TreeT $ typeOf v
+
+isBool = (== BoolT) . typeOf
+isInt = (== IntT) . typeOf
+isList x | ListT {} <- typeOf x = True
+         | otherwise = False
+isTree x | TreeT {} <- typeOf x = True
+         | otherwise = False
+
+data TypeConf = TypeConf { typeConfInput  :: [Type],
+                           typeConfOutput :: Type }
+
+checkType :: TypeConf -> Expr -> Maybe Type
+checkType conf (left :&&: right) = do BoolT <- checkType conf left
+                                      BoolT <- checkType conf right
+                                      return BoolT
+checkType conf (left :||: right) = do BoolT <- checkType conf left
+                                      BoolT <- checkType conf right
+                                      return BoolT
+checkType conf (NotE e) = do BoolT <- checkType conf e
+                             return BoolT
+checkType conf (left :=: right) = do leftT <- checkType conf left
+                                     rightT <- checkType conf right
+                                     guard $ leftT == rightT
+                                     return BoolT
+checkType conf (Leq0 e) = do IntT <- checkType conf e
+                             return BoolT
+checkType conf (IsEmptyE e) = do ListT _ <- checkType conf e
+                                 return BoolT
+checkType conf (left :+: right) = do IntT <- checkType conf left
+                                     IntT <- checkType conf right
+                                     return IntT
+checkType conf (left :-: right) = do IntT <- checkType conf left
+                                     IntT <- checkType conf right
+                                     return IntT
+checkType conf (IncE e) = do IntT <- checkType conf e
+                             return IntT
+checkType conf (DecE e) = do IntT <- checkType conf e
+                             return IntT
+checkType conf ZeroE = return IntT
+checkType conf (Div2E e) = do IntT <- checkType conf e
+                              return IntT
+checkType conf (TailE e) = do ListT t <- checkType conf e
+                              return $ ListT t
+checkType conf (HeadE e) = do ListT t <- checkType conf e
+                              return t
+checkType conf (left :++: right) = do ListT t <- checkType conf left
+                                      ListT u <- checkType conf right
+                                      guard $ t == u
+                                      return $ ListT t
+checkType conf (left ::: right) = do t <- checkType conf left
+                                     ListT u <- checkType conf right
+                                     guard $ t == u
+                                     return $ ListT t
+checkType conf EmptyListE = return $ ListT AnyT -- TODO
+checkType conf (IsLeafE e) = do TreeT _ <- checkType conf e
+                                return BoolT
+checkType conf (TreeValE e) = do TreeT t <- checkType conf e
+                                 return t
+checkType conf (TreeLeftE e) = do TreeT t <- checkType conf e
+                                  return $ TreeT t
+checkType conf (TreeRightE e) = do TreeT t <- checkType conf e
+                                   return $ TreeT t
+checkType conf (CreateNodeE {nodeLeft, nodeRoot, nodeRight}) = do TreeT t <- checkType conf nodeLeft
+                                                                  u <- checkType conf nodeRoot
+                                                                  guard $ t == u
+                                                                  TreeT w <- checkType conf nodeRight
+                                                                  guard $ t == w
+                                                                  return $ TreeT t
+checkType conf (CreateLeafE e) = do t <- checkType conf e
+                                    return $ TreeT t
+checkType conf (IfE {ifCond, ifDoThen, ifDoElse}) = do BoolT <- checkType conf ifCond
+                                                       leftT <- checkType conf ifDoThen
+                                                       rightT <- checkType conf ifDoElse
+                                                       guard $ leftT == rightT
+                                                       return leftT
+checkType conf (SelfE es) = do let ts = typeConfInput conf
+                               guard $ length ts == length es
+                               guard $ and $ zipWith (\t e -> checkType conf e == Just t) ts es
+                               return $ typeConfOutput conf
+checkType conf (InputE i) = Just $ typeConfInput conf !! i
+checkType _ Hole = Nothing
+-- checkType _ _ = Nothing