EPA: Add comments to EpaDeltawip/az/epadelta-comments

The EpaDelta variant of EpaLocation cannot be sorted by location.

So we capture any comments that need to be printed between the prior
output and this location, when creating an EpaDelta offset in ghc-exactprint.

And make the EpaLocation fields strict.

3 files changed, 25 insertions, 20 deletions

diff --git a/compiler/GHC/Hs/Dump.hs b/compiler/GHC/Hs/Dump.hs
index 247e8099da..e059cda6b9 100644
--- a/compiler/GHC/Hs/Dump.hs
+++ b/compiler/GHC/Hs/Dump.hs
@@ -139,7 +139,9 @@ showAstData bs ba a0 = blankLine $$ showAstData' a0
 
             epaAnchor :: EpaLocation -> SDoc
             epaAnchor (EpaSpan r)  = parens $ text "EpaSpan" <+> realSrcSpan r
-            epaAnchor (EpaDelta d) = parens $ text "EpaDelta" <+> deltaPos d
+            epaAnchor (EpaDelta d cs) = case ba of
+              NoBlankEpAnnotations -> parens $ text "EpaDelta" <+> deltaPos d <+> showAstData' cs
+              BlankEpAnnotations -> parens $ text "EpaDelta" <+> deltaPos d <+> text "blanked"
 
             deltaPos :: DeltaPos -> SDoc
             deltaPos (SameLine c) = parens $ text "SameLine" <+> ppr c
diff --git a/compiler/GHC/Parser/Annotation.hs b/compiler/GHC/Parser/Annotation.hs
index b414e70be5..1692d394b5 100644
--- a/compiler/GHC/Parser/Annotation.hs
+++ b/compiler/GHC/Parser/Annotation.hs
@@ -394,22 +394,25 @@ instance Outputable EpaComment where
 -- The usual way an 'AddEpAnn' is created is using the 'mj' ("make
 -- jump") function, and then it can be inserted into the appropriate
 -- annotation.
-data AddEpAnn = AddEpAnn AnnKeywordId EpaLocation deriving (Data,Show,Eq,Ord)
-
--- | The anchor for an @'AnnKeywordId'@. The Parser inserts the @'EpaSpan'@
--- variant, giving the exact location of the original item in the
--- parsed source.  This can be replaced by the @'EpaDelta'@ version, to
--- provide a position for the item relative to the end of the previous
--- item in the source.  This is useful when editing an AST prior to
--- exact printing the changed one.
-data EpaLocation = EpaSpan RealSrcSpan
-                 | EpaDelta DeltaPos
-               deriving (Data,Show,Eq,Ord)
+data AddEpAnn = AddEpAnn AnnKeywordId EpaLocation deriving (Data,Eq,Ord)
+
+-- | The anchor for an @'AnnKeywordId'@. The Parser inserts the
+-- @'EpaSpan'@ variant, giving the exact location of the original item
+-- in the parsed source.  This can be replaced by the @'EpaDelta'@
+-- version, to provide a position for the item relative to the end of
+-- the previous item in the source.  This is useful when editing an
+-- AST prior to exact printing the changed one. The list of comments
+-- in the @'EpaDelta'@ variant captures any comments between the prior
+-- output and the thing being marked here, since we cannot otherwise
+-- sort the relative order.
+data EpaLocation = EpaSpan !RealSrcSpan
+                 | EpaDelta !DeltaPos ![LEpaComment]
+               deriving (Data,Eq,Ord)
 
 -- | Tokens embedded in the AST have an EpaLocation, unless they come from
 -- generated code (e.g. by TH).
 data TokenLocation = NoTokenLoc | TokenLoc !EpaLocation
-               deriving (Data,Show,Eq,Ord)
+               deriving (Data,Eq,Ord)
 
 -- | Spacing between output items when exact printing.  It captures
 -- the spacing from the current print position on the page to the
@@ -444,7 +447,7 @@ getDeltaLine (DifferentLine r _) = r
 -- partial function is safe.
 epaLocationRealSrcSpan :: EpaLocation -> RealSrcSpan
 epaLocationRealSrcSpan (EpaSpan r) = r
-epaLocationRealSrcSpan (EpaDelta _) = panic "epaLocationRealSrcSpan"
+epaLocationRealSrcSpan (EpaDelta _ _) = panic "epaLocationRealSrcSpan"
 
 epaLocationFromSrcAnn :: SrcAnn ann -> EpaLocation
 epaLocationFromSrcAnn (SrcSpanAnn EpAnnNotUsed l) = EpaSpan (realSrcSpan l)
@@ -452,7 +455,7 @@ epaLocationFromSrcAnn (SrcSpanAnn (EpAnn anc _ _) _) = EpaSpan (anchor anc)
 
 instance Outputable EpaLocation where
   ppr (EpaSpan r) = text "EpaSpan" <+> ppr r
-  ppr (EpaDelta d) = text "EpaDelta" <+> ppr d
+  ppr (EpaDelta d cs) = text "EpaDelta" <+> ppr d <+> ppr cs
 
 instance Outputable AddEpAnn where
   ppr (AddEpAnn kw ss) = text "AddEpAnn" <+> ppr kw <+> ppr ss
@@ -631,7 +634,7 @@ data TrailingAnn
   = AddSemiAnn EpaLocation    -- ^ Trailing ';'
   | AddCommaAnn EpaLocation   -- ^ Trailing ','
   | AddVbarAnn EpaLocation    -- ^ Trailing '|'
-  deriving (Data,Show,Eq, Ord)
+  deriving (Data, Eq, Ord)
 
 instance Outputable TrailingAnn where
   ppr (AddSemiAnn ss)    = text "AddSemiAnn"    <+> ppr ss
@@ -934,7 +937,7 @@ widenSpan s as = foldl combineSrcSpans s (go as)
   where
     go [] = []
     go (AddEpAnn _ (EpaSpan s):rest) = RealSrcSpan s Strict.Nothing : go rest
-    go (AddEpAnn _ (EpaDelta _):rest) = go rest
+    go (AddEpAnn _ (EpaDelta _ _):rest) = go rest
 
 -- | The annotations need to all come after the anchor.  Make sure
 -- this is the case.
@@ -943,7 +946,7 @@ widenRealSpan s as = foldl combineRealSrcSpans s (go as)
   where
     go [] = []
     go (AddEpAnn _ (EpaSpan s):rest) = s : go rest
-    go (AddEpAnn _ (EpaDelta _):rest) =     go rest
+    go (AddEpAnn _ (EpaDelta _ _):rest) =     go rest
 
 widenAnchor :: Anchor -> [AddEpAnn] -> Anchor
 widenAnchor (Anchor s op) as = Anchor (widenRealSpan s as) op
diff --git a/compiler/GHC/Parser/PostProcess.hs b/compiler/GHC/Parser/PostProcess.hs
index 198a14ec72..ae19e7b7b3 100644
--- a/compiler/GHC/Parser/PostProcess.hs
+++ b/compiler/GHC/Parser/PostProcess.hs
@@ -456,7 +456,7 @@ add_where an@(AddEpAnn _ (EpaSpan rs)) (EpAnn a (AnnList anc o c r t) cs) cs2
 add_where an@(AddEpAnn _ (EpaSpan rs)) EpAnnNotUsed cs
   = EpAnn (Anchor rs UnchangedAnchor)
            (AnnList (Just $ Anchor rs UnchangedAnchor) Nothing Nothing [an] []) cs
-add_where (AddEpAnn _ (EpaDelta _)) _ _ = panic "add_where"
+add_where (AddEpAnn _ (EpaDelta _ _)) _ _ = panic "add_where"
  -- EpaDelta should only be used for transformations
 
 valid_anchor :: RealSrcSpan -> Bool
@@ -3011,7 +3011,7 @@ token_location_widenR NoTokenLoc _ = NoTokenLoc
 token_location_widenR tl (UnhelpfulSpan _) = tl
 token_location_widenR (TokenLoc (EpaSpan r1)) (RealSrcSpan r2 _) =
                       (TokenLoc (EpaSpan (combineRealSrcSpans r1 r2)))
-token_location_widenR (TokenLoc (EpaDelta _)) _ =
+token_location_widenR (TokenLoc (EpaDelta _ _)) _ =
   -- Never happens because the parser does not produce EpaDelta.
   panic "token_location_widenR: EpaDelta"