Improve FloatOut and SpecConstrwip/T21386

This patch addresses a relatively obscure situation that arose
when chasing perf regressions in !7847, which itself is fixing

It does two things:

* SpecConstr can specialise on ($df d1 d2) dictionary arguments
* FloatOut no longer checks argument strictness

See Note [Specialising on dictionaries] in GHC.Core.Opt.SpecConstr.

A test case is difficult to construct, but it makes a big difference
in nofib/real/eff/VSM, at least when we have the patch for #21286
installed. (The latter stops worker/wrapper for dictionary arguments).

There is a spectacular, but slightly illusory, improvement in
runtime perf on T15426.  I have documented the specifics in
T15426 itself.

Metric Decrease:
    T15426

3 files changed, 36 insertions, 10 deletions

diff --git a/testsuite/tests/perf/should_run/T15426.hs b/testsuite/tests/perf/should_run/T15426.hs
index c85c7e7ec0..cbc74d5337 100644
--- a/testsuite/tests/perf/should_run/T15426.hs
+++ b/testsuite/tests/perf/should_run/T15426.hs
@@ -11,3 +11,21 @@ main = do evaluate $ L.elemIndex 999999 [(1::Int)..1000000]
           evaluate $ L.findIndex (>=999999) [(1::Int)..1000000]
           evaluate $ L.findIndices (>=999999) [(1::Int)..1000000]
           evaluate $ unsafeFindIndex (>=999999) [(1::Int)..1000000]
+
+{- Note; see !7997.
+
+You would think those [1..100000] sub-expressions would float to the
+top level, be CSE'd, and shared.
+
+But no: until May 22-ish, they are the argument of a strict function
+findIndices; and in HEAD SetLevels goes to some trouble not to float
+strict arguments. So in HEAD, no sharing happens.
+
+I think the reasoning is bogus, so I changed in; see
+"Arguments" in Note [Floating to the top] in SetLevels.
+
+As a result these lists are now floated out and shared.
+
+Just leaving breadcrumbs, in case we later see big perf changes on
+this (slightly fragile) benchmark.
+-}
\ No newline at end of file
diff --git a/testsuite/tests/simplCore/should_compile/OpaqueNoRebox3.stderr b/testsuite/tests/simplCore/should_compile/OpaqueNoRebox3.stderr
index a74980ed99..3f01f42d2d 100644
--- a/testsuite/tests/simplCore/should_compile/OpaqueNoRebox3.stderr
+++ b/testsuite/tests/simplCore/should_compile/OpaqueNoRebox3.stderr
@@ -1,7 +1,7 @@
 
 ==================== Tidy Core ====================
 Result size of Tidy Core
-  = {terms: 120, types: 47, coercions: 4, joins: 1/1}
+  = {terms: 122, types: 49, coercions: 4, joins: 1/1}
 
 -- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0}
 OpaqueNoRebox3.$trModule4 :: GHC.Prim.Addr#
@@ -45,7 +45,7 @@ OpaqueNoRebox3.$trModule
 -- RHS size: {terms: 8, types: 3, coercions: 0, joins: 0/0}
 f [InlPrag=OPAQUE] :: Int -> Int
 [GblId, Arity=1, Str=<1L>, Unf=OtherCon []]
-f = / (x :: Int) ->
+f = \ (x :: Int) ->
       case x of { GHC.Types.I# ipv -> GHC.Types.I# (GHC.Prim.+# ipv 1#) }
 
 -- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0}
@@ -110,10 +110,15 @@ lvl11 :: GHC.Prim.Addr#
 [GblId, Unf=OtherCon []]
 lvl11 = "patError"#
 
--- RHS size: {terms: 4, types: 2, coercions: 4, joins: 0/0}
-lvl12 :: Int
+-- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0}
+lvl12 :: [Char]
+[GblId]
+lvl12 = GHC.CString.unpackCString# lvl11
+
+-- RHS size: {terms: 3, types: 2, coercions: 4, joins: 0/0}
+lvl13 :: Int
 [GblId, Str=b, Cpr=b]
-lvl12
+lvl13
   = error
       @GHC.Types.LiftedRep
       @Int
@@ -122,13 +127,13 @@ lvl12
                         <"callStack">_N <GHC.Stack.Types.CallStack>_N)
                :: GHC.Stack.Types.CallStack
                   ~R# (?callStack::GHC.Stack.Types.CallStack)))
-      (GHC.CString.unpackCString# lvl11)
+      lvl12
 
 Rec {
 -- RHS size: {terms: 50, types: 13, coercions: 0, joins: 1/1}
 g [Occ=LoopBreaker] :: Bool -> Bool -> Bool -> Int -> Int
 [GblId, Arity=4, Str=<SL><SL><L><1L>, Unf=OtherCon []]
-g = / (w :: Bool) (w1 :: Bool) (w2 :: Bool) (p :: Int) ->
+g = \ (w :: Bool) (w1 :: Bool) (w2 :: Bool) (p :: Int) ->
       join {
         fail_ [Dmd=M!P(L)] :: Int
         [LclId[JoinId(0)(Nothing)]]
@@ -139,7 +144,7 @@ g = / (w :: Bool) (w1 :: Bool) (w2 :: Bool) (p :: Int) ->
                   False -> g w GHC.Types.True GHC.Types.False p;
                   True -> f (f p)
                 };
-              True -> lvl12
+              True -> lvl13
             } } in
       case w of {
         False ->
@@ -158,4 +163,7 @@ g = / (w :: Bool) (w1 :: Bool) (w2 :: Bool) (p :: Int) ->
             True -> f p
           }
       }
-end Rec }
\ No newline at end of file
+end Rec }
+
+
+
diff --git a/testsuite/tests/simplCore/should_compile/T15631.stdout b/testsuite/tests/simplCore/should_compile/T15631.stdout
index ab181b58ed..6c528debc1 100644
--- a/testsuite/tests/simplCore/should_compile/T15631.stdout
+++ b/testsuite/tests/simplCore/should_compile/T15631.stdout
@@ -1,4 +1,4 @@
-      case GHC.List.$wlenAcc
+      case GHC.List.$wlenAcc @a (Foo.f2 @a) 0# of v { __DEFAULT ->
       case GHC.List.$wlenAcc @a xs 0# of ww1 { __DEFAULT ->
       case GHC.List.reverse1 @a xs (GHC.Types.[] @a) of {
         [] -> case Foo.f1 @a of { GHC.Types.I# v1 -> GHC.Prim.+# ww1 v1 };