[Git][ghc/ghc][ghc-9.0] Api Annotations: Introduce AnnPercent for HsExplicitMult

[Ben Gamari]

Ben Gamari pushed to branch ghc-9.0 at Glasgow Haskell Compiler / GHC


Commits:
3d7f5ec8 by Alan Zimmerman at 2020-11-01T11:45:02-05:00
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)

- - - - -


3 changed files:

- compiler/GHC/Parser.y
- compiler/GHC/Parser/Annotation.hs
- compiler/GHC/Parser/PostProcess.hs


Changes:

=====================================
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) }


=====================================
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 -- ^ '->'


=====================================
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



View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/3d7f5ec8232d9053b192cb94b19c5d5e85bc46f4

-- 
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/3d7f5ec8232d9053b192cb94b19c5d5e85bc46f4
You're receiving this email because of your account on gitlab.haskell.org.


-------------- next part --------------
An HTML attachment was scrubbed...
URL: <http://mail.haskell.org/pipermail/ghc-commits/attachments/20201101/3748ef78/attachment-0001.html>