Generalise Package Support

This patch pushes through one fundamental change: a module is now
identified by the pair of its package and module name, whereas
previously it was identified by its module name alone.  This means
that now a program can contain multiple modules with the same name, as
long as they belong to different packages.

This is a language change - the Haskell report says nothing about
packages, but it is now necessary to understand packages in order to
understand GHC's module system.  For example, a type T from module M
in package P is different from a type T from module M in package Q.
Previously this wasn't an issue because there could only be a single
module M in the program.

The "module restriction" on combining packages has therefore been
lifted, and a program can contain multiple versions of the same
package.

Note that none of the proposed syntax changes have yet been
implemented, but the architecture is geared towards supporting import
declarations qualified by package name, and that is probably the next
step.

It is now necessary to specify the package name when compiling a
package, using the -package-name flag (which has been un-deprecated).
Fortunately Cabal still uses -package-name.

Certain packages are "wired in".  Currently the wired-in packages are:
base, haskell98, template-haskell and rts, and are always referred to
by these versionless names.  Other packages are referred to with full
package IDs (eg. "network-1.0").  This is because the compiler needs
to refer to entities in the wired-in packages, and we didn't want to
bake the version of these packages into the comiler.  It's conceivable
that someone might want to upgrade the base package independently of
GHC.

Internal changes:

  - There are two module-related types:

        ModuleName      just a FastString, the name of a module
        Module          a pair of a PackageId and ModuleName

    A mapping from ModuleName can be a UniqFM, but a mapping from Module
    must be a FiniteMap (we provide it as ModuleEnv).

  - The "HomeModules" type that was passed around the compiler is now
    gone, replaced in most cases by the current package name which is
    contained in DynFlags.  We can tell whether a Module comes from the
    current package by comparing its package name against the current
    package.

  - While I was here, I changed PrintUnqual to be a little more useful:
    it now returns the ModuleName that the identifier should be qualified
    with according to the current scope, rather than its original
    module.  Also, PrintUnqual tells whether to qualify module names with
    package names (currently unused).

Docs to follow.

3 files changed, 66 insertions, 63 deletions

diff --git a/compiler/rename/RnEnv.lhs b/compiler/rename/RnEnv.lhs
index 2be3bfd5c0..1c5a559ee8 100644
--- a/compiler/rename/RnEnv.lhs
+++ b/compiler/rename/RnEnv.lhs
@@ -30,13 +30,14 @@ module RnEnv (
 
 #include "HsVersions.h"
 
-import LoadIface	( loadHomeInterface, loadSrcInterface )
+import LoadIface	( loadInterfaceForName, loadSrcInterface )
 import IfaceEnv		( lookupOrig, newGlobalBinder, newIPName )
 import HsSyn		( FixitySig(..), HsExpr(..), SyntaxExpr, SyntaxTable,
 			  LHsTyVarBndr, LHsType, 
 			  Fixity, hsLTyVarLocNames, replaceTyVarName )
 import RdrHsSyn		( extractHsTyRdrTyVars )
-import RdrName		( RdrName, rdrNameModule, isQual, isUnqual, isOrig,
+import RdrName		( RdrName, isQual, isUnqual, isOrig_maybe,
+			  isQual_maybe,
 			  mkRdrUnqual, setRdrNameSpace, rdrNameOcc,
 			  pprGlobalRdrEnv, lookupGRE_RdrName, 
 			  isExact_maybe, isSrcRdrName,
@@ -52,7 +53,7 @@ import Name		( Name, nameIsLocalOrFrom, mkInternalName, isWiredInName,
 import NameSet
 import OccName		( tcName, isDataOcc, pprNonVarNameSpace, occNameSpace,
 			  reportIfUnused )
-import Module		( Module )
+import Module		( Module, ModuleName )
 import PrelNames	( mkUnboundName, rOOT_MAIN, iNTERACTIVE, consDataConKey, hasKey )
 import UniqSupply
 import BasicTypes	( IPName, mapIPName )
@@ -91,7 +92,7 @@ newTopSrcBinder this_mod mb_parent (L loc rdr_name)
 	returnM name
 
 
-  | isOrig rdr_name
+  | Just (rdr_mod, rdr_occ) <- isOrig_maybe rdr_name
   = do	checkErr (rdr_mod == this_mod || rdr_mod == rOOT_MAIN)
 	         (badOrigBinding rdr_name)
 	-- When reading External Core we get Orig names as binders, 
@@ -111,13 +112,11 @@ newTopSrcBinder this_mod mb_parent (L loc rdr_name)
 	-- the RdrName, not from the environment.  In principle, it'd be fine to 
 	-- have an arbitrary mixture of external core definitions in a single module,
 	-- (apart from module-initialisation issues, perhaps).
-	newGlobalBinder rdr_mod (rdrNameOcc rdr_name) mb_parent 
+	newGlobalBinder rdr_mod rdr_occ mb_parent 
 	    	        (srcSpanStart loc) --TODO, should pass the whole span
 
   | otherwise
   = newGlobalBinder this_mod (rdrNameOcc rdr_name) mb_parent (srcSpanStart loc)
-  where
-    rdr_mod  = rdrNameModule rdr_name
 \end{code}
 
 %*********************************************************
@@ -164,13 +163,12 @@ lookupTopBndrRn rdr_name
   | Just name <- isExact_maybe rdr_name
   = returnM name
 
-  | isOrig rdr_name	
+  | Just (rdr_mod, rdr_occ) <- isOrig_maybe rdr_name	
 	-- This deals with the case of derived bindings, where
 	-- we don't bother to call newTopSrcBinder first
 	-- We assume there is no "parent" name
   = do	{ loc <- getSrcSpanM
-	; newGlobalBinder (rdrNameModule rdr_name)
-		          (rdrNameOcc rdr_name) Nothing (srcSpanStart loc) }
+	; newGlobalBinder rdr_mod rdr_occ Nothing (srcSpanStart loc) }
 
   | otherwise
   = do	{ mb_gre <- lookupGreLocalRn rdr_name
@@ -278,9 +276,12 @@ lookupImportedName rdr_name
 	-- This happens in derived code
   = returnM n
 
-  | otherwise	-- Always Orig, even when reading a .hi-boot file
-  = ASSERT( not (isUnqual rdr_name) )
-    lookupOrig (rdrNameModule rdr_name) (rdrNameOcc rdr_name)
+	-- Always Orig, even when reading a .hi-boot file
+  | Just (rdr_mod, rdr_occ) <- isOrig_maybe rdr_name
+  = lookupOrig rdr_mod rdr_occ
+
+  | otherwise
+  = pprPanic "RnEnv.lookupImportedName" (ppr rdr_name)
 
 unboundName :: RdrName -> RnM Name
 unboundName rdr_name 
@@ -337,13 +338,10 @@ lookupGreRn_help rdr_name lookup
 -- try to load the interface if we don't already have it.
 lookupQualifiedName :: RdrName -> RnM Name
 lookupQualifiedName rdr_name
- = let 
-       mod = rdrNameModule rdr_name
-       occ = rdrNameOcc rdr_name
-   in
+  | Just (mod,occ) <- isQual_maybe rdr_name
    -- Note: we want to behave as we would for a source file import here,
    -- and respect hiddenness of modules/packages, hence loadSrcInterface.
-   loadSrcInterface doc mod False	`thenM` \ iface ->
+   = loadSrcInterface doc mod False	`thenM` \ iface ->
 
    case  [ (mod,occ) | 
 	   (mod,avails) <- mi_exports iface,
@@ -353,6 +351,9 @@ lookupQualifiedName rdr_name
       ((mod,occ):ns) -> ASSERT (null ns) 
 			lookupOrig mod occ
       _ -> unboundName rdr_name
+
+  | otherwise
+  = pprPanic "RnEnv.lookupQualifiedName" (ppr rdr_name)
   where
     doc = ptext SLIT("Need to find") <+> ppr rdr_name
 \end{code}
@@ -421,7 +422,7 @@ lookupFixityRn name
 
     else	-- It's imported
       -- For imported names, we have to get their fixities by doing a
-      -- loadHomeInterface, and consulting the Ifaces that comes back
+      -- loadInterfaceForName, and consulting the Ifaces that comes back
       -- from that, because the interface file for the Name might not
       -- have been loaded yet.  Why not?  Suppose you import module A,
       -- which exports a function 'f', thus;
@@ -434,9 +435,9 @@ lookupFixityRn name
       -- 'f', we need to know its fixity, and it's then, and only
       -- then, that we load B.hi.  That is what's happening here.
       --
-      -- loadHomeInterface will find B.hi even if B is a hidden module,
+      -- loadInterfaceForName will find B.hi even if B is a hidden module,
       -- and that's what we want.
-        loadHomeInterface doc name	`thenM` \ iface ->
+        loadInterfaceForName doc name	`thenM` \ iface ->
 	returnM (mi_fix_fn iface (nameOccName name))
   where
     doc = ptext SLIT("Checking fixity for") <+> ppr name
@@ -705,7 +706,7 @@ mapFvRn f xs = mappM f xs	`thenM` \ stuff ->
 %************************************************************************
 
 \begin{code}
-warnUnusedModules :: [(Module,SrcSpan)] -> RnM ()
+warnUnusedModules :: [(ModuleName,SrcSpan)] -> RnM ()
 warnUnusedModules mods
   = ifOptM Opt_WarnUnusedImports (mappM_ bleat mods)
   where
diff --git a/compiler/rename/RnExpr.lhs b/compiler/rename/RnExpr.lhs
index 87af074190..e968590812 100644
--- a/compiler/rename/RnExpr.lhs
+++ b/compiler/rename/RnExpr.lhs
@@ -44,7 +44,7 @@ import Name             ( isTyVarName )
 import Name		( Name, nameOccName, nameIsLocalOrFrom )
 import NameSet
 import RdrName		( RdrName, emptyGlobalRdrEnv, extendLocalRdrEnv, lookupLocalRdrEnv )
-import LoadIface	( loadHomeInterface )
+import LoadIface	( loadInterfaceForName )
 import UniqFM		( isNullUFM )
 import UniqSet		( emptyUniqSet )
 import List		( nub )
@@ -550,7 +550,7 @@ rnRbinds str rbinds
 rnBracket (VarBr n) = do { name <- lookupOccRn n
 			 ; this_mod <- getModule
 			 ; checkM (nameIsLocalOrFrom this_mod name) $	-- Reason: deprecation checking asumes the
-			   do { loadHomeInterface msg name		-- home interface is loaded, and this is the
+			   do { loadInterfaceForName msg name		-- home interface is loaded, and this is the
 			      ; return () }				-- only way that is going to happen
 			 ; returnM (VarBr name, unitFV name) }
 		    where
diff --git a/compiler/rename/RnNames.lhs b/compiler/rename/RnNames.lhs
index 658028c3f3..71d5c9b350 100644
--- a/compiler/rename/RnNames.lhs
+++ b/compiler/rename/RnNames.lhs
@@ -13,7 +13,7 @@ module RnNames (
 
 #include "HsVersions.h"
 
-import DynFlags		( DynFlag(..), GhcMode(..) )
+import DynFlags		( DynFlag(..), GhcMode(..), DynFlags(..) )
 import HsSyn		( IE(..), ieName, ImportDecl(..), LImportDecl,
 			  ForeignDecl(..), HsGroup(..), HsValBinds(..),
 			  Sig(..), collectHsBindLocatedBinders, tyClDeclNames,
@@ -24,9 +24,8 @@ import LoadIface	( loadSrcInterface )
 import TcRnMonad hiding (LIE)
 
 import FiniteMap
-import PrelNames	( pRELUDE, isUnboundName, main_RDR_Unqual )
-import Module		( Module, moduleString, unitModuleEnv, 
-			  lookupModuleEnv, moduleEnvElts, foldModuleEnv )
+import PrelNames
+import Module
 import Name		( Name, nameSrcLoc, nameOccName, nameModule, isWiredInName,
 			  nameParent, nameParent_maybe, isExternalName,
 			  isBuiltInSyntax )
@@ -38,11 +37,10 @@ import OccName		( srcDataName, isTcOcc, pprNonVarNameSpace,
 			  extendOccEnv )
 import HscTypes		( GenAvailInfo(..), AvailInfo,
 			  HomePackageTable, PackageIfaceTable, 
-			  unQualInScope, 
+			  mkPrintUnqualified,
 			  Deprecs(..), ModIface(..), Dependencies(..), 
-			  lookupIface, ExternalPackageState(..)
+			  lookupIfaceByModule, ExternalPackageState(..)
 			)
-import Packages		( PackageIdH(..) )
 import RdrName		( RdrName, rdrNameOcc, setRdrNameSpace, 
 		  	  GlobalRdrEnv, mkGlobalRdrEnv, GlobalRdrElt(..), 
 			  emptyGlobalRdrEnv, plusGlobalRdrEnv, globalRdrEnvElts,
@@ -50,6 +48,7 @@ import RdrName		( RdrName, rdrNameOcc, setRdrNameSpace,
 			  Provenance(..), ImportSpec(..), ImpDeclSpec(..), ImpItemSpec(..), 
 			  importSpecLoc, importSpecModule, isLocalGRE, pprNameProvenance )
 import Outputable
+import UniqFM
 import Maybes		( isNothing, catMaybes, mapCatMaybes, seqMaybe, orElse )
 import SrcLoc		( Located(..), mkGeneralSrcSpan,
 			  unLoc, noLoc, srcLocSpan, SrcSpan )
@@ -96,12 +95,12 @@ rnImports imports
        | otherwise = [preludeImportDecl]
    explicit_prelude_import
        = notNull [ () | L _ (ImportDecl mod _ _ _ _) <- imports, 
-	           unLoc mod == pRELUDE ]
+	           unLoc mod == pRELUDE_NAME ]
 
 preludeImportDecl :: LImportDecl RdrName
 preludeImportDecl
   = L loc $
-	ImportDecl (L loc pRELUDE)
+	ImportDecl (L loc pRELUDE_NAME)
 	       False {- Not a boot interface -}
 	       False	{- Not qualified -}
 	       Nothing	{- No "as" -}
@@ -271,13 +270,14 @@ importsFromImportDecl this_mod
     let
 	-- Compute new transitive dependencies
 
- 	orphans | is_orph   = ASSERT( not (imp_mod_name `elem` dep_orphs deps) )
-			      imp_mod_name : dep_orphs deps
+ 	orphans | is_orph   = ASSERT( not (imp_mod `elem` dep_orphs deps) )
+			      imp_mod : dep_orphs deps
 		| otherwise = dep_orphs deps
 
+	pkg = modulePackageId (mi_module iface)
+
 	(dependent_mods, dependent_pkgs) 
-	   = case mi_package iface of
-		HomePackage ->
+	   | pkg == thisPackage dflags =
 	    	-- Imported module is from the home package
 		-- Take its dependent modules and add imp_mod itself
 		-- Take its dependent packages unchanged
@@ -291,7 +291,7 @@ importsFromImportDecl this_mod
 		-- check.  See LoadIface.loadHiBootInterface
 		  ((imp_mod_name, want_boot) : dep_mods deps, dep_pkgs deps)
 
-		ExtPackage pkg ->
+	   | otherwise =
  	   	-- Imported module is from another package
 		-- Dump the dependent modules
 		-- Add the package imp_mod comes from to the dependent packages
@@ -308,7 +308,7 @@ importsFromImportDecl this_mod
 	--	module M ( module P ) where ...
 	-- Then we must export whatever came from P unqualified.
 	imports   = ImportAvails { 
-			imp_env      = unitModuleEnv qual_mod_name avail_env,
+			imp_env      = unitUFM qual_mod_name avail_env,
 			imp_mods     = unitModuleEnv imp_mod (imp_mod, import_all, loc),
 			imp_orphs    = orphans,
 			imp_dep_mods = mkModDeps dependent_mods,
@@ -376,7 +376,7 @@ importsFromLocalDecls group
 
 	    ; this_mod = tcg_mod gbl_env
 	    ; imports = emptyImportAvails {
-			  imp_env = unitModuleEnv this_mod $
+			  imp_env = unitUFM (moduleName this_mod) $
 				    mkNameSet filtered_names
 		        }
 	    }
@@ -544,7 +544,7 @@ it re-exports @GHC@, which includes @takeMVar#@, whose type includes
 \begin{code}
 type ExportAccum	-- The type of the accumulating parameter of
 			-- the main worker function in rnExports
-     = ([Module], 		-- 'module M's seen so far
+     = ([ModuleName], 		-- 'module M's seen so far
 	ExportOccMap,		-- Tracks exported occurrence names
 	NameSet)		-- The accumulated exported stuff
 emptyExportAccum = ([], emptyOccEnv, emptyNameSet) 
@@ -561,7 +561,7 @@ rnExports Nothing = return Nothing
 rnExports (Just exports)
     = do TcGblEnv { tcg_imports = ImportAvails { imp_env = imp_env } } <- getGblEnv
          let sub_env :: NameEnv [Name]	-- Classify each name by its parent
-             sub_env = mkSubNameEnv (foldModuleEnv unionNameSets emptyNameSet imp_env)
+             sub_env = mkSubNameEnv (foldUFM unionNameSets emptyNameSet imp_env)
              rnExport (IEVar rdrName)
                  = do name <- lookupGlobalOccRn rdrName
                       return (IEVar name)
@@ -631,7 +631,7 @@ exports_from_avail (Just (items,origItems)) rdr_env (ImportAvails { imp_env = im
        return exports
   where
     sub_env :: NameEnv [Name]	-- Classify each name by its parent
-    sub_env = mkSubNameEnv (foldModuleEnv unionNameSets emptyNameSet imp_env)
+    sub_env = mkSubNameEnv (foldUFM unionNameSets emptyNameSet imp_env)
 
     do_litem :: ExportAccum -> (LIE Name, LIE RdrName) -> RnM ExportAccum
     do_litem acc (ieName, ieRdr)
@@ -645,7 +645,7 @@ exports_from_avail (Just (items,origItems)) rdr_env (ImportAvails { imp_env = im
 	       returnM acc }
 
 	| otherwise
-	= case lookupModuleEnv imp_env mod of
+	= case lookupUFM imp_env mod of
             Nothing -> do addErr (modExportErr mod)
                           return acc
             Just names
@@ -738,8 +738,8 @@ check_occs ie occs names
 %*********************************************************
 
 \begin{code}
-reportDeprecations :: TcGblEnv -> RnM ()
-reportDeprecations tcg_env
+reportDeprecations :: DynFlags -> TcGblEnv -> RnM ()
+reportDeprecations dflags tcg_env
   = ifOptM Opt_WarnDeprecations	$
     do	{ (eps,hpt) <- getEpsAndHpt
 		-- By this time, typechecking is complete, 
@@ -752,7 +752,7 @@ reportDeprecations tcg_env
 
     check hpt pit (GRE {gre_name = name, gre_prov = Imported (imp_spec:_)})
       | name `elemNameSet` used_names
-      ,	Just deprec_txt <- lookupDeprec hpt pit name
+      ,	Just deprec_txt <- lookupDeprec dflags hpt pit name
       = setSrcSpan (importSpecLoc imp_spec) $
 	addWarn (sep [ptext SLIT("Deprecated use of") <+> 
 			pprNonVarNameSpace (occNameSpace (nameOccName name)) <+> 
@@ -763,7 +763,7 @@ reportDeprecations tcg_env
 	  name_mod = nameModule name
 	  imp_mod  = importSpecModule imp_spec
 	  imp_msg  = ptext SLIT("imported from") <+> ppr imp_mod <> extra
-	  extra | imp_mod == name_mod = empty
+	  extra | imp_mod == moduleName name_mod = empty
 		| otherwise = ptext SLIT(", but defined in") <+> ppr name_mod
 
     check hpt pit ok_gre = returnM ()	-- Local, or not used, or not deprectated
@@ -774,10 +774,10 @@ reportDeprecations tcg_env
 	    -- the defn of a non-deprecated thing, when changing a module's 
 	    -- interface
 
-lookupDeprec :: HomePackageTable -> PackageIfaceTable 
+lookupDeprec :: DynFlags -> HomePackageTable -> PackageIfaceTable 
 	     -> Name -> Maybe DeprecTxt
-lookupDeprec hpt pit n 
-  = case lookupIface hpt pit (nameModule n) of
+lookupDeprec dflags hpt pit n 
+  = case lookupIfaceByModule dflags hpt pit (nameModule n) of
 	Just iface -> mi_dep_fn iface n `seqMaybe` 	-- Bleat if the thing, *or
 		      mi_dep_fn iface (nameParent n)	-- its parent*, is deprec'd
 	Nothing    
@@ -854,7 +854,7 @@ reportUnusedNames export_decls gbl_env
     -- into a bunch of avails, so they are properly grouped
     --
     -- BUG WARNING: this does not deal properly with qualified imports!
-    minimal_imports :: FiniteMap Module AvailEnv
+    minimal_imports :: FiniteMap ModuleName AvailEnv
     minimal_imports0 = foldr add_expall   emptyFM 	   expall_mods
     minimal_imports1 = foldr add_name     minimal_imports0 defined_and_used
     minimal_imports  = foldr add_inst_mod minimal_imports1 direct_import_mods
@@ -909,9 +909,10 @@ reportUnusedNames export_decls gbl_env
 		       | otherwise		 = Avail n
     
     add_inst_mod (mod,_,_) acc 
-      | mod `elemFM` acc = acc	-- We import something already
-      | otherwise        = addToFM acc mod emptyAvailEnv
+      | mod_name `elemFM` acc = acc	-- We import something already
+      | otherwise	      = addToFM acc mod_name emptyAvailEnv
       where
+	mod_name = moduleName mod
     	-- Add an empty collection of imports for a module
     	-- from which we have sucked only instance decls
    
@@ -928,15 +929,16 @@ reportUnusedNames export_decls gbl_env
     --
     -- BUG WARNING: does not deal correctly with multiple imports of the same module
     --	 	    becuase direct_import_mods has only one entry per module
-    unused_imp_mods = [(mod,loc) | (mod,no_imp,loc) <- direct_import_mods,
-    		       not (mod `elemFM` minimal_imports1),
+    unused_imp_mods = [(mod_name,loc) | (mod,no_imp,loc) <- direct_import_mods,
+		       let mod_name = moduleName mod,
+    		       not (mod_name `elemFM` minimal_imports1),
     		       mod /= pRELUDE,
 		       not no_imp]
 	-- The not no_imp part is not to complain about
 	-- import M (), which is an idiom for importing
 	-- instance declarations
     
-    module_unused :: Module -> Bool
+    module_unused :: ModuleName -> Bool
     module_unused mod = any (((==) mod) . fst) unused_imp_mods
 
 ---------------------
@@ -1017,7 +1019,7 @@ selectiveImpItem ImpAll       = False
 selectiveImpItem (ImpSome {}) = True
 
 -- ToDo: deal with original imports with 'qualified' and 'as M' clauses
-printMinimalImports :: FiniteMap Module AvailEnv	-- Minimal imports
+printMinimalImports :: FiniteMap ModuleName AvailEnv	-- Minimal imports
 		    -> RnM ()
 printMinimalImports imps
  = ifOptM Opt_D_dump_minimal_imports $ do {
@@ -1026,13 +1028,13 @@ printMinimalImports imps
    this_mod <- getModule ;
    rdr_env  <- getGlobalRdrEnv ;
    ioToTcRn (do { h <- openFile (mkFilename this_mod) WriteMode ;
-		  printForUser h (unQualInScope rdr_env) 
+		  printForUser h (mkPrintUnqualified rdr_env) 
 				 (vcat (map ppr_mod_ie mod_ies)) })
    }
   where
-    mkFilename this_mod = moduleString this_mod ++ ".imports"
+    mkFilename this_mod = moduleNameString (moduleName this_mod) ++ ".imports"
     ppr_mod_ie (mod_name, ies) 
-	| mod_name == pRELUDE 
+	| mod_name == moduleName pRELUDE
 	= empty
 	| null ies	-- Nothing except instances comes from here
 	= ptext SLIT("import") <+> ppr mod_name <> ptext SLIT("()    -- Instances only")
@@ -1053,7 +1055,7 @@ printMinimalImports imps
     to_ie (AvailTC n ns)  
 	= loadSrcInterface doc n_mod False			`thenM` \ iface ->
 	  case [xs | (m,as) <- mi_exports iface,
-		     m == n_mod,
+		     moduleName m == n_mod,
 		     AvailTC x xs <- as, 
 		     x == nameOccName n] of
 	      [xs] | all_used xs -> returnM (IEThingAll n)
@@ -1063,7 +1065,7 @@ printMinimalImports imps
 	where
 	  all_used avail_occs = all (`elem` map nameOccName ns) avail_occs
 	  doc = text "Compute minimal imports from" <+> ppr n
-	  n_mod = nameModule n
+	  n_mod = moduleName (nameModule n)
 \end{code}