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.

12 files changed, 101 insertions, 107 deletions

diff --git a/compiler/codeGen/CgBindery.lhs b/compiler/codeGen/CgBindery.lhs
index f78edda655..96735ef211 100644
--- a/compiler/codeGen/CgBindery.lhs
+++ b/compiler/codeGen/CgBindery.lhs
@@ -240,8 +240,8 @@ getCgIdInfo id
 	    name = idName id
 	in
 	if isExternalName name then do
-	    hmods <- getHomeModules 
-	    let ext_lbl = CmmLit (CmmLabel (mkClosureLabel hmods name))
+	    this_pkg <- getThisPackage
+	    let ext_lbl = CmmLit (CmmLabel (mkClosureLabel this_pkg name))
 	    return (stableIdInfo id ext_lbl (mkLFImported id))
 	else
 	if isVoidArg (idCgRep id) then
diff --git a/compiler/codeGen/CgCase.lhs b/compiler/codeGen/CgCase.lhs
index e7c08940c5..7b4861a11d 100644
--- a/compiler/codeGen/CgCase.lhs
+++ b/compiler/codeGen/CgCase.lhs
@@ -336,10 +336,10 @@ cgInlinePrimOp primop args bndr (AlgAlt tycon) live_in_alts alts
 	 	-- Bind the default binder if necessary
 		-- (avoiding it avoids the assignment)
 		-- The deadness info is set by StgVarInfo
-	; hmods <- getHomeModules
+	; this_pkg <- getThisPackage
 	; whenC (not (isDeadBinder bndr))
 		(do { tmp_reg <- bindNewToTemp bndr
-		    ; stmtC (CmmAssign tmp_reg (tagToClosure hmods tycon tag_amode)) })
+		    ; stmtC (CmmAssign tmp_reg (tagToClosure this_pkg tycon tag_amode)) })
 
 		-- Compile the alts
 	; (branches, mb_deflt) <- cgAlgAlts NoGC Nothing{-cc_slot-}
diff --git a/compiler/codeGen/CgCon.lhs b/compiler/codeGen/CgCon.lhs
index 0d8d731029..115439a0fd 100644
--- a/compiler/codeGen/CgCon.lhs
+++ b/compiler/codeGen/CgCon.lhs
@@ -70,10 +70,10 @@ cgTopRhsCon :: Id		-- Name of thing bound to this RHS
 	    -> FCode (Id, CgIdInfo)
 cgTopRhsCon id con args
   = do { 
-	; hmods <- getHomeModules
+	; this_pkg <- getThisPackage
 #if mingw32_TARGET_OS
         -- Windows DLLs have a problem with static cross-DLL refs.
-        ; ASSERT( not (isDllConApp hmods con args) ) return ()
+        ; ASSERT( not (isDllConApp this_pkg con args) ) return ()
 #endif
 	; ASSERT( args `lengthIs` dataConRepArity con ) return ()
 
@@ -83,9 +83,9 @@ cgTopRhsCon id con args
 	; let
 	    name          = idName id
 	    lf_info	  = mkConLFInfo con
-    	    closure_label = mkClosureLabel hmods name
+    	    closure_label = mkClosureLabel this_pkg name
 	    caffy         = any stgArgHasCafRefs args
-	    (closure_info, amodes_w_offsets) = layOutStaticConstr hmods con amodes
+	    (closure_info, amodes_w_offsets) = layOutStaticConstr this_pkg con amodes
 	    closure_rep = mkStaticClosureFields
 	    		     closure_info
 	    		     dontCareCCS		-- Because it's static data
@@ -142,9 +142,9 @@ at all.
 
 \begin{code}
 buildDynCon binder cc con []
-  = do hmods <- getHomeModules
+  = do this_pkg <- getThisPackage
        returnFC (stableIdInfo binder
-			   (mkLblExpr (mkClosureLabel hmods (dataConName con)))
+			   (mkLblExpr (mkClosureLabel this_pkg (dataConName con)))
     			   (mkConLFInfo con))
 \end{code}
 
@@ -198,9 +198,9 @@ Now the general case.
 \begin{code}
 buildDynCon binder ccs con args
   = do	{ 
-	; hmods <- getHomeModules
+	; this_pkg <- getThisPackage
 	; let
-	    (closure_info, amodes_w_offsets) = layOutDynConstr hmods con args
+	    (closure_info, amodes_w_offsets) = layOutDynConstr this_pkg con args
 
 	; hp_off <- allocDynClosure closure_info use_cc blame_cc amodes_w_offsets
  	; returnFC (heapIdInfo binder hp_off lf_info) }
@@ -230,10 +230,10 @@ found a $con$.
 \begin{code}
 bindConArgs :: DataCon -> [Id] -> Code
 bindConArgs con args
-  = do hmods <- getHomeModules
+  = do this_pkg <- getThisPackage
        let
 	  bind_arg (arg, offset) = bindNewToNode arg offset (mkLFArgument arg)
-	  (_, args_w_offsets)    = layOutDynConstr hmods con (addIdReps args)
+	  (_, args_w_offsets)    = layOutDynConstr this_pkg con (addIdReps args)
 	--
        ASSERT(not (isUnboxedTupleCon con)) return ()
        mapCs bind_arg args_w_offsets
@@ -416,7 +416,7 @@ static closure, for a constructor.
 cgDataCon :: DataCon -> Code
 cgDataCon data_con
   = do	{     -- Don't need any dynamic closure code for zero-arity constructors
-	  hmods <- getHomeModules
+	  this_pkg <- getThisPackage
 
 	; let
 	    -- To allow the debuggers, interpreters, etc to cope with
@@ -424,10 +424,10 @@ cgDataCon data_con
 	    -- time), we take care that info-table contains the
 	    -- information we need.
 	    (static_cl_info, _) = 
-		layOutStaticConstr hmods data_con arg_reps
+		layOutStaticConstr this_pkg data_con arg_reps
 
 	    (dyn_cl_info, arg_things) = 
-		layOutDynConstr    hmods data_con arg_reps
+		layOutDynConstr    this_pkg data_con arg_reps
 
 	    emit_info cl_info ticky_code
 		= do { code_blks <- getCgStmts the_code
diff --git a/compiler/codeGen/CgExpr.lhs b/compiler/codeGen/CgExpr.lhs
index 33d72f1608..e36b2ae236 100644
--- a/compiler/codeGen/CgExpr.lhs
+++ b/compiler/codeGen/CgExpr.lhs
@@ -152,8 +152,8 @@ cgExpr (StgOpApp (StgPrimOp TagToEnumOp) [arg] res_ty)
     do	{ (_,amode) <- getArgAmode arg
 	; amode' <- assignTemp amode	-- We're going to use it twice,
 					-- so save in a temp if non-trivial
-	; hmods <- getHomeModules
-	; stmtC (CmmAssign nodeReg (tagToClosure hmods tycon amode'))
+	; this_pkg <- getThisPackage
+	; stmtC (CmmAssign nodeReg (tagToClosure this_pkg tycon amode'))
 	; performReturn (emitAlgReturnCode tycon amode') }
    where
 	  -- If you're reading this code in the attempt to figure
@@ -185,9 +185,9 @@ cgExpr x@(StgOpApp op@(StgPrimOp primop) args res_ty)
   | ReturnsAlg tycon <- result_info, isEnumerationTyCon tycon
 	-- c.f. cgExpr (...TagToEnumOp...)
 	= do tag_reg <- newTemp wordRep
-	     hmods <- getHomeModules
+	     this_pkg <- getThisPackage
 	     cgPrimOp [tag_reg] primop args emptyVarSet
-	     stmtC (CmmAssign nodeReg (tagToClosure hmods tycon (CmmReg tag_reg)))
+	     stmtC (CmmAssign nodeReg (tagToClosure this_pkg tycon (CmmReg tag_reg)))
 	     performReturn (emitAlgReturnCode tycon (CmmReg tag_reg))
   where
 	result_info = getPrimOpResultInfo primop
@@ -282,8 +282,8 @@ cgRhs name (StgRhsCon maybe_cc con args)
 	; returnFC (name, idinfo) }
 
 cgRhs name (StgRhsClosure cc bi fvs upd_flag srt args body)
-  = do hmods <- getHomeModules
-       mkRhsClosure hmods name cc bi srt fvs upd_flag args body
+  = do this_pkg <- getThisPackage
+       mkRhsClosure this_pkg name cc bi srt fvs upd_flag args body
 \end{code}
 
 mkRhsClosure looks for two special forms of the right-hand side:
@@ -306,7 +306,7 @@ form:
 
 
 \begin{code}
-mkRhsClosure	hmods bndr cc bi srt
+mkRhsClosure	this_pkg bndr cc bi srt
 		[the_fv]   		-- Just one free var
 		upd_flag		-- Updatable thunk
 		[]			-- A thunk
@@ -328,7 +328,7 @@ mkRhsClosure	hmods bndr cc bi srt
   where
     lf_info 		  = mkSelectorLFInfo bndr offset_into_int
 				 (isUpdatable upd_flag)
-    (_, params_w_offsets) = layOutDynConstr hmods con (addIdReps params)
+    (_, params_w_offsets) = layOutDynConstr this_pkg con (addIdReps params)
 			-- Just want the layout
     maybe_offset	  = assocMaybe params_w_offsets selectee
     Just the_offset 	  = maybe_offset
@@ -352,7 +352,7 @@ We only generate an Ap thunk if all the free variables are pointers,
 for semi-obvious reasons.
 
 \begin{code}
-mkRhsClosure 	hmods bndr cc bi srt
+mkRhsClosure 	this_pkg bndr cc bi srt
 		fvs
 		upd_flag
 		[]			-- No args; a thunk
@@ -377,7 +377,7 @@ mkRhsClosure 	hmods bndr cc bi srt
 The default case
 ~~~~~~~~~~~~~~~~
 \begin{code}
-mkRhsClosure hmods bndr cc bi srt fvs upd_flag args body
+mkRhsClosure this_pkg bndr cc bi srt fvs upd_flag args body
   = cgRhsClosure bndr cc bi srt fvs upd_flag args body
 \end{code}
 
diff --git a/compiler/codeGen/CgForeignCall.hs b/compiler/codeGen/CgForeignCall.hs
index 10f41bdf8b..e66e1b8ead 100644
--- a/compiler/codeGen/CgForeignCall.hs
+++ b/compiler/codeGen/CgForeignCall.hs
@@ -23,8 +23,7 @@ import StgSyn		( StgLiveVars, StgArg, stgArgType )
 import CgProf		( curCCS, curCCSAddr )
 import CgBindery	( getVolatileRegs, getArgAmodes )
 import CgMonad
-import CgUtils		( cmmOffsetW, cmmOffsetB, cmmLoadIndexW, newTemp,
-			  assignTemp )
+import CgUtils		( cmmOffsetW, cmmOffsetB, newTemp )
 import Type		( tyConAppTyCon, repType )
 import TysPrim
 import CLabel		( mkForeignLabel, mkRtsCodeLabel )
diff --git a/compiler/codeGen/CgHeapery.lhs b/compiler/codeGen/CgHeapery.lhs
index 184af904df..ae6c892b5d 100644
--- a/compiler/codeGen/CgHeapery.lhs
+++ b/compiler/codeGen/CgHeapery.lhs
@@ -53,7 +53,7 @@ import TyCon		( tyConPrimRep )
 import CostCentre	( CostCentreStack )
 import Util		( mapAccumL, filterOut )
 import Constants	( wORD_SIZE )
-import Packages		( HomeModules )
+import PackageConfig	( PackageId )
 import Outputable
 
 \end{code}
@@ -123,7 +123,7 @@ getHpRelOffset virtual_offset
 
 \begin{code}
 layOutDynConstr, layOutStaticConstr
-	:: HomeModules
+	:: PackageId
 	-> DataCon 	
 	-> [(CgRep,a)]
 	-> (ClosureInfo,
@@ -132,8 +132,8 @@ layOutDynConstr, layOutStaticConstr
 layOutDynConstr    = layOutConstr False
 layOutStaticConstr = layOutConstr True
 
-layOutConstr  is_static hmods data_con args
-   = (mkConInfo hmods is_static data_con tot_wds ptr_wds,
+layOutConstr  is_static this_pkg data_con args
+   = (mkConInfo this_pkg is_static data_con tot_wds ptr_wds,
       things_w_offsets)
   where
     (tot_wds,		 --  #ptr_wds + #nonptr_wds
diff --git a/compiler/codeGen/CgMonad.lhs b/compiler/codeGen/CgMonad.lhs
index 22462e79e5..1866df4cef 100644
--- a/compiler/codeGen/CgMonad.lhs
+++ b/compiler/codeGen/CgMonad.lhs
@@ -47,7 +47,7 @@ module CgMonad (
 	Sequel(..), -- ToDo: unabstract?
 
 	-- ideally we wouldn't export these, but some other modules access internal state
-	getState, setState, getInfoDown, getDynFlags, getHomeModules,
+	getState, setState, getInfoDown, getDynFlags, getThisPackage,
 
 	-- more localised access to monad state	
 	getStkUsage, setStkUsage,
@@ -61,8 +61,8 @@ module CgMonad (
 
 import {-# SOURCE #-} CgBindery ( CgBindings, nukeVolatileBinds )
 
-import DynFlags		( DynFlags )
-import Packages		( HomeModules )
+import DynFlags		( DynFlags(..) )
+import PackageConfig	( PackageId )
 import Cmm
 import CmmUtils		( CmmStmts, isNopStmt )
 import CLabel
@@ -97,7 +97,6 @@ along.
 data CgInfoDownwards	-- information only passed *downwards* by the monad
   = MkCgInfoDown {
 	cgd_dflags  :: DynFlags,
-	cgd_hmods   :: HomeModules,	-- Packages we depend on
 	cgd_mod     :: Module,		-- Module being compiled
 	cgd_statics :: CgBindings,	-- [Id -> info] : static environment
 	cgd_srt     :: CLabel,		-- label of the current SRT
@@ -105,10 +104,9 @@ data CgInfoDownwards	-- information only passed *downwards* by the monad
 	cgd_eob     :: EndOfBlockInfo	-- Info for stuff to do at end of basic block:
   }
 
-initCgInfoDown :: DynFlags -> HomeModules -> Module -> CgInfoDownwards
-initCgInfoDown dflags hmods mod
+initCgInfoDown :: DynFlags -> Module -> CgInfoDownwards
+initCgInfoDown dflags mod
   = MkCgInfoDown {	cgd_dflags  = dflags,
-			cgd_hmods   = hmods,
 			cgd_mod     = mod,
 			cgd_statics = emptyVarEnv,
 			cgd_srt     = error "initC: srt",
@@ -378,11 +376,11 @@ instance Monad FCode where
 The Abstract~C is not in the environment so as to improve strictness.
 
 \begin{code}
-initC :: DynFlags -> HomeModules -> Module -> FCode a -> IO a
+initC :: DynFlags -> Module -> FCode a -> IO a
 
-initC dflags hmods mod (FCode code)
+initC dflags mod (FCode code)
   = do	{ uniqs <- mkSplitUniqSupply 'c'
-	; case code (initCgInfoDown dflags hmods mod) (initCgState uniqs) of
+	; case code (initCgInfoDown dflags mod) (initCgState uniqs) of
 	      (res, _) -> return res
 	}
 
@@ -510,8 +508,8 @@ getInfoDown = FCode $ \info_down state -> (info_down,state)
 getDynFlags :: FCode DynFlags
 getDynFlags = liftM cgd_dflags getInfoDown
 
-getHomeModules :: FCode HomeModules
-getHomeModules = liftM cgd_hmods getInfoDown
+getThisPackage :: FCode PackageId
+getThisPackage = liftM thisPackage getDynFlags
 
 withInfoDown :: FCode a -> CgInfoDownwards -> FCode a
 withInfoDown (FCode fcode) info_down = FCode $ \_ state -> fcode info_down state 
diff --git a/compiler/codeGen/CgProf.hs b/compiler/codeGen/CgProf.hs
index eee1083fca..9bbf05b90c 100644
--- a/compiler/codeGen/CgProf.hs
+++ b/compiler/codeGen/CgProf.hs
@@ -292,7 +292,7 @@ emitCostCentreDecl
    -> Code
 emitCostCentreDecl cc = do 
   { label <- mkStringCLit (costCentreUserName cc)
-  ; modl  <- mkStringCLit (moduleString (cc_mod cc))
+  ; modl  <- mkStringCLit (showSDoc (pprModule (cc_mod cc)))
   ; let
      lits = [ zero,   	-- StgInt ccID,
 	      label,	-- char *label,
diff --git a/compiler/codeGen/CgTailCall.lhs b/compiler/codeGen/CgTailCall.lhs
index dd7327b745..56614a87f3 100644
--- a/compiler/codeGen/CgTailCall.lhs
+++ b/compiler/codeGen/CgTailCall.lhs
@@ -118,9 +118,9 @@ performTailCall fun_info arg_amodes pending_assts
 	      opt_node_asst | nodeMustPointToIt lf_info = node_asst
 			    | otherwise		        = noStmts
 	; EndOfBlockInfo sp _ <- getEndOfBlockInfo
-	; hmods <- getHomeModules
+	; this_pkg <- getThisPackage
 
-	; case (getCallMethod hmods fun_name lf_info (length arg_amodes)) of
+	; case (getCallMethod this_pkg fun_name lf_info (length arg_amodes)) of
 
 	    -- Node must always point to things we enter
 	    EnterIt -> do
diff --git a/compiler/codeGen/CgUtils.hs b/compiler/codeGen/CgUtils.hs
index 2f69927db0..21e6d0850c 100644
--- a/compiler/codeGen/CgUtils.hs
+++ b/compiler/codeGen/CgUtils.hs
@@ -48,13 +48,12 @@ import MachOp		( MachRep(..), wordRep, MachOp(..),  MachHint(..),
 			  mo_wordULt, mo_wordUGt, mo_wordUGe, machRepByteWidth )
 import ForeignCall	( CCallConv(..) )
 import Literal		( Literal(..) )
-import CLabel		( CLabel, mkStringLitLabel )
 import Digraph		( SCC(..), stronglyConnComp )
 import ListSetOps	( assocDefault )
 import Util		( filterOut, sortLe )
 import DynFlags		( DynFlags(..), HscTarget(..) )
-import Packages		( HomeModules )
-import FastString	( LitString, FastString, bytesFS )
+import FastString	( LitString, bytesFS )
+import PackageConfig	( PackageId )
 import Outputable
 
 import Char		( ord )
@@ -213,11 +212,11 @@ addToMemE rep ptr n
 --
 -------------------------------------------------------------------------
 
-tagToClosure :: HomeModules -> TyCon -> CmmExpr -> CmmExpr
-tagToClosure hmods tycon tag
+tagToClosure :: PackageId -> TyCon -> CmmExpr -> CmmExpr
+tagToClosure this_pkg tycon tag
   = CmmLoad (cmmOffsetExprW closure_tbl tag) wordRep
   where closure_tbl = CmmLit (CmmLabel lbl)
-	lbl = mkClosureTableLabel hmods (tyConName tycon)
+	lbl = mkClosureTableLabel this_pkg (tyConName tycon)
 
 -------------------------------------------------------------------------
 --
@@ -488,7 +487,6 @@ mk_switch tag_expr branches mb_deflt lo_tag hi_tag via_C
 		 -- a 2-branch switch always turns into an if.
     small      	 = n_tags <= 4
     dense      	 = n_branches > (n_tags `div` 2)
-    exhaustive   = n_tags == n_branches
     n_branches   = length branches
     
     -- ignore default slots at each end of the range if there's 
diff --git a/compiler/codeGen/ClosureInfo.lhs b/compiler/codeGen/ClosureInfo.lhs
index 84d9dd95ef..d137d4d3ca 100644
--- a/compiler/codeGen/ClosureInfo.lhs
+++ b/compiler/codeGen/ClosureInfo.lhs
@@ -61,8 +61,8 @@ import SMRep		-- all of it
 
 import CLabel
 
-import Constants	( mIN_PAYLOAD_SIZE )
-import Packages		( isDllName, HomeModules )
+import Packages		( isDllName )
+import PackageConfig	( PackageId )
 import StaticFlags	( opt_SccProfilingOn, opt_OmitBlackHoling,
 			  opt_Parallel, opt_DoTickyProfiling )
 import Id		( Id, idType, idArity, idName )
@@ -330,15 +330,15 @@ mkClosureInfo is_static id lf_info tot_wds ptr_wds srt_info descr
     name   = idName id
     sm_rep = chooseSMRep is_static lf_info tot_wds ptr_wds
 
-mkConInfo :: HomeModules
+mkConInfo :: PackageId
 	  -> Bool	-- Is static
 	  -> DataCon	
 	  -> Int -> Int	-- Total and pointer words
 	  -> ClosureInfo
-mkConInfo hmods is_static data_con tot_wds ptr_wds
+mkConInfo this_pkg is_static data_con tot_wds ptr_wds
    = ConInfo {	closureSMRep = sm_rep,
 		closureCon = data_con,
-		closureDllCon = isDllName hmods (dataConName data_con) }
+		closureDllCon = isDllName this_pkg (dataConName data_con) }
   where
     sm_rep = chooseSMRep is_static (mkConLFInfo data_con) tot_wds ptr_wds
 \end{code}
@@ -560,30 +560,30 @@ data CallMethod
 	CLabel 				--   The code label
 	Int 				--   Its arity
 
-getCallMethod :: HomeModules
+getCallMethod :: PackageId
 	      -> Name		-- Function being applied
 	      -> LambdaFormInfo	-- Its info
 	      -> Int		-- Number of available arguments
 	      -> CallMethod
 
-getCallMethod hmods name lf_info n_args
+getCallMethod this_pkg name lf_info n_args
   | nodeMustPointToIt lf_info && opt_Parallel
   =	-- If we're parallel, then we must always enter via node.  
 	-- The reason is that the closure may have been 	
 	-- fetched since we allocated it.
     EnterIt
 
-getCallMethod hmods name (LFReEntrant _ arity _ _) n_args
+getCallMethod this_pkg name (LFReEntrant _ arity _ _) n_args
   | n_args == 0    = ASSERT( arity /= 0 )
 		     ReturnIt	-- No args at all
   | n_args < arity = SlowCall	-- Not enough args
-  | otherwise      = DirectEntry (enterIdLabel hmods name) arity
+  | otherwise      = DirectEntry (enterIdLabel this_pkg name) arity
 
-getCallMethod hmods name (LFCon con) n_args
+getCallMethod this_pkg name (LFCon con) n_args
   = ASSERT( n_args == 0 )
     ReturnCon con
 
-getCallMethod hmods name (LFThunk _ _ updatable std_form_info is_fun) n_args
+getCallMethod this_pkg name (LFThunk _ _ updatable std_form_info is_fun) n_args
   | is_fun 	-- Must always "call" a function-typed 
   = SlowCall	-- thing, cannot just enter it [in eval/apply, the entry code
 		-- is the fast-entry code]
@@ -598,24 +598,24 @@ getCallMethod hmods name (LFThunk _ _ updatable std_form_info is_fun) n_args
 
   | otherwise	-- Jump direct to code for single-entry thunks
   = ASSERT( n_args == 0 )
-    JumpToIt (thunkEntryLabel hmods name std_form_info updatable)
+    JumpToIt (thunkEntryLabel this_pkg name std_form_info updatable)
 
-getCallMethod hmods name (LFUnknown True) n_args
+getCallMethod this_pkg name (LFUnknown True) n_args
   = SlowCall -- might be a function
 
-getCallMethod hmods name (LFUnknown False) n_args
+getCallMethod this_pkg name (LFUnknown False) n_args
   = ASSERT2 ( n_args == 0, ppr name <+> ppr n_args ) 
     EnterIt -- Not a function
 
-getCallMethod hmods name (LFBlackHole _) n_args
+getCallMethod this_pkg name (LFBlackHole _) n_args
   = SlowCall	-- Presumably the black hole has by now
 		-- been updated, but we don't know with
 		-- what, so we slow call it
 
-getCallMethod hmods name (LFLetNoEscape 0) n_args
+getCallMethod this_pkg name (LFLetNoEscape 0) n_args
   = JumpToIt (enterReturnPtLabel (nameUnique name))
 
-getCallMethod hmods name (LFLetNoEscape arity) n_args
+getCallMethod this_pkg name (LFLetNoEscape arity) n_args
   | n_args == arity = DirectEntry (enterReturnPtLabel (nameUnique name)) arity
   | otherwise = pprPanic "let-no-escape: " (ppr name <+> ppr arity)
 
@@ -845,12 +845,12 @@ closureLabelFromCI _ = panic "closureLabelFromCI"
 -- thunkEntryLabel is a local help function, not exported.  It's used from both
 -- entryLabelFromCI and getCallMethod.
 
-thunkEntryLabel hmods thunk_id (ApThunk arity) is_updatable
+thunkEntryLabel this_pkg thunk_id (ApThunk arity) is_updatable
   = enterApLabel is_updatable arity
-thunkEntryLabel hmods thunk_id (SelectorThunk offset) upd_flag
+thunkEntryLabel this_pkg thunk_id (SelectorThunk offset) upd_flag
   = enterSelectorLabel upd_flag offset
-thunkEntryLabel hmods thunk_id _ is_updatable
-  = enterIdLabel hmods thunk_id
+thunkEntryLabel this_pkg thunk_id _ is_updatable
+  = enterIdLabel this_pkg thunk_id
 
 enterApLabel is_updatable arity
   | tablesNextToCode = mkApInfoTableLabel is_updatable arity
@@ -860,9 +860,9 @@ enterSelectorLabel upd_flag offset
   | tablesNextToCode = mkSelectorInfoLabel upd_flag offset
   | otherwise        = mkSelectorEntryLabel upd_flag offset
 
-enterIdLabel hmods id
-  | tablesNextToCode = mkInfoTableLabel hmods id
-  | otherwise        = mkEntryLabel hmods id
+enterIdLabel this_pkg id
+  | tablesNextToCode = mkInfoTableLabel this_pkg id
+  | otherwise        = mkEntryLabel this_pkg id
 
 enterLocalIdLabel id
   | tablesNextToCode = mkLocalInfoTableLabel id
diff --git a/compiler/codeGen/CodeGen.lhs b/compiler/codeGen/CodeGen.lhs
index 48c0cbfbb9..0422a875e1 100644
--- a/compiler/codeGen/CodeGen.lhs
+++ b/compiler/codeGen/CodeGen.lhs
@@ -38,11 +38,11 @@ import PprCmm		( pprCmms )
 import MachOp		( wordRep )
 
 import StgSyn
-import PrelNames	( gHC_PRIM, rOOT_MAIN, pREL_TOP_HANDLER )
-import Packages		( HomeModules )
+import PrelNames	( gHC_PRIM, rOOT_MAIN, gHC_TOP_HANDLER )
 import DynFlags		( DynFlags(..), DynFlag(..), dopt )
 import StaticFlags	( opt_SccProfilingOn )
 
+import PackageConfig	( PackageId )
 import HscTypes		( ForeignStubs(..) )
 import CostCentre       ( CollectedCCs )
 import Id               ( Id, idName, setIdName )
@@ -51,16 +51,14 @@ import OccName		( mkLocalOcc )
 import TyCon            ( TyCon )
 import Module		( Module )
 import ErrUtils		( dumpIfSet_dyn, showPass )
-import Panic		( assertPanic )
 
 #ifdef DEBUG
-import Outputable
+import Panic		( assertPanic )
 #endif
 \end{code}
 
 \begin{code}
 codeGen :: DynFlags
-	-> HomeModules
 	-> Module
 	-> [TyCon]
 	-> ForeignStubs
@@ -69,7 +67,7 @@ codeGen :: DynFlags
 	-> [(StgBinding,[(Id,[Id])])]	-- Bindings to convert, with SRTs
 	-> IO [Cmm]		-- Output
 
-codeGen dflags hmods this_mod data_tycons foreign_stubs imported_mods 
+codeGen dflags this_mod data_tycons foreign_stubs imported_mods 
 	cost_centre_info stg_binds
   = do	
   { showPass dflags "CodeGen"
@@ -79,10 +77,10 @@ codeGen dflags hmods this_mod data_tycons foreign_stubs imported_mods
 -- Why?
 --   ; mapM_ (\x -> seq x (return ())) data_tycons
 
-  ; code_stuff <- initC dflags hmods this_mod $ do 
-		{ cmm_binds  <- mapM (getCmm . cgTopBinding dflags hmods) stg_binds
+  ; code_stuff <- initC dflags this_mod $ do 
+		{ cmm_binds  <- mapM (getCmm . cgTopBinding dflags) stg_binds
 		; cmm_tycons <- mapM cgTyCon data_tycons
-		; cmm_init   <- getCmm (mkModuleInit dflags hmods way cost_centre_info 
+		; cmm_init   <- getCmm (mkModuleInit dflags way cost_centre_info 
 					     this_mod main_mod
 				  	     foreign_stubs imported_mods)
 		; return (cmm_binds ++ concat cmm_tycons ++ [cmm_init])
@@ -143,7 +141,6 @@ We initialise the module tree by keeping a work-stack,
 \begin{code}
 mkModuleInit 
 	:: DynFlags
-	-> HomeModules
 	-> String		-- the "way"
 	-> CollectedCCs         -- cost centre info
 	-> Module
@@ -151,7 +148,7 @@ mkModuleInit
 	-> ForeignStubs
 	-> [Module]
 	-> Code
-mkModuleInit dflags hmods way cost_centre_info this_mod main_mod foreign_stubs imported_mods
+mkModuleInit dflags way cost_centre_info this_mod main_mod foreign_stubs imported_mods
   = do	{ 	
         if opt_SccProfilingOn
             then do { -- Allocate the static boolean that records if this
@@ -184,9 +181,11 @@ mkModuleInit dflags hmods way cost_centre_info this_mod main_mod foreign_stubs i
 		(emitSimpleProc plain_main_init_lbl jump_to_init)
     }
   where
-    plain_init_lbl = mkPlainModuleInitLabel hmods this_mod
-    real_init_lbl  = mkModuleInitLabel hmods this_mod way
-    plain_main_init_lbl = mkPlainModuleInitLabel hmods rOOT_MAIN
+    this_pkg = thisPackage dflags
+
+    plain_init_lbl = mkPlainModuleInitLabel this_pkg this_mod
+    real_init_lbl  = mkModuleInitLabel this_pkg this_mod way
+    plain_main_init_lbl = mkPlainModuleInitLabel this_pkg rOOT_MAIN
 
     jump_to_init = stmtC (CmmJump (mkLblExpr real_init_lbl) [])
 
@@ -195,7 +194,7 @@ mkModuleInit dflags hmods way cost_centre_info this_mod main_mod foreign_stubs i
     -- Main refers to GHC.TopHandler.runIO, so make sure we call the
     -- init function for GHC.TopHandler.
     extra_imported_mods
-	| this_mod == main_mod = [pREL_TOP_HANDLER]
+	| this_mod == main_mod = [gHC_TOP_HANDLER]
 	| otherwise	       = []
 
     mod_init_code = do
@@ -204,7 +203,7 @@ mkModuleInit dflags hmods way cost_centre_info this_mod main_mod foreign_stubs i
 
 		-- Now do local stuff
 	; initCostCentres cost_centre_info
-	; mapCs (registerModuleImport hmods way) 
+	; mapCs (registerModuleImport this_pkg way) 
 		(imported_mods++extra_imported_mods)
 	} 
 
@@ -214,13 +213,13 @@ mkModuleInit dflags hmods way cost_centre_info this_mod main_mod foreign_stubs i
                       , CmmJump (CmmLoad (cmmRegOffW spReg (-1)) wordRep) [] ]
 
 -----------------------
-registerModuleImport :: HomeModules -> String -> Module -> Code
-registerModuleImport hmods way mod 
+registerModuleImport :: PackageId -> String -> Module -> Code
+registerModuleImport this_pkg way mod 
   | mod == gHC_PRIM
   = nopC 
   | otherwise 	-- Push the init procedure onto the work stack
   = stmtsC [ CmmAssign spReg (cmmRegOffW spReg (-1))
-	   , CmmStore (CmmReg spReg) (mkLblExpr (mkModuleInitLabel hmods mod way)) ]
+	   , CmmStore (CmmReg spReg) (mkLblExpr (mkModuleInitLabel this_pkg mod way)) ]
 \end{code}
 
 
@@ -261,32 +260,32 @@ style, with the increasing static environment being plumbed as a state
 variable.
 
 \begin{code}
-cgTopBinding :: DynFlags -> HomeModules -> (StgBinding,[(Id,[Id])]) -> Code
-cgTopBinding dflags hmods (StgNonRec id rhs, srts)
+cgTopBinding :: DynFlags -> (StgBinding,[(Id,[Id])]) -> Code
+cgTopBinding dflags (StgNonRec id rhs, srts)
   = do	{ id' <- maybeExternaliseId dflags id
-	; mapM_ (mkSRT hmods [id']) srts
+	; mapM_ (mkSRT (thisPackage dflags) [id']) srts
 	; (id,info) <- cgTopRhs id' rhs
 	; addBindC id info 	-- Add the *un-externalised* Id to the envt,
 				-- so we find it when we look up occurrences
 	}
 
-cgTopBinding dflags hmods (StgRec pairs, srts)
+cgTopBinding dflags (StgRec pairs, srts)
   = do	{ let (bndrs, rhss) = unzip pairs
 	; bndrs' <- mapFCs (maybeExternaliseId dflags) bndrs
 	; let pairs' = zip bndrs' rhss
-	; mapM_ (mkSRT hmods bndrs')  srts
+	; mapM_ (mkSRT (thisPackage dflags) bndrs')  srts
 	; _new_binds <- fixC (\ new_binds -> do 
 		{ addBindsC new_binds
 		; mapFCs ( \ (b,e) -> cgTopRhs b e ) pairs' })
 	; nopC }
 
-mkSRT :: HomeModules -> [Id] -> (Id,[Id]) -> Code
-mkSRT hmods these (id,[])  = nopC
-mkSRT hmods these (id,ids)
+mkSRT :: PackageId -> [Id] -> (Id,[Id]) -> Code
+mkSRT this_pkg these (id,[])  = nopC
+mkSRT this_pkg these (id,ids)
   = do	{ ids <- mapFCs remap ids
 	; id  <- remap id
 	; emitRODataLits (mkSRTLabel (idName id)) 
-		       (map (CmmLabel . mkClosureLabel hmods . idName) ids)
+		       (map (CmmLabel . mkClosureLabel this_pkg . idName) ids)
 	}
   where
 	-- Sigh, better map all the ids against the environment in