diff options
| author | Alec Theriault <alec.theriault@gmail.com> | 2018-10-04 18:13:15 -0400 |
|---|---|---|
| committer | Ryan Scott <ryan.gl.scott@gmail.com> | 2018-10-04 18:13:16 -0400 |
| commit | ba163c3b3502df039e589c5bb0bc9ea767267b2a (patch) | |
| tree | f33232f02ca1c775694153381e3b0d69771c89c4 /compiler/hsSyn | |
| parent | bace26aadaafa4064e78f9ed088c1e2217221acc (diff) | |
| download | haskell-ba163c3b3502df039e589c5bb0bc9ea767267b2a.tar.gz | |
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
Diffstat (limited to 'compiler/hsSyn')
| -rw-r--r-- | compiler/hsSyn/Convert.hs | 22 |
1 files changed, 13 insertions, 9 deletions
diff --git a/compiler/hsSyn/Convert.hs b/compiler/hsSyn/Convert.hs index f7713fff87..d094e17a14 100644 --- a/compiler/hsSyn/Convert.hs +++ b/compiler/hsSyn/Convert.hs @@ -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' -> |