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,
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 emptyTransStmt, 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
196 mkNPat :: HsOverLit id -> Maybe (SyntaxExpr id) -> Pat id
197 mkNPlusKPat :: Located id -> HsOverLit id -> Pat id
199 mkLastStmt :: LHsExpr idR -> StmtLR idL idR
200 mkExprStmt :: LHsExpr idR -> StmtLR idL idR
201 mkBindStmt :: LPat idL -> LHsExpr idR -> StmtLR idL idR
203 emptyRecStmt :: StmtLR idL idR
204 mkRecStmt :: [LStmtLR idL idR] -> StmtLR idL idR
207 mkHsIntegral i = OverLit (HsIntegral i) noRebindableInfo noSyntaxExpr
208 mkHsFractional f = OverLit (HsFractional f) noRebindableInfo noSyntaxExpr
209 mkHsIsString s = OverLit (HsIsString s) noRebindableInfo noSyntaxExpr
211 noRebindableInfo :: Bool
212 noRebindableInfo = error "noRebindableInfo" -- Just another placeholder;
214 mkHsDo ctxt stmts = HsDo ctxt stmts placeHolderType
215 mkHsComp ctxt stmts expr = mkHsDo ctxt (stmts ++ [last_stmt])
217 last_stmt = L (getLoc expr) $ mkLastStmt expr
219 mkHsIf :: LHsExpr id -> LHsExpr id -> LHsExpr id -> HsExpr id
220 mkHsIf c a b = HsIf (Just noSyntaxExpr) c a b
222 mkNPat lit neg = NPat lit neg noSyntaxExpr
223 mkNPlusKPat id lit = NPlusKPat id lit noSyntaxExpr noSyntaxExpr
225 mkTransformStmt :: [LStmt idL] -> LHsExpr idR -> StmtLR idL idR
226 mkTransformByStmt :: [LStmt idL] -> LHsExpr idR -> LHsExpr idR -> StmtLR idL idR
227 mkGroupUsingStmt :: [LStmt idL] -> LHsExpr idR -> StmtLR idL idR
228 mkGroupByStmt :: [LStmt idL] -> LHsExpr idR -> StmtLR idL idR
229 mkGroupByUsingStmt :: [LStmt idL] -> LHsExpr idR -> LHsExpr idR -> StmtLR idL idR
231 emptyTransStmt :: StmtLR idL idR
232 emptyTransStmt = TransStmt { trS_form = undefined, trS_stmts = [], trS_bndrs = []
233 , trS_by = Nothing, trS_using = noLoc noSyntaxExpr
234 , trS_ret = noSyntaxExpr, trS_bind = noSyntaxExpr
235 , trS_fmap = noSyntaxExpr }
236 mkTransformStmt ss u = emptyTransStmt { trS_form = ThenForm, trS_stmts = ss, trS_using = u }
237 mkTransformByStmt ss u b = emptyTransStmt { trS_form = ThenForm, trS_stmts = ss, trS_using = u, trS_by = Just b }
238 mkGroupByStmt ss b = emptyTransStmt { trS_form = GroupFormB, trS_stmts = ss, trS_by = Just b }
239 mkGroupUsingStmt ss u = emptyTransStmt { trS_form = GroupFormU, trS_stmts = ss, trS_using = u }
240 mkGroupByUsingStmt ss b u = emptyTransStmt { trS_form = GroupFormU, trS_stmts = ss
241 , trS_by = Just b, trS_using = u }
243 mkLastStmt expr = LastStmt expr noSyntaxExpr
244 mkExprStmt expr = ExprStmt expr noSyntaxExpr noSyntaxExpr placeHolderType
245 mkBindStmt pat expr = BindStmt pat expr noSyntaxExpr noSyntaxExpr
247 emptyRecStmt = RecStmt { recS_stmts = [], recS_later_ids = [], recS_rec_ids = []
248 , recS_ret_fn = noSyntaxExpr, recS_mfix_fn = noSyntaxExpr
249 , recS_bind_fn = noSyntaxExpr
250 , recS_rec_rets = [], recS_ret_ty = placeHolderType }
252 mkRecStmt stmts = emptyRecStmt { recS_stmts = stmts }
254 -------------------------------
255 --- A useful function for building @OpApps@. The operator is always a
256 -- variable, and we don't know the fixity yet.
257 mkHsOpApp :: LHsExpr id -> id -> LHsExpr id -> HsExpr id
258 mkHsOpApp e1 op e2 = OpApp e1 (noLoc (HsVar op)) (error "mkOpApp:fixity") e2
260 mkHsSplice :: LHsExpr RdrName -> HsSplice RdrName
261 mkHsSplice e = HsSplice unqualSplice e
263 mkHsSpliceTy :: LHsExpr RdrName -> HsType RdrName
264 mkHsSpliceTy e = HsSpliceTy (mkHsSplice e) emptyFVs placeHolderKind
266 unqualSplice :: RdrName
267 unqualSplice = mkRdrUnqual (mkVarOccFS (fsLit "splice"))
268 -- A name (uniquified later) to
269 -- identify the splice
271 mkHsQuasiQuote :: RdrName -> SrcSpan -> FastString -> HsQuasiQuote RdrName
272 mkHsQuasiQuote quoter span quote = HsQuasiQuote quoter span quote
274 unqualQuasiQuote :: RdrName
275 unqualQuasiQuote = mkRdrUnqual (mkVarOccFS (fsLit "quasiquote"))
276 -- A name (uniquified later) to
277 -- identify the quasi-quote
279 mkHsString :: String -> HsLit
280 mkHsString s = HsString (mkFastString s)
283 userHsTyVarBndrs :: [Located name] -> [Located (HsTyVarBndr name)]
284 userHsTyVarBndrs bndrs = [ L loc (UserTyVar v placeHolderKind) | L loc v <- bndrs ]
288 %************************************************************************
290 Constructing syntax with no location info
292 %************************************************************************
295 nlHsVar :: id -> LHsExpr id
296 nlHsVar n = noLoc (HsVar n)
298 nlHsLit :: HsLit -> LHsExpr id
299 nlHsLit n = noLoc (HsLit n)
301 nlVarPat :: id -> LPat id
302 nlVarPat n = noLoc (VarPat n)
304 nlLitPat :: HsLit -> LPat id
305 nlLitPat l = noLoc (LitPat l)
307 nlHsApp :: LHsExpr id -> LHsExpr id -> LHsExpr id
308 nlHsApp f x = noLoc (HsApp f x)
310 nlHsIntLit :: Integer -> LHsExpr id
311 nlHsIntLit n = noLoc (HsLit (HsInt n))
313 nlHsApps :: id -> [LHsExpr id] -> LHsExpr id
314 nlHsApps f xs = foldl nlHsApp (nlHsVar f) xs
316 nlHsVarApps :: id -> [id] -> LHsExpr id
317 nlHsVarApps f xs = noLoc (foldl mk (HsVar f) (map HsVar xs))
319 mk f a = HsApp (noLoc f) (noLoc a)
321 nlConVarPat :: id -> [id] -> LPat id
322 nlConVarPat con vars = nlConPat con (map nlVarPat vars)
324 nlInfixConPat :: id -> LPat id -> LPat id -> LPat id
325 nlInfixConPat con l r = noLoc (ConPatIn (noLoc con) (InfixCon l r))
327 nlConPat :: id -> [LPat id] -> LPat id
328 nlConPat con pats = noLoc (ConPatIn (noLoc con) (PrefixCon pats))
330 nlNullaryConPat :: id -> LPat id
331 nlNullaryConPat con = noLoc (ConPatIn (noLoc con) (PrefixCon []))
333 nlWildConPat :: DataCon -> LPat RdrName
334 nlWildConPat con = noLoc (ConPatIn (noLoc (getRdrName con))
335 (PrefixCon (nOfThem (dataConSourceArity con) nlWildPat)))
338 nlWildPat = noLoc (WildPat placeHolderType) -- Pre-typechecking
340 nlHsDo :: HsStmtContext Name -> [LStmt id] -> LHsExpr id
341 nlHsDo ctxt stmts = noLoc (mkHsDo ctxt stmts)
343 nlHsOpApp :: LHsExpr id -> id -> LHsExpr id -> LHsExpr id
344 nlHsOpApp e1 op e2 = noLoc (mkHsOpApp e1 op e2)
346 nlHsLam :: LMatch id -> LHsExpr id
347 nlHsPar :: LHsExpr id -> LHsExpr id
348 nlHsIf :: LHsExpr id -> LHsExpr id -> LHsExpr id -> LHsExpr id
349 nlHsCase :: LHsExpr id -> [LMatch id] -> LHsExpr id
350 nlList :: [LHsExpr id] -> LHsExpr id
352 nlHsLam match = noLoc (HsLam (mkMatchGroup [match]))
353 nlHsPar e = noLoc (HsPar e)
354 nlHsIf cond true false = noLoc (mkHsIf cond true false)
355 nlHsCase expr matches = noLoc (HsCase expr (mkMatchGroup matches))
356 nlList exprs = noLoc (ExplicitList placeHolderType exprs)
358 nlHsAppTy :: LHsType name -> LHsType name -> LHsType name
359 nlHsTyVar :: name -> LHsType name
360 nlHsFunTy :: LHsType name -> LHsType name -> LHsType name
362 nlHsAppTy f t = noLoc (HsAppTy f t)
363 nlHsTyVar x = noLoc (HsTyVar x)
364 nlHsFunTy a b = noLoc (HsFunTy a b)
366 nlHsTyConApp :: name -> [LHsType name] -> LHsType name
367 nlHsTyConApp tycon tys = foldl nlHsAppTy (nlHsTyVar tycon) tys
370 Tuples. All these functions are *pre-typechecker* because they lack
374 mkLHsTupleExpr :: [LHsExpr a] -> LHsExpr a
375 -- Makes a pre-typechecker boxed tuple, deals with 1 case
376 mkLHsTupleExpr [e] = e
377 mkLHsTupleExpr es = noLoc $ ExplicitTuple (map Present es) Boxed
379 mkLHsVarTuple :: [a] -> LHsExpr a
380 mkLHsVarTuple ids = mkLHsTupleExpr (map nlHsVar ids)
382 nlTuplePat :: [LPat id] -> Boxity -> LPat id
383 nlTuplePat pats box = noLoc (TuplePat pats box placeHolderType)
385 missingTupArg :: HsTupArg a
386 missingTupArg = Missing placeHolderType
389 %************************************************************************
391 Bindings; with a location at the top
393 %************************************************************************
396 mkFunBind :: Located id -> [LMatch id] -> HsBind id
397 -- Not infix, with place holders for coercion and free vars
398 mkFunBind fn ms = FunBind { fun_id = fn, fun_infix = False, fun_matches = mkMatchGroup ms,
399 fun_co_fn = idHsWrapper, bind_fvs = placeHolderNames,
403 mkHsVarBind :: SrcSpan -> id -> LHsExpr id -> LHsBind id
404 mkHsVarBind loc var rhs = mk_easy_FunBind loc var [] rhs
406 mkVarBind :: id -> LHsExpr id -> LHsBind id
407 mkVarBind var rhs = L (getLoc rhs) $
408 VarBind { var_id = var, var_rhs = rhs, var_inline = False }
411 mk_easy_FunBind :: SrcSpan -> id -> [LPat id]
412 -> LHsExpr id -> LHsBind id
414 mk_easy_FunBind loc fun pats expr
415 = L loc $ mkFunBind (L loc fun) [mkMatch pats expr emptyLocalBinds]
418 mkMatch :: [LPat id] -> LHsExpr id -> HsLocalBinds id -> LMatch id
419 mkMatch pats expr binds
420 = noLoc (Match (map paren pats) Nothing
421 (GRHSs (unguardedRHS expr) binds))
423 paren lp@(L l p) | hsPatNeedsParens p = L l (ParPat lp)
428 %************************************************************************
432 %************************************************************************
434 Get all the binders in some HsBindGroups, IN THE ORDER OF APPEARANCE. eg.
442 it should return [x, y, f, a, b] (remember, order important).
444 Note [Collect binders only after renaming]
445 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
446 These functions should only be used on HsSyn *after* the renamer,
447 to return a [Name] or [Id]. Before renaming the record punning
448 and wild-card mechanism makes it hard to know what is bound.
449 So these functions should not be applied to (HsSyn RdrName)
452 ----------------- Bindings --------------------------
453 collectLocalBinders :: HsLocalBindsLR idL idR -> [idL]
454 collectLocalBinders (HsValBinds val_binds) = collectHsValBinders val_binds
455 collectLocalBinders (HsIPBinds _) = []
456 collectLocalBinders EmptyLocalBinds = []
458 collectHsValBinders :: HsValBindsLR idL idR -> [idL]
459 collectHsValBinders (ValBindsIn binds _) = collectHsBindsBinders binds
460 collectHsValBinders (ValBindsOut binds _) = foldr collect_one [] binds
462 collect_one (_,binds) acc = collect_binds binds acc
464 collectHsBindBinders :: HsBindLR idL idR -> [idL]
465 collectHsBindBinders b = collect_bind b []
467 collect_bind :: HsBindLR idL idR -> [idL] -> [idL]
468 collect_bind (PatBind { pat_lhs = p }) acc = collect_lpat p acc
469 collect_bind (FunBind { fun_id = L _ f }) acc = f : acc
470 collect_bind (VarBind { var_id = f }) acc = f : acc
471 collect_bind (AbsBinds { abs_exports = dbinds, abs_binds = _binds }) acc
472 = [dp | (_,dp,_,_) <- dbinds] ++ acc
473 -- ++ foldr collect_bind acc binds
474 -- I don't think we want the binders from the nested binds
475 -- The only time we collect binders from a typechecked
476 -- binding (hence see AbsBinds) is in zonking in TcHsSyn
478 collectHsBindsBinders :: LHsBindsLR idL idR -> [idL]
479 collectHsBindsBinders binds = collect_binds binds []
481 collectHsBindListBinders :: [LHsBindLR idL idR] -> [idL]
482 collectHsBindListBinders = foldr (collect_bind . unLoc) []
484 collect_binds :: LHsBindsLR idL idR -> [idL] -> [idL]
485 collect_binds binds acc = foldrBag (collect_bind . unLoc) acc binds
487 collectMethodBinders :: LHsBindsLR RdrName idR -> [Located RdrName]
488 -- Used exclusively for the bindings of an instance decl which are all FunBinds
489 collectMethodBinders binds = foldrBag get [] binds
491 get (L _ (FunBind { fun_id = f })) fs = f : fs
493 -- Someone else complains about non-FunBinds
495 ----------------- Statements --------------------------
496 collectLStmtsBinders :: [LStmtLR idL idR] -> [idL]
497 collectLStmtsBinders = concatMap collectLStmtBinders
499 collectStmtsBinders :: [StmtLR idL idR] -> [idL]
500 collectStmtsBinders = concatMap collectStmtBinders
502 collectLStmtBinders :: LStmtLR idL idR -> [idL]
503 collectLStmtBinders = collectStmtBinders . unLoc
505 collectStmtBinders :: StmtLR idL idR -> [idL]
506 -- Id Binders for a Stmt... [but what about pattern-sig type vars]?
507 collectStmtBinders (BindStmt pat _ _ _) = collectPatBinders pat
508 collectStmtBinders (LetStmt binds) = collectLocalBinders binds
509 collectStmtBinders (ExprStmt {}) = []
510 collectStmtBinders (LastStmt {}) = []
511 collectStmtBinders (ParStmt xs _ _ _) = collectLStmtsBinders
513 collectStmtBinders (TransStmt { trS_stmts = stmts }) = collectLStmtsBinders stmts
514 collectStmtBinders (RecStmt { recS_stmts = ss }) = collectLStmtsBinders ss
517 ----------------- Patterns --------------------------
518 collectPatBinders :: LPat a -> [a]
519 collectPatBinders pat = collect_lpat pat []
521 collectPatsBinders :: [LPat a] -> [a]
522 collectPatsBinders pats = foldr collect_lpat [] pats
525 collect_lpat :: LPat name -> [name] -> [name]
526 collect_lpat (L _ pat) bndrs
529 go (VarPat var) = var : bndrs
530 go (WildPat _) = bndrs
531 go (LazyPat pat) = collect_lpat pat bndrs
532 go (BangPat pat) = collect_lpat pat bndrs
533 go (AsPat (L _ a) pat) = a : collect_lpat pat bndrs
534 go (ViewPat _ pat _) = collect_lpat pat bndrs
535 go (ParPat pat) = collect_lpat pat bndrs
537 go (ListPat pats _) = foldr collect_lpat bndrs pats
538 go (PArrPat pats _) = foldr collect_lpat bndrs pats
539 go (TuplePat pats _ _) = foldr collect_lpat bndrs pats
541 go (ConPatIn _ ps) = foldr collect_lpat bndrs (hsConPatArgs ps)
542 go (ConPatOut {pat_args=ps}) = foldr collect_lpat bndrs (hsConPatArgs ps)
543 -- See Note [Dictionary binders in ConPatOut]
544 go (LitPat _) = bndrs
545 go (NPat _ _ _) = bndrs
546 go (NPlusKPat (L _ n) _ _ _) = n : bndrs
548 go (SigPatIn pat _) = collect_lpat pat bndrs
549 go (SigPatOut pat _) = collect_lpat pat bndrs
550 go (QuasiQuotePat _) = bndrs
551 go (CoPat _ pat _) = go pat
554 Note [Dictionary binders in ConPatOut] See also same Note in DsArrows
555 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
556 Do *not* gather (a) dictionary and (b) dictionary bindings as binders
557 of a ConPatOut pattern. For most calls it doesn't matter, because
558 it's pre-typechecker and there are no ConPatOuts. But it does matter
559 more in the desugarer; for example, DsUtils.mkSelectorBinds uses
560 collectPatBinders. In a lazy pattern, for example f ~(C x y) = ...,
561 we want to generate bindings for x,y but not for dictionaries bound by
562 C. (The type checker ensures they would not be used.)
564 Desugaring of arrow case expressions needs these bindings (see DsArrows
565 and arrowcase1), but SPJ (Jan 2007) says it's safer for it to use its
566 own pat-binder-collector:
568 Here's the problem. Consider
571 C :: Num a => a -> Int -> T a
573 f ~(C (n+1) m) = (n,m)
575 Here, the pattern (C (n+1)) binds a hidden dictionary (d::Num a),
576 and *also* uses that dictionary to match the (n+1) pattern. Yet, the
577 variables bound by the lazy pattern are n,m, *not* the dictionary d.
578 So in mkSelectorBinds in DsUtils, we want just m,n as the variables bound.
581 hsGroupBinders :: HsGroup Name -> [Name]
582 hsGroupBinders (HsGroup { hs_valds = val_decls, hs_tyclds = tycl_decls,
583 hs_instds = inst_decls, hs_fords = foreign_decls })
584 -- Collect the binders of a Group
585 = collectHsValBinders val_decls
586 ++ hsTyClDeclsBinders tycl_decls inst_decls
587 ++ hsForeignDeclsBinders foreign_decls
589 hsForeignDeclsBinders :: [LForeignDecl Name] -> [Name]
590 hsForeignDeclsBinders foreign_decls
591 = [n | L _ (ForeignImport (L _ n) _ _) <- foreign_decls]
593 hsTyClDeclsBinders :: [[LTyClDecl Name]] -> [Located (InstDecl Name)] -> [Name]
594 hsTyClDeclsBinders tycl_decls inst_decls
595 = [n | d <- instDeclATs inst_decls ++ concat tycl_decls
596 , L _ n <- hsTyClDeclBinders d]
598 hsTyClDeclBinders :: Eq name => Located (TyClDecl name) -> [Located name]
599 -- ^ Returns all the /binding/ names of the decl, along with their SrcLocs.
600 -- The first one is guaranteed to be the name of the decl. For record fields
601 -- mentioned in multiple constructors, the SrcLoc will be from the first
602 -- occurence. We use the equality to filter out duplicate field names
604 hsTyClDeclBinders (L _ (TyFamily {tcdLName = name})) = [name]
605 hsTyClDeclBinders (L _ (TySynonym {tcdLName = name})) = [name]
606 hsTyClDeclBinders (L _ (ForeignType {tcdLName = name})) = [name]
608 hsTyClDeclBinders (L _ (ClassDecl {tcdLName = cls_name, tcdSigs = sigs, tcdATs = ats}))
610 concatMap hsTyClDeclBinders ats ++ [n | L _ (TypeSig n _) <- sigs]
612 hsTyClDeclBinders (L _ (TyData {tcdLName = tc_name, tcdCons = cons}))
613 = tc_name : hsConDeclsBinders cons
615 hsConDeclsBinders :: (Eq name) => [LConDecl name] -> [Located name]
616 -- See hsTyClDeclBinders for what this does
617 -- The function is boringly complicated because of the records
618 -- And since we only have equality, we have to be a little careful
619 hsConDeclsBinders cons
620 = snd (foldl do_one ([], []) cons)
622 do_one (flds_seen, acc) (L _ (ConDecl { con_name = lname, con_details = RecCon flds }))
623 = (map unLoc new_flds ++ flds_seen, lname : new_flds ++ acc)
625 new_flds = filterOut (\f -> unLoc f `elem` flds_seen)
626 (map cd_fld_name flds)
628 do_one (flds_seen, acc) (L _ (ConDecl { con_name = lname }))
629 = (flds_seen, lname:acc)
633 %************************************************************************
635 Collecting binders the user did not write
637 %************************************************************************
639 The job of this family of functions is to run through binding sites and find the set of all Names
640 that were defined "implicitly", without being explicitly written by the user.
642 The main purpose is to find names introduced by record wildcards so that we can avoid
643 warning the user when they don't use those names (#4404)
646 lStmtsImplicits :: [LStmtLR Name idR] -> NameSet
647 lStmtsImplicits = hs_lstmts
649 hs_lstmts :: [LStmtLR Name idR] -> NameSet
650 hs_lstmts = foldr (\stmt rest -> unionNameSets (hs_stmt (unLoc stmt)) rest) emptyNameSet
652 hs_stmt (BindStmt pat _ _ _) = lPatImplicits pat
653 hs_stmt (LetStmt binds) = hs_local_binds binds
654 hs_stmt (ExprStmt {}) = emptyNameSet
655 hs_stmt (LastStmt {}) = emptyNameSet
656 hs_stmt (ParStmt xs _ _ _) = hs_lstmts $ concatMap fst xs
658 hs_stmt (TransStmt { trS_stmts = stmts }) = hs_lstmts stmts
659 hs_stmt (RecStmt { recS_stmts = ss }) = hs_lstmts ss
661 hs_local_binds (HsValBinds val_binds) = hsValBindsImplicits val_binds
662 hs_local_binds (HsIPBinds _) = emptyNameSet
663 hs_local_binds EmptyLocalBinds = emptyNameSet
665 hsValBindsImplicits :: HsValBindsLR Name idR -> NameSet
666 hsValBindsImplicits (ValBindsOut binds _)
667 = unionManyNameSets [foldBag unionNameSets (hs_bind . unLoc) emptyNameSet hs_binds | (_rec, hs_binds) <- binds]
669 hs_bind (PatBind { pat_lhs = lpat }) = lPatImplicits lpat
670 hs_bind _ = emptyNameSet
671 hsValBindsImplicits (ValBindsIn {}) = pprPanic "hsValBindsImplicits: ValBindsIn" empty
673 lPatImplicits :: LPat Name -> NameSet
674 lPatImplicits = hs_lpat
676 hs_lpat (L _ pat) = hs_pat pat
678 hs_lpats = foldr (\pat rest -> hs_lpat pat `unionNameSets` rest) emptyNameSet
680 hs_pat (LazyPat pat) = hs_lpat pat
681 hs_pat (BangPat pat) = hs_lpat pat
682 hs_pat (AsPat _ pat) = hs_lpat pat
683 hs_pat (ViewPat _ pat _) = hs_lpat pat
684 hs_pat (ParPat pat) = hs_lpat pat
685 hs_pat (ListPat pats _) = hs_lpats pats
686 hs_pat (PArrPat pats _) = hs_lpats pats
687 hs_pat (TuplePat pats _ _) = hs_lpats pats
689 hs_pat (SigPatIn pat _) = hs_lpat pat
690 hs_pat (SigPatOut pat _) = hs_lpat pat
691 hs_pat (CoPat _ pat _) = hs_pat pat
693 hs_pat (ConPatIn _ ps) = details ps
694 hs_pat (ConPatOut {pat_args=ps}) = details ps
696 hs_pat _ = emptyNameSet
698 details (PrefixCon ps) = hs_lpats ps
699 details (RecCon fs) = hs_lpats explicit `unionNameSets` mkNameSet (collectPatsBinders implicit)
700 where (explicit, implicit) = partitionEithers [if pat_explicit then Left pat else Right pat
701 | (i, fld) <- [0..] `zip` rec_flds fs
702 , let pat = hsRecFieldArg fld
703 pat_explicit = maybe True (i<) (rec_dotdot fs)]
704 details (InfixCon p1 p2) = hs_lpat p1 `unionNameSets` hs_lpat p2
708 %************************************************************************
710 Collecting type signatures from patterns
712 %************************************************************************
715 collectSigTysFromPats :: [InPat name] -> [LHsType name]
716 collectSigTysFromPats pats = foldr collect_sig_lpat [] pats
718 collectSigTysFromPat :: InPat name -> [LHsType name]
719 collectSigTysFromPat pat = collect_sig_lpat pat []
721 collect_sig_lpat :: InPat name -> [LHsType name] -> [LHsType name]
722 collect_sig_lpat pat acc = collect_sig_pat (unLoc pat) acc
724 collect_sig_pat :: Pat name -> [LHsType name] -> [LHsType name]
725 collect_sig_pat (SigPatIn pat ty) acc = collect_sig_lpat pat (ty:acc)
727 collect_sig_pat (LazyPat pat) acc = collect_sig_lpat pat acc
728 collect_sig_pat (BangPat pat) acc = collect_sig_lpat pat acc
729 collect_sig_pat (AsPat _ pat) acc = collect_sig_lpat pat acc
730 collect_sig_pat (ParPat pat) acc = collect_sig_lpat pat acc
731 collect_sig_pat (ListPat pats _) acc = foldr collect_sig_lpat acc pats
732 collect_sig_pat (PArrPat pats _) acc = foldr collect_sig_lpat acc pats
733 collect_sig_pat (TuplePat pats _ _) acc = foldr collect_sig_lpat acc pats
734 collect_sig_pat (ConPatIn _ ps) acc = foldr collect_sig_lpat acc (hsConPatArgs ps)
735 collect_sig_pat _ acc = acc -- Literals, vars, wildcard