[project @ 2000-10-11 16:45:53 by sewardj]

[ghc-hetmet.git] / ghc / compiler / rename / Rename.lhs

diff --git a/ghc/compiler/rename/Rename.lhs b/ghc/compiler/rename/Rename.lhs
index df72d31..9d340f2 100644 (file)
--- 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