[commit: ghc] wip/rae: Fix egregious duplication of vars in RnTypes (288427c)

[git at git.haskell.org]

Repository : ssh://git@git.haskell.org/ghc

On branch  : wip/rae
Link       : http://ghc.haskell.org/trac/ghc/changeset/288427cb70f8ca72a73a2de7fb6e6b22574558a8/ghc

>---------------------------------------------------------------

commit 288427cb70f8ca72a73a2de7fb6e6b22574558a8
Author: Richard Eisenberg <rae at cs.brynmawr.edu>
Date:   Wed Aug 16 15:07:16 2017 -0400

    Fix egregious duplication of vars in RnTypes
    
    RnTypes contains a fairly intricate algorith to extract the
    kind and type variables of an HsType. This algorithm carefully
    maintains the separation between type variables and kind variables
    so that the difference between -XPolyKinds and -XTypeInType can
    be respected.
    
    But it stupidly just concatenated the lists at the end. If a variable
    were used as both a type and a kind, the algorithm would produce
    *both*! This led to all kinds of problems, including #13988.
    
    test case: ghci/scripts/T13988


>---------------------------------------------------------------

288427cb70f8ca72a73a2de7fb6e6b22574558a8
 compiler/rename/RnTypes.hs                 | 11 ++++++-----
 testsuite/tests/ghci/scripts/T13988.hs     |  8 ++++++++
 testsuite/tests/ghci/scripts/T13988.script |  2 ++
 testsuite/tests/ghci/scripts/T13988.stdout |  1 +
 testsuite/tests/ghci/scripts/all.T         |  1 +
 5 files changed, 18 insertions(+), 5 deletions(-)

diff --git a/compiler/rename/RnTypes.hs b/compiler/rename/RnTypes.hs
index cfe1517..df9ded2 100644
--- a/compiler/rename/RnTypes.hs
+++ b/compiler/rename/RnTypes.hs
@@ -1575,10 +1575,8 @@ extractHsTyRdrTyVars :: LHsType GhcPs -> RnM FreeKiTyVars
 -- occurrence is returned.
 -- See Note [Kind and type-variable binders]
 extractHsTyRdrTyVars ty
-  = do { FKTV kis tys <- extract_lty TypeLevel ty emptyFKTV
-       ; return (FKTV (nubL kis)
-                      (nubL tys)) }
-
+  = do { fvs <- extract_lty TypeLevel ty emptyFKTV
+       ; return (rmDupsInRdrTyVars fvs) }
 
 -- | Extracts free type and kind variables from types in a list.
 -- When the same name occurs multiple times in the types, only the first
@@ -1598,7 +1596,10 @@ extractHsTysRdrTyVarsDups tys
 -- | Removes multiple occurrences of the same name from FreeKiTyVars.
 rmDupsInRdrTyVars :: FreeKiTyVars -> FreeKiTyVars
 rmDupsInRdrTyVars (FKTV kis tys)
-  = FKTV (nubL kis) (nubL tys)
+  = FKTV kis' tys'
+  where
+    kis' = nubL kis
+    tys' = nubL (filterOut (`elemRdr` kis') tys)
 
 extractRdrKindSigVars :: LFamilyResultSig GhcPs -> RnM [Located RdrName]
 extractRdrKindSigVars (L _ resultSig)
diff --git a/testsuite/tests/ghci/scripts/T13988.hs b/testsuite/tests/ghci/scripts/T13988.hs
new file mode 100644
index 0000000..54969ca
--- /dev/null
+++ b/testsuite/tests/ghci/scripts/T13988.hs
@@ -0,0 +1,8 @@
+{-# LANGUAGE TypeInType, GADTs #-}
+
+module T13988 where
+
+import Data.Kind
+
+data Foo (a :: k) where
+  MkFoo :: (k ~ Type) => Foo (a :: k)
diff --git a/testsuite/tests/ghci/scripts/T13988.script b/testsuite/tests/ghci/scripts/T13988.script
new file mode 100644
index 0000000..06aa686
--- /dev/null
+++ b/testsuite/tests/ghci/scripts/T13988.script
@@ -0,0 +1,2 @@
+:load T13988
+:type +v MkFoo
diff --git a/testsuite/tests/ghci/scripts/T13988.stdout b/testsuite/tests/ghci/scripts/T13988.stdout
new file mode 100644
index 0000000..a89ff33
--- /dev/null
+++ b/testsuite/tests/ghci/scripts/T13988.stdout
@@ -0,0 +1 @@
+MkFoo :: forall k (a :: k). (k ~ *) => Foo a
diff --git a/testsuite/tests/ghci/scripts/all.T b/testsuite/tests/ghci/scripts/all.T
index 48dc864..bbb9110 100755
--- a/testsuite/tests/ghci/scripts/all.T
+++ b/testsuite/tests/ghci/scripts/all.T
@@ -258,3 +258,4 @@ test('T13591', expect_broken(13591), ghci_script, ['T13591.script'])
 test('T13699', normal, ghci_script, ['T13699.script'])
 test('T13407', normal, ghci_script, ['T13407.script'])
 test('T13963', normal, ghci_script, ['T13963.script'])
+test('T13988', normal, ghci_script, ['T13988.script'])