Remove "use mask" from StgAlt syntax
authorÖmer Sinan Ağacan <omeragacan@gmail.com>
Wed, 24 Feb 2016 21:22:36 +0000 (16:22 -0500)
committerÖmer Sinan Ağacan <omeragacan@gmail.com>
Wed, 24 Feb 2016 21:41:55 +0000 (16:41 -0500)
Reviewers: austin, bgamari, simonpj

Reviewed By: simonpj

Subscribers: thomie

Differential Revision: https://phabricator.haskell.org/D1933

compiler/codeGen/StgCmmBind.hs
compiler/codeGen/StgCmmExpr.hs
compiler/profiling/SCCfinal.hs
compiler/simplStg/StgStats.hs
compiler/simplStg/UnariseStg.hs
compiler/stgSyn/CoreToStg.hs
compiler/stgSyn/StgLint.hs
compiler/stgSyn/StgSyn.hs

index ea05e8d..f34186a 100644 (file)
@@ -270,7 +270,7 @@ mkRhsClosure    dflags bndr _cc _bi
   , StgCase (StgApp scrutinee [{-no args-}])
          _   -- ignore bndr
          (AlgAlt _)
-         [(DataAlt _, params, _use_mask, sel_expr)] <- strip expr
+         [(DataAlt _, params, sel_expr)] <- strip expr
   , StgApp selectee [{-no args-}] <- strip sel_expr
   , the_fv == scrutinee                -- Scrutinee is the only free variable
 
index 0f3898b..86b3aec 100644 (file)
@@ -375,7 +375,7 @@ calls to nonVoidIds in various places.  So we must not look up
 
 cgCase (StgApp v []) _ (PrimAlt _) alts
   | isVoidRep (idPrimRep v)  -- See Note [Scrutinising VoidRep]
-  , [(DEFAULT, _, _, rhs)] <- alts
+  , [(DEFAULT, _, rhs)] <- alts
   = cgExpr rhs
 
 {- Note [Dodgy unsafeCoerce 1]
@@ -529,7 +529,7 @@ chooseReturnBndrs :: Id -> AltType -> [StgAlt] -> [NonVoid Id]
 chooseReturnBndrs bndr (PrimAlt _) _alts
   = nonVoidIds [bndr]
 
-chooseReturnBndrs _bndr (UbxTupAlt _) [(_, ids, _, _)]
+chooseReturnBndrs _bndr (UbxTupAlt _) [(_, ids, _)]
   = nonVoidIds ids      -- 'bndr' is not assigned!
 
 chooseReturnBndrs bndr (AlgAlt _) _alts
@@ -545,10 +545,10 @@ chooseReturnBndrs _ _ _ = panic "chooseReturnBndrs"
 cgAlts :: (GcPlan,ReturnKind) -> NonVoid Id -> AltType -> [StgAlt]
        -> FCode ReturnKind
 -- At this point the result of the case are in the binders
-cgAlts gc_plan _bndr PolyAlt [(_, _, _, rhs)]
+cgAlts gc_plan _bndr PolyAlt [(_, _, rhs)]
   = maybeAltHeapCheck gc_plan (cgExpr rhs)
 
-cgAlts gc_plan _bndr (UbxTupAlt _) [(_, _, _, rhs)]
+cgAlts gc_plan _bndr (UbxTupAlt _) [(_, _, rhs)]
   = maybeAltHeapCheck gc_plan (cgExpr rhs)
         -- Here bndrs are *already* in scope, so don't rebind them
 
@@ -645,7 +645,7 @@ cgAltRhss gc_plan bndr alts = do
   let
     base_reg = idToReg dflags bndr
     cg_alt :: StgAlt -> FCode (AltCon, CmmAGraphScoped)
-    cg_alt (con, bndrs, _uses, rhs)
+    cg_alt (con, bndrs, rhs)
       = getCodeScoped             $
         maybeAltHeapCheck gc_plan $
         do { _ <- bindConArgs con base_reg bndrs
index 6bd00b0..2b2e329 100644 (file)
@@ -160,9 +160,9 @@ stgMassageForProfiling dflags mod_name _us stg_binds
         alts' <- mapM do_alt alts
         return (StgCase expr' bndr alt_type alts')
       where
-        do_alt (id, bs, use_mask, e) = do
+        do_alt (id, bs, e) = do
             e' <- do_expr e
-            return (id, bs, use_mask, e')
+            return (id, bs, e')
 
     do_expr (StgLet b e) = do
           (b,e) <- do_let b e
index 5860f61..2c72266 100644 (file)
@@ -168,6 +168,6 @@ statExpr (StgCase expr _ _ alts)
     countOne StgCases
   where
     stat_alts alts
-        = combineSEs (map statExpr [ e | (_,_,_,e) <- alts ])
+        = combineSEs (map statExpr [ e | (_,_,e) <- alts ])
 
 statExpr (StgLam {}) = panic "statExpr StgLam"
index 705fce0..c2d73a5 100644 (file)
@@ -131,16 +131,15 @@ unariseExpr us rho (StgTick tick 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)]
+unariseAlts us rho (UbxTupAlt n) bndr [(DEFAULT, [], e)]
+  = [(DataAlt (tupleDataCon Unboxed n), ys, unariseExpr us2' rho' e)]
   where
     (us2', rho', ys) = unariseIdBinder us rho bndr
-    uses = replicate (length ys) (not (isDeadBinder bndr))
 
-unariseAlts us rho (UbxTupAlt n) bndr [(DataAlt _, ys, uses, e)]
-  = [(DataAlt (tupleDataCon Unboxed n), ys', uses', unariseExpr us2' rho'' e)]
+unariseAlts us rho (UbxTupAlt n) bndr [(DataAlt _, ys, e)]
+  = [(DataAlt (tupleDataCon Unboxed n), ys', unariseExpr us2' rho'' e)]
   where
-    (us2', rho', ys', uses') = unariseUsedIdBinders us rho ys uses
+    (us2', rho', ys') = unariseIdBinders us rho ys
     rho'' = extendVarEnv rho' bndr ys'
 
 unariseAlts _ _ (UbxTupAlt _) _ alts
@@ -151,10 +150,10 @@ unariseAlts us rho _ _ alts
 
 --------------------------
 unariseAlt :: UniqSupply -> UnariseEnv -> StgAlt -> StgAlt
-unariseAlt us rho (con, xs, uses, e)
-  = (con, xs', uses', unariseExpr us' rho' e)
+unariseAlt us rho (con, xs, e)
+  = (con, xs', unariseExpr us' rho' e)
   where
-    (us', rho', xs', uses') = unariseUsedIdBinders us rho xs uses
+    (us', rho', xs') = unariseIdBinders us rho xs
 
 ------------------------
 unariseArgs :: UnariseEnv -> [StgArg] -> [StgArg]
@@ -179,14 +178,6 @@ unariseId rho x
            , text "unariseId: was unboxed tuple" <+> ppr x )
     [x]
 
-unariseUsedIdBinders :: UniqSupply -> UnariseEnv -> [Id] -> [Bool]
-                     -> (UniqSupply, UnariseEnv, [Id], [Bool])
-unariseUsedIdBinders us rho xs uses
-  = case mapAccumL2 do_one us rho (zipEqual "unariseUsedIdBinders" xs uses) of
-      (us', rho', xs_usess) -> uncurry ((,,,) us' rho') (unzip (concat xs_usess))
-  where
-    do_one us rho (x, use) = third3 (map (flip (,) use)) (unariseIdBinder us rho x)
-
 unariseIdBinders :: UniqSupply -> UnariseEnv -> [Id] -> (UniqSupply, UnariseEnv, [Id])
 unariseIdBinders us rho xs = third3 concat $ mapAccumL2 unariseIdBinder us rho xs
 
index 414571c..c275f4d 100644 (file)
@@ -413,18 +413,14 @@ coreToStgExpr (Case scrut bndr _ alts) = do
         -- where a nullary tuple is mapped to (State# World#)
         ASSERT( null binders )
         do { (rhs2, rhs_fvs, rhs_escs) <- coreToStgExpr rhs
-           ; return ((DEFAULT, [], [], rhs2), rhs_fvs, rhs_escs) }
+           ; return ((DEFAULT, [], rhs2), rhs_fvs, rhs_escs) }
       | otherwise
       = let     -- Remove type variables
             binders' = filterStgBinders binders
         in
         extendVarEnvLne [(b, LambdaBound) | b <- binders'] $ do
         (rhs2, rhs_fvs, rhs_escs) <- coreToStgExpr rhs
-        let
-                -- Records whether each param is used in the RHS
-            good_use_mask = [ b `elementOfFVInfo` rhs_fvs | b <- binders' ]
-
-        return ( (con, binders', good_use_mask, rhs2),
+        return ( (con, binders', rhs2),
                  binders' `minusFVBinders` rhs_fvs,
                  rhs_escs `delVarSetList` binders' )
                 -- ToDo: remove the delVarSet;
index df3c4e5..dd206d9 100644 (file)
@@ -223,15 +223,15 @@ lintStgAlts alts scrut_ty = do
           -- We can't check that the alternatives have the
           -- same type, because they don't, with unsafeCoerce#
 
-lintAlt :: Type -> (AltCon, [Id], [Bool], StgExpr) -> LintM (Maybe Type)
-lintAlt _ (DEFAULT, _, _, rhs)
+lintAlt :: Type -> (AltCon, [Id], StgExpr) -> LintM (Maybe Type)
+lintAlt _ (DEFAULT, _, rhs)
  = lintStgExpr rhs
 
-lintAlt scrut_ty (LitAlt lit, _, _, rhs) = do
+lintAlt scrut_ty (LitAlt lit, _, rhs) = do
    checkTys (literalType lit) scrut_ty (mkAltMsg1 scrut_ty)
    lintStgExpr rhs
 
-lintAlt scrut_ty (DataAlt con, args, _, rhs) = do
+lintAlt scrut_ty (DataAlt con, args, rhs) = do
     case splitTyConApp_maybe scrut_ty of
       Just (tycon, tys_applied) | isAlgTyCon tycon &&
                                   not (isNewTyCon tycon) -> do
index 1fc8412..4145d9e 100644 (file)
@@ -469,7 +469,7 @@ rhsHasCafRefs (StgRhsCon _ _ args)
   = any stgArgHasCafRefs args
 
 altHasCafRefs :: GenStgAlt bndr Id -> Bool
-altHasCafRefs (_, _, _, rhs) = exprHasCafRefs rhs
+altHasCafRefs (_, _, rhs) = exprHasCafRefs rhs
 
 stgArgHasCafRefs :: GenStgArg Id -> Bool
 stgArgHasCafRefs (StgVarArg id)
@@ -533,10 +533,6 @@ rather than from the scrutinee type.
 type GenStgAlt bndr occ
   = (AltCon,            -- alts: data constructor,
      [bndr],            -- constructor's parameters,
-     [Bool],            -- "use mask", same length as
-                        -- parameters; a True in a
-                        -- param's position if it is
-                        -- used in the ...
      GenStgExpr bndr occ)       -- ...right-hand side.
 
 data AltType
@@ -743,7 +739,7 @@ pprStgExpr (StgCase expr bndr alt_type alts)
 
 pprStgAlt :: (OutputableBndr bndr, Outputable occ, Ord occ)
           => GenStgAlt bndr occ -> SDoc
-pprStgAlt (con, params, _use_mask, expr)
+pprStgAlt (con, params, expr)
   = hang (hsep [ppr con, sep (map (pprBndr CaseBind) params), text "->"])
          4 (ppr expr <> semi)