- -- Find which things are bound in this group
- let
- names_bound_here = mkNameSet (collectPatBinders pat')
- in
- sigsForMe names_bound_here sigs `thenRn` \ sigs_for_me ->
- rnGRHSs grhss `thenRn` \ (grhss', fvs) ->
- returnRn
- [(names_bound_here,
- fvs `plusFV` pat_fvs,
- PatMonoBind pat' grhss' locn,
- sigs_for_me
- )]
-
-flattenMonoBinds sigs (FunMonoBind name inf matches locn)
- = pushSrcLocRn locn $
- lookupBndrRn name `thenRn` \ new_name ->
- let
- names_bound_here = unitNameSet new_name
- in
- sigsForMe names_bound_here sigs `thenRn` \ sigs_for_me ->
- mapFvRn rnMatch matches `thenRn` \ (new_matches, fvs) ->
- mapRn_ (checkPrecMatch inf new_name) new_matches `thenRn_`
- returnRn
- [(unitNameSet new_name,
- fvs,
- FunMonoBind new_name inf new_matches locn,
- sigs_for_me
- )]
-
-
-sigsForMe names_bound_here sigs
- = foldlRn check [] (filter (sigForThisGroup names_bound_here) sigs)
+---------------------
+depAnalBinds :: Bag (LHsBind Name, [Name], Uses)
+ -> ([(RecFlag, LHsBinds Name)], DefUses)
+-- Dependency analysis; this is important so that
+-- unused-binding reporting is accurate
+depAnalBinds binds_w_dus
+ = (map get_binds sccs, map get_du sccs)
+ where
+ sccs = stronglyConnComp edges
+
+ keyd_nodes = bagToList binds_w_dus `zip` [0::Int ..]
+
+ edges = [ (node, key, [key | n <- nameSetToList uses,
+ Just key <- [lookupNameEnv key_map n] ])
+ | (node@(_,_,uses), key) <- keyd_nodes ]
+
+ key_map :: NameEnv Int -- Which binding it comes from
+ key_map = mkNameEnv [(bndr, key) | ((_, bndrs, _), key) <- keyd_nodes
+ , bndr <- bndrs ]
+
+ get_binds (AcyclicSCC (bind, _, _)) = (NonRecursive, unitBag bind)
+ get_binds (CyclicSCC binds_w_dus) = (Recursive, listToBag [b | (b,d,u) <- binds_w_dus])
+
+ get_du (AcyclicSCC (_, bndrs, uses)) = (Just (mkNameSet bndrs), uses)
+ get_du (CyclicSCC binds_w_dus) = (Just defs, uses)
+ where
+ defs = mkNameSet [b | (_,bs,_) <- binds_w_dus, b <- bs]
+ uses = unionManyNameSets [u | (_,_,u) <- binds_w_dus]
+
+
+---------------------
+-- 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` []