完成语义检查，整理项目

chusql-engine/app/Main.hs

@@ -1,18 +1,18 @@
 module Main where
 
-import ChuSQL.Algebra.Op (RelOp (..))
+import ChuSQL.Algebra.Op (renderPlan)
 import ChuSQL.Algebra.Optimize (optimize)
 import ChuSQL.Algebra.Planner (translate)
+import ChuSQL.Engine
 import ChuSQL.Model
-import ChuSQL.SQLSyntax.AST
-import ChuSQL.SQLSyntax.Executor
-import ChuSQL.SQLSyntax.Parser
+import ChuSQL.Syntax.AST
+import ChuSQL.Syntax.Parser
 
 users :: Table
 users =
     Table
         { tableName = "users"
-        , tableCols = ["id", "name", "age"]
+        , tableCols = [("id", TInt), ("name", TStr), ("age", TInt)]
         , tableRows =
             [ [("id", VInt 1), ("name", VStr "Alice"), ("age", VInt 25)]
             , [("id", VInt 2), ("name", VStr "Bob"), ("age", VInt 17)]
@@ -24,7 +24,7 @@ orders :: Table
 orders =
     Table
         { tableName = "orders"
-        , tableCols = ["id", "user_id", "product"]
+        , tableCols = [("id", TInt), ("user_id", TInt), ("product", TStr)]
         , tableRows =
             [ [("id", VInt 1), ("user_id", VInt 1), ("product", VStr "Book")]
             , [("id", VInt 2), ("user_id", VInt 2), ("product", VStr "Pen")]
@@ -35,13 +35,9 @@ orders =
 db :: Database
 db = [("users", users), ("orders", orders)]
 
--- runQuery 返回 (更新后的数据库, 结果行)；演示只关心结果行
-rowsOf :: Either String (Database, [Row]) -> Either String [Row]
-rowsOf = fmap snd
-
 main :: IO ()
 main = do
-    putStrLn "==================== Parser Test ====================="
+    putStrLn "==================== Engine ====================="
     let q1 = makeSelect ["name"] "users" (Just (Gt (Col "age") (LitInt 18)))
     print (rowsOf (runQuery db q1))
 
@@ -73,35 +69,12 @@ main = do
             \JOIN orders o ON u.id = o.user_id WHERE u.age > 18"
     case parseQuery planSql of
         Left err -> putStrLn err
-        Right query -> case translate db query of
+        Right query -> case translate query of
             Left err -> putStrLn err
             Right plan -> do
                 putStrLn "--- plan before optimization ---"
-                putStrLn (dump 0 plan)
+                putStrLn (renderPlan plan)
                 putStrLn "--- plan after optimization ---"
-                putStrLn (dump 0 (optimize db plan))
+                putStrLn (renderPlan (optimize db plan))
                 putStrLn "--- rows ---"
                 print (rowsOf (runQuery db query))
-
-dump :: Int -> RelOp -> String
-dump ind op = case op of
-    Scan a t ->
-        pad ++ "Scan " ++ show a ++ " " ++ show t
-    Filter e x ->
-        pad ++ "Filter " ++ show e ++ "\n" ++ dump (ind + 1) x
-    Project c x ->
-        pad ++ "Project " ++ show c ++ "\n" ++ dump (ind + 1) x
-    Sort s x ->
-        pad ++ "Sort " ++ show s ++ "\n" ++ dump (ind + 1) x
-    Limit n x ->
-        pad ++ "Limit " ++ show n ++ "\n" ++ dump (ind + 1) x
-    Join l r c ->
-        pad
-            ++ "Join on "
-            ++ show c
-            ++ "\n"
-            ++ dump (ind + 1) l
-            ++ "\n"
-            ++ dump (ind + 1) r
-  where
-    pad = replicate (ind * 2) ' '

chusql-engine/chusql-engine.cabal

@@ -10,15 +10,16 @@ build-type:     Simple
 library
     hs-source-dirs:   src
     exposed-modules:  ChuSQL.Algebra.Eval
+                      ChuSQL.Algebra.Expr
                       ChuSQL.Algebra.Op
                       ChuSQL.Algebra.Optimize
                       ChuSQL.Algebra.Planner
+                      ChuSQL.Algebra.Sort
+                      ChuSQL.Engine
                       ChuSQL.Model
-                      ChuSQL.SQLSyntax.AST
-                      ChuSQL.SQLSyntax.Executor
-                      ChuSQL.SQLSyntax.Expr
-                      ChuSQL.SQLSyntax.Parser
-                      ChuSQL.SQLSyntax.Sort
+                      ChuSQL.Semantic
+                      ChuSQL.Syntax.AST
+                      ChuSQL.Syntax.Parser
     build-depends:    base >= 4.14 && < 5
                     , megaparsec
                     , parser-combinators

chusql-engine/src/ChuSQL/Algebra/Eval.hs

@@ -1,9 +1,9 @@
-module ChuSQL.Algebra.Eval where
+module ChuSQL.Algebra.Eval (evalRelOp) where
 
+import ChuSQL.Algebra.Expr (evalCondForRow)
 import ChuSQL.Algebra.Op
+import ChuSQL.Algebra.Sort (sortRows)
 import ChuSQL.Model
-import ChuSQL.SQLSyntax.Expr (evalCondForRow)
-import ChuSQL.SQLSyntax.Sort (sortRows)
 import Control.Monad (filterM)
 
 -- 投影
@@ -17,7 +17,7 @@ addPrefix prefix = map (\(k, v) -> (prefix ++ k, v))
 
 evalRelOp :: Database -> RelOp -> Either String [Row]
 evalRelOp db (Scan mAlias tbl) = do
-    table <- maybe (Left ("unknown table: " ++ tbl)) Right (lookup tbl db)
+    table <- lookupTable db tbl
     let prefix = maybe "" (++ ".") mAlias
     Right (map (addPrefix prefix) (tableRows table))
 evalRelOp db (Filter e op) = do

chusql-engine/src/ChuSQL/Algebra/Expr.hs

@@ -1,7 +1,7 @@
-module ChuSQL.SQLSyntax.Expr where
+module ChuSQL.Algebra.Expr (evalExpr, evalCondForRow, colsInExpr) where
 
 import ChuSQL.Model
-import ChuSQL.SQLSyntax.AST
+import ChuSQL.Syntax.AST
 import Control.Monad (join)
 
 -- 表达式求值
@@ -17,6 +17,16 @@ evalExpr (Eq a b) row = liftBinOp eqOp a b row
 evalExpr (And a b) row = liftBinOp (boolOp (&&)) a b row
 evalExpr (Or a b) row = liftBinOp (boolOp (||)) a b row
 
+-- | 收集表达式里用到的列名
+colsInExpr :: Expr -> [String]
+colsInExpr (Col c) = [c]
+colsInExpr (Gt a b) = colsInExpr a ++ colsInExpr b
+colsInExpr (Lt a b) = colsInExpr a ++ colsInExpr b
+colsInExpr (Eq a b) = colsInExpr a ++ colsInExpr b
+colsInExpr (And a b) = colsInExpr a ++ colsInExpr b
+colsInExpr (Or a b) = colsInExpr a ++ colsInExpr b
+colsInExpr _ = []
+
 -- 对行计算条件语句
 evalCondForRow :: Expr -> Row -> Either String Bool
 evalCondForRow e row = do

chusql-engine/src/ChuSQL/Algebra/Op.hs

@@ -1,6 +1,6 @@
-module ChuSQL.Algebra.Op where
+module ChuSQL.Algebra.Op (RelOp (..), renderPlan) where
 
-import ChuSQL.SQLSyntax.AST (Expr, SortDir)
+import ChuSQL.Syntax.AST (Expr, SortDir)
 
 -- 关系代数算子
 data RelOp
@@ -11,3 +11,17 @@ data RelOp
     | Limit Int RelOp
     | Join RelOp RelOp Expr
     deriving (Show, Eq)
+
+-- | 把算子树画成缩进文本（演示和调试用）
+renderPlan :: RelOp -> String
+renderPlan = go 0
+  where
+    go ind op = case op of
+        Scan a t -> pad ++ "Scan " ++ show a ++ " " ++ show t
+        Filter e x -> pad ++ "Filter " ++ show e ++ "\n" ++ go (ind + 1) x
+        Project c x -> pad ++ "Project " ++ show c ++ "\n" ++ go (ind + 1) x
+        Sort s x -> pad ++ "Sort " ++ show s ++ "\n" ++ go (ind + 1) x
+        Limit n x -> pad ++ "Limit " ++ show n ++ "\n" ++ go (ind + 1) x
+        Join l r c -> pad ++ "Join on " ++ show c ++ "\n" ++ go (ind + 1) l ++ "\n" ++ go (ind + 1) r
+      where
+        pad = replicate (ind * 2) ' '

chusql-engine/src/ChuSQL/Algebra/Optimize.hs

@@ -1,22 +1,12 @@
-module ChuSQL.Algebra.Optimize where
+module ChuSQL.Algebra.Optimize (optimize, pushProject) where
 
 import ChuSQL.Algebra.Op (RelOp (..))
 import ChuSQL.Model
-import ChuSQL.SQLSyntax.AST (Expr (..))
-import ChuSQL.SQLSyntax.Expr (evalExpr)
+import ChuSQL.Syntax.AST (Expr (..))
+import ChuSQL.Algebra.Expr (colsInExpr, evalExpr)
 
 -- * 谓词下推
 
--- | 收集表达式里用到的列名；谓词下推判断条件归属、常量折叠判断能否求值，都要用它
-colsInExpr :: Expr -> [String]
-colsInExpr (Col c) = [c]
-colsInExpr (Gt a b) = colsInExpr a ++ colsInExpr b
-colsInExpr (Lt a b) = colsInExpr a ++ colsInExpr b
-colsInExpr (Eq a b) = colsInExpr a ++ colsInExpr b
-colsInExpr (And a b) = colsInExpr a ++ colsInExpr b
-colsInExpr (Or a b) = colsInExpr a ++ colsInExpr b
-colsInExpr _ = []
-
 -- | 一个算子会产出哪些列；返回 ["*"] 表示"全部列，不用挑"
 relOpCols :: Database -> RelOp -> [String]
 relOpCols db (Filter _ x) = relOpCols db x
@@ -28,7 +18,7 @@ relOpCols db (Join l r _) = relOpCols db l ++ relOpCols db r
 relOpCols db (Scan mAlias tbl) =
     case lookup tbl db of
         Nothing -> []
-        Just t -> map (prefix ++) (tableCols t)
+        Just t -> map (prefix ++) (colNames t)
   where
     prefix = maybe "" (++ ".") mAlias
 
@@ -85,7 +75,7 @@ pushOne _ op = op
 
 -- | 工具函数
 needsAll :: [String] -> Bool
-needsAll = elem "*"
+needsAll = elem allColumns
 
 pushProject :: Database -> [String] -> RelOp -> RelOp
 pushProject db _ (Project cols x) = case pushProject db cols x of

chusql-engine/src/ChuSQL/Algebra/Planner.hs

@@ -1,44 +1,7 @@
-module ChuSQL.Algebra.Planner where
+module ChuSQL.Algebra.Planner (translate) where
 
 import ChuSQL.Algebra.Op
-import ChuSQL.Model
-import ChuSQL.SQLSyntax.AST
-
--- * 存在性检查
-checkColumns :: [String] -> [String] -> Either String ()
-checkColumns available requested =
-    case [c | c <- requested, c /= "*", c `notElem` available] of
-        [] -> Right ()
-        (c : _) -> Left ("unknown column: " ++ c)
-
-checkFrom :: Database -> FromClause -> Either String ()
-checkFrom db (FromTable _ tbl) =
-    case lookup tbl db of
-        Just _ -> Right ()
-        Nothing -> Left ("unknown table: " ++ tbl)
-checkFrom db (FromJoin left _ tbl _) = do
-    _ <- checkFrom db left
-    case lookup tbl db of
-        Just _ -> Right ()
-        Nothing -> Left ("unknown table: " ++ tbl)
-
--- | 收集 FromClause 里所有可用的列名
-availableColumns :: Database -> FromClause -> Either String [String]
-availableColumns db (FromTable mAlias tbl) = do
-    table <- maybe (Left ("unknown table: " ++ tbl)) Right (lookup tbl db)
-    let prefix = maybe "" (++ ".") mAlias
-    Right (map (prefix ++) (tableCols table))
-availableColumns db (FromJoin left mAlias tbl _) = do
-    lcols <- availableColumns db left
-    table <- maybe (Left ("unknown table: " ++ tbl)) Right (lookup tbl db)
-    let prefix = maybe "" (++ ".") mAlias
-    Right (lcols ++ map (prefix ++) (tableCols table))
-
--- | 检查数据库列明
-checkColumnsFrom :: Database -> FromClause -> [String] -> Either String ()
-checkColumnsFrom db fromC requested = do
-    available <- availableColumns db fromC
-    checkColumns available requested
+import ChuSQL.Syntax.AST
 
 -- 内部查询语句转执行计划
 fromToRelOp :: FromClause -> RelOp
@@ -46,8 +9,8 @@ fromToRelOp (FromTable mAlias tbl) = Scan mAlias tbl
 fromToRelOp (FromJoin left mAlias tbl cond) =
     Join (fromToRelOp left) (Scan mAlias tbl) cond
 
-translate :: Database -> Query -> Either String RelOp
-translate db q = case q of
+translate :: Query -> Either String RelOp
+translate q = case q of
     Select
         { selectCols = cols
         , selectFrom = fromC
@@ -55,10 +18,6 @@ translate db q = case q of
         , selectOrderBy = orderBy
         , selectLimit = mLimit
         } -> do
-            -- 检查所有表和列
-            _ <- checkFrom db fromC
-            _ <- checkColumnsFrom db fromC cols
-            _ <- checkColumnsFrom db fromC (map fst orderBy)
             let base = fromToRelOp fromC
                 filtered = case mWhere of
                     Nothing -> base

chusql-engine/src/ChuSQL/Algebra/Sort.hs

@@ -1,7 +1,7 @@
-module ChuSQL.SQLSyntax.Sort where
+module ChuSQL.Algebra.Sort (sortRows) where
 
 import ChuSQL.Model
-import ChuSQL.SQLSyntax.AST
+import ChuSQL.Syntax.AST
 import Data.List (sortBy)
 
 -- | 反向排序

chusql-engine/src/ChuSQL/Engine.hs

@@ -1,19 +1,27 @@
-module ChuSQL.SQLSyntax.Executor where
+module ChuSQL.Engine (runQuery, rowsOf) where
 
 import ChuSQL.Algebra.Eval (evalRelOp)
+import ChuSQL.Algebra.Expr (evalCondForRow, evalExpr)
 import ChuSQL.Algebra.Optimize (optimize)
 import ChuSQL.Algebra.Planner (translate)
 import ChuSQL.Model
-import ChuSQL.SQLSyntax.AST
-import ChuSQL.SQLSyntax.Expr (evalCondForRow, evalExpr)
+import ChuSQL.Semantic (check)
+import ChuSQL.Syntax.AST
 import Control.Monad (filterM)
 
--- 表里加新行
-updateTable :: String -> (Table -> Table) -> Database -> Either String Database
-updateTable name f db = do
-    table <- maybe (Left ("unknown table: " ++ name)) Right (lookup name db)
-    let table' = f table
-    Right (map (\(n, t) -> if n == name then (n, table') else (n, t)) db)
+-- | 带检查的查询入口：先做语义检查，再交给下面的执行
+runQuery :: Database -> Query -> Either String (Database, [Row])
+runQuery db q = do
+    _ <- check db q
+    runQueryUnchecked db q
+
+-- | 只要结果行（丢掉更新后的数据库），给演示和测试用
+rowsOf :: Either String (Database, [Row]) -> Either String [Row]
+rowsOf = fmap snd
+
+-- 把表整体换掉（调用方已经查过，表一定存在）
+replaceTable :: String -> Table -> Database -> Database
+replaceTable name table = map (\(n, t) -> if n == name then (n, table) else (n, t))
 
 -- 修改表
 applyUpdates :: [(String, Expr)] -> Row -> Either String Row
@@ -25,46 +33,40 @@ applyUpdates ((col, e) : rest) row = do
   where
     setColumn c v r = map (\(k, val) -> if k == c then (k, v) else (k, val)) r
 
--- 处理查询
-runQuery :: Database -> Query -> Either String (Database, [Row])
-runQuery db q@Select{} = do
-    relOp <- translate db q
+-- 实际执行（调用方请确保已过 check）
+runQueryUnchecked :: Database -> Query -> Either String (Database, [Row])
+runQueryUnchecked db q@Select{} = do
+    relOp <- translate q
     rows <- evalRelOp db (optimize db relOp)
     Right (db, rows)
 
 -- 处理插入
-runQuery db (Insert tbl cols vals) = do
+runQueryUnchecked db (Insert tbl cols vals) = do
     values <- mapM (\e -> evalExpr e []) vals
     if length cols /= length values
         then Left "column count does not match value count"
         else do
+            table <- lookupTable db tbl
             let newRow = zip cols values
-            db' <-
-                updateTable
-                    tbl
-                    (\t -> t{tableRows = tableRows t ++ [newRow]})
-                    db
-            Right (db', [])
+            Right (replaceTable tbl table{tableRows = tableRows table ++ [newRow]} db, [])
 
 -- 处理删除
-runQuery db (Delete tbl mWhere) = do
-    table <- maybe (Left ("unknown table: " ++ tbl)) Right (lookup tbl db)
+runQueryUnchecked db (Delete tbl mWhere) = do
+    table <- lookupTable db tbl
     rows <- case mWhere of
         Nothing -> Right []
         Just e -> filterM (shouldKeep e) (tableRows table)
-    db' <- updateTable tbl (\t -> t{tableRows = rows}) db
-    Right (db', [])
+    Right (replaceTable tbl table{tableRows = rows} db, [])
   where
     -- 保留 = 条件不成立
     shouldKeep :: Expr -> Row -> Either String Bool
     shouldKeep e row = not <$> evalCondForRow e row
 
 -- 处理表更新
-runQuery db (Update tbl assigns mWhere) = do
-    table <- maybe (Left ("unknown table: " ++ tbl)) Right (lookup tbl db)
+runQueryUnchecked db (Update tbl assigns mWhere) = do
+    table <- lookupTable db tbl
     rows <- mapM (updateRow mWhere assigns) (tableRows table)
-    db' <- updateTable tbl (\t -> t{tableRows = rows}) db
-    Right (db', [])
+    Right (replaceTable tbl table{tableRows = rows} db, [])
   where
     updateRow :: Maybe Expr -> [(String, Expr)] -> Row -> Either String Row
     updateRow cond asgns row = do

chusql-engine/src/ChuSQL/Model.hs

@@ -1,4 +1,11 @@
-module ChuSQL.Model where
+module ChuSQL.Model (Column (..), Value (..), Row, Table (..), Database, colNames, colType, lookupTable, allColumns) where
+
+-- 列的类型
+data Column
+    = TInt
+    | TStr
+    | TBool
+    deriving (Show, Eq)
 
 -- 列的值：整数、字符串、布尔
 data Value
@@ -13,10 +20,26 @@ type Row = [(String, Value)]
 -- 一张表
 data Table = Table
     { tableName :: String
-    , tableCols :: [String]
+    , tableCols :: [(String, Column)]
     , tableRows :: [Row]
     }
     deriving (Show)
 
 -- 数据库：多张表
 type Database = [(String, Table)]
+
+-- 获取列名
+colNames :: Table -> [String]
+colNames = map fst . tableCols
+
+-- | 查某一列的类型
+colType :: Table -> String -> Maybe Column
+colType t c = lookup c (tableCols t)
+
+-- | 按名字查表；表不存在就报错
+lookupTable :: Database -> String -> Either String Table
+lookupTable db t = maybe (Left ("unknown table: " ++ t)) Right (lookup t db)
+
+-- | 投影列清单里的哨兵值：它表示"全部列，不用挑"，不是列名
+allColumns :: String
+allColumns = "*"

chusql-engine/src/ChuSQL/Semantic.hs

@@ -0,0 +1,128 @@
+module ChuSQL.Semantic (check) where
+
+import ChuSQL.Algebra.Expr (colsInExpr)
+import ChuSQL.Model
+import ChuSQL.Syntax.AST
+import Data.List (intercalate)
+
+-- * 表与列名解析
+
+-- | 给一批列加上"别名."前缀
+prefixColumns :: Maybe String -> [(String, Column)] -> [(String, Column)]
+prefixColumns mAlias cols = [(prefix ++ c, ty) | (c, ty) <- cols]
+  where
+    prefix = maybe "" (++ ".") mAlias
+
+-- | 走一遍 FROM：算出可用列（带别名前缀），顺手把每个 ON 条件也查了
+checkFrom :: Database -> FromClause -> Either String [(String, Column)]
+checkFrom db (FromTable mAlias tbl) = do
+    t <- lookupTable db tbl
+    Right (prefixColumns mAlias (tableCols t))
+checkFrom db (FromJoin left mAlias tbl cond) = do
+    lcols <- checkFrom db left
+    t <- lookupTable db tbl
+    let env = lcols ++ prefixColumns mAlias (tableCols t)
+    checkBool "ON" env cond
+    Right env
+
+-- * 列检查与报错
+
+-- | 统一拼一条带"可用列清单"的报错
+missingColumn :: String -> String -> [(String, Column)] -> String
+missingColumn place c env =
+    "unknown column in " ++ place ++ ": " ++ c ++ hint
+  where
+    hint
+        | null env = ""
+        | otherwise = " (available: " ++ intercalate ", " (map fst env) ++ ")"
+
+-- | 请求的列必须都在可用清单里；哨兵 allColumns 表示"全部列"，放行
+checkColumns :: String -> [(String, Column)] -> [String] -> Either String ()
+checkColumns place env requested =
+    case [c | c <- requested, c /= allColumns, c `notElem` map fst env] of
+        [] -> Right ()
+        (c : _) -> Left (missingColumn place c env)
+
+-- * 表达式类型推导
+
+-- | 推出一个表达式的结果类型；列不存在、或类型对不上，都报错
+inferExpr :: String -> [(String, Column)] -> Expr -> Either String Column
+inferExpr place env (Col c) = maybe (Left (missingColumn place c env)) Right (lookup c env)
+inferExpr _ _ (LitInt _) = Right TInt
+inferExpr _ _ (LitStr _) = Right TStr
+inferExpr _ _ (LitBool _) = Right TBool
+inferExpr place env (Gt a b) = operands place env TInt a b
+inferExpr place env (Lt a b) = operands place env TInt a b
+inferExpr place env (And a b) = operands place env TBool a b
+inferExpr place env (Or a b) = operands place env TBool a b
+inferExpr place env (Eq a b) = do
+    ta <- inferExpr place env a
+    tb <- inferExpr place env b
+    if ta == tb
+        then Right TBool
+        else Left (place ++ ": both sides of = must have the same type, got " ++ show ta ++ " and " ++ show tb)
+
+-- | 二元运算的通用检查：两边都必须是同一种期望类型，结果都是布尔
+operands :: String -> [(String, Column)] -> Column -> Expr -> Expr -> Either String Column
+operands place env want a b = do
+    ta <- inferExpr place env a
+    tb <- inferExpr place env b
+    if ta == want && tb == want
+        then Right TBool
+        else Left (place ++ ": operator needs " ++ show want ++ " on both sides, got " ++ show ta ++ " and " ++ show tb)
+
+-- | 这个表达式必须能算成一个条件（布尔）
+checkBool :: String -> [(String, Column)] -> Expr -> Either String ()
+checkBool place env e = do
+    checkColumns place env (colsInExpr e)
+    t <- inferExpr place env e
+    if t == TBool
+        then Right ()
+        else Left (place ++ ": condition must be a boolean, got " ++ show t)
+
+-- * 写入语句
+
+-- | 一条赋值的通用检查：目标列必须存在，右边表达式的类型要对得上
+checkTyped :: String -> [(String, Column)] -> Table -> (String, Expr) -> Either String ()
+checkTyped place env t (c, e) = do
+    want <- maybe (Left (missingColumn place c (tableCols t))) Right (colType t c)
+    got <- inferExpr place env e
+    if want == got
+        then Right ()
+        else Left (place ++ ": column " ++ c ++ " needs " ++ show want ++ ", got " ++ show got)
+
+-- | INSERT 的一个值：环境是空的 —— 值必须是字面量，写列名会被拦下
+checkValue :: Table -> (String, Expr) -> Either String ()
+checkValue = checkTyped "INSERT" []
+
+-- | UPDATE 的一个赋值：环境是整张表 —— 右边可以引用本行的列
+checkAssign :: Table -> (String, Expr) -> Either String ()
+checkAssign t = checkTyped "UPDATE" (tableCols t) t
+
+-- * 总入口
+
+-- | 语义检查总入口：合法返回 Right ()，不合法返回 Left（带人话解释）
+check :: Database -> Query -> Either String ()
+check db q = case q of
+    Select
+        { selectCols = cols
+        , selectFrom = fromC
+        , selectWhere = mWhere
+        , selectOrderBy = orderBy
+        } -> do
+            env <- checkFrom db fromC
+            checkColumns "SELECT" env cols
+            checkColumns "ORDER BY" env (map fst orderBy)
+            mapM_ (checkBool "WHERE" env) mWhere
+    Insert tbl cols vals -> do
+        t <- lookupTable db tbl
+        checkColumns "INSERT" (tableCols t) cols
+        mapM_ (checkValue t) (zip cols vals)
+    Delete tbl mWhere -> do
+        t <- lookupTable db tbl
+        mapM_ (checkBool "WHERE" (tableCols t)) mWhere
+    Update tbl assigns mWhere -> do
+        t <- lookupTable db tbl
+        checkColumns "UPDATE" (tableCols t) (map fst assigns)
+        mapM_ (checkAssign t) assigns
+        mapM_ (checkBool "WHERE" (tableCols t)) mWhere

chusql-engine/src/ChuSQL/Syntax/AST.hs

@@ -1,4 +1,4 @@
-module ChuSQL.SQLSyntax.AST where
+module ChuSQL.Syntax.AST (Query (..), FromClause (..), Expr (..), SortDir (..), makeSelect) where
 
 -- 查询语句
 data Query

chusql-engine/src/ChuSQL/Syntax/Parser.hs

@@ -1,20 +1,13 @@
 {-# LANGUAGE ImportQualifiedPost #-}
 
-{- | SQL 语法分析器：把 SQL 文本解析为 'ChuSQL.SQLSyntax.AST.Query'。
+{- | SQL 语法分析器：把 SQL 文本解析为 'ChuSQL.Syntax.AST.Query'。
 
 词法层负责空白、关键字、标识符、字面量与符号；语法层按
 优先级 比较 > AND > OR 自底向上组装表达式。
 -}
-module ChuSQL.SQLSyntax.Parser (
-    Parser,
-    parseQuery,
-    expr,
-    identifier,
-    integer,
-    stringLit,
-) where
+module ChuSQL.Syntax.Parser (parseQuery) where
 
-import ChuSQL.SQLSyntax.AST
+import ChuSQL.Syntax.AST
 import Control.Monad.Combinators.Expr (Operator (..), makeExprParser)
 import Data.Char (isAlpha, isAlphaNum, toLower)
 import Data.List (intercalate)

chusql-engine/test/Spec.hs

@@ -1,13 +1,13 @@
 module Main where
 
 import ChuSQL.Algebra.Eval (evalRelOp)
-import ChuSQL.Algebra.Op (RelOp (..))
+import ChuSQL.Algebra.Op (RelOp (..), renderPlan)
 import ChuSQL.Algebra.Optimize (optimize, pushProject)
 import ChuSQL.Algebra.Planner (translate)
 import ChuSQL.Model
-import ChuSQL.SQLSyntax.AST
-import ChuSQL.SQLSyntax.Executor
-import ChuSQL.SQLSyntax.Parser
+import ChuSQL.Syntax.AST
+import ChuSQL.Engine
+import ChuSQL.Syntax.Parser
 import Test.Hspec
 
 -- ============================================================
@@ -17,7 +17,7 @@ users :: Table
 users =
     Table
         { tableName = "users"
-        , tableCols = ["id", "name", "age"]
+        , tableCols = [("id", TInt), ("name", TStr), ("age", TInt)]
         , tableRows =
             [ [("id", VInt 1), ("name", VStr "Alice"), ("age", VInt 25)]
             , [("id", VInt 2), ("name", VStr "Bob"), ("age", VInt 17)]
@@ -29,7 +29,7 @@ orders :: Table
 orders =
     Table
         { tableName = "orders"
-        , tableCols = ["id", "user_id", "product"]
+        , tableCols = [("id", TInt), ("user_id", TInt), ("product", TStr)]
         , tableRows =
             [ [("id", VInt 1), ("user_id", VInt 1), ("product", VStr "Book")]
             , [("id", VInt 2), ("user_id", VInt 2), ("product", VStr "Pen")]
@@ -48,7 +48,7 @@ main = hspec $ do
     -- ============================================================
     -- AST
     -- ============================================================
-    describe "ChuSQL.Syntax.Ast" $ do
+    describe "ChuSQL.Syntax.AST" $ do
         it "equal Selects are equal" $ do
             makeSelect ["name"] "users" Nothing
                 `shouldBe` makeSelect ["name"] "users" Nothing
@@ -247,7 +247,7 @@ main = hspec $ do
     -- ============================================================
     -- Engine: SELECT
     -- ============================================================
-    describe "ChuSQL.Eval.Engine (SELECT)" $ do
+    describe "ChuSQL.Engine (SELECT)" $ do
         it "returns all rows without WHERE" $ do
             rowsOf (runQuery testDB (makeSelect ["*"] "users" Nothing))
                 `shouldBe` Right
@@ -304,7 +304,7 @@ main = hspec $ do
     -- ============================================================
     -- Engine: INSERT
     -- ============================================================
-    describe "ChuSQL.Eval.Engine (INSERT)" $ do
+    describe "ChuSQL.Engine (INSERT)" $ do
         it "parses a simple INSERT" $ do
             parseQuery "INSERT INTO users (name, age) VALUES ('Dave', 22)"
                 `shouldBe` Right (Insert "users" ["name", "age"] [LitStr "Dave", LitInt 22])
@@ -353,7 +353,7 @@ main = hspec $ do
     -- ============================================================
     -- Engine: DELETE
     -- ============================================================
-    describe "ChuSQL.Eval.Engine (DELETE)" $ do
+    describe "ChuSQL.Engine (DELETE)" $ do
         it "parses DELETE with WHERE" $ do
             parseQuery "DELETE FROM users WHERE age < 18"
                 `shouldBe` Right (Delete "users" (Just (Lt (Col "age") (LitInt 18))))
@@ -403,7 +403,7 @@ main = hspec $ do
     -- ============================================================
     -- Engine: UPDATE
     -- ============================================================
-    describe "ChuSQL.Eval.Engine (UPDATE)" $ do
+    describe "ChuSQL.Engine (UPDATE)" $ do
         it "parses UPDATE with WHERE" $ do
             parseQuery "UPDATE users SET age = 26 WHERE name = 'Alice'"
                 `shouldBe` Right
@@ -495,7 +495,7 @@ main = hspec $ do
     -- ============================================================
     -- Engine: ORDER BY
     -- ============================================================
-    describe "ChuSQL.Eval.Engine (ORDER BY)" $ do
+    describe "ChuSQL.Engine (ORDER BY)" $ do
         it "parses ORDER BY ASC" $ do
             case parseQuery "SELECT name FROM users ORDER BY age ASC" of
                 Right q -> selectOrderBy q `shouldBe` [("age", Asc)]
@@ -583,7 +583,7 @@ main = hspec $ do
     -- ============================================================
     -- Engine: LIMIT
     -- ============================================================
-    describe "ChuSQL.Eval.Engine (LIMIT)" $ do
+    describe "ChuSQL.Engine (LIMIT)" $ do
         it "parses LIMIT" $ do
             case parseQuery "SELECT * FROM users LIMIT 2" of
                 Right q -> selectLimit q `shouldBe` Just 2
@@ -666,7 +666,7 @@ main = hspec $ do
     -- ============================================================
     -- Engine: JOIN
     -- ============================================================
-    describe "ChuSQL.Eval.Engine (JOIN)" $ do
+    describe "ChuSQL.Engine (JOIN)" $ do
         it "executes a two-table JOIN with aliases" $ do
             rowsOf (parseQuery "SELECT u.name, o.product FROM users u JOIN orders o ON u.id = o.user_id" >>= runQuery testDB)
                 `shouldBe` Right
@@ -834,7 +834,7 @@ main = hspec $ do
             case parseQuery "SELECT u.name FROM users u JOIN orders o ON u.id = o.user_id WHERE u.age > 20" of
                 Left err -> expectationFailure err
                 Right q ->
-                    case translate testDB q of
+                    case translate q of
                         Left err -> expectationFailure err
                         Right relOp ->
                             filterPushedIntoLeft (optimize testDB relOp) `shouldBe` True
@@ -843,7 +843,7 @@ main = hspec $ do
             case parseQuery "SELECT * FROM users" of
                 Left err -> expectationFailure err
                 Right q ->
-                    case translate testDB q of
+                    case translate q of
                         Left err -> expectationFailure err
                         Right relOp ->
                             optimize testDB relOp `shouldBe` Scan Nothing "users"
@@ -857,7 +857,7 @@ main = hspec $ do
             case parseQuery "SELECT u.name, o.product FROM users u JOIN orders o ON u.id = o.user_id WHERE u.age > 20" of
                 Left err -> expectationFailure err
                 Right q ->
-                    case translate testDB q of
+                    case translate q of
                         Left err -> expectationFailure err
                         Right relOp ->
                             optimize testDB (optimize testDB relOp) `shouldBe` optimize testDB relOp
@@ -980,6 +980,154 @@ main = hspec $ do
         it "keeps projection with ORDER BY and LIMIT results identical" $ do
             sameResultAsUnoptimized "SELECT u.name FROM users u JOIN orders o ON u.id = o.user_id ORDER BY o.product DESC LIMIT 2"
 
+    -- ============================================================
+    -- Semantic
+    -- ============================================================
+    describe "ChuSQL.Semantic" $ do
+        it "rejects an unknown column in WHERE" $ do
+            (parseQuery "SELECT name FROM users WHERE nope > 18" >>= runQuery testDB)
+                `shouldSatisfy` isLeft
+
+        it "rejects an unknown column in WHERE even when the table is empty" $ do
+            (parseQuery "SELECT name FROM users WHERE nope > 18" >>= runQuery emptyDB)
+                `shouldSatisfy` isLeft
+
+        it "rejects an unknown column in an ON condition" $ do
+            (parseQuery "SELECT u.name FROM users u JOIN orders o ON u.nope = o.user_id" >>= runQuery testDB)
+                `shouldSatisfy` isLeft
+
+        it "rejects a type mismatch inside a comparison" $ do
+            (parseQuery "SELECT name FROM users WHERE name > 18" >>= runQuery testDB)
+                `shouldSatisfy` isLeft
+
+        it "rejects a type mismatch even when the table is empty" $ do
+            (parseQuery "SELECT name FROM users WHERE name > 18" >>= runQuery emptyDB)
+                `shouldSatisfy` isLeft
+
+        it "rejects a WHERE clause that is not a condition" $ do
+            (parseQuery "SELECT name FROM users WHERE age" >>= runQuery testDB)
+                `shouldSatisfy` isLeft
+
+        it "rejects a non-boolean WHERE even when the table is empty" $ do
+            (parseQuery "SELECT name FROM users WHERE age" >>= runQuery emptyDB)
+                `shouldSatisfy` isLeft
+
+        it "rejects comparing two different types with =" $ do
+            (parseQuery "SELECT name FROM users WHERE name = 18" >>= runQuery testDB)
+                `shouldSatisfy` isLeft
+
+        it "rejects an unknown column in INSERT" $ do
+            (parseQuery "INSERT INTO users (nickname) VALUES (1)" >>= runQuery testDB)
+                `shouldSatisfy` isLeft
+
+        it "rejects a value whose type does not match the column" $ do
+            (parseQuery "INSERT INTO users (name, age) VALUES ('Dave', 'abc')" >>= runQuery testDB)
+                `shouldSatisfy` isLeft
+
+        it "rejects an unknown column in UPDATE SET" $ do
+            (parseQuery "UPDATE users SET nope = 1" >>= runQuery testDB)
+                `shouldSatisfy` isLeft
+
+        it "rejects an unknown column in DELETE WHERE" $ do
+            (parseQuery "DELETE FROM users WHERE nope > 1" >>= runQuery testDB)
+                `shouldSatisfy` isLeft
+
+        it "still accepts a valid query" $ do
+            rowsOf (parseQuery "SELECT name FROM users WHERE age > 18" >>= runQuery testDB)
+                `shouldBe` Right
+                    [ [("name", VStr "Alice")]
+                    , [("name", VStr "Carol")]
+                    ]
+
+        it "rejects an UPDATE whose value has the wrong type" $ do
+            (parseQuery "UPDATE users SET age = 'abc'" >>= runQuery testDB)
+                `shouldSatisfy` isLeft
+
+        it "rejects a type mismatch in an ON condition" $ do
+            (parseQuery "SELECT u.name FROM users u JOIN orders o ON u.name = o.user_id" >>= runQuery testDB)
+                `shouldSatisfy` isLeft
+
+        it "rejects an unknown column in DELETE WHERE even when the table is empty" $ do
+            (parseQuery "DELETE FROM users WHERE nope > 1" >>= runQuery emptyDB)
+                `shouldSatisfy` isLeft
+
+        it "rejects an unknown column in UPDATE SET even when the table is empty" $ do
+            (parseQuery "UPDATE users SET nope = 1" >>= runQuery emptyDB)
+                `shouldSatisfy` isLeft
+
+        it "currently allows an INSERT that leaves a column out (known gap)" $ do
+            (parseQuery "INSERT INTO users (name) VALUES ('Eve')" >>= runQuery testDB)
+                `shouldSatisfy` isRight
+
+        it "says which clause is wrong and which columns are available" $ do
+            case parseQuery "SELECT name FROM users WHERE nope > 18" >>= runQuery testDB of
+                Right _ -> expectationFailure "expected a Left"
+                Left err -> do
+                    err `shouldContain` "unknown column in WHERE"
+                    err `shouldContain` "available: id, name, age"
+
+        it "names INSERT when a target column does not exist" $ do
+            case parseQuery "INSERT INTO users (nickname) VALUES (1)" >>= runQuery testDB of
+                Right _ -> expectationFailure "expected a Left"
+                Left err -> err `shouldContain` "unknown column in INSERT"
+
+        it "names ORDER BY when a sort key does not exist" $ do
+            case parseQuery "SELECT name FROM users ORDER BY nope" >>= runQuery testDB of
+                Right _ -> expectationFailure "expected a Left"
+                Left err -> err `shouldContain` "unknown column in ORDER BY"
+
+        it "names ON and both types when a join condition mismatches" $ do
+            case parseQuery "SELECT u.name FROM users u JOIN orders o ON u.name = o.user_id" >>= runQuery testDB of
+                Right _ -> expectationFailure "expected a Left"
+                Left err -> do
+                    err `shouldContain` "ON: both sides of ="
+                    err `shouldContain` "TStr and TInt"
+
+        it "names the column and the expected type when an assignment has the wrong type" $ do
+            case parseQuery "UPDATE users SET age = 'abc'" >>= runQuery testDB of
+                Right _ -> expectationFailure "expected a Left"
+                Left err -> err `shouldContain` "UPDATE: column age needs TInt, got TStr"
+
+        it "accepts SELECT * across a join (the sentinel is not a column)" $ do
+            (parseQuery "SELECT * FROM users u JOIN orders o ON u.id = o.user_id" >>= runQuery testDB)
+                `shouldSatisfy` isRight
+
+    -- ============================================================
+    -- Op
+    -- ============================================================
+    describe "ChuSQL.Algebra.Op" $ do
+        it "renders a plan as indented text" $ do
+            case parseQuery "SELECT name FROM users WHERE age > 18" >>= translate of
+                Left err -> expectationFailure err
+                Right plan ->
+                    renderPlan plan
+                        `shouldBe` "Project [\"name\"]\n  Filter Gt (Col \"age\") (LitInt 18)\n    Scan Nothing \"users\""
+
+        it "renders a join plan with indentation" $ do
+            case parseQuery "SELECT u.name FROM users u JOIN orders o ON u.id = o.user_id" >>= translate of
+                Left err -> expectationFailure err
+                Right plan ->
+                    lines (renderPlan plan)
+                        `shouldBe` [ "Project [\"u.name\"]"
+                                   , "  Join on Eq (Col \"u.id\") (Col \"o.user_id\")"
+                                   , "    Scan Just \"u\" \"users\""
+                                   , "    Scan Just \"o\" \"orders\""
+                                   ]
+
+        it "renders a sort and limit plan" $ do
+            case parseQuery "SELECT name FROM users ORDER BY age DESC LIMIT 2" >>= translate of
+                Left err -> expectationFailure err
+                Right plan ->
+                    lines (renderPlan plan)
+                        `shouldBe` [ "Project [\"name\"]"
+                                   , "  Limit 2"
+                                   , "    Sort [(\"age\",Desc)]"
+                                   , "      Scan Nothing \"users\""
+                                   ]
+
+emptyDB :: Database
+emptyDB = [(n, t {tableRows = []}) | (n, t) <- testDB]
+
 -- ============================================================
 -- Helpers
 -- ============================================================
@@ -987,15 +1135,16 @@ isLeft :: Either a b -> Bool
 isLeft (Left _) = True
 isLeft (Right _) = False
 
-rowsOf :: Either String (Database, [Row]) -> Either String [Row]
-rowsOf = fmap snd
+isRight :: Either a b -> Bool
+isRight (Right _) = True
+isRight (Left _) = False
 
 sameResultAsUnoptimized :: String -> Expectation
 sameResultAsUnoptimized sql =
     case parseQuery sql of
         Left err -> expectationFailure err
         Right q ->
-            case translate testDB q of
+            case translate q of
                 Left err -> expectationFailure err
                 Right relOp ->
                     evalRelOp testDB (optimize testDB relOp) `shouldBe` evalRelOp testDB relOp
@@ -1007,7 +1156,7 @@ filterPushedIntoLeft _ = False
 optimizedPlan :: String -> Either String RelOp
 optimizedPlan sql = do
     q <- parseQuery sql
-    optimize testDB <$> translate testDB q
+    optimize testDB <$> translate q
 
 firstFilterCond :: RelOp -> Maybe Expr
 firstFilterCond (Filter p _) = Just p
@@ -1038,7 +1187,7 @@ stripProjects (Scan a t) = Scan a t
 projectedPlan :: String -> Either String RelOp
 projectedPlan sql = do
     q <- parseQuery sql
-    plan <- translate testDB q
+    plan <- translate q
     Right (pushProject testDB ["*"] plan)
 
 sideCols :: RelOp -> Maybe [String]