[Git][ghc/ghc][wip/az/epa-hslet-tokens] EPA: HsOverLabel: move annotation info to xrec-stuff

[Alan Zimmerman (@alanz)]

Alan Zimmerman pushed to branch wip/az/epa-hslet-tokens at Glasgow Haskell Compiler / GHC


Commits:
996775cb by Alan Zimmerman at 2023-12-07T15:00:50+00:00
EPA: HsOverLabel: move annotation info to xrec-stuff

- - - - -


5 changed files:

- compiler/GHC/Hs/Expr.hs
- compiler/GHC/Parser.y
- compiler/GHC/Rename/Expr.hs
- compiler/GHC/ThToHs.hs
- utils/check-exact/ExactPrint.hs


Changes:

=====================================
compiler/GHC/Hs/Expr.hs
=====================================
@@ -219,8 +219,8 @@ type instance XRecSel              GhcTc = NoExtField
 
 -- OverLabel not present in GhcTc pass; see GHC.Rename.Expr
 -- Note [Handling overloaded and rebindable constructs]
-type instance XOverLabel     GhcPs = EpAnnCO
-type instance XOverLabel     GhcRn = EpAnnCO
+type instance XOverLabel     GhcPs = NoExtField
+type instance XOverLabel     GhcRn = NoExtField
 type instance XOverLabel     GhcTc = DataConCantHappen
 
 -- ---------------------------------------------------------------------


=====================================
compiler/GHC/Parser.y
=====================================
@@ -2958,7 +2958,9 @@ aexp2   :: { ECP }
         | qcon                          { ECP $ mkHsVarPV $! $1 }
         -- See Note [%shift: aexp2 -> ipvar]
         | ipvar %shift                  {% acsExpr (\cs -> sL1a $1 (HsIPVar (comment (glRR $1) cs) $! unLoc $1)) }
-        | overloaded_label              {% acsExpr (\cs -> sL1a $1 (HsOverLabel (comment (glRR $1) cs) (fst $! unLoc $1) (snd $! unLoc $1))) }
+        -- | overloaded_label              {% acsExpr (\cs -> sL1a $1 (HsOverLabel (comment (glRR $1) cs) (fst $! unLoc $1) (snd $! unLoc $1))) }
+        | overloaded_label              {% fmap ecpFromExp
+                                           (ams1 $1 (HsOverLabel NoExtField (fst $! unLoc $1) (snd $! unLoc $1))) }
         | literal                       { ECP $ pvA (mkHsLitPV $! $1) }
 -- This will enable overloaded strings permanently.  Normally the renamer turns HsString
 -- into HsOverLit when -XOverloadedStrings is on.
@@ -4354,6 +4356,11 @@ acsExpr :: (EpAnnComments -> LHsExpr GhcPs) -> P ECP
 acsExpr a = do { expr :: (LHsExpr GhcPs) <- runPV $ acs a
                ; return (ecpFromExp $ expr) }
 
+ams1 :: MonadP m => Located a -> b -> m (LocatedA b)
+ams1 (L l a) b = do
+  cs <- getCommentsFor (locA l)
+  return (L (EpAnn (spanAsAnchor l) noAnn cs) b)
+
 amsA :: MonadP m => LocatedA a -> [TrailingAnn] -> m (LocatedA a)
 amsA (L l a) bs = do
   cs <- getCommentsFor (locA l)


=====================================
compiler/GHC/Rename/Expr.hs
=====================================
@@ -292,7 +292,7 @@ rnExpr (HsUnboundVar _ v)
 -- HsOverLabel: see Note [Handling overloaded and rebindable constructs]
 rnExpr (HsOverLabel _ src v)
   = do { (from_label, fvs) <- lookupSyntaxName fromLabelClassOpName
-       ; return ( mkExpandedExpr (HsOverLabel noAnn src v) $
+       ; return ( mkExpandedExpr (HsOverLabel noExtField src v) $
                   HsAppType noExtField (genLHsVar from_label) hs_ty_arg
                 , fvs ) }
   where


=====================================
compiler/GHC/ThToHs.hs
=====================================
@@ -1153,7 +1153,7 @@ cvtl e = wrapLA (cvt e)
                               -- constructor names - see #14627.
                               { s' <- vcName s
                               ; wrapParLA (HsVar noExtField) s' }
-    cvt (LabelE s)       = return $ HsOverLabel noComments NoSourceText (fsLit s)
+    cvt (LabelE s)       = return $ HsOverLabel noExtField NoSourceText (fsLit s)
     cvt (ImplicitParamVarE n) = do { n' <- ipName n; return $ HsIPVar noComments n' }
     cvt (GetFieldE exp f) = do { e' <- cvtl exp
                                ; return $ HsGetField noComments e'


=====================================
utils/check-exact/ExactPrint.hs
=====================================
@@ -2860,7 +2860,7 @@ instance ExactPrint (HsExpr GhcPs) where
   getAnnotationEntry (HsVar{})                    = NoEntryVal
   getAnnotationEntry (HsUnboundVar an _)          = fromAnn an
   getAnnotationEntry (HsRecSel{})                 = NoEntryVal
-  getAnnotationEntry (HsOverLabel an _ _)         = fromAnn an
+  getAnnotationEntry (HsOverLabel{})              = NoEntryVal
   getAnnotationEntry (HsIPVar an _)               = fromAnn an
   getAnnotationEntry (HsOverLit an _)             = fromAnn an
   getAnnotationEntry (HsLit an _)                 = fromAnn an
@@ -2897,8 +2897,8 @@ instance ExactPrint (HsExpr GhcPs) where
 
   setAnnotationAnchor a@(HsVar{})               _ _ _s = a
   setAnnotationAnchor (HsUnboundVar an a)    anc ts cs = (HsUnboundVar (setAnchorEpa an anc ts cs) a)
-  setAnnotationAnchor a@(HsRecSel{})           _ _ _s  = a
-  setAnnotationAnchor (HsOverLabel an s a)   anc ts cs = (HsOverLabel (setAnchorEpa an anc ts cs) s a)
+  setAnnotationAnchor a@(HsRecSel{})            _ _ _s = a
+  setAnnotationAnchor a@(HsOverLabel{})         _ _ _s = a
   setAnnotationAnchor (HsIPVar an a)         anc ts cs = (HsIPVar (setAnchorEpa an anc ts cs) a)
   setAnnotationAnchor (HsOverLit an a)       anc ts cs = (HsOverLit (setAnchorEpa an anc ts cs) a)
   setAnnotationAnchor (HsLit an a)           anc ts cs = (HsLit (setAnchorEpa an anc ts cs) a)



View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/996775cb89059ead74636f15c67acd72d7b05b7f

-- 
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/996775cb89059ead74636f15c67acd72d7b05b7f
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/20231207/f8807c11/attachment-0001.html>