diff options
author | Adam Gundry <adam@well-typed.com> | 2021-04-30 13:33:32 +0100 |
---|---|---|
committer | Adam Gundry <adam@well-typed.com> | 2021-04-30 13:34:06 +0100 |
commit | fcb8db0ac95b66f031d65064f53808eaa417a588 (patch) | |
tree | 0713075f4e4a4b0ba29be2bc0d5184063f153296 | |
parent | 1275bb0257dcf4574aa3ef3f396b0e79929825b4 (diff) | |
download | haskell-fcb8db0ac95b66f031d65064f53808eaa417a588.tar.gz |
Add a test case for awkward type family compatibility cases
-rw-r--r-- | testsuite/tests/indexed-types/should_compile/CompatibleTF.hs | 46 | ||||
-rw-r--r-- | testsuite/tests/indexed-types/should_compile/all.T | 1 |
2 files changed, 47 insertions, 0 deletions
diff --git a/testsuite/tests/indexed-types/should_compile/CompatibleTF.hs b/testsuite/tests/indexed-types/should_compile/CompatibleTF.hs new file mode 100644 index 0000000000..67f8710b7d --- /dev/null +++ b/testsuite/tests/indexed-types/should_compile/CompatibleTF.hs @@ -0,0 +1,46 @@ +{-# LANGUAGE StandaloneKindSignatures, TypeFamilies #-} + +module CompatibleTF where + +import Data.Kind (Type) + +type F :: Type -> Type -> Type -> Type -> Type +type family F a b c d where + F () b c d = c + F a () c d = d + F a b c c = c + +-- Here we need to select the third branch of F, even though the first one is +-- stuck and the second one is blocked on the first one, because the third +-- branch is compatible with the first two. +foo :: F a () () () +foo = () + + + +type family Stuck :: Type + +type family G :: Type where + G = Int + +type K :: Type -> Type -> Type +type family K a b where + K Int Char = Bool + K x y = y + + +-- Here we need to select the second branch of K, because reducing G shows that +-- the applications are apart from the first branch. +bar :: (K a G, K Stuck G) +bar = (3, 3) + + + +type family F2 a where + F2 Int = Char + +-- Here we need to reduce the second argument deeply to see that it is equal to +-- the first argument, and hence the first branch of K cannot match, so we can +-- select the second branch. +wurble :: F2 Char -> K (F2 Char) (F2 (F2 Int)) +wurble x = x diff --git a/testsuite/tests/indexed-types/should_compile/all.T b/testsuite/tests/indexed-types/should_compile/all.T index 7d8aa9f3ae..8cf309a0b1 100644 --- a/testsuite/tests/indexed-types/should_compile/all.T +++ b/testsuite/tests/indexed-types/should_compile/all.T @@ -303,3 +303,4 @@ test('T18875', normal, compile, ['']) test('T8707', normal, compile, ['-O']) test('T14111', normal, compile, ['-O']) test('T19336', normal, compile, ['-O']) +test('CompatibleTF', normal, compile, ['']) |