diff options
| author | Alan Zimmerman <alan.zimm@gmail.com> | 2020-10-07 20:38:36 +0100 |
|---|---|---|
| committer | Ben Gamari <ben@well-typed.com> | 2020-11-01 11:45:02 -0500 |
| commit | 3d7f5ec8232d9053b192cb94b19c5d5e85bc46f4 (patch) | |
| tree | 7479116f34d1306ad3b3b45e8b683f36dedc59c8 | |
| parent | 7644d85ca21ca8af9cd81d64d6c88afc80e03eb5 (diff) | |
| download | haskell-3d7f5ec8232d9053b192cb94b19c5d5e85bc46f4.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'
(cherry picked from commit c15b5f25ad54164c951e797ecbd10d0df1cf4ba6)
| -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 cc8dceed70..f6dbd8901f 100644 --- a/compiler/GHC/Parser.y +++ b/compiler/GHC/Parser.y @@ -1961,17 +1961,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 } : tyapps {% mergeOps (unLoc $1) } diff --git a/compiler/GHC/Parser/Annotation.hs b/compiler/GHC/Parser/Annotation.hs index 754b335f9e..eedbb0574f 100644 --- a/compiler/GHC/Parser/Annotation.hs +++ b/compiler/GHC/Parser/Annotation.hs @@ -302,7 +302,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 @@ -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 1aba593927..5325813911 100644 --- a/compiler/GHC/Parser/PostProcess.hs +++ b/compiler/GHC/Parser/PostProcess.hs @@ -3069,9 +3069,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 |