[commit: ghc] ghc-7.8: Line up kind and type variables correctly when desugaring TH brackets (1eaaeb7)

[git at git.haskell.org]

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

On branch  : ghc-7.8
Link       : http://ghc.haskell.org/trac/ghc/changeset/1eaaeb7a01843ee9aacc86354cf886a5a9952123/ghc

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

commit 1eaaeb7a01843ee9aacc86354cf886a5a9952123
Author: Simon Peyton Jones <simonpj at microsoft.com>
Date:   Thu Jun 12 16:36:59 2014 +0100

    Line up kind and type variables correctly when desugaring TH brackets
    
    This bug was causing Trac #9199
    
    (cherry picked from commit 571f0adccda687098d59f63524357f4ac98e72fb)
    
    Conflicts:
    	testsuite/tests/th/all.T


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

1eaaeb7a01843ee9aacc86354cf886a5a9952123
 compiler/deSugar/DsMeta.hs  | 13 ++++++++-----
 testsuite/tests/th/T9199.hs |  9 +++++++++
 testsuite/tests/th/all.T    |  1 +
 3 files changed, 18 insertions(+), 5 deletions(-)

diff --git a/compiler/deSugar/DsMeta.hs b/compiler/deSugar/DsMeta.hs
index 9ee5bc1..a0245dd 100644
--- a/compiler/deSugar/DsMeta.hs
+++ b/compiler/deSugar/DsMeta.hs
@@ -61,6 +61,7 @@ import DynFlags
 import FastString
 import ForeignCall
 import Util
+import TcRnMonad( traceOptIf )
 
 import Data.Maybe
 import Control.Monad
@@ -705,12 +706,14 @@ addTyVarBinds :: LHsTyVarBndrs Name                            -- the binders to
 -- the computations passed as the second argument is executed in that extended
 -- meta environment and gets the *new* names on Core-level as an argument
 
-addTyVarBinds tvs m
-  = do { freshNames <- mkGenSyms (hsLKiTyVarNames tvs)
-       ; term <- addBinds freshNames $
-                 do { kbs <- repList tyVarBndrTyConName mk_tv_bndr (hsQTvBndrs tvs `zip` freshNames)
+addTyVarBinds (HsQTvs { hsq_kvs = kvs, hsq_tvs = tvs }) m
+  = do { fresh_kv_names <- mkGenSyms kvs
+       ; fresh_tv_names <- mkGenSyms (map hsLTyVarName tvs)
+       ; let fresh_names = fresh_kv_names ++ fresh_tv_names
+       ; term <- addBinds fresh_names $
+                 do { kbs <- repList tyVarBndrTyConName mk_tv_bndr (tvs `zip` fresh_tv_names)
                     ; m kbs }
-       ; wrapGenSyms freshNames term }
+       ; wrapGenSyms fresh_names term }
   where
     mk_tv_bndr (tv, (_,v)) = repTyVarBndrWithKind tv (coreVar v)
 
diff --git a/testsuite/tests/th/T9199.hs b/testsuite/tests/th/T9199.hs
new file mode 100644
index 0000000..aa41198
--- /dev/null
+++ b/testsuite/tests/th/T9199.hs
@@ -0,0 +1,9 @@
+{-# LANGUAGE TemplateHaskell, PolyKinds, TypeFamilies #-}
+
+module T9160 where
+
+$( [d| class C (a :: k) where
+          type F (a :: k) :: *
+    |]
+ )
+
diff --git a/testsuite/tests/th/all.T b/testsuite/tests/th/all.T
index 841b41b..0b1679d 100644
--- a/testsuite/tests/th/all.T
+++ b/testsuite/tests/th/all.T
@@ -323,3 +323,4 @@ test('T8884', normal, compile, ['-v0'])
 test('T8932', normal, compile_fail, ['-v0'])
 test('T8954', normal, compile, ['-v0'])
 test('T7241', normal, compile_fail, ['-v0'])
+test('T9199', normal, compile, ['-v0'])