Get rid of ProbOneShot

This fixes #13227. It remains to be seen what the performance impacts
are. Pushing as a branch to get perf.haskell.org answer that for us.

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

5 files changed, 11 insertions, 38 deletions

diff --git a/compiler/basicTypes/BasicTypes.hs b/compiler/basicTypes/BasicTypes.hs
index a23255b7b2..5af90171d6 100644
--- a/compiler/basicTypes/BasicTypes.hs
+++ b/compiler/basicTypes/BasicTypes.hs
@@ -210,8 +210,6 @@ type Alignment = Int -- align to next N-byte boundary (N must be a power of 2).
 -- work.
 data OneShotInfo
   = NoOneShotInfo -- ^ No information
-  | ProbOneShot   -- ^ The lambda is probably applied at most once
-                  -- See Note [Computing one-shot info, and ProbOneShot] in Demand
   | OneShotLam    -- ^ The lambda is applied at most once.
   deriving (Eq)
 
@@ -228,18 +226,13 @@ hasNoOneShotInfo _             = False
 
 worstOneShot, bestOneShot :: OneShotInfo -> OneShotInfo -> OneShotInfo
 worstOneShot NoOneShotInfo _             = NoOneShotInfo
-worstOneShot ProbOneShot   NoOneShotInfo = NoOneShotInfo
-worstOneShot ProbOneShot   _             = ProbOneShot
 worstOneShot OneShotLam    os            = os
 
 bestOneShot NoOneShotInfo os         = os
-bestOneShot ProbOneShot   OneShotLam = OneShotLam
-bestOneShot ProbOneShot   _          = ProbOneShot
 bestOneShot OneShotLam    _          = OneShotLam
 
 pprOneShotInfo :: OneShotInfo -> SDoc
 pprOneShotInfo NoOneShotInfo = empty
-pprOneShotInfo ProbOneShot   = text "ProbOneShot"
 pprOneShotInfo OneShotLam    = text "OneShot"
 
 instance Outputable OneShotInfo where
diff --git a/compiler/basicTypes/Demand.hs b/compiler/basicTypes/Demand.hs
index 8cacf2270c..1d90ac0b50 100644
--- a/compiler/basicTypes/Demand.hs
+++ b/compiler/basicTypes/Demand.hs
@@ -1783,17 +1783,15 @@ it should not fall over.
 -}
 
 argsOneShots :: StrictSig -> Arity -> [[OneShotInfo]]
--- See Note [Computing one-shot info, and ProbOneShot]
+-- See Note [Computing one-shot info]
 argsOneShots (StrictSig (DmdType _ arg_ds _)) n_val_args
-  = go arg_ds
+  | unsaturated_call = []
+  | otherwise = go arg_ds
   where
     unsaturated_call = arg_ds `lengthExceeds` n_val_args
-    good_one_shot
-      | unsaturated_call = ProbOneShot
-      | otherwise        = OneShotLam
 
     go []               = []
-    go (arg_d : arg_ds) = argOneShots good_one_shot arg_d `cons` go arg_ds
+    go (arg_d : arg_ds) = argOneShots arg_d `cons` go arg_ds
 
     -- Avoid list tail like [ [], [], [] ]
     cons [] [] = []
@@ -1813,19 +1811,18 @@ saturatedByOneShots n (JD { ud = usg })
     go n (UCall One u) = go (n-1) u
     go _ _             = False
 
-argOneShots :: OneShotInfo     -- OneShotLam or ProbOneShot,
-            -> Demand          -- depending on saturation
+argOneShots :: Demand          -- depending on saturation
             -> [OneShotInfo]
-argOneShots one_shot_info (JD { ud = usg })
+argOneShots (JD { ud = usg })
   = case usg of
       Use _ arg_usg -> go arg_usg
       _             -> []
   where
-    go (UCall One  u) = one_shot_info : go u
+    go (UCall One  u) = OneShotLam : go u
     go (UCall Many u) = NoOneShotInfo : go u
     go _              = []
 
-{- Note [Computing one-shot info, and ProbOneShot]
+{- Note [Computing one-shot info]
 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
 Consider a call
     f (\pqr. e1) (\xyz. e2) e3
@@ -1835,20 +1832,6 @@ Then argsOneShots returns a [[OneShotInfo]] of
     [[OneShot,NoOneShotInfo,OneShot],  [OneShot]]
 The occurrence analyser propagates this one-shot infor to the
 binders \pqr and \xyz; see Note [Use one-shot information] in OccurAnal.
-
-But suppose f was not saturated, so the call looks like
-    f (\pqr. e1) (\xyz. e2)
-The in principle this partial application might be shared, and
-the (\prq.e1) abstraction might be called more than once.  So
-we can't mark them OneShot. But instead we return
-    [[ProbOneShot,NoOneShotInfo,ProbOneShot],  [ProbOneShot]]
-The occurrence analyser propagates this to the \pqr and \xyz
-binders.
-
-How is it used?  Well, it's quite likely that the partial application
-of f is not shared, so the float-out pass (in SetLevels.lvlLamBndrs)
-does not float MFEs out of a ProbOneShot lambda.  That currently is
-the only way that ProbOneShot is used.
 -}
 
 -- appIsBottom returns true if an application to n args
diff --git a/compiler/basicTypes/Id.hs b/compiler/basicTypes/Id.hs
index 64b87ff15d..69c2cc32b0 100644
--- a/compiler/basicTypes/Id.hs
+++ b/compiler/basicTypes/Id.hs
@@ -762,7 +762,7 @@ isOneShotBndr var
 
 -- | Should we apply the state hack to values of this 'Type'?
 stateHackOneShot :: OneShotInfo
-stateHackOneShot = OneShotLam         -- Or maybe ProbOneShot?
+stateHackOneShot = OneShotLam
 
 typeOneShot :: Type -> OneShotInfo
 typeOneShot ty
@@ -798,7 +798,6 @@ isStateHackType ty
 isProbablyOneShotLambda :: Id -> Bool
 isProbablyOneShotLambda id = case idStateHackOneShotInfo id of
                                OneShotLam    -> True
-                               ProbOneShot   -> True
                                NoOneShotInfo -> False
 
 setOneShotLambda :: Id -> Id
@@ -819,8 +818,6 @@ updOneShotInfo id one_shot
     do_upd = case (idOneShotInfo id, one_shot) of
                 (NoOneShotInfo, _) -> True
                 (OneShotLam,    _) -> False
-                (_, NoOneShotInfo) -> False
-                _                  -> True
 
 -- The OneShotLambda functions simply fiddle with the IdInfo flag
 -- But watch out: this may change the type of something else
diff --git a/compiler/simplCore/OccurAnal.hs b/compiler/simplCore/OccurAnal.hs
index 864d468a35..b02ddc9540 100644
--- a/compiler/simplCore/OccurAnal.hs
+++ b/compiler/simplCore/OccurAnal.hs
@@ -1548,7 +1548,7 @@ occAnalNonRecRhs env bndr bndrs body
          | otherwise        = rhsCtxt env
 
     -- See Note [Use one-shot info]
-    rhs_env = env1 { occ_one_shots = argOneShots OneShotLam dmd }
+    rhs_env = env1 { occ_one_shots = argOneShots dmd }
 
 
     certainly_inline -- See Note [Cascading inlines]
diff --git a/testsuite/tests/simplCore/should_run/all.T b/testsuite/tests/simplCore/should_run/all.T
index 6fe17e17d6..702d83cd27 100644
--- a/testsuite/tests/simplCore/should_run/all.T
+++ b/testsuite/tests/simplCore/should_run/all.T
@@ -73,4 +73,4 @@ test('T12689broken', expect_broken(12689), compile_and_run, [''])
 test('T12689a', normal, compile_and_run, [''])
 
 test('T13172', only_ways(['optasm']), compile_and_run, ['-dcore-lint'])
-test('T13227', expect_broken(13227), compile_and_run, [''])
+test('T13227', normal, compile_and_run, [''])