diff options
| author | Simon Peyton Jones <simonpj@microsoft.com> | 2014-06-12 16:36:59 +0100 |
|---|---|---|
| committer | Austin Seipp <austin@well-typed.com> | 2014-06-30 08:42:43 -0500 |
| commit | 1eaaeb7a01843ee9aacc86354cf886a5a9952123 (patch) | |
| tree | 7df8e8c5a0127f65232e18ff1df94d1ab844213d | |
| parent | 37182fa8e6a752b42b8acff5499a5f4cc3346c20 (diff) | |
| download | haskell-1eaaeb7a01843ee9aacc86354cf886a5a9952123.tar.gz | |
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
| -rw-r--r-- | compiler/deSugar/DsMeta.hs | 13 | ||||
| -rw-r--r-- | testsuite/tests/th/T9199.hs | 9 | ||||
| -rw-r--r-- | 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 9ee5bc1bb7..a0245dd258 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 0000000000..aa41198b57 --- /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 841b41bdb6..0b1679da70 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']) |