diff options
author | Alan Zimmerman <alan.zimm@gmail.com> | 2020-10-04 20:46:41 +0100 |
---|---|---|
committer | Alan Zimmerman <alan.zimm@gmail.com> | 2020-10-20 08:35:34 +0100 |
commit | ea736839d85594c95490dcf02d3325c2bbc68f33 (patch) | |
tree | 6f6c0335e216f67b63caf9e4a46d3e5bb6e852af /compiler/GHC/Parser.y | |
parent | 59b08a5d192e102f66a6d9260cc8466d7428cffe (diff) | |
download | haskell-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.y | 21 |
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 |