量词比较
This commit is contained in:
LIm1tZz7 committed
1 parent
9b1c835202
commit
7d96933e32
15 files changed
+185
-15
No files matched your search
@@ -1,7 +1,7 @@
|
||||
module ChuSQL.Core.Engine.Algebra.Eval (evalRelOp, evalRelOpM, evalExprM, evalCondForRowM) where
|
||||
|
||||
import ChuSQL.Core.Engine.Algebra.Cost (tableMetaOf)
|
||||
import ChuSQL.Core.Engine.Algebra.Expr (evalCondForRow, evalExpr)
|
||||
import ChuSQL.Core.Engine.Algebra.Expr (evalCondForRow, evalExpr, quantifiedCompare)
|
||||
import ChuSQL.Core.Engine.Algebra.Optimize (optimize)
|
||||
import ChuSQL.Core.Engine.Algebra.Op
|
||||
import ChuSQL.Core.Engine.Algebra.Planner (translate)
|
||||
@@ -312,6 +312,14 @@ substSubqueries db e env = case e of
|
||||
ExistsSub sq negated -> do
|
||||
rows <- runSubqueryRows db sq env
|
||||
pure (fmap (\rs -> LitBool (if negated then null rs else not (null rs))) rows)
|
||||
QuantCmp op a sq q -> do
|
||||
lhs <- substSubqueries db a env
|
||||
rows <- runSubqueryRows db sq env
|
||||
pure (do
|
||||
a' <- lhs
|
||||
rs <- rows
|
||||
vs <- mapM rowValue rs
|
||||
Right (quantifiedCompare op a' (map valueLiteral vs) q))
|
||||
InList a es negated -> do
|
||||
lhs <- substSubqueries db a env
|
||||
es' <- mapM (\x -> substSubqueries db x env) es
|
||||
|
||||
@@ -1,8 +1,8 @@
|
||||
module ChuSQL.Core.Engine.Algebra.Expr (evalExpr, evalCondForRow, colsInExpr, aggregatesIn, hasAggregate, bareColumns, hasSubquery, hasDivision, inValues, threeValuedNot) where
|
||||
module ChuSQL.Core.Engine.Algebra.Expr (evalExpr, evalCondForRow, colsInExpr, aggregatesIn, hasAggregate, bareColumns, hasSubquery, hasDivision, inValues, threeValuedNot, quantifiedCompare) where
|
||||
|
||||
import ChuSQL.Core.Model
|
||||
import ChuSQL.Core.Engine.Syntax.AST
|
||||
import ChuSQL.Core.Engine.Builtin (Operator (..), executeOperator, inValues, threeValuedNot)
|
||||
import ChuSQL.Core.Engine.Builtin (Operator (..), compareNode, executeOperator, inValues, threeValuedNot)
|
||||
|
||||
-- 表达式求值：三值逻辑，NULL 参与运算结果仍是 NULL。
|
||||
|
||||
@@ -47,12 +47,19 @@ evalExpr (InList a es negated) row = do
|
||||
evalExpr (ScalarSub _) _ = Left subqueryNeedsDatabase
|
||||
evalExpr (InSub _ _ _) _ = Left subqueryNeedsDatabase
|
||||
evalExpr (ExistsSub _ _) _ = Left subqueryNeedsDatabase
|
||||
evalExpr (QuantCmp _ _ _ _) _ = Left subqueryNeedsDatabase
|
||||
evalExpr agg _ = Left ("aggregate functions are not allowed here: " ++ show agg)
|
||||
|
||||
-- | 子查询要连上存储才能跑
|
||||
subqueryNeedsDatabase :: String
|
||||
subqueryNeedsDatabase = "subquery needs a database to run"
|
||||
|
||||
-- | 量词比较摊成 AND / OR 链
|
||||
quantifiedCompare :: CompareOp -> Expr -> [Expr] -> Quantifier -> Expr
|
||||
quantifiedCompare op lhs vs q = case vs of
|
||||
[] -> LitBool (q == AllQ)
|
||||
_ -> foldr1 (if q == AllQ then And else Or) (map (compareNode op lhs) vs)
|
||||
|
||||
-- | 表达式用到了哪些列
|
||||
colsInExpr :: Expr -> [String]
|
||||
colsInExpr (Col c) = [c]
|
||||
@@ -80,6 +87,7 @@ colsInExpr (ScalarSub sq) = subqueryRefs sq
|
||||
colsInExpr (InSub a sq _) = colsInExpr a ++ subqueryRefs sq
|
||||
colsInExpr (InList a es _) = colsInExpr a ++ concatMap colsInExpr es
|
||||
colsInExpr (ExistsSub sq _) = subqueryRefs sq
|
||||
colsInExpr (QuantCmp _ a sq _) = colsInExpr a ++ subqueryRefs sq
|
||||
colsInExpr _ = []
|
||||
|
||||
-- | 表达式里有没有除法（除法可能报错，不能提前或延后求值）
|
||||
@@ -98,6 +106,7 @@ hasDivision e = case e of
|
||||
NotEq a b -> both a b
|
||||
And a b -> both a b
|
||||
Or a b -> both a b
|
||||
QuantCmp _ a _ _ -> hasDivision a
|
||||
_ -> False
|
||||
where
|
||||
-- | 两个子表达式里任意一个有除法
|
||||
@@ -110,6 +119,7 @@ hasSubquery e = case e of
|
||||
InSub _ _ _ -> True
|
||||
InList a es _ -> any hasSubquery (a : es)
|
||||
ExistsSub _ _ -> True
|
||||
QuantCmp _ _ _ _ -> True
|
||||
Add a b -> both a b
|
||||
Sub a b -> both a b
|
||||
Mul a b -> both a b
|
||||
@@ -144,6 +154,7 @@ aggregatesIn e = case e of
|
||||
a@(AvgOf _) -> [a]
|
||||
a@(MinOf _) -> [a]
|
||||
a@(MaxOf _) -> [a]
|
||||
QuantCmp _ a _ _ -> aggregatesIn a
|
||||
Add a b -> both a b
|
||||
Sub a b -> both a b
|
||||
Mul a b -> both a b
|
||||
@@ -191,6 +202,7 @@ bareColumns e = case e of
|
||||
InSub a sq _ -> bareColumns a ++ subqueryRefs sq
|
||||
InList a es _ -> bareColumns a ++ concatMap bareColumns es
|
||||
ExistsSub sq _ -> subqueryRefs sq
|
||||
QuantCmp _ a sq _ -> bareColumns a ++ subqueryRefs sq
|
||||
_ -> []
|
||||
where
|
||||
-- | 两个子表达式的裸列拼起来
|
||||
|
||||
@@ -65,6 +65,7 @@ scaleRows db p x rows = case p of
|
||||
GtE _ _ -> quarter
|
||||
LtE _ _ -> quarter
|
||||
NotEq _ _ -> quarter
|
||||
QuantCmp _ _ _ _ -> quarter
|
||||
And a b -> max 1 (min (scaleRows db a x rows) (scaleRows db b x rows))
|
||||
_ -> quarter
|
||||
where
|
||||
|
||||
@@ -147,6 +147,7 @@ foldConstants (Eq a b) = foldNode (Eq (foldConstants a) (foldConstants b))
|
||||
foldConstants (GtE a b) = foldNode (GtE (foldConstants a) (foldConstants b))
|
||||
foldConstants (LtE a b) = foldNode (LtE (foldConstants a) (foldConstants b))
|
||||
foldConstants (NotEq a b) = foldNode (NotEq (foldConstants a) (foldConstants b))
|
||||
foldConstants (QuantCmp op a sq q) = QuantCmp op (foldConstants a) sq q
|
||||
foldConstants (And a b) = foldNode (And (foldConstants a) (foldConstants b))
|
||||
foldConstants (Or a b) = foldNode (Or (foldConstants a) (foldConstants b))
|
||||
foldConstants e = e
|
||||
|
||||
@@ -47,6 +47,7 @@ rewriteAggs aggs e = case [label | (label, agg) <- aggs, agg == e] of
|
||||
GtE a b -> GtE (go a) (go b)
|
||||
LtE a b -> LtE (go a) (go b)
|
||||
NotEq a b -> NotEq (go a) (go b)
|
||||
QuantCmp op a sq q -> QuantCmp op (go a) sq q
|
||||
And a b -> And (go a) (go b)
|
||||
Or a b -> Or (go a) (go b)
|
||||
IsNull a -> IsNull (go a)
|
||||
|
||||
@@ -11,13 +11,15 @@ module ChuSQL.Core.Engine.Builtin
|
||||
, Operator (..)
|
||||
, operatorOfExpr
|
||||
, operatorSymbol
|
||||
, operatorOfCompare
|
||||
, compareNode
|
||||
, executeOperator
|
||||
, threeValuedNot
|
||||
, inValues
|
||||
) where
|
||||
|
||||
import ChuSQL.Core.Model (Value (..), compareValue)
|
||||
import ChuSQL.Core.Engine.Syntax.AST (Expr (..))
|
||||
import ChuSQL.Core.Engine.Syntax.AST (CompareOp (..), Expr (..))
|
||||
import Control.Monad (foldM)
|
||||
import Data.Char (toLower)
|
||||
|
||||
@@ -177,6 +179,24 @@ operatorOfExpr (And _ _) = Just OpAnd
|
||||
operatorOfExpr (Or _ _) = Just OpOr
|
||||
operatorOfExpr _ = Nothing
|
||||
|
||||
-- | 量词比较里的比较运算符
|
||||
operatorOfCompare :: CompareOp -> Operator
|
||||
operatorOfCompare CmpEq = OpEq
|
||||
operatorOfCompare CmpNe = OpNe
|
||||
operatorOfCompare CmpGt = OpGt
|
||||
operatorOfCompare CmpGtE = OpGtE
|
||||
operatorOfCompare CmpLt = OpLt
|
||||
operatorOfCompare CmpLtE = OpLtE
|
||||
|
||||
-- | 量词比较在字面量上的节点
|
||||
compareNode :: CompareOp -> Expr -> Expr -> Expr
|
||||
compareNode CmpEq = Eq
|
||||
compareNode CmpNe = NotEq
|
||||
compareNode CmpGt = Gt
|
||||
compareNode CmpGtE = GtE
|
||||
compareNode CmpLt = Lt
|
||||
compareNode CmpLtE = LtE
|
||||
|
||||
-- | 运算符求值：算错个数是内部错误
|
||||
executeOperator :: Operator -> [Value] -> Either String Value
|
||||
executeOperator op vs = case (op, vs) of
|
||||
|
||||
@@ -177,6 +177,19 @@ inferExpr db place env (InList a es _) = do
|
||||
mapM_ (itemType place ta) ts
|
||||
Right (InferType CBool)
|
||||
inferExpr _ _ _ (ExistsSub _ _) = Right (InferType CBool)
|
||||
inferExpr db place env (QuantCmp _ a sq q) = do
|
||||
ta <- inferExpr db place env a
|
||||
cols <- inferSubqueryOutput db env sq
|
||||
case cols of
|
||||
[(_, t)]
|
||||
| compatible ta t -> Right (InferType CBool)
|
||||
| otherwise -> Left (place ++ ": " ++ quantLabel q ++ " subquery column has type " ++ renderType t ++ ", expected " ++ renderType ta)
|
||||
_ -> Left (place ++ ": " ++ quantLabel q ++ " subquery must return exactly one column")
|
||||
|
||||
-- | 量词在错误文本里的名字
|
||||
quantLabel :: Quantifier -> String
|
||||
quantLabel AnyQ = "ANY"
|
||||
quantLabel AllQ = "ALL"
|
||||
|
||||
-- | IN 列表里的每一项都要跟左边的类型对得上
|
||||
itemType :: String -> InferredType -> InferredType -> Either String ()
|
||||
@@ -617,6 +630,7 @@ resolveExpr db env outer f e = case e of
|
||||
InSub a sq negated -> InSub <$> resolveExpr db env outer f a <*> resolveSubquery db (env ++ outer) sq <*> pure negated
|
||||
InList a es negated -> InList <$> resolveExpr db env outer f a <*> mapM (resolveExpr db env outer f) es <*> pure negated
|
||||
ExistsSub sq negated -> ExistsSub <$> resolveSubquery db (env ++ outer) sq <*> pure negated
|
||||
QuantCmp op a sq q -> QuantCmp op <$> resolveExpr db env outer f a <*> resolveSubquery db (env ++ outer) sq <*> pure q
|
||||
_ -> Right e
|
||||
where
|
||||
-- | 递归处理两个子表达式
|
||||
|
||||
@@ -1,4 +1,4 @@
|
||||
module ChuSQL.Core.Engine.Syntax.AST (Statement (..), FromClause (..), JoinKind (..), Expr (..), Subquery (..), SortDir (..), makeSelect) where
|
||||
module ChuSQL.Core.Engine.Syntax.AST (Statement (..), FromClause (..), JoinKind (..), Expr (..), Subquery (..), Quantifier (..), CompareOp (..), SortDir (..), makeSelect) where
|
||||
|
||||
import ChuSQL.Core.Model (Column (..), ColumnType, Value (..))
|
||||
|
||||
@@ -88,6 +88,22 @@ data Subquery = Subquery
|
||||
}
|
||||
deriving (Show, Eq)
|
||||
|
||||
-- | 量词：ANY 至少一行成立，ALL 每一行都成立
|
||||
data Quantifier
|
||||
= AnyQ
|
||||
| AllQ
|
||||
deriving (Show, Eq)
|
||||
|
||||
-- | 量词比较里的比较运算符
|
||||
data CompareOp
|
||||
= CmpEq
|
||||
| CmpNe
|
||||
| CmpGt
|
||||
| CmpGtE
|
||||
| CmpLt
|
||||
| CmpLtE
|
||||
deriving (Show, Eq)
|
||||
|
||||
-- | 条件表达式：列、字面量、算术、比较、逻辑、聚合与子查询
|
||||
data Expr
|
||||
= Col String
|
||||
@@ -124,6 +140,7 @@ data Expr
|
||||
| InSub Expr Subquery Bool
|
||||
| InList Expr [Expr] Bool
|
||||
| ExistsSub Subquery Bool
|
||||
| QuantCmp CompareOp Expr Subquery Quantifier
|
||||
deriving (Show, Eq)
|
||||
|
||||
-- | 排序方向：升序或降序
|
||||
|
||||
@@ -3,7 +3,7 @@
|
||||
module ChuSQL.Core.Engine.Syntax.Parser (parseStatement, parseExpression) where
|
||||
|
||||
import ChuSQL.Core.Model (Column (..), ColumnType (..), Value (..), plainColumn)
|
||||
import ChuSQL.Core.Engine.Builtin (Builtin (..), builtinName, builtinNames, builtinNode)
|
||||
import ChuSQL.Core.Engine.Builtin (Builtin (..), builtinName, builtinNames, builtinNode, compareNode)
|
||||
import ChuSQL.Core.Engine.Syntax.AST
|
||||
import Control.Monad (void)
|
||||
import Control.Monad.Combinators.Expr (Operator (..), makeExprParser)
|
||||
@@ -112,14 +112,9 @@ operatorTable =
|
||||
[ [Prefix (Neg <$ symbol "-")]
|
||||
, [InfixL (Mul <$ symbol "*"), InfixL (Div <$ symbol "/")]
|
||||
, [InfixL (Add <$ symbol "+"), InfixL (Sub <$ symbol "-")]
|
||||
, [ InfixN (NotEq <$ try (symbol "<>" <|> symbol "!="))
|
||||
, InfixN (GtE <$ try (symbol ">="))
|
||||
, InfixN (LtE <$ try (symbol "<="))
|
||||
, InfixN (Gt <$ symbol ">")
|
||||
, InfixN (Lt <$ symbol "<")
|
||||
, InfixN (Eq <$ symbol "=")
|
||||
]
|
||||
, [ InfixN comparisonOp ]
|
||||
, [ Postfix inPredicate
|
||||
, Postfix (try quantifiedCmp)
|
||||
, Postfix (IsNotNull <$ try (keyword "is" *> keyword "not" *> keyword "null"))
|
||||
, Postfix (IsNull <$ (keyword "is" *> keyword "null"))
|
||||
]
|
||||
@@ -127,6 +122,37 @@ operatorTable =
|
||||
, [InfixL (Or <$ keyword "OR")]
|
||||
]
|
||||
|
||||
-- | 普通比较：读最长的运算符，后面不能是 ANY / ALL
|
||||
comparisonOp :: Parser (Expr -> Expr -> Expr)
|
||||
comparisonOp = try $ do
|
||||
op <- cmpOp
|
||||
notFollowedBy quantifierKeyword
|
||||
return (compareNode op)
|
||||
|
||||
-- | 量词：ANY 或 ALL
|
||||
quantifierKeyword :: Parser Quantifier
|
||||
quantifierKeyword = (AnyQ <$ keyword "any") <|> (AllQ <$ keyword "all")
|
||||
|
||||
-- | 比较运算符符号
|
||||
cmpOp :: Parser CompareOp
|
||||
cmpOp =
|
||||
choice
|
||||
[ CmpNe <$ try (symbol "<>" <|> symbol "!=")
|
||||
, CmpGtE <$ try (symbol ">=")
|
||||
, CmpLtE <$ try (symbol "<=")
|
||||
, CmpGt <$ symbol ">"
|
||||
, CmpLt <$ symbol "<"
|
||||
, CmpEq <$ symbol "="
|
||||
]
|
||||
|
||||
-- | 量词比较 ANY / ALL
|
||||
quantifiedCmp :: Parser (Expr -> Expr)
|
||||
quantifiedCmp = do
|
||||
op <- cmpOp
|
||||
q <- quantifierKeyword
|
||||
sq <- between (symbol "(") (symbol ")") subquerySelect
|
||||
return (\e -> QuantCmp op e sq q)
|
||||
|
||||
-- | 最小的表达式单位
|
||||
atom :: Parser Expr
|
||||
atom =
|
||||
@@ -282,6 +308,8 @@ reservedWords =
|
||||
, "type"
|
||||
, "group"
|
||||
, "with"
|
||||
, "any"
|
||||
, "all"
|
||||
]
|
||||
|
||||
-- | 别名（不许用保留字）
|
||||
@@ -715,6 +743,7 @@ expandExpr env e = case e of
|
||||
InSub x sq neg -> (\x' sq' -> InSub x' sq' neg) <$> go x <*> goSub sq
|
||||
InList x es neg -> (\x' es' -> InList x' es' neg) <$> go x <*> traverse go es
|
||||
ExistsSub sq neg -> (\sq' -> ExistsSub sq' neg) <$> goSub sq
|
||||
QuantCmp op x sq q -> (\x' sq' -> QuantCmp op x' sq' q) <$> go x <*> goSub sq
|
||||
_ -> Right e
|
||||
where
|
||||
-- | 继续看子表达式
|
||||
|
||||
@@ -602,6 +602,55 @@ main = hspec $ do
|
||||
ids (And (Gt (Col "code") (LitInt 501)) (Lt (Col "code") (LitInt 502)))
|
||||
`shouldReturn` Right []
|
||||
|
||||
describe "ChuSQL.Core.Engine (ANY / ALL)" $ do
|
||||
-- sql：在默认库上跑 SQL 取结果行
|
||||
let sql input = parseStatement input >>= rowsOf . runStatement testDB
|
||||
-- values：只取结果里的值
|
||||
values input = fmap (map (map snd)) (sql input)
|
||||
|
||||
it "parses > ANY into a quantified comparison" $ do
|
||||
parseStatement "SELECT name FROM users WHERE age > ANY (SELECT age FROM orders)"
|
||||
`shouldBe` Right (Select ["name"] (FromTable Nothing "users") (Just (QuantCmp CmpGt (Col "age") (Subquery (Select ["age"] (FromTable Nothing "orders") Nothing [] [] Nothing) []) AnyQ)) [] [] Nothing)
|
||||
|
||||
it "parses <> ALL into a quantified comparison" $ do
|
||||
parseStatement "SELECT name FROM users WHERE age <> ALL (SELECT age FROM orders)"
|
||||
`shouldBe` Right (Select ["name"] (FromTable Nothing "users") (Just (QuantCmp CmpNe (Col "age") (Subquery (Select ["age"] (FromTable Nothing "orders") Nothing [] [] Nothing) []) AllQ)) [] [] Nothing)
|
||||
|
||||
it "still reads plain comparisons" $ do
|
||||
values "SELECT name FROM users WHERE age > 20 ORDER BY name"
|
||||
`shouldBe` Right [[VStr "Alice"], [VStr "Carol"]]
|
||||
|
||||
it "satisfies ANY when at least one row matches" $ do
|
||||
values "SELECT name FROM users WHERE age > ANY (SELECT age FROM users WHERE name = 'Bob')"
|
||||
`shouldBe` Right [[VStr "Alice"], [VStr "Carol"]]
|
||||
values "SELECT name FROM users WHERE age = ANY (SELECT age FROM users WHERE name = 'Bob')"
|
||||
`shouldBe` Right [[VStr "Bob"]]
|
||||
|
||||
it "satisfies ALL only when every row matches" $ do
|
||||
values "SELECT name FROM users WHERE age >= ALL (SELECT age FROM users)"
|
||||
`shouldBe` Right [[VStr "Carol"]]
|
||||
values "SELECT name FROM users WHERE age > ALL (SELECT age FROM users)" `shouldBe` Right []
|
||||
|
||||
it "treats an empty subquery as true for ALL and false for ANY" $ do
|
||||
values "SELECT name FROM users WHERE age > ALL (SELECT age FROM users WHERE name = 'Nobody')"
|
||||
`shouldBe` Right [[VStr "Alice"], [VStr "Bob"], [VStr "Carol"]]
|
||||
values "SELECT name FROM users WHERE age > ANY (SELECT age FROM users WHERE name = 'Nobody')"
|
||||
`shouldBe` Right []
|
||||
|
||||
it "keeps NULL in the subquery three-valued" $ do
|
||||
values "SELECT name FROM users WHERE age > ANY (SELECT NULL)" `shouldBe` Right []
|
||||
values "SELECT name FROM users WHERE age > ALL (SELECT NULL)" `shouldBe` Right []
|
||||
|
||||
it "agrees with IN on the equality form" $ do
|
||||
sql "SELECT name FROM users WHERE id = ANY (SELECT id FROM orders)"
|
||||
`shouldBe` sql "SELECT name FROM users WHERE id IN (SELECT id FROM orders)"
|
||||
|
||||
it "rejects a multi-column or mistyped quantifier subquery" $ do
|
||||
isLeft (sql "SELECT name FROM users WHERE age > ANY (SELECT id, name FROM users)")
|
||||
`shouldBe` True
|
||||
isLeft (sql "SELECT name FROM users WHERE name > ANY (SELECT id FROM users)")
|
||||
`shouldBe` True
|
||||
|
||||
describe "ChuSQL.Core.Engine (SELECT)" $ do
|
||||
-- sql：在默认库上跑 SQL 取结果行
|
||||
let sql input = parseStatement input >>= rowsOf . runStatement testDB
|
||||
|
||||
Reference in new issue
Block a user