hssqlppp-0.2.0: Database/HsSqlPpp/AstInternals/TypeChecking/Expressions.ag
{-
Copyright 2009 Jake Wheat
This file contains the type checking code for the expression ast data
type.
-}
--gather the backtree, type errors and types together and add annotations
SEM Expression
| IntegerLit StringLit FloatLit BooleanLit NullLit FunCall Identifier
Exists Case CaseSimple Cast InPredicate ScalarSubQuery LiftOperator
PositionalArg Placeholder WindowFn
lhs.annotatedTree = annTypesAndErrors @loc.backTree
(tpeToT @loc.tpe)
(getErrors @loc.tpe)
$ fmap ((:[]) . FunctionPrototypeA) @loc.prototype
SEM Expression
| IntegerLit StringLit FloatLit BooleanLit NullLit FunCall Identifier
Exists Case CaseSimple Cast InPredicate ScalarSubQuery LiftOperator
PositionalArg Placeholder WindowFn
loc.prototype : {Maybe FunctionPrototype}
SEM Expression
| IntegerLit StringLit FloatLit BooleanLit NullLit Identifier
Exists Case CaseSimple Cast InPredicate ScalarSubQuery LiftOperator
PositionalArg Placeholder WindowFn
loc.prototype = Nothing
{-
== literals
pretty straightforward
-}
SEM Expression
| IntegerLit loc.tpe = Right typeInt
| StringLit loc.tpe = Right UnknownType
| FloatLit loc.tpe = Right typeNumeric
| BooleanLit loc.tpe = Right typeBool
-- I think a null has the same type resolution as an unknown string lit
| NullLit loc.tpe = Right UnknownType
SEM Expression
| IntegerLit
loc.backTree = IntegerLit @ann @i
| StringLit
loc.backTree = StringLit @ann @quote @value
| FloatLit
loc.backTree = FloatLit @ann @d
| BooleanLit
loc.backTree = BooleanLit @ann @b
| NullLit
loc.backTree = NullLit @ann
{-
== cast expression
all the work is done in the typename node
-}
SEM Expression
| Cast loc.tpe = Right $ @tn.namedType
loc.backTree = Cast @ann @expr.annotatedTree @tn.annotatedTree
{-
== operators and functions
-}
SEM Expression
| FunCall
(loc.tpe, loc.prototype) = if any (==TypeCheckFailed) @args.typeList
then (Right TypeCheckFailed, Nothing)
else
let fe = typeCheckFunCall
@lhs.cat
@funName
@args.typeList
in (dependsOnRTpe @args.typeList $ fmap (\(_,_,r,_) -> r) fe
,eitherToMaybe fe)
loc.backTree = FunCall @ann @funName @args.annotatedTree
| WindowFn
loc.tpe = Right (getTypeAnnotation @fn.annotatedTree)
loc.backTree = WindowFn @ann
@fn.annotatedTree
@partitionBy.annotatedTree
@orderBy.annotatedTree
@dir.annotatedTree
@frm.annotatedTree
{
{-
small shim in front of findCallMatch in the type conversion code, to
handle some special cases.
Some of the special cases will no longer be needed when variadic
support is added.
between, greatest and least are treated as syntactic sugar so we
delegate the function lookups to the <=/>= operators.
the row comparison should be more general than this, since it supports
any operator satisfying some properties
TODO: move all of this into find call match. Don't know why it's separate
-}
typeCheckFunCall :: Catalog -> String -> [Type] -> Either [TypeError] FunctionPrototype
typeCheckFunCall cat fnName' argsType =
{-trace ("typecheckfncall " ++ fnName' ++ show argsType) $-}
--dependsOnRTpe argsType $
case fnName of
"count" -> -- not quite sure how this is suppose to work,
-- the counts in the pg catalog accept either
-- no args, or one arg of type any, but you can call
-- count with multiple arguments?
return ("count", argsType, typeBigInt, False)
"!between" -> do
f1 <- lookupReturnType ">=" [argsType !! 0, argsType !! 1]
f2 <- lookupReturnType "<=" [argsType !! 0, argsType !! 2]
lookupFn "!and" [f1,f2]
"greatest" -> do
fp@(_,_,t,_) <- lookupFn fnName argsType
lookupFn ">=" [t,t]
return fp
"least" -> do
fp@(_,_,t,_) <- lookupFn fnName argsType
lookupFn "<=" [t,t]
return fp
"!rowctor" -> return $ ("!rowCtor", argsType, AnonymousRecordType argsType, False)
-- special case the row comparison ops
-- this needs to be fixed: we want to match
-- any implicit casts to functions on composite types
-- first, then we can use the anonymous record type on
-- any composite
_ | fnName `elem` ["=", "<>", "<=", ">=", "<", ">"]
&& length argsType == 2
&& all isCompositeOrSetOfCompositeType argsType
&& compositesCompatible cat (head argsType) (head $ tail argsType) -> return (fnName, argsType, typeBool, False)
--checked for all special cases, so run general case now
s -> lookupFn s argsType
where
lookupReturnType :: String -> [Type] -> Either [TypeError] Type
lookupReturnType s1 args = fmap (\(_,_,r,_) -> r) $ lookupFn s1 args
lookupFn :: String -> [Type] -> Either [TypeError] FunctionPrototype
lookupFn s1 args = findCallMatch cat
(if s1 == "u-" then "-" else s1) args
fnName = map toLower fnName'
}
{-
lifted operator:
pretty much the same as haskell 'any (lhs [op]) rhss' (or all instead of any)
where lhs is the first argument and rhss is the second argument
which must be an array
pg allows the rhss to also be a subselect, this is a todo
-}
SEM Expression
| LiftOperator
loc.tpe = dependsOnRTpe @args.typeList $ do
let args = @args.annotatedTree
errorWhen (length args /= 2)
[AnyAllError $ "must have two args, got " ++ show args]
let [a,b] = args
aType = getTypeAnnotation a
bType = getTypeAnnotation b
dependsOnRTpe [aType,bType] $ do
errorWhen (not $ isArrayType bType)
[AnyAllError $ "second arg must be array, got " ++ show args]
elemType <- unwrapArray $ bType
resType <- fmap (\(_,_,r,_) -> r) $ typeCheckFunCall
@lhs.cat
@oper
[aType,elemType]
errorWhen (resType /= typeBool)
[AnyAllError $ "operator must have bool return, got " ++ show resType]
return resType
loc.backTree = LiftOperator @ann @oper @flav.annotatedTree @args.annotatedTree
{-
== case expression
for non simple cases, we need all the when expressions to be bool, and
then to collect the types of the then parts to see if we can resolve a
common type
for simple cases, we need to check all the when parts have the same type
as the value to check against, then we collect the then parts as above.
-}
SEM Expression
| Case CaseSimple
loc.whenTypes = map getTypeAnnotation $ concatMap fst $
@cases.annotatedTree
loc.thenTypes = map getTypeAnnotation $
(map snd $ @cases.annotatedTree) ++
maybeToList @els.annotatedTree
SEM Expression
| Case
loc.tpe =
dependsOnRTpe @loc.whenTypes $ do
errorWhen (any (/= typeBool) @loc.whenTypes) $
[WrongTypes typeBool @loc.whenTypes]
dependsOnRTpe @loc.thenTypes $
resolveResultSetType @lhs.cat @loc.thenTypes
loc.backTree = Case @ann @cases.annotatedTree @els.annotatedTree
SEM Expression
| CaseSimple
loc.tpe =
dependsOnRTpe @loc.whenTypes $ do
let valueType = getTypeAnnotation @value.annotatedTree
checkWhenTypes <-
resolveResultSetType @lhs.cat (valueType : @loc.whenTypes)
dependsOnRTpe @loc.thenTypes $
resolveResultSetType @lhs.cat @loc.thenTypes
loc.backTree = CaseSimple @ann
@value.annotatedTree
@cases.annotatedTree
@els.annotatedTree
{-
== identifiers
pull id types out of cat for identifiers
-}
SEM Expression
| Identifier
loc.tpe = libLookupID @lhs.lib @i
loc.backTree = Identifier @ann @i
SEM Expression
| PositionalArg
loc.tpe = libLookupID @lhs.lib ('$':show @p)
loc.backTree = PositionalArg @ann @p
SEM Expression
| Placeholder
loc.tpe = Right UnknownType
loc.backTree = Placeholder @ann
-- exists: will work on any subselect so we don't need to do any checking
SEM Expression
| Exists
loc.tpe = Right typeBool
loc.backTree = Exists @ann @sel.annotatedTree
{-
== scalar subquery
1 col -> type of that col
2 + cols -> row type
-}
SEM Expression
| ScalarSubQuery
loc.tpe =
do
let selType = getTypeAnnotation @sel.annotatedTree
dependsOnRTpe [selType] $ do
f <- map snd <$> unwrapSetOfComposite selType
case length f of
0 -> Left [InternalError "no columns in scalar subquery?"]
1 -> Right $ head f
_ -> Right $ AnonymousRecordType f
loc.backTree = ScalarSubQuery @ann @sel.annotatedTree
{-
== inlist
todo: make the ast and typechecking a special case of lifted operator
-}
SEM Expression
| InPredicate
loc.tpe = do
lt <- @list.listType
ty <- resolveResultSetType
@lhs.cat
[getTypeAnnotation @expr.annotatedTree, lt]
return typeBool
loc.backTree = InPredicate @ann
@expr.annotatedTree
@i
@list.annotatedTree
ATTR InList [||listType : {Either [TypeError] Type}]
SEM InList
| InList
lhs.listType = resolveResultSetType @lhs.cat @exprs.typeList
| InSelect
lhs.listType =
do
attrs <- map snd <$> (unwrapSetOfComposite $
getTypeAnnotation @sel.annotatedTree)
typ <- case length attrs of
0 -> Left [InternalError
"got subquery with no columns? in inselect"]
1 -> Right $ head attrs
_ -> Right $ AnonymousRecordType attrs
dependsOnRTpe attrs $ Right typ
{-
================================================================================
dodgy type inference for parameterized statements
start with ? in function calls only
the idea is to assume the type is unknown, save the matched function prototype,
then set an inferred type attribute back down into the ? node,
then convert this to an annotation
the matched function prototype gets saved in Expression.loc.protoType
above when resolving the matching function
won't work: the function prototype lookup uses the annotation on the
argument nodes, and this will make the annotation dependent on already
having the function prototype.
-}
-- ATTR Expression [inferredType:Type||]
-- ATTR ExpressionList [inferredTypes:{[Type]}||]
-- SEM Expression
-- | FunCall
-- args.inferredTypes = let t =