X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2Ftypecheck%2FTcSplice.lhs;h=7c3aa8637ab2574ecf0726846f22f3593d6787ad;hb=e8db8f8ea957807dc6d4f134a147ef60bfd0ee93;hp=beb72f193278b25f81b006e010c6ccf178a18739;hpb=0065d5ab628975892cea1ec7303f968c3338cbe1;p=ghc-hetmet.git

diff --git a/compiler/typecheck/TcSplice.lhs b/compiler/typecheck/TcSplice.lhs
index beb72f1..7c3aa86 100644
--- a/compiler/typecheck/TcSplice.lhs
+++ b/compiler/typecheck/TcSplice.lhs
@@ -390,7 +390,7 @@ runMeta convert expr
 		-- We also do the TH -> HS syntax conversion inside the same
 		-- exception-cacthing thing so that if there are any lurking 
 		-- exceptions in the data structure returned by hval, we'll
-		-- encounter them inside the tryALlM
+		-- encounter them inside the try
 	  either_tval <- tryAllM $ do
 		{ th_syn <- TH.runQ (unsafeCoerce# hval)
 		; case convert (getLoc expr) th_syn of
@@ -421,7 +421,16 @@ instance TH.Quasi (IOEnv (Env TcGblEnv TcLclEnv)) where
 
   qCurrentModule = do { m <- getModule; return (moduleString m) }
   qReify v = reify v
-  qRecover = recoverM
+
+	-- For qRecover, discard error messages if 
+	-- the recovery action is chosen.  Otherwise
+	-- we'll only fail higher up.  c.f. tryTcLIE_
+  qRecover recover main = do { (msgs, mb_res) <- tryTcErrs main
+			     ; case mb_res of
+		  	         Just val -> do { addMessages msgs	-- There might be warnings
+				   	        ; return val }
+		  	         Nothing  -> recover			-- Discard all msgs
+			  }
 
   qRunIO io = ioToTcRn io
 \end{code}