From f002250abac21ee4e9c9e4d7bc05db8aa885a65d Mon Sep 17 00:00:00 2001
From: Andreas Klebinger <klebinger.andreas@gmx.at>
Date: Thu, 4 Jul 2019 12:50:00 +0200
Subject: [PATCH] Dont gather ticks when only striping them in STG.
Adds stripStgTicksTopE which only returns the stripped expression.
So far we also allocated a list for the stripped ticks which was
never used.
Allocation difference is as expected very small but present.
About 0.02% difference when compiling with -O.
---
compiler/codeGen/StgCmmBind.hs | 2 +-
compiler/stgSyn/CoreToStg.hs | 4 ++--
compiler/stgSyn/StgSyn.hs | 10 ++++++++--
3 files changed, 11 insertions(+), 5 deletions(-)
diff --git a/compiler/codeGen/StgCmmBind.hs b/compiler/codeGen/StgCmmBind.hs
index 68a79878d3b3..7189800f6ee8 100644
--- a/compiler/codeGen/StgCmmBind.hs
+++ b/compiler/codeGen/StgCmmBind.hs
@@ -265,7 +265,7 @@ mkRhsClosure dflags bndr _cc
upd_flag -- Updatable thunk
[] -- A thunk
expr
- | let strip = snd . stripStgTicksTop (not . tickishIsCode)
+ | let strip = stripStgTicksTopE (not . tickishIsCode)
, StgCase (StgApp scrutinee [{-no args-}])
_ -- ignore bndr
(AlgAlt _)
diff --git a/compiler/stgSyn/CoreToStg.hs b/compiler/stgSyn/CoreToStg.hs
index 6c59ebb08172..dae1e351eb17 100644
--- a/compiler/stgSyn/CoreToStg.hs
+++ b/compiler/stgSyn/CoreToStg.hs
@@ -716,7 +716,7 @@ mkTopStgRhs dflags this_mod ccs bndr rhs
, ccs )
where
- (_, unticked_rhs) = stripStgTicksTop (not . tickishIsCode) rhs
+ unticked_rhs = stripStgTicksTopE (not . tickishIsCode) rhs
upd_flag | isUsedOnce (idDemandInfo bndr) = SingleEntry
| otherwise = Updatable
@@ -758,7 +758,7 @@ mkStgRhs bndr rhs
currentCCS
upd_flag [] rhs
where
- (_, unticked_rhs) = stripStgTicksTop (not . tickishIsCode) rhs
+ unticked_rhs = stripStgTicksTopE (not . tickishIsCode) rhs
upd_flag | isUsedOnce (idDemandInfo bndr) = SingleEntry
| otherwise = Updatable
diff --git a/compiler/stgSyn/StgSyn.hs b/compiler/stgSyn/StgSyn.hs
index 2372e3ed27f4..e6a12053990b 100644
--- a/compiler/stgSyn/StgSyn.hs
+++ b/compiler/stgSyn/StgSyn.hs
@@ -50,7 +50,7 @@ module StgSyn (
topStgBindHasCafRefs, stgArgHasCafRefs, stgRhsArity,
isDllConApp,
stgArgType,
- stripStgTicksTop,
+ stripStgTicksTop, stripStgTicksTopE,
stgCaseBndrInScope,
pprStgBinding, pprGenStgTopBindings, pprStgTopBindings
@@ -163,12 +163,18 @@ stgArgType (StgVarArg v) = idType v
stgArgType (StgLitArg lit) = literalType lit
--- | Strip ticks of a given type from an STG expression
+-- | Strip ticks of a given type from an STG expression.
stripStgTicksTop :: (Tickish Id -> Bool) -> GenStgExpr p -> ([Tickish Id], GenStgExpr p)
stripStgTicksTop p = go []
where go ts (StgTick t e) | p t = go (t:ts) e
go ts other = (reverse ts, other)
+-- | Strip ticks of a given type from an STG expression returning only the expression.
+stripStgTicksTopE :: (Tickish Id -> Bool) -> GenStgExpr p -> GenStgExpr p
+stripStgTicksTopE p = go
+ where go (StgTick t e) | p t = go e
+ go other = other
+
-- | Given an alt type and whether the program is unarised, return whether the
-- case binder is in scope.
--
--
GitLab