refactoring only: use the parameterised InstalledPackageInfo

This required moving PackageId from PackageConfig to Module

compiler/basicTypes/Module.hi-boot-6

 module Module where
 data Module
 data ModuleName
+data PackageId
 moduleName :: Module -> ModuleName
-modulePackageId :: Module -> PackageConfig.PackageId
-
+modulePackageId :: Module -> PackageId
+packageIdString :: PackageId -> GHC.Base.String

compiler/basicTypes/Module.lhs

@@ -9,13 +9,6 @@ These are Uniquable, hence we can build FiniteMaps with Modules as
 the keys.
 
 \begin{code}
-{-# OPTIONS -w #-}
--- The above warning supression flag is a temporary kludge.
--- While working on this module you are encouraged to remove it and fix
--- any warnings in the module. See
---     http://hackage.haskell.org/trac/ghc/wiki/Commentary/CodingStyle#Warnings
--- for details
-
 module Module 
     (
 	-- * The ModuleName type
@@ -26,6 +19,21 @@ module Module
 	mkModuleName,
 	mkModuleNameFS,
 
+        -- * The PackageId type
+        PackageId,
+        fsToPackageId,
+        packageIdFS,
+        stringToPackageId,
+        packageIdString,
+
+	-- * Wired-in PackageIds
+	basePackageId,
+	rtsPackageId,
+	haskell98PackageId,
+	thPackageId,
+        ndpPackageId,
+	mainPackageId,
+
 	-- * The Module type
 	Module,
 	modulePackageId, moduleName,
@@ -55,10 +63,10 @@ module Module
 
 #include "HsVersions.h"
 import Outputable
+import qualified Pretty
 import Unique
 import FiniteMap
 import UniqFM
-import PackageConfig
 import FastString
 import Binary
 \end{code}
@@ -188,12 +196,16 @@ instance Binary Module where
   put_ bh (Module p n) = put_ bh p >> put_ bh n
   get bh = do p <- get bh; n <- get bh; return (Module p n)
 
+instance Uniquable PackageId where
+ getUnique pid = getUnique (packageIdFS pid)
+
 mkModule :: PackageId -> ModuleName -> Module
 mkModule = Module
 
 pprModule :: Module -> SDoc
 pprModule mod@(Module p n)  = pprPackagePrefix p mod <> pprModuleName n
 
+pprPackagePrefix :: PackageId -> Module -> PprStyle -> Pretty.Doc
 pprPackagePrefix p mod = getPprStyle doc
  where
    doc sty
@@ -207,6 +219,70 @@ pprPackagePrefix p mod = getPprStyle doc
        | otherwise = empty
 \end{code}
 
+%************************************************************************
+%*                                                                      *
+\subsection{PackageId}
+%*                                                                      *
+%************************************************************************
+
+\begin{code}
+newtype PackageId = PId FastString deriving( Eq, Ord )  -- includes the version
+    -- here to avoid module loops with PackageConfig
+
+instance Outputable PackageId where
+   ppr pid = text (packageIdString pid)
+
+instance Binary PackageId where
+  put_ bh pid = put_ bh (packageIdFS pid)
+  get bh = do { fs <- get bh; return (fsToPackageId fs) }
+
+fsToPackageId :: FastString -> PackageId
+fsToPackageId = PId
+
+packageIdFS :: PackageId -> FastString
+packageIdFS (PId fs) = fs
+
+stringToPackageId :: String -> PackageId
+stringToPackageId = fsToPackageId . mkFastString
+
+packageIdString :: PackageId -> String
+packageIdString = unpackFS . packageIdFS
+
+
+-- -----------------------------------------------------------------------------
+-- Package Ids that are wired in
+
+-- Certain packages are "known" to the compiler, in that we know about certain
+-- entities that reside in these packages, and the compiler needs to 
+-- declare static Modules and Names that refer to these packages.  Hence
+-- the wired-in packages can't include version numbers, since we don't want
+-- to bake the version numbers of these packages into GHC.
+--
+-- So here's the plan.  Wired-in packages are still versioned as
+-- normal in the packages database, and you can still have multiple
+-- versions of them installed.  However, for each invocation of GHC,
+-- only a single instance of each wired-in package will be recognised
+-- (the desired one is selected via -package/-hide-package), and GHC
+-- will use the unversioned PackageId below when referring to it,
+-- including in .hi files and object file symbols.  Unselected
+-- versions of wired-in packages will be ignored, as will any other
+-- package that depends directly or indirectly on it (much as if you
+-- had used -ignore-package).
+
+basePackageId, rtsPackageId, haskell98PackageId, 
+  thPackageId, ndpPackageId, mainPackageId  :: PackageId
+basePackageId      = fsToPackageId FSLIT("base")
+rtsPackageId	   = fsToPackageId FSLIT("rts")
+haskell98PackageId = fsToPackageId FSLIT("haskell98")
+thPackageId        = fsToPackageId FSLIT("template-haskell")
+ndpPackageId       = fsToPackageId FSLIT("ndp")
+
+-- This is the package Id for the program.  It is the default package
+-- Id if you don't specify a package name.  We don't add this prefix
+-- to symbol name, since there can be only one main package per program.
+mainPackageId	   = fsToPackageId FSLIT("main")
+\end{code}
+
 %************************************************************************
 %*                                                                      *
 \subsection{@ModuleEnv@s}

compiler/basicTypes/Module.lhs-boot

 \begin{code}
 module Module where
 
-import PackageConfig (PackageId)
-
 data Module
 data ModuleName
+data PackageId
 moduleName :: Module -> ModuleName
 modulePackageId :: Module -> PackageId
+packageIdString :: PackageId -> String
 \end{code}

compiler/basicTypes/Unique.lhs

@@ -58,7 +58,6 @@ module Unique (
 #include "HsVersions.h"
 
 import BasicTypes
-import PackageConfig
 import FastString
 import Outputable
 
@@ -155,9 +154,6 @@ x `hasKey` k	= getUnique x == k
 instance Uniquable FastString where
  getUnique fs = mkUniqueGrimily (I# (uniqueOfFS fs))
 
-instance Uniquable PackageId where
- getUnique pid = getUnique (packageIdFS pid)
-
 instance Uniquable Int where
  getUnique i = mkUniqueGrimily i
 \end{code}

compiler/coreSyn/CoreUtils.lhs

@@ -55,6 +55,7 @@ import SrcLoc
 import VarSet
 import VarEnv
 import Name
+import Module
 #if mingw32_TARGET_OS
 import Packages
 #endif
@@ -70,7 +71,6 @@ import TyCon
 import TysWiredIn
 import CostCentre
 import BasicTypes
-import PackageConfig
 import Unique
 import Outputable
 import DynFlags

compiler/ghci/InteractiveUI.hs

@@ -1448,7 +1448,7 @@ getCommonPrefix (s:ss) = foldl common s ss
 
 allExposedModules :: DynFlags -> [ModuleName]
 allExposedModules dflags 
- = map GHC.mkModuleName (concat (map exposedModules (filter exposed (eltsUFM pkg_db))))
+ = concat (map exposedModules (filter exposed (eltsUFM pkg_db)))
  where
   pkg_db = pkgIdMap (pkgState dflags)
 #else

compiler/main/CodeOutput.lhs

@@ -30,7 +30,6 @@ import Finder		( mkStubPaths )
 import PprC		( writeCs )
 import CmmLint		( cmmLint )
 import Packages
-import PackageConfig	( rtsPackageId )
 import Util
 import FastString	( unpackFS )
 import Cmm		( RawCmm )
@@ -40,7 +39,7 @@ import DynFlags
 import ErrUtils		( dumpIfSet_dyn, showPass, ghcExit )
 import Outputable
 import Pretty		( Mode(..), printDoc )
-import Module		( Module, ModLocation(..), moduleName )
+import Module
 import List		( nub )
 import Maybes		( firstJust )
 

compiler/main/DynFlags.hs

@@ -61,7 +61,7 @@ module DynFlags (
 
 #include "HsVersions.h"
 
-import Module		( Module, mkModuleName, mkModule, ModLocation )
+import Module
 import PackageConfig
 import PrelNames	( mAIN )
 #ifdef i386_TARGET_ARCH
@@ -381,7 +381,7 @@ data DynFlags = DynFlags {
   -- Package state
   -- NB. do not modify this field, it is calculated by 
   -- Packages.initPackages and Packages.updatePackages.
-  pkgDatabase           :: Maybe (UniqFM InstalledPackageInfo),
+  pkgDatabase           :: Maybe (UniqFM PackageConfig),
   pkgState		:: PackageState,
 
   -- hsc dynamic flags

compiler/main/Finder.lhs

@@ -4,13 +4,6 @@
 \section[Finder]{Module Finder}
 
 \begin{code}
-{-# OPTIONS -w #-}
--- The above warning supression flag is a temporary kludge.
--- While working on this module you are encouraged to remove it and fix
--- any warnings in the module. See
---     http://hackage.haskell.org/trac/ghc/wiki/Commentary/CodingStyle#Warnings
--- for details
-
 module Finder (
     flushFinderCaches,
     FindResult(..),
@@ -530,7 +523,7 @@ findObjectLinkableMaybe mod locn
 findObjectLinkable :: Module -> FilePath -> ClockTime -> IO Linkable
 findObjectLinkable mod obj_fn obj_time = do
   let stub_fn = case splitFilename3 obj_fn of
-			(dir, base, ext) -> dir ++ "/" ++ base ++ "_stub.o"
+			(dir, base, _ext) -> dir ++ "/" ++ base ++ "_stub.o"
   stub_exist <- doesFileExist stub_fn
   if stub_exist
 	then return (LM obj_time mod [DotO obj_fn, DotO stub_fn])

compiler/main/GHC.hs

@@ -244,7 +244,6 @@ import Module
 import UniqFM
 import UniqSet
 import Unique
-import PackageConfig
 import FiniteMap
 import Panic
 import Digraph

compiler/main/PackageConfig.hs

-{-# OPTIONS -w #-}
--- The above warning supression flag is a temporary kludge.
--- While working on this module you are encouraged to remove it and fix
--- any warnings in the module. See
---     http://hackage.haskell.org/trac/ghc/wiki/Commentary/CodingStyle#Warnings
--- for details
-
 --
 -- (c) The University of Glasgow, 2004
 --
 
 module PackageConfig (
 	-- * PackageId
-	PackageId, 
-	mkPackageId, stringToPackageId, packageIdString, packageConfigId,
-	packageIdFS, fsToPackageId,  unpackPackageId,
+	mkPackageId, packageConfigId, unpackPackageId,
 	
 	-- * The PackageConfig type: information about a package
 	PackageConfig,
-	InstalledPackageInfo(..), showPackageId,
+	InstalledPackageInfo_(..), showPackageId,
 	Version(..),
 	PackageIdentifier(..),
 	defaultPackageConfig,
-
-	-- * Wired-in PackageIds
-	basePackageId,
-	rtsPackageId,
-	haskell98PackageId,
-	thPackageId,
-        ndpPackageId,
-	mainPackageId
   ) where
 
 #include "HsVersions.h"
 
+import Module 
 import Distribution.InstalledPackageInfo
 import Distribution.Package
 import Distribution.Version
-import FastString
 import Distribution.Compat.ReadP ( readP_to_S )
 
+-- warning suppression
+_unused :: FS.FastString
+_unused = FSLIT("")
+
 -- -----------------------------------------------------------------------------
 -- Our PackageConfig type is just InstalledPackageInfo from Cabal.  Later we
 -- might need to extend it with some GHC-specific stuff, but for now it's fine.
 
-type PackageConfig = InstalledPackageInfo
+type PackageConfig = InstalledPackageInfo_ ModuleName
+defaultPackageConfig :: PackageConfig
 defaultPackageConfig = emptyInstalledPackageInfo
 
 -- -----------------------------------------------------------------------------
@@ -60,22 +48,6 @@ defaultPackageConfig = emptyInstalledPackageInfo
 --
 -- A PackageId is a string of the form <pkg>-<version>.
 
-newtype PackageId = PId FastString deriving( Eq, Ord )  -- includes the version
-	-- easier not to use a newtype here, because we need instances of
-	-- Binary & Outputable, and we're too early to define them
-
-fsToPackageId :: FastString -> PackageId
-fsToPackageId = PId
-
-packageIdFS :: PackageId -> FastString
-packageIdFS (PId fs) = fs
-
-stringToPackageId :: String -> PackageId
-stringToPackageId = fsToPackageId . mkFastString
-
-packageIdString :: PackageId -> String
-packageIdString = unpackFS . packageIdFS
-
 mkPackageId :: PackageIdentifier -> PackageId
 mkPackageId = stringToPackageId . showPackageId
 
@@ -88,35 +60,3 @@ unpackPackageId p
         []      -> Nothing
         (pid:_) -> Just pid
   where str = packageIdString p
-
--- -----------------------------------------------------------------------------
--- Package Ids that are wired in
-
--- Certain packages are "known" to the compiler, in that we know about certain
--- entities that reside in these packages, and the compiler needs to 
--- declare static Modules and Names that refer to these packages.  Hence
--- the wired-in packages can't include version numbers, since we don't want
--- to bake the version numbers of these packages into GHC.
---
--- So here's the plan.  Wired-in packages are still versioned as
--- normal in the packages database, and you can still have multiple
--- versions of them installed.  However, for each invocation of GHC,
--- only a single instance of each wired-in package will be recognised
--- (the desired one is selected via -package/-hide-package), and GHC
--- will use the unversioned PackageId below when referring to it,
--- including in .hi files and object file symbols.  Unselected
--- versions of wired-in packages will be ignored, as will any other
--- package that depends directly or indirectly on it (much as if you
--- had used -ignore-package).
-
-basePackageId      = fsToPackageId FSLIT("base")
-rtsPackageId	   = fsToPackageId FSLIT("rts")
-haskell98PackageId = fsToPackageId FSLIT("haskell98")
-thPackageId        = fsToPackageId FSLIT("template-haskell")
-ndpPackageId       = fsToPackageId FSLIT("ndp")
-
--- This is the package Id for the program.  It is the default package
--- Id if you don't specify a package name.  We don't add this prefix
--- to symbol name, since there can be only one main package per program.
-mainPackageId	   = fsToPackageId FSLIT("main")
-

compiler/main/Packages.lhs

@@ -557,12 +557,12 @@ mkModuleMap pkg_db = foldr extend_modmap emptyUFM pkgids
         
 	extend_modmap pkgid modmap =
 		addListToUFM_C (++) modmap 
-		    [(m, [(pkg, m `elem` exposed_mods)]) | m <- all_mods]
+		   ([(m, [(pkg, True)])  | m <- exposed_mods] ++
+		    [(m, [(pkg, False)]) | m <- hidden_mods])
 	  where
 		pkg = expectJust "mkModuleMap" (lookupPackage pkg_db pkgid)
-	        exposed_mods = map mkModuleName (exposedModules pkg)
-	        hidden_mods  = map mkModuleName (hiddenModules pkg)
-		all_mods = exposed_mods ++ hidden_mods
+	        exposed_mods = exposedModules pkg
+	        hidden_mods  = hiddenModules pkg
 
 pprPkg :: PackageConfig -> SDoc
 pprPkg p = text (showPackageId (package p))
@@ -704,5 +704,10 @@ dumpPackages :: DynFlags -> IO ()
 dumpPackages dflags
   = do  let pkg_map = pkgIdMap (pkgState dflags)
 	putMsg dflags $
-	      vcat (map (text.showInstalledPackageInfo) (eltsUFM pkg_map))
+	      vcat (map (text.showInstalledPackageInfo.to_ipi) (eltsUFM pkg_map))
+ where
+  to_ipi pkgconf@InstalledPackageInfo_{ exposedModules = e,
+                                        hiddenModules = h } = 
+    pkgconf{ exposedModules = map moduleNameString e,
+             hiddenModules  = map moduleNameString h }
 \end{code}

compiler/main/ParsePkgConf.y

@@ -12,6 +12,7 @@ module ParsePkgConf( loadPackageConfig ) where
 
 import PackageConfig
 import Lexer
+import Module
 import DynFlags
 import FastString
 import StringBuffer
@@ -82,27 +83,27 @@ field	:: { PackageConfig -> PackageConfig }
 		-- another case of license
 
 	| VARID '=' strlist		
-		{\p -> case unpackFS $1 of
-		        "exposedModules"    -> p{exposedModules    = $3}
-		        "hiddenModules"     -> p{hiddenModules     = $3}
-		        "importDirs"        -> p{importDirs        = $3}
-		        "libraryDirs"       -> p{libraryDirs       = $3}
-		        "hsLibraries"       -> p{hsLibraries       = $3}
-		        "extraLibraries"    -> p{extraLibraries    = $3}
-		        "extraGHCiLibraries"-> p{extraGHCiLibraries= $3}
-		        "includeDirs"       -> p{includeDirs       = $3}
-		        "includes"          -> p{includes          = $3}
-		        "hugsOptions"       -> p{hugsOptions       = $3}
-		        "ccOptions"         -> p{ccOptions         = $3}
-		        "ldOptions"         -> p{ldOptions         = $3}
-		        "frameworkDirs"     -> p{frameworkDirs     = $3}
-		        "frameworks"        -> p{frameworks        = $3}
-		        "haddockInterfaces" -> p{haddockInterfaces = $3}
-		        "haddockHTMLs"      -> p{haddockHTMLs      = $3}
-		        "depends"     	    -> p{depends = []}
-				-- empty list only, non-empty handled below
-			other -> p
-		}
+	{\p -> case unpackFS $1 of
+	        "exposedModules"    -> p{exposedModules    = map mkModuleNameFS $3}
+	        "hiddenModules"     -> p{hiddenModules     = map mkModuleNameFS $3}
+	        "importDirs"        -> p{importDirs        = map unpackFS $3}
+	        "libraryDirs"       -> p{libraryDirs       = map unpackFS $3}
+	        "hsLibraries"       -> p{hsLibraries       = map unpackFS $3}
+	        "extraLibraries"    -> p{extraLibraries    = map unpackFS $3}
+	        "extraGHCiLibraries"-> p{extraGHCiLibraries= map unpackFS $3}
+	        "includeDirs"       -> p{includeDirs       = map unpackFS $3}
+	        "includes"          -> p{includes          = map unpackFS $3}
+	        "hugsOptions"       -> p{hugsOptions       = map unpackFS $3}
+	        "ccOptions"         -> p{ccOptions         = map unpackFS $3}
+	        "ldOptions"         -> p{ldOptions         = map unpackFS $3}
+	        "frameworkDirs"     -> p{frameworkDirs     = map unpackFS $3}
+	        "frameworks"        -> p{frameworks        = map unpackFS $3}
+	        "haddockInterfaces" -> p{haddockInterfaces = map unpackFS $3}
+	        "haddockHTMLs"      -> p{haddockHTMLs      = map unpackFS $3}
+	        "depends"     	    -> p{depends = []}
+			-- empty list only, non-empty handled below
+		other -> p
+	}
 
 	| VARID '=' pkgidlist
 		{% case unpackFS $1 of
@@ -117,7 +118,8 @@ pkgid	:: { PackageIdentifier }
 
 version :: { Version }
 	: CONID '{' VARID '=' intlist ',' VARID '=' strlist '}'
-			{ Version{ versionBranch=$5, versionTags=$9 } }
+			{ Version{ versionBranch=$5, 
+                                   versionTags=map unpackFS $9 } }
 
 pkgidlist :: { [PackageIdentifier] }
 	: '[' pkgids ']'		{ $2 }
@@ -135,13 +137,13 @@ ints	:: { [Int] }
 	: INT				{ [ fromIntegral $1 ] }
 	| INT ',' ints			{ fromIntegral $1 : $3 }
 
-strlist :: { [String] }
+strlist :: { [FastString] }
         : '[' ']'			{ [] }
 	| '[' strs ']'			{ $2 }
 
-strs	:: { [String] }
-	: STRING			{ [ unpackFS $1 ] }
-	| STRING ',' strs 		{ unpackFS $1 : $3 }
+strs	:: { [FastString] }
+	: STRING			{ [ $1 ] }
+	| STRING ',' strs 		{ $1 : $3 }
 
 {
 happyError :: P a

compiler/main/TidyPgm.lhs

@@ -47,11 +47,10 @@ import TyCon		( TyCon, makeTyConAbstract, tyConDataCons, isNewTyCon,
 			  newTyConRep, tyConSelIds, isAlgTyCon,
 			  isEnumerationTyCon, isOpenTyCon )
 import Class		( classSelIds )
-import Module		( Module )
+import Module
 import HscTypes
 import Maybes		( orElse, mapCatMaybes )
 import ErrUtils		( showPass, dumpIfSet_core )
-import PackageConfig	( PackageId )
 import UniqSupply	( splitUniqSupply, uniqFromSupply )
 import Outputable
 import FastTypes  hiding ( fastOr )

compiler/parser/ParserCore.y

@@ -20,7 +20,6 @@ import Type ( Kind,
             )
 import Name( Name, nameOccName, nameModule, mkExternalName )
 import Module
-import PackageConfig	( mainPackageId, stringToPackageId )
 import ParserCoreUtils
 import LexCore
 import Literal

compiler/prelude/PrelNames.lhs

@@ -56,8 +56,7 @@ module PrelNames (
 
 #include "HsVersions.h"
 
-import PackageConfig
-import Module	  ( Module, ModuleName, mkModule, mkModuleNameFS )
+import Module
 import OccName	  ( dataName, tcName, clsName, varName, mkOccNameFS,
 		    mkVarOccFS )
 import RdrName	  ( RdrName, nameRdrName, mkOrig, rdrNameOcc, mkUnqual )

compiler/profiling/SCCfinal.lhs

@@ -36,12 +36,11 @@ module SCCfinal ( stgMassageForProfiling ) where
 
 import StgSyn
 
-import PackageConfig	( PackageId )
 import StaticFlags	( opt_AutoSccsOnIndividualCafs )
 import CostCentre	-- lots of things
 import Id
 import Name
-import Module		( Module )
+import Module
 import UniqSupply	( splitUniqSupply, UniqSupply )
 #ifdef PROF_DO_BOXING
 import UniqSupply	( uniqFromSupply )

compiler/stgSyn/CoreToStg.lhs

@@ -36,7 +36,7 @@ import Name		( getOccName, isExternalName, nameOccName )
 import OccName		( occNameString, occNameFS )
 import BasicTypes       ( Arity )
 import StaticFlags	( opt_RuntimeTypes )
-import PackageConfig	( PackageId )
+import Module
 import Outputable
 
 infixr 9 `thenLne`

compiler/stgSyn/StgSyn.lhs

@@ -59,7 +59,6 @@ import Var		( isId )
 import Id		( Id, idName, idType, idCafInfo )
 import IdInfo		( mayHaveCafRefs )
 import Packages		( isDllName )
-import PackageConfig	( PackageId )
 import Literal		( Literal, literalType )
 import ForeignCall	( ForeignCall )
 import DataCon		( DataCon, dataConName )
@@ -74,7 +73,7 @@ import UniqSet		( isEmptyUniqSet, uniqSetToList, UniqSet )
 import Unique		( Unique )
 import Bitmap
 import StaticFlags	( opt_SccProfilingOn )
-import Module		( Module, pprModule )
+import Module
 \end{code}
 
 %************************************************************************

compiler/utils/Binary.hs

@@ -66,7 +66,6 @@ import Unique
 import Panic
 import UniqFM
 import FastMutInt
-import PackageConfig
 
 import Foreign
 import Data.Array.IO
@@ -667,10 +666,6 @@ getFS bh = do
   --
   go 0
 
-instance Binary PackageId where
-  put_ bh pid = put_ bh (packageIdFS pid)
-  get bh = do { fs <- get bh; return (fsToPackageId fs) }
-
 instance Binary FastString where
   put_ bh f@(FastString id l _ fp _) =
     case getUserData bh of {