X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2Frename%2FRnEnv.lhs;h=c2b7a7b52f56fe74a7b2e7023e7f20ffe166d794;hb=786932468faac49aafe20b65eabc8bdf465fbc9d;hp=c3b5592834f2ac5855cc1707fd281fa5b65ea0b7;hpb=f1cc3eb980a634e62f2739a7a25387c902fa9d8a;p=ghc-hetmet.git

diff --git a/compiler/rename/RnEnv.lhs b/compiler/rename/RnEnv.lhs
index c3b5592..c2b7a7b 100644
--- a/compiler/rename/RnEnv.lhs
+++ b/compiler/rename/RnEnv.lhs
@@ -20,10 +20,10 @@ module RnEnv (
 	newLocalBndrRn, newLocalBndrsRn, newIPNameRn,
 	bindLocalName, bindLocalNames, bindLocalNamesFV, 
 	MiniFixityEnv, emptyFsEnv, extendFsEnv, lookupFsEnv,
-	bindLocalNamesFV_WithFixities,
+	addLocalFixities,
 	bindLocatedLocalsFV, bindLocatedLocalsRn,
 	bindSigTyVarsFV, bindPatSigTyVars, bindPatSigTyVarsFV,
-	bindTyVarsRn, extendTyVarEnvFVRn,
+	bindTyVarsRn, bindTyVarsFV, extendTyVarEnvFVRn,
 
 	checkDupRdrNames, checkDupAndShadowedRdrNames,
         checkDupNames, checkDupAndShadowedNames, 
@@ -48,10 +48,10 @@ import Name		( Name, nameIsLocalOrFrom, mkInternalName, isWiredInName,
 			  nameSrcLoc, nameSrcSpan, nameOccName, nameModule, isExternalName )
 import NameSet
 import NameEnv
-import LazyUniqFM
+import UniqFM
 import DataCon		( dataConFieldLabels )
 import OccName
-import Module		( Module, ModuleName )
+import Module		( ModuleName )
 import PrelNames	( mkUnboundName, rOOT_MAIN, iNTERACTIVE, 
 			  consDataConKey, forall_tv_RDR )
 import Unique
@@ -82,8 +82,8 @@ thenM = (>>=)
 %*********************************************************
 
 \begin{code}
-newTopSrcBinder :: Module -> Located RdrName -> RnM Name
-newTopSrcBinder this_mod (L loc rdr_name)
+newTopSrcBinder :: Located RdrName -> RnM Name
+newTopSrcBinder (L loc rdr_name)
   | Just name <- isExact_maybe rdr_name
   =	-- This is here to catch 
 	--   (a) Exact-name binders created by Template Haskell
@@ -95,13 +95,15 @@ newTopSrcBinder this_mod (L loc rdr_name)
 	--	data T = (,) Int Int
 	-- unless we are in GHC.Tup
     ASSERT2( isExternalName name,  ppr name )
-    do	{ unless (this_mod == nameModule name)
+    do	{ this_mod <- getModule
+        ; unless (this_mod == nameModule name)
 	         (addErrAt loc (badOrigBinding rdr_name))
 	; return name }
 
 
   | Just (rdr_mod, rdr_occ) <- isOrig_maybe rdr_name
-  = do	{ unless (rdr_mod == this_mod || rdr_mod == rOOT_MAIN)
+  = do	{ this_mod <- getModule
+        ; unless (rdr_mod == this_mod || rdr_mod == rOOT_MAIN)
 	         (addErrAt loc (badOrigBinding rdr_name))
 	-- When reading External Core we get Orig names as binders, 
 	-- but they should agree with the module gotten from the monad
@@ -137,7 +139,8 @@ newTopSrcBinder this_mod (L loc rdr_name)
 	        ; return (mkInternalName uniq (rdrNameOcc rdr_name) loc) } 
 	  else	
 	  	-- Normal case
-	     newGlobalBinder this_mod (rdrNameOcc rdr_name) loc }
+             do { this_mod <- getModule
+                ; newGlobalBinder this_mod (rdrNameOcc rdr_name) loc } }
 \end{code}
 
 %*********************************************************
@@ -651,22 +654,17 @@ type MiniFixityEnv = FastStringEnv (Located Fixity)
 --------------------------------
 -- Used for nested fixity decls to bind names along with their fixities.
 -- the fixities are given as a UFM from an OccName's FastString to a fixity decl
-bindLocalNamesFV_WithFixities :: [Name]
-			      -> MiniFixityEnv
-			      -> RnM (a, FreeVars) -> RnM (a, FreeVars)
-bindLocalNamesFV_WithFixities names fixities thing_inside
-  = bindLocalNamesFV names $
-    extendFixityEnv boundFixities $ 
-    thing_inside
+
+addLocalFixities :: MiniFixityEnv -> [Name] -> RnM a -> RnM a
+addLocalFixities mini_fix_env names thing_inside
+  = extendFixityEnv (mapCatMaybes find_fixity names) thing_inside
   where
-    -- find the names that have fixity decls
-    boundFixities = foldr 
-                        (\ name -> \ acc -> 
-                         -- check whether this name has a fixity decl
-                          case lookupFsEnv fixities (occNameFS (nameOccName name)) of
-                               Just (L _ fix) -> (name, FixItem (nameOccName name) fix) : acc
-                               Nothing -> acc) [] names
-    -- bind the names; extend the fixity env; do the thing inside
+    find_fixity name 
+      = case lookupFsEnv mini_fix_env (occNameFS occ) of
+          Just (L _ fix) -> Just (name, FixItem occ fix)
+          Nothing        -> Nothing
+      where
+        occ = nameOccName name
 \end{code}
 
 --------------------------------
@@ -841,7 +839,7 @@ bindLocalName name enclosed_scope
 bindLocalNamesFV :: [Name] -> RnM (a, FreeVars) -> RnM (a, FreeVars)
 bindLocalNamesFV names enclosed_scope
   = do	{ (result, fvs) <- bindLocalNames names enclosed_scope
-	; return (result, delListFromNameSet fvs names) }
+	; return (result, delFVs names fvs) }
 
 
 -------------------------------------
@@ -852,9 +850,17 @@ bindLocatedLocalsFV :: [Located RdrName]
 bindLocatedLocalsFV rdr_names enclosed_scope
   = bindLocatedLocalsRn rdr_names	$ \ names ->
     enclosed_scope names		`thenM` \ (thing, fvs) ->
-    return (thing, delListFromNameSet fvs names)
+    return (thing, delFVs names fvs)
 
 -------------------------------------
+bindTyVarsFV ::  [LHsTyVarBndr RdrName]
+	      -> ([LHsTyVarBndr Name] -> RnM (a, FreeVars))
+	      -> RnM (a, FreeVars)
+bindTyVarsFV tyvars thing_inside
+  = bindTyVarsRn tyvars $ \ tyvars' ->
+    do { (res, fvs) <- thing_inside tyvars'
+       ; return (res, delFVs (map hsLTyVarName tyvars') fvs) }
+
 bindTyVarsRn ::  [LHsTyVarBndr RdrName]
 	      -> ([LHsTyVarBndr Name] -> RnM a)
 	      -> RnM a