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, mkHsLams, mkHsDictLet,
24 mkHsOpApp, mkHsDo, mkHsComp, mkHsWrapPat, mkHsWrapPatCoI, mkDoStmts,
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, mkLastStmt,
46 emptyGroupStmt, 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,
64 hsForeignDeclsBinders, hsGroupBinders,
66 -- Collecting implicit binders
67 lStmtsImplicits, hsValBindsImplicits, lPatImplicits
95 %************************************************************************
97 Some useful helpers for constructing syntax
99 %************************************************************************
101 These functions attempt to construct a not-completely-useless SrcSpan
102 from their components, compared with the nl* functions below which
103 just attach noSrcSpan to everything.
106 mkHsPar :: LHsExpr id -> LHsExpr id
107 mkHsPar e = L (getLoc e) (HsPar e)
109 mkSimpleMatch :: [LPat id] -> LHsExpr id -> LMatch id
110 mkSimpleMatch pats rhs
112 Match pats Nothing (unguardedGRHSs rhs)
116 (pat:_) -> combineSrcSpans (getLoc pat) (getLoc rhs)
118 unguardedGRHSs :: LHsExpr id -> GRHSs id
119 unguardedGRHSs rhs = GRHSs (unguardedRHS rhs) emptyLocalBinds
121 unguardedRHS :: LHsExpr id -> [LGRHS id]
122 unguardedRHS rhs@(L loc _) = [L loc (GRHS [] rhs)]
124 mkHsAppTy :: LHsType name -> LHsType name -> LHsType name
125 mkHsAppTy t1 t2 = addCLoc t1 t2 (HsAppTy t1 t2)
127 mkHsApp :: LHsExpr name -> LHsExpr name -> LHsExpr name
128 mkHsApp e1 e2 = addCLoc e1 e2 (HsApp e1 e2)
130 nlHsTyApp :: name -> [Type] -> LHsExpr name
131 nlHsTyApp fun_id tys = noLoc (HsWrap (mkWpTyApps tys) (HsVar fun_id))
133 mkLHsWrap :: HsWrapper -> LHsExpr id -> LHsExpr id
134 mkLHsWrap co_fn (L loc e) = L loc (mkHsWrap co_fn e)
136 mkHsWrap :: HsWrapper -> HsExpr id -> HsExpr id
137 mkHsWrap co_fn e | isIdHsWrapper co_fn = e
138 | otherwise = HsWrap co_fn e
140 mkHsWrapCoI :: CoercionI -> HsExpr id -> HsExpr id
141 mkHsWrapCoI (IdCo _) e = e
142 mkHsWrapCoI (ACo co) e = mkHsWrap (WpCast co) e
144 mkLHsWrapCoI :: CoercionI -> LHsExpr id -> LHsExpr id
145 mkLHsWrapCoI (IdCo _) e = e
146 mkLHsWrapCoI (ACo co) (L loc e) = L loc (mkHsWrap (WpCast co) e)
148 coiToHsWrapper :: CoercionI -> HsWrapper
149 coiToHsWrapper (IdCo _) = idHsWrapper
150 coiToHsWrapper (ACo co) = WpCast co
152 mkHsWrapPat :: HsWrapper -> Pat id -> Type -> Pat id
153 mkHsWrapPat co_fn p ty | isIdHsWrapper co_fn = p
154 | otherwise = CoPat co_fn p ty
156 mkHsWrapPatCoI :: CoercionI -> Pat id -> Type -> Pat id
157 mkHsWrapPatCoI (IdCo _) pat _ = pat
158 mkHsWrapPatCoI (ACo co) pat ty = CoPat (WpCast co) pat ty
160 mkHsLam :: [LPat id] -> LHsExpr id -> LHsExpr id
161 mkHsLam pats body = mkHsPar (L (getLoc body) (HsLam matches))
163 matches = mkMatchGroup [mkSimpleMatch pats body]
165 mkMatchGroup :: [LMatch id] -> MatchGroup id
166 mkMatchGroup matches = MatchGroup matches placeHolderType
168 mkHsLams :: [TyVar] -> [EvVar] -> LHsExpr Id -> LHsExpr Id
169 mkHsLams tyvars dicts expr = mkLHsWrap (mkWpTyLams tyvars <.> mkWpLams dicts) expr
171 mkHsDictLet :: TcEvBinds -> LHsExpr Id -> LHsExpr Id
172 mkHsDictLet ev_binds expr = mkLHsWrap (mkWpLet ev_binds) expr
174 mkHsConApp :: DataCon -> [Type] -> [HsExpr Id] -> LHsExpr Id
175 -- Used for constructing dictionary terms etc, so no locations
176 mkHsConApp data_con tys args
177 = foldl mk_app (nlHsTyApp (dataConWrapId data_con) tys) args
179 mk_app f a = noLoc (HsApp f (noLoc a))
181 mkSimpleHsAlt :: LPat id -> LHsExpr id -> LMatch id
182 -- A simple lambda with a single pattern, no binds, no guards; pre-typechecking
183 mkSimpleHsAlt pat expr
184 = mkSimpleMatch [pat] expr
186 -------------------------------
187 -- These are the bits of syntax that contain rebindable names
188 -- See RnEnv.lookupSyntaxName
190 mkHsIntegral :: Integer -> PostTcType -> HsOverLit id
191 mkHsFractional :: Rational -> PostTcType -> HsOverLit id
192 mkHsIsString :: FastString -> PostTcType -> HsOverLit id
193 mkHsDo :: HsStmtContext Name -> [LStmt id] -> HsExpr id
194 mkHsComp :: HsStmtContext Name -> [LStmt id] -> LHsExpr id -> HsExpr id
195 mkDoStmts :: [LStmt id] -> [LStmt id]
197 mkNPat :: HsOverLit id -> Maybe (SyntaxExpr id) -> Pat id
198 mkNPlusKPat :: Located id -> HsOverLit id -> Pat id
200 mkTransformStmt :: [LStmt idL] -> LHsExpr idR -> StmtLR idL idR
201 mkTransformByStmt :: [LStmt idL] -> LHsExpr idR -> LHsExpr idR -> StmtLR idL idR
203 mkLastStmt :: LHsExpr idR -> StmtLR idL idR
204 mkExprStmt :: LHsExpr idR -> StmtLR idL idR
205 mkBindStmt :: LPat idL -> LHsExpr idR -> StmtLR idL idR
207 emptyRecStmt :: StmtLR idL idR
208 mkRecStmt :: [LStmtLR idL idR] -> StmtLR idL idR
211 mkHsIntegral i = OverLit (HsIntegral i) noRebindableInfo noSyntaxExpr
212 mkHsFractional f = OverLit (HsFractional f) noRebindableInfo noSyntaxExpr
213 mkHsIsString s = OverLit (HsIsString s) noRebindableInfo noSyntaxExpr
215 noRebindableInfo :: Bool
216 noRebindableInfo = error "noRebindableInfo" -- Just another placeholder;
218 -- mkDoStmts turns a trailing ExprStmt into a LastStmt
219 mkDoStmts [L loc (ExprStmt e _ _ _)] = [L loc (mkLastStmt e)]
220 mkDoStmts (s:ss) = s : mkDoStmts ss
223 mkHsDo ctxt stmts = HsDo ctxt stmts placeHolderType
224 mkHsComp ctxt stmts expr = mkHsDo ctxt (stmts ++ [last_stmt])
226 last_stmt = L (getLoc expr) $ mkLastStmt expr
228 mkHsIf :: LHsExpr id -> LHsExpr id -> LHsExpr id -> HsExpr id
229 mkHsIf c a b = HsIf (Just noSyntaxExpr) c a b
231 mkNPat lit neg = NPat lit neg noSyntaxExpr
232 mkNPlusKPat id lit = NPlusKPat id lit noSyntaxExpr noSyntaxExpr
234 mkTransformStmt stmts usingExpr = TransformStmt stmts [] usingExpr Nothing noSyntaxExpr noSyntaxExpr
235 mkTransformByStmt stmts usingExpr byExpr = TransformStmt stmts [] usingExpr (Just byExpr) noSyntaxExpr noSyntaxExpr
237 mkGroupUsingStmt :: [LStmt idL] -> LHsExpr idR -> StmtLR idL idR
238 mkGroupByStmt :: [LStmt idL] -> LHsExpr idR -> StmtLR idL idR
239 mkGroupByUsingStmt :: [LStmt idL] -> LHsExpr idR -> LHsExpr idR -> StmtLR idL idR
241 emptyGroupStmt :: StmtLR idL idR
242 emptyGroupStmt = GroupStmt { grpS_stmts = [], grpS_bndrs = [], grpS_explicit = False
243 , grpS_by = Nothing, grpS_using = noLoc noSyntaxExpr
244 , grpS_ret = noSyntaxExpr, grpS_bind = noSyntaxExpr
245 , grpS_fmap = noSyntaxExpr }
246 mkGroupUsingStmt ss u = emptyGroupStmt { grpS_stmts = ss, grpS_explicit = True, grpS_using = u }
247 mkGroupByStmt ss b = emptyGroupStmt { grpS_stmts = ss, grpS_by = Just b }
248 mkGroupByUsingStmt ss b u = emptyGroupStmt { grpS_stmts = ss, grpS_by = Just b
249 , grpS_explicit = True, grpS_using = u }
251 mkLastStmt expr = LastStmt expr noSyntaxExpr
252 mkExprStmt expr = ExprStmt expr noSyntaxExpr noSyntaxExpr placeHolderType
253 mkBindStmt pat expr = BindStmt pat expr noSyntaxExpr noSyntaxExpr
255 emptyRecStmt = RecStmt { recS_stmts = [], recS_later_ids = [], recS_rec_ids = []
256 , recS_ret_fn = noSyntaxExpr, recS_mfix_fn = noSyntaxExpr
257 , recS_bind_fn = noSyntaxExpr
258 , recS_rec_rets = [], recS_ret_ty = placeHolderType }
260 mkRecStmt stmts = emptyRecStmt { recS_stmts = stmts }
262 -------------------------------
263 --- A useful function for building @OpApps@. The operator is always a
264 -- variable, and we don't know the fixity yet.
265 mkHsOpApp :: LHsExpr id -> id -> LHsExpr id -> HsExpr id
266 mkHsOpApp e1 op e2 = OpApp e1 (noLoc (HsVar op)) (error "mkOpApp:fixity") e2
268 mkHsSplice :: LHsExpr RdrName -> HsSplice RdrName
269 mkHsSplice e = HsSplice unqualSplice e
271 mkHsSpliceTy :: LHsExpr RdrName -> HsType RdrName
272 mkHsSpliceTy e = HsSpliceTy (mkHsSplice e) emptyFVs placeHolderKind
274 unqualSplice :: RdrName
275 unqualSplice = mkRdrUnqual (mkVarOccFS (fsLit "splice"))
276 -- A name (uniquified later) to
277 -- identify the splice
279 mkHsQuasiQuote :: RdrName -> SrcSpan -> FastString -> HsQuasiQuote RdrName
280 mkHsQuasiQuote quoter span quote = HsQuasiQuote quoter span quote
282 unqualQuasiQuote :: RdrName
283 unqualQuasiQuote = mkRdrUnqual (mkVarOccFS (fsLit "quasiquote"))
284 -- A name (uniquified later) to
285 -- identify the quasi-quote
287 mkHsString :: String -> HsLit
288 mkHsString s = HsString (mkFastString s)
291 userHsTyVarBndrs :: [Located name] -> [Located (HsTyVarBndr name)]
292 userHsTyVarBndrs bndrs = [ L loc (UserTyVar v placeHolderKind) | L loc v <- bndrs ]
296 %************************************************************************
298 Constructing syntax with no location info
300 %************************************************************************
303 nlHsVar :: id -> LHsExpr id
304 nlHsVar n = noLoc (HsVar n)
306 nlHsLit :: HsLit -> LHsExpr id
307 nlHsLit n = noLoc (HsLit n)
309 nlVarPat :: id -> LPat id
310 nlVarPat n = noLoc (VarPat n)
312 nlLitPat :: HsLit -> LPat id
313 nlLitPat l = noLoc (LitPat l)
315 nlHsApp :: LHsExpr id -> LHsExpr id -> LHsExpr id
316 nlHsApp f x = noLoc (HsApp f x)
318 nlHsIntLit :: Integer -> LHsExpr id
319 nlHsIntLit n = noLoc (HsLit (HsInt n))
321 nlHsApps :: id -> [LHsExpr id] -> LHsExpr id
322 nlHsApps f xs = foldl nlHsApp (nlHsVar f) xs
324 nlHsVarApps :: id -> [id] -> LHsExpr id
325 nlHsVarApps f xs = noLoc (foldl mk (HsVar f) (map HsVar xs))
327 mk f a = HsApp (noLoc f) (noLoc a)
329 nlConVarPat :: id -> [id] -> LPat id
330 nlConVarPat con vars = nlConPat con (map nlVarPat vars)
332 nlInfixConPat :: id -> LPat id -> LPat id -> LPat id
333 nlInfixConPat con l r = noLoc (ConPatIn (noLoc con) (InfixCon l r))
335 nlConPat :: id -> [LPat id] -> LPat id
336 nlConPat con pats = noLoc (ConPatIn (noLoc con) (PrefixCon pats))
338 nlNullaryConPat :: id -> LPat id
339 nlNullaryConPat con = noLoc (ConPatIn (noLoc con) (PrefixCon []))
341 nlWildConPat :: DataCon -> LPat RdrName
342 nlWildConPat con = noLoc (ConPatIn (noLoc (getRdrName con))
343 (PrefixCon (nOfThem (dataConSourceArity con) nlWildPat)))
346 nlWildPat = noLoc (WildPat placeHolderType) -- Pre-typechecking
348 nlHsDo :: HsStmtContext Name -> [LStmt id] -> LHsExpr id
349 nlHsDo ctxt stmts = noLoc (mkHsDo ctxt stmts)
351 nlHsOpApp :: LHsExpr id -> id -> LHsExpr id -> LHsExpr id
352 nlHsOpApp e1 op e2 = noLoc (mkHsOpApp e1 op e2)
354 nlHsLam :: LMatch id -> LHsExpr id
355 nlHsPar :: LHsExpr id -> LHsExpr id
356 nlHsIf :: LHsExpr id -> LHsExpr id -> LHsExpr id -> LHsExpr id
357 nlHsCase :: LHsExpr id -> [LMatch id] -> LHsExpr id
358 nlList :: [LHsExpr id] -> LHsExpr id
360 nlHsLam match = noLoc (HsLam (mkMatchGroup [match]))
361 nlHsPar e = noLoc (HsPar e)
362 nlHsIf cond true false = noLoc (mkHsIf cond true false)
363 nlHsCase expr matches = noLoc (HsCase expr (mkMatchGroup matches))
364 nlList exprs = noLoc (ExplicitList placeHolderType exprs)
366 nlHsAppTy :: LHsType name -> LHsType name -> LHsType name
367 nlHsTyVar :: name -> LHsType name
368 nlHsFunTy :: LHsType name -> LHsType name -> LHsType name
370 nlHsAppTy f t = noLoc (HsAppTy f t)
371 nlHsTyVar x = noLoc (HsTyVar x)
372 nlHsFunTy a b = noLoc (HsFunTy a b)
374 nlHsTyConApp :: name -> [LHsType name] -> LHsType name
375 nlHsTyConApp tycon tys = foldl nlHsAppTy (nlHsTyVar tycon) tys
378 Tuples. All these functions are *pre-typechecker* because they lack
382 mkLHsTupleExpr :: [LHsExpr a] -> LHsExpr a
383 -- Makes a pre-typechecker boxed tuple, deals with 1 case
384 mkLHsTupleExpr [e] = e
385 mkLHsTupleExpr es = noLoc $ ExplicitTuple (map Present es) Boxed
387 mkLHsVarTuple :: [a] -> LHsExpr a
388 mkLHsVarTuple ids = mkLHsTupleExpr (map nlHsVar ids)
390 nlTuplePat :: [LPat id] -> Boxity -> LPat id
391 nlTuplePat pats box = noLoc (TuplePat pats box placeHolderType)
393 missingTupArg :: HsTupArg a
394 missingTupArg = Missing placeHolderType
397 %************************************************************************
399 Bindings; with a location at the top
401 %************************************************************************
404 mkFunBind :: Located id -> [LMatch id] -> HsBind id
405 -- Not infix, with place holders for coercion and free vars
406 mkFunBind fn ms = FunBind { fun_id = fn, fun_infix = False, fun_matches = mkMatchGroup ms,
407 fun_co_fn = idHsWrapper, bind_fvs = placeHolderNames,
411 mkHsVarBind :: SrcSpan -> id -> LHsExpr id -> LHsBind id
412 mkHsVarBind loc var rhs = mk_easy_FunBind loc var [] rhs
414 mkVarBind :: id -> LHsExpr id -> LHsBind id
415 mkVarBind var rhs = L (getLoc rhs) $
416 VarBind { var_id = var, var_rhs = rhs, var_inline = False }
419 mk_easy_FunBind :: SrcSpan -> id -> [LPat id]
420 -> LHsExpr id -> LHsBind id
422 mk_easy_FunBind loc fun pats expr
423 = L loc $ mkFunBind (L loc fun) [mkMatch pats expr emptyLocalBinds]
426 mkMatch :: [LPat id] -> LHsExpr id -> HsLocalBinds id -> LMatch id
427 mkMatch pats expr binds
428 = noLoc (Match (map paren pats) Nothing
429 (GRHSs (unguardedRHS expr) binds))
431 paren lp@(L l p) | hsPatNeedsParens p = L l (ParPat lp)
436 %************************************************************************
440 %************************************************************************
442 Get all the binders in some HsBindGroups, IN THE ORDER OF APPEARANCE. eg.
450 it should return [x, y, f, a, b] (remember, order important).
452 Note [Collect binders only after renaming]
453 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
454 These functions should only be used on HsSyn *after* the renamer,
455 to return a [Name] or [Id]. Before renaming the record punning
456 and wild-card mechanism makes it hard to know what is bound.
457 So these functions should not be applied to (HsSyn RdrName)
460 ----------------- Bindings --------------------------
461 collectLocalBinders :: HsLocalBindsLR idL idR -> [idL]
462 collectLocalBinders (HsValBinds val_binds) = collectHsValBinders val_binds
463 collectLocalBinders (HsIPBinds _) = []
464 collectLocalBinders EmptyLocalBinds = []
466 collectHsValBinders :: HsValBindsLR idL idR -> [idL]
467 collectHsValBinders (ValBindsIn binds _) = collectHsBindsBinders binds
468 collectHsValBinders (ValBindsOut binds _) = foldr collect_one [] binds
470 collect_one (_,binds) acc = collect_binds binds acc
472 collectHsBindBinders :: HsBindLR idL idR -> [idL]
473 collectHsBindBinders b = collect_bind b []
475 collect_bind :: HsBindLR idL idR -> [idL] -> [idL]
476 collect_bind (PatBind { pat_lhs = p }) acc = collect_lpat p acc
477 collect_bind (FunBind { fun_id = L _ f }) acc = f : acc
478 collect_bind (VarBind { var_id = f }) acc = f : acc
479 collect_bind (AbsBinds { abs_exports = dbinds, abs_binds = _binds }) acc
480 = [dp | (_,dp,_,_) <- dbinds] ++ acc
481 -- ++ foldr collect_bind acc binds
482 -- I don't think we want the binders from the nested binds
483 -- The only time we collect binders from a typechecked
484 -- binding (hence see AbsBinds) is in zonking in TcHsSyn
486 collectHsBindsBinders :: LHsBindsLR idL idR -> [idL]
487 collectHsBindsBinders binds = collect_binds binds []
489 collectHsBindListBinders :: [LHsBindLR idL idR] -> [idL]
490 collectHsBindListBinders = foldr (collect_bind . unLoc) []
492 collect_binds :: LHsBindsLR idL idR -> [idL] -> [idL]
493 collect_binds binds acc = foldrBag (collect_bind . unLoc) acc binds
495 collectMethodBinders :: LHsBindsLR RdrName idR -> [Located RdrName]
496 -- Used exclusively for the bindings of an instance decl which are all FunBinds
497 collectMethodBinders binds = foldrBag get [] binds
499 get (L _ (FunBind { fun_id = f })) fs = f : fs
501 -- Someone else complains about non-FunBinds
503 ----------------- Statements --------------------------
504 collectLStmtsBinders :: [LStmtLR idL idR] -> [idL]
505 collectLStmtsBinders = concatMap collectLStmtBinders
507 collectStmtsBinders :: [StmtLR idL idR] -> [idL]
508 collectStmtsBinders = concatMap collectStmtBinders
510 collectLStmtBinders :: LStmtLR idL idR -> [idL]
511 collectLStmtBinders = collectStmtBinders . unLoc
513 collectStmtBinders :: StmtLR idL idR -> [idL]
514 -- Id Binders for a Stmt... [but what about pattern-sig type vars]?
515 collectStmtBinders (BindStmt pat _ _ _) = collectPatBinders pat
516 collectStmtBinders (LetStmt binds) = collectLocalBinders binds
517 collectStmtBinders (ExprStmt {}) = []
518 collectStmtBinders (LastStmt {}) = []
519 collectStmtBinders (ParStmt xs _ _ _) = collectLStmtsBinders
521 collectStmtBinders (TransformStmt stmts _ _ _ _ _) = collectLStmtsBinders stmts
522 collectStmtBinders (GroupStmt { grpS_stmts = stmts }) = collectLStmtsBinders stmts
523 collectStmtBinders (RecStmt { recS_stmts = ss }) = collectLStmtsBinders ss
526 ----------------- Patterns --------------------------
527 collectPatBinders :: LPat a -> [a]
528 collectPatBinders pat = collect_lpat pat []
530 collectPatsBinders :: [LPat a] -> [a]
531 collectPatsBinders pats = foldr collect_lpat [] pats
534 collect_lpat :: LPat name -> [name] -> [name]
535 collect_lpat (L _ pat) bndrs
538 go (VarPat var) = var : bndrs
539 go (WildPat _) = bndrs
540 go (LazyPat pat) = collect_lpat pat bndrs
541 go (BangPat pat) = collect_lpat pat bndrs
542 go (AsPat (L _ a) pat) = a : collect_lpat pat bndrs
543 go (ViewPat _ pat _) = collect_lpat pat bndrs
544 go (ParPat pat) = collect_lpat pat bndrs
546 go (ListPat pats _) = foldr collect_lpat bndrs pats
547 go (PArrPat pats _) = foldr collect_lpat bndrs pats
548 go (TuplePat pats _ _) = foldr collect_lpat bndrs pats
550 go (ConPatIn _ ps) = foldr collect_lpat bndrs (hsConPatArgs ps)
551 go (ConPatOut {pat_args=ps}) = foldr collect_lpat bndrs (hsConPatArgs ps)
552 -- See Note [Dictionary binders in ConPatOut]
553 go (LitPat _) = bndrs
554 go (NPat _ _ _) = bndrs
555 go (NPlusKPat (L _ n) _ _ _) = n : bndrs
557 go (SigPatIn pat _) = collect_lpat pat bndrs
558 go (SigPatOut pat _) = collect_lpat pat bndrs
559 go (QuasiQuotePat _) = bndrs
560 go (TypePat _) = bndrs
561 go (CoPat _ pat _) = go pat
564 Note [Dictionary binders in ConPatOut] See also same Note in DsArrows
565 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
566 Do *not* gather (a) dictionary and (b) dictionary bindings as binders
567 of a ConPatOut pattern. For most calls it doesn't matter, because
568 it's pre-typechecker and there are no ConPatOuts. But it does matter
569 more in the desugarer; for example, DsUtils.mkSelectorBinds uses
570 collectPatBinders. In a lazy pattern, for example f ~(C x y) = ...,
571 we want to generate bindings for x,y but not for dictionaries bound by
572 C. (The type checker ensures they would not be used.)
574 Desugaring of arrow case expressions needs these bindings (see DsArrows
575 and arrowcase1), but SPJ (Jan 2007) says it's safer for it to use its
576 own pat-binder-collector:
578 Here's the problem. Consider
581 C :: Num a => a -> Int -> T a
583 f ~(C (n+1) m) = (n,m)
585 Here, the pattern (C (n+1)) binds a hidden dictionary (d::Num a),
586 and *also* uses that dictionary to match the (n+1) pattern. Yet, the
587 variables bound by the lazy pattern are n,m, *not* the dictionary d.
588 So in mkSelectorBinds in DsUtils, we want just m,n as the variables bound.
591 hsGroupBinders :: HsGroup Name -> [Name]
592 hsGroupBinders (HsGroup { hs_valds = val_decls, hs_tyclds = tycl_decls,
593 hs_instds = inst_decls, hs_fords = foreign_decls })
594 -- Collect the binders of a Group
595 = collectHsValBinders val_decls
596 ++ hsTyClDeclsBinders tycl_decls inst_decls
597 ++ hsForeignDeclsBinders foreign_decls
599 hsForeignDeclsBinders :: [LForeignDecl Name] -> [Name]
600 hsForeignDeclsBinders foreign_decls
601 = [n | L _ (ForeignImport (L _ n) _ _) <- foreign_decls]
603 hsTyClDeclsBinders :: [[LTyClDecl Name]] -> [Located (InstDecl Name)] -> [Name]
604 hsTyClDeclsBinders tycl_decls inst_decls
605 = [n | d <- instDeclATs inst_decls ++ concat tycl_decls
606 , L _ n <- hsTyClDeclBinders d]
608 hsTyClDeclBinders :: Eq name => Located (TyClDecl name) -> [Located name]
609 -- ^ Returns all the /binding/ names of the decl, along with their SrcLocs.
610 -- The first one is guaranteed to be the name of the decl. For record fields
611 -- mentioned in multiple constructors, the SrcLoc will be from the first
612 -- occurence. We use the equality to filter out duplicate field names
614 hsTyClDeclBinders (L _ (TyFamily {tcdLName = name})) = [name]
615 hsTyClDeclBinders (L _ (TySynonym {tcdLName = name})) = [name]
616 hsTyClDeclBinders (L _ (ForeignType {tcdLName = name})) = [name]
618 hsTyClDeclBinders (L _ (ClassDecl {tcdLName = cls_name, tcdSigs = sigs, tcdATs = ats}))
620 concatMap hsTyClDeclBinders ats ++ [n | L _ (TypeSig n _) <- sigs]
622 hsTyClDeclBinders (L _ (TyData {tcdLName = tc_name, tcdCons = cons}))
623 = tc_name : hsConDeclsBinders cons
625 hsConDeclsBinders :: (Eq name) => [LConDecl name] -> [Located name]
626 -- See hsTyClDeclBinders for what this does
627 -- The function is boringly complicated because of the records
628 -- And since we only have equality, we have to be a little careful
629 hsConDeclsBinders cons
630 = snd (foldl do_one ([], []) cons)
632 do_one (flds_seen, acc) (L _ (ConDecl { con_name = lname, con_details = RecCon flds }))
633 = (map unLoc new_flds ++ flds_seen, lname : new_flds ++ acc)
635 new_flds = filterOut (\f -> unLoc f `elem` flds_seen)
636 (map cd_fld_name flds)
638 do_one (flds_seen, acc) (L _ (ConDecl { con_name = lname }))
639 = (flds_seen, lname:acc)
643 %************************************************************************
645 Collecting binders the user did not write
647 %************************************************************************
649 The job of this family of functions is to run through binding sites and find the set of all Names
650 that were defined "implicitly", without being explicitly written by the user.
652 The main purpose is to find names introduced by record wildcards so that we can avoid
653 warning the user when they don't use those names (#4404)
656 lStmtsImplicits :: [LStmtLR Name idR] -> NameSet
657 lStmtsImplicits = hs_lstmts
659 hs_lstmts :: [LStmtLR Name idR] -> NameSet
660 hs_lstmts = foldr (\stmt rest -> unionNameSets (hs_stmt (unLoc stmt)) rest) emptyNameSet
662 hs_stmt (BindStmt pat _ _ _) = lPatImplicits pat
663 hs_stmt (LetStmt binds) = hs_local_binds binds
664 hs_stmt (ExprStmt {}) = emptyNameSet
665 hs_stmt (LastStmt {}) = emptyNameSet
666 hs_stmt (ParStmt xs _ _ _) = hs_lstmts $ concatMap fst xs
668 hs_stmt (TransformStmt stmts _ _ _ _ _) = hs_lstmts stmts
669 hs_stmt (GroupStmt { grpS_stmts = stmts }) = hs_lstmts stmts
670 hs_stmt (RecStmt { recS_stmts = ss }) = hs_lstmts ss
672 hs_local_binds (HsValBinds val_binds) = hsValBindsImplicits val_binds
673 hs_local_binds (HsIPBinds _) = emptyNameSet
674 hs_local_binds EmptyLocalBinds = emptyNameSet
676 hsValBindsImplicits :: HsValBindsLR Name idR -> NameSet
677 hsValBindsImplicits (ValBindsOut binds _)
678 = unionManyNameSets [foldBag unionNameSets (hs_bind . unLoc) emptyNameSet hs_binds | (_rec, hs_binds) <- binds]
680 hs_bind (PatBind { pat_lhs = lpat }) = lPatImplicits lpat
681 hs_bind _ = emptyNameSet
682 hsValBindsImplicits (ValBindsIn {}) = pprPanic "hsValBindsImplicits: ValBindsIn" empty
684 lPatImplicits :: LPat Name -> NameSet
685 lPatImplicits = hs_lpat
687 hs_lpat (L _ pat) = hs_pat pat
689 hs_lpats = foldr (\pat rest -> hs_lpat pat `unionNameSets` rest) emptyNameSet
691 hs_pat (LazyPat pat) = hs_lpat pat
692 hs_pat (BangPat pat) = hs_lpat pat
693 hs_pat (AsPat _ pat) = hs_lpat pat
694 hs_pat (ViewPat _ pat _) = hs_lpat pat
695 hs_pat (ParPat pat) = hs_lpat pat
696 hs_pat (ListPat pats _) = hs_lpats pats
697 hs_pat (PArrPat pats _) = hs_lpats pats
698 hs_pat (TuplePat pats _ _) = hs_lpats pats
700 hs_pat (SigPatIn pat _) = hs_lpat pat
701 hs_pat (SigPatOut pat _) = hs_lpat pat
702 hs_pat (CoPat _ pat _) = hs_pat pat
704 hs_pat (ConPatIn _ ps) = details ps
705 hs_pat (ConPatOut {pat_args=ps}) = details ps
707 hs_pat _ = emptyNameSet
709 details (PrefixCon ps) = hs_lpats ps
710 details (RecCon fs) = hs_lpats explicit `unionNameSets` mkNameSet (collectPatsBinders implicit)
711 where (explicit, implicit) = partitionEithers [if pat_explicit then Left pat else Right pat
712 | (i, fld) <- [0..] `zip` rec_flds fs
713 , let pat = hsRecFieldArg fld
714 pat_explicit = maybe True (i<) (rec_dotdot fs)]
715 details (InfixCon p1 p2) = hs_lpat p1 `unionNameSets` hs_lpat p2
719 %************************************************************************
721 Collecting type signatures from patterns
723 %************************************************************************
726 collectSigTysFromPats :: [InPat name] -> [LHsType name]
727 collectSigTysFromPats pats = foldr collect_sig_lpat [] pats
729 collectSigTysFromPat :: InPat name -> [LHsType name]
730 collectSigTysFromPat pat = collect_sig_lpat pat []
732 collect_sig_lpat :: InPat name -> [LHsType name] -> [LHsType name]
733 collect_sig_lpat pat acc = collect_sig_pat (unLoc pat) acc
735 collect_sig_pat :: Pat name -> [LHsType name] -> [LHsType name]
736 collect_sig_pat (SigPatIn pat ty) acc = collect_sig_lpat pat (ty:acc)
737 collect_sig_pat (TypePat ty) acc = ty:acc
739 collect_sig_pat (LazyPat pat) acc = collect_sig_lpat pat acc
740 collect_sig_pat (BangPat pat) acc = collect_sig_lpat pat acc
741 collect_sig_pat (AsPat _ pat) acc = collect_sig_lpat pat acc
742 collect_sig_pat (ParPat pat) acc = collect_sig_lpat pat acc
743 collect_sig_pat (ListPat pats _) acc = foldr collect_sig_lpat acc pats
744 collect_sig_pat (PArrPat pats _) acc = foldr collect_sig_lpat acc pats
745 collect_sig_pat (TuplePat pats _ _) acc = foldr collect_sig_lpat acc pats
746 collect_sig_pat (ConPatIn _ ps) acc = foldr collect_sig_lpat acc (hsConPatArgs ps)
747 collect_sig_pat _ acc = acc -- Literals, vars, wildcard