3 % (c) The University of Glasgow, 1992-2006
6 Here we collect a variety of helper functions that construct or
7 analyse HsSyn. All these functions deal with generic HsSyn; functions
8 which deal with the intantiated versions are located elsewhere:
10 Parameterised by Module
11 ---------------- -------------
12 RdrName parser/RdrHsSyn
19 mkHsPar, mkHsApp, mkHsConApp, mkSimpleHsAlt,
20 mkSimpleMatch, unguardedGRHSs, unguardedRHS,
21 mkMatchGroup, mkMatch, mkHsLam, mkHsIf,
22 mkHsWrap, mkLHsWrap, mkHsWrapCoI, mkLHsWrapCoI,
23 coiToHsWrapper, mkHsDictLet,
24 mkHsOpApp, mkHsDo, mkHsWrapPat, mkHsWrapPatCoI,
26 nlHsTyApp, nlHsVar, nlHsLit, nlHsApp, nlHsApps, nlHsIntLit, nlHsVarApps,
27 nlHsDo, nlHsOpApp, nlHsLam, nlHsPar, nlHsIf, nlHsCase, nlList,
28 mkLHsTupleExpr, mkLHsVarTuple, missingTupArg,
31 mkFunBind, mkVarBind, mkHsVarBind, mk_easy_FunBind,
34 mkHsIntegral, mkHsFractional, mkHsIsString, mkHsString,
37 mkNPat, mkNPlusKPat, nlVarPat, nlLitPat, nlConVarPat, nlConPat, nlInfixConPat,
38 nlNullaryConPat, nlWildConPat, nlWildPat, nlTuplePat,
41 mkHsAppTy, userHsTyVarBndrs,
42 nlHsAppTy, nlHsTyVar, nlHsFunTy, nlHsTyConApp,
45 mkTransformStmt, mkTransformByStmt, mkExprStmt, mkBindStmt,
46 mkGroupUsingStmt, mkGroupByStmt, mkGroupByUsingStmt,
47 emptyRecStmt, mkRecStmt,
50 unqualSplice, mkHsSpliceTy, mkHsSplice, mkHsQuasiQuote, unqualQuasiQuote,
56 collectLocalBinders, collectHsValBinders, collectHsBindListBinders,
57 collectHsBindsBinders, collectHsBindBinders, collectMethodBinders,
58 collectPatBinders, collectPatsBinders,
59 collectLStmtsBinders, collectStmtsBinders,
60 collectLStmtBinders, collectStmtBinders,
61 collectSigTysFromPats, collectSigTysFromPat,
63 hsTyClDeclBinders, hsTyClDeclsBinders, hsConDeclsBinders,
64 hsForeignDeclsBinders, hsGroupBinders
89 %************************************************************************
91 Some useful helpers for constructing syntax
93 %************************************************************************
95 These functions attempt to construct a not-completely-useless SrcSpan
96 from their components, compared with the nl* functions below which
97 just attach noSrcSpan to everything.
100 mkHsPar :: LHsExpr id -> LHsExpr id
101 mkHsPar e = L (getLoc e) (HsPar e)
103 mkSimpleMatch :: [LPat id] -> LHsExpr id -> LMatch id
104 mkSimpleMatch pats rhs
106 Match pats Nothing (unguardedGRHSs rhs)
110 (pat:_) -> combineSrcSpans (getLoc pat) (getLoc rhs)
112 unguardedGRHSs :: LHsExpr id -> GRHSs id
113 unguardedGRHSs rhs = GRHSs (unguardedRHS rhs) emptyLocalBinds
115 unguardedRHS :: LHsExpr id -> [LGRHS id]
116 unguardedRHS rhs@(L loc _) = [L loc (GRHS [] rhs)]
118 mkHsAppTy :: LHsType name -> LHsType name -> LHsType name
119 mkHsAppTy t1 t2 = addCLoc t1 t2 (HsAppTy t1 t2)
121 mkHsApp :: LHsExpr name -> LHsExpr name -> LHsExpr name
122 mkHsApp e1 e2 = addCLoc e1 e2 (HsApp e1 e2)
124 nlHsTyApp :: name -> [Type] -> LHsExpr name
125 nlHsTyApp fun_id tys = noLoc (HsWrap (mkWpTyApps tys) (HsVar fun_id))
127 mkLHsWrap :: HsWrapper -> LHsExpr id -> LHsExpr id
128 mkLHsWrap co_fn (L loc e) = L loc (mkHsWrap co_fn e)
130 mkHsWrap :: HsWrapper -> HsExpr id -> HsExpr id
131 mkHsWrap co_fn e | isIdHsWrapper co_fn = e
132 | otherwise = HsWrap co_fn e
134 mkHsWrapCoI :: CoercionI -> HsExpr id -> HsExpr id
135 mkHsWrapCoI (IdCo _) e = e
136 mkHsWrapCoI (ACo co) e = mkHsWrap (WpCast co) e
138 mkLHsWrapCoI :: CoercionI -> LHsExpr id -> LHsExpr id
139 mkLHsWrapCoI (IdCo _) e = e
140 mkLHsWrapCoI (ACo co) (L loc e) = L loc (mkHsWrap (WpCast co) e)
142 coiToHsWrapper :: CoercionI -> HsWrapper
143 coiToHsWrapper (IdCo _) = idHsWrapper
144 coiToHsWrapper (ACo co) = WpCast co
146 mkHsWrapPat :: HsWrapper -> Pat id -> Type -> Pat id
147 mkHsWrapPat co_fn p ty | isIdHsWrapper co_fn = p
148 | otherwise = CoPat co_fn p ty
150 mkHsWrapPatCoI :: CoercionI -> Pat id -> Type -> Pat id
151 mkHsWrapPatCoI (IdCo _) pat _ = pat
152 mkHsWrapPatCoI (ACo co) pat ty = CoPat (WpCast co) pat ty
154 mkHsLam :: [LPat id] -> LHsExpr id -> LHsExpr id
155 mkHsLam pats body = mkHsPar (L (getLoc body) (HsLam matches))
157 matches = mkMatchGroup [mkSimpleMatch pats body]
159 mkMatchGroup :: [LMatch id] -> MatchGroup id
160 mkMatchGroup matches = MatchGroup matches placeHolderType
162 mkHsDictLet :: TcEvBinds -> LHsExpr Id -> LHsExpr Id
163 mkHsDictLet ev_binds expr = mkLHsWrap (WpLet ev_binds) expr
165 mkHsConApp :: DataCon -> [Type] -> [HsExpr Id] -> LHsExpr Id
166 -- Used for constructing dictionary terms etc, so no locations
167 mkHsConApp data_con tys args
168 = foldl mk_app (nlHsTyApp (dataConWrapId data_con) tys) args
170 mk_app f a = noLoc (HsApp f (noLoc a))
172 mkSimpleHsAlt :: LPat id -> LHsExpr id -> LMatch id
173 -- A simple lambda with a single pattern, no binds, no guards; pre-typechecking
174 mkSimpleHsAlt pat expr
175 = mkSimpleMatch [pat] expr
177 -------------------------------
178 -- These are the bits of syntax that contain rebindable names
179 -- See RnEnv.lookupSyntaxName
181 mkHsIntegral :: Integer -> PostTcType -> HsOverLit id
182 mkHsFractional :: Rational -> PostTcType -> HsOverLit id
183 mkHsIsString :: FastString -> PostTcType -> HsOverLit id
184 mkHsDo :: HsStmtContext Name -> [LStmt id] -> LHsExpr id -> HsExpr id
186 mkNPat :: HsOverLit id -> Maybe (SyntaxExpr id) -> Pat id
187 mkNPlusKPat :: Located id -> HsOverLit id -> Pat id
189 mkTransformStmt :: [LStmt idL] -> LHsExpr idR -> StmtLR idL idR
190 mkTransformByStmt :: [LStmt idL] -> LHsExpr idR -> LHsExpr idR -> StmtLR idL idR
192 mkExprStmt :: LHsExpr idR -> StmtLR idL idR
193 mkBindStmt :: LPat idL -> LHsExpr idR -> StmtLR idL idR
195 emptyRecStmt :: StmtLR idL idR
196 mkRecStmt :: [LStmtLR idL idR] -> StmtLR idL idR
199 mkHsIntegral i = OverLit (HsIntegral i) noRebindableInfo noSyntaxExpr
200 mkHsFractional f = OverLit (HsFractional f) noRebindableInfo noSyntaxExpr
201 mkHsIsString s = OverLit (HsIsString s) noRebindableInfo noSyntaxExpr
203 noRebindableInfo :: Bool
204 noRebindableInfo = error "noRebindableInfo" -- Just another placeholder;
206 mkHsDo ctxt stmts body = HsDo ctxt stmts body placeHolderType
208 mkHsIf :: LHsExpr id -> LHsExpr id -> LHsExpr id -> HsExpr id
209 mkHsIf c a b = HsIf (Just noSyntaxExpr) c a b
211 mkNPat lit neg = NPat lit neg noSyntaxExpr
212 mkNPlusKPat id lit = NPlusKPat id lit noSyntaxExpr noSyntaxExpr
214 mkTransformStmt stmts usingExpr = TransformStmt stmts [] usingExpr Nothing
215 mkTransformByStmt stmts usingExpr byExpr = TransformStmt stmts [] usingExpr (Just byExpr)
217 mkGroupUsingStmt :: [LStmt idL] -> LHsExpr idR -> StmtLR idL idR
218 mkGroupByStmt :: [LStmt idL] -> LHsExpr idR -> StmtLR idL idR
219 mkGroupByUsingStmt :: [LStmt idL] -> LHsExpr idR -> LHsExpr idR -> StmtLR idL idR
221 mkGroupUsingStmt stmts usingExpr = GroupStmt stmts [] Nothing (Left usingExpr)
222 mkGroupByStmt stmts byExpr = GroupStmt stmts [] (Just byExpr) (Right noSyntaxExpr)
223 mkGroupByUsingStmt stmts byExpr usingExpr = GroupStmt stmts [] (Just byExpr) (Left usingExpr)
225 mkExprStmt expr = ExprStmt expr noSyntaxExpr placeHolderType
226 mkBindStmt pat expr = BindStmt pat expr noSyntaxExpr noSyntaxExpr
228 emptyRecStmt = RecStmt { recS_stmts = [], recS_later_ids = [], recS_rec_ids = []
229 , recS_ret_fn = noSyntaxExpr, recS_mfix_fn = noSyntaxExpr
230 , recS_bind_fn = noSyntaxExpr
231 , recS_rec_rets = [], recS_dicts = emptyTcEvBinds }
233 mkRecStmt stmts = emptyRecStmt { recS_stmts = stmts }
235 -------------------------------
236 --- A useful function for building @OpApps@. The operator is always a
237 -- variable, and we don't know the fixity yet.
238 mkHsOpApp :: LHsExpr id -> id -> LHsExpr id -> HsExpr id
239 mkHsOpApp e1 op e2 = OpApp e1 (noLoc (HsVar op)) (error "mkOpApp:fixity") e2
241 mkHsSplice :: LHsExpr RdrName -> HsSplice RdrName
242 mkHsSplice e = HsSplice unqualSplice e
244 mkHsSpliceTy :: LHsExpr RdrName -> HsType RdrName
245 mkHsSpliceTy e = HsSpliceTy (mkHsSplice e) emptyFVs placeHolderKind
247 unqualSplice :: RdrName
248 unqualSplice = mkRdrUnqual (mkVarOccFS (fsLit "splice"))
249 -- A name (uniquified later) to
250 -- identify the splice
252 mkHsQuasiQuote :: RdrName -> SrcSpan -> FastString -> HsQuasiQuote RdrName
253 mkHsQuasiQuote quoter span quote = HsQuasiQuote quoter span quote
255 unqualQuasiQuote :: RdrName
256 unqualQuasiQuote = mkRdrUnqual (mkVarOccFS (fsLit "quasiquote"))
257 -- A name (uniquified later) to
258 -- identify the quasi-quote
260 mkHsString :: String -> HsLit
261 mkHsString s = HsString (mkFastString s)
264 userHsTyVarBndrs :: [Located name] -> [Located (HsTyVarBndr name)]
265 userHsTyVarBndrs bndrs = [ L loc (UserTyVar v placeHolderKind) | L loc v <- bndrs ]
269 %************************************************************************
271 Constructing syntax with no location info
273 %************************************************************************
276 nlHsVar :: id -> LHsExpr id
277 nlHsVar n = noLoc (HsVar n)
279 nlHsLit :: HsLit -> LHsExpr id
280 nlHsLit n = noLoc (HsLit n)
282 nlVarPat :: id -> LPat id
283 nlVarPat n = noLoc (VarPat n)
285 nlLitPat :: HsLit -> LPat id
286 nlLitPat l = noLoc (LitPat l)
288 nlHsApp :: LHsExpr id -> LHsExpr id -> LHsExpr id
289 nlHsApp f x = noLoc (HsApp f x)
291 nlHsIntLit :: Integer -> LHsExpr id
292 nlHsIntLit n = noLoc (HsLit (HsInt n))
294 nlHsApps :: id -> [LHsExpr id] -> LHsExpr id
295 nlHsApps f xs = foldl nlHsApp (nlHsVar f) xs
297 nlHsVarApps :: id -> [id] -> LHsExpr id
298 nlHsVarApps f xs = noLoc (foldl mk (HsVar f) (map HsVar xs))
300 mk f a = HsApp (noLoc f) (noLoc a)
302 nlConVarPat :: id -> [id] -> LPat id
303 nlConVarPat con vars = nlConPat con (map nlVarPat vars)
305 nlInfixConPat :: id -> LPat id -> LPat id -> LPat id
306 nlInfixConPat con l r = noLoc (ConPatIn (noLoc con) (InfixCon l r))
308 nlConPat :: id -> [LPat id] -> LPat id
309 nlConPat con pats = noLoc (ConPatIn (noLoc con) (PrefixCon pats))
311 nlNullaryConPat :: id -> LPat id
312 nlNullaryConPat con = noLoc (ConPatIn (noLoc con) (PrefixCon []))
314 nlWildConPat :: DataCon -> LPat RdrName
315 nlWildConPat con = noLoc (ConPatIn (noLoc (getRdrName con))
316 (PrefixCon (nOfThem (dataConSourceArity con) nlWildPat)))
319 nlWildPat = noLoc (WildPat placeHolderType) -- Pre-typechecking
321 nlHsDo :: HsStmtContext Name -> [LStmt id] -> LHsExpr id -> LHsExpr id
322 nlHsDo ctxt stmts body = noLoc (mkHsDo ctxt stmts body)
324 nlHsOpApp :: LHsExpr id -> id -> LHsExpr id -> LHsExpr id
325 nlHsOpApp e1 op e2 = noLoc (mkHsOpApp e1 op e2)
327 nlHsLam :: LMatch id -> LHsExpr id
328 nlHsPar :: LHsExpr id -> LHsExpr id
329 nlHsIf :: LHsExpr id -> LHsExpr id -> LHsExpr id -> LHsExpr id
330 nlHsCase :: LHsExpr id -> [LMatch id] -> LHsExpr id
331 nlList :: [LHsExpr id] -> LHsExpr id
333 nlHsLam match = noLoc (HsLam (mkMatchGroup [match]))
334 nlHsPar e = noLoc (HsPar e)
335 nlHsIf cond true false = noLoc (mkHsIf cond true false)
336 nlHsCase expr matches = noLoc (HsCase expr (mkMatchGroup matches))
337 nlList exprs = noLoc (ExplicitList placeHolderType exprs)
339 nlHsAppTy :: LHsType name -> LHsType name -> LHsType name
340 nlHsTyVar :: name -> LHsType name
341 nlHsFunTy :: LHsType name -> LHsType name -> LHsType name
343 nlHsAppTy f t = noLoc (HsAppTy f t)
344 nlHsTyVar x = noLoc (HsTyVar x)
345 nlHsFunTy a b = noLoc (HsFunTy a b)
347 nlHsTyConApp :: name -> [LHsType name] -> LHsType name
348 nlHsTyConApp tycon tys = foldl nlHsAppTy (nlHsTyVar tycon) tys
351 Tuples. All these functions are *pre-typechecker* because they lack
355 mkLHsTupleExpr :: [LHsExpr a] -> LHsExpr a
356 -- Makes a pre-typechecker boxed tuple, deals with 1 case
357 mkLHsTupleExpr [e] = e
358 mkLHsTupleExpr es = noLoc $ ExplicitTuple (map Present es) Boxed
360 mkLHsVarTuple :: [a] -> LHsExpr a
361 mkLHsVarTuple ids = mkLHsTupleExpr (map nlHsVar ids)
363 nlTuplePat :: [LPat id] -> Boxity -> LPat id
364 nlTuplePat pats box = noLoc (TuplePat pats box placeHolderType)
366 missingTupArg :: HsTupArg a
367 missingTupArg = Missing placeHolderType
370 %************************************************************************
372 Bindings; with a location at the top
374 %************************************************************************
377 mkFunBind :: Located id -> [LMatch id] -> HsBind id
378 -- Not infix, with place holders for coercion and free vars
379 mkFunBind fn ms = FunBind { fun_id = fn, fun_infix = False, fun_matches = mkMatchGroup ms,
380 fun_co_fn = idHsWrapper, bind_fvs = placeHolderNames,
384 mkHsVarBind :: SrcSpan -> id -> LHsExpr id -> LHsBind id
385 mkHsVarBind loc var rhs = mk_easy_FunBind loc var [] rhs
387 mkVarBind :: id -> LHsExpr id -> LHsBind id
388 mkVarBind var rhs = L (getLoc rhs) $
389 VarBind { var_id = var, var_rhs = rhs, var_inline = False }
392 mk_easy_FunBind :: SrcSpan -> id -> [LPat id]
393 -> LHsExpr id -> LHsBind id
395 mk_easy_FunBind loc fun pats expr
396 = L loc $ mkFunBind (L loc fun) [mkMatch pats expr emptyLocalBinds]
399 mkMatch :: [LPat id] -> LHsExpr id -> HsLocalBinds id -> LMatch id
400 mkMatch pats expr binds
401 = noLoc (Match (map paren pats) Nothing
402 (GRHSs (unguardedRHS expr) binds))
404 paren lp@(L l p) | hsPatNeedsParens p = L l (ParPat lp)
409 %************************************************************************
413 %************************************************************************
415 Get all the binders in some HsBindGroups, IN THE ORDER OF APPEARANCE. eg.
423 it should return [x, y, f, a, b] (remember, order important).
425 Note [Collect binders only after renaming]
426 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
427 These functions should only be used on HsSyn *after* the renamer,
428 to return a [Name] or [Id]. Before renaming the record punning
429 and wild-card mechanism makes it hard to know what is bound.
430 So these functions should not be applied to (HsSyn RdrName)
433 ----------------- Bindings --------------------------
434 collectLocalBinders :: HsLocalBindsLR idL idR -> [idL]
435 collectLocalBinders (HsValBinds val_binds) = collectHsValBinders val_binds
436 collectLocalBinders (HsIPBinds _) = []
437 collectLocalBinders EmptyLocalBinds = []
439 collectHsValBinders :: HsValBindsLR idL idR -> [idL]
440 collectHsValBinders (ValBindsIn binds _) = collectHsBindsBinders binds
441 collectHsValBinders (ValBindsOut binds _) = foldr collect_one [] binds
443 collect_one (_,binds) acc = collect_binds binds acc
445 collectHsBindBinders :: HsBindLR idL idR -> [idL]
446 collectHsBindBinders b = collect_bind b []
448 collect_bind :: HsBindLR idL idR -> [idL] -> [idL]
449 collect_bind (PatBind { pat_lhs = p }) acc = collect_lpat p acc
450 collect_bind (FunBind { fun_id = L _ f }) acc = f : acc
451 collect_bind (VarBind { var_id = f }) acc = f : acc
452 collect_bind (AbsBinds { abs_exports = dbinds, abs_binds = _binds }) acc
453 = [dp | (_,dp,_,_) <- dbinds] ++ acc
454 -- ++ foldr collect_bind acc binds
455 -- I don't think we want the binders from the nested binds
456 -- The only time we collect binders from a typechecked
457 -- binding (hence see AbsBinds) is in zonking in TcHsSyn
459 collectHsBindsBinders :: LHsBindsLR idL idR -> [idL]
460 collectHsBindsBinders binds = collect_binds binds []
462 collectHsBindListBinders :: [LHsBindLR idL idR] -> [idL]
463 collectHsBindListBinders = foldr (collect_bind . unLoc) []
465 collect_binds :: LHsBindsLR idL idR -> [idL] -> [idL]
466 collect_binds binds acc = foldrBag (collect_bind . unLoc) acc binds
468 collectMethodBinders :: LHsBindsLR RdrName idR -> [Located RdrName]
469 -- Used exclusively for the bindings of an instance decl which are all FunBinds
470 collectMethodBinders binds = foldrBag get [] binds
472 get (L _ (FunBind { fun_id = f })) fs = f : fs
474 -- Someone else complains about non-FunBinds
476 ----------------- Statements --------------------------
477 collectLStmtsBinders :: [LStmtLR idL idR] -> [idL]
478 collectLStmtsBinders = concatMap collectLStmtBinders
480 collectStmtsBinders :: [StmtLR idL idR] -> [idL]
481 collectStmtsBinders = concatMap collectStmtBinders
483 collectLStmtBinders :: LStmtLR idL idR -> [idL]
484 collectLStmtBinders = collectStmtBinders . unLoc
486 collectStmtBinders :: StmtLR idL idR -> [idL]
487 -- Id Binders for a Stmt... [but what about pattern-sig type vars]?
488 collectStmtBinders (BindStmt pat _ _ _) = collectPatBinders pat
489 collectStmtBinders (LetStmt binds) = collectLocalBinders binds
490 collectStmtBinders (ExprStmt _ _ _) = []
491 collectStmtBinders (ParStmt xs) = collectLStmtsBinders
493 collectStmtBinders (TransformStmt stmts _ _ _) = collectLStmtsBinders stmts
494 collectStmtBinders (GroupStmt stmts _ _ _) = collectLStmtsBinders stmts
495 collectStmtBinders (RecStmt { recS_stmts = ss }) = collectLStmtsBinders ss
498 ----------------- Patterns --------------------------
499 collectPatBinders :: LPat a -> [a]
500 collectPatBinders pat = collect_lpat pat []
502 collectPatsBinders :: [LPat a] -> [a]
503 collectPatsBinders pats = foldr collect_lpat [] pats
506 collect_lpat :: LPat name -> [name] -> [name]
507 collect_lpat (L _ pat) bndrs
510 go (VarPat var) = var : bndrs
511 go (WildPat _) = bndrs
512 go (LazyPat pat) = collect_lpat pat bndrs
513 go (BangPat pat) = collect_lpat pat bndrs
514 go (AsPat (L _ a) pat) = a : collect_lpat pat bndrs
515 go (ViewPat _ pat _) = collect_lpat pat bndrs
516 go (ParPat pat) = collect_lpat pat bndrs
518 go (ListPat pats _) = foldr collect_lpat bndrs pats
519 go (PArrPat pats _) = foldr collect_lpat bndrs pats
520 go (TuplePat pats _ _) = foldr collect_lpat bndrs pats
522 go (ConPatIn _ ps) = foldr collect_lpat bndrs (hsConPatArgs ps)
523 go (ConPatOut {pat_args=ps}) = foldr collect_lpat bndrs (hsConPatArgs ps)
524 -- See Note [Dictionary binders in ConPatOut]
525 go (LitPat _) = bndrs
526 go (NPat _ _ _) = bndrs
527 go (NPlusKPat (L _ n) _ _ _) = n : bndrs
529 go (SigPatIn pat _) = collect_lpat pat bndrs
530 go (SigPatOut pat _) = collect_lpat pat bndrs
531 go (QuasiQuotePat _) = bndrs
532 go (TypePat _) = bndrs
533 go (CoPat _ pat _) = go pat
536 Note [Dictionary binders in ConPatOut] See also same Note in DsArrows
537 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
538 Do *not* gather (a) dictionary and (b) dictionary bindings as binders
539 of a ConPatOut pattern. For most calls it doesn't matter, because
540 it's pre-typechecker and there are no ConPatOuts. But it does matter
541 more in the desugarer; for example, DsUtils.mkSelectorBinds uses
542 collectPatBinders. In a lazy pattern, for example f ~(C x y) = ...,
543 we want to generate bindings for x,y but not for dictionaries bound by
544 C. (The type checker ensures they would not be used.)
546 Desugaring of arrow case expressions needs these bindings (see DsArrows
547 and arrowcase1), but SPJ (Jan 2007) says it's safer for it to use its
548 own pat-binder-collector:
550 Here's the problem. Consider
553 C :: Num a => a -> Int -> T a
555 f ~(C (n+1) m) = (n,m)
557 Here, the pattern (C (n+1)) binds a hidden dictionary (d::Num a),
558 and *also* uses that dictionary to match the (n+1) pattern. Yet, the
559 variables bound by the lazy pattern are n,m, *not* the dictionary d.
560 So in mkSelectorBinds in DsUtils, we want just m,n as the variables bound.
563 hsGroupBinders :: HsGroup Name -> [Name]
564 hsGroupBinders (HsGroup { hs_valds = val_decls, hs_tyclds = tycl_decls,
565 hs_instds = inst_decls, hs_fords = foreign_decls })
566 -- Collect the binders of a Group
567 = collectHsValBinders val_decls
568 ++ hsTyClDeclsBinders tycl_decls inst_decls
569 ++ hsForeignDeclsBinders foreign_decls
571 hsForeignDeclsBinders :: [LForeignDecl Name] -> [Name]
572 hsForeignDeclsBinders foreign_decls
573 = [n | L _ (ForeignImport (L _ n) _ _) <- foreign_decls]
575 hsTyClDeclsBinders :: [Located (TyClDecl Name)] -> [Located (InstDecl Name)] -> [Name]
576 hsTyClDeclsBinders tycl_decls inst_decls
577 = [n | d <- instDeclATs inst_decls ++ tycl_decls, L _ n <- hsTyClDeclBinders d]
579 hsTyClDeclBinders :: Eq name => Located (TyClDecl name) -> [Located name]
580 -- ^ Returns all the /binding/ names of the decl, along with their SrcLocs.
581 -- The first one is guaranteed to be the name of the decl. For record fields
582 -- mentioned in multiple constructors, the SrcLoc will be from the first
583 -- occurence. We use the equality to filter out duplicate field names
585 hsTyClDeclBinders (L _ (TyFamily {tcdLName = name})) = [name]
586 hsTyClDeclBinders (L _ (TySynonym {tcdLName = name})) = [name]
587 hsTyClDeclBinders (L _ (ForeignType {tcdLName = name})) = [name]
589 hsTyClDeclBinders (L _ (ClassDecl {tcdLName = cls_name, tcdSigs = sigs, tcdATs = ats}))
591 concatMap hsTyClDeclBinders ats ++ [n | L _ (TypeSig n _) <- sigs]
593 hsTyClDeclBinders (L _ (TyData {tcdLName = tc_name, tcdCons = cons}))
594 = tc_name : hsConDeclsBinders cons
596 hsConDeclsBinders :: (Eq name) => [LConDecl name] -> [Located name]
597 -- See hsTyClDeclBinders for what this does
598 -- The function is boringly complicated because of the records
599 -- And since we only have equality, we have to be a little careful
600 hsConDeclsBinders cons
601 = snd (foldl do_one ([], []) cons)
603 do_one (flds_seen, acc) (L _ (ConDecl { con_name = lname, con_details = RecCon flds }))
604 = (map unLoc new_flds ++ flds_seen, lname : new_flds ++ acc)
606 new_flds = filterOut (\f -> unLoc f `elem` flds_seen)
607 (map cd_fld_name flds)
609 do_one (flds_seen, acc) (L _ (ConDecl { con_name = lname }))
610 = (flds_seen, lname:acc)
614 %************************************************************************
616 Collecting type signatures from patterns
618 %************************************************************************
621 collectSigTysFromPats :: [InPat name] -> [LHsType name]
622 collectSigTysFromPats pats = foldr collect_sig_lpat [] pats
624 collectSigTysFromPat :: InPat name -> [LHsType name]
625 collectSigTysFromPat pat = collect_sig_lpat pat []
627 collect_sig_lpat :: InPat name -> [LHsType name] -> [LHsType name]
628 collect_sig_lpat pat acc = collect_sig_pat (unLoc pat) acc
630 collect_sig_pat :: Pat name -> [LHsType name] -> [LHsType name]
631 collect_sig_pat (SigPatIn pat ty) acc = collect_sig_lpat pat (ty:acc)
632 collect_sig_pat (TypePat ty) acc = ty:acc
634 collect_sig_pat (LazyPat pat) acc = collect_sig_lpat pat acc
635 collect_sig_pat (BangPat pat) acc = collect_sig_lpat pat acc
636 collect_sig_pat (AsPat _ pat) acc = collect_sig_lpat pat acc
637 collect_sig_pat (ParPat pat) acc = collect_sig_lpat pat acc
638 collect_sig_pat (ListPat pats _) acc = foldr collect_sig_lpat acc pats
639 collect_sig_pat (PArrPat pats _) acc = foldr collect_sig_lpat acc pats
640 collect_sig_pat (TuplePat pats _ _) acc = foldr collect_sig_lpat acc pats
641 collect_sig_pat (ConPatIn _ ps) acc = foldr collect_sig_lpat acc (hsConPatArgs ps)
642 collect_sig_pat _ acc = acc -- Literals, vars, wildcard