hssqlppp-0.0.6: Database/HsSqlPpp/TypeChecking/TypeChecking.ag
{-
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.
-}