{- Copyright 2009 Jake Wheat This file contains the attr and sem definitions, which do the type checking, etc.. A lot of the haskell code has been moved into other files: TypeCheckingH, AstUtils.lhs, it is intended that only small amounts of code appear (i.e. one-liners) inline in this file, and larger bits go in AstUtils.lhs. These are only divided because the attribute grammar system uses a custom syntax with a custom preprocessor. These guidelines aren't followed very well. The current type checking approach doesn't quite match how SQL works. The main problem is that you can e.g. exec create table statements inside a function. This is something that the type checker will probably not be able to deal for a while if ever. (Will need hooks into postgresql to do this properly, which might not be impossible...). The main current limitation is that the ddl statements aren't passed on in the scope so e.g. it doesn't type check a create table followed by a select from that table. The support for this is nearly complete and it should be working very soon. Once most of the type checking is working, all the code and documentation will be overhauled quite a lot. Alternatively put, this code is in need of better documentation and organisation, and serious refactoring. An unholy mixture of Maybe, Either, Either Monad and TypeCheckFailed is used to do error handling. TODO: document pattern of typecheckfailed propagation, loc.tpe usage. ================================================================================ = main attributes used Here are the main attributes used in the type checking: scope is used to chain the scopes up and down the tree, to allow access to the catalog information, and to store the in scope identifier names and types e.g. inside a select expression. annotatedTree is used to create a copy of the ast with the type, etc. annotations. -} ATTR AllNodes Root ExpressionRoot [ scope : Scope | | annotatedTree : SELF ] {- ================================================================================ = expressions -} { annTypesAndErrors :: Annotated a => a -> Type -> [TypeError] -> Maybe AnnotationElement -> a annTypesAndErrors item nt errs add = changeAnn item $ (([TypeAnnotation nt] ++ maybeToList add ++ map TypeErrorA errs) ++) } SEM Expression | IntegerLit StringLit FloatLit BooleanLit NullLit FunCall Identifier Exists Case CaseSimple Cast InPredicate ScalarSubQuery --PositionalArg WindowFn lhs.annotatedTree = annTypesAndErrors @loc.backTree (errorToTypeFail @loc.tpe) (getErrors @loc.tpe) Nothing {- == literals -} 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 SEM Expression | IntegerLit loc.tpe = Right typeInt | StringLit loc.tpe = Right UnknownStringLit | FloatLit loc.tpe = Right typeNumeric | BooleanLit loc.tpe = Right typeBool -- I think a null types like an unknown string lit | NullLit loc.tpe = Right UnknownStringLit {- == cast expression -} SEM Expression | Cast loc.tpe = @tn.namedType loc.backTree = Cast @ann @expr.annotatedTree @tn.annotatedTree {- == type names Types with type modifiers (called PrecTypeName here, to be changed), are not supported at the moment. -} ATTR TypeName [ | | namedType : {Either [TypeError] Type} ] SEM TypeName | SimpleTypeName lhs.namedType = lookupTypeByName @lhs.scope $ canonicalizeTypeName @tn lhs.annotatedTree = SimpleTypeName @tn | ArrayTypeName lhs.namedType = ArrayType <$> @typ.namedType lhs.annotatedTree = ArrayTypeName @typ.annotatedTree | SetOfTypeName lhs.namedType = SetOfType <$> @typ.namedType lhs.annotatedTree = SetOfTypeName @typ.annotatedTree | PrecTypeName lhs.namedType = Right TypeCheckFailed lhs.annotatedTree = PrecTypeName @tn @prec {- == operators and functions -} SEM Expression | FunCall loc.tpe = checkTypes @args.typeList $ typeCheckFunCall @lhs.scope @funName @args.typeList loc.backTree = FunCall @ann @funName @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 = checkTypes @loc.whenTypes $ do when (any (/= typeBool) @loc.whenTypes) $ Left [WrongTypes typeBool @loc.whenTypes] checkTypes @loc.thenTypes $ resolveResultSetType @lhs.scope @loc.thenTypes loc.backTree = Case @ann @cases.annotatedTree @els.annotatedTree SEM Expression | CaseSimple loc.tpe = checkTypes @loc.whenTypes $ do checkWhenTypes <- resolveResultSetType @lhs.scope (getTypeAnnotation @value.annotatedTree: @loc.whenTypes) checkTypes @loc.thenTypes $ resolveResultSetType @lhs.scope @loc.thenTypes loc.backTree = CaseSimple @ann @value.annotatedTree @cases.annotatedTree @els.annotatedTree {- == identifiers pull id types out of scope for identifiers -} SEM Expression | Identifier loc.tpe = let (correlationName,iden) = splitIdentifier @i in scopeLookupID @lhs.scope correlationName iden loc.backTree = Identifier @ann @i 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 = let selType = getTypeAnnotation @sel.annotatedTree in checkTypes [selType] $ let f = map snd $ unwrapComposite $ unwrapSetOf selType in case length f of 0 -> error "internal error: no columns in scalar subquery?" 1 -> Right $ head f _ -> Right $ RowCtor f loc.backTree = ScalarSubQuery @ann @sel.annotatedTree {- == inlist -} SEM Expression | InPredicate loc.tpe = do lt <- @list.listType ty <- resolveResultSetType @lhs.scope [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.scope @exprs.typeList | InSelect lhs.listType = let attrs = map snd $ unwrapComposite $ unwrapSetOf $ getTypeAnnotation @sel.annotatedTree typ = case length attrs of 0 -> error "internal error - got subquery with no columns? in inselect" 1 -> head attrs _ -> RowCtor attrs in checkTypes attrs $ Right typ ATTR ExpressionList [ | | typeList : {[Type]} ] SEM ExpressionList | Cons lhs.typeList = getTypeAnnotation @hd.annotatedTree : @tl.typeList | Nil lhs.typeList = [] ATTR ExpressionListList [ | | typeListList : {[[Type]]} ] SEM ExpressionListList | Cons lhs.typeListList = @hd.typeList : @tl.typeListList | Nil lhs.typeListList = [] {- ================================================================================ = statements -} SEM Statement | SelectStatement Insert Update Delete CreateView CreateDomain CreateFunction CreateType CreateTable lhs.annotatedTree = annTypesAndErrors @loc.backTree (errorToTypeFail @loc.tpe) (getErrors @loc.tpe) $ Just $ StatementInfoA @loc.statementInfo {- ================================================================================ = basic select statements == nodeTypes -} SEM Statement | SelectStatement loc.tpe = checkTypes [getTypeAnnotation @ex.annotatedTree] $ Right $ Pseudo Void loc.statementInfo = SelectInfo $ getTypeAnnotation @ex.annotatedTree loc.backTree = SelectStatement @ann @ex.annotatedTree SEM SelectExpression | Values Select CombineSelect lhs.annotatedTree = annTypesAndErrors @loc.backTree (errorToTypeFail @loc.tpe) (getErrors @loc.tpe) Nothing { checkExpressionBool :: Maybe Expression -> Either [TypeError] Type checkExpressionBool whr = do let ty = fromMaybe typeBool $ fmap getTypeAnnotation whr when (ty `notElem` [typeBool, TypeCheckFailed]) $ Left [ExpressionMustBeBool] return ty } SEM SelectExpression | Values loc.tpe = typeCheckValuesExpr @lhs.scope @vll.typeListList loc.backTree = Values @ann @vll.annotatedTree | Select loc.tpe = do whereType <- checkExpressionBool @selWhere.annotatedTree let trefType = fromMaybe typeBool $ fmap getTypeAnnotation @selTref.annotatedTree slType = @selSelectList.listType chainTypeCheckFailed [trefType, whereType, slType] $ Right $ case slType of UnnamedCompositeType [(_,Pseudo Void)] -> Pseudo Void _ -> SetOfType slType loc.backTree = Select @ann @selDistinct.annotatedTree @selSelectList.annotatedTree @selTref.annotatedTree @selWhere.annotatedTree @selGroupBy.annotatedTree @selHaving.annotatedTree @selOrderBy.annotatedTree @selDir.annotatedTree @selLimit.annotatedTree @selOffset.annotatedTree | CombineSelect loc.tpe = let sel1t = getTypeAnnotation @sel1.annotatedTree sel2t = getTypeAnnotation @sel2.annotatedTree in checkTypes [sel1t, sel2t] $ typeCheckCombineSelect @lhs.scope sel1t sel2t loc.backTree = CombineSelect @ann @ctype.annotatedTree @sel1.annotatedTree @sel2.annotatedTree { getTbCols = unwrapComposite . unwrapSetOf . getTypeAnnotation } ATTR TableRef MTableRef [ | | idens : {[QualifiedScope]} joinIdens : {[String]} ] SEM TableRef | SubTref TrefAlias Tref TrefFun TrefFunAlias JoinedTref lhs.annotatedTree = annTypesAndErrors @loc.backTree (errorToTypeFail @loc.tpe) (getErrors @loc.tpe) Nothing SEM TableRef | SubTref loc.tpe = checkTypes [getTypeAnnotation @sel.annotatedTree] $ Right $ unwrapSetOfComposite $ getTypeAnnotation @sel.annotatedTree loc.backTree = SubTref @ann @sel.annotatedTree @alias lhs.idens = [(@alias, (getTbCols @sel.annotatedTree, []))] lhs.joinIdens = [] | TrefAlias Tref loc.tpe = either Left (Right . fst) @loc.relType lhs.joinIdens = [] loc.relType = getRelationType @lhs.scope @tbl loc.unwrappedRelType = either (const ([], [])) (both unwrapComposite) @loc.relType | Tref lhs.idens = [(@tbl, @loc.unwrappedRelType)] loc.backTree = Tref @ann @tbl | TrefAlias lhs.idens = [(@alias, @loc.unwrappedRelType)] loc.backTree = TrefAlias @ann @tbl @alias | TrefFun TrefFunAlias loc.tpe = getFnType @lhs.scope @alias @fn.annotatedTree lhs.joinIdens = [] lhs.idens = case getFunIdens @lhs.scope @loc.alias @fn.annotatedTree of Left e -> [] Right x -> [second (\l -> (unwrapComposite l, [])) x] | TrefFun loc.alias = "" loc.backTree = TrefFun @ann @fn.annotatedTree | TrefFunAlias loc.alias = @alias loc.backTree = TrefFunAlias @ann @fn.annotatedTree @alias | JoinedTref loc.tpe = checkTypes [tblt ,tbl1t] $ case (@nat.annotatedTree, @onExpr.annotatedTree) of (Natural, _) -> unionJoinList $ commonFieldNames tblt tbl1t (_,Just (JoinUsing s)) -> unionJoinList s _ -> unionJoinList [] where tblt = getTypeAnnotation @tbl.annotatedTree tbl1t = getTypeAnnotation @tbl1.annotatedTree unionJoinList s = combineTableTypesWithUsingList @lhs.scope s tblt tbl1t lhs.idens = @tbl.idens ++ @tbl1.idens lhs.joinIdens = commonFieldNames (getTypeAnnotation @tbl.annotatedTree) (getTypeAnnotation @tbl1.annotatedTree) loc.backTree = JoinedTref @ann @tbl.annotatedTree @nat.annotatedTree @joinType.annotatedTree @tbl1.annotatedTree @onExpr.annotatedTree { getFnType :: Scope -> String -> Expression -> Either [TypeError] Type getFnType scope alias = either Left (Right . snd) . getFunIdens scope alias getFunIdens :: Scope -> String -> Expression -> Either [TypeError] (String,Type) getFunIdens scope alias fnVal = case fnVal of FunCall _ f _ -> let correlationName = if alias /= "" then alias else f in Right (correlationName, case getTypeAnnotation fnVal of SetOfType (CompositeType t) -> getCompositeType t SetOfType x -> UnnamedCompositeType [(correlationName,x)] y -> UnnamedCompositeType [(correlationName,y)]) x -> Left [ContextError "FunCall"] where getCompositeType t = case getAttrs scope [Composite ,TableComposite ,ViewComposite] t of Just ((_,_,a@(UnnamedCompositeType _)), _) -> a _ -> UnnamedCompositeType [] } SEM MTableRef | Nothing lhs.idens = [] lhs.joinIdens = [] ATTR SelectItemList SelectList [ | | listType : Type ] SEM SelectItemList | Cons lhs.listType = doSelectItemListTpe @lhs.scope @hd.columnName @hd.itemType @tl.listType | Nil lhs.listType = UnnamedCompositeType [] ATTR SelectItem [ | | itemType : Type ] SEM SelectItem | SelExp SelectItem lhs.itemType = getTypeAnnotation @ex.annotatedTree -- hack to fix up for errors for ok * SEM SelectItem | SelExp loc.annotatedTree = SelExp $ fixStar @ex.annotatedTree | SelectItem loc.backTree = SelectItem (fixStar @ex.annotatedTree) @name { fixStar ex = changeAnnRecurse fs ex where fs a = if TypeAnnotation TypeCheckFailed `elem` a && any (\an -> case an of TypeErrorA (UnrecognisedIdentifier x) | let (_,iden) = splitIdentifier x in iden == "*" -> True _ -> False) a then filter (\an -> case an of TypeAnnotation TypeCheckFailed -> False TypeErrorA (UnrecognisedIdentifier _) -> False _ -> True) a else a } --[TypeAnnotation TypeCheckFailed,TypeErrorA (UnrecognisedIdentifier "*")] SEM SelectList | SelectList lhs.listType = @items.listType {- == scope passing scope flow: current simple version: from tref -> select list -> where (so we take the identifiers and types from the tref part, and send them into the selectlist and where parts) 1. from 2. where 3. group by 4. having 5. select -} SEM SelectExpression | Select selSelectList.scope = scopeReplaceIds @lhs.scope @selTref.idens @selTref.joinIdens selWhere.scope = scopeReplaceIds @lhs.scope @selTref.idens @selTref.joinIdens {- == attributes columnName is used to collect the column names that the select list produces, it is combined into an unnamedcompositetype in selectitemlist, which is also where star expansion happens. -} ATTR SelectItem [ | | columnName : String ] {- if the select item is just an identifier, then that column is named after the identifier e.g. select a, b as c, b + c from d, gives three columns one named a, one named c, and one unnamed, even though only one has an alias if the select item is a function or aggregate call at the top level, then it is named after that function or aggregate if it is a cast, the column is named after the target data type name iff it is a simple type name -} --default value for non identifier nodes ATTR Expression [ | | liftedColumnName USE {`(fixedValue "")`} {""}: String ] { fixedValue :: a -> a -> a -> a fixedValue a _ _ = a } {- override for identifier nodes, this only makes it out to the selectitem node if the identifier is not wrapped in parens, function calls, etc. -} SEM Expression | Identifier lhs.liftedColumnName = @i | FunCall lhs.liftedColumnName = if isOperator @funName then "" else @funName | Cast lhs.liftedColumnName = case @tn.annotatedTree of SimpleTypeName tn -> tn _ -> "" -- collect the aliases and column names for use by the selectitemlist nodes SEM SelectItem | SelExp lhs.columnName = case @ex.liftedColumnName of "" -> "?column?" s -> s | SelectItem lhs.columnName = @name {- ================================================================================ = insert -} SEM Statement | Insert loc.columnStuff = checkColumnConsistency @lhs.scope @table @targetCols.strings (unwrapComposite $ unwrapSetOf $ getTypeAnnotation @insData.annotatedTree) loc.tpe = checkTypes [getTypeAnnotation @insData.annotatedTree] $ do @loc.columnStuff Right $ Pseudo Void loc.statementInfo = InsertInfo @table $ errorToTypeFailF UnnamedCompositeType @loc.columnStuff loc.backTree = Insert @ann @table @targetCols.annotatedTree @insData.annotatedTree @returning ATTR StringList [ | | strings : {[String]} ] SEM StringList | Cons lhs.strings = @hd : @tl.strings | Nil lhs.strings = [] {- ================================================================================ = update -} { } SEM Statement | Update loc.tpe = do let re = checkRelationExists @lhs.scope @table when (isJust re) $ Left [fromJust $ re] whereType <- checkExpressionBool @whr.annotatedTree chainTypeCheckFailed (whereType:map snd @assigns.pairs) $ do @loc.columnsConsistent checkErrorList @assigns.rowSetErrors $ Pseudo Void loc.columnsConsistent = checkColumnConsistency @lhs.scope @table (map fst @assigns.pairs) @assigns.pairs loc.statementInfo = UpdateInfo @table $ flip errorToTypeFailF @loc.columnsConsistent $ \c -> let colNames = map fst @assigns.pairs in UnnamedCompositeType $ map (\t -> (t,getType c t)) colNames where getType cols t = fromJust $ lookup t cols loc.backTree = Update @ann @table @assigns.annotatedTree @whr.annotatedTree @returning ATTR SetClauseList [ | | pairs : {[(String,Type)]} rowSetErrors : {[TypeError]} ] SEM SetClauseList | Cons lhs.pairs = @hd.pairs ++ @tl.pairs lhs.rowSetErrors = maybeToList @hd.rowSetError ++ @tl.rowSetErrors | Nil lhs.pairs = [] lhs.rowSetErrors = [] ATTR SetClause [ | | pairs : {[(String,Type)]} rowSetError : {Maybe TypeError} ] SEM SetClause | SetClause lhs.pairs = [(@att, getTypeAnnotation @val.annotatedTree)] lhs.rowSetError = Nothing | RowSetClause loc.rowSetError = let atts = @atts.strings types = getRowTypes @vals.typeList in if length atts /= length types then Just WrongNumberOfColumns else Nothing lhs.pairs = zip @atts.strings $ getRowTypes @vals.typeList { getRowTypes :: [Type] -> [Type] getRowTypes [RowCtor ts] = ts getRowTypes ts = ts } {- ================================================================================ = delete -} SEM Statement | Delete loc.tpe = case checkRelationExists @lhs.scope @table of Just e -> Left [e] Nothing -> do whereType <- checkExpressionBool @whr.annotatedTree return $ Pseudo Void loc.statementInfo = DeleteInfo @table loc.backTree = Delete @ann @table @whr.annotatedTree @returning {- ================================================================================ = create table scope needs to be modified: types, typenames, typecats, attrdefs, systemcolumns produces a compositedef: (name, tablecomposite, unnamedcomp [(attrname, type)]) -} ATTR AttributeDef [ | | attrName : String namedType : {Either [TypeError] Type} ] SEM AttributeDef | AttributeDef lhs.attrName = @name lhs.namedType = @typ.namedType ATTR AttributeDefList [ | | attrs : {[(String, Either [TypeError] Type)]} ] SEM AttributeDefList | Cons lhs.attrs = (@hd.attrName, @hd.namedType) : @tl.attrs | Nil lhs.attrs = [] SEM Statement | CreateTable loc.attrTypes = map snd @atts.attrs loc.tpe = checkErrorList (concat $ lefts @loc.attrTypes) $ Pseudo Void loc.compositeType = errorToTypeFailF (const $ UnnamedCompositeType doneAtts) @loc.tpe where doneAtts = map (second errorToTypeFail) @atts.attrs loc.backTree = CreateTable @ann @name @atts.annotatedTree @cons.annotatedTree loc.statementInfo = RelvarInfo (@name, TableComposite, @loc.compositeType) SEM Statement | CreateTableAs loc.selType = getTypeAnnotation @expr.annotatedTree loc.tpe = Right @loc.selType loc.backTree = CreateTableAs @ann @name @expr.annotatedTree loc.statementInfo = RelvarInfo (@name, TableComposite, @loc.selType) {- ================================================================================ = create view -} SEM Statement | CreateView loc.tpe = checkTypes [getTypeAnnotation @expr.annotatedTree] $ Right $ Pseudo Void loc.backTree = CreateView @ann @name @expr.annotatedTree loc.statementInfo = RelvarInfo (@name, ViewComposite, getTypeAnnotation @expr.annotatedTree) {- ================================================================================ = create type -} ATTR TypeAttributeDef [ | | attrName : String namedType : {Either [TypeError] Type} ] SEM TypeAttributeDef | TypeAttDef lhs.attrName = @name lhs.namedType = @typ.namedType ATTR TypeAttributeDefList [ | | attrs : {[(String, Either [TypeError] Type)]} ] SEM TypeAttributeDefList | Cons lhs.attrs = (@hd.attrName, @hd.namedType) : @tl.attrs | Nil lhs.attrs = [] SEM Statement | CreateType loc.attrTypes = map snd @atts.attrs loc.tpe = checkErrorList (concat $ lefts @loc.attrTypes) $ Pseudo Void loc.compositeType = errorToTypeFailF (const $ UnnamedCompositeType doneAtts) @loc.tpe where doneAtts = map (second errorToTypeFail) @atts.attrs loc.backTree = CreateType @ann @name @atts.annotatedTree loc.statementInfo = RelvarInfo (@name, Composite, @loc.compositeType) {- ================================================================================ = create domain -} SEM Statement | CreateDomain loc.namedTypeType = case @typ.namedType of Left _ -> TypeCheckFailed Right x -> x loc.tpe = checkTypes [@loc.namedTypeType] $ Right $ Pseudo Void loc.backTree = CreateDomain @ann @name @typ.annotatedTree @check loc.statementInfo = CreateDomainInfo @name @loc.namedTypeType {- ================================================================================ = create function ignore body for now, just get the signature -} ATTR ParamDef [ | | paramName : String ] ATTR ParamDefList [ | | params : {[(String,Either [TypeError] Type)]} ] ATTR ParamDef [ | | namedType : {Either [TypeError] Type} ] SEM ParamDef | ParamDef ParamDefTp lhs.namedType = @typ.namedType | ParamDef lhs.paramName = @name | ParamDefTp lhs.paramName = "" SEM ParamDefList | Nil lhs.params = [] | Cons lhs.params = ((@hd.paramName, @hd.namedType) : @tl.params) SEM Statement | CreateFunction loc.retTypeType = errorToTypeFail @rettype.namedType loc.paramTypes = let tpes = map snd @params.params in if null $ concat $ lefts tpes then rights tpes else [TypeCheckFailed] loc.tpe = do @rettype.namedType let tpes = map snd @params.params checkErrorList (concat $ lefts tpes) $ Pseudo Void loc.backTree = CreateFunction @ann @lang.annotatedTree @name @params.annotatedTree @rettype.annotatedTree @bodyQuote @body.annotatedTree @vol.annotatedTree loc.statementInfo = CreateFunctionInfo (@name,@loc.paramTypes,@loc.retTypeType) {- ================================================================================ = static tests Try to use a list of message data types to hold all sorts of information which works its way out to the top level where the client code gets it. Want to have the lists concatenated together automatically from subnodes to parent node, and then to be able to add extra messages to this list at each node also. Problem 1: can't have two sem statements for the same node type which both add messages, and then the messages get combined to provide the final message list attribute value for that node. You want this so that e.g. that different sorts of checks appear in different sections. Workaround is instead of having each check in it's own section, to combine them all into one SEM. Problem 2: no shorthand to combine what the default rule for messages would be and then add a bit extra - so if you want all the children messages, plus possibly an extra message or two, have to write out the default rule in full explicitly. Can get round this by writing out loads of code. Both the workarounds to these seem a bit tedious and error prone, and will make the code much less readable. Maybe need a preprocessor to produce the ag file? Alternatively, just attach the messages to each node (so this appears in the data types and isn't an attribute, then have a tree walker collect them all). Since an annotation field in each node is going to be added anyway, so each node can be labelled with a type, will probably do this at some point. ================================================================================ = inloop testing inloop - use to check continue, exit, and other commands that can only appear inside loops (for, while, loop) the only nodes that really need this attribute are the ones which can contain statements The inloop test is the only thing which uses the messages atm. It shouldn't, at some point inloop testing will become part of the type checking. This is just some example code, will probably do something a lot more heavy weight like symbolic interpretation - want to do all sorts of loop, return, nullability, etc. analysis. -} {- ATTR AllNodes Root ExpressionRoot [ | | messages USE {++} {[]} : {[Message]} ] ATTR AllNodes [ inLoop: Bool | | ] SEM Root | Root statements.inLoop = False SEM ExpressionRoot | ExpressionRoot expr.inLoop = False -- set the inloop stuff which nests, it's reset inside a create -- function statement, in case you have a create function inside a -- loop, seems unlikely you'd do this though SEM Statement | ForSelectStatement ForIntegerStatement WhileStatement sts.inLoop = True | CreateFunction body.inLoop = False -- now we can check when we hit a continue statement if it is in the -- right context SEM Statement | ContinueStatement lhs.messages = if not @lhs.inLoop then [Error ContinueNotInLoop] else [] -} {- ================================================================================ = notes and todo containment guide for select expressions: combineselect 2 selects insert ?select createtableas 1 select createview 1 select return query 1 select forselect 1 select select->subselect select expression->exists select scalarsubquery select inselect select containment guide for statements: forselect [statement] forinteger [statement] while [statement] casestatement [[statement]] if [[statement]] createfunction->fnbody [Statement] TODO some non type-check checks: check plpgsql only in plpgsql function orderby in top level select only copy followed immediately by copydata iff stdin, copydata only follows copy from stdin count args to raise, etc., check same number as placeholders in string no natural with onexpr in joins typename -> setof (& fix parsing), what else like this? expressions: positionalarg in function, window function only in select list top level review all ast checks, and see if we can also catch them during parsing (e.g. typeName parses setof, but this should only be allowed for a function return, and we can make this a parse error when parsing from source code rather than checking a generated ast. This needs judgement to say whether a parse error is better than a check error, I think for setof it is, but e.g. for a continue not in a loop (which could be caught during parsing) works better as a check error, looking at the error message the user will get. This might be wrong, haven't thought too carefully about it yet). TODO: canonicalize ast process, as part of type checking produces a canonicalized ast which: all implicit casts appear explicitly in the ast (maybe distinguished from explicit casts?) all names fully qualified all types use canonical names literal values and selectors in one form (use row style?) nodes are tagged with types what else? Canonical form only defined for type consistent asts. This canonical form should pretty print and parse back to the same form, and type check correctly. -}