-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_`
- failFSST()
- in
-
- recoverFSST propagate_errs $
-
- 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.
- readMutVarSST m_errs_var `thenSST` \ (m_warns, m_errs) ->
- if isEmptyBag m_errs then
- returnFSST result
- else
- failFSST () -- This triggers the recoverFSST
-
--- (tryTc r m) tries m; if it succeeds it returns it,
--- otherwise it returns r. Any error messages added by m are discarded,
--- whether or not m succeeds.
-tryTc :: TcM s r -> TcM s r -> TcM s r
-tryTc recover m down env
- = recoverFSST (\ _ -> recover down env) $
-
- newMutVarSST (emptyBag,emptyBag) `thenSST` \ new_errs_var ->
- m (setTcErrs down new_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. If so we want tryTc to use
- -- "recover" instead
- readMutVarSST new_errs_var `thenSST` \ (_,errs) ->
- if isEmptyBag errs then
- returnFSST result
- else
- recover down env
-
--- Run the thing inside, but throw away all its error messages.
--- discardErrsTc :: TcM s r -> TcM s r
--- discardErrsTc :: NF_TcM s r -> NF_TcM s r
-discardErrsTc :: (TcDown s -> TcEnv s -> State# s -> a)
- -> (TcDown s -> TcEnv s -> State# s -> a)
-discardErrsTc m down env
- = newMutVarSST (emptyBag,emptyBag) `thenSST` \ new_errs_var ->
- m (setTcErrs down new_errs_var) env
-
-checkTc :: Bool -> Message -> TcM s () -- Check that the boolean is true
-checkTc True err = returnTc ()
-checkTc False err = failWithTc err