+-- (checkNoErrsTc m) succeeds iff m succeeds and generates no errors
+-- If m fails then (checkNoErrsTc m) fails.
+-- If m succeeds, it checks whether m generated any errors messages
+-- (it might have recovered internally)
+-- If so, it fails too.
+-- Regardless, any errors generated by m are propagated to the enclosing
+-- context.
+
+checkNoErrsTc :: TcM s r -> TcM s r
+checkNoErrsTc m down env
+ = newMutVarSST (emptyBag,emptyBag) `thenSST` \ m_errs_var ->
+ let
+ errs_var = getTcErrs down
+ propagate_errs
+ = readMutVarSST m_errs_var `thenSST` \ (m_warns, m_errs) ->
+ readMutVarSST errs_var `thenSST` \ (warns, errs) ->
+ writeMutVarSST errs_var (warns `unionBags` m_warns,
+ errs `unionBags` m_errs) `thenSST_`
+ returnSST m_errs
+ in
+
+ recoverFSST (\ _ -> propagate_errs `thenSST_` failFSST ()) $
+
+ m (setTcErrs down m_errs_var) env `thenFSST` \ result ->
+
+ -- Check that m has no errors; if it has internal recovery
+ -- mechanisms it might "succeed" but having found a bunch of
+ -- errors along the way.
+ propagate_errs `thenSST` \ errs ->
+ if isEmptyBag errs then
+ returnFSST result
+ else
+ failFSST ()
+