Commit a9dc62ae authored by Ömer Sinan Ağacan's avatar Ömer Sinan Ağacan

Remove "use mask" from StgAlt syntax

Reviewers: austin, bgamari, simonpj

Reviewed By: simonpj

Subscribers: thomie

Differential Revision: https://phabricator.haskell.org/D1933
parent d8c64e86
......@@ -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
......
......@@ -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
......
......@@ -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
......
......@@ -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"
......@@ -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
......
......@@ -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;
......
......@@ -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
......
......@@ -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)
......
Markdown is supported
0%
or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment