[commit: ghc] ghc-8.2: Revert "Fix #11963 by checking for more mixed type/kinds" (5e2d3e6)
git at git.haskell.org
git at git.haskell.org
Mon Oct 2 14:14:14 UTC 2017
Repository : ssh://git@git.haskell.org/ghc
On branch : ghc-8.2
Link : http://ghc.haskell.org/trac/ghc/changeset/5e2d3e6d06a051dd30c0ce1919cd2d3d0ece087b/ghc
>---------------------------------------------------------------
commit 5e2d3e6d06a051dd30c0ce1919cd2d3d0ece087b
Author: Ben Gamari <ben at smart-cactus.org>
Date: Mon Oct 2 10:13:42 2017 -0400
Revert "Fix #11963 by checking for more mixed type/kinds"
This reverts commit 18dee8912f6afdcf13073d3d95d85513c14180e3.
It causes a few Hackage programs to be rejected, which we want to avoid
for a point release.
>---------------------------------------------------------------
5e2d3e6d06a051dd30c0ce1919cd2d3d0ece087b
compiler/rename/RnTypes.hs | 25 ++++---------------
testsuite/tests/typecheck/should_fail/T11963.hs | 29 ----------------------
.../tests/typecheck/should_fail/T11963.stderr | 20 ---------------
testsuite/tests/typecheck/should_fail/all.T | 1 -
4 files changed, 5 insertions(+), 70 deletions(-)
diff --git a/compiler/rename/RnTypes.hs b/compiler/rename/RnTypes.hs
index 58d7c9f..589cc02 100644
--- a/compiler/rename/RnTypes.hs
+++ b/compiler/rename/RnTypes.hs
@@ -1707,25 +1707,11 @@ extract_hs_tv_bndrs tvs
= do { FKTV bndr_kvs _
<- foldrM extract_lkind emptyFKTV [k | L _ (KindedTyVar _ k) <- tvs]
- ; let locals = map hsLTyVarLocName tvs
-
- -- These checks are all tested in typecheck/should_fail/T11963
- ; check_for_mixed_vars bndr_kvs acc_tvs
- ; check_for_mixed_vars bndr_kvs body_tvs
- ; check_for_mixed_vars body_tvs acc_kvs
- ; check_for_mixed_vars body_kvs acc_tvs
- ; check_for_mixed_vars locals body_kvs
-
+ ; let locals = map hsLTyVarName tvs
; return $
- FKTV (filterOut (`elemRdr` locals) (bndr_kvs ++ body_kvs)
+ FKTV (filterOut ((`elem` locals) . unLoc) (bndr_kvs ++ body_kvs)
++ acc_kvs)
- (filterOut (`elemRdr` locals) body_tvs ++ acc_tvs) }
- where
- check_for_mixed_vars :: [Located RdrName] -> [Located RdrName] -> RnM ()
- check_for_mixed_vars tvs1 tvs2 = mapM_ check tvs1
- where
- check tv1 = when (isRdrTyVar (unLoc tv1) && (tv1 `elemRdr` tvs2)) $
- mixedVarsErr tv1
+ (filterOut ((`elem` locals) . unLoc) body_tvs ++ acc_tvs) }
extract_tv :: TypeOrKind -> Located RdrName -> FreeKiTyVars -> RnM FreeKiTyVars
extract_tv t_or_k ltv@(L _ tv) acc
@@ -1740,6 +1726,8 @@ extract_tv t_or_k ltv@(L _ tv) acc
mixedVarsErr ltv
; return (FKTV (ltv : kvs) tvs) }
| otherwise = return acc
+ where
+ elemRdr x = any (eqLocated x)
mixedVarsErr :: Located RdrName -> RnM ()
mixedVarsErr (L loc tv)
@@ -1752,6 +1740,3 @@ mixedVarsErr (L loc tv)
-- just used in this module; seemed convenient here
nubL :: Eq a => [Located a] -> [Located a]
nubL = nubBy eqLocated
-
-elemRdr :: Located RdrName -> [Located RdrName] -> Bool
-elemRdr x = any (eqLocated x)
diff --git a/testsuite/tests/typecheck/should_fail/T11963.hs b/testsuite/tests/typecheck/should_fail/T11963.hs
deleted file mode 100644
index c4f78ae..0000000
--- a/testsuite/tests/typecheck/should_fail/T11963.hs
+++ /dev/null
@@ -1,29 +0,0 @@
-{-# LANGUAGE GADTs, PolyKinds, RankNTypes #-}
-
-module T11963 where
-
--- this module should be rejected without TypeInType
-
-import Data.Proxy
-
--- see code in RnTypes.extract_hs_tv_bndrs which checks for these bad cases
-
- -- bndr_kvs vs body_tvs
-data Typ k t where
- Typ :: (forall (a :: k -> *). a t -> a t) -> Typ k t
-
- -- bndr_kvs vs acc_tvs
-foo :: (forall (t :: k). Proxy t) -> Proxy k
-foo _ = undefined
-
- -- locals vs body_kvs
-bar :: forall k. forall (t :: k). Proxy t
-bar = undefined
-
- -- body_kvs vs acc_tvs
-quux :: (forall t. Proxy (t :: k)) -> Proxy k
-quux _ = undefined
-
- -- body_tvs vs acc_kvs
-blargh :: (forall a. a -> Proxy k) -> Proxy (t :: k)
-blargh _ = undefined
diff --git a/testsuite/tests/typecheck/should_fail/T11963.stderr b/testsuite/tests/typecheck/should_fail/T11963.stderr
deleted file mode 100644
index 74c3ab0..0000000
--- a/testsuite/tests/typecheck/should_fail/T11963.stderr
+++ /dev/null
@@ -1,20 +0,0 @@
-
-T11963.hs:13:26: error:
- Variable ‘k’ used as both a kind and a type
- Did you intend to use TypeInType?
-
-T11963.hs:16:22: error:
- Variable ‘k’ used as both a kind and a type
- Did you intend to use TypeInType?
-
-T11963.hs:20:15: error:
- Variable ‘k’ used as both a kind and a type
- Did you intend to use TypeInType?
-
-T11963.hs:24:32: error:
- Variable ‘k’ used as both a kind and a type
- Did you intend to use TypeInType?
-
-T11963.hs:28:33: error:
- Variable ‘k’ used as both a kind and a type
- Did you intend to use TypeInType?
diff --git a/testsuite/tests/typecheck/should_fail/all.T b/testsuite/tests/typecheck/should_fail/all.T
index 9f9752a..2f75316 100644
--- a/testsuite/tests/typecheck/should_fail/all.T
+++ b/testsuite/tests/typecheck/should_fail/all.T
@@ -434,7 +434,6 @@ test('T12709', normal, compile_fail, [''])
test('T13446', normal, compile_fail, [''])
test('T13320', normal, compile_fail, [''])
test('T13677', normal, compile_fail, [''])
-test('T11963', normal, compile_fail, [''])
test('T14000', normal, compile_fail, [''])
test('T11672', normal, compile_fail, [''])
test('T13929', normal, compile_fail, [''])
More information about the ghc-commits
mailing list