diff options
Diffstat (limited to 'compiler/simplStg/StgCse.hs')
| -rw-r--r-- | compiler/simplStg/StgCse.hs | 38 |
1 files changed, 25 insertions, 13 deletions
diff --git a/compiler/simplStg/StgCse.hs b/compiler/simplStg/StgCse.hs index 6bd6adc7ec..1ae1213960 100644 --- a/compiler/simplStg/StgCse.hs +++ b/compiler/simplStg/StgCse.hs @@ -5,9 +5,9 @@ Note [CSE for Stg] ~~~~~~~~~~~~~~~~~~ This module implements a simple common subexpression elimination pass for STG. This is useful because there are expressions that we want to common up (because -they are operational equivalent), but that we cannot common up in Core, because +they are operationally equivalent), but that we cannot common up in Core, because their types differ. -This was original reported as #9291. +This was originally reported as #9291. There are two types of common code occurrences that we aim for, see note [Case 1: CSEing allocated closures] and @@ -16,7 +16,7 @@ note [Case 2: CSEing case binders] below. Note [Case 1: CSEing allocated closures] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -The fist kind of CSE opportunity we aim for is generated by this Haskell code: +The first kind of CSE opportunity we aim for is generated by this Haskell code: bar :: a -> (Either Int a, Either Bool a) bar x = (Right x, Right x) @@ -70,6 +70,8 @@ and nothing stops us from transforming that to -} module StgCse (stgCse) where +import GhcPrelude + import DataCon import Id import StgSyn @@ -78,7 +80,7 @@ import VarEnv import CoreSyn (AltCon(..)) import Data.List (mapAccumL) import Data.Maybe (fromMaybe) -import TrieMap +import CoreMap import NameEnv import Control.Monad( (>=>) ) @@ -137,7 +139,7 @@ data CseEnv = CseEnv -- * If we remove `let x = Con z` because `let y = Con z` is in scope, -- we note this here as x ↦ y. , ce_bndrMap :: IdEnv OutId - -- If we come across a case expression case x as b of … with a trivial + -- ^ If we come across a case expression case x as b of … with a trivial -- binder, we add b ↦ x to this. -- This map is *only* used when looking something up in the ce_conAppMap. -- See Note [Trivial case scrutinee] @@ -217,7 +219,7 @@ substVar env id = fromMaybe id $ lookupVarEnv (ce_subst env) id -- Functions to enter binders --- This is much simpler than the requivalent code in CoreSubst: +-- This is much simpler than the equivalent code in CoreSubst: -- * We do not substitute type variables, and -- * There is nothing relevant in IdInfo at this stage -- that needs substitutions. @@ -300,7 +302,7 @@ stgCseExpr env (StgCase scrut bndr ty alts) env2 | StgApp trivial_scrut [] <- scrut' = addTrivCaseBndr bndr trivial_scrut env1 -- See Note [Trivial case scrutinee] | otherwise = env1 - alts' = map (stgCseAlt env2 bndr') alts + alts' = map (stgCseAlt env2 ty bndr') alts -- A constructor application. @@ -327,14 +329,24 @@ stgCseExpr env (StgLetNoEscape binds body) -- Case alternatives -- Extend the CSE environment -stgCseAlt :: CseEnv -> OutId -> InStgAlt -> OutStgAlt -stgCseAlt env case_bndr (DataAlt dataCon, args, rhs) +stgCseAlt :: CseEnv -> AltType -> OutId -> InStgAlt -> OutStgAlt +stgCseAlt env ty case_bndr (DataAlt dataCon, args, rhs) = let (env1, args') = substBndrs env args - env2 = addDataCon case_bndr dataCon (map StgVarArg args') env1 + env2 + -- To avoid dealing with unboxed sums StgCse runs after unarise and + -- should maintain invariants listed in Note [Post-unarisation + -- invariants]. One of the invariants is that some binders are not + -- used (unboxed tuple case binders) which is what we check with + -- `stgCaseBndrInScope` here. If the case binder is not in scope we + -- don't add it to the CSE env. See also #15300. + | stgCaseBndrInScope ty True -- CSE runs after unarise + = addDataCon case_bndr dataCon (map StgVarArg args') env1 + | otherwise + = env1 -- see note [Case 2: CSEing case binders] rhs' = stgCseExpr env2 rhs in (DataAlt dataCon, args', rhs') -stgCseAlt env _ (altCon, args, rhs) +stgCseAlt env _ _ (altCon, args, rhs) = let (env1, args') = substBndrs env args rhs' = stgCseExpr env1 rhs in (altCon, args', rhs') @@ -362,7 +374,7 @@ stgCsePairs env0 ((b,e):pairs) mbCons = maybe id (:) -- The RHS of a binding. --- If it is an constructor application, either short-cut it or extend the environment +-- If it is a constructor application, either short-cut it or extend the environment stgCseRhs :: CseEnv -> OutId -> InStgRhs -> (Maybe (OutId, OutStgRhs), CseEnv) stgCseRhs env bndr (StgRhsCon ccs dataCon args) | Just other_bndr <- envLookup dataCon args' env @@ -438,7 +450,7 @@ we first replace v with r2. Next we want to replace Right r2 with r1. But the ce_conAppMap contains Right a! Therefore, we add r1 ↦ x to ce_bndrMap when analysing the outer case, and use -this subsitution before looking Right r2 up in ce_conAppMap, and everything +this substitution before looking Right r2 up in ce_conAppMap, and everything works out. Note [Free variables of an StgClosure] |