X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=ghc%2Fcompiler%2Frename%2FRnMonad.lhs;h=78f89184f7d3ea0f2e27dd747ad94b9a48616c57;hb=30cf375e0bc79a6b71074a5e0fd2ec393241a751;hp=dd1ec55c375a7d729d6085734355be0b07d012a6;hpb=4250d64191132fd493985549eda5ca05b82a663f;p=ghc-hetmet.git

diff --git a/ghc/compiler/rename/RnMonad.lhs b/ghc/compiler/rename/RnMonad.lhs
index dd1ec55..78f8918 100644
--- a/ghc/compiler/rename/RnMonad.lhs
+++ b/ghc/compiler/rename/RnMonad.lhs
@@ -43,7 +43,8 @@ import RnHsSyn		( RnName, mkRnName, mkRnUnbound, mkRnImplicit,
 import RnUtils		( RnEnv(..), extendLocalRnEnv,
 			  lookupRnEnv, lookupGlobalRnEnv, lookupTcRnEnv,
 			  unknownNameErr, badClassOpErr, qualNameErr,
-			  dupNamesErr, shadowedNameWarn, negateNameWarn )
+			  dupNamesErr, shadowedNameWarn
+			)
 
 import Bag		( Bag, emptyBag, isEmptyBag, snocBag )
 import CmdLineOpts	( opt_WarnNameShadowing )
@@ -55,6 +56,7 @@ import Name		( Module(..), RdrName(..), isQual,
 			  getOccName
 			)
 import PrelInfo		( builtinNameInfo, BuiltinNames(..), BuiltinKeys(..) )
+import PrelMods		( pRELUDE )
 import Pretty		( Pretty(..), PrettyRep )
 import SrcLoc		( SrcLoc, mkUnknownSrcLoc )
 import UniqFM		( UniqFM, emptyUFM )
@@ -291,12 +293,10 @@ newLocalNames :: String 		-- Documentation string
 	      -> RnMonad x s [RnName]
 
 newLocalNames str names_w_loc
-  = mapRn (addWarnRn . negateNameWarn) negs 	`thenRn_`
-    mapRn (addErrRn . qualNameErr str) quals 	`thenRn_`
+  = mapRn (addErrRn . qualNameErr str) quals 	`thenRn_`
     mapRn (addErrRn . dupNamesErr str) dups  	`thenRn_`
     mkLocalNames these
   where
-    negs  = filter ((== Unqual SLIT("negate")).fst) names_w_loc
     quals = filter (isQual.fst) names_w_loc
     (these, dups) = removeDups cmp_fst names_w_loc
     cmp_fst (a,_) (b,_) = cmp a b
@@ -306,10 +306,10 @@ newLocalNames str names_w_loc
 mkLocalNames :: [(RdrName, SrcLoc)] -> RnMonad x s [RnName]
 mkLocalNames names_w_locs
   = rnGetUniques (length names_w_locs) 	`thenRn` \ uniqs ->
-    returnRn (zipWithEqual new_local uniqs names_w_locs)
+    returnRn (zipWithEqual "mkLocalNames" new_local uniqs names_w_locs)
   where
     new_local uniq (Unqual str, srcloc)
-      = mkRnName (mkLocalName uniq str srcloc)
+      = mkRnName (mkLocalName uniq str False{-emph names-} srcloc)
 \end{code}
 
 
@@ -369,30 +369,26 @@ lookup_val rdr lookup check do_err down@(RnDown _ _ locn (RnIface b_names b_key
 	Nothing   -> lookup_nonexisting_val b_names b_key imp_var us_var rdr
 
 lookup_nonexisting_val (b_names,_) b_key imp_var us_var rdr
-  = case rdr of
-      Qual _ _ -> -- builtin things *don't* have Qual names
-		  lookup_or_create_implicit_val b_key imp_var us_var rdr
-
-      Unqual n -> case (lookupFM b_names n) of
-		    Nothing -> lookup_or_create_implicit_val b_key imp_var us_var rdr
-		    Just xx -> returnSST xx
+  = let str_mod = case rdr of { Qual m n -> (n,m); Unqual n -> (n, pRELUDE) }
+    in case (lookupFM b_names str_mod) of
+	 Nothing -> lookup_or_create_implicit_val b_key imp_var us_var rdr
+	 Just xx -> returnSST xx
 
 lookup_or_create_implicit_val b_key imp_var us_var rdr
   = readMutVarSST imp_var `thenSST` \ (implicit_val_fm, implicit_tc_fm) ->
     case lookupFM implicit_val_fm rdr of
 	Just implicit -> returnSST implicit
 	Nothing ->
-	  (case rdr of
-	     Qual _ _ -> get_unique us_var
-	     Unqual n -> case (lookupFM b_key n) of
-			   Just (u,_) -> returnSST u
-			   _	      -> get_unique us_var
-	  )					`thenSST` \ uniq -> 
+	  (let str_mod = case rdr of { Qual m n -> (n,m); Unqual n -> (n, pRELUDE) }
+	   in case (lookupFM b_key str_mod) of
+		Just (u,_) -> returnSST u
+		_          -> get_unique us_var
+	  )							`thenSST` \ uniq -> 
 	  let
 	      implicit   = mkRnImplicit (mkImplicitName uniq rdr)
 	      new_val_fm = addToFM implicit_val_fm rdr implicit
 	  in
-	  writeMutVarSST imp_var (new_val_fm, implicit_tc_fm) `thenSST_`
+	  writeMutVarSST imp_var (new_val_fm, implicit_tc_fm) 	`thenSST_`
 	  returnSST implicit
 \end{code}
 
@@ -430,13 +426,10 @@ lookup_tc rdr check mk_implicit err_str down@(RnDown _ _ locn (RnIface b_names b
     fail = failButContinueRn (mkRnUnbound rdr) (unknownNameErr err_str rdr locn) down
 
 lookup_nonexisting_tc check mk_implicit fail (_,b_names) b_key imp_var us_var rdr
-  = case rdr of
-      Qual _ _ -> -- builtin things *don't* have Qual names
-		  lookup_or_create_implicit_tc check mk_implicit fail b_key imp_var us_var rdr
-
-      Unqual n -> case (lookupFM b_names n) of
-		    Nothing -> lookup_or_create_implicit_tc check mk_implicit fail b_key imp_var us_var rdr
-		    Just xx -> returnSST xx
+  = let str_mod = case rdr of { Qual m n -> (n,m); Unqual n -> (n, pRELUDE) }
+    in case (lookupFM b_names str_mod) of
+	 Nothing -> lookup_or_create_implicit_tc check mk_implicit fail b_key imp_var us_var rdr
+	 Just xx -> returnSST xx
 
 lookup_or_create_implicit_tc check mk_implicit fail b_key imp_var us_var rdr
   = readMutVarSST imp_var `thenSST` \ (implicit_val_fm, implicit_tc_fm) ->
@@ -444,17 +437,16 @@ lookup_or_create_implicit_tc check mk_implicit fail b_key imp_var us_var rdr
 	Just implicit | check implicit -> returnSST implicit
 		      | otherwise      -> fail
 	Nothing ->
-	  (case rdr of
-	     Qual _ _ -> get_unique us_var
-	     Unqual n -> case (lookupFM b_key n) of
-			   Just (u,_) -> returnSST u
-			   _	      -> get_unique us_var
-	  )					`thenSST` \ uniq -> 
+	  (let str_mod = case rdr of { Qual m n -> (n,m); Unqual n -> (n, pRELUDE) }
+	   in case (lookupFM b_key str_mod) of
+		Just (u,_) -> returnSST u
+		_          -> get_unique us_var
+	  )							`thenSST` \ uniq -> 
 	  let
 	      implicit  = mk_implicit (mkImplicitName uniq rdr)
 	      new_tc_fm = addToFM implicit_tc_fm rdr implicit
 	  in
-	  writeMutVarSST imp_var (implicit_val_fm, new_tc_fm) `thenSST_`
+	  writeMutVarSST imp_var (implicit_val_fm, new_tc_fm) 	`thenSST_`
 	  returnSST implicit
 \end{code}