compiler: Use compact representation/FastStrings for `SourceNote`s

`SourceNote`s should not be stored as [Char] as this is highly wasteful
and in certain scenarios can be highly duplicated.

Metric Decrease:
  hard_hole_fits

15 files changed, 33 insertions, 28 deletions

diff --git a/compiler/GHC/Cmm/CLabel.hs b/compiler/GHC/Cmm/CLabel.hs
index e1e69a6296..274e5a834d 100644
--- a/compiler/GHC/Cmm/CLabel.hs
+++ b/compiler/GHC/Cmm/CLabel.hs
@@ -839,7 +839,7 @@ data InfoProvEnt = InfoProvEnt
                                -- The rendered Haskell type of the closure the table represents
                                , infoProvModule :: !Module
                                -- Origin module
-                               , infoTableProv :: !(Maybe (RealSrcSpan, String)) }
+                               , infoTableProv :: !(Maybe (RealSrcSpan, LexicalFastString)) }
                                -- Position and information about the info table
                                deriving (Eq, Ord)
 
diff --git a/compiler/GHC/Cmm/Parser.y b/compiler/GHC/Cmm/Parser.y
index 495e72e37d..5634c27712 100644
--- a/compiler/GHC/Cmm/Parser.y
+++ b/compiler/GHC/Cmm/Parser.y
@@ -1501,7 +1501,7 @@ withSourceNote :: Located a -> Located b -> CmmParse c -> CmmParse c
 withSourceNote a b parse = do
   name <- getName
   case combineSrcSpans (getLoc a) (getLoc b) of
-    RealSrcSpan span _ -> code (emitTick (SourceNote span name)) >> parse
+    RealSrcSpan span _ -> code (emitTick (SourceNote span $ LexicalFastString $ mkFastString name)) >> parse
     _other           -> parse
 
 -- -----------------------------------------------------------------------------
diff --git a/compiler/GHC/CmmToAsm/AArch64/CodeGen.hs b/compiler/GHC/CmmToAsm/AArch64/CodeGen.hs
index c0e9a7e8d5..7e669e8363 100644
--- a/compiler/GHC/CmmToAsm/AArch64/CodeGen.hs
+++ b/compiler/GHC/CmmToAsm/AArch64/CodeGen.hs
@@ -144,10 +144,10 @@ basicBlockCodeGen block = do
   -- Generate location directive
   dbg <- getDebugBlock (entryLabel block)
   loc_instrs <- case dblSourceTick =<< dbg of
-    Just (SourceNote span name)
+    Just (SourceNote span (LexicalFastString name))
       -> do fileId <- getFileId (srcSpanFile span)
             let line = srcSpanStartLine span; col = srcSpanStartCol span
-            return $ unitOL $ LOCATION fileId line col name
+            return $ unitOL $ LOCATION fileId line col (unpackFS name)
     _ -> return nilOL
   (mid_instrs,mid_bid) <- stmtsToInstrs id stmts
   (!tail_instrs,_) <- stmtToInstrs mid_bid tail
diff --git a/compiler/GHC/CmmToAsm/Dwarf.hs b/compiler/GHC/CmmToAsm/Dwarf.hs
index 58f0815329..2481a2dd73 100644
--- a/compiler/GHC/CmmToAsm/Dwarf.hs
+++ b/compiler/GHC/CmmToAsm/Dwarf.hs
@@ -6,6 +6,7 @@ import GHC.Prelude
 
 import GHC.Cmm.CLabel
 import GHC.Cmm.Expr
+import GHC.Data.FastString
 import GHC.Settings.Config ( cProjectName, cProjectVersion )
 import GHC.Types.Tickish   ( CmmTickish, GenTickish(..) )
 import GHC.Cmm.DebugBlock
@@ -177,7 +178,8 @@ procToDwarf :: NCGConfig -> DebugBlock -> DwarfInfo
 procToDwarf config prc
   = DwarfSubprogram { dwChildren = map (blockToDwarf config) (dblBlocks prc)
                     , dwName     = case dblSourceTick prc of
-                         Just s@SourceNote{} -> sourceName s
+                         Just s@SourceNote{} -> case sourceName s of
+                            LexicalFastString s -> unpackFS s
                          _otherwise -> show (dblLabel prc)
                     , dwLabel    = dblCLabel prc
                     , dwParent   = fmap mkAsmTempDieLabel
diff --git a/compiler/GHC/CmmToAsm/PPC/CodeGen.hs b/compiler/GHC/CmmToAsm/PPC/CodeGen.hs
index f8a726da6c..6fa50d586d 100644
--- a/compiler/GHC/CmmToAsm/PPC/CodeGen.hs
+++ b/compiler/GHC/CmmToAsm/PPC/CodeGen.hs
@@ -129,10 +129,10 @@ basicBlockCodeGen block = do
   -- Generate location directive
   dbg <- getDebugBlock (entryLabel block)
   loc_instrs <- case dblSourceTick =<< dbg of
-    Just (SourceNote span name)
+    Just (SourceNote span (LexicalFastString name))
       -> do fileid <- getFileId (srcSpanFile span)
             let line = srcSpanStartLine span; col =srcSpanStartCol span
-            return $ unitOL $ LOCATION fileid line col name
+            return $ unitOL $ LOCATION fileid line col (unpackFS name)
     _ -> return nilOL
   mid_instrs <- stmtsToInstrs stmts
   tail_instrs <- stmtToInstrs tail
diff --git a/compiler/GHC/CmmToAsm/X86/CodeGen.hs b/compiler/GHC/CmmToAsm/X86/CodeGen.hs
index 859b27e248..4141e8f292 100644
--- a/compiler/GHC/CmmToAsm/X86/CodeGen.hs
+++ b/compiler/GHC/CmmToAsm/X86/CodeGen.hs
@@ -196,10 +196,10 @@ basicBlockCodeGen block = do
   -- Generate location directive
   dbg <- getDebugBlock (entryLabel block)
   loc_instrs <- case dblSourceTick =<< dbg of
-    Just (SourceNote span name)
+    Just (SourceNote span (LexicalFastString name))
       -> do fileId <- getFileId (srcSpanFile span)
             let line = srcSpanStartLine span; col = srcSpanStartCol span
-            return $ unitOL $ LOCATION fileId line col name
+            return $ unitOL $ LOCATION fileId line col (unpackFS name)
     _ -> return nilOL
   (mid_instrs,mid_bid) <- stmtsToInstrs id stmts
   (!tail_instrs,_) <- stmtToInstrs mid_bid tail
diff --git a/compiler/GHC/CoreToIface.hs b/compiler/GHC/CoreToIface.hs
index e6d3fe93b7..566900cdb4 100644
--- a/compiler/GHC/CoreToIface.hs
+++ b/compiler/GHC/CoreToIface.hs
@@ -578,7 +578,7 @@ toIfaceOneShot id | isId id
 toIfaceTickish :: CoreTickish -> Maybe IfaceTickish
 toIfaceTickish (ProfNote cc tick push) = Just (IfaceSCC cc tick push)
 toIfaceTickish (HpcTick modl ix)       = Just (IfaceHpcTick modl ix)
-toIfaceTickish (SourceNote src names)  = Just (IfaceSource src names)
+toIfaceTickish (SourceNote src (LexicalFastString names))  = Just (IfaceSource src names)
 toIfaceTickish (Breakpoint {})         = Nothing
    -- Ignore breakpoints, since they are relevant only to GHCi, and
    -- should not be serialised (#8333)
diff --git a/compiler/GHC/CoreToStg/Prep.hs b/compiler/GHC/CoreToStg/Prep.hs
index d4f1fc52b3..48969e0dcb 100644
--- a/compiler/GHC/CoreToStg/Prep.hs
+++ b/compiler/GHC/CoreToStg/Prep.hs
@@ -314,7 +314,7 @@ mkDataConWorkers generate_debug_info mod_loc data_tycons
      | Just file <- ml_hs_file mod_loc       = tick (span1 file)
      | otherwise                             = tick (span1 "???")
      where tick span  = Tick $ SourceNote span $
-             renderWithContext defaultSDocContext $ ppr name
+             LexicalFastString $ mkFastString $ renderWithContext defaultSDocContext $ ppr name
            span1 file = realSrcLocSpan $ mkRealSrcLoc (mkFastString file) 1 1
 
 {-
diff --git a/compiler/GHC/HsToCore/Ticks.hs b/compiler/GHC/HsToCore/Ticks.hs
index 8c0227df80..ccacf71887 100644
--- a/compiler/GHC/HsToCore/Ticks.hs
+++ b/compiler/GHC/HsToCore/Ticks.hs
@@ -1182,24 +1182,23 @@ mkTickish boxLabel countEntries topOnly pos fvs decl_path = do
         , tick_label = boxLabel
         }
 
-      cc_name | topOnly   = head decl_path
-              | otherwise = concat (intersperse "." decl_path)
+      cc_name | topOnly   = mkFastString $ head decl_path
+              | otherwise = mkFastString $ concat (intersperse "." decl_path)
 
   env <- getEnv
   case tickishType env of
     HpcTicks -> HpcTick (this_mod env) <$> addMixEntry me
 
     ProfNotes -> do
-      let nm = mkFastString cc_name
-      flavour <- mkHpcCCFlavour <$> getCCIndexM nm
-      let cc = mkUserCC nm (this_mod env) pos flavour
+      flavour <- mkHpcCCFlavour <$> getCCIndexM cc_name
+      let cc = mkUserCC cc_name (this_mod env) pos flavour
           count = countEntries && tte_countEntries env
       return $ ProfNote cc count True{-scopes-}
 
     Breakpoints -> Breakpoint noExtField <$> addMixEntry me <*> pure ids
 
     SourceNotes | RealSrcSpan pos' _ <- pos ->
-      return $ SourceNote pos' cc_name
+      return $ SourceNote pos' $ LexicalFastString cc_name
 
     _otherwise -> panic "mkTickish: bad source span!"
 
diff --git a/compiler/GHC/Iface/Syntax.hs b/compiler/GHC/Iface/Syntax.hs
index 84603e9399..e48678ec80 100644
--- a/compiler/GHC/Iface/Syntax.hs
+++ b/compiler/GHC/Iface/Syntax.hs
@@ -45,6 +45,7 @@ module GHC.Iface.Syntax (
 
 import GHC.Prelude
 
+import GHC.Data.FastString
 import GHC.Builtin.Names ( unrestrictedFunTyConKey, liftedTypeKindTyConKey,
                            constraintKindTyConKey )
 import GHC.Types.Unique ( hasKey )
@@ -577,7 +578,7 @@ data IfaceExpr
 data IfaceTickish
   = IfaceHpcTick Module Int                -- from HpcTick x
   | IfaceSCC     CostCentre Bool Bool      -- from ProfNote
-  | IfaceSource  RealSrcSpan String        -- from SourceNote
+  | IfaceSource  RealSrcSpan FastString        -- from SourceNote
   -- no breakpoints: we never export these into interface files
 
 data IfaceAlt = IfaceAlt IfaceConAlt [IfLclName] IfaceExpr
diff --git a/compiler/GHC/IfaceToCore.hs b/compiler/GHC/IfaceToCore.hs
index e37f34ef46..03506e531c 100644
--- a/compiler/GHC/IfaceToCore.hs
+++ b/compiler/GHC/IfaceToCore.hs
@@ -1646,7 +1646,7 @@ tcIfaceExpr (IfaceTick tickish expr) = do
 tcIfaceTickish :: IfaceTickish -> IfM lcl CoreTickish
 tcIfaceTickish (IfaceHpcTick modl ix)   = return (HpcTick modl ix)
 tcIfaceTickish (IfaceSCC  cc tick push) = return (ProfNote cc tick push)
-tcIfaceTickish (IfaceSource src name)   = return (SourceNote src name)
+tcIfaceTickish (IfaceSource src name)   = return (SourceNote src (LexicalFastString name))
 
 -------------------------
 tcIfaceLit :: Literal -> IfL Literal
diff --git a/compiler/GHC/Stg/Debug.hs b/compiler/GHC/Stg/Debug.hs
index 39a559cb73..fd3cbeea88 100644
--- a/compiler/GHC/Stg/Debug.hs
+++ b/compiler/GHC/Stg/Debug.hs
@@ -16,7 +16,7 @@ import GHC.Types.Tickish
 import GHC.Core.DataCon
 import GHC.Types.IPE
 import GHC.Unit.Module
-import GHC.Types.Name   ( getName, getOccName, occNameString, nameSrcSpan)
+import GHC.Types.Name   ( getName, getOccName, occNameFS, nameSrcSpan)
 import GHC.Data.FastString
 
 import Control.Monad (when)
@@ -29,7 +29,7 @@ import Control.Applicative
 import qualified Data.List.NonEmpty as NE
 import Data.List.NonEmpty (NonEmpty(..))
 
-data SpanWithLabel = SpanWithLabel RealSrcSpan String
+data SpanWithLabel = SpanWithLabel RealSrcSpan LexicalFastString
 
 data StgDebugOpts = StgDebugOpts
   { stgDebug_infoTableMap              :: !Bool
@@ -74,7 +74,7 @@ collectStgRhs bndr (StgRhsClosure ext cc us bs e t) = do
     -- If the name has a span, use that initially as the source position in-case
     -- we don't get anything better.
     with_span = case nameSrcSpan name of
-                  RealSrcSpan pos _ -> withSpan (pos, occNameString (getOccName name))
+                  RealSrcSpan pos _ -> withSpan (pos, LexicalFastString $ occNameFS (getOccName name))
                   _ -> id
   e' <- with_span $ collectExpr e
   recordInfo bndr e'
@@ -92,7 +92,7 @@ recordInfo bndr new_rhs = do
     -- A span from the ticks surrounding the new_rhs
     best_span = quickSourcePos thisFile new_rhs
     -- A back-up span if the bndr had a source position, many do not (think internally generated ids)
-    bndr_span = (\s -> SpanWithLabel s (occNameString (getOccName bndr)))
+    bndr_span = (\s -> SpanWithLabel s (LexicalFastString $ occNameFS (getOccName bndr)))
                   <$> srcSpanToRealSrcSpan (nameSrcSpan (getName bndr))
   recordStgIdPosition bndr best_span bndr_span
 
diff --git a/compiler/GHC/StgToCmm/InfoTableProv.hs b/compiler/GHC/StgToCmm/InfoTableProv.hs
index 20e2056116..4f6a23ef01 100644
--- a/compiler/GHC/StgToCmm/InfoTableProv.hs
+++ b/compiler/GHC/StgToCmm/InfoTableProv.hs
@@ -5,11 +5,12 @@ import GHC.Platform
 import GHC.Unit.Module
 import GHC.Utils.Outputable
 import GHC.Types.SrcLoc (pprUserRealSpan, srcSpanFile)
-import GHC.Data.FastString (fastStringToShortText)
+import GHC.Data.FastString (fastStringToShortText, unpackFS, LexicalFastString(..))
 
 import GHC.Cmm.CLabel
 import GHC.Cmm.Expr
 import GHC.Cmm.Utils
+
 import GHC.StgToCmm.Config
 import GHC.StgToCmm.Lit (newByteStringCLit)
 import GHC.StgToCmm.Monad
@@ -67,7 +68,7 @@ toCgIPE platform ctx module_name ipe = do
     table_name <- lookupStringTable $ ST.pack $ renderWithContext ctx (pprCLabel platform (infoTablePtr ipe))
     closure_desc <- lookupStringTable $ ST.pack $ show (infoProvEntClosureType ipe)
     type_desc <- lookupStringTable $ ST.pack $ infoTableType ipe
-    let label_str = maybe "" snd (infoTableProv ipe)
+    let label_str = maybe "" ((\(LexicalFastString s) -> unpackFS s) . snd) (infoTableProv ipe)
     let (src_loc_file, src_loc_span) =
             case infoTableProv ipe of
               Nothing -> (mempty, "")
diff --git a/compiler/GHC/Types/IPE.hs b/compiler/GHC/Types/IPE.hs
index 461bae6a55..2de2bf18e2 100644
--- a/compiler/GHC/Types/IPE.hs
+++ b/compiler/GHC/Types/IPE.hs
@@ -9,6 +9,7 @@ module GHC.Types.IPE (
 import GHC.Prelude
 
 import GHC.Types.Name
+import GHC.Data.FastString
 import GHC.Types.SrcLoc
 import GHC.Core.DataCon
 
@@ -20,7 +21,7 @@ import qualified Data.Map.Strict as Map
 
 -- | Position and information about an info table.
 -- For return frames these are the contents of a 'CoreSyn.SourceNote'.
-type IpeSourceLocation = (RealSrcSpan, String)
+type IpeSourceLocation = (RealSrcSpan, LexicalFastString)
 
 -- | A map from a 'Name' to the best approximate source position that
 -- name arose from.
diff --git a/compiler/GHC/Types/Tickish.hs b/compiler/GHC/Types/Tickish.hs
index c1f745870d..5cbfb876e5 100644
--- a/compiler/GHC/Types/Tickish.hs
+++ b/compiler/GHC/Types/Tickish.hs
@@ -25,6 +25,7 @@ module GHC.Types.Tickish (
 ) where
 
 import GHC.Prelude
+import GHC.Data.FastString
 
 import GHC.Core.Type
 
@@ -153,8 +154,8 @@ data GenTickish pass =
   -- necessary to enable optimizations.
   | SourceNote
     { sourceSpan :: RealSrcSpan -- ^ Source covered
-    , sourceName :: String      -- ^ Name for source location
-                                --   (uses same names as CCs)
+    , sourceName :: LexicalFastString  -- ^ Name for source location
+                                       --   (uses same names as CCs)
     }
 
 deriving instance Eq (GenTickish 'TickishPassCore)