X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=ghc%2Fcompiler%2Frename%2FRename.lhs;h=2d8bd929457f7bee2a8ece74f39250a122c3c956;hb=f7ecf7234c224489be8a5e63fced903b655d92ee;hp=02194ae2ec6385d268545421142021b2712a7ec4;hpb=9d4c03805bafb6b1e1d47306b6a6c591c998e517;p=ghc-hetmet.git

diff --git a/ghc/compiler/rename/Rename.lhs b/ghc/compiler/rename/Rename.lhs
index 02194ae..2d8bd92 100644
--- a/ghc/compiler/rename/Rename.lhs
+++ b/ghc/compiler/rename/Rename.lhs
@@ -39,19 +39,19 @@ import RnUtils		( SYN_IE(RnEnv), extendGlobalRnEnv, emptyRnEnv )
 import Bag		( isEmptyBag, unionBags, unionManyBags, bagToList, listToBag )
 import CmdLineOpts	( opt_HiMap, opt_NoImplicitPrelude )
 import ErrUtils		( SYN_IE(Error), SYN_IE(Warning) )
-import FiniteMap	( emptyFM, eltsFM, fmToList, addToFM, lookupFM{-ToDo:rm-}, FiniteMap )
+import FiniteMap	( emptyFM, eltsFM, fmToList, addToFM, FiniteMap )
 import Maybes		( catMaybes )
 import Name		( isLocallyDefined, mkWiredInName, getLocalName, isLocalName,
 			  origName,
 			  Name, RdrName(..), ExportFlag(..)
 			)
-import PprStyle		-- ToDo:rm
-import PrelInfo		( builtinNameInfo, SYN_IE(BuiltinNames), SYN_IE(BuiltinKeys) )
-import Pretty		-- ToDo:rm
+--import PprStyle		-- ToDo:rm
+import PrelInfo		( builtinNameMaps, builtinKeysMap, SYN_IE(BuiltinNames), SYN_IE(BuiltinKeys) )
+import Pretty
 import Unique		( ixClassKey )
 import UniqFM		( emptyUFM, lookupUFM, addListToUFM_C, eltsUFM )
 import UniqSupply	( splitUniqSupply )
-import Util		( panic, assertPanic, pprTrace{-ToDo:rm-} )
+import Util		( panic, assertPanic{-, pprTrace ToDo:rm-} )
 \end{code}
 
 \begin{code}
@@ -62,7 +62,10 @@ renameModule :: UniqSupply
 		    RnEnv,		-- final env (for renaming derivings)
 		    [Module],	   	-- imported modules; for profiling
 
-		    Name -> ExportFlag,	-- export info
+		    (Name -> ExportFlag,	-- export info
+		     ([(Name,ExportFlag)],
+		      [(Name,ExportFlag)])),
+
 		    (UsagesMap,
 	            VersionsMap,      	-- version info; for usage
 		    [Module]),	   	-- instance modules; for iface
@@ -77,29 +80,29 @@ ToDo: Deal with instances (instance version, this module on instance list ???)
 \begin{code}
 renameModule us input@(HsModule modname _ _ imports _ _ _ _ _ _ _ _ _ _)
 
-  = let
-	(b_names, b_keys, _) = builtinNameInfo
+  = {-
+    let
 	pp_pair (n,m) = ppBesides [ppPStr m,ppChar '.',ppPStr n]
     in
-    {-
-    pprTrace "builtins:\n" (case b_names of { (builtin_ids, builtin_tcs) ->
+    pprTrace "builtins:\n" (case builtinNameMaps of { (builtin_ids, builtin_tcs) ->
     			    ppAboves [ ppCat (map pp_pair (keysFM builtin_ids))
     				     , ppCat (map pp_pair (keysFM builtin_tcs))
-    				     , ppCat (map pp_pair (keysFM b_keys))
+    				     , ppCat (map pp_pair (keysFM builtinKeysMap))
     				     ]}) $
     -}
+    -- _scc_ "rnGlobalNames"
     makeHiMap opt_HiMap	    >>=	         \ hi_files ->
 --  pprTrace "HiMap:\n" (ppAboves [ ppCat [ppPStr m, ppStr p] | (m,p) <- fmToList hi_files])
     initIfaceCache modname hi_files  >>= \ iface_cache ->
 
-    fixIO ( \ ~(_, _, _, _, rec_occ_fm, rec_export_fn) ->
+    fixIO ( \ ~(_, _, _, _, rec_occ_fm, ~(rec_export_fn,_)) ->
     let
 	rec_occ_fn :: Name -> [RdrName]
 	rec_occ_fn n = case lookupUFM rec_occ_fm n of
 		         Nothing        -> []
 		         Just (rn,occs) -> occs
 
-	global_name_info = (b_names, b_keys, rec_export_fn, rec_occ_fn)
+	global_name_info = (builtinNameMaps, builtinKeysMap, rec_export_fn, rec_occ_fn)
     in
     getGlobalNames iface_cache global_name_info us1 input >>=
 	\ (occ_env, imp_mods, unqual_imps, imp_fixes, top_errs, top_warns) ->
@@ -109,12 +112,12 @@ renameModule us input@(HsModule modname _ _ imports _ _ _ _ _ _ _ _ _ _)
     else
 
     -- No top-level name errors so rename source ...
+    -- _scc_ "rnSource"
     case initRn True modname occ_env us2
 		(rnSource imp_mods unqual_imps imp_fixes input) of {
-	((rn_module, export_fn, src_occs), src_errs, src_warns) ->
+	((rn_module, export_fn, module_dotdots, src_occs), src_errs, src_warns) ->
 
     --pprTrace "renameModule:" (ppCat (map (ppr PprDebug . fst) (bagToList src_occs))) $
-
     let
 	occ_fm :: UniqFM (RnName, [RdrName])
 
@@ -129,21 +132,25 @@ renameModule us input@(HsModule modname _ _ imports _ _ _ _ _ _ _ _ _ _)
 			      			  GT__ -> x : insert new xs
 
 	occ_warns = map multipleOccWarn (filter multiple_occs (eltsUFM occ_fm))
-	multiple_occs (rn, (o1:o2:_)) = True
+
+	multiple_occs (rn, (o1:o2:_)) = getLocalName o1 /= SLIT("negate")
+					-- the user is rarely responsible if
+					-- "negate" is mentioned in multiple ways
 	multiple_occs _               = False
     in
     return (rn_module, imp_mods, 
 	    top_errs  `unionBags` src_errs,
 	    top_warns `unionBags` src_warns `unionBags` listToBag occ_warns,
-	    occ_fm, export_fn)
+	    occ_fm, (export_fn, module_dotdots))
 
-    }) >>= \ (rn_module, imp_mods, errs_so_far, warns_so_far, occ_fm, export_fn) ->
+    }) >>= \ (rn_module, imp_mods, errs_so_far, warns_so_far, occ_fm, export_stuff) ->
 
     if not (isEmptyBag errs_so_far) then
 	return (rn_panic, rn_panic, rn_panic, rn_panic, rn_panic, errs_so_far, warns_so_far)
     else
 
     -- No errors renaming source so rename the interfaces ...
+    -- _scc_ "preRnIfaces"
     let
 	-- split up all names that occurred in the source; between
 	-- those that are defined therein and those merely mentioned.
@@ -183,22 +190,15 @@ renameModule us input@(HsModule modname _ _ imports _ _ _ _ _ _ _ _ _ _)
 	     else case (origName "pairify_rn" name) of { OrigName m n ->
 		  Qual m n }
 	     , rn)
-
-	must_haves
-	  | opt_NoImplicitPrelude
-	  = [{-no Prelude.hi, no point looking-}]
-	  | otherwise
-	  = [ name_fn (mkWiredInName u orig ExportAll)
-	    | (orig@(OrigName mod str), (u, name_fn)) <- fmToList b_keys,
-	      str `notElem` [ SLIT("main"), SLIT("mainPrimIO")] ]
     in
 --  ASSERT (isEmptyBag orig_occ_dups)
-    (if (isEmptyBag orig_occ_dups) then \x->x
-     else pprTrace "orig_occ_dups:" (ppAboves [ ppCat [ppr PprDebug m, ppr PprDebug n, ppr PprDebug o] | (m,n,o) <- bagToList orig_occ_dups])) $
+--    (if (isEmptyBag orig_occ_dups) then \x->x
+--     else pprTrace "orig_occ_dups:" (ppAboves [ ppCat [ppr PprDebug m, ppr PprDebug n, ppr PprDebug o] | (m,n,o) <- bagToList orig_occ_dups])) $
     ASSERT (isEmptyBag orig_def_dups)
 
+    -- _scc_ "rnIfaces"
     rnIfaces iface_cache imp_mods us3 orig_def_env orig_occ_env
-	     rn_module (must_haves ++ imports_used) >>=
+	     rn_module (initMustHaves ++ imports_used) >>=
 	\ (rn_module_with_imports, final_env,
 	   (implicit_val_fm, implicit_tc_fm),
 	   usage_stuff,
@@ -207,7 +207,7 @@ renameModule us input@(HsModule modname _ _ imports _ _ _ _ _ _ _ _ _ _)
     return (rn_module_with_imports,
 	    final_env,
 	    imp_mods,
-	    export_fn,
+	    export_stuff,
 	    usage_stuff,
 	    errs_so_far  `unionBags` iface_errs,
 	    warns_so_far `unionBags` iface_warns)
@@ -216,6 +216,17 @@ renameModule us input@(HsModule modname _ _ imports _ _ _ _ _ _ _ _ _ _)
 
     (us1, us') = splitUniqSupply us
     (us2, us3) = splitUniqSupply us'
+
+initMustHaves :: [RnName]
+    -- things we *must* find declarations for, because the
+    -- compiler may eventually make reference to them (e.g.,
+    -- class Eq)
+initMustHaves
+  | opt_NoImplicitPrelude
+  = [{-no Prelude.hi, no point looking-}]
+  | otherwise
+  = [ name_fn (mkWiredInName u orig ExportAll)
+    | (orig@(OrigName mod str), (u, name_fn)) <- fmToList builtinKeysMap ]
 \end{code}
 
 \begin{code}