[Git][ghc/ghc][master] EPA: Tuple Present no longer has annotation

[Marge Bot (@marge-bot)]

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


Commits:
a79960fe by Alan Zimmerman at 2023-11-22T11:49:48-05:00
EPA: Tuple Present no longer has annotation

The Present constructor for a Tuple argument will never have an exact
print annotation. So make this impossible.

- - - - -


6 changed files:

- compiler/GHC/Hs/Expr.hs
- compiler/GHC/Hs/Utils.hs
- compiler/GHC/Parser/PostProcess.hs
- compiler/GHC/Tc/TyCl/PatSyn.hs
- compiler/GHC/ThToHs.hs
- utils/check-exact/ExactPrint.hs


Changes:

=====================================
compiler/GHC/Hs/Expr.hs
=====================================
@@ -416,7 +416,7 @@ type instance XXPragE        (GhcPass _) = DataConCantHappen
 type instance XCDotFieldOcc (GhcPass _) = EpAnn AnnFieldLabel
 type instance XXDotFieldOcc (GhcPass _) = DataConCantHappen
 
-type instance XPresent         (GhcPass _) = EpAnn [AddEpAnn]
+type instance XPresent         (GhcPass _) = NoExtField
 
 type instance XMissing         GhcPs = EpAnn EpaLocation
 type instance XMissing         GhcRn = NoExtField


=====================================
compiler/GHC/Hs/Utils.hs
=====================================
@@ -666,7 +666,7 @@ mkLHsTupleExpr :: [LHsExpr (GhcPass p)] -> XExplicitTuple (GhcPass p)
 -- Makes a pre-typechecker boxed tuple, deals with 1 case
 mkLHsTupleExpr [e] _ = e
 mkLHsTupleExpr es ext
-  = noLocA $ ExplicitTuple ext (map (Present noAnn) es) Boxed
+  = noLocA $ ExplicitTuple ext (map (Present noExtField) es) Boxed
 
 mkLHsVarTuple :: IsSrcSpanAnn p a
                => [IdP (GhcPass p)]  -> XExplicitTuple (GhcPass p)


=====================================
compiler/GHC/Parser/PostProcess.hs
=====================================
@@ -3151,7 +3151,7 @@ mkSumOrTupleExpr l boxity (Tuple es) anns = do
   where
     toTupArg :: Either (EpAnn EpaLocation) (LHsExpr GhcPs) -> HsTupArg GhcPs
     toTupArg (Left ann) = missingTupArg ann
-    toTupArg (Right a)  = Present noAnn a
+    toTupArg (Right a)  = Present noExtField a
 
 -- Sum
 -- mkSumOrTupleExpr l Unboxed (Sum alt arity e) =


=====================================
compiler/GHC/Tc/TyCl/PatSyn.hs
=====================================
@@ -1037,7 +1037,7 @@ tcPatToExpr args pat = go pat
            ; return $ ExplicitList noExtField exprs }
     go1 (TuplePat _ pats box)       = do { exprs <- mapM go pats
                                          ; return $ ExplicitTuple noExtField
-                                           (map (Present noAnn) exprs) box }
+                                           (map (Present noExtField) exprs) box }
     go1 (SumPat _ pat alt arity)    = do { expr <- go1 (unLoc pat)
                                          ; return $ ExplicitSum noExtField alt arity
                                                                    (noLocA expr)


=====================================
compiler/GHC/ThToHs.hs
=====================================
@@ -1218,7 +1218,7 @@ cvtDD (FromThenToR x y z) = do { x' <- cvtl x; y' <- cvtl y; z' <- cvtl z; retur
 
 cvt_tup :: [Maybe Exp] -> Boxity -> CvtM (HsExpr GhcPs)
 cvt_tup es boxity = do { let cvtl_maybe Nothing  = return (missingTupArg noAnn)
-                             cvtl_maybe (Just e) = fmap (Present noAnn) (cvtl e)
+                             cvtl_maybe (Just e) = fmap (Present noExtField) (cvtl e)
                        ; es' <- mapM cvtl_maybe es
                        ; return $ ExplicitTuple
                                     noAnn


=====================================
utils/check-exact/ExactPrint.hs
=====================================
@@ -3431,10 +3431,10 @@ instance ExactPrint (DotFieldOcc GhcPs) where
 -- ---------------------------------------------------------------------
 
 instance ExactPrint (HsTupArg GhcPs) where
-  getAnnotationEntry (Present an _) = fromAnn an
+  getAnnotationEntry (Present _ _) = NoEntryVal
   getAnnotationEntry (Missing an)   = fromAnn an
 
-  setAnnotationAnchor (Present an a) anc ts cs = Present (setAnchorEpa an anc ts cs) a
+  setAnnotationAnchor (Present a b) _ _ _ = Present a b
   setAnnotationAnchor (Missing an)   anc ts cs = Missing (setAnchorEpa an anc ts cs)
 
   exact (Present a e) = Present a <$> markAnnotated e



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

-- 
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/a79960fec0d65574015aae56f42f26b501a48f07
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/20231122/2ce172fe/attachment-0001.html>