Reduce magic for seqId
authorSimon Peyton Jones <simonpj@microsoft.com>
Fri, 22 May 2015 13:41:54 +0000 (14:41 +0100)
committerSimon Peyton Jones <simonpj@microsoft.com>
Fri, 22 May 2015 14:05:23 +0000 (15:05 +0100)
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

compiler/basicTypes/MkId.hs
compiler/coreSyn/CoreSubst.hs
compiler/deSugar/DsBinds.hs

index 365ed82..2e84d83 100644 (file)
@@ -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]
 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~
index 52f4c0d..a3665ed 100644 (file)
@@ -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.
+
 
 ************************************************************************
 *                                                                      *
index f67ffac..fac5eb7 100644 (file)
@@ -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"))