diff options
| author | Richard Eisenberg <eir@cis.upenn.edu> | 2014-12-12 12:02:31 -0500 |
|---|---|---|
| committer | Richard Eisenberg <eir@cis.upenn.edu> | 2014-12-12 12:02:31 -0500 |
| commit | f49e19b9f65a00e767ae45d60e1766f4a4f82973 (patch) | |
| tree | f55986a5310e32e9a5fb9f0e8b97a97ff2996cd3 | |
| parent | 190038033778925092b03169d33e29f4c8e5fb05 (diff) | |
| download | haskell-f49e19b9f65a00e767ae45d60e1766f4a4f82973.tar.gz | |
Allow multiple type family instances to match in reduceTyFamApp_maybe
| -rw-r--r-- | compiler/types/FamInstEnv.hs | 6 | ||||
| -rw-r--r-- | testsuite/tests/ghci/scripts/GhciKinds.hs | 4 | ||||
| -rw-r--r-- | testsuite/tests/ghci/scripts/GhciKinds.script | 5 | ||||
| -rw-r--r-- | testsuite/tests/ghci/scripts/GhciKinds.stdout | 6 |
4 files changed, 19 insertions, 2 deletions
diff --git a/compiler/types/FamInstEnv.hs b/compiler/types/FamInstEnv.hs index e366037aae..25787264ac 100644 --- a/compiler/types/FamInstEnv.hs +++ b/compiler/types/FamInstEnv.hs @@ -806,8 +806,10 @@ reduceTyFamApp_maybe envs role tc tys -- (e.g. the call in topNormaliseType_maybe) then we can -- unwrap data families as well as type-synonym families; -- otherwise only type-synonym families - , [FamInstMatch { fim_instance = fam_inst - , fim_tys = inst_tys }] <- lookupFamInstEnv envs tc ntys + , FamInstMatch { fim_instance = fam_inst + , fim_tys = inst_tys } : _ <- lookupFamInstEnv envs tc ntys + -- NB: Allow multiple matches because of compatible overlap + = let ax = famInstAxiom fam_inst co = mkUnbranchedAxInstCo role ax inst_tys ty = pSnd (coercionKind co) diff --git a/testsuite/tests/ghci/scripts/GhciKinds.hs b/testsuite/tests/ghci/scripts/GhciKinds.hs index 4945814ff9..8e1af372ee 100644 --- a/testsuite/tests/ghci/scripts/GhciKinds.hs +++ b/testsuite/tests/ghci/scripts/GhciKinds.hs @@ -4,3 +4,7 @@ module GhciKinds where type family F a :: * type instance F [a] = a -> F a type instance F Int = Bool + +-- test ":kind!" in the presence of compatible overlap +type instance F (Maybe a) = Char +type instance F (Maybe Int) = Char diff --git a/testsuite/tests/ghci/scripts/GhciKinds.script b/testsuite/tests/ghci/scripts/GhciKinds.script index 310c2a8c3d..fa9401524c 100644 --- a/testsuite/tests/ghci/scripts/GhciKinds.script +++ b/testsuite/tests/ghci/scripts/GhciKinds.script @@ -3,3 +3,8 @@ :l GhciKinds :kind F [[[Int]]] :kind! F [[[Int]]] +:kind! F (Maybe Int) +:kind! F (Maybe Bool) + +:seti -XRankNTypes +:kind! forall a. F (Maybe a) diff --git a/testsuite/tests/ghci/scripts/GhciKinds.stdout b/testsuite/tests/ghci/scripts/GhciKinds.stdout index 3961994e09..e34b84a42a 100644 --- a/testsuite/tests/ghci/scripts/GhciKinds.stdout +++ b/testsuite/tests/ghci/scripts/GhciKinds.stdout @@ -3,3 +3,9 @@ Maybe :: * -> * F [[[Int]]] :: * F [[[Int]]] :: * = [[Int]] -> [Int] -> Int -> Bool +F (Maybe Int) :: * += Char +F (Maybe Bool) :: * += Char +forall a. F (Maybe a) :: * += Char |