diff options
| -rw-r--r-- | ghc/compiler/codeGen/CodeGen.lhs | 6 | ||||
| -rw-r--r-- | ghc/compiler/prelude/PrelNames.lhs | 16 | ||||
| -rw-r--r-- | ghc/compiler/rename/RnEnv.lhs | 22 | ||||
| -rw-r--r-- | ghc/compiler/typecheck/TcRnDriver.lhs | 20 |
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 } } ; |