完成语义检查，整理项目

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)