Commit ad923917 authored by rl@cse.unsw.edu.au's avatar rl@cse.unsw.edu.au

Add builtin rule to eliminate unnecessary casts in seq

The patch adds this rule:

  seq (x `cast` co) y = seq x y

This is subject to the usual treatment of seq rules. It also makes them
match more often: it will rewrite

  seq (f x `cast` co) y = seq (f x) y

and allow a seq rule for f to match.
parent c01e472e
......@@ -934,6 +934,7 @@ seqId :: Id -- See Note [seqId magic]
seqId = pcMiscPrelId seqName ty info
where
info = noCafIdInfo `setUnfoldingInfo` mkCompulsoryUnfolding rhs
`setSpecInfo` mkSpecInfo [seq_cast_rule]
ty = mkForAllTys [alphaTyVar,openBetaTyVar]
......@@ -941,6 +942,18 @@ seqId = pcMiscPrelId seqName ty info
[x,y] = mkTemplateLocals [alphaTy, openBetaTy]
rhs = mkLams [alphaTyVar,openBetaTyVar,x,y] (Case (Var x) x openBetaTy [(DEFAULT, [], Var y)])
seq_cast_rule = BuiltinRule { ru_name = fsLit "seq of cast"
, ru_fn = seqName
, ru_nargs = 4
, ru_try = match_seq_of_cast
}
match_seq_of_cast :: [CoreExpr] -> Maybe CoreExpr -- Note [RULES for seq]
match_seq_of_cast [Type _, Type res_ty, Cast scrut co, expr]
= Just (Var seqId `mkApps` [Type (fst (coercionKind co)), Type res_ty,
scrut, expr])
match_seq_of_cast _ = Nothing
------------------------------------------------
lazyId :: Id -- See Note [lazyId magic]
lazyId = pcMiscPrelId lazyIdName ty info
......@@ -986,6 +999,12 @@ To make this work, we need to be careful that the magical desugaring
done in Note [seqId magic] item (c) is *not* done on the LHS of a rule.
Or rather, we arrange to un-do it, in DsBinds.decomposeRuleLhs.
We also have the following builtin rule:
seq (x `cast` co) y = seq x y
This eliminates unnecessary casts and also allows other seq rules to
match more often.
Note [lazyId magic]
~~~~~~~~~~~~~~~~~~~
......
......@@ -1450,7 +1450,7 @@ rebuildCase env scrut case_bndr [(_, bndrs, rhs)] cont
rebuildCase env scrut case_bndr alts@[(_, bndrs, rhs)] cont
| all isDeadBinder (case_bndr : bndrs) -- So this is just 'seq'
= -- For this case, see Note [Rules for seq] in MkId
= -- For this case, see Note [RULES for seq] in MkId
do { let rhs' = substExpr env rhs
out_args = [Type (substTy env (idType case_bndr)),
Type (exprType rhs'), scrut, rhs']
......@@ -1540,7 +1540,10 @@ where x::F Int. Then we'd like to rewrite (F Int) to Int, getting
in rhs
so that 'rhs' can take advantage of the form of x'. Notice that Note
[Case of cast] may then apply to the result.
[Case of cast] may then apply to the result. We only do this if x is actually
used in the rhs. There is no point in adding the cast if this is really just a
seq and doing so would interfere with seq rules (Note [RULES for seq]), in
particular with the one that removes casts.
This showed up in Roman's experiments. Example:
foo :: F Int -> Int -> Int
......@@ -1564,8 +1567,9 @@ improveSeq :: (FamInstEnv, FamInstEnv) -> SimplEnv
-> SimplM (SimplEnv, OutExpr, OutId)
-- Note [Improving seq]
improveSeq fam_envs env scrut case_bndr case_bndr1 [(DEFAULT,_,_)]
| Just (co, ty2) <- topNormaliseType fam_envs (idType case_bndr1)
= do { case_bndr2 <- newId (fsLit "nt") ty2
| not (isDeadBinder case_bndr)
, Just (co, ty2) <- topNormaliseType fam_envs (idType case_bndr1)
= do { case_bndr2 <- newId (fsLit "nt") ty2
; let rhs = DoneEx (Var case_bndr2 `Cast` mkSymCoercion co)
env2 = extendIdSubst env case_bndr rhs
; return (env2, scrut `Cast` co, case_bndr2) }
......
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