From 0da85d41ee6bc7f941cdbee8cebd5b57fa35396f Mon Sep 17 00:00:00 2001
From: Alan Zimmerman <alan.zimm@gmail.com>
Date: Fri, 14 May 2021 12:33:01 +0100
Subject: EPA: Fix explicit specificity and unicode linear arrow annotations

Closes #19839
Closes #19840
---
 compiler/GHC/Parser.y             | 9 ++++++---
 compiler/GHC/Parser/Annotation.hs | 2 ++
 2 files changed, 8 insertions(+), 3 deletions(-)

(limited to 'compiler')

diff --git a/compiler/GHC/Parser.y b/compiler/GHC/Parser.y
index 44ca8fa042..38c5233ab4 100644
--- a/compiler/GHC/Parser.y
+++ b/compiler/GHC/Parser.y
@@ -2151,7 +2151,7 @@ type :: { LHsType GhcPs }
 
         | btype '->.' ctype            {% hintLinear (getLoc $2) >>
                                           acsA (\cs -> sLL (reLoc $1) (reLoc $>)
-                                            $ HsFunTy (EpAnn (glAR $1) (mau $2) cs) (HsLinearArrow UnicodeSyntax Nothing) $1 $3) }
+                                            $ HsFunTy (EpAnn (glAR $1) (mlu $2) cs) (HsLinearArrow UnicodeSyntax Nothing) $1 $3) }
                                               -- [mu AnnLollyU $2] }
 
 mult :: { Located (IsUnicodeSyntax -> HsArrow GhcPs) }
@@ -2271,8 +2271,8 @@ tv_bndrs :: { [LHsTyVarBndr Specificity GhcPs] }
 
 tv_bndr :: { LHsTyVarBndr Specificity GhcPs }
         : tv_bndr_no_braces             { $1 }
-        | '{' tyvar '}'                 {% acsA (\cs -> sLL $1 $> (UserTyVar (EpAnn (glR $1) [mop $1, mcp $3] cs) InferredSpec $2)) }
-        | '{' tyvar '::' kind '}'       {% acsA (\cs -> sLL $1 $> (KindedTyVar (EpAnn (glR $1) [mop $1,mu AnnDcolon $3 ,mcp $5] cs) InferredSpec $2 $4)) }
+        | '{' tyvar '}'                 {% acsA (\cs -> sLL $1 $> (UserTyVar (EpAnn (glR $1) [moc $1, mcc $3] cs) InferredSpec $2)) }
+        | '{' tyvar '::' kind '}'       {% acsA (\cs -> sLL $1 $> (KindedTyVar (EpAnn (glR $1) [moc $1,mu AnnDcolon $3 ,mcc $5] cs) InferredSpec $2 $4)) }
 
 tv_bndr_no_braces :: { LHsTyVarBndr Specificity GhcPs }
         : tyvar                         {% acsA (\cs -> (sL1 (reLocN $1) (UserTyVar (EpAnn (glNR $1) [] cs) SpecifiedSpec $1))) }
@@ -4175,6 +4175,9 @@ mau :: Located Token -> TrailingAnn
 mau lt@(L l t) = if isUnicode lt then AddRarrowAnnU (EpaSpan $ rs l)
                                  else AddRarrowAnn  (EpaSpan $ rs l)
 
+mlu :: Located Token -> TrailingAnn
+mlu lt@(L l t) = AddLollyAnnU (EpaSpan $ rs l)
+
 -- | If the 'Token' is using its unicode variant return the unicode variant of
 --   the annotation
 toUnicodeAnn :: AnnKeywordId -> Located Token -> AnnKeywordId
diff --git a/compiler/GHC/Parser/Annotation.hs b/compiler/GHC/Parser/Annotation.hs
index e2701709f3..ab88285274 100644
--- a/compiler/GHC/Parser/Annotation.hs
+++ b/compiler/GHC/Parser/Annotation.hs
@@ -622,6 +622,7 @@ data TrailingAnn
   | AddVbarAnn EpaLocation    -- ^ Trailing '|'
   | AddRarrowAnn EpaLocation  -- ^ Trailing '->'
   | AddRarrowAnnU EpaLocation -- ^ Trailing '->', unicode variant
+  | AddLollyAnnU EpaLocation  -- ^ Trailing '⊸'
   deriving (Data,Show,Eq, Ord)
 
 instance Outputable TrailingAnn where
@@ -630,6 +631,7 @@ instance Outputable TrailingAnn where
   ppr (AddVbarAnn ss)    = text "AddVbarAnn"    <+> ppr ss
   ppr (AddRarrowAnn ss)  = text "AddRarrowAnn"  <+> ppr ss
   ppr (AddRarrowAnnU ss) = text "AddRarrowAnnU" <+> ppr ss
+  ppr (AddLollyAnnU ss)  = text "AddLollyAnnU"  <+> ppr ss
 
 -- | Annotation for items appearing in a list. They can have one or
 -- more trailing punctuations items, such as commas or semicolons.
-- 
cgit v1.2.1