X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2Ftypecheck%2FTcSplice.lhs;h=55e09759960d9105fed486a729df95e425f36ee2;hb=ebec49fed627b7dd17e297ddc79a9c677a2ce538;hp=d63b4a016190e14f57842c53e073ce15d026287b;hpb=81466110ff8104ca60e20d617bab83f6f78f0ec2;p=ghc-hetmet.git diff --git a/compiler/typecheck/TcSplice.lhs b/compiler/typecheck/TcSplice.lhs index d63b4a0..55e0975 100644 --- a/compiler/typecheck/TcSplice.lhs +++ b/compiler/typecheck/TcSplice.lhs @@ -73,6 +73,8 @@ import qualified Language.Haskell.TH.Syntax as TH import GHC.Exts ( unsafeCoerce#, Int#, Int(..) ) #if __GLASGOW_HASKELL__ < 609 import qualified Exception ( userErrors ) +#else +import System.IO.Error #endif \end{code} @@ -603,9 +605,15 @@ runMeta convert expr -> failM -- Error already in Tc monad | otherwise -> failWithTc (mk_msg "run" exn) -- Exception #else - Left (SomeException exn) -> do + Left (SomeException exn) -> case cast exn of - Just (ErrorCall "IOEnv failure") -> + Just (ErrorCall "IOEnv failure") -> + failM -- Error already in Tc monad + _ -> + case cast exn of + Just ioe + | isUserError ioe && + (ioeGetErrorString ioe == "IOEnv failure") -> failM -- Error already in Tc monad _ -> failWithTc (mk_msg "run" exn) -- Exception #endif