summaryrefslogtreecommitdiff
path: root/compiler/GHC/Parser.y
diff options
context:
space:
mode:
authorAlan Zimmerman <alan.zimm@gmail.com>2020-10-04 20:46:41 +0100
committerAlan Zimmerman <alan.zimm@gmail.com>2020-10-20 08:35:34 +0100
commitea736839d85594c95490dcf02d3325c2bbc68f33 (patch)
tree6f6c0335e216f67b63caf9e4a46d3e5bb6e852af /compiler/GHC/Parser.y
parent59b08a5d192e102f66a6d9260cc8466d7428cffe (diff)
downloadhaskell-ea736839d85594c95490dcf02d3325c2bbc68f33.tar.gz
API Annotations: Keep track of unicode for linear arrow notationwip/az/unicode-hsscaled
The linear arrow can be parsed as `%1 ->` or a direct single token unicode equivalent. Make sure that this distinction is captured in the parsed AST by using IsUnicodeSyntax where it appears, and introduce a new API Annotation, AnnMult to represent its location when unicode is not used. Updated haddock submodule
Diffstat (limited to 'compiler/GHC/Parser.y')
-rw-r--r--compiler/GHC/Parser.y21
1 files changed, 12 insertions, 9 deletions
diff --git a/compiler/GHC/Parser.y b/compiler/GHC/Parser.y
index b688b86310..666b329e84 100644
--- a/compiler/GHC/Parser.y
+++ b/compiler/GHC/Parser.y
@@ -2051,22 +2051,22 @@ is connected to the first type too.
type :: { LHsType GhcPs }
-- See Note [%shift: type -> btype]
: btype %shift { $1 }
- | btype '->' ctype {% ams $1 [mu AnnRarrow $2] -- See note [GADT decl discards annotations]
- >> ams (sLL $1 $> $ HsFunTy noExtField HsUnrestrictedArrow $1 $3)
+ | btype '->' ctype {% ams $1 [mu AnnRarrow $2] -- See Note [GADT decl discards annotations]
+ >> ams (sLL $1 $> $ HsFunTy noExtField (HsUnrestrictedArrow (toUnicode $2)) $1 $3)
[mu AnnRarrow $2] }
| btype mult '->' ctype {% hintLinear (getLoc $2)
- >> ams $1 [mu AnnRarrow $3] -- See note [GADT decl discards annotations]
- >> ams (sLL $1 $> $ HsFunTy noExtField (unLoc $2) $1 $4)
- [mu AnnRarrow $3] }
+ >> ams $1 [mj AnnMult $2,mu AnnRarrow $3] -- See Note [GADT decl discards annotations]
+ >> ams (sLL $1 $> $ HsFunTy noExtField ((unLoc $2) (toUnicode $3)) $1 $4)
+ [mj AnnMult $2,mu AnnRarrow $3] }
| btype '->.' ctype {% hintLinear (getLoc $2)
- >> ams $1 [mu AnnLollyU $2] -- See note [GADT decl discards annotations]
- >> ams (sLL $1 $> $ HsFunTy noExtField HsLinearArrow $1 $3)
+ >> ams $1 [mu AnnLollyU $2] -- See Note [GADT decl discards annotations]
+ >> ams (sLL $1 $> $ HsFunTy noExtField (HsLinearArrow UnicodeSyntax) $1 $3)
[mu AnnLollyU $2] }
-mult :: { Located (HsArrow GhcPs) }
- : PREFIX_PERCENT atype { sLL $1 $> (mkMultTy $2) }
+mult :: { Located (IsUnicodeSyntax -> HsArrow GhcPs) }
+ : PREFIX_PERCENT atype { sLL $1 $> (\u -> mkMultTy u $2) }
btype :: { LHsType GhcPs }
: infixtype {% runPV $1 }
@@ -3999,6 +3999,9 @@ mu a lt@(L l t) = AddAnn (toUnicodeAnn a lt) l
toUnicodeAnn :: AnnKeywordId -> Located Token -> AnnKeywordId
toUnicodeAnn a t = if isUnicode t then unicodeAnn a else a
+toUnicode :: Located Token -> IsUnicodeSyntax
+toUnicode t = if isUnicode t then UnicodeSyntax else NormalSyntax
+
gl :: Located a -> SrcSpan
gl = getLoc