Show an error when we cannot default a concrete tyvar

Fixes #23153

7 files changed, 55 insertions, 4 deletions

diff --git a/compiler/GHC/Tc/Errors/Ppr.hs b/compiler/GHC/Tc/Errors/Ppr.hs
index d4e0ba15a1..0d253cbf6b 100644
--- a/compiler/GHC/Tc/Errors/Ppr.hs
+++ b/compiler/GHC/Tc/Errors/Ppr.hs
@@ -1728,6 +1728,11 @@ instance Diagnostic TcRnMessage where
             in ppr (getSrcSpan n) <> colon <+> ppr (tyConName tc)
                    <+> text "from external module"
 
+    TcRnCannotDefaultConcrete frr
+      -> mkSimpleDecorated $
+         ppr (frr_context frr) $$
+         text "cannot be assigned a fixed runtime representation," <+>
+         text "not even by defaulting."
 
   diagnosticReason = \case
     TcRnUnknownMessage m
@@ -2300,6 +2305,8 @@ instance Diagnostic TcRnMessage where
       -> ErrorWithoutFlag
     TcRnTypeSynonymCycle{}
       -> ErrorWithoutFlag
+    TcRnCannotDefaultConcrete{}
+      -> ErrorWithoutFlag
 
   diagnosticHints = \case
     TcRnUnknownMessage m
@@ -2899,6 +2906,8 @@ instance Diagnostic TcRnMessage where
       -> [suggestExtension LangExt.DataKinds]
     TcRnTypeSynonymCycle{}
       -> noHints
+    TcRnCannotDefaultConcrete{}
+      -> [SuggestAddTypeSignatures UnnamedBinding]
 
   diagnosticCode = constructorCode
 
diff --git a/compiler/GHC/Tc/Errors/Types.hs b/compiler/GHC/Tc/Errors/Types.hs
index 7817715537..6e58e6b033 100644
--- a/compiler/GHC/Tc/Errors/Types.hs
+++ b/compiler/GHC/Tc/Errors/Types.hs
@@ -3473,6 +3473,15 @@ data TcRnMessage where
                        -> ![LIdP GhcRn] -- ^ The LHS args
                        -> !PatSynInvalidRhsReason -- ^ The number of equation arguments
                        -> TcRnMessage
+  {- TcRnCannotDefaultConcrete is an error occurring when a concrete
+    type variable cannot be defaulted.
+
+    Test cases:
+      T23153
+  -}
+  TcRnCannotDefaultConcrete
+    :: !FixedRuntimeRepOrigin
+    -> TcRnMessage
 
   {-| TcRnMultiAssocTyFamDefaults is an error indicating that multiple default
     declarations were specified for an associated type family.
diff --git a/compiler/GHC/Tc/Utils/Zonk.hs b/compiler/GHC/Tc/Utils/Zonk.hs
index f9ab10b6d0..7a2c0de793 100644
--- a/compiler/GHC/Tc/Utils/Zonk.hs
+++ b/compiler/GHC/Tc/Utils/Zonk.hs
@@ -56,6 +56,7 @@ import GHC.Tc.Utils.TcType
 import GHC.Tc.Utils.TcMType
 import GHC.Tc.Utils.Env   ( tcLookupGlobalOnly )
 import GHC.Tc.Types.Evidence
+import GHC.Tc.Errors.Types
 
 import GHC.Core.TyCo.Ppr     ( pprTyVar )
 import GHC.Core.TyCon
@@ -1810,6 +1811,9 @@ commitFlexi flexi tv zonked_kind
         | isMultiplicityTy zonked_kind
         -> do { traceTc "Defaulting flexi tyvar to Many:" (pprTyVar tv)
               ; return manyDataConTy }
+        | Just (ConcreteFRR origin) <- isConcreteTyVar_maybe tv
+        -> do { addErr $ TcRnCannotDefaultConcrete origin
+              ; return (anyTypeOfKind zonked_kind) }
         | otherwise
         -> do { traceTc "Defaulting flexi tyvar to Any:" (pprTyVar tv)
               ; return (anyTypeOfKind zonked_kind) }
diff --git a/compiler/GHC/Types/Error/Codes.hs b/compiler/GHC/Types/Error/Codes.hs
index 2aeffa87f5..b85e484ea2 100644
--- a/compiler/GHC/Types/Error/Codes.hs
+++ b/compiler/GHC/Types/Error/Codes.hs
@@ -480,8 +480,6 @@ type family GhcDiagnosticCode c = n | n -> c where
 
   GhcDiagnosticCode "TcRnIllegalHsigDefaultMethods"                 = 93006
   GhcDiagnosticCode "TcRnHsigFixityMismatch"                        = 93007
-  GhcDiagnosticCode "HsigShapeSortMismatch"                         = 93008
-  GhcDiagnosticCode "HsigShapeNotUnifiable"                         = 93009
   GhcDiagnosticCode "TcRnHsigNoIface"                               = 93010
   GhcDiagnosticCode "TcRnHsigMissingModuleExport"                   = 93011
   GhcDiagnosticCode "TcRnBadGenericMethod"                          = 59794
@@ -551,8 +549,7 @@ type family GhcDiagnosticCode c = n | n -> c where
   GhcDiagnosticCode "TcRnPatSynEscapedCoercion"                     = 88986
   GhcDiagnosticCode "TcRnPatSynExistentialInResult"                 = 33973
   GhcDiagnosticCode "TcRnPatSynArityMismatch"                       = 18365
-  GhcDiagnosticCode "PatSynNotInvertible"                           = 69317
-  GhcDiagnosticCode "PatSynUnboundVar"                              = 28572
+  GhcDiagnosticCode "TcRnCannotDefaultConcrete"                     = 52083
   GhcDiagnosticCode "TcRnMultiAssocTyFamDefaults"                   = 59128
   GhcDiagnosticCode "TcRnTyFamDepsDisabled"                         = 43991
   GhcDiagnosticCode "TcRnAbstractClosedTyFamDecl"                   = 60012
@@ -580,6 +577,10 @@ type family GhcDiagnosticCode c = n | n -> c where
   GhcDiagnosticCode "TcRnTyFamNameMismatch"                         = 88221
   GhcDiagnosticCode "TcRnTypeSynonymCycle"                          = 97522
 
+  -- PatSynInvalidRhsReason
+  GhcDiagnosticCode "PatSynNotInvertible"                           = 69317
+  GhcDiagnosticCode "PatSynUnboundVar"                              = 28572
+
   -- TcRnBadFieldAnnotation/BadFieldAnnotationReason
   GhcDiagnosticCode "LazyFieldsDisabled"                            = 81601
   GhcDiagnosticCode "UnpackWithoutStrictness"                       = 10107
@@ -601,6 +602,10 @@ type family GhcDiagnosticCode c = n | n -> c where
   GhcDiagnosticCode "TcRnPrecedenceParsingError"                    = 88747
   GhcDiagnosticCode "TcRnSectionPrecedenceError"                    = 46878
 
+  -- HsigShapeMismatchReason
+  GhcDiagnosticCode "HsigShapeSortMismatch"                         = 93008
+  GhcDiagnosticCode "HsigShapeNotUnifiable"                         = 93009
+
   -- IllegalNewtypeReason
   GhcDiagnosticCode "DoesNotHaveSingleField"                        = 23517
   GhcDiagnosticCode "IsNonLinear"                                   = 38291
diff --git a/testsuite/tests/rep-poly/T23153.hs b/testsuite/tests/rep-poly/T23153.hs
new file mode 100644
index 0000000000..06b2ea3a03
--- /dev/null
+++ b/testsuite/tests/rep-poly/T23153.hs
@@ -0,0 +1,8 @@
+module T23153 where
+
+import GHC.Exts
+
+f :: forall r s (a :: TYPE (r s)). a -> ()
+f = f
+
+g h = f (h ())
diff --git a/testsuite/tests/rep-poly/T23153.stderr b/testsuite/tests/rep-poly/T23153.stderr
new file mode 100644
index 0000000000..9350f4277b
--- /dev/null
+++ b/testsuite/tests/rep-poly/T23153.stderr
@@ -0,0 +1,15 @@
+
+T23153.hs:8:1: error: [GHC-52083]
+    The argument ‘(h ())’ of ‘f’
+    cannot be assigned a fixed runtime representation, not even by defaulting.
+    Suggested fix: Add a type signature.
+
+T23153.hs:8:1: error: [GHC-52083]
+    The argument ‘(h ())’ of ‘f’
+    cannot be assigned a fixed runtime representation, not even by defaulting.
+    Suggested fix: Add a type signature.
+
+T23153.hs:8:1: error: [GHC-52083]
+    The argument ‘(h ())’ of ‘f’
+    cannot be assigned a fixed runtime representation, not even by defaulting.
+    Suggested fix: Add a type signature.
diff --git a/testsuite/tests/rep-poly/all.T b/testsuite/tests/rep-poly/all.T
index a01a2529ae..a05a6bb7e5 100644
--- a/testsuite/tests/rep-poly/all.T
+++ b/testsuite/tests/rep-poly/all.T
@@ -116,3 +116,4 @@ test('T21650_b', normal, compile_fail, ['-Wno-deprecated-flags'])            ##
 
 
 test('T23051', normal, compile_fail, [''])
+test('T23153', normal, compile_fail, [''])