Dont gather ticks when only striping them in STG.
authorAndreas Klebinger <klebinger.andreas@gmx.at>
Thu, 4 Jul 2019 10:50:00 +0000 (12:50 +0200)
committerMarge Bot <ben+marge-bot@smart-cactus.org>
Fri, 5 Jul 2019 01:25:43 +0000 (21:25 -0400)
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
compiler/stgSyn/CoreToStg.hs
compiler/stgSyn/StgSyn.hs

index 68a7987..7189800 100644 (file)
@@ -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 _)
index 6c59ebb..dae1e35 100644 (file)
@@ -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
index 2372e3e..e6a1205 100644 (file)
@@ -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.
 --