diff --git a/README.md b/README.md index 4dd907b..83eeb63 100644 --- a/README.md +++ b/README.md @@ -17,6 +17,7 @@ 作为函数式编程语言,从语言层面契合SQL语句解析和代数数学运算,同时有强大的类型安全系统。 - SQL词法分析、AST +- 语义分析:表/列存在性与类型检查(执行前的关卡) - 事务处理 - 查询优化、内存表管理 - 关系代数运算 @@ -41,22 +42,6 @@ > 如果找到了较好的Rust+Haskell集成方法也会及时替换 -# 代码规模 - -| 语言 / 类别 | 文件数 | 行数 | 说明 | -| --------------- | -----: | -------: | --------------------------------------------------------------- | -| Haskell(引擎) | 11 | 902 | `chusql-engine/src/` 10 个模块 + `app/Main.hs` | -| Haskell(测试) | 1 | 1058 | `test/Spec.hs`,124 条用例 | -| Haskell(基准) | 1 | 118 | `benchmark/chusql-engine/src/Main.hs` | -| Rust | 0 | 0 | `chusql-storage/` 尚未开工 | -| 前端 | 0 | 0 | `chusql-web/` 尚未开工 | -| Markdown 文档 | 6 | 1456 | `README.md` + `docs/` 3 篇 + `benchmark/` 2 篇 | -| 构建 / 配置 | 9 | 231 | cabal、`stack.yaml(.lock)`、`tasks.json`、`.gitignore`、LICENSE | -| 项目计划 | 1 | 368 | `chusql-engine/projectplan.txt` | -| **合计** | **29** | **4133** | 另有 3 个 `.gitkeep` 占位文件未计入 | - -> 最近更新:2026-09-19 - # 性能基准 **测试环境**:Windows / GHC 9.10.3 / `-O2` @@ -65,9 +50,9 @@ | 查询 | 结果行数 | 未优化 | 优化后 | 加速 | | ------------------------------------------ | -------: | -------: | ----------: | --------: | -| `JOIN` + `WHERE u.age > 90` | 45 | 125.0 ms | **7.1 ms** | **17.7x** | -| `JOIN`(无 WHERE,只有投影) | 500 | 132.8 ms | 105.5 ms | 1.3x | -| `JOIN` + `WHERE` + `ORDER BY` + `LIMIT 10` | 10 | 171.9 ms | **10.3 ms** | **16.8x** | -| 单表 `WHERE age > 90`(对照组) | 45 | 0.111 ms | 0.153 ms | 0.7x | +| `JOIN` + `WHERE u.age > 90` | 45 | 242.2 ms | **16.6 ms** | **14.6x** | +| `JOIN`(无 WHERE,只有投影) | 500 | 210.9 ms | 195.3 ms | 1.1x | +| `JOIN` + `WHERE` + `ORDER BY` + `LIMIT 10` | 10 | 164.1 ms | **14.2 ms** | **11.6x** | +| 单表 `WHERE age > 90`(对照组) | 45 | 0.175 ms | 0.290 ms | 0.6x | -> 最近更新:2026-09-19 +> 最近更新:2026-09-22(绝对值受机器状态影响,倍率更稳定;同机同法可复现) diff --git a/benchmark/chusql-engine/src/Main.hs b/benchmark/chusql-engine/src/Main.hs index 646b0b5..7222914 100644 --- a/benchmark/chusql-engine/src/Main.hs +++ b/benchmark/chusql-engine/src/Main.hs @@ -4,8 +4,9 @@ import ChuSQL.Algebra.Eval (evalRelOp) import ChuSQL.Algebra.Optimize (optimize) import ChuSQL.Algebra.Planner (translate) import ChuSQL.Model -import ChuSQL.SQLSyntax.Parser (parseQuery) +import ChuSQL.Syntax.Parser (parseQuery) import Control.Exception (evaluate) +import Data.IORef (IORef, newIORef, readIORef) import System.CPUTime (getCPUTime) import System.Environment (getArgs) import Text.Printf (printf) @@ -14,7 +15,7 @@ mkUsers :: Int -> Table mkUsers n = Table { tableName = "users" - , tableCols = ["id", "name", "age"] + , tableCols = [("id", TInt), ("name", TStr), ("age", TInt)] , tableRows = [ [("id", VInt i), ("name", VStr ("user" ++ show i)), ("age", VInt (i `mod` 100))] | i <- [1 .. n] @@ -25,7 +26,7 @@ mkOrders :: Int -> Int -> Table mkOrders n m = Table { tableName = "orders" - , tableCols = ["id", "user_id", "product"] + , tableCols = [("id", TInt), ("user_id", TInt), ("product", TStr)] , tableRows = [ [("id", VInt j), ("user_id", VInt (1 + (j - 1) `mod` n)), ("product", VStr ("item" ++ show (j `mod` 50)))] | j <- [1 .. m] @@ -43,17 +44,21 @@ rowCount :: Either String [Row] -> Int rowCount (Left _) = -1 rowCount (Right rows) = length rows -runOnce :: Database -> String -> Bool -> IO Int -runOnce db sql useOpt = do - let result = case parseQuery sql >>= translate db of +-- salt 是从 IORef 里读出来的:有了这个"IO 里来的"依赖,GHC 就没法把整段纯计算 +-- 提到循环外只算一次 —— 否则批量计时会把 1 次的开销除以 k,测出 0.000 ms 这种假数据 +runOnce :: IORef String -> Database -> String -> Bool -> IO Int +runOnce saltRef db sql useOpt = do + salt <- readIORef saltRef + let result = case parseQuery (sql ++ salt) >>= translate of Left e -> Left e Right plan -> evalRelOp db (if useOpt then optimize db plan else plan) forced <- evaluate (checksum result) return forced -resultRows :: Database -> String -> Bool -> IO Int -resultRows db sql useOpt = do - let result = case parseQuery sql >>= translate db of +resultRows :: IORef String -> Database -> String -> Bool -> IO Int +resultRows saltRef db sql useOpt = do + salt <- readIORef saltRef + let result = case parseQuery (sql ++ salt) >>= translate of Left e -> Left e Right plan -> evalRelOp db (if useOpt then optimize db plan else plan) _ <- evaluate (checksum result) @@ -73,12 +78,12 @@ benchOp target act = loop 1 t <- timed (mapM_ (const act) [1 .. k]) if t < target then loop (k * 2) else return (t / fromIntegral k, k) -report :: Database -> Double -> String -> IO () -report db target sql = do - nUn <- resultRows db sql False - nOp <- resultRows db sql True - (tUn, kUn) <- benchOp target (runOnce db sql False) - (tOp, kOp) <- benchOp target (runOnce db sql True) +report :: IORef String -> Database -> Double -> String -> IO () +report saltRef db target sql = do + nUn <- resultRows saltRef db sql False + nOp <- resultRows saltRef db sql True + (tUn, kUn) <- benchOp target (runOnce saltRef db sql False) + (tOp, kOp) <- benchOp target (runOnce saltRef db sql True) let speedup = if tOp <= 0 then 0 else tUn / tOp mismatch = if nUn == nOp then "" else " <<< 结果不一致!" printf "%s\n" sql @@ -113,6 +118,7 @@ main = do printf "数据规模:users = %d 行,orders = %d 行\n" n m printf "计时方式:CPU 时间;每个用例自动加倍批量次数,直到一批累计耗时超过 %.2f 秒,再折算成单次耗时\n" target printf "(先跑一遍预热,避免把首次构造数据的开销算进去)\n\n" - _ <- runOnce db warmupSql False - _ <- runOnce db warmupSql True - mapM_ (report db target) queries + saltRef <- newIORef "" + _ <- runOnce saltRef db warmupSql False + _ <- runOnce saltRef db warmupSql True + mapM_ (report saltRef db target) queries diff --git a/chusql-engine/app/Main.hs b/chusql-engine/app/Main.hs index 613428c..0afccac 100644 --- a/chusql-engine/app/Main.hs +++ b/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) ' ' diff --git a/chusql-engine/chusql-engine.cabal b/chusql-engine/chusql-engine.cabal index 2ce1c25..41069e4 100644 --- a/chusql-engine/chusql-engine.cabal +++ b/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 diff --git a/chusql-engine/src/ChuSQL/Algebra/Eval.hs b/chusql-engine/src/ChuSQL/Algebra/Eval.hs index 77cf55d..0bddc5e 100644 --- a/chusql-engine/src/ChuSQL/Algebra/Eval.hs +++ b/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 diff --git a/chusql-engine/src/ChuSQL/SQLSyntax/Expr.hs b/chusql-engine/src/ChuSQL/Algebra/Expr.hs similarity index 77% rename from chusql-engine/src/ChuSQL/SQLSyntax/Expr.hs rename to chusql-engine/src/ChuSQL/Algebra/Expr.hs index e9fc0f7..0fc7955 100644 --- a/chusql-engine/src/ChuSQL/SQLSyntax/Expr.hs +++ b/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 diff --git a/chusql-engine/src/ChuSQL/Algebra/Op.hs b/chusql-engine/src/ChuSQL/Algebra/Op.hs index 1fe58d0..77315af 100644 --- a/chusql-engine/src/ChuSQL/Algebra/Op.hs +++ b/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) ' ' diff --git a/chusql-engine/src/ChuSQL/Algebra/Optimize.hs b/chusql-engine/src/ChuSQL/Algebra/Optimize.hs index 765c13c..10efcf2 100644 --- a/chusql-engine/src/ChuSQL/Algebra/Optimize.hs +++ b/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 diff --git a/chusql-engine/src/ChuSQL/Algebra/Planner.hs b/chusql-engine/src/ChuSQL/Algebra/Planner.hs index f12dd85..8f645a2 100644 --- a/chusql-engine/src/ChuSQL/Algebra/Planner.hs +++ b/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 diff --git a/chusql-engine/src/ChuSQL/SQLSyntax/Sort.hs b/chusql-engine/src/ChuSQL/Algebra/Sort.hs similarity index 93% rename from chusql-engine/src/ChuSQL/SQLSyntax/Sort.hs rename to chusql-engine/src/ChuSQL/Algebra/Sort.hs index 313cc4d..6e1bc08 100644 --- a/chusql-engine/src/ChuSQL/SQLSyntax/Sort.hs +++ b/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) -- | 反向排序 diff --git a/chusql-engine/src/ChuSQL/SQLSyntax/Executor.hs b/chusql-engine/src/ChuSQL/Engine.hs similarity index 53% rename from chusql-engine/src/ChuSQL/SQLSyntax/Executor.hs rename to chusql-engine/src/ChuSQL/Engine.hs index 8320220..8f987dc 100644 --- a/chusql-engine/src/ChuSQL/SQLSyntax/Executor.hs +++ b/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 diff --git a/chusql-engine/src/ChuSQL/Model.hs b/chusql-engine/src/ChuSQL/Model.hs index f711635..6b11f30 100644 --- a/chusql-engine/src/ChuSQL/Model.hs +++ b/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 = "*" diff --git a/chusql-engine/src/ChuSQL/Semantic.hs b/chusql-engine/src/ChuSQL/Semantic.hs new file mode 100644 index 0000000..d65c7b0 --- /dev/null +++ b/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 diff --git a/chusql-engine/src/ChuSQL/SQLSyntax/AST.hs b/chusql-engine/src/ChuSQL/Syntax/AST.hs similarity index 91% rename from chusql-engine/src/ChuSQL/SQLSyntax/AST.hs rename to chusql-engine/src/ChuSQL/Syntax/AST.hs index 93417ef..dedfea8 100644 --- a/chusql-engine/src/ChuSQL/SQLSyntax/AST.hs +++ b/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 diff --git a/chusql-engine/src/ChuSQL/SQLSyntax/Parser.hs b/chusql-engine/src/ChuSQL/Syntax/Parser.hs similarity index 96% rename from chusql-engine/src/ChuSQL/SQLSyntax/Parser.hs rename to chusql-engine/src/ChuSQL/Syntax/Parser.hs index f43b7d0..6e44ac1 100644 --- a/chusql-engine/src/ChuSQL/SQLSyntax/Parser.hs +++ b/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) diff --git a/chusql-engine/test/Spec.hs b/chusql-engine/test/Spec.hs index 436bd22..619b9c2 100644 --- a/chusql-engine/test/Spec.hs +++ b/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] diff --git a/docs/INTRODUCTION.md b/docs/INTRODUCTION.md deleted file mode 100644 index 1981ebe..0000000 --- a/docs/INTRODUCTION.md +++ /dev/null @@ -1,87 +0,0 @@ -# 实现要点 - -完整的实现原理相对复杂,故不多赘述,这里阐述一些关键的实现要点 - -## Haskell -- 处理引擎 - -### 词法分析 - -词法层与语法层同处 `chusql-engine/src/ChuSQL/SQLSyntax/Parser.hs`,基于 **megaparsec** 实现。解析器类型为 - -```haskell -type Parser = Parsec Void String -``` - -即输入是 `String`,词法错误类型取 `Void`(不自定义错误类型),失败信息统一由 `errorBundlePretty` 渲染成人可读的报文。 - -#### 空白与词法单元骨架 - -| 组合子 | 定义 | 作用 | -| -------- | ------------------------------ | ------------------------------------ | -| `sc` | `Lxr.space space1 empty empty` | 跳过空白(含换行);暂不解析注释 | -| `lexeme` | `Lxr.lexeme sc` | 解析一个词法单元,并吃掉其后的空白 | -| `symbol` | `Lxr.symbol sc` | 固定符号 `*` `,` `=` `>` `<` `(` `)` | - -所有词法单元都从 `lexeme` 出口,游标返回时必定停在下一个 token 的起始位置,因此语法层不需要感知空白。 - -#### 已实现的 token - -| token | 组合子 | 词法规则 | 例 | -| -------- | ------------ | ------------------------------------------ | ------------------------ | -| 关键字 | `keyword` | 大小写不敏感;其后不能紧跟标识符字符 | `SELECT` / `select` | -| 标识符 | `identifier` | 首字符为字母或 `_`,其后为字母、数字或 `_` | `users`、`user1`、`_tmp` | -| 整数 | `integer` | 十进制,委托 `Lxr.decimal` | `18` | -| 字符串 | `stringLit` | 单引号包裹,遵循标准 SQL 转义 | `'Alice'` | -| 符号 | `symbol` | 字面匹配 | `>`、`(` | -| 排序方向 | `sortDir` | `ASC` / `DESC`,缺省 `Asc` | `DESC` | - -目前已接入语法的关键字:`SELECT`、`FROM`、`WHERE`、`ORDER`、`BY`、`LIMIT`、`AND`、`OR`、`ASC`、`DESC`、`INSERT`、`INTO`、`VALUES`、`DELETE`、`UPDATE`、`SET`。 - -#### 三个关键实现点 - -**1. 关键字要防前缀** - -`keyword` 匹配完关键字后追加 `notFollowedBy (satisfy isIdentChar)`,否则 `selection` 会被读成 `SELECT`、`fromage` 会被读成 `FROM`。 - -**2. 关键字必须可回溯(`try`)** - -```haskell -keyword k = lexeme $ try $ do - _ <- string' k - notFollowedBy (satisfy isIdentChar) -``` - -`string'` 大小写不敏感,匹配 `ORDER` 时会先吃掉前两个字符 `OR`;紧接着的前缀守卫因为遇到 `D` 而失败,此时输入已被消耗,这个失败就成了**已消耗失败**,调用方的 `many`(`AND` / `OR` 运算符层)不会回溯而是直接报错: - -```text -SELECT name FROM users WHERE age > 18 ORDER BY age DESC - ^ unexpected 'D' -``` - -把整个 `keyword` 用 `try` 包住,失败即复位,`ORDER BY` 才能被后续子句正常识别。这同时消掉了一整类隐患:任何以 `AND` / `OR` 为前缀的子句关键字跟在表达式后面都不会再炸。 - -**3. 字符串字面量不能用 `manyTill`** - -`manyTill p end` 每一步都先尝试结束符,`'It''s ok'` 会在 `''` 的第一个引号处提前收尾。正确做法是先读内容、再吃结尾引号: - -```haskell -stringLit = lexeme $ do - _ <- char '\'' - s <- many stringChar - _ <- char '\'' - return s - -stringChar = choice [ '\'' <$ try (string "''"), satisfy (/= '\'') ] -``` - -`stringChar` 的两个分支在失败时都不消耗输入,因此可以安全地放进 `many`。 - -#### 字符串字面量与标准 SQL 转义 - -| 写法 | 含义 | -| --------- | ------------------------------------------------------- | -| `'it''s'` | `''` 折叠为一个单引号,值为 `it's` | -| `'a\b'` | 反斜杠是普通字符,值为 `a\b`(**不**做 `\n`/`\t` 转义) | -| `''` | 空字符串 | -| `''''` | 只含一个单引号的字符串 | -| `'oops` | 未闭合,解析失败 |