X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=ghc%2Fcompiler%2Frename%2FRename.lhs;h=9d340f24c1966ed5fc3193993d2e6f97609f4eb5;hb=a237946da277f10bd3d223e5926d118044d24194;hp=df72d3159b08b92abbc35a8613a547871ca7fe1e;hpb=d3d3c6122f19a9a936f3c0b6f10486faaa1055bd;p=ghc-hetmet.git

diff --git a/ghc/compiler/rename/Rename.lhs b/ghc/compiler/rename/Rename.lhs
index df72d31..9d340f2 100644
--- a/ghc/compiler/rename/Rename.lhs
+++ b/ghc/compiler/rename/Rename.lhs
@@ -15,7 +15,7 @@ import RnHsSyn		( RenamedHsModule, RenamedHsDecl,
 			  extractHsTyNames, extractHsCtxtTyNames
 			)
 
-import CmdLineOpts	( opt_HiMap, opt_D_dump_rn_trace, opt_D_dump_minimal_imports,
+import CmdLineOpts	( dopt_D_dump_rn_trace, dopt_D_dump_minimal_imports,
 			  opt_D_dump_rn, opt_D_dump_rn_stats, opt_WarnDeprecations,
 			  opt_WarnUnusedBinds
 		        )
@@ -48,10 +48,12 @@ import TyCon		( isSynTyCon, getSynTyConDefn )
 import NameSet
 import TysWiredIn	( unitTyCon, intTyCon, doubleTyCon, boolTyCon )
 import PrelRules	( builtinRules )
-import PrelInfo		( mAIN_Name, pREL_MAIN_Name, pRELUDE_Name,
-			  ioTyCon_RDR, unpackCString_RDR, unpackCStringFoldr_RDR, unpackCStringUtf8_RDR,
-			  fractionalClassKeys, derivingOccurrences 
+import PrelNames	( mAIN_Name, pREL_MAIN_Name, pRELUDE_Name,
+			  ioTyCon_RDR,
+			  unpackCString_RDR, unpackCStringFoldr_RDR, unpackCStringUtf8_RDR,
+			  eqString_RDR
 			)
+import PrelInfo		( fractionalClassKeys, derivingOccurrences )
 import Type		( namesOfType, funTyCon )
 import ErrUtils		( printErrorsAndWarnings, dumpIfSet, ghcExit )
 import BasicTypes	( Version, initialVersion )
@@ -78,12 +80,13 @@ type RenameResult = ( Module		-- This module
 		    , FixityEnv		-- The fixity environment; for derivings
 		    , [Module])		-- Imported modules
 		   
-renameModule :: UniqSupply -> RdrNameHsModule -> IO (Maybe RenameResult)
-renameModule us this_mod@(HsModule mod_name vers exports imports local_decls _ loc)
+renameModule :: PersistentCompilerState -> RdrNameHsModule -> IO (Maybe RenameResult)
+renameModule pcs this_mod@(HsModule mod_name vers exports imports local_decls _ loc)
   = 	-- Initialise the renamer monad
     do {
 	((maybe_rn_stuff, dump_action), rn_errs_bag, rn_warns_bag) 
-	   <- initRn (mkThisModule mod_name) us 
+	   <- initRn pcs 
+		     (mkThisModule mod_name) 
 		     (mkSearchPath opt_HiMap) loc
 		     (rename this_mod) ;
 
@@ -247,9 +250,10 @@ implicitFVs mod_name decls
     implicit_occs = string_occs ++ foldr ((++) . get) implicit_main decls
 
 	-- Virtually every program has error messages in it somewhere
-    string_occs = [unpackCString_RDR, unpackCStringFoldr_RDR, unpackCStringUtf8_RDR]
+    string_occs = [unpackCString_RDR, unpackCStringFoldr_RDR, unpackCStringUtf8_RDR,
+		   eqString_RDR]
 
-    get (TyClD (TyData _ _ _ _ _ _ (Just deriv_classes) _ _))
+    get (TyClD (TyData _ _ _ _ _ _ (Just deriv_classes) _ _ _ _))
        = concat (map get_deriv deriv_classes)
     get other = []
 
@@ -275,6 +279,7 @@ isOrphanDecl (RuleD (HsRule _ _ _ lhs _ _))
     check (HsVar v)   	  = not (isLocallyDefined v)
     check (HsApp f a) 	  = check f && check a
     check (HsLit _)   	  = False
+    check (HsOverLit _)	  = False
     check (OpApp l o _ r) = check l && check o && check r
     check (NegApp e _)    = check e
     check (HsPar e)	  = check e
@@ -468,8 +473,9 @@ slurpDeferredDecls decls
     ASSERT( isEmptyFVs fvs )
     returnRn decls1
 
-stripDecl (mod, TyClD (TyData dt _ tc tvs _ nconstrs _ _ loc))
-  = (mod, TyClD (TyData dt [] tc tvs [] nconstrs Nothing NoDataPragmas loc))
+stripDecl (mod, TyClD (TyData dt _ tc tvs _ nconstrs _ _ loc name1 name2))
+  = (mod, TyClD (TyData dt [] tc tvs [] nconstrs Nothing NoDataPragmas loc
+		name1 name2))
 	-- Nuke the context and constructors
 	-- But retain the *number* of constructors!
 	-- Also the tvs will have kinds on them.
@@ -500,7 +506,7 @@ vars of the source program, and extracts from the decl the gate names.
 getGates source_fvs (SigD (IfaceSig _ ty _ _))
   = extractHsTyNames ty
 
-getGates source_fvs (TyClD (ClassDecl ctxt cls tvs _ sigs _ _ _ _ _ _ _))
+getGates source_fvs (TyClD (ClassDecl ctxt cls tvs _ sigs _ _ _ _ ))
   = (delListFromNameSet (foldr (plusFV . get) (extractHsCtxtTyNames ctxt) sigs)
 		        (hsTyVarNames tvs)
      `addOneToNameSet` cls)
@@ -525,7 +531,7 @@ getGates source_fvs (TyClD (TySynonym tycon tvs ty _))
 		       (hsTyVarNames tvs)
 	-- A type synonym type constructor isn't a "gate" for instance decls
 
-getGates source_fvs (TyClD (TyData _ ctxt tycon tvs cons _ _ _ _))
+getGates source_fvs (TyClD (TyData _ ctxt tycon tvs cons _ _ _ _ _ _))
   = delListFromNameSet (foldr (plusFV . get) (extractHsCtxtTyNames ctxt) cons)
 		       (hsTyVarNames tvs)
     `addOneToNameSet` tycon
@@ -548,7 +554,6 @@ getGates source_fvs (TyClD (TyData _ ctxt tycon tvs cons _ _ _ _))
     get_details (VanillaCon tys) = plusFVs (map get_bang tys)
     get_details (InfixCon t1 t2) = get_bang t1 `plusFV` get_bang t2
     get_details (RecCon fields)  = plusFVs [get_bang t | (_, t) <- fields]
-    get_details (NewCon t _)	 = extractHsTyNames t
 
     get_field (fs,t) | any (`elemNameSet` source_fvs) fs = get_bang t
 		     | otherwise			 = emptyFVs
@@ -602,7 +607,7 @@ fixitiesFromLocalDecls gbl_env decls
     getFixities acc (FixD fix)
       = fix_decl acc fix
 
-    getFixities acc (TyClD (ClassDecl _ _ _ _ sigs _ _ _ _ _ _ _))
+    getFixities acc (TyClD (ClassDecl _ _ _ _ sigs _ _ _ _ ))
       = foldlRn fix_decl acc [sig | FixSig sig <- sigs]
 		-- Get fixities from class decl sigs too.
     getFixities acc other_decl