diff options
| author | sheaf <sam.derbyshire@gmail.com> | 2023-02-15 14:28:02 +0100 |
|---|---|---|
| committer | Marge Bot <ben+marge-bot@smart-cactus.org> | 2023-02-16 20:32:27 -0500 |
| commit | 8988eeef193f055d7b67de5aaa00590c63491fb5 (patch) | |
| tree | 0be0cf737d77e74d3367830b2be951ede3732a4a | |
| parent | b3ac17ad6d7f504ee7615ca67e02e5e094cf1905 (diff) | |
| download | haskell-8988eeef193f055d7b67de5aaa00590c63491fb5.tar.gz | |
Expand synonyms in RoughMap
We were failing to expand type synonyms in the function
GHC.Core.RoughMap.typeToRoughMatchLookupTc, even though the
RoughMap infrastructure crucially relies on type synonym expansion
to work.
This patch adds the missing type-synonym expansion.
Fixes #22985
| -rw-r--r-- | compiler/GHC/Core/RoughMap.hs | 6 | ||||
| -rw-r--r-- | testsuite/tests/typecheck/should_compile/T22985a.hs | 6 | ||||
| -rw-r--r-- | testsuite/tests/typecheck/should_compile/T22985b.hs | 6 | ||||
| -rw-r--r-- | testsuite/tests/typecheck/should_compile/all.T | 3 |
4 files changed, 19 insertions, 2 deletions
diff --git a/compiler/GHC/Core/RoughMap.hs b/compiler/GHC/Core/RoughMap.hs index 7107198cc6..0fa868c748 100644 --- a/compiler/GHC/Core/RoughMap.hs +++ b/compiler/GHC/Core/RoughMap.hs @@ -320,7 +320,11 @@ roughMatchTcsLookup tys = map typeToRoughMatchLookupTc tys typeToRoughMatchLookupTc :: Type -> RoughMatchLookupTc typeToRoughMatchLookupTc ty - | Just (ty', _) <- splitCastTy_maybe ty + -- Expand synonyms first, as explained in Note [Rough matching in class and family instances]. + -- Failing to do so led to #22985. + | Just ty' <- coreView ty + = typeToRoughMatchLookupTc ty' + | CastTy ty' _ <- ty = typeToRoughMatchLookupTc ty' | otherwise = case splitAppTys ty of diff --git a/testsuite/tests/typecheck/should_compile/T22985a.hs b/testsuite/tests/typecheck/should_compile/T22985a.hs new file mode 100644 index 0000000000..8271c93e52 --- /dev/null +++ b/testsuite/tests/typecheck/should_compile/T22985a.hs @@ -0,0 +1,6 @@ +module T22985a where + +type Phase n = n + +addExpr :: Eq a => Phase a -> () +addExpr _ = () diff --git a/testsuite/tests/typecheck/should_compile/T22985b.hs b/testsuite/tests/typecheck/should_compile/T22985b.hs new file mode 100644 index 0000000000..904ce3bdca --- /dev/null +++ b/testsuite/tests/typecheck/should_compile/T22985b.hs @@ -0,0 +1,6 @@ +module T22985b where + +type Phase n = n + +addExpr :: Num a => Phase a -> a +addExpr x = let t = asTypeOf x 0 in t diff --git a/testsuite/tests/typecheck/should_compile/all.T b/testsuite/tests/typecheck/should_compile/all.T index d687336044..7552520678 100644 --- a/testsuite/tests/typecheck/should_compile/all.T +++ b/testsuite/tests/typecheck/should_compile/all.T @@ -861,4 +861,5 @@ test('T20666b', normal, compile, ['']) test('T22891', normal, compile, ['']) test('T22912', normal, compile, ['']) test('T22924', normal, compile, ['']) - +test('T22985a', normal, compile, ['-O']) +test('T22985b', normal, compile, ['']) |