summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
Diffstat
-rw-r--r--compiler/GHC/Tc/Errors/Ppr.hs9
-rw-r--r--compiler/GHC/Tc/Errors/Types.hs9
-rw-r--r--compiler/GHC/Tc/Utils/Zonk.hs4
-rw-r--r--compiler/GHC/Types/Error/Codes.hs13
-rw-r--r--testsuite/tests/rep-poly/T23153.hs8
-rw-r--r--testsuite/tests/rep-poly/T23153.stderr15
-rw-r--r--testsuite/tests/rep-poly/all.T1
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, [''])
View Lorry Controller Status