X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2Frename%2FRnBinds.lhs;h=9efe64e133ee1966c23dd38d1304c726d9b2fdfa;hb=27286cf2ce6733cbbf008972c6bea30ea2e562ee;hp=57731082eb6ce003f3b309f435eb5bc5aa3c3706;hpb=354d1eb692be9fa5683dab82258062ebc61fdb2d;p=ghc-hetmet.git

diff --git a/compiler/rename/RnBinds.lhs b/compiler/rename/RnBinds.lhs
index 5773108..9efe64e 100644
--- a/compiler/rename/RnBinds.lhs
+++ b/compiler/rename/RnBinds.lhs
@@ -28,7 +28,7 @@ import RnPat          (rnPats, rnBindPat,
                       )
                       
 import RnEnv
-import DynFlags	( DynFlag(..) )
+import DynFlags
 import Name
 import NameEnv
 import NameSet
@@ -158,8 +158,7 @@ rnTopBindsLHS :: MiniFixityEnv
               -> HsValBinds RdrName 
               -> RnM (HsValBindsLR Name RdrName)
 rnTopBindsLHS fix_env binds
-  = do { mod <- getModule
-       ; rnValBindsLHSFromDoc (topRecNameMaker mod fix_env) binds }
+  = rnValBindsLHSFromDoc (topRecNameMaker fix_env) binds
 
 rnTopBindsRHS :: NameSet	-- Names bound by these binds
               -> HsValBindsLR Name RdrName 
@@ -179,7 +178,7 @@ rnTopBinds :: HsValBinds RdrName
            -> RnM (HsValBinds Name, DefUses)
 rnTopBinds b = 
   do nl <- rnTopBindsLHS emptyFsEnv b
-     let bound_names = map unLoc (collectHsValBinders nl)
+     let bound_names = collectHsValBinders nl
      bindLocalNames bound_names $ rnTopBindsRHS (mkNameSet bound_names) nl
        
 
@@ -261,7 +260,7 @@ rnValBindsLHS fix_env binds
      	 --   g = let f = ... in f
      	 -- should.
        ; binds' <- rnValBindsLHSFromDoc (localRecNameMaker fix_env) binds 
-       ; let bound_names = map unLoc $ collectHsValBinders binds'
+       ; let bound_names = collectHsValBinders binds'
        ; envs <- getRdrEnvs
        ; checkDupAndShadowedNames envs bound_names
        ; return (bound_names, binds') }
@@ -276,7 +275,7 @@ rnValBindsLHSFromDoc topP (ValBindsIn mbinds sigs)
   = do { mbinds' <- mapBagM (rnBindLHS topP doc) mbinds
        ; return $ ValBindsIn mbinds' sigs }
   where
-    bndrs = collectHsBindBinders mbinds
+    bndrs = collectHsBindsBinders mbinds
     doc   = text "In the binding group for:" <+> pprWithCommas ppr bndrs
 
 rnValBindsLHSFromDoc _ b = pprPanic "rnValBindsLHSFromDoc" (ppr b)
@@ -314,10 +313,11 @@ rnValBindsRHSGen _ _ b = pprPanic "rnValBindsRHSGen" (ppr b)
 rnValBindsRHS :: NameSet  -- 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 bound_names fvs) bound_names binds
-
+rnValBindsRHS bound_names binds
+  = rnValBindsRHSGen trim bound_names binds
+  where
+    trim fvs = intersectNameSet bound_names fvs 
+	-- Only keep the names the names from this group
 
 -- for local binds
 -- wrapper that does both the left- and right-hand sides 
@@ -335,7 +335,8 @@ rnValBindsAndThen binds@(ValBindsIn _ sigs) thing_inside
 	; (bound_names, new_lhs) <- rnValBindsLHS new_fixities binds
 
 	      --     ...and bring them (and their fixities) into scope
-	; bindLocalNamesFV_WithFixities bound_names new_fixities $ do
+	; bindLocalNamesFV bound_names              $
+          addLocalFixities new_fixities bound_names $ do
 
 	{      -- (C) Do the RHS and thing inside
 	  (binds', dus) <- rnValBindsRHS (mkNameSet bound_names) new_lhs 
@@ -350,9 +351,9 @@ rnValBindsAndThen binds@(ValBindsIn _ sigs) thing_inside
 
 	; let
             -- The variables "used" in the val binds are: 
-            --   (1) the uses of the binds (duUses)
+            --   (1) the uses of the binds (allUses)
             --   (2) the FVs of the thing-inside
-            all_uses = duUses dus `plusFV` result_fvs
+            all_uses = allUses dus `plusFV` result_fvs
 		-- Note [Unused binding hack]
 		-- ~~~~~~~~~~~~~~~~~~~~~~~~~~
 		-- Note that *in contrast* to the above reporting of
@@ -464,21 +465,22 @@ rnBind :: (Name -> [Name])		-- Signature tyvar function
 rnBind _ trim (L loc (PatBind { pat_lhs = pat,
                                 pat_rhs = grhss, 
                                 -- pat fvs were stored here while
-                                -- processing the LHS          
-                                bind_fvs=pat_fvs }))
+                                -- after processing the LHS          
+                                bind_fvs = pat_fvs }))
   = setSrcSpan loc $ 
     do	{let bndrs = collectPatBinders pat
 
 	; (grhss', fvs) <- rnGRHSs PatBindRhs grhss
 		-- No scoped type variables for pattern bindings
-	; let fvs' = trim fvs
+	; let all_fvs = pat_fvs `plusFV` fvs
+              fvs'    = trim all_fvs
 
 	; fvs' `seq` -- See Note [Free-variable space leak]
-      return (L loc (PatBind { pat_lhs = pat,
-                                  pat_rhs = grhss', 
-				     pat_rhs_ty = placeHolderType, 
-                                  bind_fvs = fvs' }),
-		  bndrs, pat_fvs `plusFV` fvs) }
+          return (L loc (PatBind { pat_lhs    = pat,
+                                   pat_rhs    = grhss', 
+				   pat_rhs_ty = placeHolderType, 
+                                   bind_fvs   = fvs' }),
+		  bndrs, all_fvs) }
 
 rnBind sig_fn 
        trim 
@@ -606,10 +608,11 @@ rnMethodBinds :: Name			-- Class name
 	      -> RnM (LHsBinds Name, FreeVars)
 
 rnMethodBinds cls sig_fn gen_tyvars binds
-  = foldM do_one (emptyBag,emptyFVs) (bagToList binds)
-  where do_one (binds,fvs) bind = do
-	   (bind', fvs_bind) <- rnMethodBind cls sig_fn gen_tyvars bind
-	   return (bind' `unionBags` binds, fvs_bind `plusFV` fvs)
+  = foldlM do_one (emptyBag,emptyFVs) (bagToList binds)
+  where 
+    do_one (binds,fvs) bind 
+       = do { (bind', fvs_bind) <- rnMethodBind cls sig_fn gen_tyvars bind
+	    ; return (binds `unionBags` bind', fvs_bind `plusFV` fvs) }
 
 rnMethodBind :: Name
 	      -> (Name -> [Name])