Commit eae703aa authored by Simon Peyton Jones's avatar Simon Peyton Jones

Reduce magic for seqId

An upcoming commit means that the RULES for 'seq' get only
one value arg, not two.  This patch prepares for that by

- reducing the arity of seq's built-in rule, to take one value arg
- making 'seq' not inline on the LHS of RULES
- and removing the horrid un-inlining in DsBinds.decomposeRuleLhs
parent 369dd0c6
......@@ -1074,10 +1074,15 @@ nullAddrId = pcMiscPrelId nullAddrName addrPrimTy info
seqId :: Id -- See Note [seqId magic]
seqId = pcMiscPrelId seqName ty info
where
info = noCafIdInfo `setInlinePragInfo` alwaysInlinePragma
info = noCafIdInfo `setInlinePragInfo` inline_prag
`setUnfoldingInfo` mkCompulsoryUnfolding rhs
`setSpecInfo` mkSpecInfo [seq_cast_rule]
inline_prag = alwaysInlinePragma `setInlinePragmaActivation` ActiveAfter 0
-- Make 'seq' not inline-always, so that simpleOptExpr
-- (see CoreSubst.simple_app) won't inline 'seq' on the
-- LHS of rules. That way we can have rules for 'seq';
-- see Note [seqId magic]
ty = mkForAllTys [alphaTyVar,betaTyVar]
(mkFunTy alphaTy (mkFunTy betaTy betaTy))
......@@ -1087,17 +1092,18 @@ seqId = pcMiscPrelId seqName ty info
rhs = mkLams [alphaTyVar,betaTyVar,x,y] (Case (Var x) x betaTy [(DEFAULT, [], Var y)])
-- See Note [Built-in RULES for seq]
-- NB: ru_nargs = 3, not 4, to match the code in
-- Simplify.rebuildCase which tries to apply this rule
seq_cast_rule = BuiltinRule { ru_name = fsLit "seq of cast"
, ru_fn = seqName
, ru_nargs = 4
, ru_try = match_seq_of_cast
}
, ru_nargs = 3
, ru_try = match_seq_of_cast }
match_seq_of_cast :: RuleFun
-- See Note [Built-in RULES for seq]
match_seq_of_cast _ _ _ [Type _, Type res_ty, Cast scrut co, expr]
match_seq_of_cast _ _ _ [Type _, Type res_ty, Cast scrut co]
= Just (Var seqId `mkApps` [Type (pFst (coercionKind co)), Type res_ty,
scrut, expr])
scrut])
match_seq_of_cast _ _ _ _ = Nothing
------------------------------------------------
......@@ -1203,16 +1209,24 @@ transform to
Rather than attempt some general analysis to support this, I've added
enough support that you can do this using a rewrite rule:
RULE "f/seq" forall n. seq (f n) e = seq n e
RULE "f/seq" forall n. seq (f n) = seq n
You write that rule. When GHC sees a case expression that discards
its result, it mentally transforms it to a call to 'seq' and looks for
a RULE. (This is done in Simplify.rebuildCase.) As usual, the
correctness of the rule is up to you.
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.
VERY IMPORTANT: to make this work, we give the RULE an arity of 1, not 2.
If we wrote
RULE "f/seq" forall n e. seq (f n) e = seq n e
with rule arity 2, then two bad things would happen:
- The magical desugaring done in Note [seqId magic] item (c)
for saturated application of 'seq' would turn the LHS into
a case expression!
- The code in Simplify.rebuildCase would need to actually supply
the value argument, which turns out to be awkward.
Note [Built-in RULES for seq]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~
......
......@@ -954,6 +954,7 @@ simple_app subst (Lam b e) (a:as)
b2 = add_info subst' b b'
simple_app subst (Var v) as
| isCompulsoryUnfolding (idUnfolding v)
, isAlwaysActive (idInlineActivation v)
-- See Note [Unfold compulsory unfoldings in LHSs]
= simple_app subst (unfoldingTemplate (idUnfolding v)) as
simple_app subst (Tick t e) as
......@@ -1108,10 +1109,16 @@ to remain visible until Phase 1
Note [Unfold compulsory unfoldings in LHSs]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
When the user writes `map coerce = coerce` as a rule, the rule will only ever
match if we replace coerce by its unfolding on the LHS, because that is the
core that the rule matching engine will find. So do that for everything that
has a compulsory unfolding. Also see Note [Desugaring coerce as cast] in Desugar
When the user writes `RULES map coerce = coerce` as a rule, the rule
will only ever match if simpleOptExpr replaces coerce by its unfolding
on the LHS, because that is the core that the rule matching engine
will find. So do that for everything that has a compulsory
unfolding. Also see Note [Desugaring coerce as cast] in Desugar.
However, we don't want to inline 'seq', which happens to also have a
compulsory unfolding, so we only do this unfolding only for things
that are always-active. See Note [User-defined RULES for seq] in MkId.
************************************************************************
* *
......
......@@ -53,7 +53,6 @@ import MkId(proxyHashId)
import Class
import DataCon ( dataConTyCon )
import Name
import MkId ( seqId )
import IdInfo ( IdDetails(..) )
import Var
import VarSet
......@@ -602,11 +601,6 @@ decomposeRuleLhs orig_bndrs orig_lhs
| not (fn_id `elemVarSet` orig_bndr_set)
= Just (fn_id, args)
decompose (Case scrut bndr ty [(DEFAULT, _, body)]) args
| isDeadBinder bndr -- Note [Matching seqId]
, let args' = [Type (idType bndr), Type ty, scrut, body]
= Just (seqId, args' ++ args)
decompose _ _ = Nothing
bad_shape_msg = hang (ptext (sLit "RULE left-hand side too complicated to desugar"))
......
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