diff options
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 |
commit | 4f9967aa3d1f7cfd539d0c173cafac0fe290e26f (patch) | |
tree | 804e9f55f2eecd955bc55b6bffb39ed41429483f /compiler/simplStg | |
parent | bbc0ec5733df434878b02f7556a1cc947718a8b1 (diff) | |
download | haskell-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.hs | 6 | ||||
-rw-r--r-- | compiler/simplStg/UnariseStg.hs | 26 |
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] |