{- 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) 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 = dependsOnRTpe @args.typeList $ typeCheckFunCall @lhs.env @funName @args.typeList 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 :: Environment -> String -> [Type] -> Either [TypeError] Type typeCheckFunCall env 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 typeBigInt "!between" -> do f1 <- lookupFn ">=" [argsType !! 0, argsType !! 1] f2 <- lookupFn "<=" [argsType !! 0, argsType !! 2] lookupFn "!and" [f1,f2] --"coalesce" -> resolveResultSetType env argsType "greatest" -> do t <- lookupFn fnName argsType -- t <- resolveResultSetType env argsType lookupFn ">=" [t,t] return t "least" -> do t <- lookupFn fnName argsType -- resolveResultSetType env argsType lookupFn "<=" [t,t] return t "!rowctor" -> return $ AnonymousRecordType argsType -- 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 env (head argsType) (head $ tail argsType) -> Right typeBool --checked for all special cases, so run general case now s -> lookupFn s argsType where lookupFn :: String -> [Type] -> Either [TypeError] Type lookupFn s1 args = do (_,_,r,_) <- findCallMatch env (if s1 == "u-" then "-" else s1) args return r checkRowTypesMatch (AnonymousRecordType t1s) (AnonymousRecordType t2s) = do when (length t1s /= length t2s) $ Left [ValuesListsMustBeSameLength] let errs = map (resolveResultSetType env . (\(a,b) -> [a,b])) $ zip t1s t2s liftErrors $ concat $ lefts errs return typeBool checkRowTypesMatch x y = error $ "internal error: checkRowTypesMatch called with " ++ show x ++ "," ++ show y 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 <- typeCheckFunCall @lhs.env @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.env @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.env (valueType : @loc.whenTypes) dependsOnRTpe @loc.thenTypes $ resolveResultSetType @lhs.env @loc.thenTypes loc.backTree = CaseSimple @ann @value.annotatedTree @cases.annotatedTree @els.annotatedTree {- == identifiers pull id types out of env 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.env [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.env @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