X-Git-Url: http://git.megacz.com/?p=ghc-hetmet.git;a=blobdiff_plain;f=compiler%2Frename%2FRnNames.lhs;h=06cddd20008ce1a525188af621ed3a4005486f73;hp=d61133b2b63fa73827629b79bb49fc6b4632bff4;hb=d0c6c8b3979e6bd11edba434ccbc61105dcd2537;hpb=b709009c523c281824005e6c0158a8e136d73931

diff --git a/compiler/rename/RnNames.lhs b/compiler/rename/RnNames.lhs
index d61133b..06cddd2 100644
--- a/compiler/rename/RnNames.lhs
+++ b/compiler/rename/RnNames.lhs
@@ -30,28 +30,12 @@ import Module
 import Name
 import NameEnv
 import NameSet
-import OccName		( srcDataName, pprNonVarNameSpace,
-			  occNameSpace,
-			  OccEnv, mkOccEnv, mkOccEnv_C, lookupOccEnv,
-			  emptyOccEnv, extendOccEnv )
-import HscTypes		( GenAvailInfo(..), AvailInfo, availNames, availName,
-			  HomePackageTable, PackageIfaceTable, 
-			  mkPrintUnqualified, availsToNameSet,
-			  Deprecs(..), ModIface(..), Dependencies(..), 
-			  lookupIfaceByModule, ExternalPackageState(..)
-			)
-import RdrName		( RdrName, rdrNameOcc, setRdrNameSpace, Parent(..),
-		  	  GlobalRdrEnv, mkGlobalRdrEnv, GlobalRdrElt(..), 
-			  emptyGlobalRdrEnv, plusGlobalRdrEnv, globalRdrEnvElts,
-			  extendGlobalRdrEnv, lookupGlobalRdrEnv,
-			  lookupGRE_RdrName, lookupGRE_Name, 
-			  Provenance(..), ImportSpec(..), ImpDeclSpec(..), ImpItemSpec(..), 
-			  importSpecLoc, importSpecModule, isLocalGRE, pprNameProvenance,
-			  unQualSpecOK, qualSpecOK )
+import OccName
+import HscTypes
+import RdrName
 import Outputable
 import Maybes
-import SrcLoc		( Located(..), mkGeneralSrcSpan, getLoc,
-			  unLoc, noLoc, srcLocSpan, SrcSpan )
+import SrcLoc
 import FiniteMap
 import ErrUtils
 import BasicTypes	( DeprecTxt )
@@ -81,29 +65,16 @@ rnImports imports
          -- warning for {- SOURCE -} ones that are unnecessary
     = do this_mod <- getModule
          implicit_prelude <- doptM Opt_ImplicitPrelude
-         let all_imports	       = mk_prel_imports this_mod implicit_prelude ++ imports
-             (source, ordinary) = partition is_source_import all_imports
+         let prel_imports	= mkPrelImports this_mod implicit_prelude imports
+             (source, ordinary) = partition is_source_import imports
              is_source_import (L _ (ImportDecl _ is_boot _ _ _)) = is_boot
 
-         stuff1 <- mapM (rnImportDecl this_mod) ordinary
+         stuff1 <- mapM (rnImportDecl this_mod) (prel_imports ++ ordinary)
          stuff2 <- mapM (rnImportDecl this_mod) source
          let (decls, rdr_env, imp_avails) = combine (stuff1 ++ stuff2)
          return (decls, rdr_env, imp_avails) 
 
     where
--- NB: opt_NoImplicitPrelude is slightly different to import Prelude ();
--- because the former doesn't even look at Prelude.hi for instance 
--- declarations, whereas the latter does.
-   mk_prel_imports this_mod implicit_prelude
-       |  this_mod == pRELUDE
-          || explicit_prelude_import
-          || not implicit_prelude
-           = []
-       | otherwise = [preludeImportDecl]
-   explicit_prelude_import
-       = notNull [ () | L _ (ImportDecl mod _ _ _ _) <- imports, 
-	           unLoc mod == pRELUDE_NAME ]
-
    combine :: [(LImportDecl Name,  GlobalRdrEnv, ImportAvails)]
            -> ([LImportDecl Name], GlobalRdrEnv, ImportAvails)
    combine = foldr plus ([], emptyGlobalRdrEnv, emptyImportAvails)
@@ -113,18 +84,34 @@ rnImports imports
                    gbl_env1 `plusGlobalRdrEnv` gbl_env2,
                    imp_avails1 `plusImportAvails` imp_avails2)
 
-preludeImportDecl :: LImportDecl RdrName
-preludeImportDecl
-  = L loc $
-	ImportDecl (L loc pRELUDE_NAME)
+mkPrelImports :: Module -> Bool -> [LImportDecl RdrName] -> [LImportDecl RdrName]
+-- Consruct the implicit declaration "import Prelude" (or not)
+--
+-- NB: opt_NoImplicitPrelude is slightly different to import Prelude ();
+-- because the former doesn't even look at Prelude.hi for instance 
+-- declarations, whereas the latter does.
+mkPrelImports this_mod implicit_prelude import_decls
+  | this_mod == pRELUDE
+   || explicit_prelude_import
+   || not implicit_prelude
+  = []
+  | otherwise = [preludeImportDecl]
+  where
+      explicit_prelude_import
+       = notNull [ () | L _ (ImportDecl mod _ _ _ _) <- import_decls, 
+	           unLoc mod == pRELUDE_NAME ]
+
+      preludeImportDecl :: LImportDecl RdrName
+      preludeImportDecl
+        = L loc $
+	  ImportDecl (L loc pRELUDE_NAME)
 	       False {- Not a boot interface -}
 	       False	{- Not qualified -}
 	       Nothing	{- No "as" -}
 	       Nothing	{- No import list -}
-  where
-    loc = mkGeneralSrcSpan FSLIT("Implicit import declaration")         
 
-	
+      loc = mkGeneralSrcSpan FSLIT("Implicit import declaration")         
+
 
 rnImportDecl  :: Module
 	      -> LImportDecl RdrName
@@ -812,14 +799,13 @@ exports_from_avail (Just rdr_items) rdr_env imports this_mod
              return (IEVar (gre_name gre), greAvail gre)
 
     lookup_ie (IEThingAbs rdr) 
-        = do name <- lookupGlobalOccRn rdr
-	     case lookupGRE_RdrName rdr rdr_env of
-	       []    -> panic "RnNames.lookup_ie"
-	       elt:_ -> case gre_par elt of
-			  NoParent   -> return (IEThingAbs name, 
-						AvailTC name [name])
-			  ParentIs p -> return (IEThingAbs name, 
-						AvailTC p [name])
+        = do gre <- lookupGreRn rdr
+	     let name = gre_name gre
+	     case gre_par gre of
+		NoParent   -> return (IEThingAbs name, 
+				      AvailTC name [name])
+		ParentIs p -> return (IEThingAbs name, 
+				      AvailTC p [name])
 
     lookup_ie ie@(IEThingAll rdr) 
         = do name <- lookupGlobalOccRn rdr
@@ -932,7 +918,7 @@ reportDeprecations dflags tcg_env
 
     check hpt pit gre@(GRE {gre_name = name, gre_prov = Imported (imp_spec:_)})
       | name `elemNameSet` used_names
-      ,	Just deprec_txt <- lookupDeprec dflags hpt pit gre
+      ,	Just deprec_txt <- lookupImpDeprec dflags hpt pit gre
       = addWarnAt (importSpecLoc imp_spec)
 		  (sep [ptext SLIT("Deprecated use of") <+> 
 			pprNonVarNameSpace (occNameSpace (nameOccName name)) <+> 
@@ -954,9 +940,10 @@ reportDeprecations dflags tcg_env
 	    -- the defn of a non-deprecated thing, when changing a module's 
 	    -- interface
 
-lookupDeprec :: DynFlags -> HomePackageTable -> PackageIfaceTable 
-	     -> GlobalRdrElt -> Maybe DeprecTxt
-lookupDeprec dflags hpt pit gre
+lookupImpDeprec :: DynFlags -> HomePackageTable -> PackageIfaceTable 
+	        -> GlobalRdrElt -> Maybe DeprecTxt
+-- The name is definitely imported, so look in HPT, PIT
+lookupImpDeprec dflags hpt pit gre
   = case lookupIfaceByModule dflags hpt pit (nameModule name) of
 	Just iface -> mi_dep_fn iface name `seqMaybe` 	-- Bleat if the thing, *or
 		      case gre_par gre of