diff options
| -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. -- |