Inline data constructor wrappers in phase 2 only
authorSimon Peyton Jones <simonpj@microsoft.com>
Tue, 28 Feb 2017 19:04:40 +0000 (14:04 -0500)
committerDavid Feuer <David.Feuer@gmail.com>
Tue, 28 Feb 2017 19:04:41 +0000 (14:04 -0500)
This patch prepares for my upcoming early-inlining patch. It arranges
that data constructor wrappers are not inlined until Phase 2 (the
first of the "normal" phases.)  That gives rules a chance to fire
in the InitialPhase (aka "gentle").

This has been a bit of a problem for a while, so it's nice to have
a fix.  It should make no difference immediately, becuase currently
nothing is inlined in the InitialPhase anyway.

Reviewers: austin, bgamari

Subscribers: thomie

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

compiler/basicTypes/MkId.hs
testsuite/tests/deSugar/should_compile/T2431.stderr
testsuite/tests/simplCore/should_compile/T7360.stderr

index b542f32..890a4bf 100644 (file)
@@ -518,7 +518,7 @@ mkDataConRep dflags fam_envs wrap_name mb_bangs data_con
                          `setArityInfo`         wrap_arity
                              -- It's important to specify the arity, so that partial
                              -- applications are treated as values
-                         `setInlinePragInfo`    alwaysInlinePragma
+                         `setInlinePragInfo`    wrap_prag
                          `setUnfoldingInfo`     wrap_unf
                          `setStrictnessInfo`    wrap_sig
                              -- We need to get the CAF info right here because TidyPgm
@@ -527,10 +527,15 @@ mkDataConRep dflags fam_envs wrap_name mb_bangs data_con
                          `setNeverLevPoly`      wrap_ty
 
              wrap_sig = mkClosedStrictSig wrap_arg_dmds (dataConCPR data_con)
+
              wrap_arg_dmds = map mk_dmd arg_ibangs
              mk_dmd str | isBanged str = evalDmd
                         | otherwise           = topDmd
 
+             wrap_prag = alwaysInlinePragma `setInlinePragmaActivation`
+                         ActiveAfter NoSourceText 2
+                         -- See Note [Activation for data constructor wrappers]
+
              -- The wrapper will usually be inlined (see wrap_unf), so its
              -- strictness and CPR info is usually irrelevant. But this is
              -- not always the case; GHC may choose not to inline it. In
@@ -620,7 +625,20 @@ mkDataConRep dflags fam_envs wrap_name mb_bangs data_con
            ; expr <- mk_rep_app prs (mkVarApps con_app rep_ids)
            ; return (unbox_fn expr) }
 
-{-
+{- Note [Activation for data constructor wrappers]
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+The Activation on a data constructor wrapper allows it to inline in
+Phase 2 and later (1, 0).  But not in the InitialPhase.  That gives
+rewrite rules a chance to fire (in the InitialPhase) if they mention
+a data constructor on the left
+   RULE "foo"  f (K a b) = ...
+Since the LHS of rules are simplified with InitialPhase, we won't
+inline the wrapper on the LHS either.
+
+People have asked for this before, but now that even the InitialPhase
+does some inlining, it has become important.
+
+
 Note [Bangs on imported data constructors]
 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
 
index d601d5d..722a5e4 100644 (file)
@@ -4,7 +4,7 @@ Result size of Tidy Core
   = {terms: 83, types: 49, coercions: 1, joins: 0/0}
 
 -- RHS size: {terms: 2, types: 4, coercions: 1, joins: 0/0}
-T2431.$WRefl [InlPrag=INLINE] :: forall a. a :~: a
+T2431.$WRefl [InlPrag=INLINE[2]] :: forall a. a :~: a
 [GblId[DataConWrapper],
  Caf=NoCafRefs,
  Str=m,
@@ -13,9 +13,9 @@ T2431.$WRefl [InlPrag=INLINE] :: forall a. a :~: a
          Guidance=ALWAYS_IF(arity=0,unsat_ok=True,boring_ok=False)
          Tmpl= \ (@ a) ->
                  T2431.Refl @ a @ a @~ (<a>_N :: (a :: *) GHC.Prim.~# (a :: *))}]
-T2431.$WRefl =
-  \ (@ a) ->
-    T2431.Refl @ a @ a @~ (<a>_N :: (a :: *) GHC.Prim.~# (a :: *))
+T2431.$WRefl
+  \ (@ a) ->
+      T2431.Refl @ a @ a @~ (<a>_N :: (a :: *) GHC.Prim.~# (a :: *))
 
 -- RHS size: {terms: 4, types: 8, coercions: 0, joins: 0/0}
 absurd :: forall a. (Int :~: Bool) -> a
@@ -85,14 +85,14 @@ $tc:~:2 = GHC.Types.TrNameS $tc:~:1
 -- RHS size: {terms: 7, types: 0, coercions: 0, joins: 0/0}
 T2431.$tc:~: :: GHC.Types.TyCon
 [GblId, Caf=NoCafRefs]
-T2431.$tc:~: =
-  GHC.Types.TyCon
-    4608886815921030019##
-    6030312177285011233##
-    T2431.$trModule
-    $tc:~:2
-    0#
-    krep4
+T2431.$tc:~:
+  GHC.Types.TyCon
+      4608886815921030019##
+      6030312177285011233##
+      T2431.$trModule
+      $tc:~:2
+      0#
+      krep4
 
 -- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0}
 krep5 :: GHC.Types.KindRep
@@ -107,9 +107,9 @@ krep6 = GHC.Types.KindRepVar 0#
 -- RHS size: {terms: 3, types: 2, coercions: 0, joins: 0/0}
 krep7 :: [GHC.Types.KindRep]
 [GblId, Caf=NoCafRefs]
-krep7 =
-  GHC.Types.:
-    @ GHC.Types.KindRep krep6 (GHC.Types.[] @ GHC.Types.KindRep)
+krep7
+  GHC.Types.:
+      @ GHC.Types.KindRep krep6 (GHC.Types.[] @ GHC.Types.KindRep)
 
 -- RHS size: {terms: 3, types: 1, coercions: 0, joins: 0/0}
 krep8 :: [GHC.Types.KindRep]
@@ -134,14 +134,14 @@ $tc'Refl2 = GHC.Types.TrNameS $tc'Refl1
 -- RHS size: {terms: 7, types: 0, coercions: 0, joins: 0/0}
 T2431.$tc'Refl :: GHC.Types.TyCon
 [GblId, Caf=NoCafRefs]
-T2431.$tc'Refl =
-  GHC.Types.TyCon
-    2478588351447975921##
-    2684375695874497811##
-    T2431.$trModule
-    $tc'Refl2
-    1#
-    krep9
+T2431.$tc'Refl
+  GHC.Types.TyCon
+      2478588351447975921##
+      2684375695874497811##
+      T2431.$trModule
+      $tc'Refl2
+      1#
+      krep9
 
 
 
index bf2c6df..260cbd2 100644 (file)
@@ -4,7 +4,7 @@ Result size of Tidy Core
   = {terms: 125, types: 58, coercions: 0, joins: 0/0}
 
 -- RHS size: {terms: 6, types: 3, coercions: 0, joins: 0/0}
-T7360.$WFoo3 [InlPrag=INLINE] :: Int -> Foo
+T7360.$WFoo3 [InlPrag=INLINE[2]] :: Int -> Foo
 [GblId[DataConWrapper],
  Arity=1,
  Caf=NoCafRefs,
@@ -14,9 +14,9 @@ T7360.$WFoo3 [InlPrag=INLINE] :: Int -> Foo
          Guidance=ALWAYS_IF(arity=1,unsat_ok=True,boring_ok=False)
          Tmpl= \ (dt [Occ=Once!] :: Int) ->
                  case dt of { GHC.Types.I# dt [Occ=Once] -> T7360.Foo3 dt }}]
-T7360.$WFoo3 =
-  \ (dt [Occ=Once!] :: Int) ->
-    case dt of { GHC.Types.I# dt [Occ=Once] -> T7360.Foo3 dt }
+T7360.$WFoo3
+  \ (dt [Occ=Once!] :: Int) ->
+      case dt of { GHC.Types.I# dt [Occ=Once] -> T7360.Foo3 dt }
 
 -- RHS size: {terms: 5, types: 2, coercions: 0, joins: 0/0}
 fun1 [InlPrag=NOINLINE] :: Foo -> ()
@@ -64,16 +64,16 @@ fun2 :: forall a. [a] -> ((), Int)
                       GHC.Types.I# ww2
                       }
                   })}]
-fun2 =
-  \ (@ a) (x :: [a]) ->
-    (T7360.fun5,
-     case x of wild {
-       [] -> T7360.fun4;
-       : ds ds1 ->
-         case GHC.List.$wlenAcc @ a wild 0# of ww2 { __DEFAULT ->
-         GHC.Types.I# ww2
-         }
-     })
+fun2
+  \ (@ a) (x :: [a]) ->
+      (T7360.fun5,
+       case x of wild {
+         [] -> T7360.fun4;
+         : ds ds1 ->
+           case GHC.List.$wlenAcc @ a wild 0# of ww2 { __DEFAULT ->
+           GHC.Types.I# ww2
+           }
+       })
 
 -- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0}
 T7360.$trModule4 :: GHC.Prim.Addr#
@@ -116,8 +116,8 @@ T7360.$trModule :: GHC.Types.Module
  Str=m,
  Unf=Unf{Src=<vanilla>, TopLvl=True, Value=True, ConLike=True,
          WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 30}]
-T7360.$trModule =
-  GHC.Types.Module T7360.$trModule3 T7360.$trModule1
+T7360.$trModule
+  GHC.Types.Module T7360.$trModule3 T7360.$trModule1
 
 -- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0}
 T7360.$tcFoo1 [InlPrag=[~]] :: GHC.Types.KindRep
@@ -148,21 +148,21 @@ T7360.$tcFoo :: GHC.Types.TyCon
  Str=m,
  Unf=Unf{Src=<vanilla>, TopLvl=True, Value=True, ConLike=True,
          WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 70}]
-T7360.$tcFoo =
-  GHC.Types.TyCon
-    1581370841583180512##
-    13291578023368289311##
-    T7360.$trModule
-    T7360.$tcFoo2
-    0#
-    T7360.$tcFoo1
+T7360.$tcFoo
+  GHC.Types.TyCon
+      1581370841583180512##
+      13291578023368289311##
+      T7360.$trModule
+      T7360.$tcFoo2
+      0#
+      T7360.$tcFoo1
 
 -- RHS size: {terms: 3, types: 1, coercions: 0, joins: 0/0}
 T7360.$tc'Foo4 [InlPrag=[~]] :: GHC.Types.KindRep
 [GblId, Caf=NoCafRefs, Str=m1]
-T7360.$tc'Foo4 =
-  GHC.Types.KindRepTyConApp
-    T7360.$tcFoo (GHC.Types.[] @ GHC.Types.KindRep)
+T7360.$tc'Foo4
+  GHC.Types.KindRepTyConApp
+      T7360.$tcFoo (GHC.Types.[] @ GHC.Types.KindRep)
 
 -- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0}
 T7360.$tc'Foo6 :: GHC.Prim.Addr#
@@ -188,21 +188,21 @@ T7360.$tc'Foo1 :: GHC.Types.TyCon
  Str=m,
  Unf=Unf{Src=<vanilla>, TopLvl=True, Value=True, ConLike=True,
          WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 70}]
-T7360.$tc'Foo1 =
-  GHC.Types.TyCon
-    3986951253261644518##
-    2515097940992351150##
-    T7360.$trModule
-    T7360.$tc'Foo5
-    0#
-    T7360.$tc'Foo4
+T7360.$tc'Foo1
+  GHC.Types.TyCon
+      3986951253261644518##
+      2515097940992351150##
+      T7360.$trModule
+      T7360.$tc'Foo5
+      0#
+      T7360.$tc'Foo4
 
 -- RHS size: {terms: 3, types: 1, coercions: 0, joins: 0/0}
 T7360.$tc'Foo7 [InlPrag=[~]] :: GHC.Types.KindRep
 [GblId, Caf=NoCafRefs, Str=m1]
-T7360.$tc'Foo7 =
-  GHC.Types.KindRepTyConApp
-    T7360.$tcFoo (GHC.Types.[] @ GHC.Types.KindRep)
+T7360.$tc'Foo7
+  GHC.Types.KindRepTyConApp
+      T7360.$tcFoo (GHC.Types.[] @ GHC.Types.KindRep)
 
 -- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0}
 T7360.$tc'Foo9 :: GHC.Prim.Addr#
@@ -228,28 +228,28 @@ T7360.$tc'Foo2 :: GHC.Types.TyCon
  Str=m,
  Unf=Unf{Src=<vanilla>, TopLvl=True, Value=True, ConLike=True,
          WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 70}]
-T7360.$tc'Foo2 =
-  GHC.Types.TyCon
-    17325079864060690428##
-    2969742457748208427##
-    T7360.$trModule
-    T7360.$tc'Foo8
-    0#
-    T7360.$tc'Foo7
+T7360.$tc'Foo2
+  GHC.Types.TyCon
+      17325079864060690428##
+      2969742457748208427##
+      T7360.$trModule
+      T7360.$tc'Foo8
+      0#
+      T7360.$tc'Foo7
 
 -- RHS size: {terms: 3, types: 1, coercions: 0, joins: 0/0}
 krep :: GHC.Types.KindRep
 [GblId, Str=m1]
-krep =
-  GHC.Types.KindRepTyConApp
-    GHC.Types.$tcInt (GHC.Types.[] @ GHC.Types.KindRep)
+krep
+  GHC.Types.KindRepTyConApp
+      GHC.Types.$tcInt (GHC.Types.[] @ GHC.Types.KindRep)
 
 -- RHS size: {terms: 3, types: 1, coercions: 0, joins: 0/0}
 krep1 :: GHC.Types.KindRep
 [GblId, Caf=NoCafRefs, Str=m1]
-krep1 =
-  GHC.Types.KindRepTyConApp
-    T7360.$tcFoo (GHC.Types.[] @ GHC.Types.KindRep)
+krep1
+  GHC.Types.KindRepTyConApp
+      T7360.$tcFoo (GHC.Types.[] @ GHC.Types.KindRep)
 
 -- RHS size: {terms: 3, types: 0, coercions: 0, joins: 0/0}
 T7360.$tc'Foo10 [InlPrag=[~]] :: GHC.Types.KindRep
@@ -279,14 +279,14 @@ T7360.$tc'Foo3 :: GHC.Types.TyCon
  Str=m,
  Unf=Unf{Src=<vanilla>, TopLvl=True, Value=True, ConLike=True,
          WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 70}]
-T7360.$tc'Foo3 =
-  GHC.Types.TyCon
-    3674231676522181654##
-    2694749919371021431##
-    T7360.$trModule
-    T7360.$tc'Foo11
-    0#
-    T7360.$tc'Foo10
+T7360.$tc'Foo3
+  GHC.Types.TyCon
+      3674231676522181654##
+      2694749919371021431##
+      T7360.$trModule
+      T7360.$tc'Foo11
+      0#
+      T7360.$tc'Foo10