[Git][ghc/ghc][master] EPA: Use EpaLocation for RecFieldsDotDot

[Marge Bot (@marge-bot)]

Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC


Commits:
19883a23 by Alan Zimmerman at 2024-04-05T16:58:17-04:00
EPA: Use EpaLocation for RecFieldsDotDot

So we can update it to a delta position in makeDeltaAst if needed.

- - - - -


5 changed files:

- compiler/GHC/Hs/Pat.hs
- compiler/GHC/Hs/Utils.hs
- compiler/GHC/Parser/PostProcess.hs
- compiler/GHC/Rename/Pat.hs
- utils/check-exact/ExactPrint.hs


Changes:

=====================================
compiler/GHC/Hs/Pat.hs
=====================================
@@ -350,7 +350,7 @@ hsRecUpdFieldOcc = fmap unambiguousFieldOcc . hfbLHS
 instance Outputable (HsTyPat p) => Outputable (HsConPatTyArg p) where
   ppr (HsConPatTyArg _ ty) = char '@' <> ppr ty
 
-instance (Outputable arg, Outputable (XRec p (HsRecField p arg)), XRec p RecFieldsDotDot ~ Located RecFieldsDotDot)
+instance (Outputable arg, Outputable (XRec p (HsRecField p arg)), XRec p RecFieldsDotDot ~ LocatedE RecFieldsDotDot)
       => Outputable (HsRecFields p arg) where
   ppr (HsRecFields { rec_flds = flds, rec_dotdot = Nothing })
         = braces (fsep (punctuate comma (map ppr flds)))
@@ -976,4 +976,4 @@ type instance Anno (Pat (GhcPass p)) = SrcSpanAnnA
 type instance Anno (HsOverLit (GhcPass p)) = EpAnnCO
 type instance Anno ConLike = SrcSpanAnnN
 type instance Anno (HsFieldBind lhs rhs) = SrcSpanAnnA
-type instance Anno RecFieldsDotDot = SrcSpan
+type instance Anno RecFieldsDotDot = EpaLocation


=====================================
compiler/GHC/Hs/Utils.hs
=====================================
@@ -1830,7 +1830,7 @@ lPatImplicits = hs_lpat
     details (RecCon (HsRecFields { rec_dotdot = Nothing, rec_flds }))
       = hs_lpats $ map (hfbRHS . unLoc) rec_flds
     details (RecCon (HsRecFields { rec_dotdot = Just (L err_loc rec_dotdot), rec_flds }))
-          = [(err_loc, implicit_field_binders)]
+          = [(l2l err_loc, implicit_field_binders)]
           ++ hs_lpats explicit_pats
 
           where (explicit_pats, implicit_field_binders)


=====================================
compiler/GHC/Parser/PostProcess.hs
=====================================
@@ -2679,7 +2679,7 @@ mkRdrRecordCon con flds anns
 mk_rec_fields :: [LocatedA (HsRecField (GhcPass p) arg)] -> Maybe SrcSpan -> HsRecFields (GhcPass p) arg
 mk_rec_fields fs Nothing = HsRecFields { rec_flds = fs, rec_dotdot = Nothing }
 mk_rec_fields fs (Just s)  = HsRecFields { rec_flds = fs
-                                     , rec_dotdot = Just (L s (RecFieldsDotDot $ length fs)) }
+                                     , rec_dotdot = Just (L (l2l s) (RecFieldsDotDot $ length fs)) }
 
 mk_rec_upd_field :: HsRecField GhcPs (LHsExpr GhcPs) -> HsRecUpdField GhcPs GhcPs
 mk_rec_upd_field (HsFieldBind noAnn (L loc (FieldOcc _ rdr)) arg pun)


=====================================
compiler/GHC/Rename/Pat.hs
=====================================
@@ -775,7 +775,7 @@ rnHsRecPatsAndThen mk (L _ con)
       do { arg' <- rnLPatAndThen (nested_mk dd mk (RecFieldsDotDot n')) (hfbRHS fld)
          ; return (L l (fld { hfbRHS = arg' })) }
 
-    loc = maybe noSrcSpan getLoc dd
+    loc = maybe noSrcSpan getLocA dd
 
     -- Don't warn for let P{..} = ... in ...
     check_unused_wildcard = case mk of
@@ -873,12 +873,12 @@ rnHsRecFields ctxt mk_arg (HsRecFields { rec_flds = flds, rec_dotdot = dotdot })
                  , hfbRHS = arg'
                  , hfbPun = pun } }
 
-    rn_dotdot :: Maybe (Located RecFieldsDotDot)      -- See Note [DotDot fields] in GHC.Hs.Pat
+    rn_dotdot :: Maybe (LocatedE RecFieldsDotDot)     -- See Note [DotDot fields] in GHC.Hs.Pat
               -> Maybe Name -- The constructor (Nothing for an
                                 --    out of scope constructor)
               -> [LHsRecField GhcRn (LocatedA arg)] -- Explicit fields
               -> RnM ([LHsRecField GhcRn (LocatedA arg)])   -- Field Labels we need to fill in
-    rn_dotdot (Just (L loc (RecFieldsDotDot n))) (Just con) flds -- ".." on record construction / pat match
+    rn_dotdot (Just (L loc_e (RecFieldsDotDot n))) (Just con) flds -- ".." on record construction / pat match
       | not (isUnboundName con) -- This test is because if the constructor
                                 -- isn't in scope the constructor lookup will add
                                 -- an error but still return an unbound name. We
@@ -910,6 +910,7 @@ rnHsRecFields ctxt mk_arg (HsRecFields { rec_flds = flds, rec_dotdot = dotdot })
                              _other           -> True ]
 
            ; addUsedGREs NoDeprecationWarnings dot_dot_gres
+           ; let loc = locA loc_e
            ; let locn = noAnnSrcSpan loc
            ; return [ L (noAnnSrcSpan loc) (HsFieldBind
                         { hfbAnn = noAnn


=====================================
utils/check-exact/ExactPrint.hs
=====================================
@@ -3328,12 +3328,13 @@ instance (ExactPrint body) => ExactPrint (HsRecFields GhcPs body) where
   setAnnotationAnchor a _ _ _ = a
   exact (HsRecFields fields mdot) = do
     fields' <- markAnnotated fields
-    case mdot of
-      Nothing -> return ()
-      Just (L ss _) ->
-        printStringAtSs ss ".." >> return ()
+    mdot' <- case mdot of
+      Nothing -> return Nothing
+      Just (L ss d) -> do
+        ss' <- printStringAtAA ss ".."
+        return $ Just (L ss' d)
       -- Note: mdot contains the SrcSpan where the ".." appears, if present
-    return (HsRecFields fields' mdot)
+    return (HsRecFields fields' mdot')
 
 -- ---------------------------------------------------------------------
 



View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/19883a23b8bc704118fa663d8bab00a503b5a527

-- 
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/19883a23b8bc704118fa663d8bab00a503b5a527
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/20240405/90a54cd3/attachment-0001.html>