Commit 9e9367d6 authored by simonmar's avatar simonmar
Browse files

[project @ 2002-06-27 15:38:56 by simonmar]

Finally fix foreign export and foreign import "wrapper" so that
exceptions raised during the call are handled properly rather than
causing the RTS to bomb out.

In particular, calling System.exitWith in a foreign export will cause
the program to terminate cleanly with the desired exit code.  All
other exceptions are printed on stderr (and the program is
terminated).

Details:

GHC.TopHandler.runMain is now called runIO, and has type IO a -> IO a
(previously it had type IO a -> IO (), but that's not general enough
for a foreign export).  The stubs for foreign export and forein import
"wrapper" now automatically wrap the computation in runIO or its dual,
runNonIO.  It turned out to be simpler to do it this way than to do
the wrapping in Haskell land (plain foreign exports don't have
wrappers in Haskell).
parent 3d89e057
......@@ -462,9 +462,17 @@ mkFExportCBits c_nm maybe_target arg_htys res_hty is_IO_res_ty cc
, 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
......
......@@ -97,7 +97,7 @@ knownKeyNames
= [
-- Type constructors (synonyms especially)
ioTyConName, ioDataConName,
runMainName,
runIOName,
orderingTyConName,
rationalTyConName,
ratioDataConName,
......@@ -336,7 +336,7 @@ and it's convenient to write them all down in one place.
\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
......
......@@ -43,7 +43,7 @@ import Module ( ModuleName, moduleName, mkVanillaModule,
import PrelNames ( mkUnboundName,
derivingOccurrences,
mAIN_Name, main_RDR_Unqual,
runMainName, intTyConName,
runIOName, intTyConName,
boolTyConName, funTyConName,
unpackCStringName, unpackCStringFoldrName, unpackCStringUtf8Name,
eqStringName, printName,
......@@ -567,7 +567,7 @@ ubiquitousNames
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
......@@ -582,7 +582,7 @@ checkMain ghci_mode mod_name gbl_env
| 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
......
......@@ -18,7 +18,7 @@ import HsSyn ( HsBinds(..), MonoBinds(..), HsDecl(..), HsExpr(..),
isSourceInstDecl, mkSimpleMatch, placeHolderType, isCoreDecl
)
import PrelNames ( ioTyConName, printName,
returnIOName, bindIOName, failIOName, thenIOName, runMainName,
returnIOName, bindIOName, failIOName, thenIOName, runIOName,
dollarMainName, itName
)
import MkId ( unsafeCoerceId )
......@@ -751,10 +751,10 @@ We must check that in module Main,
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).
......@@ -770,17 +770,17 @@ tcCheckMain (Just main_name)
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
*
......@@ -116,7 +116,18 @@ rts_evalLazyIO ( HaskellObj p, unsigned int stack_size, /*out*/HaskellObj *ret )
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
*
......@@ -19,6 +19,8 @@ extern DLL_IMPORT const StgClosure GHCziBase_False_closure;
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;
......@@ -64,6 +66,8 @@ extern DLL_IMPORT const StgInfoTable GHCziStable_StablePtr_con_info;
#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)
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment