summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorRyan Scott <ryan.gl.scott@gmail.com>2022-04-02 07:45:00 -0400
committerMarge Bot <ben+marge-bot@smart-cactus.org>2022-04-30 16:51:47 -0400
commite2dd884aa9ffcac5b4bf0d8c826d07ffd18e5d6e (patch)
tree3e32c8aacd97b2fcb837219768a490bfeeb61d15
parent0cdef80783b95ea2d2a49c5a9ee4ec06cde3958e (diff)
downloadhaskell-e2dd884aa9ffcac5b4bf0d8c826d07ffd18e5d6e.tar.gz
Make mkFunCo take AnonArgFlags into account
Previously, whenever `mkFunCo` would produce reflexive coercions, it would use `mkVisFunTy` to produce the kind of the coercion. However, `mkFunCo` is also used to produce coercions between types of the form `ty1 => ty2` in certain places. This has the unfortunate side effect of causing the type of the coercion to appear as `ty1 -> ty2` in certain error messages, as spotted in #21328. This patch address this by changing replacing the use of `mkVisFunTy` with `mkFunctionType` in `mkFunCo`. `mkFunctionType` checks the kind of `ty1` and makes the function arrow `=>` instead of `->` if `ty1` has kind `Constraint`, so this should always produce the correct `AnonArgFlag`. As a result, this patch fixes part (2) of #21328. This is not the only possible way to fix #21328, as the discussion on that issue lists some possible alternatives. Ultimately, it was concluded that the alternatives would be difficult to maintain, and since we already use `mkFunctionType` in `coercionLKind` and `coercionRKind`, using `mkFunctionType` in `mkFunCo` is consistent with this choice. Moreover, using `mkFunctionType` does not regress the performance of any test case we have in GHC's test suite.
-rw-r--r--compiler/GHC/Core/Coercion.hs5
-rw-r--r--testsuite/tests/typecheck/should_fail/T21328.hs11
-rw-r--r--testsuite/tests/typecheck/should_fail/T21328.stderr4
-rw-r--r--testsuite/tests/typecheck/should_fail/all.T1
4 files changed, 19 insertions, 2 deletions
diff --git a/compiler/GHC/Core/Coercion.hs b/compiler/GHC/Core/Coercion.hs
index 4cfdc3ee82..235e8c65fb 100644
--- a/compiler/GHC/Core/Coercion.hs
+++ b/compiler/GHC/Core/Coercion.hs
@@ -792,14 +792,15 @@ mkTyConAppCo r tc cos
| otherwise = TyConAppCo r tc cos
-- | Build a function 'Coercion' from two other 'Coercion's. That is,
--- given @co1 :: a ~ b@ and @co2 :: x ~ y@ produce @co :: (a -> x) ~ (b -> y)@.
+-- given @co1 :: a ~ b@ and @co2 :: x ~ y@ produce @co :: (a -> x) ~ (b -> y)@
+-- or @(a => x) ~ (b => y)@, depending on the kind of @a@/@b@.
mkFunCo :: Role -> CoercionN -> Coercion -> Coercion -> Coercion
mkFunCo r w co1 co2
-- See Note [Refl invariant]
| Just (ty1, _) <- isReflCo_maybe co1
, Just (ty2, _) <- isReflCo_maybe co2
, Just (w, _) <- isReflCo_maybe w
- = mkReflCo r (mkVisFunTy w ty1 ty2)
+ = mkReflCo r (mkFunctionType w ty1 ty2)
| otherwise = FunCo r w co1 co2
-- | Apply a 'Coercion' to another 'Coercion'.
diff --git a/testsuite/tests/typecheck/should_fail/T21328.hs b/testsuite/tests/typecheck/should_fail/T21328.hs
new file mode 100644
index 0000000000..f589c5d3a7
--- /dev/null
+++ b/testsuite/tests/typecheck/should_fail/T21328.hs
@@ -0,0 +1,11 @@
+{-# LANGUAGE TypeFamilies #-}
+module T21328 where
+
+import GHC.Exts
+import Type.Reflection
+
+type family Id x
+type instance Id x = x
+
+cast :: forall a. Id (TypeRep a) -> (Typeable a => Int) -> Int
+cast = withDict @(TypeRep a) @(Typeable a)
diff --git a/testsuite/tests/typecheck/should_fail/T21328.stderr b/testsuite/tests/typecheck/should_fail/T21328.stderr
new file mode 100644
index 0000000000..a7d106a793
--- /dev/null
+++ b/testsuite/tests/typecheck/should_fail/T21328.stderr
@@ -0,0 +1,4 @@
+
+T21328.hs:11:8: error:
+ Invalid instantiation of ‘withDict’ at type:
+ Id (TypeRep a) -> (Typeable a => Int) -> Int
diff --git a/testsuite/tests/typecheck/should_fail/all.T b/testsuite/tests/typecheck/should_fail/all.T
index c856ca7e95..aceaf051c9 100644
--- a/testsuite/tests/typecheck/should_fail/all.T
+++ b/testsuite/tests/typecheck/should_fail/all.T
@@ -653,4 +653,5 @@ test('T20064', normal, compile_fail, [''])
test('T21130', normal, compile_fail, [''])
test('T20768_fail', normal, compile_fail, [''])
test('T21327', normal, compile_fail, [''])
+test('T21328', normal, compile_fail, [''])
test('T21338', normal, compile_fail, [''])