Disable -fdefer-type-errors for linear types (#20083)

3 files changed, 32 insertions, 3 deletions

diff --git a/compiler/GHC/HsToCore/Errors/Ppr.hs b/compiler/GHC/HsToCore/Errors/Ppr.hs
index c5f3aca1ec..eba5c12e74 100644
--- a/compiler/GHC/HsToCore/Errors/Ppr.hs
+++ b/compiler/GHC/HsToCore/Errors/Ppr.hs
@@ -88,7 +88,7 @@ instance Diagnostic DsMessage where
       -> mkSimpleDecorated $
           text "Ignoring useless SPECIALISE pragma for NOINLINE function:" <+> quotes (ppr poly_id)
     DsMultiplicityCoercionsNotSupported
-      -> mkSimpleDecorated $ text "Multiplicity coercions are currently not supported (see GHC #19517)"
+      -> mkSimpleDecorated $ text "GHC bug #19517: GHC currently does not support programs using GADTs or type families to witness equality of multiplicities"
     DsOrphanRule rule
       -> mkSimpleDecorated $ text "Orphan rule:" <+> ppr rule
     DsRuleLhsTooComplicated orig_lhs lhs2
diff --git a/compiler/GHC/Tc/Errors.hs b/compiler/GHC/Tc/Errors.hs
index a504fd44ea..dc95a6a81d 100644
--- a/compiler/GHC/Tc/Errors.hs
+++ b/compiler/GHC/Tc/Errors.hs
@@ -926,10 +926,18 @@ suppressGroup mk_err ctxt cts
       ; traceTc "Suppressing errors for" (ppr cts)
       ; mapM_ (addDeferredBinding ctxt err) cts }
 
+-- See Note [No deferring for multiplicity errors]
+nonDeferrableOrigin :: CtOrigin -> Bool
+nonDeferrableOrigin NonLinearPatternOrigin = True
+nonDeferrableOrigin (UsageEnvironmentOf _) = True
+nonDeferrableOrigin _                      = False
+
 maybeReportError :: ReportErrCtxt -> Ct -> Report -> TcM ()
 maybeReportError ctxt ct report
   = unless (cec_suppress ctxt) $ -- Some worse error has occurred, so suppress this diagnostic
-    do let reason = cec_defer_type_errors ctxt
+    do let reason | nonDeferrableOrigin (ctOrigin ct) = ErrorWithoutFlag
+                  | otherwise                         = cec_defer_type_errors ctxt
+                  -- See Note [No deferring for multiplicity errors]
        msg <- mkErrorReport reason ctxt (ctLocEnv (ctLoc ct)) report
        reportDiagnostic msg
 
@@ -1087,6 +1095,27 @@ is perhaps a bit *over*-consistent!
 
 With #10283, you can now opt out of deferred type error warnings.
 
+Note [No deferring for multiplicity errors]
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+As explained in Note [Wrapper returned from tcSubMult] in GHC.Tc.Utils.Unify,
+linear types do not support casts and any nontrivial coercion will raise
+an error during desugaring.
+
+This means that even if we defer a multiplicity mismatch during typechecking,
+the desugarer will refuse to compile anyway. Worse: the error raised
+by the desugarer would shadow the type mismatch warnings (#20083).
+As a solution, we refuse to defer submultiplicity constraints. Test: T20083.
+
+To determine whether a constraint arose from a submultiplicity check, we
+look at the CtOrigin. All calls to tcSubMult use one of two origins,
+UsageEnvironmentOf and NonLinearPatternOrigin. Those origins are not
+used outside of linear types.
+
+In the future, we should compile 'WpMultCoercion' to a runtime error with
+-fdefer-type-errors, but the current implementation does not always
+place the wrapper in the right place and the resulting program can fail Lint.
+This plan is tracked in #20083.
+
 Note [Deferred errors for coercion holes]
 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
 Suppose we need to defer a type error where the destination for the evidence
diff --git a/compiler/GHC/Tc/Utils/Unify.hs b/compiler/GHC/Tc/Utils/Unify.hs
index 4b12595f72..7b8920f555 100644
--- a/compiler/GHC/Tc/Utils/Unify.hs
+++ b/compiler/GHC/Tc/Utils/Unify.hs
@@ -792,7 +792,7 @@ solved to check whether they are trivial or not. Plus there is precedent for
 type errors during desuraging (such as the representation polymorphism
 restriction). An alternative would be to have a kind of constraint which can
 only produce trivial evidence, then this check would happen in the constraint
-solver.
+solver (#18756).
 -}
 
 tcSubMult :: CtOrigin -> Mult -> Mult -> TcM HsWrapper