diff options
| author | sheaf <sam.derbyshire@gmail.com> | 2023-02-15 14:28:02 +0100 |
|---|---|---|
| committer | Matthew Pickering <matthewtpickering@gmail.com> | 2023-02-20 09:32:46 +0000 |
| commit | 8e9b8753a50f8ba9e1e7f265ec5b4dbe78bc4e19 (patch) | |
| tree | 4c09679b03b67b35f09bbbf9b11191ea5fd49cd0 | |
| parent | 6164ceb89b24ce4d97fd035eecdc638f40351e71 (diff) | |
| download | haskell-8e9b8753a50f8ba9e1e7f265ec5b4dbe78bc4e19.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
(cherry picked from commit 8988eeef193f055d7b67de5aaa00590c63491fb5)
| -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 c8f4d939cf..20725c3d50 100644 --- a/testsuite/tests/typecheck/should_compile/all.T +++ b/testsuite/tests/typecheck/should_compile/all.T @@ -862,4 +862,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, ['']) |