/src/Database/HsSqlPpp/Internals/TypeChecking/Ddl/CreateFunction.ag

  1{-
  2
  3
  4This file contains the ag code for create function statements.
  5
  6    | CreateFunction ann:Annotation
  7                     name : String
  8                     params : ParamDefList
  9                     rettype : TypeName
 10                     rep : Replace
 11                     lang : Language
 12                     body : FnBody
 13                     vol : Volatility
 14
 15DATA FnBody | SqlFnBody ann:Annotation sts : StatementList
 16            | PlpgsqlFnBody ann:Annotation vars:VarDefList sts : StatementList
 17
 18DATA ParamDef | ParamDef ann:Annotation name:String typ:TypeName
 19              | ParamDefTp ann:Annotation typ:TypeName
 20
 21DATA VarDef | VarDef ann:Annotation
 22                     name : String
 23                     typ : TypeName
 24                     value : (Maybe Expression)
 25
 26paramdeflist: need cat, produces lb
 27vardef needs cat, produces lb
 28function body: gets cat and new lb
 29
 30-}
 31{
 32data ParamName = NamedParam Int String
 33               | UnnamedParam Int
 34}
 35
 36ATTR ParamDef [pos : Int||paramName : ParamName
 37                          namedType : {Maybe Type}]
 38
 39ATTR ParamDefList [pos : Int||params : {[(ParamName, Maybe Type)]}]
 40
 41
 42-- collect the information to update the local bindings from the parameters
 43SEM ParamDef
 44    | ParamDef ParamDefTp
 45        lhs.namedType = @typ.namedType
 46    | ParamDef
 47        lhs.paramName = NamedParam @lhs.pos (ncStr @name)
 48    | ParamDefTp
 49        lhs.paramName = UnnamedParam @lhs.pos
 50
 51SEM ParamDefList
 52     | Nil lhs.params = []
 53     | Cons lhs.params = ((@hd.paramName, @hd.namedType) : @tl.params)
 54            hd.pos = @lhs.pos
 55            tl.pos = @lhs.pos + 1
 56
 57-- create the new local bindings and pass into the function body
 58-- just
 59
 60SEM Statement
 61    | CreateFunction
 62        --add the parameters to the catalog for the contained statements
 63        body.lib = either (const @lhs.lib) id $ do
 64                   _ <- lmt @rettype.namedType
 65                   lbUpdate @lhs.cat (LBIds ((getTName @name.originalTree) ++ " parameters") (Just (getTName @name.originalTree)) paramsNoPos) @lhs.lib
 66                   >>= lbUpdate @lhs.cat (LBIds ((getTName @name.originalTree) ++ " parameters") Nothing paramsPosOnly)
 67                   where
 68                     paramsPosOnly :: [(String,Type)]
 69                     paramsPosOnly = mapMaybe prm @params.params
 70                     prm :: (ParamName,Maybe Type) -> Maybe (String,Type)
 71                     prm (NamedParam p _,Just t) = Just ("$" ++ show p, t)
 72                     prm (UnnamedParam p,Just t) = Just ("$" ++ show p, t)
 73                     prm _ = Nothing
 74                     paramsNoPos :: [(String,Type)]
 75                     paramsNoPos = mapMaybe pnp @params.params
 76                     pnp :: (ParamName,Maybe Type) -> Maybe (String,Type)
 77                     pnp (NamedParam _ n,Just t) = Just (n,t)
 78                     pnp _ = Nothing
 79        params.pos = 1
 80
 81{-
 82boilerplate
 83
 84-}
 85
 86SEM Statement
 87    | CreateFunction
 88        loc.tpe = Right $ Pseudo Void
 89        loc.catUpdates = either (const []) id $ do
 90                         let ps = mapMaybe lpt @params.params
 91                         rt <- lmt @rettype.namedType
 92                         return [CatCreateFunction FunName
 93                                                   (map toLower (getTName @name.originalTree))
 94                                                   ps
 95                                                   rt
 96                                                   False]
 97                         where
 98                           lpt (_,Just t) = Just t
 99                           lpt _ = Nothing
100
101        loc.backTree = CreateFunction @ann
102                                      @name.originalTree
103                                      @params.annotatedTree
104                                      @rettype.annotatedTree
105                                      @rep
106                                      @lang
107                                      @body.annotatedTree
108                                      @vol
109        loc.statementType = Nothing
110        body.cat = @lhs.inProducedCat
111
112
113
114
115{-
116
117
118== function prototype
119
120all you do here is type check enough to produce the prototype
121information which is added to the catalog, this means the function
122name, parameter types, and the return type.
123
124type checking failure is contained so that the function prototype is
125produced iff the parameter and return types check ok. Any type errors
126in the function body (including the top level variable declarations
127don't affect the prototype, and hence callers of the function).
128
129-}
130
131
132
133
134{-
135ISSUE:
136
137when writing an sql file, you can put a create function which refers
138to a table definition that is given later. As long as the function
139isn't called before the table definition is given, this is ok. To
140handle this, need to gather the function prototype, but delay checking
141the contents until either a) all the other type checking has been
142done, or b) the function is needed (list ways this can happen: used in
143a view (even then, not needed until view is used), function can be
144called directly, or indirectly in another function call, ...)
145
146No thoughts on how to do this - but at some point want to support
147'declarative' sql source code, where the order doesn't matter, and
148this code figures out an order to load it into the database which will
149get past pgs checks, so hopefully the solution will move towards this
150goal also. One additional consideration is that the error message in a
151situation like this would be really helpful if it could tell that a
152problem like this could be fixed with a reordering, and suggest that
153reordering.
154
155New plan: do two passes, type check everything but the bodies of
156functions in first pass, then type check bodies of functions in second
157pass. Not perfect, but better than current situation. This will be
158achieved by using a separate cat attribute which is the same as the cat
159value which gets returned from the annotation functions in AstInternal.ag
160
161-}
162
163{-
164TODO: using fromRight on it's own for identifier bindings or cat
165updates is wrong, if an error is produced then this needs to be added
166to an annotation somewhere. Some of the code uses error instead of fromRight
167which is even worse.
168-}
169
170
171