[project @ 2005-06-21 10:44:37 by simonmar]

Relax the restrictions on conflicting packages.  This should address
many of the traps that people have been falling into with the current
package story.

Now, a local module can shadow a module in an exposed package, as long
as the package is not otherwise required by the program.  GHC checks
for conflicts when it knows the dependencies of the module being
compiled.

Also, we now check for module conflicts in exposed packages only when
importing a module: if an import can be satisfied from multiple
packages, that's an error.  It's not possible to prevent GHC from
starting by installing packages now (unless you install another base
package).

It seems to be possible to confuse GHCi by having a local module
shadowing a package module that goes away and comes back again.  I
think it's nearly right, but strange happenings have been observed.

I'll try to merge this into the STABLE branch.

10 files changed, 104 insertions, 97 deletions

diff --git a/ghc/compiler/codeGen/CgBindery.lhs b/ghc/compiler/codeGen/CgBindery.lhs
index e4ca141c9e..f78edda655 100644
--- a/ghc/compiler/codeGen/CgBindery.lhs
+++ b/ghc/compiler/codeGen/CgBindery.lhs
@@ -240,8 +240,8 @@ getCgIdInfo id
 	    name = idName id
 	in
 	if isExternalName name then do
-	    dflags <- getDynFlags 
-	    let ext_lbl = CmmLit (CmmLabel (mkClosureLabel dflags name))
+	    hmods <- getHomeModules 
+	    let ext_lbl = CmmLit (CmmLabel (mkClosureLabel hmods name))
 	    return (stableIdInfo id ext_lbl (mkLFImported id))
 	else
 	if isVoidArg (idCgRep id) then
diff --git a/ghc/compiler/codeGen/CgCase.lhs b/ghc/compiler/codeGen/CgCase.lhs
index 58a43f489c..e7c08940c5 100644
--- a/ghc/compiler/codeGen/CgCase.lhs
+++ b/ghc/compiler/codeGen/CgCase.lhs
@@ -1,7 +1,7 @@
 %
 % (c) The GRASP/AQUA Project, Glasgow University, 1992-1998
 %
-% $Id: CgCase.lhs,v 1.74 2005/03/31 10:16:34 simonmar Exp $
+% $Id: CgCase.lhs,v 1.75 2005/06/21 10:44:41 simonmar Exp $
 %
 %********************************************************
 %*							*
@@ -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
-	; dflags <- getDynFlags
+	; hmods <- getHomeModules
 	; whenC (not (isDeadBinder bndr))
 		(do { tmp_reg <- bindNewToTemp bndr
-		    ; stmtC (CmmAssign tmp_reg (tagToClosure dflags tycon tag_amode)) })
+		    ; stmtC (CmmAssign tmp_reg (tagToClosure hmods tycon tag_amode)) })
 
 		-- Compile the alts
 	; (branches, mb_deflt) <- cgAlgAlts NoGC Nothing{-cc_slot-}
diff --git a/ghc/compiler/codeGen/CgCon.lhs b/ghc/compiler/codeGen/CgCon.lhs
index d94cbf03f6..bfb55bf46e 100644
--- a/ghc/compiler/codeGen/CgCon.lhs
+++ b/ghc/compiler/codeGen/CgCon.lhs
@@ -71,10 +71,10 @@ cgTopRhsCon :: Id		-- Name of thing bound to this RHS
 	    -> FCode (Id, CgIdInfo)
 cgTopRhsCon id con args
   = do { 
-	; dflags <- getDynFlags
+	; hmods <- getHomeModules
 #if mingw32_TARGET_OS
         -- Windows DLLs have a problem with static cross-DLL refs.
-        ; ASSERT( not (isDllConApp dflags con args) ) return ()
+        ; ASSERT( not (isDllConApp hmods con args) ) return ()
 #endif
 	; ASSERT( args `lengthIs` dataConRepArity con ) return ()
 
@@ -84,9 +84,9 @@ cgTopRhsCon id con args
 	; let
 	    name          = idName id
 	    lf_info	  = mkConLFInfo con
-    	    closure_label = mkClosureLabel dflags name
+    	    closure_label = mkClosureLabel hmods name
 	    caffy         = any stgArgHasCafRefs args
-	    (closure_info, amodes_w_offsets) = layOutStaticConstr dflags con amodes
+	    (closure_info, amodes_w_offsets) = layOutStaticConstr hmods con amodes
 	    closure_rep = mkStaticClosureFields
 	    		     closure_info
 	    		     dontCareCCS		-- Because it's static data
@@ -143,9 +143,9 @@ at all.
 
 \begin{code}
 buildDynCon binder cc con []
-  = do dflags <- getDynFlags
+  = do hmods <- getHomeModules
        returnFC (stableIdInfo binder
-			   (mkLblExpr (mkClosureLabel dflags (dataConName con)))
+			   (mkLblExpr (mkClosureLabel hmods (dataConName con)))
     			   (mkConLFInfo con))
 \end{code}
 
@@ -199,9 +199,9 @@ Now the general case.
 \begin{code}
 buildDynCon binder ccs con args
   = do	{ 
-	; dflags <- getDynFlags
+	; hmods <- getHomeModules
 	; let
-	    (closure_info, amodes_w_offsets) = layOutDynConstr dflags con args
+	    (closure_info, amodes_w_offsets) = layOutDynConstr hmods con args
 
 	; hp_off <- allocDynClosure closure_info use_cc blame_cc amodes_w_offsets
  	; returnFC (heapIdInfo binder hp_off lf_info) }
@@ -231,10 +231,10 @@ found a $con$.
 \begin{code}
 bindConArgs :: DataCon -> [Id] -> Code
 bindConArgs con args
-  = do dflags <- getDynFlags
+  = do hmods <- getHomeModules
        let
 	  bind_arg (arg, offset) = bindNewToNode arg offset (mkLFArgument arg)
-	  (_, args_w_offsets)    = layOutDynConstr dflags con (addIdReps args)
+	  (_, args_w_offsets)    = layOutDynConstr hmods con (addIdReps args)
 	--
        ASSERT(not (isUnboxedTupleCon con)) return ()
        mapCs bind_arg args_w_offsets
@@ -417,7 +417,7 @@ static closure, for a constructor.
 cgDataCon :: DataCon -> Code
 cgDataCon data_con
   = do	{     -- Don't need any dynamic closure code for zero-arity constructors
-	  dflags <- getDynFlags
+	  hmods <- getHomeModules
 
 	; let
 	    -- To allow the debuggers, interpreters, etc to cope with
@@ -425,10 +425,10 @@ cgDataCon data_con
 	    -- time), we take care that info-table contains the
 	    -- information we need.
 	    (static_cl_info, _) = 
-		layOutStaticConstr dflags data_con arg_reps
+		layOutStaticConstr hmods data_con arg_reps
 
 	    (dyn_cl_info, arg_things) = 
-		layOutDynConstr    dflags data_con arg_reps
+		layOutDynConstr    hmods data_con arg_reps
 
 	    emit_info cl_info ticky_code
 		= do { code_blks <- getCgStmts the_code
diff --git a/ghc/compiler/codeGen/CgExpr.lhs b/ghc/compiler/codeGen/CgExpr.lhs
index 459f2c011f..33d72f1608 100644
--- a/ghc/compiler/codeGen/CgExpr.lhs
+++ b/ghc/compiler/codeGen/CgExpr.lhs
@@ -1,7 +1,7 @@
 %
 % (c) The GRASP/AQUA Project, Glasgow University, 1992-1998
 %
-% $Id: CgExpr.lhs,v 1.61 2004/11/26 16:20:07 simonmar Exp $
+% $Id: CgExpr.lhs,v 1.62 2005/06/21 10:44:41 simonmar Exp $
 %
 %********************************************************
 %*							*
@@ -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
-	; dflags <- getDynFlags
-	; stmtC (CmmAssign nodeReg (tagToClosure dflags tycon amode'))
+	; hmods <- getHomeModules
+	; stmtC (CmmAssign nodeReg (tagToClosure hmods 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
-	     dflags <- getDynFlags
+	     hmods <- getHomeModules
 	     cgPrimOp [tag_reg] primop args emptyVarSet
-	     stmtC (CmmAssign nodeReg (tagToClosure dflags tycon (CmmReg tag_reg)))
+	     stmtC (CmmAssign nodeReg (tagToClosure hmods 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 dflags <- getDynFlags
-       mkRhsClosure dflags name cc bi srt fvs upd_flag args body
+  = do hmods <- getHomeModules
+       mkRhsClosure hmods 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	dflags bndr cc bi srt
+mkRhsClosure	hmods bndr cc bi srt
 		[the_fv]   		-- Just one free var
 		upd_flag		-- Updatable thunk
 		[]			-- A thunk
@@ -328,7 +328,7 @@ mkRhsClosure	dflags bndr cc bi srt
   where
     lf_info 		  = mkSelectorLFInfo bndr offset_into_int
 				 (isUpdatable upd_flag)
-    (_, params_w_offsets) = layOutDynConstr dflags con (addIdReps params)
+    (_, params_w_offsets) = layOutDynConstr hmods 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 	dflags bndr cc bi srt
+mkRhsClosure 	hmods bndr cc bi srt
 		fvs
 		upd_flag
 		[]			-- No args; a thunk
@@ -377,7 +377,7 @@ mkRhsClosure 	dflags bndr cc bi srt
 The default case
 ~~~~~~~~~~~~~~~~
 \begin{code}
-mkRhsClosure dflags bndr cc bi srt fvs upd_flag args body
+mkRhsClosure hmods bndr cc bi srt fvs upd_flag args body
   = cgRhsClosure bndr cc bi srt fvs upd_flag args body
 \end{code}
 
diff --git a/ghc/compiler/codeGen/CgHeapery.lhs b/ghc/compiler/codeGen/CgHeapery.lhs
index 66bc6f5dcc..78a6f78053 100644
--- a/ghc/compiler/codeGen/CgHeapery.lhs
+++ b/ghc/compiler/codeGen/CgHeapery.lhs
@@ -1,7 +1,7 @@
 %
 % (c) The GRASP/AQUA Project, Glasgow University, 1992-1998
 %
-% $Id: CgHeapery.lhs,v 1.46 2005/04/21 15:28:20 simonmar Exp $
+% $Id: CgHeapery.lhs,v 1.47 2005/06/21 10:44:41 simonmar Exp $
 %
 \section[CgHeapery]{Heap management functions}
 
@@ -54,11 +54,9 @@ import TyCon		( tyConPrimRep )
 import CostCentre	( CostCentreStack )
 import Util		( mapAccumL, filterOut )
 import Constants	( wORD_SIZE )
-import DynFlags	( DynFlags )
+import Packages		( HomeModules )
 import Outputable
 
-import GLAEXTS
-
 \end{code}
 
 
@@ -126,7 +124,7 @@ getHpRelOffset virtual_offset
 
 \begin{code}
 layOutDynConstr, layOutStaticConstr
-	:: DynFlags
+	:: HomeModules
 	-> DataCon 	
 	-> [(CgRep,a)]
 	-> (ClosureInfo,
@@ -135,8 +133,8 @@ layOutDynConstr, layOutStaticConstr
 layOutDynConstr    = layOutConstr False
 layOutStaticConstr = layOutConstr True
 
-layOutConstr  is_static dflags data_con args
-   = (mkConInfo dflags is_static data_con tot_wds ptr_wds,
+layOutConstr  is_static hmods data_con args
+   = (mkConInfo hmods is_static data_con tot_wds ptr_wds,
       things_w_offsets)
   where
     (tot_wds,		 --  #ptr_wds + #nonptr_wds
diff --git a/ghc/compiler/codeGen/CgMonad.lhs b/ghc/compiler/codeGen/CgMonad.lhs
index 4160580f92..4f95c9b36a 100644
--- a/ghc/compiler/codeGen/CgMonad.lhs
+++ b/ghc/compiler/codeGen/CgMonad.lhs
@@ -1,7 +1,7 @@
 %
 % (c) The GRASP/AQUA Project, Glasgow University, 1992-1998
 %
-% $Id: CgMonad.lhs,v 1.44 2005/03/18 13:37:44 simonmar Exp $
+% $Id: CgMonad.lhs,v 1.45 2005/06/21 10:44:41 simonmar Exp $
 %
 \section[CgMonad]{The code generation monad}
 
@@ -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,
+	getState, setState, getInfoDown, getDynFlags, getHomeModules,
 
 	-- more localised access to monad state	
 	getStkUsage, setStkUsage,
@@ -61,7 +61,8 @@ module CgMonad (
 
 import {-# SOURCE #-} CgBindery ( CgBindings, nukeVolatileBinds )
 
-import DynFlags	( DynFlags )
+import DynFlags		( DynFlags )
+import Packages		( HomeModules )
 import Cmm
 import CmmUtils		( CmmStmts, isNopStmt )
 import CLabel
@@ -96,6 +97,7 @@ 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
@@ -103,9 +105,10 @@ data CgInfoDownwards	-- information only passed *downwards* by the monad
 	cgd_eob     :: EndOfBlockInfo	-- Info for stuff to do at end of basic block:
   }
 
-initCgInfoDown :: DynFlags -> Module -> CgInfoDownwards
-initCgInfoDown dflags mod
+initCgInfoDown :: DynFlags -> HomeModules -> Module -> CgInfoDownwards
+initCgInfoDown dflags hmods mod
   = MkCgInfoDown {	cgd_dflags  = dflags,
+			cgd_hmods   = hmods,
 			cgd_mod     = mod,
 			cgd_statics = emptyVarEnv,
 			cgd_srt     = error "initC: srt",
@@ -375,11 +378,11 @@ instance Monad FCode where
 The Abstract~C is not in the environment so as to improve strictness.
 
 \begin{code}
-initC :: DynFlags -> Module -> FCode a -> IO a
+initC :: DynFlags -> HomeModules -> Module -> FCode a -> IO a
 
-initC dflags mod (FCode code)
+initC dflags hmods mod (FCode code)
   = do	{ uniqs <- mkSplitUniqSupply 'c'
-	; case code (initCgInfoDown dflags mod) (initCgState uniqs) of
+	; case code (initCgInfoDown dflags hmods mod) (initCgState uniqs) of
 	      (res, _) -> return res
 	}
 
@@ -507,6 +510,9 @@ getInfoDown = FCode $ \info_down state -> (info_down,state)
 getDynFlags :: FCode DynFlags
 getDynFlags = liftM cgd_dflags getInfoDown
 
+getHomeModules :: FCode HomeModules
+getHomeModules = liftM cgd_hmods getInfoDown
+
 withInfoDown :: FCode a -> CgInfoDownwards -> FCode a
 withInfoDown (FCode fcode) info_down = FCode $ \_ state -> fcode info_down state 
 
diff --git a/ghc/compiler/codeGen/CgTailCall.lhs b/ghc/compiler/codeGen/CgTailCall.lhs
index 9932613b14..f76fcbdce3 100644
--- a/ghc/compiler/codeGen/CgTailCall.lhs
+++ b/ghc/compiler/codeGen/CgTailCall.lhs
@@ -1,7 +1,7 @@
 %
 % (c) The GRASP/AQUA Project, Glasgow University, 1992-1998
 %
-% $Id: CgTailCall.lhs,v 1.42 2005/03/31 10:16:34 simonmar Exp $
+% $Id: CgTailCall.lhs,v 1.43 2005/06/21 10:44:41 simonmar Exp $
 %
 %********************************************************
 %*							*
@@ -118,9 +118,9 @@ performTailCall fun_info arg_amodes pending_assts
 	      opt_node_asst | nodeMustPointToIt lf_info = node_asst
 			    | otherwise		        = noStmts
 	; EndOfBlockInfo sp _ <- getEndOfBlockInfo
-	; dflags <- getDynFlags
+	; hmods <- getHomeModules
 
-	; case (getCallMethod dflags fun_name lf_info (length arg_amodes)) of
+	; case (getCallMethod hmods fun_name lf_info (length arg_amodes)) of
 
 	    -- Node must always point to things we enter
 	    EnterIt -> do
diff --git a/ghc/compiler/codeGen/CgUtils.hs b/ghc/compiler/codeGen/CgUtils.hs
index 67e5973327..b70bd26153 100644
--- a/ghc/compiler/codeGen/CgUtils.hs
+++ b/ghc/compiler/codeGen/CgUtils.hs
@@ -52,7 +52,8 @@ import CLabel		( CLabel, mkStringLitLabel )
 import Digraph		( SCC(..), stronglyConnComp )
 import ListSetOps	( assocDefault )
 import Util		( filterOut, sortLe )
-import DynFlags	( DynFlags(..), HscTarget(..) )
+import DynFlags		( DynFlags(..), HscTarget(..) )
+import Packages		( HomeModules )
 import FastString	( LitString, FastString, unpackFS )
 import Outputable
 
@@ -210,11 +211,11 @@ addToMemE rep ptr n
 --
 -------------------------------------------------------------------------
 
-tagToClosure :: DynFlags -> TyCon -> CmmExpr -> CmmExpr
-tagToClosure dflags tycon tag
+tagToClosure :: HomeModules -> TyCon -> CmmExpr -> CmmExpr
+tagToClosure hmods tycon tag
   = CmmLoad (cmmOffsetExprW closure_tbl tag) wordRep
   where closure_tbl = CmmLit (CmmLabel lbl)
-	lbl = mkClosureTableLabel dflags (tyConName tycon)
+	lbl = mkClosureTableLabel hmods (tyConName tycon)
 
 -------------------------------------------------------------------------
 --
diff --git a/ghc/compiler/codeGen/ClosureInfo.lhs b/ghc/compiler/codeGen/ClosureInfo.lhs
index 423f429ded..48c4ddeda8 100644
--- a/ghc/compiler/codeGen/ClosureInfo.lhs
+++ b/ghc/compiler/codeGen/ClosureInfo.lhs
@@ -62,8 +62,7 @@ import SMRep		-- all of it
 import CLabel
 
 import Constants	( mIN_UPD_SIZE, mIN_SIZE_NonUpdHeapObject )
-import Packages		( isDllName )
-import DynFlags		( DynFlags )
+import Packages		( isDllName, HomeModules )
 import StaticFlags	( opt_SccProfilingOn, opt_OmitBlackHoling,
 			  opt_Parallel, opt_DoTickyProfiling,
 			  opt_SMP )
@@ -332,15 +331,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 :: DynFlags
+mkConInfo :: HomeModules
 	  -> Bool	-- Is static
 	  -> DataCon	
 	  -> Int -> Int	-- Total and pointer words
 	  -> ClosureInfo
-mkConInfo dflags is_static data_con tot_wds ptr_wds
+mkConInfo hmods is_static data_con tot_wds ptr_wds
    = ConInfo {	closureSMRep = sm_rep,
 		closureCon = data_con,
-		closureDllCon = isDllName dflags (dataConName data_con) }
+		closureDllCon = isDllName hmods (dataConName data_con) }
   where
     sm_rep = chooseSMRep is_static (mkConLFInfo data_con) tot_wds ptr_wds
 \end{code}
@@ -572,30 +571,30 @@ data CallMethod
 	CLabel 				--   The code label
 	Int 				--   Its arity
 
-getCallMethod :: DynFlags
+getCallMethod :: HomeModules
 	      -> Name		-- Function being applied
 	      -> LambdaFormInfo	-- Its info
 	      -> Int		-- Number of available arguments
 	      -> CallMethod
 
-getCallMethod dflags name lf_info n_args
+getCallMethod hmods 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 dflags name (LFReEntrant _ arity _ _) n_args
+getCallMethod hmods 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 dflags name) arity
+  | otherwise      = DirectEntry (enterIdLabel hmods name) arity
 
-getCallMethod dflags name (LFCon con) n_args
+getCallMethod hmods name (LFCon con) n_args
   = ASSERT( n_args == 0 )
     ReturnCon con
 
-getCallMethod dflags name (LFThunk _ _ updatable std_form_info is_fun) n_args
+getCallMethod hmods 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]
@@ -608,24 +607,24 @@ getCallMethod dflags 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 dflags name std_form_info updatable)
+    JumpToIt (thunkEntryLabel hmods name std_form_info updatable)
 
-getCallMethod dflags name (LFUnknown True) n_args
+getCallMethod hmods name (LFUnknown True) n_args
   = SlowCall -- might be a function
 
-getCallMethod dflags name (LFUnknown False) n_args
+getCallMethod hmods name (LFUnknown False) n_args
   = ASSERT2 ( n_args == 0, ppr name <+> ppr n_args ) 
     EnterIt -- Not a function
 
-getCallMethod dflags name (LFBlackHole _) n_args
+getCallMethod hmods 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 dflags name (LFLetNoEscape 0) n_args
+getCallMethod hmods name (LFLetNoEscape 0) n_args
   = JumpToIt (enterReturnPtLabel (nameUnique name))
 
-getCallMethod dflags name (LFLetNoEscape arity) n_args
+getCallMethod hmods name (LFLetNoEscape arity) n_args
   | n_args == arity = DirectEntry (enterReturnPtLabel (nameUnique name)) arity
   | otherwise = pprPanic "let-no-escape: " (ppr name <+> ppr arity)
 
@@ -855,12 +854,12 @@ closureLabelFromCI _ = panic "closureLabelFromCI"
 -- thunkEntryLabel is a local help function, not exported.  It's used from both
 -- entryLabelFromCI and getCallMethod.
 
-thunkEntryLabel dflags thunk_id (ApThunk arity) is_updatable
+thunkEntryLabel hmods thunk_id (ApThunk arity) is_updatable
   = enterApLabel is_updatable arity
-thunkEntryLabel dflags thunk_id (SelectorThunk offset) upd_flag
+thunkEntryLabel hmods thunk_id (SelectorThunk offset) upd_flag
   = enterSelectorLabel upd_flag offset
-thunkEntryLabel dflags thunk_id _ is_updatable
-  = enterIdLabel dflags thunk_id
+thunkEntryLabel hmods thunk_id _ is_updatable
+  = enterIdLabel hmods thunk_id
 
 enterApLabel is_updatable arity
   | tablesNextToCode = mkApInfoTableLabel is_updatable arity
@@ -870,9 +869,9 @@ enterSelectorLabel upd_flag offset
   | tablesNextToCode = mkSelectorInfoLabel upd_flag offset
   | otherwise        = mkSelectorEntryLabel upd_flag offset
 
-enterIdLabel dflags id
-  | tablesNextToCode = mkInfoTableLabel dflags id
-  | otherwise        = mkEntryLabel dflags id
+enterIdLabel hmods id
+  | tablesNextToCode = mkInfoTableLabel hmods id
+  | otherwise        = mkEntryLabel hmods id
 
 enterLocalIdLabel id
   | tablesNextToCode = mkLocalInfoTableLabel id
diff --git a/ghc/compiler/codeGen/CodeGen.lhs b/ghc/compiler/codeGen/CodeGen.lhs
index 1aa48656f5..1ea944c2c0 100644
--- a/ghc/compiler/codeGen/CodeGen.lhs
+++ b/ghc/compiler/codeGen/CodeGen.lhs
@@ -29,7 +29,7 @@ import CgBindery	( CgIdInfo, addBindC, addBindsC, getCgIdInfo,
 			  cgIdInfoId )
 import CgClosure	( cgTopRhsClosure )
 import CgCon		( cgTopRhsCon, cgTyCon )
-import CgUtils		( cmmRegOffW, emitRODataLits, cmmNeWord, emitRtsCall )
+import CgUtils		( cmmRegOffW, emitRODataLits, cmmNeWord )
 
 import CLabel
 import Cmm
@@ -39,6 +39,7 @@ import MachOp		( wordRep, MachHint(..) )
 
 import StgSyn
 import PrelNames	( gHC_PRIM, rOOT_MAIN, mAIN, pREL_TOP_HANDLER )
+import Packages		( HomeModules )
 import DynFlags		( DynFlags(..), DynFlag(..), dopt )
 import StaticFlags	( opt_SccProfilingOn )
 
@@ -59,6 +60,7 @@ import Outputable
 
 \begin{code}
 codeGen :: DynFlags
+	-> HomeModules
 	-> Module
 	-> [TyCon]
 	-> ForeignStubs
@@ -67,7 +69,7 @@ codeGen :: DynFlags
 	-> [(StgBinding,[(Id,[Id])])]	-- Bindings to convert, with SRTs
 	-> IO [Cmm]		-- Output
 
-codeGen dflags this_mod data_tycons foreign_stubs imported_mods 
+codeGen dflags hmods this_mod data_tycons foreign_stubs imported_mods 
 	cost_centre_info stg_binds
   = do	
   { showPass dflags "CodeGen"
@@ -77,10 +79,10 @@ codeGen dflags this_mod data_tycons foreign_stubs imported_mods
 -- Why?
 --   ; mapM_ (\x -> seq x (return ())) data_tycons
 
-  ; code_stuff <- initC dflags this_mod $ do 
-		{ cmm_binds  <- mapM (getCmm . cgTopBinding dflags) stg_binds
+  ; code_stuff <- initC dflags hmods this_mod $ do 
+		{ cmm_binds  <- mapM (getCmm . cgTopBinding dflags hmods) stg_binds
 		; cmm_tycons <- mapM cgTyCon data_tycons
-		; cmm_init   <- getCmm (mkModuleInit dflags way cost_centre_info 
+		; cmm_init   <- getCmm (mkModuleInit dflags hmods way cost_centre_info 
 					     this_mod mb_main_mod
 				  	     foreign_stubs imported_mods)
 		; return (cmm_binds ++ concat cmm_tycons ++ [cmm_init])
@@ -141,6 +143,7 @@ We initialise the module tree by keeping a work-stack,
 \begin{code}
 mkModuleInit 
 	:: DynFlags
+	-> HomeModules
 	-> String		-- the "way"
 	-> CollectedCCs         -- cost centre info
 	-> Module
@@ -148,7 +151,7 @@ mkModuleInit
 	-> ForeignStubs
 	-> [Module]
 	-> Code
-mkModuleInit dflags way cost_centre_info this_mod mb_main_mod foreign_stubs imported_mods
+mkModuleInit dflags hmods way cost_centre_info this_mod mb_main_mod foreign_stubs imported_mods
   = do	{ 	
         if opt_SccProfilingOn
             then do { -- Allocate the static boolean that records if this
@@ -181,9 +184,9 @@ mkModuleInit dflags way cost_centre_info this_mod mb_main_mod foreign_stubs impo
 		(emitSimpleProc plain_main_init_lbl jump_to_init)
     }
   where
-    plain_init_lbl = mkPlainModuleInitLabel dflags this_mod
-    real_init_lbl  = mkModuleInitLabel dflags this_mod way
-    plain_main_init_lbl = mkPlainModuleInitLabel dflags rOOT_MAIN
+    plain_init_lbl = mkPlainModuleInitLabel hmods this_mod
+    real_init_lbl  = mkModuleInitLabel hmods this_mod way
+    plain_main_init_lbl = mkPlainModuleInitLabel hmods rOOT_MAIN
 
     jump_to_init = stmtC (CmmJump (mkLblExpr real_init_lbl) [])
 
@@ -205,7 +208,7 @@ mkModuleInit dflags way cost_centre_info this_mod mb_main_mod foreign_stubs impo
 
 		-- Now do local stuff
 	; initCostCentres cost_centre_info
-	; mapCs (registerModuleImport dflags way) 
+	; mapCs (registerModuleImport hmods way) 
 		(imported_mods++extra_imported_mods)
 	} 
 
@@ -215,13 +218,13 @@ mkModuleInit dflags way cost_centre_info this_mod mb_main_mod foreign_stubs impo
                       , CmmJump (CmmLoad (cmmRegOffW spReg (-1)) wordRep) [] ]
 
 -----------------------
-registerModuleImport :: DynFlags -> String -> Module -> Code
-registerModuleImport dflags way mod 
+registerModuleImport :: HomeModules -> String -> Module -> Code
+registerModuleImport hmods 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 dflags mod way)) ]
+	   , CmmStore (CmmReg spReg) (mkLblExpr (mkModuleInitLabel hmods mod way)) ]
 \end{code}
 
 
@@ -262,32 +265,32 @@ style, with the increasing static environment being plumbed as a state
 variable.
 
 \begin{code}
-cgTopBinding :: DynFlags -> (StgBinding,[(Id,[Id])]) -> Code
-cgTopBinding dflags (StgNonRec id rhs, srts)
+cgTopBinding :: DynFlags -> HomeModules -> (StgBinding,[(Id,[Id])]) -> Code
+cgTopBinding dflags hmods (StgNonRec id rhs, srts)
   = do	{ id' <- maybeExternaliseId dflags id
-	; mapM_ (mkSRT dflags [id']) srts
+	; mapM_ (mkSRT hmods [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 (StgRec pairs, srts)
+cgTopBinding dflags hmods (StgRec pairs, srts)
   = do	{ let (bndrs, rhss) = unzip pairs
 	; bndrs' <- mapFCs (maybeExternaliseId dflags) bndrs
 	; let pairs' = zip bndrs' rhss
-	; mapM_ (mkSRT dflags bndrs')  srts
+	; mapM_ (mkSRT hmods bndrs')  srts
 	; _new_binds <- fixC (\ new_binds -> do 
 		{ addBindsC new_binds
 		; mapFCs ( \ (b,e) -> cgTopRhs b e ) pairs' })
 	; nopC }
 
-mkSRT :: DynFlags -> [Id] -> (Id,[Id]) -> Code
-mkSRT dflags these (id,[])  = nopC
-mkSRT dflags these (id,ids)
+mkSRT :: HomeModules -> [Id] -> (Id,[Id]) -> Code
+mkSRT hmods these (id,[])  = nopC
+mkSRT hmods these (id,ids)
   = do	{ ids <- mapFCs remap ids
 	; id  <- remap id
 	; emitRODataLits (mkSRTLabel (idName id)) 
-		       (map (CmmLabel . mkClosureLabel dflags . idName) ids)
+		       (map (CmmLabel . mkClosureLabel hmods . idName) ids)
 	}
   where
 	-- Sigh, better map all the ids against the environment in