[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.

1 files changed, 25 insertions, 22 deletions

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