diff --git a/compiler/GHC/Parser.y b/compiler/GHC/Parser.y
index 65b29fe99af2e0f8515b34b9e0bb582e2af37fef..9c5aa62fa37cd5026d001576cfb8ac946a9a3c23 100644
--- a/compiler/GHC/Parser.y
+++ b/compiler/GHC/Parser.y
@@ -4560,7 +4560,7 @@ addTrailingCommaN (L anns a) span = do
addTrailingCommaS :: Located StringLiteral -> EpaLocation -> Located StringLiteral
addTrailingCommaS (L l sl) span
- = L (widenSpan l [AddEpAnn AnnComma span]) (sl { sl_tc = Just (epaLocationRealSrcSpan span) })
+ = L (widenSpan l [AddEpAnn AnnComma span]) (sl { sl_tc = Just (epaToNoCommentsLocation span) })
-- -------------------------------------
diff --git a/compiler/GHC/Parser/Annotation.hs b/compiler/GHC/Parser/Annotation.hs
index 9fd34116db262cb721b3445b153a635e4ae143e2..b6e7cfde0191e19405c306edcffe07f5f0cacb0f 100644
--- a/compiler/GHC/Parser/Annotation.hs
+++ b/compiler/GHC/Parser/Annotation.hs
@@ -454,27 +454,8 @@ instance Outputable EpaComment where
-- annotation.
data AddEpAnn = AddEpAnn AnnKeywordId EpaLocation deriving (Data,Eq)
--- | 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' a = EpaSpan !SrcSpan
- | EpaDelta !DeltaPos !a
- deriving (Data,Eq,Show)
-
type EpaLocation = EpaLocation' [LEpaComment]
-type NoCommentsLocation = EpaLocation' NoComments
-
-data NoComments = NoComments
- deriving (Data,Eq,Ord,Show)
-
epaToNoCommentsLocation :: EpaLocation -> NoCommentsLocation
epaToNoCommentsLocation (EpaSpan ss) = EpaSpan ss
epaToNoCommentsLocation (EpaDelta dp []) = EpaDelta dp NoComments
@@ -492,34 +473,6 @@ data TokenLocation = NoTokenLoc | TokenLoc !EpaLocation
instance Outputable a => Outputable (GenLocated TokenLocation a) where
ppr (L _ x) = ppr x
--- | Spacing between output items when exact printing. It captures
--- the spacing from the current print position on the page to the
--- position required for the thing about to be printed. This is
--- either on the same line in which case is is simply the number of
--- spaces to emit, or it is some number of lines down, with a given
--- column offset. The exact printing algorithm keeps track of the
--- column offset pertaining to the current anchor position, so the
--- `deltaColumn` is the additional spaces to add in this case. See
--- https://gitlab.haskell.org/ghc/ghc/wikis/api-annotations for
--- details.
-data DeltaPos
- = SameLine { deltaColumn :: !Int }
- | DifferentLine
- { deltaLine :: !Int, -- ^ deltaLine should always be > 0
- deltaColumn :: !Int
- } deriving (Show,Eq,Ord,Data)
-
--- | Smart constructor for a 'DeltaPos'. It preserves the invariant
--- that for the 'DifferentLine' constructor 'deltaLine' is always > 0.
-deltaPos :: Int -> Int -> DeltaPos
-deltaPos l c = case l of
- 0 -> SameLine c
- _ -> DifferentLine l c
-
-getDeltaLine :: DeltaPos -> Int
-getDeltaLine (SameLine _) = 0
-getDeltaLine (DifferentLine r _) = r
-
-- | Used in the parser only, extract the 'RealSrcSpan' from an
-- 'EpaLocation'. The parser will never insert a 'DeltaPos', so the
-- partial function is safe.
@@ -527,13 +480,6 @@ epaLocationRealSrcSpan :: EpaLocation -> RealSrcSpan
epaLocationRealSrcSpan (EpaSpan (RealSrcSpan r _)) = r
epaLocationRealSrcSpan _ = panic "epaLocationRealSrcSpan"
-instance Outputable NoComments where
- ppr NoComments = text "NoComments"
-
-instance (Outputable a) => Outputable (EpaLocation' a) where
- ppr (EpaSpan r) = text "EpaSpan" <+> ppr r
- ppr (EpaDelta d cs) = text "EpaDelta" <+> ppr d <+> ppr cs
-
instance Outputable AddEpAnn where
ppr (AddEpAnn kw ss) = text "AddEpAnn" <+> ppr kw <+> ppr ss
@@ -1419,10 +1365,6 @@ instance (Outputable a) => Outputable (EpAnn a) where
instance Outputable NoEpAnns where
ppr NoEpAnns = text "NoEpAnns"
-instance Outputable DeltaPos where
- ppr (SameLine c) = text "SameLine" <+> ppr c
- ppr (DifferentLine l c) = text "DifferentLine" <+> ppr l <+> ppr c
-
instance Outputable (GenLocated NoCommentsLocation EpaComment) where
ppr (L l c) = text "L" <+> ppr l <+> ppr c
diff --git a/compiler/GHC/Types/SourceText.hs b/compiler/GHC/Types/SourceText.hs
index 45e2a7f97a7778858be1995112cd5557ff48418f..74ed351e6e9565cf7c0d613875e03c295aa07f43 100644
--- a/compiler/GHC/Types/SourceText.hs
+++ b/compiler/GHC/Types/SourceText.hs
@@ -305,17 +305,13 @@ data StringLiteral = StringLiteral
{ sl_st :: SourceText, -- literal raw source.
-- See Note [Literal source text]
sl_fs :: FastString, -- literal string value
- sl_tc :: Maybe RealSrcSpan -- Location of
+ sl_tc :: Maybe NoCommentsLocation
+ -- Location of
-- possible
-- trailing comma
-- AZ: if we could have a LocatedA
-- StringLiteral we would not need sl_tc, but
-- that would cause import loops.
-
- -- AZ:2: sl_tc should be an EpaAnchor, to allow
- -- editing and reprinting the AST. Need a more
- -- robust solution.
-
} deriving Data
instance Eq StringLiteral where
diff --git a/compiler/GHC/Types/SrcLoc.hs b/compiler/GHC/Types/SrcLoc.hs
index 18ba080f0b12c32879639bedd94a3ce2ee161b45..b96e4af3bc0c141a5af11ad14dd0839a45b73c33 100644
--- a/compiler/GHC/Types/SrcLoc.hs
+++ b/compiler/GHC/Types/SrcLoc.hs
@@ -109,6 +109,10 @@ module GHC.Types.SrcLoc (
mkSrcSpanPs,
combineRealSrcSpans,
psLocatedToLocated,
+
+ -- * Exact print locations
+ EpaLocation'(..), NoCommentsLocation, NoComments(..),
+ DeltaPos(..), deltaPos, getDeltaLine,
) where
import GHC.Prelude
@@ -894,3 +898,70 @@ psSpanEnd (PsSpan r b) = PsLoc (realSrcSpanEnd r) (bufSpanEnd b)
mkSrcSpanPs :: PsSpan -> SrcSpan
mkSrcSpanPs (PsSpan r b) = RealSrcSpan r (Strict.Just b)
+
+-- ---------------------------------------------------------------------
+-- The following section contains basic types related to exact printing.
+-- See https://gitlab.haskell.org/ghc/ghc/wikis/api-annotations for
+-- details.
+-- This is only s subset, to prevent import loops. The balance are in
+-- GHC.Parser.Annotation
+-- ---------------------------------------------------------------------
+
+
+-- | 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' a = EpaSpan !SrcSpan
+ | EpaDelta !DeltaPos !a
+ deriving (Data,Eq,Show)
+
+type NoCommentsLocation = EpaLocation' NoComments
+
+data NoComments = NoComments
+ deriving (Data,Eq,Ord,Show)
+
+-- | Spacing between output items when exact printing. It captures
+-- the spacing from the current print position on the page to the
+-- position required for the thing about to be printed. This is
+-- either on the same line in which case is is simply the number of
+-- spaces to emit, or it is some number of lines down, with a given
+-- column offset. The exact printing algorithm keeps track of the
+-- column offset pertaining to the current anchor position, so the
+-- `deltaColumn` is the additional spaces to add in this case. See
+-- https://gitlab.haskell.org/ghc/ghc/wikis/api-annotations for
+-- details.
+data DeltaPos
+ = SameLine { deltaColumn :: !Int }
+ | DifferentLine
+ { deltaLine :: !Int, -- ^ deltaLine should always be > 0
+ deltaColumn :: !Int
+ } deriving (Show,Eq,Ord,Data)
+
+-- | Smart constructor for a 'DeltaPos'. It preserves the invariant
+-- that for the 'DifferentLine' constructor 'deltaLine' is always > 0.
+deltaPos :: Int -> Int -> DeltaPos
+deltaPos l c = case l of
+ 0 -> SameLine c
+ _ -> DifferentLine l c
+
+getDeltaLine :: DeltaPos -> Int
+getDeltaLine (SameLine _) = 0
+getDeltaLine (DifferentLine r _) = r
+
+instance Outputable NoComments where
+ ppr NoComments = text "NoComments"
+
+instance (Outputable a) => Outputable (EpaLocation' a) where
+ ppr (EpaSpan r) = text "EpaSpan" <+> ppr r
+ ppr (EpaDelta d cs) = text "EpaDelta" <+> ppr d <+> ppr cs
+
+instance Outputable DeltaPos where
+ ppr (SameLine c) = text "SameLine" <+> ppr c
+ ppr (DifferentLine l c) = text "DifferentLine" <+> ppr l <+> ppr c
diff --git a/utils/check-exact/ExactPrint.hs b/utils/check-exact/ExactPrint.hs
index 7c1b24bb7866397759d4b1c128b9e534f6e00acf..1ddc7b3443d006e9039322e737929d25e8ba46b1 100644
--- a/utils/check-exact/ExactPrint.hs
+++ b/utils/check-exact/ExactPrint.hs
@@ -711,6 +711,11 @@ printStringAtMLocL (EpAnn anc an cs) l s = do
printStringAtAA :: (Monad m, Monoid w) => EpaLocation -> String -> EP w m EpaLocation
printStringAtAA el str = printStringAtAAC CaptureComments el str
+printStringAtNC :: (Monad m, Monoid w) => NoCommentsLocation -> String -> EP w m NoCommentsLocation
+printStringAtNC el str = do
+ el' <- printStringAtAAC NoCaptureComments (noCommentsToEpaLocation el) str
+ return (epaToNoCommentsLocation el')
+
printStringAtAAL :: (Monad m, Monoid w)
=> a -> Lens a EpaLocation -> String -> EP w m a
printStringAtAAL an l str = do
@@ -2117,10 +2122,10 @@ instance ExactPrint StringLiteral where
getAnnotationEntry = const NoEntryVal
setAnnotationAnchor a _ _ _ = a
- exact l@(StringLiteral src fs mcomma) = do
+ exact (StringLiteral src fs mcomma) = do
printSourceTextAA src (show (unpackFS fs))
- mapM_ (\r -> printStringAtRs r ",") mcomma
- return l
+ mcomma' <- mapM (\r -> printStringAtNC r ",") mcomma
+ return (StringLiteral src fs mcomma')
-- ---------------------------------------------------------------------