Add a final demand analyzer run right before TidyCore

in order to have precise used-once information in the exported
strictness signatures, as well as precise used-once information on
thunks. This avoids the bad effects of #11731.

The subsequent worker-wrapper pass is responsible for removing the
demand environment part of the strictness signature. It does not run
after the final demand analyzer pass, so remove this also in CoreTidy.

The subsequent worker-wrapper pass is also responsible for removing
used-once-information from the demands and strictness signatures, as
these might not be preserved by the simplifier. This is _not_ done by
CoreTidy, because we _do_ want this information, as produced by the last
round of the demand analyzer, to be available to the code generator.

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

12 files changed, 143 insertions, 17 deletions

diff --git a/testsuite/tests/perf/compiler/all.T b/testsuite/tests/perf/compiler/all.T
index 022ed92142..46d6478f75 100644
--- a/testsuite/tests/perf/compiler/all.T
+++ b/testsuite/tests/perf/compiler/all.T
@@ -639,7 +639,7 @@ test('T9020',
 test('T9675',
      [ only_ways(['optasm']),
        compiler_stats_num_field('max_bytes_used', # Note [residency]
-          [(wordsize(64), 30837312, 15),
+          [(wordsize(64), 38776008, 15),
           # 2014-10-13    29596552
           # 2014-10-13    26570896   seq the DmdEnv in seqDmdType as well
           # 2014-10-13    18582472   different machines giving different results..
@@ -647,12 +647,13 @@ test('T9675',
           # 2015-06-21    28056344   switch to `+RTS -G1`, tighten bound to 15%
           # 2015-10-28    23776640   emit Typeable at definition site
           # 2015-12-11    30837312   TypeInType (see #11196)
+          # 2016-04-14    38776008   Final demand analyzer run
            (wordsize(32), 18043224, 15)
           # 2015-07-11    15341228   (x86/Linux, 64-bit machine) use +RTS -G1
           # 2016-04-06    18043224   (x86/Linux, 64-bit machine)
           ]),
        compiler_stats_num_field('peak_megabytes_allocated', # Note [residency]
-          [(wordsize(64), 113, 15),
+          [(wordsize(64), 144, 15),
           # 2014-10-13    66
           # 2014-10-13    58         seq the DmdEnv in seqDmdType as well
           # 2014-10-13    49         different machines giving different results...
@@ -661,6 +662,7 @@ test('T9675',
           # 2015-06-21    105        switch to `+RTS -G1`
           # 2015-12-04    88         new pattern checker (D1535)
           # 2015-12-11    113        TypeInType (see #11196)
+          # 2016-04-14    144        Final demand analyzer run
             (wordsize(32), 56, 15)
           # 2015-07-11    56         (x86/Linux, 64-bit machine) use +RTS -G1
           ]),
@@ -771,10 +773,11 @@ test('T9961',
 test('T9233',
     [ only_ways(['normal']),
       compiler_stats_num_field('bytes allocated',
-        [(wordsize(64), 999826288, 5),
-         # 2015-08-04   999826288     initial value
-         (wordsize(32), 515672240, 5)   # Put in your value here if you hit this
-         # 2016-04-06   515672240     (x86/Linux) initial value
+        [(wordsize(64), 1066246248, 5),
+         # 2015-08-04    999826288     initial value
+         # 2016-04-14   1066246248     Final demand analyzer run
+         (wordsize(32),  515672240, 5)   # Put in your value here if you hit this
+         # 2016-04-06    515672240     (x86/Linux) initial value
         ]),
       extra_clean(['T9233a.hi', 'T9233a.o'])
     ],
@@ -784,17 +787,19 @@ test('T9233',
 test('T10370',
      [ only_ways(['optasm']),
        compiler_stats_num_field('max_bytes_used', # Note [residency]
-          [(wordsize(64), 22823976, 15),
+          [(wordsize(64), 28256896, 15),
           # 2015-10-22    19548720
           # 2016-02-24    22823976   Changing Levity to RuntimeRep; not sure why this regresses though, even after some analysis
+          # 2016-04-14    28256896   final demand analyzer run
            (wordsize(32), 11371496, 15),
           # 2015-10-22    11371496
           ]),
        compiler_stats_num_field('peak_megabytes_allocated', # Note [residency]
-          [(wordsize(64), 76, 15),
-          # 2015-10-22    76
-           (wordsize(32), 39, 15),
-          # 2015-10-22    39
+          [(wordsize(64), 101, 15),
+          # 2015-10-22     76
+          # 2016-04-14    101 final demand analyzer run
+           (wordsize(32),  39, 15),
+          # 2015-10-22     39
           ]),
        # Use `+RTS -G1` for more stable residency measurements. Note [residency].
        extra_hc_opts('+RTS -G1 -RTS')
diff --git a/testsuite/tests/simplCore/should_compile/T4908.stderr b/testsuite/tests/simplCore/should_compile/T4908.stderr
index 947d16a206..7136bd1f51 100644
--- a/testsuite/tests/simplCore/should_compile/T4908.stderr
+++ b/testsuite/tests/simplCore/should_compile/T4908.stderr
@@ -33,7 +33,7 @@ T4908.$trModule =
 Rec {
 -- RHS size: {terms: 19, types: 5, coercions: 0}
 T4908.f_$s$wf [Occ=LoopBreaker] :: Int -> Int# -> Int# -> Bool
-[GblId, Arity=3, Caf=NoCafRefs, Str=<L,A><L,U><S,1*U>]
+[GblId, Arity=3, Caf=NoCafRefs, Str=<L,A><L,1*U><S,1*U>]
 T4908.f_$s$wf =
   \ (sc :: Int) (sc1 :: Int#) (sc2 :: Int#) ->
     case sc2 of ds {
@@ -51,7 +51,7 @@ T4908.$wf [InlPrag=[0]] :: Int# -> (Int, Int) -> Bool
 [GblId,
  Arity=2,
  Caf=NoCafRefs,
- Str=<S,1*U><L,1*U(A,U(U))>,
+ Str=<S,1*U><L,1*U(A,1*U(1*U))>,
  Unf=Unf{Src=<vanilla>, TopLvl=True, Value=True, ConLike=True,
          WorkFree=True, Expandable=True, Guidance=IF_ARGS [30 20] 101 20}]
 T4908.$wf =
@@ -74,7 +74,7 @@ f [InlPrag=INLINE[0]] :: Int -> (Int, Int) -> Bool
 [GblId,
  Arity=2,
  Caf=NoCafRefs,
- Str=<S(S),1*U(1*U)><L,1*U(A,U(U))>,
+ Str=<S(S),1*U(1*U)><L,1*U(A,1*U(1*U))>,
  Unf=Unf{Src=InlineStable, TopLvl=True, Value=True, ConLike=True,
          WorkFree=True, Expandable=True,
          Guidance=ALWAYS_IF(arity=2,unsat_ok=True,boring_ok=False)
diff --git a/testsuite/tests/simplCore/should_compile/spec-inline.stderr b/testsuite/tests/simplCore/should_compile/spec-inline.stderr
index 441b4ed391..64bf015a26 100644
--- a/testsuite/tests/simplCore/should_compile/spec-inline.stderr
+++ b/testsuite/tests/simplCore/should_compile/spec-inline.stderr
@@ -43,7 +43,7 @@ Rec {
 -- RHS size: {terms: 55, types: 9, coercions: 0}
 Roman.foo_$s$wgo [Occ=LoopBreaker]
   :: GHC.Prim.Int# -> GHC.Prim.Int# -> GHC.Prim.Int#
-[GblId, Arity=2, Caf=NoCafRefs, Str=<L,U><L,U>]
+[GblId, Arity=2, Caf=NoCafRefs, Str=<L,U><S,U>]
 Roman.foo_$s$wgo =
   \ (sc :: GHC.Prim.Int#) (sc1 :: GHC.Prim.Int#) ->
     let {
@@ -151,7 +151,7 @@ foo :: Int -> Int
 [GblId,
  Arity=1,
  Caf=NoCafRefs,
- Str=<S,1*U(U)>m,
+ Str=<S(S),1*U(U)>m,
  Unf=Unf{Src=InlineStable, TopLvl=True, Value=True, ConLike=True,
          WorkFree=True, Expandable=True,
          Guidance=ALWAYS_IF(arity=1,unsat_ok=True,boring_ok=False)
diff --git a/testsuite/tests/simplCore/should_run/all.T b/testsuite/tests/simplCore/should_run/all.T
index 042c0974d9..7fd181296b 100644
--- a/testsuite/tests/simplCore/should_run/all.T
+++ b/testsuite/tests/simplCore/should_run/all.T
@@ -71,4 +71,4 @@ test('T9128', normal, compile_and_run, [''])
 test('T9390', normal, compile_and_run, [''])
 test('T10830', extra_run_opts('+RTS -K100k -RTS'), compile_and_run, [''])
 test('T11172', normal, compile_and_run, [''])
-test('T11731', expect_broken(11731), compile_and_run, ['-fspec-constr'])
+test('T11731', normal, compile_and_run, ['-fspec-constr'])
diff --git a/testsuite/tests/stranal/should_compile/T10694.stderr b/testsuite/tests/stranal/should_compile/T10694.stderr
index 1908a08afe..06fc3a7a8a 100644
--- a/testsuite/tests/stranal/should_compile/T10694.stderr
+++ b/testsuite/tests/stranal/should_compile/T10694.stderr
@@ -1,5 +1,66 @@
+
+==================== Tidy Core ====================
+Result size of Tidy Core = {terms: 59, types: 41, coercions: 0}
+
+-- RHS size: {terms: 39, types: 23, coercions: 0}
+pm [InlPrag=NOINLINE] :: Int -> Int -> (Int, Int)
 [GblId, Arity=2, Str=<L,U(U)><L,U(U)>m]
+pm =
+  \ (x_axr :: Int) (y_axs :: Int) ->
+    let {
+      l_sVj :: Int
+      [LclId]
+      l_sVj =
+        case x_axr of { GHC.Types.I# x1_aUL -> case y_axs of { GHC.Types.I# y1_aUP -> GHC.Types.I# (GHC.Prim.+# x1_aUL y1_aUP) } } } in
+    let {
+      l1_sVl :: Int
+      [LclId]
+      l1_sVl =
+        case x_axr of { GHC.Types.I# x1_aUV -> case y_axs of { GHC.Types.I# y1_aUZ -> GHC.Types.I# (GHC.Prim.-# x1_aUV y1_aUZ) } } } in
+    let {
+      l2_sVk :: [Int]
+      [LclId]
+      l2_sVk = GHC.Types.: @ Int l1_sVl (GHC.Types.[] @ Int) } in
+    let {
+      l3_sVa :: [Int]
+      [LclId]
+      l3_sVa = GHC.Types.: @ Int l_sVj l2_sVk } in
+    (GHC.List.$w!! @ Int l3_sVa 0#, GHC.List.$w!! @ Int l3_sVa 1#)
+
+-- RHS size: {terms: 8, types: 7, coercions: 0}
+m :: Int -> Int -> Int
+[GblId,
+ Arity=2,
  Str=<L,U(U)><L,U(U)>,
+ Unf=Unf{Src=InlineStable, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True,
+         Guidance=ALWAYS_IF(arity=2,unsat_ok=True,boring_ok=False)
+         Tmpl= \ (x_aCt [Occ=Once] :: Int) (y_aCu [Occ=Once] :: Int) ->
+                 case pm x_aCt y_aCu of { (_ [Occ=Dead], mr_aCw [Occ=Once]) -> mr_aCw }}]
+m = \ (x_aCt :: Int) (y_aCu :: Int) -> case pm x_aCt y_aCu of { (pr_aCv, mr_aCw) -> mr_aCw }
+
+-- RHS size: {terms: 2, types: 0, coercions: 0}
+T10694.$trModule2 :: GHC.Types.TrName
+[GblId,
+ Caf=NoCafRefs,
  Str=m1,
+ Unf=Unf{Src=<vanilla>, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 30 20}]
+T10694.$trModule2 = GHC.Types.TrNameS "main"#
+
+-- RHS size: {terms: 2, types: 0, coercions: 0}
+T10694.$trModule1 :: GHC.Types.TrName
+[GblId,
+ Caf=NoCafRefs,
  Str=m1,
+ Unf=Unf{Src=<vanilla>, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 40 20}]
+T10694.$trModule1 = GHC.Types.TrNameS "T10694"#
+
+-- RHS size: {terms: 3, types: 0, coercions: 0}
+T10694.$trModule :: GHC.Types.Module
+[GblId,
+ Caf=NoCafRefs,
  Str=m,
+ Unf=Unf{Src=<vanilla>, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 30}]
+T10694.$trModule = GHC.Types.Module T10694.$trModule2 T10694.$trModule1
+
+
+
diff --git a/testsuite/tests/stranal/sigs/BottomFromInnerLambda.stderr b/testsuite/tests/stranal/sigs/BottomFromInnerLambda.stderr
index 4bc1e3f379..ee36ca357f 100644
--- a/testsuite/tests/stranal/sigs/BottomFromInnerLambda.stderr
+++ b/testsuite/tests/stranal/sigs/BottomFromInnerLambda.stderr
@@ -5,3 +5,10 @@ BottomFromInnerLambda.expensive: <S(S),1*U(U)>m
 BottomFromInnerLambda.f: <S(S),1*U(U)>
 
 
+
+==================== Strictness signatures ====================
+BottomFromInnerLambda.$trModule: m
+BottomFromInnerLambda.expensive: <S(S),1*U(U)>m
+BottomFromInnerLambda.f: <S(S),1*U(U)>
+
+
diff --git a/testsuite/tests/stranal/sigs/DmdAnalGADTs.stderr b/testsuite/tests/stranal/sigs/DmdAnalGADTs.stderr
index d06e4ca86a..fb898f7e22 100644
--- a/testsuite/tests/stranal/sigs/DmdAnalGADTs.stderr
+++ b/testsuite/tests/stranal/sigs/DmdAnalGADTs.stderr
@@ -12,3 +12,17 @@ DmdAnalGADTs.hasCPR: m
 DmdAnalGADTs.hasStrSig: <S,1*U(U)>m
 
 
+
+==================== Strictness signatures ====================
+DmdAnalGADTs.$tc'A: m
+DmdAnalGADTs.$tc'B: m
+DmdAnalGADTs.$tcD: m
+DmdAnalGADTs.$trModule: m
+DmdAnalGADTs.diverges: b
+DmdAnalGADTs.f: <S,1*U>
+DmdAnalGADTs.f': <S,1*U>m
+DmdAnalGADTs.g: <S,1*U>
+DmdAnalGADTs.hasCPR: m
+DmdAnalGADTs.hasStrSig: <S,1*U(U)>m
+
+
diff --git a/testsuite/tests/stranal/sigs/HyperStrUse.stderr b/testsuite/tests/stranal/sigs/HyperStrUse.stderr
index 442576db56..21077d243f 100644
--- a/testsuite/tests/stranal/sigs/HyperStrUse.stderr
+++ b/testsuite/tests/stranal/sigs/HyperStrUse.stderr
@@ -4,3 +4,9 @@ HyperStrUse.$trModule: m
 HyperStrUse.f: <S(S(S)L),1*U(1*U(U),A)><S,1*U>m
 
 
+
+==================== Strictness signatures ====================
+HyperStrUse.$trModule: m
+HyperStrUse.f: <S(S(S)L),1*U(1*U(U),A)><S,1*U>m
+
+
diff --git a/testsuite/tests/stranal/sigs/StrAnalExample.stderr b/testsuite/tests/stranal/sigs/StrAnalExample.stderr
index bd82226bee..4cc6f01905 100644
--- a/testsuite/tests/stranal/sigs/StrAnalExample.stderr
+++ b/testsuite/tests/stranal/sigs/StrAnalExample.stderr
@@ -4,3 +4,9 @@ StrAnalExample.$trModule: m
 StrAnalExample.foo: <S,1*U>
 
 
+
+==================== Strictness signatures ====================
+StrAnalExample.$trModule: m
+StrAnalExample.foo: <S,1*U>
+
+
diff --git a/testsuite/tests/stranal/sigs/T8569.stderr b/testsuite/tests/stranal/sigs/T8569.stderr
index 84636c1916..10d962ec45 100644
--- a/testsuite/tests/stranal/sigs/T8569.stderr
+++ b/testsuite/tests/stranal/sigs/T8569.stderr
@@ -7,3 +7,12 @@ T8569.$trModule: m
 T8569.addUp: <S,1*U><L,U>
 
 
+
+==================== Strictness signatures ====================
+T8569.$tc'Rdata: m
+T8569.$tc'Rint: m
+T8569.$tcRep: m
+T8569.$trModule: m
+T8569.addUp: <S,1*U><L,U>
+
+
diff --git a/testsuite/tests/stranal/sigs/T8598.stderr b/testsuite/tests/stranal/sigs/T8598.stderr
index 28d5dd0c7d..c084e15a99 100644
--- a/testsuite/tests/stranal/sigs/T8598.stderr
+++ b/testsuite/tests/stranal/sigs/T8598.stderr
@@ -4,3 +4,9 @@ T8598.$trModule: m
 T8598.fun: <S(S),1*U(U)>m
 
 
+
+==================== Strictness signatures ====================
+T8598.$trModule: m
+T8598.fun: <S(S),1*U(U)>m
+
+
diff --git a/testsuite/tests/stranal/sigs/UnsatFun.stderr b/testsuite/tests/stranal/sigs/UnsatFun.stderr
index f5093981eb..1ea2fa4773 100644
--- a/testsuite/tests/stranal/sigs/UnsatFun.stderr
+++ b/testsuite/tests/stranal/sigs/UnsatFun.stderr
@@ -10,3 +10,15 @@ UnsatFun.h2: <S,1*U><L,1*C1(U(U))>
 UnsatFun.h3: <C(S),1*C1(U)>m
 
 
+
+==================== Strictness signatures ====================
+UnsatFun.$trModule: m
+UnsatFun.f: <B,1*U(U)><B,A>x
+UnsatFun.g: <B,1*U(U)>x
+UnsatFun.g': <L,1*U(U)>
+UnsatFun.g3: <L,U(U)>m
+UnsatFun.h: <C(S),1*C1(U(U))>
+UnsatFun.h2: <S,1*U><L,1*C1(U(U))>
+UnsatFun.h3: <C(S),1*C1(U)>m
+
+