summaryrefslogtreecommitdiff
path: root/compiler/simplStg
diff options
context:
space:
mode:
authorÖmer Sinan Ağacan <omeragacan@gmail.com>2016-02-04 16:22:48 -0500
committerÖmer Sinan Ağacan <omeragacan@gmail.com>2016-02-04 16:24:09 -0500
commit4f9967aa3d1f7cfd539d0c173cafac0fe290e26f (patch)
tree804e9f55f2eecd955bc55b6bffb39ed41429483f /compiler/simplStg
parentbbc0ec5733df434878b02f7556a1cc947718a8b1 (diff)
downloadhaskell-4f9967aa3d1f7cfd539d0c173cafac0fe290e26f.tar.gz
Remove unused LiveVars and SRT fields of StgCase and StgLetNoEscape
Also remove the functions and types that became useless after removing the fields: - SRT functions - LiveInfo type and functions - freeVarsToLiveVars - unariseLives and unariseSRT Reviewers: bgamari, simonpj, austin Reviewed By: simonpj Subscribers: thomie Differential Revision: https://phabricator.haskell.org/D1880
Diffstat (limited to 'compiler/simplStg')
-rw-r--r--compiler/simplStg/StgStats.hs6
-rw-r--r--compiler/simplStg/UnariseStg.hs26
2 files changed, 9 insertions, 23 deletions
diff --git a/compiler/simplStg/StgStats.hs b/compiler/simplStg/StgStats.hs
index dd1f5a64d2..5860f61057 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 b16220134d..705fce01b3 100644
--- a/compiler/simplStg/UnariseStg.hs
+++ b/compiler/simplStg/UnariseStg.hs
@@ -42,7 +42,6 @@ import MkId (realWorldPrimId)
import Type
import TysWiredIn
import DataCon
-import VarSet
import OccName
import Name
import Util
@@ -74,9 +73,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 srt args expr
+ StgRhsClosure ccs b_info fvs update_flag args expr
-> StgRhsClosure ccs b_info (unariseIds rho fvs) update_flag
- (unariseSRT rho srt) args' (unariseExpr us' rho' expr)
+ args' (unariseExpr us' rho' expr)
where (us', rho', args') = unariseIdBinders us rho args
StgRhsCon ccs con args
-> StgRhsCon ccs con (unariseArgs rho args)
@@ -111,10 +110,8 @@ unariseExpr us rho (StgLam xs e)
where
(us', rho', xs') = unariseIdBinders us rho xs
-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'
+unariseExpr us rho (StgCase e bndr alt_ty alts)
+ = StgCase (unariseExpr us1 rho e) bndr alt_ty alts'
where
(us1, us2) = splitUniqSupply us
alts' = unariseAlts us2 rho alt_ty bndr alts
@@ -124,9 +121,8 @@ unariseExpr us rho (StgLet bind e)
where
(us1, us2) = splitUniqSupply us
-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)
+unariseExpr us rho (StgLetNoEscape bind e)
+ = StgLetNoEscape (unariseBinding us1 rho bind) (unariseExpr us2 rho e)
where
(us1, us2) = splitUniqSupply us
@@ -161,13 +157,6 @@ 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)
@@ -212,6 +201,3 @@ 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]