X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=ghc%2Fcompiler%2Frename%2FRnNames.lhs;h=6781ee7cacb0554ac2f52c7df2f10dc1828875ad;hb=bb88e732b7383c10496c0f60c3bdea2c22362cc6;hp=baa7c7406ae7bcba42abb0e9dba826a71b6d092e;hpb=b6fbea9780c7acaa623acf2289db1514745ab6b8;p=ghc-hetmet.git

diff --git a/ghc/compiler/rename/RnNames.lhs b/ghc/compiler/rename/RnNames.lhs
index baa7c74..6781ee7 100644
--- a/ghc/compiler/rename/RnNames.lhs
+++ b/ghc/compiler/rename/RnNames.lhs
@@ -23,14 +23,15 @@ import LoadIface	( loadSrcInterface )
 import TcRnMonad
 
 import FiniteMap
-import PrelNames	( pRELUDE_Name, isBuiltInSyntaxName, isUnboundName,
+import PrelNames	( pRELUDE_Name, isUnboundName,
 			  main_RDR_Unqual )
 import Module		( Module, ModuleName, moduleName, mkPackageModule,
 			  moduleNameUserString, isHomeModule,
 			  unitModuleEnvByName, unitModuleEnv, 
 			  lookupModuleEnvByName, moduleEnvElts )
-import Name		( Name, nameSrcLoc, nameOccName, nameModuleName,
-			  nameParent, nameParent_maybe, isExternalName, nameModule )
+import Name		( Name, nameSrcLoc, nameOccName, nameModuleName, isWiredInName,
+			  nameParent, nameParent_maybe, isExternalName, nameModule,
+			  isBuiltInSyntax )
 import NameSet
 import NameEnv
 import OccName		( srcDataName, isTcOcc, occNameFlavour, OccEnv, 
@@ -53,7 +54,7 @@ import SrcLoc		( noSrcLoc, Located(..), mkGeneralSrcSpan,
 			  unLoc, noLoc, srcLocSpan, SrcSpan )
 import BasicTypes	( DeprecTxt )
 import ListSetOps	( removeDups )
-import Util		( sortLt, notNull, isSingleton )
+import Util		( sortLe, notNull, isSingleton )
 import List		( partition )
 import IO		( openFile, IOMode(..) )
 \end{code}
@@ -71,32 +72,32 @@ rnImports :: [LImportDecl RdrName]
 	  -> RnM (GlobalRdrEnv, ImportAvails)
 
 rnImports imports
-  = 		-- PROCESS IMPORT DECLS
+  = do	{	-- PROCESS IMPORT DECLS
 		-- Do the non {- SOURCE -} ones first, so that we get a helpful
 		-- warning for {- SOURCE -} ones that are unnecessary
-	getModule				`thenM` \ this_mod ->
-	doptM Opt_NoImplicitPrelude		`thenM` \ opt_no_prelude -> 
-	let
-	  all_imports	     = mk_prel_imports this_mod opt_no_prelude ++ imports
-	  (source, ordinary) = partition is_source_import all_imports
-	  is_source_import (L _ (ImportDecl _ is_boot _ _ _)) = is_boot
-
-	  get_imports = importsFromImportDecl this_mod
-	in
-	mappM get_imports ordinary	`thenM` \ stuff1 ->
-	mappM get_imports source	`thenM` \ stuff2 ->
+	  this_mod <- getModule
+	; opt_no_prelude <- doptM Opt_NoImplicitPrelude
+	; let
+	    all_imports	     = mk_prel_imports this_mod opt_no_prelude ++ imports
+	    (source, ordinary) = partition is_source_import all_imports
+	    is_source_import (L _ (ImportDecl _ is_boot _ _ _)) = is_boot
+
+	    get_imports = importsFromImportDecl this_mod
+
+	; stuff1 <- mappM get_imports ordinary
+	; stuff2 <- mappM get_imports source
 
 		-- COMBINE RESULTS
-	let
+	; let
 	    (imp_gbl_envs, imp_avails) = unzip (stuff1 ++ stuff2)
 	    gbl_env :: GlobalRdrEnv
 	    gbl_env = foldr plusGlobalRdrEnv emptyGlobalRdrEnv imp_gbl_envs
 
 	    all_avails :: ImportAvails
 	    all_avails = foldr plusImportAvails emptyImportAvails imp_avails
-	in
+
 		-- ALL DONE
-	returnM (gbl_env, all_avails)
+	; return (gbl_env, all_avails) }
   where
 	-- NB: opt_NoImplicitPrelude is slightly different to import Prelude ();
 	-- because the former doesn't even look at Prelude.hi for instance 
@@ -336,10 +337,10 @@ importsFromLocalDecls group
 
  	avails' | implicit_prelude = filter not_built_in_syntax avails
 		| otherwise	   = avails
-	not_built_in_syntax a = not (all isBuiltInSyntaxName (availNames a))
+	not_built_in_syntax a = not (all isBuiltInSyntax (availNames a))
 		-- Only filter it if all the names of the avail are built-in
 		-- In particular, lists have (:) which is not built in syntax
-		-- so we don't filter it out.  [Sept 03: wrong: see isBuiltInSyntaxName]
+		-- so we don't filter it out.  [Sept 03: wrong: see isBuiltInSyntax]
 
 	avail_env = mkAvailEnv avails'
 	imports   = emptyImportAvails {
@@ -728,8 +729,7 @@ check_occs ie occs names
 reportDeprecations :: TcGblEnv -> RnM ()
 reportDeprecations tcg_env
   = ifOptM Opt_WarnDeprecations	$
-    do	{ hpt <- getHpt
-	; eps <- getEps
+    do	{ (eps,hpt) <- getEpsAndHpt
 	; mapM_ (check hpt (eps_PIT eps)) all_gres }
   where
     used_names = findUses (tcg_dus tcg_env) emptyNameSet
@@ -765,7 +765,13 @@ lookupDeprec hpt pit n
   = case lookupIface hpt pit (nameModule n) of
 	Just iface -> mi_dep_fn iface n `seqMaybe` 	-- Bleat if the thing, *or
 		      mi_dep_fn iface (nameParent n)	-- its parent*, is deprec'd
-	Nothing    -> pprPanic "lookupDeprec" (ppr n)	
+	Nothing    
+	  | isWiredInName n -> Nothing
+		-- We have not necessarily loaded the .hi file for a 
+		-- wired-in name (yet), although we *could*.
+		-- And we never deprecate them
+
+	 | otherwise -> pprPanic "lookupDeprec" (ppr n)	
 		-- By now all the interfaces should have been loaded
 
 gre_is_used :: NameSet -> GlobalRdrElt -> Bool
@@ -1005,8 +1011,11 @@ addDupDeclErr (n:ns)
 	  nest 2 (ptext SLIT("other declarations at:")),
 	  nest 4 (vcat (map ppr sorted_locs))]
   where
-    sorted_locs = sortLt occ'ed_before (map nameSrcLoc ns)
-    occ'ed_before a b = LT == compare a b
+    sorted_locs = sortLe occ'ed_before (map nameSrcLoc ns)
+    occ'ed_before a b = case compare a b of
+			  LT -> True
+			  EQ -> True
+			  GT -> False
 
 dupExportWarn occ_name ie1 ie2
   = hsep [quotes (ppr occ_name),