Fixes around incomplete guards (#20023, #20024)wip/runtime-error-fixes

- Fix linearity error with incomplete MultiWayIf (#20023)
- Fix partial pattern binding error message (#20024)
- Remove obsolete test LinearPolyTest
  It tested the special typing rule for ($), which was removed
  during the implementation of Quick Look 97cff9190d3.
- Fix ticket numbers in linear/*/all.T, they referred to linear types
  issue tracker

4 files changed, 14 insertions, 23 deletions

diff --git a/compiler/GHC/HsToCore/GuardedRHSs.hs b/compiler/GHC/HsToCore/GuardedRHSs.hs
index 6f1de8ae16..8ecf6c84ed 100644
--- a/compiler/GHC/HsToCore/GuardedRHSs.hs
+++ b/compiler/GHC/HsToCore/GuardedRHSs.hs
@@ -49,7 +49,8 @@ necessary.  The type argument gives the type of the @ei@.
 dsGuarded :: GRHSs GhcTc (LHsExpr GhcTc) -> Type -> NonEmpty Nablas -> DsM CoreExpr
 dsGuarded grhss rhs_ty rhss_nablas = do
     match_result <- dsGRHSs PatBindRhs grhss rhs_ty rhss_nablas
-    error_expr <- mkErrorAppDs nON_EXHAUSTIVE_GUARDS_ERROR_ID rhs_ty empty
+    error_expr <- mkErrorAppDs nON_EXHAUSTIVE_GUARDS_ERROR_ID rhs_ty
+                               (text "pattern binding")
     extractMatchResult match_result error_expr
 
 -- In contrast, @dsGRHSs@ produces a @MatchResult CoreExpr@.
diff --git a/compiler/GHC/HsToCore/Utils.hs b/compiler/GHC/HsToCore/Utils.hs
index b68cf061a0..5c68525f12 100644
--- a/compiler/GHC/HsToCore/Utils.hs
+++ b/compiler/GHC/HsToCore/Utils.hs
@@ -405,11 +405,10 @@ mkErrorAppDs :: Id              -- The error function
 mkErrorAppDs err_id ty msg = do
     src_loc <- getSrcSpanDs
     dflags <- getDynFlags
-    let
-        full_msg = showSDoc dflags (hcat [ppr src_loc, vbar, msg])
-        core_msg = Lit (mkLitString full_msg)
-        -- mkLitString returns a result of type String#
-    return (mkApps (Var err_id) [Type (getRuntimeRep ty), Type ty, core_msg])
+    let full_msg = showSDoc dflags (hcat [ppr src_loc, vbar, msg])
+        fail_expr = mkRuntimeErrorApp err_id unitTy full_msg
+    return $ mkWildCase fail_expr (unrestricted unitTy) ty []
+    -- See Note [Incompleteness and linearity]
 
 {-
 Note [Incompleteness and linearity]
@@ -426,7 +425,7 @@ the linearity of x.
 Instead, we use 'f x False = case error "Non-exhausive pattern..." :: () of {}'.
 This case expression accounts for linear variables by assigning bottom usage
 (See Note [Bottom as a usage] in GHC.Core.Multiplicity).
-This is done in mkFailExpr.
+This is done in mkErrorAppDs, called from mkFailExpr.
 We use '()' instead of the original return type ('a' in this case)
 because there might be representation polymorphism, e.g. in
 
@@ -458,9 +457,7 @@ is disabled.
 
 mkFailExpr :: HsMatchContext GhcRn -> Type -> DsM CoreExpr
 mkFailExpr ctxt ty
-  = do fail_expr <- mkErrorAppDs pAT_ERROR_ID unitTy (matchContextErrString ctxt)
-       return $ mkWildCase fail_expr (unrestricted unitTy) ty []
-       -- See Note [Incompleteness and linearity]
+  = mkErrorAppDs pAT_ERROR_ID ty (matchContextErrString ctxt)
 
 {-
 'mkCoreAppDs' and 'mkCoreAppsDs' handle the special-case desugaring of 'seq'.
diff --git a/compiler/GHC/Tc/Errors.hs b/compiler/GHC/Tc/Errors.hs
index f3c8a19b04..e45d051e50 100644
--- a/compiler/GHC/Tc/Errors.hs
+++ b/compiler/GHC/Tc/Errors.hs
@@ -953,10 +953,10 @@ mkErrorTerm ctxt ct_loc ty report
          -- This will be reported at runtime, so we always want "error:" in the report, never "warning:"
        ; dflags <- getDynFlags
        ; let err_msg = pprLocMsgEnvelope msg
-             err_fs  = mkFastString $ showSDoc dflags $
+             err_str = showSDoc dflags $
                        err_msg $$ text "(deferred type error)"
 
-       ; return $ evDelayedError ty err_fs }
+       ; return $ evDelayedError ty err_str }
 
 tryReporters :: ReportErrCtxt -> [ReporterSpec] -> [Ct] -> TcM (ReportErrCtxt, [Ct])
 -- Use the first reporter in the list whose predicate says True
diff --git a/compiler/GHC/Tc/Types/EvTerm.hs b/compiler/GHC/Tc/Types/EvTerm.hs
index 19afec031a..ad380ec0a2 100644
--- a/compiler/GHC/Tc/Types/EvTerm.hs
+++ b/compiler/GHC/Tc/Types/EvTerm.hs
@@ -13,34 +13,27 @@ import GHC.Tc.Types.Evidence
 import GHC.Unit
 
 import GHC.Builtin.Names
-import GHC.Builtin.Types ( liftedRepTy, unitTy )
+import GHC.Builtin.Types ( unitTy )
 
 import GHC.Core.Type
 import GHC.Core
 import GHC.Core.Make
 import GHC.Core.Utils
 
-import GHC.Types.Literal ( Literal(..) )
 import GHC.Types.SrcLoc
 import GHC.Types.Name
 import GHC.Types.TyThing
 
-import GHC.Data.FastString
-
 -- Used with Opt_DeferTypeErrors
 -- See Note [Deferring coercion errors to runtime]
 -- in GHC.Tc.Solver
-evDelayedError :: Type -> FastString -> EvTerm
+evDelayedError :: Type -> String -> EvTerm
 evDelayedError ty msg
   = EvExpr $
-    let fail_expr = Var errorId `mkTyApps` [liftedRepTy, unitTy] `mkApps` [litMsg]
+    let fail_expr = mkRuntimeErrorApp tYPE_ERROR_ID unitTy msg
     in mkWildCase fail_expr (unrestricted unitTy) ty []
        -- See Note [Incompleteness and linearity] in GHC.HsToCore.Utils
-       -- c.f. mkFailExpr in GHC.HsToCore.Utils
-
-  where
-    errorId = tYPE_ERROR_ID
-    litMsg  = Lit (LitString (bytesFS msg))
+       -- c.f. mkErrorAppDs in GHC.HsToCore.Utils
 
 -- Dictionary for CallStack implicit parameters
 evCallStack :: (MonadThings m, HasModule m, HasDynFlags m) =>