[commit: ghc] master: Minor simplification in unariser pass: (e9bfb3f)

git at git.haskell.org git at git.haskell.org
Sun Nov 1 16:51:23 UTC 2015


Repository : ssh://git@git.haskell.org/ghc

On branch  : master
Link       : http://ghc.haskell.org/trac/ghc/changeset/e9bfb3fd4cb61621c28b51f0bf0e3d2c6f74e45f/ghc

>---------------------------------------------------------------

commit e9bfb3fd4cb61621c28b51f0bf0e3d2c6f74e45f
Author: Ömer Sinan Ağacan <omeragacan at gmail.com>
Date:   Sun Nov 1 17:14:58 2015 +0100

    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


>---------------------------------------------------------------

e9bfb3fd4cb61621c28b51f0bf0e3d2c6f74e45f
 compiler/simplStg/UnariseStg.hs | 24 +++++++++++-------------
 1 file changed, 11 insertions(+), 13 deletions(-)

diff --git a/compiler/simplStg/UnariseStg.hs b/compiler/simplStg/UnariseStg.hs
index f3d592f..a1533ba 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)



More information about the ghc-commits mailing list