summaryrefslogtreecommitdiff
path: root/compiler
diff options
context:
space:
mode:
authorZubin Duggal <zubin.duggal@gmail.com>2023-05-04 05:52:13 +0530
committerMarge Bot <ben+marge-bot@smart-cactus.org>2023-05-16 14:00:00 -0400
commitb70bc6900fcee7ff1e334bf8099283f610d6f9d4 (patch)
tree00b6c66159721fbedc9f59e12e3b61181937c584 /compiler
parent90e69d5d167b9d6cd63b04e42f8af375dc4b307f (diff)
downloadhaskell-b70bc6900fcee7ff1e334bf8099283f610d6f9d4.tar.gz
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
Diffstat (limited to 'compiler')
-rw-r--r--compiler/GHC/Cmm/CLabel.hs2
-rw-r--r--compiler/GHC/Cmm/Parser.y2
-rw-r--r--compiler/GHC/CmmToAsm/AArch64/CodeGen.hs4
-rw-r--r--compiler/GHC/CmmToAsm/Dwarf.hs4
-rw-r--r--compiler/GHC/CmmToAsm/PPC/CodeGen.hs4
-rw-r--r--compiler/GHC/CmmToAsm/X86/CodeGen.hs4
-rw-r--r--compiler/GHC/CoreToIface.hs2
-rw-r--r--compiler/GHC/CoreToStg/Prep.hs2
-rw-r--r--compiler/GHC/HsToCore/Ticks.hs11
-rw-r--r--compiler/GHC/Iface/Syntax.hs3
-rw-r--r--compiler/GHC/IfaceToCore.hs2
-rw-r--r--compiler/GHC/Stg/Debug.hs8
-rw-r--r--compiler/GHC/StgToCmm/InfoTableProv.hs5
-rw-r--r--compiler/GHC/Types/IPE.hs3
-rw-r--r--compiler/GHC/Types/Tickish.hs5
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)