Skip to content
GitLab
Projects
Groups
Snippets
/
Help
Help
Support
Community forum
Keyboard shortcuts
?
Submit feedback
Sign in / Register
Toggle navigation
Menu
Open sidebar
Glasgow Haskell Compiler
GHC
Commits
571f0adc
Commit
571f0adc
authored
Jun 12, 2014
by
Simon Peyton Jones
Browse files
Line up kind and type variables correctly when desugaring TH brackets
This bug was causing Trac
#9199
parent
b60df0fa
Changes
3
Hide whitespace changes
Inline
Side-by-side
compiler/deSugar/DsMeta.hs
View file @
571f0adc
...
...
@@ -63,6 +63,7 @@ import DynFlags
import
FastString
import
ForeignCall
import
Util
import
TcRnMonad
(
traceOptIf
)
import
Data.Maybe
import
Control.Monad
...
...
@@ -707,12 +708,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
fresh
N
ames
term
}
;
wrapGenSyms
fresh
_n
ames
term
}
where
mk_tv_bndr
(
tv
,
(
_
,
v
))
=
repTyVarBndrWithKind
tv
(
coreVar
v
)
...
...
testsuite/tests/th/T9199.hs
0 → 100644
View file @
571f0adc
{-# LANGUAGE TemplateHaskell, PolyKinds, TypeFamilies #-}
module
T9160
where
$
(
[
d
|
class C (a :: k) where
type F (a :: k) :: *
|]
)
testsuite/tests/th/all.T
View file @
571f0adc
...
...
@@ -327,4 +327,5 @@ test('T8954', normal, compile, ['-v0'])
test
('
T8932
',
normal
,
compile_fail
,
['
-v0
'])
test
('
T8987
',
normal
,
compile_fail
,
['
-v0
'])
test
('
T7241
',
normal
,
compile_fail
,
['
-v0
'])
test
('
T9199
',
normal
,
compile
,
['
-v0
'])
Administrator
@root
mentioned in commit
1eaaeb7a
·
Dec 17, 2018
mentioned in commit
1eaaeb7a
mentioned in commit 1eaaeb7a01843ee9aacc86354cf886a5a9952123
Toggle commit list
Write
Preview
Supports
Markdown
0%
Try again
or
attach a new file
.
Cancel
You are about to add
0
people
to the discussion. Proceed with caution.
Finish editing this message first!
Cancel
Please
register
or
sign in
to comment