+ mbinders_w_srclocs = collectHsBindLocatedBinders mbinds
+ doc = text "In the binding group for:"
+ <+> pprWithCommas ppr (map unLoc mbinders_w_srclocs)
+
+---------------------
+rnValBinds :: (FreeVars -> FreeVars)
+ -> HsValBinds RdrName
+ -> RnM (HsValBinds Name, DefUses)
+-- Assumes the binders of the binding are in scope already
+
+rnValBinds trim (ValBindsIn mbinds sigs)
+ = do { sigs' <- rename_sigs sigs
+
+ ; let { rn_bind = wrapLocFstM (rnBind sig_fn trim)
+ ; sig_fn = mkSigTvFn sigs' }
+
+ ; (mbinds', du_bag) <- mapAndUnzipBagM rn_bind mbinds
+
+ ; let defs, uses :: NameSet
+ (defs, uses) = foldrBag plus (emptyNameSet, emptyNameSet) du_bag
+ plus (ds1,us1) (ds2,us2) = (ds1 `unionNameSets` ds2,
+ us1 `unionNameSets` us2)
+
+ ; check_sigs (okBindSig defs) sigs'
+
+ ; traceRn (text "rnValBind" <+> (ppr defs $$ ppr uses))
+ ; return (ValBindsIn mbinds' sigs',
+ [(Just defs, uses `plusFV` hsSigsFVs sigs')]) }
+
+---------------------
+-- Bind the top-level forall'd type variables in the sigs.
+-- E.g f :: a -> a
+-- f = rhs
+-- The 'a' scopes over the rhs
+--
+-- NB: there'll usually be just one (for a function binding)
+-- but if there are many, one may shadow the rest; too bad!
+-- e.g x :: [a] -> [a]
+-- y :: [(a,a)] -> a
+-- (x,y) = e
+-- In e, 'a' will be in scope, and it'll be the one from 'y'!
+
+mkSigTvFn :: [LSig Name] -> (Name -> [Name])
+-- Return a lookup function that maps an Id Name to the names
+-- of the type variables that should scope over its body..
+mkSigTvFn sigs
+ = \n -> lookupNameEnv env n `orElse` []
+ where
+ env :: NameEnv [Name]
+ env = mkNameEnv [ (name, map hsLTyVarName ltvs)
+ | L _ (Sig (L _ name)
+ (L _ (HsForAllTy Explicit ltvs _ _))) <- sigs]
+ -- Note the pattern-match on "Explicit"; we only bind
+ -- type variables from signatures with an explicit top-level for-all
+
+-- The trimming function trims the free vars we attach to a
+-- binding so that it stays reasonably small
+noTrim :: FreeVars -> FreeVars
+noTrim fvs = fvs -- Used at top level
+
+trimWith :: [Name] -> FreeVars -> FreeVars
+-- Nested bindings; trim by intersection with the names bound here
+trimWith bndrs = intersectNameSet (mkNameSet bndrs)
+
+---------------------
+rnBind :: (Name -> [Name]) -- Signature tyvar function
+ -> (FreeVars -> FreeVars) -- Trimming function for rhs free vars
+ -> HsBind RdrName
+ -> RnM (HsBind Name, (Defs, Uses))
+rnBind sig_fn trim (PatBind pat grhss ty _)
+ = do { (pat', pat_fvs) <- rnLPat pat
+
+ ; let bndrs = collectPatBinders pat'
+
+ ; (grhss', fvs) <- bindSigTyVarsFV (concatMap sig_fn bndrs) $
+ rnGRHSs PatBindRhs grhss
+
+ ; return (PatBind pat' grhss' ty (trim fvs),
+ (mkNameSet bndrs, pat_fvs `plusFV` fvs)) }
+
+rnBind sig_fn trim (FunBind name inf matches _)
+ = do { new_name <- lookupLocatedBndrRn name
+ ; let { plain_name = unLoc new_name
+ ; bndrs = unitNameSet plain_name }
+
+ ; (matches', fvs) <- bindSigTyVarsFV (sig_fn plain_name) $
+ rnMatchGroup (FunRhs plain_name) matches
+
+ ; checkPrecMatch inf plain_name matches'
+
+ ; return (FunBind new_name inf matches' (trim fvs),
+ (bndrs, fvs))
+ }