[project @ 2000-08-18 06:34:26 by qrczak]
[ghc-hetmet.git] / ghc / compiler / rename / Rename.lhs
index f2f8614..df72d31 100644 (file)
@@ -29,7 +29,7 @@ import RnIfaces               ( getImportedInstDecls, importDecl, mkImportExportInfo, getInte
 import RnEnv           ( availName, availsToNameSet, 
                          emptyAvailEnv, unitAvailEnv, availEnvElts, plusAvailEnv, 
                          warnUnusedImports, warnUnusedLocalBinds, warnUnusedModules,
-                         lookupImplicitOccsRn, unknownNameErr,
+                         lookupOrigNames, unknownNameErr,
                          FreeVars, plusFVs, plusFV, unitFV, emptyFVs, isEmptyFVs, addOneFV
                        )
 import Module           ( Module, ModuleName, WhereFrom(..),
@@ -49,7 +49,7 @@ import NameSet
 import TysWiredIn      ( unitTyCon, intTyCon, doubleTyCon, boolTyCon )
 import PrelRules       ( builtinRules )
 import PrelInfo                ( mAIN_Name, pREL_MAIN_Name, pRELUDE_Name,
-                         ioTyCon_RDR, unpackCString_RDR, unpackCString2_RDR, unpackCStringFoldr_RDR,
+                         ioTyCon_RDR, unpackCString_RDR, unpackCStringFoldr_RDR, unpackCStringUtf8_RDR,
                          fractionalClassKeys, derivingOccurrences 
                        )
 import Type            ( namesOfType, funTyCon )
@@ -76,14 +76,16 @@ type RenameResult = ( Module                -- This module
                    , ParsedIface       -- The new interface
                    , RnNameSupply      -- Final env; for renaming derivings
                    , FixityEnv         -- The fixity environment; for derivings
-                   , [ModuleName])     -- Imported modules; for profiling
+                   , [Module])         -- Imported modules
                   
 renameModule :: UniqSupply -> RdrNameHsModule -> IO (Maybe RenameResult)
 renameModule us 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 mod_name us (mkSearchPath opt_HiMap) loc (rename this_mod) ;
+          <- initRn (mkThisModule mod_name) us 
+                    (mkSearchPath opt_HiMap) loc
+                    (rename this_mod) ;
 
        -- Check for warnings
        printErrorsAndWarnings rn_errs_bag rn_warns_bag ;
@@ -155,10 +157,20 @@ rename this_mod@(HsModule mod_name vers exports imports local_decls mod_deprec l
     mkImportExportInfo mod_name export_avails exports  `thenRn` \ (my_exports, my_usages) ->
 
        -- RETURN THE RENAMED MODULE
-    getNameSupplyRn                            `thenRn` \ name_supply ->
+    getNameSupplyRn                    `thenRn` \ name_supply ->
+    getIfacesRn                        `thenRn` \ ifaces ->
     let
+       direct_import_mods :: [Module]
+       direct_import_mods = [m | (_, _, Just (m, _, _, _, imp, _))
+                                 <- eltsFM (iImpModInfo ifaces), user_import imp]
+
+               -- *don't* just pick the forward edges.  It's entirely possible
+               -- that a module is only reachable via back edges.
+       user_import ImportByUser = True
+       user_import ImportByUserSource = True
+       user_import _ = False
+
        this_module        = mkThisModule mod_name
-       direct_import_mods = [mod | ImportDecl mod _ _ _ _ _ <- imports]
 
        -- Export only those fixities that are for names that are
        --      (a) defined in this module
@@ -210,7 +222,7 @@ mentioned explicitly, but which might be needed by the type checker.
 
 \begin{code}
 implicitFVs mod_name decls
-  = lookupImplicitOccsRn implicit_occs         `thenRn` \ implicit_names ->
+  = lookupOrigNames implicit_occs                      `thenRn` \ implicit_names ->
     returnRn (mkNameSet (map getName default_tycons)   `plusFV`
              implicit_names)
   where
@@ -235,7 +247,7 @@ 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, unpackCString2_RDR, unpackCStringFoldr_RDR]
+    string_occs = [unpackCString_RDR, unpackCStringFoldr_RDR, unpackCStringUtf8_RDR]
 
     get (TyClD (TyData _ _ _ _ _ _ (Just deriv_classes) _ _))
        = concat (map get_deriv deriv_classes)
@@ -494,7 +506,7 @@ getGates source_fvs (TyClD (ClassDecl ctxt cls tvs _ sigs _ _ _ _ _ _ _))
      `addOneToNameSet` cls)
     `plusFV` maybe_double
   where
-    get (ClassOpSig n _ _ ty _) 
+    get (ClassOpSig n _ ty _) 
        | n `elemNameSet` source_fvs = extractHsTyNames ty
        | otherwise                  = emptyFVs
 
@@ -655,7 +667,7 @@ rnDeprecs gbl_env mod_deprec decls
 %*********************************************************
 
 \begin{code}
-reportUnusedNames :: ModuleName -> [ModuleName] 
+reportUnusedNames :: ModuleName -> [Module] 
                  -> GlobalRdrEnv -> AvailEnv
                  -> Avails -> NameSet -> [RenamedHsDecl] 
                  -> RnMG ()
@@ -724,19 +736,19 @@ reportUnusedNames mod_name direct_import_mods
        --       import This.  Sigh. 
        --       There's really no good way to detect this, so the error message 
        --       in RnEnv.warnUnusedModules is weakened instead
-       inst_mods = [m | InstD (InstDecl _ _ _ dfun _) <- imported_decls,
-                        let m = moduleName (nameModule dfun),
+       inst_mods = [m | InstD (InstDecl _ _ _ (Just dfun) _) <- imported_decls,
+                        let m = nameModule dfun,
                         m `elem` direct_import_mods
                    ]
 
-       minimal_imports :: FiniteMap ModuleName AvailEnv
+       minimal_imports :: FiniteMap Module AvailEnv
        minimal_imports0 = emptyFM
        minimal_imports1 = foldNameSet add_name minimal_imports0 really_used_names
        minimal_imports  = foldr   add_inst_mod minimal_imports1 inst_mods
        
        add_name n acc = case maybeUserImportedFrom n of
                           Nothing -> acc
-                          Just m  -> addToFM_C plusAvailEnv acc (moduleName m)
+                          Just m  -> addToFM_C plusAvailEnv acc m
                                                (unitAvailEnv (mk_avail n))
        add_inst_mod m acc 
          | m `elemFM` acc = acc        -- We import something already
@@ -752,13 +764,14 @@ reportUnusedNames mod_name direct_import_mods
 
        -- unused_imp_mods are the directly-imported modules 
        -- that are not mentioned in minimal_imports
-       unused_imp_mods = [m | m <- direct_import_mods, 
-                               not (maybeToBool (lookupFM minimal_imports m))]
+       unused_imp_mods = [m | m <- direct_import_mods,
+                              not (maybeToBool (lookupFM minimal_imports m)),
+                              moduleName m /= pRELUDE_Name]
 
        module_unused :: Name -> Bool
        -- Name is imported from a module that's completely unused,
        -- so don't report stuff about the name (the module covers it)
-       module_unused n = moduleName (expectJust "module_unused" (maybeUserImportedFrom n))
+       module_unused n = expectJust "module_unused" (maybeUserImportedFrom n)
                          `elem` unused_imp_mods
                                -- module_unused is only called if it's user-imported
     in
@@ -791,7 +804,7 @@ printMinimalImports mod_name imps
                            parens (fsep (punctuate comma (map ppr ies)))
 
     to_ies (mod, avail_env) = mapRn to_ie (availEnvElts avail_env)     `thenRn` \ ies ->
-                             returnRn (mod, ies)
+                             returnRn (moduleName mod, ies)
 
     to_ie :: AvailInfo -> RnMG (IE Name)
     to_ie (Avail n)       = returnRn (IEVar n)