diff options
| author | Vladislav Zavialov <vlad.z.4096@gmail.com> | 2021-06-01 13:46:39 +0300 |
|---|---|---|
| committer | Marge Bot <ben+marge-bot@smart-cactus.org> | 2021-06-16 20:19:10 -0400 |
| commit | a2e4cb80db1b63ea2c5e0ab501acec7fb1b116e3 (patch) | |
| tree | 5d0ef3df75a255a817d611fef555812f3223cc8a /compiler/GHC/Parser.y | |
| parent | 6c131ba04ab1455827d985704e4411aa19185f5f (diff) | |
| download | haskell-a2e4cb80db1b63ea2c5e0ab501acec7fb1b116e3.tar.gz | |
HsUniToken and HsToken for HsArrow (#19623)
Another step towards a simpler design for exact printing.
Updates the haddock submodule.
Diffstat (limited to 'compiler/GHC/Parser.y')
| -rw-r--r-- | compiler/GHC/Parser.y | 27 |
1 files changed, 13 insertions, 14 deletions
diff --git a/compiler/GHC/Parser.y b/compiler/GHC/Parser.y index cc52d67469..15088081e1 100644 --- a/compiler/GHC/Parser.y +++ b/compiler/GHC/Parser.y @@ -12,6 +12,7 @@ {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE LambdaCase #-} {-# LANGUAGE RankNTypes #-} +{-# LANGUAGE DataKinds #-} {-# LANGUAGE GADTs #-} {-# LANGUAGE ScopedTypeVariables #-} @@ -2147,20 +2148,20 @@ type :: { LHsType GhcPs } -- See Note [%shift: type -> btype] : btype %shift { $1 } | btype '->' ctype {% acsA (\cs -> sLL (reLoc $1) (reLoc $>) - $ HsFunTy (EpAnn (glAR $1) (mau $2) cs) (HsUnrestrictedArrow (toUnicode $2)) $1 $3) } + $ HsFunTy (EpAnn (glAR $1) NoEpAnns cs) (HsUnrestrictedArrow (hsUniTok $2)) $1 $3) } | btype mult '->' ctype {% hintLinear (getLoc $2) - >> let arr = (unLoc $2) (toUnicode $3) + >> let arr = (unLoc $2) (hsUniTok $3) in acsA (\cs -> sLL (reLoc $1) (reLoc $>) - $ HsFunTy (EpAnn (glAR $1) (mau $3) cs) arr $1 $4) } + $ HsFunTy (EpAnn (glAR $1) NoEpAnns cs) arr $1 $4) } | btype '->.' ctype {% hintLinear (getLoc $2) >> acsA (\cs -> sLL (reLoc $1) (reLoc $>) - $ HsFunTy (EpAnn (glAR $1) (mlu $2) cs) (HsLinearArrow UnicodeSyntax Nothing) $1 $3) } + $ HsFunTy (EpAnn (glAR $1) NoEpAnns cs) (HsLinearArrow (HsLolly (hsTok $2))) $1 $3) } -- [mu AnnLollyU $2] } -mult :: { Located (IsUnicodeSyntax -> HsArrow GhcPs) } - : PREFIX_PERCENT atype { sLL $1 (reLoc $>) (\u -> mkMultTy u $1 $2) } +mult :: { Located (LHsUniToken "->" "\8594" GhcPs -> HsArrow GhcPs) } + : PREFIX_PERCENT atype { sLL $1 (reLoc $>) (mkMultTy (hsTok $1) $2) } btype :: { LHsType GhcPs } : infixtype {% runPV $1 } @@ -4178,13 +4179,6 @@ msemim l = if isZeroWidthSpan (gl l) then Nothing else Just (EpaSpan $ rs $ gl l mu :: AnnKeywordId -> Located Token -> AddEpAnn mu a lt@(L l t) = AddEpAnn (toUnicodeAnn a lt) (EpaSpan $ rs l) -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 @@ -4350,7 +4344,12 @@ listAsAnchor [] = spanAsAnchor noSrcSpan listAsAnchor (L l _:_) = spanAsAnchor (locA l) hsTok :: Located Token -> LHsToken tok GhcPs -hsTok (L l _) = L (EpAnn (Anchor (realSrcSpan l) UnchangedAnchor) NoEpAnns emptyComments) HsTok +hsTok (L l _) = L (EpAnn (spanAsAnchor l) NoEpAnns emptyComments) HsTok + +hsUniTok :: Located Token -> LHsUniToken tok utok GhcPs +hsUniTok t@(L l _) = + L (EpAnn (spanAsAnchor l) NoEpAnns emptyComments) + (if isUnicode t then HsUnicodeTok else HsNormalTok) -- ------------------------------------- |