[project @ 2004-11-26 16:19:45 by simonmar]

Further integration with the new package story.  GHC now supports
pretty much everything in the package proposal.

  - GHC now works in terms of PackageIds (<pkg>-<version>) rather than
    just package names.  You can still specify package names without
    versions on the command line, as long as the name is unambiguous.

  - GHC understands hidden/exposed modules in a package, and will refuse
    to import a hidden module.  Also, the hidden/eposed status of packages
    is taken into account.

  - I had to remove the old package syntax from ghc-pkg, backwards
    compatibility isn't really practical.

  - All the package.conf.in files have been rewritten in the new syntax,
    and contain a complete list of modules in the package.  I've set all
    the versions to 1.0 for now - please check your package(s) and fix the
    version number & other info appropriately.

  - New options:

	-hide-package P    sets the expose flag on package P to False
	-ignore-package P  unregisters P for this compilation

	For comparison, -package P sets the expose flag on package P
        to True, and also causes P to be linked in eagerly.

        -package-name is no longer officially supported.  Unofficially, it's
	a synonym for -ignore-package, which has more or less the same effect
	as -package-name used to.

	Note that a package may be hidden and yet still be linked into
	the program, by virtue of being a dependency of some other package.
	To completely remove a package from the compiler's internal database,
        use -ignore-package.

	The compiler will complain if any two packages in the
        transitive closure of exposed packages contain the same
        module.

	You *must* use -ignore-package P when compiling modules for
        package P, if package P (or an older version of P) is already
        registered.  The compiler will helpfully complain if you don't.
	The fptools build system does this.

   - Note: the Cabal library won't work yet.  It still thinks GHC uses
     the old package config syntax.

Internal changes/cleanups:

   - The ModuleName type has gone away.  Modules are now just (a
     newtype of) FastStrings, and don't contain any package information.
     All the package-related knowledge is in DynFlags, which is passed
     down to where it is needed.

   - DynFlags manipulation has been cleaned up somewhat: there are no
     global variables holding DynFlags any more, instead the DynFlags
     are passed around properly.

   - There are a few less global variables in GHC.  Lots more are
     scheduled for removal.

   - -i is now a dynamic flag, as are all the package-related flags (but
     using them in {-# OPTIONS #-} is Officially Not Recommended).

   - make -j now appears to work under fptools/libraries/.  Probably
     wouldn't take much to get it working for a whole build.

1 files changed, 40 insertions, 39 deletions

diff --git a/ghc/compiler/codeGen/CodeGen.lhs b/ghc/compiler/codeGen/CodeGen.lhs
index 7ee581a45f..056fb1ef50 100644
--- a/ghc/compiler/codeGen/CodeGen.lhs
+++ b/ghc/compiler/codeGen/CodeGen.lhs
@@ -33,15 +33,14 @@ import CgClosure	( cgTopRhsClosure )
 import CgCon		( cgTopRhsCon, cgTyCon )
 import CgUtils		( cmmRegOffW, emitRODataLits, cmmNeWord, emitRtsCall )
 
-import CLabel		( mkSRTLabel, mkClosureLabel, moduleRegdLabel,
-			  mkPlainModuleInitLabel, mkModuleInitLabel )
+import CLabel
 import Cmm
 import CmmUtils		( zeroCLit, mkIntCLit, mkLblExpr )
 import PprCmm		( pprCmms )
 import MachOp		( wordRep, MachHint(..) )
 
 import StgSyn
-import PrelNames	( gHC_PRIM, rOOT_MAIN, mAIN_Name, pREL_TOP_HANDLER )
+import PrelNames	( gHC_PRIM, rOOT_MAIN, mAIN, pREL_TOP_HANDLER )
 import CmdLineOpts	( DynFlags, DynFlag(..), opt_EnsureSplittableC,
 			  opt_SccProfilingOn )
 
@@ -51,10 +50,9 @@ import Id               ( Id, idName, setIdName )
 import Name		( nameSrcLoc, nameOccName, nameUnique, isInternalName, mkExternalName )
 import OccName		( mkLocalOcc )
 import TyCon            ( isDataTyCon )
-import Module		( Module, mkModuleName )
+import Module		( Module, mkModule )
 import ErrUtils		( dumpIfSet_dyn, showPass )
 import Panic		( assertPanic )
-import qualified Module ( moduleName )
 
 #ifdef DEBUG
 import Outputable
@@ -86,14 +84,14 @@ codeGen dflags this_mod type_env foreign_stubs imported_mods
 -- Why?
 --   ; mapM_ (\x -> seq x (return ())) data_tycons
 
-  ; code_stuff <- initC this_mod $ do 
-			{ cmm_binds  <- mapM (getCmm . cgTopBinding) stg_binds
-			; cmm_tycons <- mapM cgTyCon data_tycons
-			; cmm_init   <- getCmm (mkModuleInit way cost_centre_info 
-						     this_mod mb_main_mod
-					  	     foreign_stubs imported_mods)
-			; return (cmm_binds ++ concat cmm_tycons ++ [cmm_init]) 
-			}
+  ; 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 way cost_centre_info 
+					     this_mod mb_main_mod
+				  	     foreign_stubs imported_mods)
+		; return (cmm_binds ++ concat cmm_tycons ++ [cmm_init]) 
+		}
 		-- Put datatype_stuff after code_stuff, because the
 		-- datatype closure table (for enumeration types) to
 		-- (say) PrelBase_True_closure, which is defined in
@@ -149,14 +147,15 @@ We initialise the module tree by keeping a work-stack,
 
 \begin{code}
 mkModuleInit 
-	:: String		-- the "way"
+	:: DynFlags
+	-> String		-- the "way"
 	-> CollectedCCs         -- cost centre info
 	-> Module
 	-> Maybe String		-- Just m ==> we have flag: -main-is Foo.baz 
 	-> ForeignStubs
 	-> [Module]
 	-> Code
-mkModuleInit way cost_centre_info this_mod mb_main_mod foreign_stubs imported_mods
+mkModuleInit dflags way cost_centre_info this_mod mb_main_mod foreign_stubs imported_mods
   = do	{ 	
 
 	-- Allocate the static boolean that records if this
@@ -184,31 +183,31 @@ mkModuleInit way cost_centre_info this_mod mb_main_mod foreign_stubs imported_mo
 	; emitSimpleProc plain_init_lbl jump_to_init
 
 	-- When compiling the module in which the 'main' function lives,
-	-- (that is, Module.moduleName this_mod == main_mod_name)
+	-- (that is, this_mod == main_mod)
 	-- we inject an extra stg_init procedure for stg_init_ZCMain, for the 
 	-- RTS to invoke.  We must consult the -main-is flag in case the
 	-- user specified a different function to Main.main
-	; whenC (Module.moduleName this_mod == main_mod_name)
+	; whenC (this_mod == main_mod)
 		(emitSimpleProc plain_main_init_lbl jump_to_init)
     }
   where
-    plain_init_lbl = mkPlainModuleInitLabel this_mod
-    real_init_lbl  = mkModuleInitLabel this_mod way
-    plain_main_init_lbl = mkPlainModuleInitLabel rOOT_MAIN
+    plain_init_lbl = mkPlainModuleInitLabel dflags this_mod
+    real_init_lbl  = mkModuleInitLabel dflags this_mod way
+    plain_main_init_lbl = mkPlainModuleInitLabel dflags rOOT_MAIN
 
     jump_to_init = stmtC (CmmJump (mkLblExpr real_init_lbl) [])
 
     mod_reg_val = CmmLoad (mkLblExpr moduleRegdLabel) wordRep
 
-    main_mod_name = case mb_main_mod of
-			Just mod_name -> mkModuleName mod_name
-			Nothing	      -> mAIN_Name
+    main_mod = case mb_main_mod of
+			Just mod_name -> mkModule mod_name
+			Nothing	      -> mAIN
 
     -- Main refers to GHC.TopHandler.runIO, so make sure we call the
     -- init function for GHC.TopHandler.
     extra_imported_mods
-	| Module.moduleName this_mod == main_mod_name = [pREL_TOP_HANDLER]
-	| otherwise			 	      = []
+	| this_mod == main_mod = [pREL_TOP_HANDLER]
+	| otherwise	       = []
 
     mod_init_code = do
 	{ 	-- Set mod_reg to 1 to record that we've been here
@@ -217,18 +216,19 @@ mkModuleInit way cost_centre_info this_mod mb_main_mod foreign_stubs imported_mo
 		-- Now do local stuff
 	; registerForeignExports foreign_stubs
 	; initCostCentres cost_centre_info
-	; mapCs (registerModuleImport way) (imported_mods++extra_imported_mods)
+	; mapCs (registerModuleImport dflags way) 
+		(imported_mods++extra_imported_mods)
 	} 
 
 
 -----------------------
-registerModuleImport :: String -> Module -> Code
-registerModuleImport way mod 
+registerModuleImport :: DynFlags -> String -> Module -> Code
+registerModuleImport dflags 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 mod way)) ]
+	   , CmmStore (CmmReg spReg) (mkLblExpr (mkModuleInitLabel dflags mod way)) ]
 
 -----------------------
 registerForeignExports :: ForeignStubs -> Code
@@ -239,7 +239,8 @@ registerForeignExports (ForeignStubs _ _ _ fe_bndrs)
   where
 	mk_export_register bndr
 	  = emitRtsCall SLIT("getStablePtr") 
-		[ (CmmLit (CmmLabel (mkClosureLabel (idName bndr))), PtrHint) ]
+		[ (CmmLit (CmmLabel (mkLocalClosureLabel (idName bndr))), 
+		   PtrHint) ]
 \end{code}
 
 
@@ -280,32 +281,32 @@ style, with the increasing static environment being plumbed as a state
 variable.
 
 \begin{code}
-cgTopBinding :: (StgBinding,[(Id,[Id])]) -> Code
-cgTopBinding (StgNonRec id rhs, srts)
+cgTopBinding :: DynFlags -> (StgBinding,[(Id,[Id])]) -> Code
+cgTopBinding dflags (StgNonRec id rhs, srts)
   = do	{ id' <- maybeExternaliseId id
-	; mapM_ (mkSRT [id']) srts
+	; mapM_ (mkSRT 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 (StgRec pairs, srts)
+cgTopBinding dflags (StgRec pairs, srts)
   = do	{ let (bndrs, rhss) = unzip pairs
 	; bndrs' <- mapFCs maybeExternaliseId bndrs
 	; let pairs' = zip bndrs' rhss
-	; mapM_ (mkSRT bndrs')  srts
+	; mapM_ (mkSRT dflags bndrs')  srts
 	; new_binds <- fixC (\ new_binds -> do 
 		{ addBindsC new_binds
 		; mapFCs ( \ (b,e) -> cgTopRhs b e ) pairs' })
 	; nopC }
 
-mkSRT :: [Id] -> (Id,[Id]) -> Code
-mkSRT these (id,[])  = nopC
-mkSRT these (id,ids)
+mkSRT :: DynFlags -> [Id] -> (Id,[Id]) -> Code
+mkSRT dflags these (id,[])  = nopC
+mkSRT dflags these (id,ids)
   = do	{ ids <- mapFCs remap ids
 	; id  <- remap id
 	; emitRODataLits (mkSRTLabel (idName id)) 
-		       (map (CmmLabel . mkClosureLabel . idName) ids)
+		       (map (CmmLabel . mkClosureLabel dflags . idName) ids)
 	}
   where
 	-- Sigh, better map all the ids against the environment in