compiler: Use compact representation for SourceText

SourceText is serialized along with INLINE pragmas into interface files. Many of
these SourceTexts are identical, for example "{-# INLINE#". When deserialized,
each such SourceText was previously expanded out into a [Char], which is highly
wasteful of memory, and each such instance of the text would allocate an
independent list with its contents as deserializing breaks any sharing that might
have existed.

Instead, we use a `FastString` to represent these, so that each instance unique
text will be interned and stored in a memory efficient manner.

5 files changed, 9 insertions, 9 deletions

diff --git a/compiler/GHC/Hs/Binds.hs b/compiler/GHC/Hs/Binds.hs
index c7dd8fca0f..ca4b6b08e2 100644
--- a/compiler/GHC/Hs/Binds.hs
+++ b/compiler/GHC/Hs/Binds.hs
@@ -756,7 +756,7 @@ ppr_sig (InlineSig _ var inl)
   = ppr_pfx <+> pprInline inl <+> pprPrefixOcc (unLoc var) <+> text "#-}"
     where
       ppr_pfx = case inlinePragmaSource inl of
-        SourceText src -> text src
+        SourceText src -> ftext src
         NoSourceText   -> text "{-#" <+> inlinePragmaName (inl_inline inl)
 ppr_sig (SpecInstSig (_, src) ty)
   = pragSrcBrackets src "{-# pragma" (text "instance" <+> ppr ty)
@@ -828,7 +828,7 @@ pragBrackets doc = text "{-#" <+> doc <+> text "#-}"
 -- | Using SourceText in case the pragma was spelled differently or used mixed
 -- case
 pragSrcBrackets :: SourceText -> String -> SDoc -> SDoc
-pragSrcBrackets (SourceText src) _   doc = text src <+> doc <+> text "#-}"
+pragSrcBrackets (SourceText src) _   doc = ftext src <+> doc <+> text "#-}"
 pragSrcBrackets NoSourceText     alt doc = text alt <+> doc <+> text "#-}"
 
 pprVarSig :: (OutputableBndr id) => [id] -> SDoc -> SDoc
diff --git a/compiler/GHC/Hs/Decls.hs b/compiler/GHC/Hs/Decls.hs
index 201adc5467..07bcba6cc4 100644
--- a/compiler/GHC/Hs/Decls.hs
+++ b/compiler/GHC/Hs/Decls.hs
@@ -913,7 +913,7 @@ ppOverlapPragma mb =
     Just (L _ (Incoherent s))   -> maybe_stext s "{-# INCOHERENT #-}"
   where
     maybe_stext NoSourceText     alt = text alt
-    maybe_stext (SourceText src) _   = text src <+> text "#-}"
+    maybe_stext (SourceText src) _   = ftext src <+> text "#-}"
 
 
 instance (OutputableBndrId p) => Outputable (InstDecl (GhcPass p)) where
@@ -1219,7 +1219,7 @@ type instance XXWarnDecl    (GhcPass _) = DataConCantHappen
 instance OutputableBndrId p
         => Outputable (WarnDecls (GhcPass p)) where
     ppr (Warnings ext decls)
-      = text src <+> vcat (punctuate comma (map ppr decls)) <+> text "#-}"
+      = ftext src <+> vcat (punctuate comma (map ppr decls)) <+> text "#-}"
       where src = case ghcPass @p of
               GhcPs | (_, SourceText src) <- ext -> src
               GhcRn | SourceText src <- ext -> src
diff --git a/compiler/GHC/Hs/Dump.hs b/compiler/GHC/Hs/Dump.hs
index 794607bd49..245a1cd43e 100644
--- a/compiler/GHC/Hs/Dump.hs
+++ b/compiler/GHC/Hs/Dump.hs
@@ -139,8 +139,8 @@ showAstData bs ba a0 = blankLine $$ showAstData' a0
             sourceText :: SourceText -> SDoc
             sourceText NoSourceText = parens $ text "NoSourceText"
             sourceText (SourceText src) = case bs of
-              NoBlankSrcSpan   -> parens $ text "SourceText" <+> text src
-              BlankSrcSpanFile -> parens $ text "SourceText" <+> text src
+              NoBlankSrcSpan   -> parens $ text "SourceText" <+> ftext src
+              BlankSrcSpanFile -> parens $ text "SourceText" <+> ftext src
               _                -> parens $ text "SourceText" <+> text "blanked"
 
             epaAnchor :: EpaLocation -> SDoc
diff --git a/compiler/GHC/Hs/Expr.hs b/compiler/GHC/Hs/Expr.hs
index be7af5002a..385bbd62c7 100644
--- a/compiler/GHC/Hs/Expr.hs
+++ b/compiler/GHC/Hs/Expr.hs
@@ -131,7 +131,7 @@ data SyntaxExprTc = SyntaxExprTc { syn_expr      :: HsExpr GhcTc
 -- | This is used for rebindable-syntax pieces that are too polymorphic
 -- for tcSyntaxOp (trS_fmap and the mzip in ParStmt)
 noExpr :: HsExpr (GhcPass p)
-noExpr = HsLit noComments (HsString (SourceText  "noExpr") (fsLit "noExpr"))
+noExpr = HsLit noComments (HsString (SourceText $ fsLit "noExpr") (fsLit "noExpr"))
 
 noSyntaxExpr :: forall p. IsPass p => SyntaxExpr (GhcPass p)
                               -- Before renaming, and sometimes after
@@ -519,7 +519,7 @@ ppr_expr (HsRecSel _ f)      = pprPrefixOcc f
 ppr_expr (HsIPVar _ v)       = ppr v
 ppr_expr (HsOverLabel _ s l) = char '#' <> case s of
                                              NoSourceText -> ppr l
-                                             SourceText src -> text src
+                                             SourceText src -> ftext src
 ppr_expr (HsLit _ lit)       = ppr lit
 ppr_expr (HsOverLit _ lit)   = ppr lit
 ppr_expr (HsPar _ _ e _)     = parens (ppr_lexpr e)
diff --git a/compiler/GHC/Hs/ImpExp.hs b/compiler/GHC/Hs/ImpExp.hs
index 83f5cfbb88..06a6cc783e 100644
--- a/compiler/GHC/Hs/ImpExp.hs
+++ b/compiler/GHC/Hs/ImpExp.hs
@@ -171,7 +171,7 @@ instance (OutputableBndrId p
                                 GhcTc -> dataConCantHappen ext
             in case mSrcText of
                   NoSourceText   -> text "{-# SOURCE #-}"
-                  SourceText src -> text src <+> text "#-}"
+                  SourceText src -> ftext src <+> text "#-}"
         ppr_imp _ NotBoot = empty
 
         pp_spec Nothing             = empty