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 )
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
| 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
-- 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}
%************************************************************************
\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
assertIdKey = mkPreludeMiscIdUnique 53
runSTRepIdKey = mkPreludeMiscIdUnique 54
-dollarMainKey = mkPreludeMiscIdUnique 55
+rootMainKey = mkPreludeMiscIdUnique 55
runMainKey = mkPreludeMiscIdUnique 56
andIdKey = mkPreludeMiscIdUnique 57
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 )
| 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
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 )
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,
-- 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 } ;
-- 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) $
-- 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) ;
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 } } ;