Commit ba163c3b authored by Alec Theriault's avatar Alec Theriault Committed by Ryan Scott

Don't drop arguments in TH type arguments

Summary:
When converting from TH AST back to HsType, we were occasionally
dropping type arguments. This resulted in incorrectly accepted programs
as well as incorrectly rejected programs.

Test Plan: make TEST=T15360a && make TEST=T15360b

Reviewers: goldfire, bgamari, tdammers

Reviewed By: bgamari, tdammers

Subscribers: RyanGlScott, rwbarton, carter

GHC Trac Issues: #15360

Differential Revision: https://phabricator.haskell.org/D5188
parent bace26aa
......@@ -1355,7 +1355,7 @@ cvtTypeKind ty_str ty
}
LitT lit
-> returnL (HsTyLit noExt (cvtTyLit lit))
-> mk_apps (HsTyLit noExt (cvtTyLit lit)) tys'
WildCardT
-> mk_apps mkAnonWildCardTy tys'
......@@ -1364,17 +1364,19 @@ cvtTypeKind ty_str ty
-> do { s' <- tconName s
; t1' <- cvtType t1
; t2' <- cvtType t2
; mk_apps (HsTyVar noExt NotPromoted (noLoc s')) [t1', t2']
; mk_apps (HsTyVar noExt NotPromoted (noLoc s'))
(t1' : t2' : tys')
}
UInfixT t1 s t2
-> do { t2' <- cvtType t2
; cvtOpAppT t1 s t2'
} -- Note [Converting UInfix]
; t <- cvtOpAppT t1 s t2' -- Note [Converting UInfix]
; mk_apps (unLoc t) tys'
}
ParensT t
-> do { t' <- cvtType t
; returnL $ HsParTy noExt t'
; mk_apps (HsParTy noExt t') tys'
}
PromotedT nm -> do { nm' <- cName nm
......@@ -1394,7 +1396,7 @@ cvtTypeKind ty_str ty
m = length tys'
PromotedNilT
-> returnL (HsExplicitListTy noExt Promoted [])
-> mk_apps (HsExplicitListTy noExt Promoted []) tys'
PromotedConsT -- See Note [Representing concrete syntax in types]
-- in Language.Haskell.TH.Syntax
......@@ -1406,12 +1408,14 @@ cvtTypeKind ty_str ty
tys'
StarT
-> returnL (HsTyVar noExt NotPromoted (noLoc
(getRdrName liftedTypeKindTyCon)))
-> mk_apps (HsTyVar noExt NotPromoted
(noLoc (getRdrName liftedTypeKindTyCon)))
tys'
ConstraintT
-> returnL (HsTyVar noExt NotPromoted
-> mk_apps (HsTyVar noExt NotPromoted
(noLoc (getRdrName constraintKindTyCon)))
tys'
EqualityT
| [x',y'] <- tys' ->
......
{-# LANGUAGE TemplateHaskell #-}
module T15360a where
import Language.Haskell.TH
data T a b c = Mk a b c
bar :: $( return $ AppT (InfixT (ConT ''Int) ''T (ConT ''Bool)) (ConT ''Double) )
bar = Mk 5 True 3.14
baz :: $( return $ AppT (ParensT (ConT ''Maybe)) (ConT ''Int) )
baz = Just 5
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE QuasiQuotes #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE StarIsType #-}
module T15360b where
import Data.Kind
import Data.Proxy
x :: Proxy $([t| * Double |])
x = Proxy
y :: Proxy $([t| 1 Int |])
y = Proxy
z :: Proxy $([t| Constraint Bool |])
z = Proxy
w :: Proxy $([t| '[] Int |])
w = Proxy
T15360b.hs:10:14: error:
• Expected kind ‘* -> k4’, but ‘Type’ has kind ‘*’
• In the first argument of ‘Proxy’, namely ‘(Type Double)’
In the type signature: x :: Proxy (Type Double)
T15360b.hs:13:14: error:
• Expected kind ‘* -> k3’, but ‘1’ has kind ‘GHC.Types.Nat’
• In the first argument of ‘Proxy’, namely ‘(1 Int)’
In the type signature: y :: Proxy (1 Int)
T15360b.hs:16:14: error:
• Expected kind ‘* -> k2’, but ‘Constraint’ has kind ‘*’
• In the first argument of ‘Proxy’, namely ‘(Constraint Bool)’
In the type signature: z :: Proxy (Constraint Bool)
T15360b.hs:19:14: error:
• Expected kind ‘* -> k1’, but ‘'[]’ has kind ‘[k0]’
• In the first argument of ‘Proxy’, namely ‘('[] Int)’
In the type signature: w :: Proxy ('[] Int)
......@@ -419,6 +419,8 @@ test('T15321', normal, compile_fail, [''])
test('T15324', normal, compile, ['-v0 -ddump-splices -dsuppress-uniques'])
test('T15331', normal, compile, ['-v0 -ddump-splices -dsuppress-uniques'])
test('T15365', normal, compile, ['-v0 -ddump-splices -dsuppress-uniques'])
test('T15360a', normal, compile, [''])
test('T15360b', normal, compile_fail, [''])
# Note: T9693 should be only_ways(['ghci']) once it's fixed.
test('T9693', expect_broken(9693), ghci_script, ['T9693.script'])
test('T14471', normal, compile, [''])
......
Markdown is supported
0%
or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment