lie_rules `plusLIE`
lie_main
in
- tcSimplifyTop lie_alldecls `thenTc` \ const_inst_binds ->
- traceTc (text "endsimpltop") `thenTc_`
+ tcSimplifyTop lie_alldecls `thenTc` \ const_inst_binds ->
+ traceTc (text "endsimpltop") `thenTc_`
+
-- Backsubstitution. This must be done last.
-- Even tcSimplifyTop may do some unification.
checkTc, checkTcM, checkMaybeTc, checkMaybeTcM,
failTc, failWithTc, addErrTc, addErrsTc, warnTc,
- recoverTc, checkNoErrsTc, recoverNF_Tc, discardErrsTc,
+ recoverTc, checkNoErrsTc, ifErrsTc, recoverNF_Tc, discardErrsTc,
addErrTcM, addInstErrTcM, failWithTcM,
tcGetEnv, tcSetEnv,
errs_var = getTcErrs down
+ifErrsTc :: TcM r -> TcM r -> TcM r
+-- ifErrsTc bale_out main
+-- does 'bale_out' if there are errors in errors collection
+-- and does 'main' otherwise
+-- Useful to avoid error cascades
+
+ifErrsTc bale_out main
+ = getErrsTc `thenNF_Tc` \ (warns, errs) ->
+ if isEmptyBag errs then
+ main
+ else
+ bale_out
+
-- (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.
-- Collect together all the bad guys
bad_guys = non_stds ++ concat std_bads
in
- -- Disambiguate the ones that look feasible
- mapTc disambigGroup std_oks `thenTc` \ binds_ambig ->
- -- And complain about the ones that don't
+ ifErrsTc (returnTc []) (
+ -- Don't check for ambiguous things
+ -- if there has been an error; errors often
+ -- give rise to spurious ambiguous Insts
+
+
+ -- And complain about the ones that don't fall under
+ -- the Haskell rules for disambiguation
-- This group includes both non-existent instances
-- e.g. Num (IO a) and Eq (Int -> Int)
-- and ambiguous dictionaries
-- e.g. Num a
- addTopAmbigErrs bad_guys `thenNF_Tc_`
+ addTopAmbigErrs bad_guys `thenNF_Tc_`
+
+ -- Disambiguate the ones that look feasible
+ mapTc disambigGroup std_oks
+ ) `thenTc` \ binds_ambig ->
+
returnTc (binds `andMonoBinds` andMonoBindList binds_ambig)
where