diff options
| author | Alan Zimmerman <alan.zimm@gmail.com> | 2020-10-07 20:38:36 +0100 |
|---|---|---|
| committer | Marge Bot <ben+marge-bot@smart-cactus.org> | 2020-10-27 14:04:26 -0400 |
| commit | e3fdd4197cd9def4af40acb3753843e3e9a74d7e (patch) | |
| tree | ed6c9ee717a318809be5c3a8997814f92522c0b1 /compiler | |
| parent | 78b52c888a1cc68750261382e3a62fff65242016 (diff) | |
| download | haskell-e3fdd4197cd9def4af40acb3753843e3e9a74d7e.tar.gz | |
Api Annotations: Introduce AnnPercent for HsExplicitMult
For the case
foo :: a %p -> b
The location of the '%' is captured, separate from the 'p'
Diffstat (limited to 'compiler')
| -rw-r--r-- | compiler/GHC/Parser.y | 11 | ||||
| -rw-r--r-- | compiler/GHC/Parser/Annotation.hs | 3 | ||||
| -rw-r--r-- | compiler/GHC/Parser/PostProcess.hs | 7 |
3 files changed, 12 insertions, 9 deletions
diff --git a/compiler/GHC/Parser.y b/compiler/GHC/Parser.y index 666b329e84..1d1ae49685 100644 --- a/compiler/GHC/Parser.y +++ b/compiler/GHC/Parser.y @@ -2056,17 +2056,18 @@ type :: { LHsType GhcPs } [mu AnnRarrow $2] } | btype mult '->' ctype {% hintLinear (getLoc $2) - >> 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] } + >> let (arr, ann) = (unLoc $2) (toUnicode $3) + in (ams $1 [ann,mu AnnRarrow $3] -- See Note [GADT decl discards annotations] + >> ams (sLL $1 $> $ HsFunTy noExtField arr $1 $4) + [ann,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 UnicodeSyntax) $1 $3) [mu AnnLollyU $2] } -mult :: { Located (IsUnicodeSyntax -> HsArrow GhcPs) } - : PREFIX_PERCENT atype { sLL $1 $> (\u -> mkMultTy u $2) } +mult :: { Located (IsUnicodeSyntax -> (HsArrow GhcPs, AddAnn)) } + : PREFIX_PERCENT atype { sLL $1 $> (\u -> mkMultTy u $1 $2) } btype :: { LHsType GhcPs } : infixtype {% runPV $1 } diff --git a/compiler/GHC/Parser/Annotation.hs b/compiler/GHC/Parser/Annotation.hs index a3cbc92308..9381d591d4 100644 --- a/compiler/GHC/Parser/Annotation.hs +++ b/compiler/GHC/Parser/Annotation.hs @@ -301,7 +301,7 @@ data AnnKeywordId | AnnMdo | AnnMinus -- ^ '-' | AnnModule - | AnnMult -- ^ '%1' + | AnnPercentOne -- ^ '%1' -- for HsLinearArrow | AnnNewtype | AnnName -- ^ where a name loses its location in the AST, this carries it | AnnOf @@ -318,6 +318,7 @@ data AnnKeywordId | AnnDollarDollar -- ^ prefix '$$' -- TemplateHaskell | AnnPackageName | AnnPattern + | AnnPercent -- ^ '%' -- for HsExplicitMult | AnnProc | AnnQualified | AnnRarrow -- ^ '->' diff --git a/compiler/GHC/Parser/PostProcess.hs b/compiler/GHC/Parser/PostProcess.hs index 4812486d19..a4ac42d382 100644 --- a/compiler/GHC/Parser/PostProcess.hs +++ b/compiler/GHC/Parser/PostProcess.hs @@ -2617,9 +2617,10 @@ mkLHsOpTy x op y = let loc = getLoc x `combineSrcSpans` getLoc op `combineSrcSpans` getLoc y in L loc (mkHsOpTy x op y) -mkMultTy :: IsUnicodeSyntax -> LHsType GhcPs -> HsArrow GhcPs -mkMultTy u (L _ (HsTyLit _ (HsNumTy _ 1))) = HsLinearArrow u -mkMultTy u t = HsExplicitMult u t +mkMultTy :: IsUnicodeSyntax -> Located Token -> LHsType GhcPs -> (HsArrow GhcPs, AddAnn) +mkMultTy u tok t@(L _ (HsTyLit _ (HsNumTy _ 1))) + = (HsLinearArrow u, AddAnn AnnPercentOne (combineLocs tok t)) +mkMultTy u tok t = (HsExplicitMult u t, AddAnn AnnPercent (getLoc tok)) ----------------------------------------------------------------------------- -- Token symbols |