From b70bc6900fcee7ff1e334bf8099283f610d6f9d4 Mon Sep 17 00:00:00 2001 From: Zubin Duggal Date: Thu, 4 May 2023 05:52:13 +0530 Subject: 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 --- compiler/GHC/Cmm/CLabel.hs | 2 +- compiler/GHC/Cmm/Parser.y | 2 +- compiler/GHC/CmmToAsm/AArch64/CodeGen.hs | 4 ++-- compiler/GHC/CmmToAsm/Dwarf.hs | 4 +++- compiler/GHC/CmmToAsm/PPC/CodeGen.hs | 4 ++-- compiler/GHC/CmmToAsm/X86/CodeGen.hs | 4 ++-- compiler/GHC/CoreToIface.hs | 2 +- compiler/GHC/CoreToStg/Prep.hs | 2 +- compiler/GHC/HsToCore/Ticks.hs | 11 +++++------ compiler/GHC/Iface/Syntax.hs | 3 ++- compiler/GHC/IfaceToCore.hs | 2 +- compiler/GHC/Stg/Debug.hs | 8 ++++---- compiler/GHC/StgToCmm/InfoTableProv.hs | 5 +++-- compiler/GHC/Types/IPE.hs | 3 ++- compiler/GHC/Types/Tickish.hs | 5 +++-- 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) -- cgit v1.2.1