diff options
-rw-r--r-- | compiler/GHC/Tc/Utils/Concrete.hs-boot | 11 | ||||
-rw-r--r-- | compiler/GHC/Tc/Utils/TcMType.hs | 6 | ||||
-rw-r--r-- | testsuite/tests/rep-poly/RepPolyPartialSig.hs | 8 | ||||
-rw-r--r-- | testsuite/tests/rep-poly/RepPolyPartialSig.stderr | 13 | ||||
-rw-r--r-- | testsuite/tests/rep-poly/RepPolyPatBind.stderr | 33 | ||||
-rw-r--r-- | testsuite/tests/rep-poly/all.T | 1 |
6 files changed, 71 insertions, 1 deletions
diff --git a/compiler/GHC/Tc/Utils/Concrete.hs-boot b/compiler/GHC/Tc/Utils/Concrete.hs-boot new file mode 100644 index 0000000000..be8a2f63f6 --- /dev/null +++ b/compiler/GHC/Tc/Utils/Concrete.hs-boot @@ -0,0 +1,11 @@ +module GHC.Tc.Utils.Concrete where + +import GHC.Utils.Misc ( HasDebugCallStack ) +import GHC.Tc.Types ( TcM ) +import GHC.Tc.Types.Origin ( FixedRuntimeRepContext ) +import GHC.Tc.Utils.TcType ( TcType ) + +hasFixedRuntimeRep_syntactic :: HasDebugCallStack + => FixedRuntimeRepContext + -> TcType + -> TcM () diff --git a/compiler/GHC/Tc/Utils/TcMType.hs b/compiler/GHC/Tc/Utils/TcMType.hs index d0afe71560..3df247e911 100644 --- a/compiler/GHC/Tc/Utils/TcMType.hs +++ b/compiler/GHC/Tc/Utils/TcMType.hs @@ -115,6 +115,7 @@ import GHC.Tc.Types.Constraint import GHC.Tc.Types.Evidence import GHC.Tc.Utils.Monad -- TcType, amongst others import GHC.Tc.Utils.TcType +import {-# SOURCE #-} GHC.Tc.Utils.Concrete ( hasFixedRuntimeRep_syntactic ) import GHC.Tc.Errors.Types import GHC.Tc.Errors.Ppr @@ -556,7 +557,7 @@ expTypeToType (Infer inf_res) = inferResultToType inf_res inferResultToType :: InferResult -> TcM Type inferResultToType (IR { ir_uniq = u, ir_lvl = tc_lvl - , ir_ref = ref }) + , ir_ref = ref, ir_frr = mb_frr }) = do { mb_inferred_ty <- readTcRef ref ; tau <- case mb_inferred_ty of Just ty -> do { ensureMonoType ty @@ -564,6 +565,9 @@ inferResultToType (IR { ir_uniq = u, ir_lvl = tc_lvl ; return ty } Nothing -> do { rr <- newMetaTyVarTyAtLevel tc_lvl runtimeRepTy ; tau <- newMetaTyVarTyAtLevel tc_lvl (mkTYPEapp rr) + ; case mb_frr of + Nothing -> return () + Just reason -> hasFixedRuntimeRep_syntactic reason tau -- See Note [TcLevel of ExpType] ; writeMutVar ref (Just tau) ; return tau } diff --git a/testsuite/tests/rep-poly/RepPolyPartialSig.hs b/testsuite/tests/rep-poly/RepPolyPartialSig.hs new file mode 100644 index 0000000000..afaf14ecc7 --- /dev/null +++ b/testsuite/tests/rep-poly/RepPolyPartialSig.hs @@ -0,0 +1,8 @@ +{-# LANGUAGE TypeFamilies, PartialTypeSignatures #-} +module RepPolyPartialSig where + +import GHC.Exts + +type family A :: RuntimeRep + +f x = x :: (_ :: TYPE A) diff --git a/testsuite/tests/rep-poly/RepPolyPartialSig.stderr b/testsuite/tests/rep-poly/RepPolyPartialSig.stderr new file mode 100644 index 0000000000..095c374387 --- /dev/null +++ b/testsuite/tests/rep-poly/RepPolyPartialSig.stderr @@ -0,0 +1,13 @@ + +RepPolyPartialSig.hs:8:7: error: [GHC-55287] + • The first pattern in the equation for ‘f’ + does not have a fixed runtime representation. + Its type is: + p :: TYPE c0 + Cannot unify ‘A’ with the type variable ‘c0’ + because it is not a concrete ‘RuntimeRep’. + • In the expression: x :: (_ :: TYPE A) + In an equation for ‘f’: f x = x :: (_ :: TYPE A) + • Relevant bindings include + x :: p (bound at RepPolyPartialSig.hs:8:3) + f :: p -> w (bound at RepPolyPartialSig.hs:8:1) diff --git a/testsuite/tests/rep-poly/RepPolyPatBind.stderr b/testsuite/tests/rep-poly/RepPolyPatBind.stderr index 40637215fe..a600e83672 100644 --- a/testsuite/tests/rep-poly/RepPolyPatBind.stderr +++ b/testsuite/tests/rep-poly/RepPolyPatBind.stderr @@ -17,3 +17,36 @@ RepPolyPatBind.hs:18:5: error: [GHC-55287] x, y :: a (# x, y #) = undefined in x + +RepPolyPatBind.hs:18:8: error: [GHC-55287] + • The pattern binding does not have a fixed runtime representation. + Its type is: + (# a0, b0 #) :: TYPE (TupleRep [c0, c1]) + Cannot unify ‘rep’ with the type variable ‘c0’ + because it is not a concrete ‘RuntimeRep’. + • In the pattern: (# x, y #) + In a pattern binding: (# x, y #) = undefined + In the expression: + let + x, y :: a + (# x, y #) = undefined + in x + • Relevant bindings include + foo :: () -> a (bound at RepPolyPatBind.hs:15:1) + +RepPolyPatBind.hs:18:11: error: [GHC-55287] + • The pattern binding does not have a fixed runtime representation. + Its type is: + (# a0, b0 #) :: TYPE (TupleRep [c0, c1]) + Cannot unify ‘rep’ with the type variable ‘c1’ + because it is not a concrete ‘RuntimeRep’. + • In the pattern: (# x, y #) + In a pattern binding: (# x, y #) = undefined + In the expression: + let + x, y :: a + (# x, y #) = undefined + in x + • Relevant bindings include + x :: a (bound at RepPolyPatBind.hs:18:8) + foo :: () -> a (bound at RepPolyPatBind.hs:15:1) diff --git a/testsuite/tests/rep-poly/all.T b/testsuite/tests/rep-poly/all.T index 33044ae9fe..dd8a85c251 100644 --- a/testsuite/tests/rep-poly/all.T +++ b/testsuite/tests/rep-poly/all.T @@ -66,6 +66,7 @@ test('RepPolyMcGuard', normal, compile_fail, ['']) test('RepPolyNewtypePat1', normal, compile_fail, ['']) test('RepPolyNewtypePat2', normal, compile, ['']) test('RepPolyNPlusK', normal, compile_fail, ['']) +test('RepPolyPartialSig', normal, compile_fail, ['']) test('RepPolyPatBind', normal, compile_fail, ['']) test('RepPolyPatSynArg', normal, compile_fail, ['']) test('RepPolyPatSynRes', normal, compile_fail, ['']) |