From: simonpj <unknown>
Date: Mon, 25 Jul 2005 11:08:27 +0000 (+0000)
Subject: [project @ 2005-07-25 11:08:26 by simonpj]
X-Git-Tag: Initial_conversion_from_CVS_complete~330
X-Git-Url: http://git.megacz.com/?a=commitdiff_plain;h=70349c3260ae22b3e46657150ce144f5de99d8d2;p=ghc-hetmet.git

[project @ 2005-07-25 11:08:26 by simonpj]
MERGE TO STABLE if poss

Make the "root main" Id :Main.main into an *implicit* Id, whose parent is
Main.main.  What that means is that the "root main" Id won't be emitted
into the interface file.  Which has not been causing a problem in practice
but is clearly wrong -- there were two 'main's in the interface file.
---

diff --git a/ghc/compiler/prelude/PrelNames.lhs b/ghc/compiler/prelude/PrelNames.lhs
index 13b862a..0d7d558 100644
--- a/ghc/compiler/prelude/PrelNames.lhs
+++ b/ghc/compiler/prelude/PrelNames.lhs
@@ -268,7 +268,7 @@ rANDOM		= mkModule "System.Random"
 
 gLA_EXTS	= mkModule "GHC.Exts"
 rOOT_MAIN	= mkModule ":Main"		-- Root module for initialisation 
-	-- The ':xxx' makes a moudle name that the user can never
+	-- The ':xxx' makes a module 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.
@@ -435,7 +435,6 @@ and it's convenient to write them all down in one place.
 
 
 \begin{code}
-rootMainName  = varQual rOOT_MAIN FSLIT("main") rootMainKey
 runMainIOName = varQual pREL_TOP_HANDLER FSLIT("runMainIO") runMainKey
 
 orderingTyConName = tcQual   pREL_BASE FSLIT("Ordering") orderingTyConKey
diff --git a/ghc/compiler/typecheck/TcRnDriver.lhs b/ghc/compiler/typecheck/TcRnDriver.lhs
index 8e427fe..c9f03c3 100644
--- a/ghc/compiler/typecheck/TcRnDriver.lhs
+++ b/ghc/compiler/typecheck/TcRnDriver.lhs
@@ -33,7 +33,7 @@ import HsSyn		( HsModule(..), HsExtCore(..), HsGroup(..), LHsDecl,
 			  nlHsApp, nlHsVar, pprLHsBinds )
 import RdrHsSyn		( findSplice )
 
-import PrelNames	( runMainIOName, rootMainName, mAIN,
+import PrelNames	( runMainIOName, rootMainKey, rOOT_MAIN, mAIN,
 			  main_RDR_Unqual )
 import RdrName		( RdrName, mkRdrUnqual, emptyGlobalRdrEnv )
 import TcHsSyn		( zonkTopDecls )
@@ -63,8 +63,9 @@ import ErrUtils		( Messages, mkDumpDoc, showPass )
 import Id		( Id, mkExportedLocalId, isLocalId, idName, idType )
 import Var		( Var )
 import Module           ( Module, ModuleEnv, mkModule, moduleEnvElts, elemModuleEnv )
-import OccName		( mkVarOcc )
-import Name		( Name, NamedThing(..), isExternalName, getSrcLoc, isWiredInName )
+import OccName		( mkVarOcc, mkOccFS, varName )
+import Name		( Name, NamedThing(..), isExternalName, getSrcLoc, isWiredInName,
+			  mkExternalName )
 import NameSet
 import TyCon		( tyConHasGenerics, isSynTyCon, getSynTyConDefn, tyConKind )
 import SrcLoc		( srcLocSpan, Located(..), noLoc )
@@ -83,7 +84,7 @@ import Outputable
 #ifdef GHCI
 import HsSyn		( HsStmtContext(..), Stmt(..), HsExpr(..), 
 			  HsLocalBinds(..), HsValBinds(..),
-			  LStmt, LHsExpr, LHsType, mkVarBind,
+			  LStmt, LHsExpr, LHsType, mkVarBind, 
 			  collectLStmtsBinders, collectLStmtBinders, nlVarPat,
 		   	  placeHolderType, noSyntaxExpr )
 import RdrName		( GlobalRdrElt(..), globalRdrEnvElts,
@@ -764,8 +765,23 @@ check_main ghci_mode tcg_env main_mod main_fn
 	; (main_expr, ty) <- setSrcSpan (srcLocSpan (getSrcLoc main_name)) $
 			     tcInferRho rhs
 
-	; let { root_main_id = mkExportedLocalId rootMainName ty ;
-	        main_bind    = noLoc (VarBind root_main_id main_expr) }
+	-- The function that the RTS invokes is always :Main.main,
+	-- which we call root_main_id.  
+	-- (Because GHC allows the user to have a module not called 
+	-- Main as the main module, we can't rely on the main function
+	-- being called "Main.main".  That's why root_main_id has a fixed
+	-- module ":Main".)
+	-- We also make root_main_id an implicit Id, by making main_name
+	-- its parent (hence (Just main_name)).  That has the effect
+	-- of preventing its type and unfolding from getting out into
+	-- the interface file. Otherwise we can end up with two defns
+	-- for 'main' in the interface file!
+
+	; let { root_main_name =  mkExternalName rootMainKey rOOT_MAIN 
+				   (mkOccFS varName FSLIT("main")) 
+				   (Just main_name) (getSrcLoc main_name)
+	      ; root_main_id = mkExportedLocalId root_main_name ty
+	      ; main_bind    = noLoc (VarBind root_main_id main_expr) }
 
 	; return (tcg_env { tcg_binds = tcg_binds tcg_env 
 					`snocBag` main_bind,