+-- wrapper for local binds
+-- creates the documentation info and calls the helper below
+rnValBindsLHS :: MiniFixityEnv
+ -> HsValBinds RdrName
+ -> RnM (HsValBindsLR Name RdrName)
+rnValBindsLHS fix_env binds =
+ let (boundNames,doc) = bindersAndDoc binds
+ in rnValBindsLHSFromDoc_Local boundNames doc fix_env binds
+
+-- a helper used for local binds that does the duplicates check,
+-- just so we don't forget to do it somewhere
+rnValBindsLHSFromDoc_Local :: [Located RdrName] -- RdrNames of the LHS (so we don't have to gather them twice)
+ -> SDoc -- doc string for dup names and shadowing
+ -> MiniFixityEnv
+ -> HsValBinds RdrName
+ -> RnM (HsValBindsLR Name RdrName)
+
+rnValBindsLHSFromDoc_Local boundNames doc fix_env binds = do
+ -- Do error checking: we need to check for dups here because we
+ -- don't don't bind all of the variables from the ValBinds at once
+ -- with bindLocatedLocals any more.
+ checkDupAndShadowedRdrNames doc boundNames
+
+ -- (Note that we don't want to do this at the top level, since
+ -- sorting out duplicates and shadowing there happens elsewhere.
+ -- The behavior is even different. For example,
+ -- import A(f)
+ -- f = ...
+ -- should not produce a shadowing warning (but it will produce
+ -- an ambiguity warning if you use f), but
+ -- import A(f)
+ -- g = let f = ... in f
+ -- should.
+ rnValBindsLHSFromDoc (localRecNameMaker fix_env) boundNames doc binds
+
+bindersAndDoc :: HsValBinds RdrName -> ([Located RdrName], SDoc)
+bindersAndDoc binds =
+ let
+ -- the unrenamed bndrs for error checking and reporting
+ orig = collectHsValBinders binds
+ doc = text "In the binding group for:" <+> pprWithCommas ppr (map unLoc orig)
+ in
+ (orig, doc)
+
+-- renames the left-hand sides
+-- generic version used both at the top level and for local binds
+-- does some error checking, but not what gets done elsewhere at the top level
+rnValBindsLHSFromDoc :: NameMaker
+ -> [Located RdrName] -- RdrNames of the LHS (so we don't have to gather them twice)
+ -> SDoc -- doc string for dup names and shadowing
+ -> HsValBinds RdrName
+ -> RnM (HsValBindsLR Name RdrName)
+rnValBindsLHSFromDoc topP _original_bndrs doc (ValBindsIn mbinds sigs) = do
+ -- rename the LHSes
+ mbinds' <- mapBagM (rnBindLHS topP doc) mbinds
+ return $ ValBindsIn mbinds' sigs
+rnValBindsLHSFromDoc _ _ _ b = pprPanic "rnValBindsLHSFromDoc" (ppr b)
+
+-- General version used both from the top-level and for local things
+-- Assumes the LHS vars are in scope
+--
+-- Does not bind the local fixity declarations
+rnValBindsRHSGen :: (FreeVars -> FreeVars) -- for trimming free var sets
+ -- The trimming function trims the free vars we attach to a
+ -- binding so that it stays reasonably small
+ -> [Name] -- names bound by the LHSes
+ -> HsValBindsLR Name RdrName
+ -> RnM (HsValBinds Name, DefUses)
+
+rnValBindsRHSGen trim bound_names (ValBindsIn mbinds sigs) = do
+ -- rename the sigs
+ sigs' <- renameSigs (Just (mkNameSet bound_names)) okBindSig sigs
+ -- rename the RHSes
+ binds_w_dus <- mapBagM (rnBind (mkSigTvFn sigs') trim) mbinds
+ 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)
+
+-- Wrapper for local binds
+--
+-- The *client* of this function is responsible for checking for unused binders;
+-- it doesn't (and can't: we don't have the thing inside the binds) happen here
+--
+-- The client is also responsible for bringing the fixities into scope
+rnValBindsRHS :: [Name] -- names bound by the LHSes
+ -> HsValBindsLR Name RdrName
+ -> RnM (HsValBinds Name, DefUses)
+rnValBindsRHS bound_names binds =
+ rnValBindsRHSGen (\ fvs -> -- only keep the names the names from this group
+ intersectNameSet (mkNameSet bound_names) fvs) bound_names binds