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-26 08:31:31 +0000 |
| commit | c15b5f25ad54164c951e797ecbd10d0df1cf4ba6 (patch) | |
| tree | 3702c247376fe550bf112cafeb54b1dd81addbbc | |
| parent | 730bb59086ad1036143983c3fba61bd851bebc03 (diff) | |
| download | haskell-wip/az/apiann-annpercent.tar.gz | |
Api Annotations: Introduce AnnPercent for HsExplicitMultwip/az/apiann-annpercent
For the case
foo :: a %p -> b
The location of the '%' is captured, separate from the 'p'
| -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 |