diff options
| author | Alan Zimmerman <alan.zimm@gmail.com> | 2020-10-07 20:38:36 +0100 |
|---|---|---|
| committer | Alan Zimmerman <alan.zimm@gmail.com> | 2020-10-07 20:38:36 +0100 |
| commit | f279f6372da1b36e8c87767cc63200ea4ebb7de0 (patch) | |
| tree | c079d5d75361955a3cca154f0b9c23b8c35bb953 | |
| parent | a0ee40af9a2ecffeae2698ae1f323afc5a20e957 (diff) | |
| download | haskell-wip/az/ghc-9.0-unicode-linear-arrow.tar.gz | |
Api Annotations: Introduce AnnPercent for HsExplicitMultwip/az/ghc-9.0-unicode-linear-arrow
For the case
foo :: a %p -> b
The location of the '%' is captured, separate from the 'p'
| -rw-r--r-- | compiler/GHC/Parser.y | 10 | ||||
| -rw-r--r-- | compiler/GHC/Parser/Annotation.hs | 1 | ||||
| -rw-r--r-- | compiler/GHC/Parser/PostProcess.hs | 6 |
3 files changed, 9 insertions, 8 deletions
diff --git a/compiler/GHC/Parser.y b/compiler/GHC/Parser.y index 18dacdc2e9..7d40b67d16 100644 --- a/compiler/GHC/Parser.y +++ b/compiler/GHC/Parser.y @@ -1961,17 +1961,17 @@ 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 NormalSyntax (unLoc $2) $1 $4) - [mj AnnMult $2,mu AnnRarrow $3] } + >> ams $1 (mj AnnMult $2:mu AnnRarrow $3:(snd $ unLoc $2)) -- See Note [GADT decl discards annotations] + >> ams (sLL $1 $> $ HsFunTy NormalSyntax (fst $ unLoc $2) $1 $4) + (mj AnnMult $2:mu AnnRarrow $3:(snd $ unLoc $2)) } | btype '->.' ctype {% hintLinear (getLoc $2) >> ams $1 [mu AnnLollyU $2] -- See note [GADT decl discards annotations] >> ams (sLL $1 $> $ HsFunTy UnicodeSyntax HsLinearArrow $1 $3) [mu AnnLollyU $2] } -mult :: { Located (HsArrow GhcPs) } - : PREFIX_PERCENT atype { sLL $1 $> (mkMultTy $2) } +mult :: { Located (HsArrow GhcPs, [AddAnn]) } + : PREFIX_PERCENT atype { sLL $1 $> (mkMultTy $2 [mj AnnPercent $1]) } btype :: { LHsType GhcPs } diff --git a/compiler/GHC/Parser/Annotation.hs b/compiler/GHC/Parser/Annotation.hs index 754b335f9e..22ea7f26d0 100644 --- a/compiler/GHC/Parser/Annotation.hs +++ b/compiler/GHC/Parser/Annotation.hs @@ -319,6 +319,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 43ff9cc2d1..ff706329ee 100644 --- a/compiler/GHC/Parser/PostProcess.hs +++ b/compiler/GHC/Parser/PostProcess.hs @@ -3073,9 +3073,9 @@ mkLHsOpTy x op y = let loc = getLoc x `combineSrcSpans` getLoc op `combineSrcSpans` getLoc y in L loc (mkHsOpTy x op y) -mkMultTy :: LHsType GhcPs -> HsArrow GhcPs -mkMultTy (L _ (HsTyLit _ (HsNumTy _ 1))) = HsLinearArrow -mkMultTy t = HsExplicitMult t +mkMultTy :: LHsType GhcPs -> [AddAnn] -> (HsArrow GhcPs, [AddAnn]) +mkMultTy (L _ (HsTyLit _ (HsNumTy _ 1))) _ = (HsLinearArrow, []) +mkMultTy t anns = (HsExplicitMult t, anns) ----------------------------------------------------------------------------- -- Token symbols |