diff options
author | Austin Seipp <austin@well-typed.com> | 2014-02-20 01:28:00 -0600 |
---|---|---|
committer | Austin Seipp <austin@well-typed.com> | 2014-02-20 03:13:41 -0600 |
commit | d3af9807ca8a1db0bc9298ea50895ee9df55edb7 (patch) | |
tree | 0fadedf88fdfde1290c6d5adc859711b0ffa50fa | |
parent | f99a0321a8cf0507924a0d30b6b7b586d7855129 (diff) | |
download | haskell-d3af9807ca8a1db0bc9298ea50895ee9df55edb7.tar.gz |
Really fix #5682 (parsing of promoted datacons)
Patch submitted by an anonymous friend on the bug tracker.
This also fixes TH_RichKinds2 which had a slight message output wibble
(it uses the qualified name of the promoted datacon)
Signed-off-by: Austin Seipp <austin@well-typed.com>
-rw-r--r-- | compiler/parser/Parser.y.pp | 7 | ||||
-rw-r--r-- | testsuite/tests/th/TH_RichKinds2.stderr | 2 |
2 files changed, 4 insertions, 5 deletions
diff --git a/compiler/parser/Parser.y.pp b/compiler/parser/Parser.y.pp index d2bc463b62..27d6c3839f 100644 --- a/compiler/parser/Parser.y.pp +++ b/compiler/parser/Parser.y.pp @@ -1151,12 +1151,11 @@ atype :: { LHsType RdrName } | TH_ID_SPLICE { LL $ mkHsSpliceTy $ L1 $ HsVar $ mkUnqual varName (getTH_ID_SPLICE $1) } -- see Note [Promotion] for the followings - | SIMPLEQUOTE qconid { LL $ HsTyVar $ unLoc $2 } - | SIMPLEQUOTE '(' ')' { LL $ HsTyVar $ getRdrName unitDataCon } + | SIMPLEQUOTE qcon { LL $ HsTyVar $ unLoc $2 } | SIMPLEQUOTE '(' ctype ',' comma_types1 ')' { LL $ HsExplicitTupleTy [] ($3 : $5) } | SIMPLEQUOTE '[' comma_types0 ']' { LL $ HsExplicitListTy placeHolderKind $3 } - | SIMPLEQUOTE '(' qconop ')' { LL $ HsTyVar (unLoc $3) } - | SIMPLEQUOTE '(' varop ')' { LL $ HsTyVar (unLoc $3) } + | SIMPLEQUOTE var { LL $ HsTyVar $ unLoc $2 } + | '[' ctype ',' comma_types1 ']' { LL $ HsExplicitListTy placeHolderKind ($2 : $4) } | INTEGER {% mkTyLit $ LL $ HsNumTy $ getINTEGER $1 } | STRING {% mkTyLit $ LL $ HsStrTy $ getSTRING $1 } diff --git a/testsuite/tests/th/TH_RichKinds2.stderr b/testsuite/tests/th/TH_RichKinds2.stderr index 625d03e961..8370df332d 100644 --- a/testsuite/tests/th/TH_RichKinds2.stderr +++ b/testsuite/tests/th/TH_RichKinds2.stderr @@ -3,7 +3,7 @@ TH_RichKinds2.hs:23:4: Warning: data SMaybe_0 (t_1 :: k_0 -> *) (t_3 :: Data.Maybe.Maybe k_0) = forall . t_3 ~ 'Data.Maybe.Nothing => SNothing_4 | forall a_5 . t_3 ~ 'Data.Maybe.Just a_5 => SJust_6 (t_1 a_5) -type instance TH_RichKinds2.Map f_7 '[] = '[] +type instance TH_RichKinds2.Map f_7 'GHC.Types.[] = 'GHC.Types.[] type instance TH_RichKinds2.Map f_8 ('GHC.Types.: h_9 t_10) = 'GHC.Types.: (f_8 h_9) (TH_RichKinds2.Map f_8 t_10) |