From ec197dfef33654dd16b5832905dad2e52f79f7ab Mon Sep 17 00:00:00 2001 From: pepe Date: Fri, 26 Sep 2008 20:48:36 +0000 Subject: [PATCH] Don't capture error calls in tryUser A previous patch slightly changed the semantics of tryUser. This patch restores the original behaviour (as expected in :print) --- compiler/typecheck/TcRnMonad.lhs | 2 +- compiler/utils/IOEnv.hs | 2 +- compiler/utils/Panic.lhs | 12 +++--------- 3 files changed, 5 insertions(+), 11 deletions(-) diff --git a/compiler/typecheck/TcRnMonad.lhs b/compiler/typecheck/TcRnMonad.lhs index 4c07a23..a2474c1 100644 --- a/compiler/typecheck/TcRnMonad.lhs +++ b/compiler/typecheck/TcRnMonad.lhs @@ -546,7 +546,7 @@ discardWarnings thing_inside #if __GLASGOW_HASKELL__ < 609 try_m :: TcRn r -> TcRn (Either Exception r) #else -try_m :: TcRn r -> TcRn (Either ErrorCall r) +try_m :: TcRn r -> TcRn (Either IOException r) #endif -- Does try_m, with a debug-trace on failure try_m thing diff --git a/compiler/utils/IOEnv.hs b/compiler/utils/IOEnv.hs index 0cad752..394a1c8 100644 --- a/compiler/utils/IOEnv.hs +++ b/compiler/utils/IOEnv.hs @@ -98,7 +98,7 @@ fixM f = IOEnv (\ env -> fixIO (\ r -> unIOEnv (f r) env)) #if __GLASGOW_HASKELL__ < 609 tryM :: IOEnv env r -> IOEnv env (Either Exception r) #else -tryM :: IOEnv env r -> IOEnv env (Either ErrorCall r) +tryM :: IOEnv env r -> IOEnv env (Either IOException r) #endif -- Reflect UserError exceptions (only) into IOEnv monad -- Other exceptions are not caught; they are simply propagated as exns diff --git a/compiler/utils/Panic.lhs b/compiler/utils/Panic.lhs index 6f7a4a8..0e049b0 100644 --- a/compiler/utils/Panic.lhs +++ b/compiler/utils/Panic.lhs @@ -219,22 +219,16 @@ tryUser action = tryJust tc_errors action tc_errors e@(Exception.IOException ioe) | isUserError ioe = Just e tc_errors _other = Nothing #else -tryUser :: IO a -> IO (Either ErrorCall a) +tryUser :: IO a -> IO (Either IOException a) tryUser io = do ei <- try io case ei of Right v -> return (Right v) Left se@(SomeException ex) -> - case cast ex of - -- Look for good old fashioned ErrorCall's - Just errorCall -> return (Left errorCall) - Nothing -> - case cast ex of - -- And also for user errors in IO errors. - -- Sigh. + case cast ex of Just ioe | isUserError ioe -> - return (Left (ErrorCall (ioeGetErrorString ioe))) + return (Left ioe) _ -> throw se #endif \end{code} -- 1.7.10.4