Improve the Occurrence Analyzer’s handling of one-shot functions

When determining whether an expression is used saturatedly, count the
number of value arguments that the occurrence analyser sees, and add
the number of one-shot arguments that we know (from the strictness
analyser) are passed from the context.

perf results suggest no noticable change in allocations, reduction of
code sizes, and performance regression possibliy due to loss of join
points.

Test Plan: perf.haskell.org

Reviewers: simonpj, austin, bgamari

Reviewed By: bgamari

Subscribers: thomie

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

2 files changed, 107 insertions, 66 deletions

diff --git a/compiler/simplCore/OccurAnal.hs b/compiler/simplCore/OccurAnal.hs
index 728e4725f8..92c21ada14 100644
--- a/compiler/simplCore/OccurAnal.hs
+++ b/compiler/simplCore/OccurAnal.hs
@@ -1547,7 +1547,7 @@ occAnalNonRecRhs env bndr bndrs body
     env1 | certainly_inline = env
          | otherwise        = rhsCtxt env
 
-    -- See Note [Use one-shot info]
+    -- See Note [Sources of one-shot information]
     rhs_env = env1 { occ_one_shots = argOneShots dmd }
 
 
@@ -1867,16 +1867,17 @@ occAnalApp env (Var fun, args, ticks)
        -- This is the *whole point* of the isRhsEnv predicate
        -- See Note [Arguments of let-bound constructors]
 
-    n_val_args = valArgCount args
+    n_val_args = valArgCount args + length (takeWhile isOneShotInfo (occ_one_shots env))
+        -- See Note [Sources of one-shot information], bullet point A'
+
     n_args     = length args
     fun_uds    = mkOneOcc env fun (n_val_args > 0) n_args
     is_exp     = isExpandableApp fun n_val_args
-           -- See Note [CONLIKE pragma] in BasicTypes
-           -- The definition of is_exp should match that in
-           -- Simplify.prepareRhs
+        -- See Note [CONLIKE pragma] in BasicTypes
+        -- The definition of is_exp should match that in Simplify.prepareRhs
 
     one_shots  = argsOneShots (idStrictness fun) n_val_args
-                 -- See Note [Use one-shot info]
+        -- See Note [Sources of one-shot information]
 
 occAnalApp env (fun, args, ticks)
   = (markAllNonTailCalled (fun_uds +++ args_uds),
@@ -1898,20 +1899,44 @@ zapDetailsIf True  uds = zapDetails uds
 zapDetailsIf False uds = uds
 
 {-
-Note [Use one-shot information]
-~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
-The occurrence analyser propagates one-shot-lambda information in two
-situations:
+Note [Sources of one-shot information]
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+The occurrence analyser obtains one-shot-lambda information from two sources:
+
+A:  Saturated applications:  eg   f e1 .. en
+
+    In general, given a call (f e1 .. en) we can propagate one-shot info from
+    f's strictness signature into e1 .. en, but /only/ if n is enough to
+    saturate the strictness signature. A stricteness signature like
+
+    f :: C1(C1(L))LS
+
+    means that *if f is applied to three arguments* then it will guarantee to
+    call its first argument at most once, and to call the result of that at
+    most once. But if f has fewer than three arguments, all bets are off; e.g.
+
+    map (f (\x y. expensive) e2) xs
+
+    Here the \x y abstraction may be called many times (once for each element of
+    xs) so we should not mark x and y as one-shot. But if it was
 
-  * Applications:  eg   build (\c n -> blah)
+    map (f (\x y. expensive) 3 2) xs
 
-    Propagate one-shot info from the strictness signature of 'build' to
-    the \c n.
+    then the first argument of f will be called at most once.
 
-    This strictness signature can come from a module interface, in the case of
-    an imported function, or from a previous run of the demand analyser.
+A': Non-obviously satuated applications: eg    build (f (\x y -> expensive))
 
-  * Let-bindings:  eg   let f = \c. let ... in \n -> blah
+    In this case, f is only manifestly applied to one argument, so it does not
+    look saturated. So bye the previous point, we should not use its strictness
+    signature to learn about the one-shotness of \x y. But in this case we can:
+
+    build is fully applied, so we may use its strictness signature. From that
+    we learn that build calls its argument with two arguments *at most once*.
+
+    So there is really only one call to f, and it will have three arguments. In
+    that sense, f is saturated, and we may proceed as described above.
+
+B:  Let-bindings:  eg   let f = \c. let ... in \n -> blah
                         in (build f, build f)
 
     Propagate one-shot info from the demanand-info on 'f' to the
@@ -1924,6 +1949,22 @@ Previously, the demand analyser would *also* set the one-shot information, but
 that code was buggy (see #11770), so doing it only in on place, namely here, is
 saner.
 
+Note [OneShots]
+~~~~~~~~~~~~~~~
+When analysing an expression, the occ_one_shots argument contains information
+about how the function is being used. The length of the list indicates
+how many arguments will eventually be passed to the analysed expression,
+and the OneShotInfo indicates whether this application is once or multiple times.
+
+Example:
+
+ Context of f                occ_one_shots when analysing f
+
+ f 1 2                       [OneShot, OneShot]
+ map (f 1)                   [OneShot, NoOneShotInfo]
+ build f                     [OneShot, OneShot]
+ f 1 2 `seq` f 2 1           [NoOneShotInfo, OneShot]
+
 Note [Binders in case alternatives]
 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
 Consider
@@ -2008,7 +2049,7 @@ wrapAltRHS _ _ alt_usg _ alt_rhs
 
 data OccEnv
   = OccEnv { occ_encl       :: !OccEncl      -- Enclosing context information
-           , occ_one_shots  :: !OneShots     -- Tells about linearity
+           , occ_one_shots  :: !OneShots     -- See Note [OneShots]
            , occ_gbl_scrut  :: GlobalScruts
            , occ_rule_act   :: Activation -> Bool   -- Which rules are active
              -- See Note [Finding rule RHS free vars]
@@ -2037,11 +2078,8 @@ instance Outputable OccEncl where
   ppr OccRhs     = text "occRhs"
   ppr OccVanilla = text "occVanilla"
 
+-- See note [OneShots]
 type OneShots = [OneShotInfo]
-        -- []           No info
-        --
-        -- one_shot_info:ctxt    Analysing a function-valued expression that
-        --                       will be applied as described by one_shot_info
 
 initOccEnv :: (Activation -> Bool) -> OccEnv
 initOccEnv active_rule
diff --git a/testsuite/tests/perf/haddock/all.T b/testsuite/tests/perf/haddock/all.T
index f037954263..c9b84cf458 100644
--- a/testsuite/tests/perf/haddock/all.T
+++ b/testsuite/tests/perf/haddock/all.T
@@ -5,32 +5,33 @@
 test('haddock.base',
      [unless(in_tree_compiler(), skip), req_haddock
      ,stats_num_field('bytes allocated',
-          [(wordsize(64), 31115778088 , 5)
-            # 2012-08-14: 5920822352 (amd64/Linux)
-            # 2012-09-20: 5829972376 (amd64/Linux)
-            # 2012-10-08: 5902601224 (amd64/Linux)
-            # 2013-01-17: 6064874536 (x86_64/Linux)
-            # 2013-02-10: 6282746976 (x86_64/Linux)
-            # 2013-09-17: 6634886456 (x86_64/Linux)
-            # 2013-09-18: 6294339840 (x86_64/Linux)
-            # 2013-11-21: 6756213256 (x86_64/Linux)
-            # 2014-01-12: 7128342344 (x86_64/Linux)
-            # 2014-06-12: 7498123680 (x86_64/Linux)
-            # 2014-08-05: 7992757384 (x86_64/Linux - bugfix for #314, Haddock now parses more URLs)
-            # 2014-08-08: 7946284944 (x86_64/Linux - Haddock updates to attoparsec-0.12.1.0)
-            # 2014-09-09: 8354439016 (x86_64/Linux - Applicative/Monad changes, according to Austin)
-            # 2014-09-10: 7901230808 (x86_64/Linux - Applicative/Monad changes, according to Joachim)
-            # 2014-10-07: 8322584616 (x86_64/Linux)
-            # 2014-12-14: 9502647104 (x86_64/Linux) - Update to Haddock 2.16
-            # 2014-01-08: 9014511528 (x86_64/Linux) - Eliminate so-called "silent superclass parameters" (and others)
-            # 2015-07-22: 9418857192 (x86_64/Linux) - Just slowly creeping up.
-            # 2015-10-03: 9894189856 (x86_64/Linux) - Still creeping
+          [(wordsize(64), 34819979936 , 5)
+            # 2012-08-14:  5920822352 (amd64/Linux)
+            # 2012-09-20:  5829972376 (amd64/Linux)
+            # 2012-10-08:  5902601224 (amd64/Linux)
+            # 2013-01-17:  6064874536 (x86_64/Linux)
+            # 2013-02-10:  6282746976 (x86_64/Linux)
+            # 2013-09-17:  6634886456 (x86_64/Linux)
+            # 2013-09-18:  6294339840 (x86_64/Linux)
+            # 2013-11-21:  6756213256 (x86_64/Linux)
+            # 2014-01-12:  7128342344 (x86_64/Linux)
+            # 2014-06-12:  7498123680 (x86_64/Linux)
+            # 2014-08-05:  7992757384 (x86_64/Linux - bugfix for #314, Haddock now parses more URLs)
+            # 2014-08-08:  7946284944 (x86_64/Linux - Haddock updates to attoparsec-0.12.1.0)
+            # 2014-09-09:  8354439016 (x86_64/Linux - Applicative/Monad changes, according to Austin)
+            # 2014-09-10:  7901230808 (x86_64/Linux - Applicative/Monad changes, according to Joachim)
+            # 2014-10-07:  8322584616 (x86_64/Linux)
+            # 2014-12-14:  9502647104 (x86_64/Linux) - Update to Haddock 2.16
+            # 2014-01-08:  9014511528 (x86_64/Linux) - Eliminate so-called "silent superclass parameters" (and others)
+            # 2015-07-22:  9418857192 (x86_64/Linux) - Just slowly creeping up.
+            # 2015-10-03:  9894189856 (x86_64/Linux) - Still creeping
             # 2015-12-11: 11119767632 (amd64/Linux) - TypeInType (see #11196)
             # 2015-12-17: 26282821104 (x86_64/Linux) - Update Haddock to master
             # 2015-12-17: 27812188000 (x86_64/Linux) - Move Data.Functor.* into base
             # 2016-02-25: 30987348040 (x86_64/Linux) - RuntimeRep
             # 2016-05-12: 32855223200 (x86_64/Linux) - Make Generic1 poly-kinded
             # 2017-01-11: 31115778088 (x86_64/Linux) - Join points (#12988)
+            # 2017-02-11: 34819979936 (x86_64/Linux) - OccurAnal / One-Shot  (#13227)
 
           ,(platform('i386-unknown-mingw32'), 4434804940, 5)
             # 2013-02-10:                     3358693084 (x86/Windows)
@@ -53,29 +54,29 @@ test('haddock.base',
 test('haddock.Cabal',
      [unless(in_tree_compiler(), skip), req_haddock
      ,stats_num_field('bytes allocated',
-          [(wordsize(64), 23272708864, 5)
-            # 2012-08-14: 3255435248 (amd64/Linux)
-            # 2012-08-29: 3324606664 (amd64/Linux, new codegen)
-            # 2012-10-08: 3373401360 (amd64/Linux)
-            # 2013-03-13: 3626604824 (amd64/Linux) Cabal updated
-            # 2013-03-28: 3517301864 (amd64/Linux) fixed #7796
-            # 2013-04-26: 3658801800 (amd64/Linux) Cabal updated
-            # 2013-08-26: 3808466816 (amd64/Linux) Cabal updated
-            # 2013-11-21: 3908586784 (amd64/Linux) Cabal updated
-            # 2013-12-12: 3828567272 (amd64/Linux)
-            # 2014-01-12: 3979151552 (amd64/Linux) new parser
-            # 2014-06-29: 4200993768 (amd64/Linux)
-            # 2014-08-05: 4493770224 (x86_64/Linux - bugfix for #314, Haddock now parses more URLs)
-            # 2014-08-29: 4267311856 (x86_64/Linux - w/w for INLINABLE things)
-            # 2014-09-09: 4660249216 (x86_64/Linux - Applicative/Monad changes according to Austin)
-            # 2014-09-10: 4500376192 (x86_64/Linux - Applicative/Monad changes according to Joachim)
-            # 2014-09-24: 5840893376 (x86_64/Linux - Cabal update)
-            # 2014-10-04: 6019839624 (x86_64/Linux - Burning Bridges, Cabal update)
-            # 2014-12-14: 6387320816 (x86_64/Linux) - Update to Haddock 2.16
-            # 2015-01-22: 6710234312 (x86_64/Linux) - Cabal updated
-            # 2015-06-29: 7413958344 (x86_64/Linux) - due to #10482, not yet investigated
-            # 2015-12-11: 8114833312 (amd64/Linux) - TypeInType (See #11196)
-            # 2015-12-17: 9982130512 (amd64/Linux) - Update Haddock to master
+          [(wordsize(64), 25533642168, 5)
+            # 2012-08-14:  3255435248 (amd64/Linux)
+            # 2012-08-29:  3324606664 (amd64/Linux, new codegen)
+            # 2012-10-08:  3373401360 (amd64/Linux)
+            # 2013-03-13:  3626604824 (amd64/Linux) Cabal updated
+            # 2013-03-28:  3517301864 (amd64/Linux) fixed #7796
+            # 2013-04-26:  3658801800 (amd64/Linux) Cabal updated
+            # 2013-08-26:  3808466816 (amd64/Linux) Cabal updated
+            # 2013-11-21:  3908586784 (amd64/Linux) Cabal updated
+            # 2013-12-12:  3828567272 (amd64/Linux)
+            # 2014-01-12:  3979151552 (amd64/Linux) new parser
+            # 2014-06-29:  4200993768 (amd64/Linux)
+            # 2014-08-05:  4493770224 (x86_64/Linux - bugfix for #314, Haddock now parses more URLs)
+            # 2014-08-29:  4267311856 (x86_64/Linux - w/w for INLINABLE things)
+            # 2014-09-09:  4660249216 (x86_64/Linux - Applicative/Monad changes according to Austin)
+            # 2014-09-10:  4500376192 (x86_64/Linux - Applicative/Monad changes according to Joachim)
+            # 2014-09-24:  5840893376 (x86_64/Linux - Cabal update)
+            # 2014-10-04:  6019839624 (x86_64/Linux - Burning Bridges, Cabal update)
+            # 2014-12-14:  6387320816 (x86_64/Linux) - Update to Haddock 2.16
+            # 2015-01-22:  6710234312 (x86_64/Linux) - Cabal updated
+            # 2015-06-29:  7413958344 (x86_64/Linux) - due to #10482, not yet investigated
+            # 2015-12-11:  8114833312 (amd64/Linux) - TypeInType (See #11196)
+            # 2015-12-17:  9982130512 (amd64/Linux) - Update Haddock to master
             # 2015-12-22: 10519532424 (amd64/Linux) - Lots of new Semigroup instances in Cabal
             # 2016-03-29: 11517963232 (amd64/Linux) - not yet investigated
             # 2016-03-30: 10941742184 (amd64/Linux) - defer inlining of Int* Ord methods
@@ -94,6 +95,7 @@ test('haddock.Cabal',
             # 2016-10-06: 23706190072 (amd64/Linux) - Cabal update
             # 2016-12-20: 25478853176 (amd64/Linux) - Cabal update
             # 2017-01-14: 23272708864 (amd64/Linux) - Join points (#12988)
+            # 2017-02-11: 25533642168 (amd64/Linux) - OccurAnal / One-Shot  (#13227)
 
           ,(platform('i386-unknown-mingw32'), 3293415576, 5)
             # 2012-10-30:                     1733638168 (x86/Windows)
@@ -115,8 +117,8 @@ test('haddock.Cabal',
 test('haddock.compiler',
      [unless(in_tree_compiler(), skip), req_haddock
      ,stats_num_field('bytes allocated',
-          [(wordsize(64), 60911147344, 10)
-            # 2012P-08-14: 26070600504 (amd64/Linux)
+          [(wordsize(64), 62070477608, 10)
+            # 2012-08-14: 26070600504 (amd64/Linux)
             # 2012-08-29: 26353100288 (amd64/Linux, new CG)
             # 2012-09-18: 26882813032 (amd64/Linux)
             # 2012-11-12: 25990254632 (amd64/Linux)
@@ -131,6 +133,7 @@ test('haddock.compiler',
             # 2015-12-17: 58017214568 (amd64/Linux) update Haddock to master
             # 2016-06-21: 55314944264 (amd64/Linux) D2350: Make checkFamInstConsistency less expensive
             # 2016-11-29: 60911147344 (amd64/Linux) unknown cause
+            # 2017-02-11: 62070477608 (amd64/Linux) OccurAnal / One-Shot  (#13227) (and others)
 
           ,(platform('i386-unknown-mingw32'),   902576468, 10)
             # 2012-10-30:                     13773051312 (x86/Windows)