diff --git a/compiler/GHC/Hs/Expr.hs b/compiler/GHC/Hs/Expr.hs
index ffba60e9d8c669cee03817e40e87f9f760a25495..d4d4c45f31d86b3f944c29b1687cf4db638ab4be 100644
--- a/compiler/GHC/Hs/Expr.hs
+++ b/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
diff --git a/compiler/GHC/Hs/Utils.hs b/compiler/GHC/Hs/Utils.hs
index efb5ffff7b9479c9bd4f3745355458715137ee5c..6b7a6e6c5fca36601de7e416fc5a1781875099e3 100644
--- a/compiler/GHC/Hs/Utils.hs
+++ b/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)
diff --git a/compiler/GHC/Parser/PostProcess.hs b/compiler/GHC/Parser/PostProcess.hs
index 75d63e70447cca0d75af4294eb4b59b2a16b589d..ddca8efe5d4637382ab3e612bd6241c7425f7e2e 100644
--- a/compiler/GHC/Parser/PostProcess.hs
+++ b/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) =
diff --git a/compiler/GHC/Tc/TyCl/PatSyn.hs b/compiler/GHC/Tc/TyCl/PatSyn.hs
index d26b7d1cdf1c06ff83b18e556be6fedcd8c31f88..16f2859a51c1b074820b0f98bc3a421089cfb0d4 100644
--- a/compiler/GHC/Tc/TyCl/PatSyn.hs
+++ b/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)
diff --git a/compiler/GHC/ThToHs.hs b/compiler/GHC/ThToHs.hs
index e47bbeff4dbb36474a33c8f8ae17f20de2d099fa..4c9f1cd793f0b33e98fd3b47498cafac0241adf9 100644
--- a/compiler/GHC/ThToHs.hs
+++ b/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
diff --git a/utils/check-exact/ExactPrint.hs b/utils/check-exact/ExactPrint.hs
index cfcd1a5773a3c81c690731afa828c2abffe751aa..37e6303b9a5af5c11edcf3f6ad11902e70ce95ea 100644
--- a/utils/check-exact/ExactPrint.hs
+++ b/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