diff options
| author | Andreas Klebinger <klebinger.andreas@gmx.at> | 2019-07-04 12:50:00 +0200 |
|---|---|---|
| committer | Marge Bot <ben+marge-bot@smart-cactus.org> | 2019-07-04 21:25:43 -0400 |
| commit | f002250abac21ee4e9c9e4d7bc05db8aa885a65d (patch) | |
| tree | fe7a65afc103e1d56ec1540185947900a5068a06 | |
| parent | 80afdf6be11ae3b5bfd1b09dbc5f5118a9dde55a (diff) | |
| download | haskell-f002250abac21ee4e9c9e4d7bc05db8aa885a65d.tar.gz | |
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.
| -rw-r--r-- | compiler/codeGen/StgCmmBind.hs | 2 | ||||
| -rw-r--r-- | compiler/stgSyn/CoreToStg.hs | 4 | ||||
| -rw-r--r-- | 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 68a79878d3..7189800f6e 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 6c59ebb081..dae1e351eb 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 2372e3ed27..e6a1205399 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. -- |