hssqlppp-0.2.0: Database/HsSqlPpp/AstInternals/TypeChecking/CreateFunction.ag
{-
Copyright 2009 Jake Wheat
This file contains the ag code for create function statements. This
includes producing the function prototype, and passing the parameter
and variable declaration bindings into the statement body.
== function prototype
all we do here is type check enough to produce the prototype
information which is added to the catalog, this means the function
name, parameter types, and the return type.
type checking failure is contained so that the function prototype is
produced iff the parameter and return types check ok. Any type errors
in the function body (including the top level variable declarations
don't affect the prototype, and hence callers of the function).
-}
SEM Statement
| CreateFunction
loc.tpe = dependsOnRTpe
(@rettype.namedType : @loc.parameterTypes) $
Right $ Pseudo Void
loc.catUpdates = dependsOn [tpeToT @loc.tpe] []
[CatCreateFunction FunName
(map toLower @name)
@loc.parameterTypes
@rettype.namedType
False]
loc.parameterTypes = (map snd @params.params)
loc.backTree = CreateFunction @ann
@name
@params.annotatedTree
@rettype.annotatedTree
@lang.annotatedTree
@bodyQuote
@body.annotatedTree
@vol.annotatedTree
loc.statementType = []
body.cat = @lhs.inProducedCat
{-
== parameters
-}
ATTR ParamDef [||paramName : String
namedType : Type]
ATTR ParamDefList [||params : {[(String, 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)
{-
ISSUE:
when writing an sql file, you can put a create function which refers
to a table definition that is given later. As long as the function
isn't called before the table definition is given, this is ok. To
handle this, need to gather the function prototype, but delay checking
the contents until either a) all the other type checking has been
done, or b) the function is needed (list ways this can happen: used in
a view (even then, not needed until view is used), function can be
called directly, or indirectly in another function call, ...)
No thoughts on how to do this - but at some point want to support
'declarative' sql source code, where the order doesn't matter, and
this code figures out an order to load it into the database which will
get past pgs checks, so hopefully the solution will move towards this
goal also. One additional consideration is that the error message in a
situation like this would be really helpful if it could tell that a
problem like this could be fixed with a reordering, and suggest that
reordering.
New plan: do two passes, type check everything but the bodies of
functions in first pass, then type check bodies of functions in second
pass. Not perfect, but better than current situation. This will be
achieved by using a separate cat attribute which is the same as the cat
value which gets returned from the annotation functions in AstInternal.ag
-}
SEM Statement
| CreateFunction
--add the parameters to the catalog for the contained statements
body.lib = let p = @params.params
++ (zip posNames $ map snd @params.params)
in fromRight @lhs.lib $
updateBindings @lhs.lib @lhs.cat
[LibStackIDs [("", p)
,(@name, @params.params)]]
where
posNames :: [String]
posNames = map (\l -> '$':show l) [1..]
{-
TODO: using fromRight on it's own for identifier bindings or cat
updates is wrong, if an error is produced then this needs to be added
to an annotation somewhere. Some of the code uses error instead of fromRight
which is even worse.
-}
SEM FnBody
| PlpgsqlFnBody
--make the variable names available in the body of the
--function this needs to be generalised to begin/end blocks
--which can nest inside plpgsql functions (they aren't even
--supported by the parser at the moment)
sts.lib = fromRight @lhs.lib $
updateBindings @lhs.lib @lhs.cat
[LibStackIDs [("", @vars.defs)]]
ATTR VarDef [||def : {(String,Type)}]
ATTR VarDefList [||defs : {[(String,Type)]}]
--slightly hacky, should fix this better
SEM VarDef
| VarDef lhs.def = (@name, if @typ.namedType == Pseudo Record then PgRecord Nothing else @typ.namedType)
SEM VarDefList
| Cons lhs.defs = @hd.def : @tl.defs
| Nil lhs.defs = []