From b27517a53ef4a8cdc62d52289600f02e28a46a7c Mon Sep 17 00:00:00 2001
From: Austin Seipp <austin@well-typed.com>
Date: Thu, 20 Feb 2014 01:28:00 -0600
Subject: [PATCH] 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>
(cherry picked from commit d3af9807ca8a1db0bc9298ea50895ee9df55edb7)
---
compiler/parser/Parser.y.pp | 7 +++----
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 d2bc463b621c..27d6c3839f1a 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 625d03e9615f..8370df332d31 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)
--
GitLab