[project @ 2003-07-09 11:06:31 by simonpj]

--------------------------
	Fix two External-Core bugs
	--------------------------

1.  An inadvertent "let x = ...x..." bug in TcRnDriver

2.  Adjust the new -main-is story, so that the root module is called
	":Main" instead of "$Main".
    This means that the z-encoded module name is "ZCMain" rather than "zdMain",
    which in keeps the External-Core lexer happy.  And is more consistent generally.

3.  Make the renamer happy to see definitions from modules other than the "home" one,
    when doing External Core.  In the main module, there'll be a definition for
    ZCMain.main.

4 files changed, 41 insertions, 23 deletions

diff --git a/ghc/compiler/codeGen/CodeGen.lhs b/ghc/compiler/codeGen/CodeGen.lhs
index 8606ff9116..5b01138cd8 100644
--- a/ghc/compiler/codeGen/CodeGen.lhs
+++ b/ghc/compiler/codeGen/CodeGen.lhs
@@ -28,7 +28,7 @@ import DriverState	( v_Build_tag, v_MainModIs )
 import StgSyn
 import CgMonad
 import AbsCSyn
-import PrelNames	( gHC_PRIM, dOLLAR_MAIN, mAIN_Name )
+import PrelNames	( gHC_PRIM, rOOT_MAIN, mAIN_Name )
 import CLabel		( mkSRTLabel, mkClosureLabel, 
 			  mkPlainModuleInitLabel, mkModuleInitLabel )
 import PprAbsC		( dumpRealC )
@@ -148,7 +148,7 @@ mkModuleInit way cost_centre_info this_mod mb_main_mod foreign_stubs imported_mo
 	register_mod_imports = map mk_import_register imported_mods
 
 	-- When compiling the module in which the 'main' function lives,
-	-- we inject an extra stg_init procedure for stg_init_zdMain, for the 
+	-- 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
 	main_mod_name = case mb_main_mod of
@@ -158,7 +158,7 @@ mkModuleInit way cost_centre_info this_mod mb_main_mod foreign_stubs imported_mo
 	  | Module.moduleName this_mod /= main_mod_name 
   	  = AbsCNop	-- The normal case
 	  | otherwise	-- this_mod contains the main function
-	  = CCodeBlock (mkPlainModuleInitLabel dOLLAR_MAIN)
+	  = CCodeBlock (mkPlainModuleInitLabel rOOT_MAIN)
 		       (CJump (CLbl (mkPlainModuleInitLabel this_mod) CodePtrRep))
 			     
     in
diff --git a/ghc/compiler/prelude/PrelNames.lhs b/ghc/compiler/prelude/PrelNames.lhs
index 2ecfaa57dd..a77a4db7af 100644
--- a/ghc/compiler/prelude/PrelNames.lhs
+++ b/ghc/compiler/prelude/PrelNames.lhs
@@ -299,9 +299,13 @@ pRELUDE		= mkBasePkgModule pRELUDE_Name
 -- MetaHaskell Extension  text2 from Meta/work/gen.hs
 mETA_META_Name   = mkModuleName "Language.Haskell.THSyntax"
 
-dOLLAR_MAIN_Name = mkModuleName "$Main"		-- Root module for initialisation 
-dOLLAR_MAIN	 = mkHomeModule dOLLAR_MAIN_Name
-iNTERACTIVE      = mkHomeModule (mkModuleName "$Interactive")
+rOOT_MAIN_Name = mkModuleName ":Main"		-- Root module for initialisation 
+rOOT_MAIN      = mkHomeModule rOOT_MAIN_Name	
+	-- The ':xxx' makes a moudle name that the user can never
+	-- use himself.  The z-encoding for ':' is "ZC", so the z-encoded
+	-- module name still starts with a capital letter, which keeps
+	-- the z-encoded version consistent.
+iNTERACTIVE    = mkHomeModule (mkModuleName ":Interactive")
 \end{code}
 
 %************************************************************************
@@ -474,8 +478,8 @@ and it's convenient to write them all down in one place.
 
 
 \begin{code}
-dollarMainName = varQual dOLLAR_MAIN_Name FSLIT("main") dollarMainKey
-runIOName      = varQual pREL_TOP_HANDLER_Name FSLIT("runIO") runMainKey
+rootMainName = varQual rOOT_MAIN_Name FSLIT("main") rootMainKey
+runIOName    = varQual pREL_TOP_HANDLER_Name FSLIT("runIO") runMainKey
 
 -- Stuff from GHC.Prim
 superKindName    = kindQual FSLIT("KX") kindConKey
@@ -978,7 +982,7 @@ otherwiseIdKey		      = mkPreludeMiscIdUnique 51
 assertIdKey		      = mkPreludeMiscIdUnique 53
 runSTRepIdKey		      = mkPreludeMiscIdUnique 54
 
-dollarMainKey		      = mkPreludeMiscIdUnique 55
+rootMainKey		      = mkPreludeMiscIdUnique 55
 runMainKey		      = mkPreludeMiscIdUnique 56
 
 andIdKey		      = mkPreludeMiscIdUnique 57
diff --git a/ghc/compiler/rename/RnEnv.lhs b/ghc/compiler/rename/RnEnv.lhs
index e08a8c0c8d..255356cd00 100644
--- a/ghc/compiler/rename/RnEnv.lhs
+++ b/ghc/compiler/rename/RnEnv.lhs
@@ -40,7 +40,8 @@ import PrelNames	( mkUnboundName, intTyConName,
 			  boolTyConName, funTyConName,
 			  unpackCStringName, unpackCStringFoldrName, unpackCStringUtf8Name,
 			  eqStringName, printName, integerTyConName,
-			  bindIOName, returnIOName, failIOName, thenIOName
+			  bindIOName, returnIOName, failIOName, thenIOName,
+			  rOOT_MAIN_Name
 			)
 #ifdef GHCI	
 import DsMeta		( templateHaskellNames, qTyConName )
@@ -70,11 +71,24 @@ newTopBinder mod rdr_name loc
   | Just name <- isExact_maybe rdr_name
   = returnM name
 
-  | otherwise
-  = ASSERT( not (isOrig rdr_name) || rdrNameModule rdr_name == moduleName mod )
+  | isOrig rdr_name
+  = ASSERT( rdr_mod == moduleName mod || rdr_mod == rOOT_MAIN_Name )
 	-- When reading External Core we get Orig names as binders, 
 	-- but they should agree with the module gotten from the monad
-    newGlobalName mod (rdrNameOcc rdr_name) loc
+	--
+	-- Except for the ":Main.main = ..." definition inserted into 
+	-- the Main module
+	--
+	-- Because of this latter case, we take the module from the RdrName,
+	-- not from the environment.  In principle, it'd be fine to have an
+	-- arbitrary mixture of external core definitions in a single module,
+	-- (apart from module-initialisation issues, perhaps).
+    newGlobalName (mkHomeModule rdr_mod) (rdrNameOcc rdr_name) loc
+
+  | otherwise
+  = newGlobalName mod (rdrNameOcc rdr_name) loc
+  where
+    rdr_mod = rdrNameModule rdr_name
 
 newGlobalName :: Module -> OccName -> SrcLoc -> TcRn m Name
 newGlobalName mod occ loc
diff --git a/ghc/compiler/typecheck/TcRnDriver.lhs b/ghc/compiler/typecheck/TcRnDriver.lhs
index c127b2c6b0..463ff1da7a 100644
--- a/ghc/compiler/typecheck/TcRnDriver.lhs
+++ b/ghc/compiler/typecheck/TcRnDriver.lhs
@@ -33,7 +33,7 @@ import RdrHsSyn		( RdrNameHsModule, RdrNameHsDecl, RdrNameStmt, RdrNameHsExpr,
 
 import PrelNames	( iNTERACTIVE, ioTyConName, printName, monadNames,
 			  returnIOName, runIOName, 
-			  dollarMainName, itName, mAIN_Name, unsafeCoerceName
+			  rootMainName, itName, mAIN_Name, unsafeCoerceName
 			)
 import RdrName		( RdrName, getRdrName, mkRdrUnqual, 
 			  lookupRdrEnv, elemRdrEnv )
@@ -64,7 +64,7 @@ import TcRules		( tcRules )
 import TcForeign	( tcForeignImports, tcForeignExports )
 import TcIfaceSig	( tcInterfaceSigs, tcCoreBinds )
 import TcInstDcls	( tcInstDecls1, tcIfaceInstDecls, tcInstDecls2 )
-import TcSimplify	( tcSimplifyTop, tcSimplifyInfer )
+import TcSimplify	( tcSimplifyTop, tcSimplifyInteractive, tcSimplifyInfer )
 import TcTyClsDecls	( tcTyAndClassDecls )
 
 import RnNames		( importsFromLocalDecls, rnImports, exportsFromAvail, 
@@ -425,7 +425,7 @@ tc_stmts stmts
 	-- and then			let it = e
 	-- It's the simplify step that rejects the first.
 	traceTc (text "tcs 3") ;
-	const_binds <- tcSimplifyTop lie ;
+	const_binds <- tcSimplifyInteractive lie ;
 
 	-- Build result expression and zonk it
 	let { expr = mkHsLet const_binds tc_expr } ;
@@ -461,7 +461,7 @@ tcRnExpr hsc_env pcs ictxt rdr_expr
 	-- it might have a rank-2 type (e.g. :t runST)
     ((tc_expr, res_ty), lie)	   <- getLIE (tcInferRho rn_expr) ;
     ((qtvs, _, dict_ids), lie_top) <- getLIE (tcSimplifyInfer smpl_doc (tyVarsOfType res_ty) lie)  ;
-    tcSimplifyTop lie_top ;
+    tcSimplifyInteractive lie_top ;
 
     let { all_expr_ty = mkForAllTys qtvs 		$
     		        mkFunTys (map idType dict_ids)	$
@@ -556,13 +556,13 @@ tcRnExtCore hsc_env pcs (HsModule (Just this_mod) _ _ decls _ loc)
 	-- rnSrcDecls handles fixity decls etc too, which won't occur
 	-- but that doesn't matter
    let { local_group = mkGroup decls } ;
-   (_, rn_decls, dus) <- initRn (InterfaceMode this_mod) 
-				      (rnSrcDecls local_group) ;
+   (_, rn_src_decls, dus) <- initRn (InterfaceMode this_mod) 
+				    (rnSrcDecls local_group) ;
    failIfErrsM ;
 
  	-- Get the supporting decls
    rn_imp_decls <- slurpImpDecls (duUses dus) ;
-   let { rn_decls = rn_decls `addImpDecls` rn_imp_decls } ;
+   let { rn_decls = rn_src_decls `addImpDecls` rn_imp_decls } ;
 
 	-- Dump trace of renaming part
    rnDump (ppr rn_decls) ;
@@ -1159,12 +1159,12 @@ check_main ghci_mode tcg_env main_mod main_fn
 	addErrCtxt mainCtxt		$
 	setGblEnv tcg_env 		$ do {
 	
-	-- $main :: IO () = runIO main
+	-- :Main.main :: IO () = runIO main
 	let { rhs = HsApp (HsVar runIOName) (HsVar main_name) } ;
 	(main_expr, ty) <- tcInferRho rhs ;
 
-	let { dollar_main_id = setIdLocalExported (mkLocalId dollarMainName ty) ;
-	      main_bind      = VarMonoBind dollar_main_id main_expr ;
+	let { root_main_id = setIdLocalExported (mkLocalId rootMainName ty) ;
+	      main_bind      = VarMonoBind root_main_id main_expr ;
 	      tcg_env' 	     = tcg_env { tcg_binds = tcg_binds tcg_env 
 						     `andMonoBinds` main_bind } } ;