Revert "Remove unused LiveVars and SRT fields of StgCase and StgLetNoEscape"

This reverts commit 4f9967aa3d1f7cfd539d0c173cafac0fe290e26f.

2 files changed, 23 insertions, 9 deletions

diff --git a/compiler/simplStg/StgStats.hs b/compiler/simplStg/StgStats.hs
index 5860f61057..dd1f5a64d2 100644
--- a/compiler/simplStg/StgStats.hs
+++ b/compiler/simplStg/StgStats.hs
@@ -127,7 +127,7 @@ statRhs :: Bool -> (Id, StgRhs) -> StatEnv
 statRhs top (_, StgRhsCon _ _ _)
   = countOne (ConstructorBinds top)
 
-statRhs top (_, StgRhsClosure _ _ fv u _ body)
+statRhs top (_, StgRhsClosure _ _ fv u _ _ body)
   = statExpr body                       `combineSE`
     countN FreeVariables (length fv)    `combineSE`
     countOne (
@@ -153,7 +153,7 @@ statExpr (StgConApp _ _)  = countOne ConstructorApps
 statExpr (StgOpApp _ _ _) = countOne PrimitiveApps
 statExpr (StgTick _ e)    = statExpr e
 
-statExpr (StgLetNoEscape binds body)
+statExpr (StgLetNoEscape _ _ binds body)
   = statBinding False{-not top-level-} binds    `combineSE`
     statExpr body                               `combineSE`
     countOne LetNoEscapes
@@ -162,7 +162,7 @@ statExpr (StgLet binds body)
   = statBinding False{-not top-level-} binds    `combineSE`
     statExpr body
 
-statExpr (StgCase expr _ _ alts)
+statExpr (StgCase expr _ _ _ _ _ alts)
   = statExpr expr       `combineSE`
     stat_alts alts      `combineSE`
     countOne StgCases
diff --git a/compiler/simplStg/UnariseStg.hs b/compiler/simplStg/UnariseStg.hs
index 705fce01b3..b16220134d 100644
--- a/compiler/simplStg/UnariseStg.hs
+++ b/compiler/simplStg/UnariseStg.hs
@@ -42,6 +42,7 @@ import MkId (realWorldPrimId)
 import Type
 import TysWiredIn
 import DataCon
+import VarSet
 import OccName
 import Name
 import Util
@@ -73,9 +74,9 @@ unariseBinding us rho bind = case bind of
 
 unariseRhs :: UniqSupply -> UnariseEnv -> StgRhs -> StgRhs
 unariseRhs us rho rhs = case rhs of
-  StgRhsClosure ccs b_info fvs update_flag args expr
+  StgRhsClosure ccs b_info fvs update_flag srt args expr
     -> StgRhsClosure ccs b_info (unariseIds rho fvs) update_flag
-                     args' (unariseExpr us' rho' expr)
+                     (unariseSRT rho srt) args' (unariseExpr us' rho' expr)
     where (us', rho', args') = unariseIdBinders us rho args
   StgRhsCon ccs con args
     -> StgRhsCon ccs con (unariseArgs rho args)
@@ -110,8 +111,10 @@ unariseExpr us rho (StgLam xs e)
   where
     (us', rho', xs') = unariseIdBinders us rho xs
 
-unariseExpr us rho (StgCase e bndr alt_ty alts)
-  = StgCase (unariseExpr us1 rho e) bndr alt_ty alts'
+unariseExpr us rho (StgCase e case_lives alts_lives bndr srt alt_ty alts)
+  = StgCase (unariseExpr us1 rho e) (unariseLives rho case_lives)
+            (unariseLives rho alts_lives) bndr (unariseSRT rho srt)
+            alt_ty alts'
  where
     (us1, us2) = splitUniqSupply us
     alts'      = unariseAlts us2 rho alt_ty bndr alts
@@ -121,8 +124,9 @@ unariseExpr us rho (StgLet bind e)
   where
     (us1, us2) = splitUniqSupply us
 
-unariseExpr us rho (StgLetNoEscape bind e)
-  = StgLetNoEscape (unariseBinding us1 rho bind) (unariseExpr us2 rho e)
+unariseExpr us rho (StgLetNoEscape live_in_let live_in_bind bind e)
+  = StgLetNoEscape (unariseLives rho live_in_let) (unariseLives rho live_in_bind)
+                   (unariseBinding us1 rho bind) (unariseExpr us2 rho e)
   where
     (us1, us2) = splitUniqSupply us
 
@@ -157,6 +161,13 @@ unariseAlt us rho (con, xs, uses, e)
     (us', rho', xs', uses') = unariseUsedIdBinders us rho xs uses
 
 ------------------------
+unariseSRT :: UnariseEnv -> SRT -> SRT
+unariseSRT _   NoSRT            = NoSRT
+unariseSRT rho (SRTEntries ids) = SRTEntries (concatMapVarSet (unariseId rho) ids)
+
+unariseLives :: UnariseEnv -> StgLiveVars -> StgLiveVars
+unariseLives rho ids = concatMapVarSet (unariseId rho) ids
+
 unariseArgs :: UnariseEnv -> [StgArg] -> [StgArg]
 unariseArgs rho = concatMap (unariseArg rho)
 
@@ -201,3 +212,6 @@ unariseIdBinder us rho x = case repType (idType x) of
 unboxedTupleBindersFrom :: UniqSupply -> Id -> [UnaryType] -> [Id]
 unboxedTupleBindersFrom us x tys = zipWith (mkSysLocalOrCoVar fs) (uniqsFromSupply us) tys
   where fs = occNameFS (getOccName x)
+
+concatMapVarSet :: (Var -> [Var]) -> VarSet -> VarSet
+concatMapVarSet f xs = mkVarSet [x' | x <- varSetElems xs, x' <- f x]