[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