rnValBindsRHSGen trim bound_names (ValBindsIn mbinds sigs) = do
-- rename the sigs
- env <- getGblEnv
- traceRn (ptext (sLit "Rename sigs") <+> ppr (tcg_rdr_env env))
sigs' <- renameSigs (Just (mkNameSet bound_names)) okBindSig sigs
-- rename the RHSes
binds_w_dus <- mapBagM (rnBind (mkSigTvFn sigs') trim) mbinds
- let (anal_binds, anal_dus) = depAnalBinds binds_w_dus
- (valbind', valbind'_dus) = (ValBindsOut anal_binds sigs',
- usesOnly (hsSigsFVs sigs') `plusDU` anal_dus)
- return (valbind', valbind'_dus)
+ case depAnalBinds binds_w_dus of
+ (anal_binds, anal_dus) ->
+ do let valbind' = ValBindsOut anal_binds sigs'
+ valbind'_dus = usesOnly (hsSigsFVs sigs') `plusDU` anal_dus
+ return (valbind', valbind'_dus)
rnValBindsRHSGen _ _ b = pprPanic "rnValBindsRHSGen" (ppr b)
; (grhss', fvs) <- rnGRHSs PatBindRhs grhss
-- No scoped type variables for pattern bindings
+ ; let fvs' = trim fvs
- ; return (L loc (PatBind { pat_lhs = pat,
+ ; fvs' `seq` -- See Note [Free-variable space leak]
+ return (L loc (PatBind { pat_lhs = pat,
pat_rhs = grhss',
pat_rhs_ty = placeHolderType,
- bind_fvs = trim fvs }),
+ bind_fvs = fvs' }),
bndrs, pat_fvs `plusFV` fvs) }
rnBind sig_fn
; (matches', fvs) <- bindSigTyVarsFV (sig_fn plain_name) $
-- bindSigTyVars tests for Opt_ScopedTyVars
rnMatchGroup (FunRhs plain_name inf) matches
+ ; let fvs' = trim fvs
; checkPrecMatch inf plain_name matches'
- ; return (L loc (FunBind { fun_id = name,
+ ; fvs' `seq` -- See Note [Free-variable space leak]
+ return (L loc (FunBind { fun_id = name,
fun_infix = inf,
fun_matches = matches',
- bind_fvs = trim fvs,
+ bind_fvs = fvs',
fun_co_fn = idHsWrapper,
fun_tick = Nothing }),
[plain_name], fvs)
}
rnBind _ _ b = pprPanic "rnBind" (ppr b)
-
+
+{-
+Note [Free-variable space leak]
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+We have
+ fvs' = trim fvs
+and we seq fvs' before turning it as part of a record.
+
+The reason is that trim is sometimes something like
+ \xs -> intersectNameSet (mkNameSet bound_names) xs
+and we don't want to retain the list bound_names. This showed up in
+trac ticket #1136.
+-}
+
---------------------
depAnalBinds :: Bag (LHsBind Name, [Name], Uses)
-> ([(RecFlag, LHsBinds Name)], DefUses)
\begin{code}
rnMatchGroup :: HsMatchContext Name -> MatchGroup RdrName -> RnM (MatchGroup Name, FreeVars)
-rnMatchGroup ctxt (MatchGroup ms _) = do
- (new_ms, ms_fvs) <- mapFvRn (rnMatch ctxt) ms
- return (MatchGroup new_ms placeHolderType, ms_fvs)
+rnMatchGroup ctxt (MatchGroup ms _)
+ = do { (new_ms, ms_fvs) <- mapFvRn (rnMatch ctxt) ms
+ ; return (MatchGroup new_ms placeHolderType, ms_fvs) }
rnMatch :: HsMatchContext Name -> LMatch RdrName -> RnM (LMatch Name, FreeVars)
rnMatch ctxt = wrapLocFstM (rnMatch' ctxt)