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,
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 mkNPat lit neg = NPat lit neg noSyntaxExpr
209 mkNPlusKPat id lit = NPlusKPat id lit noSyntaxExpr noSyntaxExpr
211 mkTransformStmt stmts usingExpr = TransformStmt stmts [] usingExpr Nothing
212 mkTransformByStmt stmts usingExpr byExpr = TransformStmt stmts [] usingExpr (Just byExpr)
214 mkGroupUsingStmt :: [LStmt idL] -> LHsExpr idR -> StmtLR idL idR
215 mkGroupByStmt :: [LStmt idL] -> LHsExpr idR -> StmtLR idL idR
216 mkGroupByUsingStmt :: [LStmt idL] -> LHsExpr idR -> LHsExpr idR -> StmtLR idL idR
218 mkGroupUsingStmt stmts usingExpr = GroupStmt stmts [] Nothing (Left usingExpr)
219 mkGroupByStmt stmts byExpr = GroupStmt stmts [] (Just byExpr) (Right noSyntaxExpr)
220 mkGroupByUsingStmt stmts byExpr usingExpr = GroupStmt stmts [] (Just byExpr) (Left usingExpr)
222 mkExprStmt expr = ExprStmt expr noSyntaxExpr placeHolderType
223 mkBindStmt pat expr = BindStmt pat expr noSyntaxExpr noSyntaxExpr
225 emptyRecStmt = RecStmt { recS_stmts = [], recS_later_ids = [], recS_rec_ids = []
226 , recS_ret_fn = noSyntaxExpr, recS_mfix_fn = noSyntaxExpr
227 , recS_bind_fn = noSyntaxExpr
228 , recS_rec_rets = [], recS_dicts = emptyTcEvBinds }
230 mkRecStmt stmts = emptyRecStmt { recS_stmts = stmts }
232 -------------------------------
233 --- A useful function for building @OpApps@. The operator is always a
234 -- variable, and we don't know the fixity yet.
235 mkHsOpApp :: LHsExpr id -> id -> LHsExpr id -> HsExpr id
236 mkHsOpApp e1 op e2 = OpApp e1 (noLoc (HsVar op)) (error "mkOpApp:fixity") e2
238 mkHsSplice :: LHsExpr RdrName -> HsSplice RdrName
239 mkHsSplice e = HsSplice unqualSplice e
241 mkHsSpliceTy :: LHsExpr RdrName -> HsType RdrName
242 mkHsSpliceTy e = HsSpliceTy (mkHsSplice e) emptyFVs placeHolderKind
244 unqualSplice :: RdrName
245 unqualSplice = mkRdrUnqual (mkVarOccFS (fsLit "splice"))
246 -- A name (uniquified later) to
247 -- identify the splice
249 mkHsQuasiQuote :: RdrName -> SrcSpan -> FastString -> HsQuasiQuote RdrName
250 mkHsQuasiQuote quoter span quote = HsQuasiQuote quoter span quote
252 unqualQuasiQuote :: RdrName
253 unqualQuasiQuote = mkRdrUnqual (mkVarOccFS (fsLit "quasiquote"))
254 -- A name (uniquified later) to
255 -- identify the quasi-quote
257 mkHsString :: String -> HsLit
258 mkHsString s = HsString (mkFastString s)
261 userHsTyVarBndrs :: [Located name] -> [Located (HsTyVarBndr name)]
262 userHsTyVarBndrs bndrs = [ L loc (UserTyVar v placeHolderKind) | L loc v <- bndrs ]
266 %************************************************************************
268 Constructing syntax with no location info
270 %************************************************************************
273 nlHsVar :: id -> LHsExpr id
274 nlHsVar n = noLoc (HsVar n)
276 nlHsLit :: HsLit -> LHsExpr id
277 nlHsLit n = noLoc (HsLit n)
279 nlVarPat :: id -> LPat id
280 nlVarPat n = noLoc (VarPat n)
282 nlLitPat :: HsLit -> LPat id
283 nlLitPat l = noLoc (LitPat l)
285 nlHsApp :: LHsExpr id -> LHsExpr id -> LHsExpr id
286 nlHsApp f x = noLoc (HsApp f x)
288 nlHsIntLit :: Integer -> LHsExpr id
289 nlHsIntLit n = noLoc (HsLit (HsInt n))
291 nlHsApps :: id -> [LHsExpr id] -> LHsExpr id
292 nlHsApps f xs = foldl nlHsApp (nlHsVar f) xs
294 nlHsVarApps :: id -> [id] -> LHsExpr id
295 nlHsVarApps f xs = noLoc (foldl mk (HsVar f) (map HsVar xs))
297 mk f a = HsApp (noLoc f) (noLoc a)
299 nlConVarPat :: id -> [id] -> LPat id
300 nlConVarPat con vars = nlConPat con (map nlVarPat vars)
302 nlInfixConPat :: id -> LPat id -> LPat id -> LPat id
303 nlInfixConPat con l r = noLoc (ConPatIn (noLoc con) (InfixCon l r))
305 nlConPat :: id -> [LPat id] -> LPat id
306 nlConPat con pats = noLoc (ConPatIn (noLoc con) (PrefixCon pats))
308 nlNullaryConPat :: id -> LPat id
309 nlNullaryConPat con = noLoc (ConPatIn (noLoc con) (PrefixCon []))
311 nlWildConPat :: DataCon -> LPat RdrName
312 nlWildConPat con = noLoc (ConPatIn (noLoc (getRdrName con))
313 (PrefixCon (nOfThem (dataConSourceArity con) nlWildPat)))
316 nlWildPat = noLoc (WildPat placeHolderType) -- Pre-typechecking
318 nlHsDo :: HsStmtContext Name -> [LStmt id] -> LHsExpr id -> LHsExpr id
319 nlHsDo ctxt stmts body = noLoc (mkHsDo ctxt stmts body)
321 nlHsOpApp :: LHsExpr id -> id -> LHsExpr id -> LHsExpr id
322 nlHsOpApp e1 op e2 = noLoc (mkHsOpApp e1 op e2)
324 nlHsLam :: LMatch id -> LHsExpr id
325 nlHsPar :: LHsExpr id -> LHsExpr id
326 nlHsIf :: LHsExpr id -> LHsExpr id -> LHsExpr id -> LHsExpr id
327 nlHsCase :: LHsExpr id -> [LMatch id] -> LHsExpr id
328 nlList :: [LHsExpr id] -> LHsExpr id
330 nlHsLam match = noLoc (HsLam (mkMatchGroup [match]))
331 nlHsPar e = noLoc (HsPar e)
332 nlHsIf cond true false = noLoc (HsIf cond true false)
333 nlHsCase expr matches = noLoc (HsCase expr (mkMatchGroup matches))
334 nlList exprs = noLoc (ExplicitList placeHolderType exprs)
336 nlHsAppTy :: LHsType name -> LHsType name -> LHsType name
337 nlHsTyVar :: name -> LHsType name
338 nlHsFunTy :: LHsType name -> LHsType name -> LHsType name
340 nlHsAppTy f t = noLoc (HsAppTy f t)
341 nlHsTyVar x = noLoc (HsTyVar x)
342 nlHsFunTy a b = noLoc (HsFunTy a b)
344 nlHsTyConApp :: name -> [LHsType name] -> LHsType name
345 nlHsTyConApp tycon tys = foldl nlHsAppTy (nlHsTyVar tycon) tys
348 Tuples. All these functions are *pre-typechecker* because they lack
352 mkLHsTupleExpr :: [LHsExpr a] -> LHsExpr a
353 -- Makes a pre-typechecker boxed tuple, deals with 1 case
354 mkLHsTupleExpr [e] = e
355 mkLHsTupleExpr es = noLoc $ ExplicitTuple (map Present es) Boxed
357 mkLHsVarTuple :: [a] -> LHsExpr a
358 mkLHsVarTuple ids = mkLHsTupleExpr (map nlHsVar ids)
360 nlTuplePat :: [LPat id] -> Boxity -> LPat id
361 nlTuplePat pats box = noLoc (TuplePat pats box placeHolderType)
363 missingTupArg :: HsTupArg a
364 missingTupArg = Missing placeHolderType
367 %************************************************************************
369 Bindings; with a location at the top
371 %************************************************************************
374 mkFunBind :: Located id -> [LMatch id] -> HsBind id
375 -- Not infix, with place holders for coercion and free vars
376 mkFunBind fn ms = FunBind { fun_id = fn, fun_infix = False, fun_matches = mkMatchGroup ms,
377 fun_co_fn = idHsWrapper, bind_fvs = placeHolderNames,
381 mkHsVarBind :: SrcSpan -> id -> LHsExpr id -> LHsBind id
382 mkHsVarBind loc var rhs = mk_easy_FunBind loc var [] rhs
384 mkVarBind :: id -> LHsExpr id -> LHsBind id
385 mkVarBind var rhs = L (getLoc rhs) $
386 VarBind { var_id = var, var_rhs = rhs, var_inline = False }
389 mk_easy_FunBind :: SrcSpan -> id -> [LPat id]
390 -> LHsExpr id -> LHsBind id
392 mk_easy_FunBind loc fun pats expr
393 = L loc $ mkFunBind (L loc fun) [mkMatch pats expr emptyLocalBinds]
396 mkMatch :: [LPat id] -> LHsExpr id -> HsLocalBinds id -> LMatch id
397 mkMatch pats expr binds
398 = noLoc (Match (map paren pats) Nothing
399 (GRHSs (unguardedRHS expr) binds))
401 paren lp@(L l p) | hsPatNeedsParens p = L l (ParPat lp)
406 %************************************************************************
410 %************************************************************************
412 Get all the binders in some HsBindGroups, IN THE ORDER OF APPEARANCE. eg.
420 it should return [x, y, f, a, b] (remember, order important).
422 Note [Collect binders only after renaming]
423 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
424 These functions should only be used on HsSyn *after* the renamer,
425 to return a [Name] or [Id]. Before renaming the record punning
426 and wild-card mechanism makes it hard to know what is bound.
427 So these functions should not be applied to (HsSyn RdrName)
430 ----------------- Bindings --------------------------
431 collectLocalBinders :: HsLocalBindsLR idL idR -> [idL]
432 collectLocalBinders (HsValBinds val_binds) = collectHsValBinders val_binds
433 collectLocalBinders (HsIPBinds _) = []
434 collectLocalBinders EmptyLocalBinds = []
436 collectHsValBinders :: HsValBindsLR idL idR -> [idL]
437 collectHsValBinders (ValBindsIn binds _) = collectHsBindsBinders binds
438 collectHsValBinders (ValBindsOut binds _) = foldr collect_one [] binds
440 collect_one (_,binds) acc = collect_binds binds acc
442 collectHsBindBinders :: HsBindLR idL idR -> [idL]
443 collectHsBindBinders b = collect_bind b []
445 collect_bind :: HsBindLR idL idR -> [idL] -> [idL]
446 collect_bind (PatBind { pat_lhs = p }) acc = collect_lpat p acc
447 collect_bind (FunBind { fun_id = L _ f }) acc = f : acc
448 collect_bind (VarBind { var_id = f }) acc = f : acc
449 collect_bind (AbsBinds { abs_exports = dbinds, abs_binds = _binds }) acc
450 = [dp | (_,dp,_,_) <- dbinds] ++ acc
451 -- ++ foldr collect_bind acc binds
452 -- I don't think we want the binders from the nested binds
453 -- The only time we collect binders from a typechecked
454 -- binding (hence see AbsBinds) is in zonking in TcHsSyn
456 collectHsBindsBinders :: LHsBindsLR idL idR -> [idL]
457 collectHsBindsBinders binds = collect_binds binds []
459 collectHsBindListBinders :: [LHsBindLR idL idR] -> [idL]
460 collectHsBindListBinders = foldr (collect_bind . unLoc) []
462 collect_binds :: LHsBindsLR idL idR -> [idL] -> [idL]
463 collect_binds binds acc = foldrBag (collect_bind . unLoc) acc binds
465 collectMethodBinders :: LHsBindsLR RdrName idR -> [Located RdrName]
466 -- Used exclusively for the bindings of an instance decl which are all FunBinds
467 collectMethodBinders binds = foldrBag get [] binds
469 get (L _ (FunBind { fun_id = f })) fs = f : fs
471 -- Someone else complains about non-FunBinds
473 ----------------- Statements --------------------------
474 collectLStmtsBinders :: [LStmtLR idL idR] -> [idL]
475 collectLStmtsBinders = concatMap collectLStmtBinders
477 collectStmtsBinders :: [StmtLR idL idR] -> [idL]
478 collectStmtsBinders = concatMap collectStmtBinders
480 collectLStmtBinders :: LStmtLR idL idR -> [idL]
481 collectLStmtBinders = collectStmtBinders . unLoc
483 collectStmtBinders :: StmtLR idL idR -> [idL]
484 -- Id Binders for a Stmt... [but what about pattern-sig type vars]?
485 collectStmtBinders (BindStmt pat _ _ _) = collectPatBinders pat
486 collectStmtBinders (LetStmt binds) = collectLocalBinders binds
487 collectStmtBinders (ExprStmt _ _ _) = []
488 collectStmtBinders (ParStmt xs) = collectLStmtsBinders
490 collectStmtBinders (TransformStmt stmts _ _ _) = collectLStmtsBinders stmts
491 collectStmtBinders (GroupStmt stmts _ _ _) = collectLStmtsBinders stmts
492 collectStmtBinders (RecStmt { recS_stmts = ss }) = collectLStmtsBinders ss
495 ----------------- Patterns --------------------------
496 collectPatBinders :: LPat a -> [a]
497 collectPatBinders pat = collect_lpat pat []
499 collectPatsBinders :: [LPat a] -> [a]
500 collectPatsBinders pats = foldr collect_lpat [] pats
503 collect_lpat :: LPat name -> [name] -> [name]
504 collect_lpat (L _ pat) bndrs
507 go (VarPat var) = var : bndrs
508 go (VarPatOut var _) = var : bndrs
509 -- See Note [Dictionary binders in ConPatOut]
510 go (WildPat _) = bndrs
511 go (LazyPat pat) = collect_lpat pat bndrs
512 go (BangPat pat) = collect_lpat pat bndrs
513 go (AsPat (L _ a) pat) = a : collect_lpat pat bndrs
514 go (ViewPat _ pat _) = collect_lpat pat bndrs
515 go (ParPat pat) = collect_lpat pat bndrs
517 go (ListPat pats _) = foldr collect_lpat bndrs pats
518 go (PArrPat pats _) = foldr collect_lpat bndrs pats
519 go (TuplePat pats _ _) = foldr collect_lpat bndrs pats
521 go (ConPatIn _ ps) = foldr collect_lpat bndrs (hsConPatArgs ps)
522 go (ConPatOut {pat_args=ps}) = foldr collect_lpat bndrs (hsConPatArgs ps)
523 -- See Note [Dictionary binders in ConPatOut]
524 go (LitPat _) = bndrs
525 go (NPat _ _ _) = bndrs
526 go (NPlusKPat (L _ n) _ _ _) = n : bndrs
528 go (SigPatIn pat _) = collect_lpat pat bndrs
529 go (SigPatOut pat _) = collect_lpat pat bndrs
530 go (QuasiQuotePat _) = bndrs
531 go (TypePat _) = bndrs
532 go (CoPat _ pat _) = go pat
535 Note [Dictionary binders in ConPatOut] See also same Note in DsArrows
536 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
537 Do *not* gather (a) dictionary and (b) dictionary bindings as binders
538 of a ConPatOut pattern. For most calls it doesn't matter, because
539 it's pre-typechecker and there are no ConPatOuts. But it does matter
540 more in the desugarer; for example, DsUtils.mkSelectorBinds uses
541 collectPatBinders. In a lazy pattern, for example f ~(C x y) = ...,
542 we want to generate bindings for x,y but not for dictionaries bound by
543 C. (The type checker ensures they would not be used.)
545 Desugaring of arrow case expressions needs these bindings (see DsArrows
546 and arrowcase1), but SPJ (Jan 2007) says it's safer for it to use its
547 own pat-binder-collector:
549 Here's the problem. Consider
552 C :: Num a => a -> Int -> T a
554 f ~(C (n+1) m) = (n,m)
556 Here, the pattern (C (n+1)) binds a hidden dictionary (d::Num a),
557 and *also* uses that dictionary to match the (n+1) pattern. Yet, the
558 variables bound by the lazy pattern are n,m, *not* the dictionary d.
559 So in mkSelectorBinds in DsUtils, we want just m,n as the variables bound.
562 hsGroupBinders :: HsGroup Name -> [Name]
563 hsGroupBinders (HsGroup { hs_valds = val_decls, hs_tyclds = tycl_decls,
564 hs_instds = inst_decls, hs_fords = foreign_decls })
565 -- Collect the binders of a Group
566 = collectHsValBinders val_decls
567 ++ hsTyClDeclsBinders tycl_decls inst_decls
568 ++ hsForeignDeclsBinders foreign_decls
570 hsForeignDeclsBinders :: [LForeignDecl Name] -> [Name]
571 hsForeignDeclsBinders foreign_decls
572 = [n | L _ (ForeignImport (L _ n) _ _) <- foreign_decls]
574 hsTyClDeclsBinders :: [Located (TyClDecl Name)] -> [Located (InstDecl Name)] -> [Name]
575 hsTyClDeclsBinders tycl_decls inst_decls
576 = [n | d <- instDeclATs inst_decls ++ tycl_decls, L _ n <- hsTyClDeclBinders d]
578 hsTyClDeclBinders :: Eq name => Located (TyClDecl name) -> [Located name]
579 -- ^ Returns all the /binding/ names of the decl, along with their SrcLocs.
580 -- The first one is guaranteed to be the name of the decl. For record fields
581 -- mentioned in multiple constructors, the SrcLoc will be from the first
582 -- occurence. We use the equality to filter out duplicate field names
584 hsTyClDeclBinders (L _ (TyFamily {tcdLName = name})) = [name]
585 hsTyClDeclBinders (L _ (TySynonym {tcdLName = name})) = [name]
586 hsTyClDeclBinders (L _ (ForeignType {tcdLName = name})) = [name]
588 hsTyClDeclBinders (L _ (ClassDecl {tcdLName = cls_name, tcdSigs = sigs, tcdATs = ats}))
590 concatMap hsTyClDeclBinders ats ++ [n | L _ (TypeSig n _) <- sigs]
592 hsTyClDeclBinders (L _ (TyData {tcdLName = tc_name, tcdCons = cons}))
593 = tc_name : hsConDeclsBinders cons
595 hsConDeclsBinders :: (Eq name) => [LConDecl name] -> [Located name]
596 -- See hsTyClDeclBinders for what this does
597 -- The function is boringly complicated because of the records
598 -- And since we only have equality, we have to be a little careful
599 hsConDeclsBinders cons
600 = snd (foldl do_one ([], []) cons)
602 do_one (flds_seen, acc) (L _ (ConDecl { con_name = lname, con_details = RecCon flds }))
603 = (map unLoc new_flds ++ flds_seen, lname : new_flds ++ acc)
605 new_flds = filterOut (\f -> unLoc f `elem` flds_seen)
606 (map cd_fld_name flds)
608 do_one (flds_seen, acc) (L _ (ConDecl { con_name = lname }))
609 = (flds_seen, lname:acc)
613 %************************************************************************
615 Collecting type signatures from patterns
617 %************************************************************************
620 collectSigTysFromPats :: [InPat name] -> [LHsType name]
621 collectSigTysFromPats pats = foldr collect_sig_lpat [] pats
623 collectSigTysFromPat :: InPat name -> [LHsType name]
624 collectSigTysFromPat pat = collect_sig_lpat pat []
626 collect_sig_lpat :: InPat name -> [LHsType name] -> [LHsType name]
627 collect_sig_lpat pat acc = collect_sig_pat (unLoc pat) acc
629 collect_sig_pat :: Pat name -> [LHsType name] -> [LHsType name]
630 collect_sig_pat (SigPatIn pat ty) acc = collect_sig_lpat pat (ty:acc)
631 collect_sig_pat (TypePat ty) acc = ty:acc
633 collect_sig_pat (LazyPat pat) acc = collect_sig_lpat pat acc
634 collect_sig_pat (BangPat pat) acc = collect_sig_lpat pat acc
635 collect_sig_pat (AsPat _ pat) acc = collect_sig_lpat pat acc
636 collect_sig_pat (ParPat pat) acc = collect_sig_lpat pat acc
637 collect_sig_pat (ListPat pats _) acc = foldr collect_sig_lpat acc pats
638 collect_sig_pat (PArrPat pats _) acc = foldr collect_sig_lpat acc pats
639 collect_sig_pat (TuplePat pats _ _) acc = foldr collect_sig_lpat acc pats
640 collect_sig_pat (ConPatIn _ ps) acc = foldr collect_sig_lpat acc (hsConPatArgs ps)
641 collect_sig_pat _ acc = acc -- Literals, vars, wildcard