, text "SchedulerStatus rc;"
, declareResult
-- create the application + perform it.
- , text (if is_IO_res_ty then "rc=rts_evalIO" else "rc=rts_eval")
- <> parens (expr_to_run <+> comma <> text "&ret")
- <> semi
+ , text "rc=rts_evalIO" <> parens (
+ text "rts_apply" <> parens (
+ text "(HaskellObj)"
+ <> text (if is_IO_res_ty
+ then "runIO_closure"
+ else "runNonIO_closure")
+ <> comma
+ <> expr_to_run
+ ) <+> comma
+ <> text "&ret"
+ ) <> semi
, text "rts_checkSchedStatus" <> parens (doubleQuotes (ftext c_nm)
<> comma <> text "rc") <> semi
, text "return" <> return_what <> semi
= [
-- Type constructors (synonyms especially)
ioTyConName, ioDataConName,
- runMainName,
+ runIOName,
orderingTyConName,
rationalTyConName,
ratioDataConName,
\begin{code}
dollarMainName = varQual mAIN_Name FSLIT("$main") dollarMainKey
-runMainName = varQual pREL_TOP_HANDLER_Name FSLIT("runMain") runMainKey
+runIOName = varQual pREL_TOP_HANDLER_Name FSLIT("runIO") runMainKey
-- Stuff from GHC.Prim
usOnceTyConName = kindQual FSLIT(".") usOnceTyConKey
import PrelNames ( mkUnboundName,
derivingOccurrences,
mAIN_Name, main_RDR_Unqual,
- runMainName, intTyConName,
+ runIOName, intTyConName,
boolTyConName, funTyConName,
unpackCStringName, unpackCStringFoldrName, unpackCStringUtf8Name,
eqStringName, printName,
checkMain ghci_mode mod_name gbl_env
-- LOOKUP main IF WE'RE IN MODULE Main
-- The main point of this is to drag in the declaration for 'main',
- -- its in another module, and for the Prelude function 'runMain',
+ -- its in another module, and for the Prelude function 'runIO',
-- so that the type checker will find them
--
-- We have to return the main_name separately, because it's a
| otherwise
= lookupSrcName gbl_env main_RDR_Unqual `thenRn` \ main_name ->
- returnRn (Just main_name, unitFV main_name, unitFV runMainName)
+ returnRn (Just main_name, unitFV main_name, unitFV runIOName)
where
complain_no_main | ghci_mode == Interactive = addWarnRn noMainMsg
isSourceInstDecl, mkSimpleMatch, placeHolderType, isCoreDecl
)
import PrelNames ( ioTyConName, printName,
- returnIOName, bindIOName, failIOName, thenIOName, runMainName,
+ returnIOName, bindIOName, failIOName, thenIOName, runIOName,
dollarMainName, itName
)
import MkId ( unsafeCoerceId )
b) Main.main :: forall a1...an. IO t, for some type t
Then we build
- $main = PrelTopHandler.runMain Main.main
+ $main = GHC.TopHandler.runIO Main.main
The function
- PrelTopHandler :: IO a -> IO ()
+ GHC.TopHandler.runIO :: IO a -> IO a
catches the top level exceptions.
It accepts a Main.main of any type (IO a).
newTyVarTy liftedTypeKind `thenNF_Tc` \ ty ->
tcMonoExpr rhs ty `thenTc` \ (main_expr, lie) ->
zonkTcType ty `thenNF_Tc` \ ty ->
- ASSERT( is_io_unit ty )
+ ASSERT( is_io ty )
let
dollar_main_id = setIdLocalExported (mkLocalId dollarMainName ty)
in
returnTc (VarMonoBind dollar_main_id main_expr, lie)
where
- rhs = HsApp (HsVar runMainName) (HsVar main_name)
+ rhs = HsApp (HsVar runIOName) (HsVar main_name)
-is_io_unit :: Type -> Bool -- True for IO ()
-is_io_unit tau = case tcSplitTyConApp_maybe tau of
- Just (tc, [arg]) -> getName tc == ioTyConName && isUnitTy arg
+is_io :: Type -> Bool -- True for IO a
+is_io tau = case tcSplitTyConApp_maybe tau of
+ Just (tc, [_]) -> getName tc == ioTyConName
other -> False
mainCtxt = ptext SLIT("When checking the type of 'main'")
/* ----------------------------------------------------------------------------
- * $Id: RtsAPI.h,v 1.26 2002/02/15 07:23:02 sof Exp $
+ * $Id: RtsAPI.h,v 1.27 2002/06/27 15:38:58 simonmar Exp $
*
* (c) The GHC Team, 1998-1999
*
void
rts_checkSchedStatus ( char* site, SchedulerStatus rc);
-/* -------------------------------------------------------------------------- */
+/* --------------------------------------------------------------------------
+ Wrapper closures
+
+ These are used by foreign export and foreign import "wrapper" stubs.
+ ----------------------------------------------------------------------- */
+
+extern DLL_IMPORT const StgClosure GHCziTopHandler_runIO_closure;
+extern DLL_IMPORT const StgClosure GHCziTopHandler_runNonIO_closure;
+#define runIO_closure (&GHCziTopHandler_runIO_closure)
+#define runNonIO_closure (&GHCziTopHandler_runNonIO_closure)
+
+/* ------------------------------------------------------------------------ */
#ifdef __cplusplus
}
/* -----------------------------------------------------------------------------
- * $Id: Prelude.h,v 1.19 2002/02/12 15:17:22 simonmar Exp $
+ * $Id: Prelude.h,v 1.20 2002/06/27 15:38:58 simonmar Exp $
*
* (c) The GHC Team, 1998-2001
*
extern DLL_IMPORT const StgClosure GHCziPack_unpackCString_closure;
extern DLL_IMPORT const StgClosure GHCziWeak_runFinalizzerBatch_closure;
extern const StgClosure Main_zdmain_closure;
+extern DLL_IMPORT const StgClosure GHCziTopHandler_runIO_closure;
+extern DLL_IMPORT const StgClosure GHCziTopHandler_runNonIO_closure;
extern DLL_IMPORT const StgClosure GHCziIOBase_stackOverflow_closure;
extern DLL_IMPORT const StgClosure GHCziIOBase_heapOverflow_closure;
#define unpackCString_closure (&GHCziPack_unpackCString_closure)
#define runFinalizerBatch_closure (&GHCziWeak_runFinalizzerBatch_closure)
#define mainIO_closure (&Main_zdmain_closure)
+#define runIO_closure (&GHCziTopHandler_runIO_closure)
+#define runNonIO_closure (&GHCziTopHandler_runNonIO_closure)
#define stackOverflow_closure (&GHCziIOBase_stackOverflow_closure)
#define heapOverflow_closure (&GHCziIOBase_heapOverflow_closure)