diff options
| author | Ömer Sinan Ağacan <omeragacan@gmail.com> | 2015-11-01 17:14:58 +0100 |
|---|---|---|
| committer | Ben Gamari <ben@smart-cactus.org> | 2015-11-01 17:15:34 +0100 |
| commit | e9bfb3fd4cb61621c28b51f0bf0e3d2c6f74e45f (patch) | |
| tree | 70df393df0cb50c012cc60e125dba7cc2533ed50 /compiler/simplStg | |
| parent | 52c6e3d608ee3d010337d4405df86c2620d24887 (diff) | |
| download | haskell-e9bfb3fd4cb61621c28b51f0bf0e3d2c6f74e45f.tar.gz | |
Minor simplification in unariser pass:
We don't need to update StgCase's AltType, because it's already set
correctly in `CoreToStg.mkStgAltType`, so we can just remove extra
argument passing and return values.
(I think this is a useful refactoring because it makes it clear that we
don't need to update AltTypes)
Reviewers: austin, bgamari, simonpj
Reviewed By: bgamari, simonpj
Subscribers: simonpj, thomie
Differential Revision: https://phabricator.haskell.org/D1403
Diffstat (limited to 'compiler/simplStg')
| -rw-r--r-- | compiler/simplStg/UnariseStg.hs | 24 |
1 files changed, 11 insertions, 13 deletions
diff --git a/compiler/simplStg/UnariseStg.hs b/compiler/simplStg/UnariseStg.hs index f3d592f49c..a1533bacc8 100644 --- a/compiler/simplStg/UnariseStg.hs +++ b/compiler/simplStg/UnariseStg.hs @@ -114,10 +114,10 @@ unariseExpr us rho (StgLam xs e) 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' + alt_ty alts' where (us1, us2) = splitUniqSupply us - (alt_ty', alts') = unariseAlts us2 rho alt_ty bndr (repType (idType bndr)) alts + alts' = unariseAlts us2 rho alt_ty bndr alts unariseExpr us rho (StgLet bind e) = StgLet (unariseBinding us1 rho bind) (unariseExpr us2 rho e) @@ -134,27 +134,25 @@ unariseExpr us rho (StgTick tick e) = StgTick tick (unariseExpr us rho e) ------------------------ -unariseAlts :: UniqSupply -> UnariseEnv -> AltType -> Id -> RepType -> [StgAlt] -> (AltType, [StgAlt]) -unariseAlts us rho alt_ty _ (UnaryRep _) alts - = (alt_ty, zipWith (\us alt -> unariseAlt us rho alt) (listSplitUniqSupply us) alts) - -unariseAlts us rho _ bndr (UbxTupleRep tys) ((DEFAULT, [], [], e) : _) - = (UbxTupAlt n, [(DataAlt (tupleDataCon Unboxed n), ys, uses, unariseExpr us2' rho' e)]) +unariseAlts :: UniqSupply -> UnariseEnv -> AltType -> Id -> [StgAlt] -> [StgAlt] +unariseAlts us rho (UbxTupAlt n) bndr [(DEFAULT, [], [], e)] + = [(DataAlt (tupleDataCon Unboxed n), ys, uses, unariseExpr us2' rho' e)] where (us2', rho', ys) = unariseIdBinder us rho bndr uses = replicate (length ys) (not (isDeadBinder bndr)) - n = length tys -unariseAlts us rho _ bndr (UbxTupleRep _) [(DataAlt _, ys, uses, e)] - = (UbxTupAlt n, [(DataAlt (tupleDataCon Unboxed n), ys', uses', unariseExpr us2' rho'' e)]) +unariseAlts us rho (UbxTupAlt n) bndr [(DataAlt _, ys, uses, e)] + = [(DataAlt (tupleDataCon Unboxed n), ys', uses', unariseExpr us2' rho'' e)] where (us2', rho', ys', uses') = unariseUsedIdBinders us rho ys uses rho'' = extendVarEnv rho' bndr ys' - n = length ys' -unariseAlts _ _ _ _ (UbxTupleRep _) alts +unariseAlts _ _ (UbxTupAlt _) _ alts = pprPanic "unariseExpr: strange unboxed tuple alts" (ppr alts) +unariseAlts us rho _ _ alts + = zipWith (\us alt -> unariseAlt us rho alt) (listSplitUniqSupply us) alts + -------------------------- unariseAlt :: UniqSupply -> UnariseEnv -> StgAlt -> StgAlt unariseAlt us rho (con, xs, uses, e) |