From 5ecf452603a0c79e4fed0062b79bcaff4449b213 Mon Sep 17 00:00:00 2001 From: Tyson Whitehead Date: Tue, 10 Apr 2007 14:17:09 +0000 Subject: [PATCH] Distinguish between userError (i.e., deliberate failure) and other immediate and embedded exceptions for TH splices for trac #1265 --- compiler/typecheck/TcSplice.lhs | 22 +++++++++++----------- 1 file changed, 11 insertions(+), 11 deletions(-) diff --git a/compiler/typecheck/TcSplice.lhs b/compiler/typecheck/TcSplice.lhs index b675cf9..c7dccc4 100644 --- a/compiler/typecheck/TcSplice.lhs +++ b/compiler/typecheck/TcSplice.lhs @@ -394,17 +394,17 @@ runMeta convert expr -- exception-cacthing thing so that if there are any lurking -- exceptions in the data structure returned by hval, we'll -- encounter them inside the try - either_tval <- tryAllM $ do - { th_syn <- TH.runQ (unsafeCoerce# hval) - ; case convert (getLoc expr) th_syn of - Left err -> do { addErrTc err; return Nothing } - Right hs_syn -> return (Just hs_syn) } - - ; case either_tval of - Right (Just v) -> return v - Right Nothing -> failM -- Error already in Tc monad - Left exn -> failWithTc (mk_msg "run" exn) -- Exception - }}} + either_th_syn <- tryAllM $ tryM $ TH.runQ $ unsafeCoerce# hval + ; case either_th_syn of + Left exn -> failWithTc (mk_msg "run" exn) + Right (Left exn) -> failM -- Error already in Tc monad + Right (Right th_syn) -> do + { either_hs_syn <- tryAllM $ return $! convert (getLoc expr) th_syn + ; case either_hs_syn of + Left exn -> failWithTc (mk_msg "interpret result of" exn) + Right (Left err) -> do { addErrTc err; failM } + Right (Right hs_syn) -> return hs_syn + }}}} where mk_msg s exn = vcat [text "Exception when trying to" <+> text s <+> text "compile-time code:", nest 2 (text (Panic.showException exn)), -- 1.7.10.4