This patch addresses the exponential blow-up in the simplifier.

Specifically:
  #13253 exponential inlining
  #10421 ditto
  #18140 strict constructors
  #18282 another nested-function call case

This patch makes one really significant changes: change the way that
mkDupableCont handles StrictArg.  The details are explained in
GHC.Core.Opt.Simplify Note [Duplicating StrictArg].

Specific changes

* In mkDupableCont, when making auxiliary bindings for the other arguments
  of a call, add extra plumbing so that we don't forget the demand on them.
  Otherwise we haev to wait for another round of strictness analysis. But
  actually all the info is to hand.  This change affects:
  - Make the strictness list in ArgInfo be [Demand] instead of [Bool],
    and rename it to ai_dmds.
  - Add as_dmd to ValArg
  - Simplify.makeTrivial takes a Demand
  - mkDupableContWithDmds takes a [Demand]

There are a number of other small changes

1. For Ids that are used at most once in each branch of a case, make
   the occurrence analyser record the total number of syntactic
   occurrences.  Previously we recorded just OneBranch or
   MultipleBranches.

   I thought this was going to be useful, but I ended up barely
   using it; see Note [Note [Suppress exponential blowup] in
   GHC.Core.Opt.Simplify.Utils

   Actual changes:
     * See the occ_n_br field of OneOcc.
     * postInlineUnconditionally

2. I found a small perf buglet in SetLevels; see the new
   function GHC.Core.Opt.SetLevels.hasFreeJoin

3. Remove the sc_cci field of StrictArg.  I found I could get
   its information from the sc_fun field instead.  Less to get
   wrong!

4. In ArgInfo, arrange that ai_dmds and ai_discs have a simpler
   invariant: they line up with the value arguments beyond ai_args
   This allowed a bit of nice refactoring; see isStrictArgInfo,
   lazyArgcontext, strictArgContext

There is virtually no difference in nofib. (The runtime numbers
are bogus -- I tried a few manually.)

        Program           Size    Allocs   Runtime   Elapsed  TotalMem
--------------------------------------------------------------------------------
            fft          +0.0%     -2.0%    -48.3%    -49.4%      0.0%
     multiplier          +0.0%     -2.2%    -50.3%    -50.9%      0.0%
--------------------------------------------------------------------------------
            Min          -0.4%     -2.2%    -59.2%    -60.4%      0.0%
            Max          +0.0%     +0.1%     +3.3%     +4.9%      0.0%
 Geometric Mean          +0.0%     -0.0%    -33.2%    -34.3%     -0.0%

Test T18282 is an existing example of these deeply-nested strict calls.
We get a big decrease in compile time (-85%) because so much less
inlining takes place.

Metric Decrease:
    T18282

24 files changed, 437 insertions, 50 deletions

diff --git a/testsuite/tests/numeric/should_compile/T14465.stdout b/testsuite/tests/numeric/should_compile/T14465.stdout
index 75c05a57ee..5001d5b3a4 100644
--- a/testsuite/tests/numeric/should_compile/T14465.stdout
+++ b/testsuite/tests/numeric/should_compile/T14465.stdout
@@ -82,7 +82,7 @@ plusOne :: Natural -> Natural
  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)
-         Tmpl= \ (n [Occ=Once] :: Natural) -> naturalAdd n M.minusOne1}]
+         Tmpl= \ (n [Occ=Once1] :: Natural) -> naturalAdd n M.minusOne1}]
 plusOne = \ (n :: Natural) -> naturalAdd n M.minusOne1
 
 -- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0}
diff --git a/testsuite/tests/numeric/should_compile/T7116.stdout b/testsuite/tests/numeric/should_compile/T7116.stdout
index 9548a7f445..41995d9734 100644
--- a/testsuite/tests/numeric/should_compile/T7116.stdout
+++ b/testsuite/tests/numeric/should_compile/T7116.stdout
@@ -48,7 +48,7 @@ dr :: Double -> Double
  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)
-         Tmpl= \ (x [Occ=Once!] :: Double) ->
+         Tmpl= \ (x [Occ=Once1!] :: Double) ->
                  case x of { GHC.Types.D# x1 ->
                  GHC.Types.D# (GHC.Prim.+## x1 x1)
                  }}]
@@ -65,7 +65,7 @@ dl :: Double -> Double
  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)
-         Tmpl= \ (x [Occ=Once!] :: Double) ->
+         Tmpl= \ (x [Occ=Once1!] :: Double) ->
                  case x of { GHC.Types.D# y -> GHC.Types.D# (GHC.Prim.+## y y) }}]
 dl = dr
 
@@ -78,7 +78,7 @@ fr :: Float -> Float
  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)
-         Tmpl= \ (x [Occ=Once!] :: Float) ->
+         Tmpl= \ (x [Occ=Once1!] :: Float) ->
                  case x of { GHC.Types.F# x1 ->
                  GHC.Types.F# (GHC.Prim.plusFloat# x1 x1)
                  }}]
@@ -97,7 +97,7 @@ fl :: Float -> Float
  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)
-         Tmpl= \ (x [Occ=Once!] :: Float) ->
+         Tmpl= \ (x [Occ=Once1!] :: Float) ->
                  case x of { GHC.Types.F# y ->
                  GHC.Types.F# (GHC.Prim.plusFloat# y y)
                  }}]
diff --git a/testsuite/tests/perf/compiler/T10421.hs b/testsuite/tests/perf/compiler/T10421.hs
new file mode 100644
index 0000000000..226cc95fd2
--- /dev/null
+++ b/testsuite/tests/perf/compiler/T10421.hs
@@ -0,0 +1,51 @@
+-- Exponential with GHC 8.10
+
+module RegBig where
+
+import Prelude
+
+import Control.Applicative
+import T10421_Form
+import T10421_Y
+
+data Register
+  = Register String
+             String
+             String
+             String
+             String
+             String
+             String
+             String
+             String
+             String
+             String
+             String
+
+registerForm :: a -> IO (FormResult Register)
+registerForm _  = do
+  (a1, _) <- mreq textField "" Nothing
+  (a2, _) <- mreq textField "" Nothing
+  (a3, _) <- mreq textField "" Nothing
+  (a4, _) <- mreq textField "" Nothing
+  (a5, _) <- mreq textField "" Nothing
+  (a6, _) <- mreq textField "" Nothing
+  (a7, _) <- mreq textField "" Nothing
+  (a8, _) <- mreq textField "" Nothing
+  (a9, _) <- mreq textField "" Nothing
+  (a10, _) <- mreq textField "" Nothing
+  (a11, _) <- mreq textField "" Nothing
+  (a12, _) <- mreq textField "" Nothing
+  return (Register <$> a1
+                   <*> a2
+                   <*> a3
+                   <*> a4
+                   <*> a5
+                   <*> a6
+                   <*> a7
+                   <*> a8
+                   <*> a9
+                   <*> a10
+                   <*> a11
+                   <*> a12
+      )
diff --git a/testsuite/tests/perf/compiler/T10421_Form.hs b/testsuite/tests/perf/compiler/T10421_Form.hs
new file mode 100644
index 0000000000..0abf7ad9d5
--- /dev/null
+++ b/testsuite/tests/perf/compiler/T10421_Form.hs
@@ -0,0 +1,19 @@
+-- Form.hs
+module T10421_Form where
+
+import Control.Applicative
+
+data FormResult a = FormMissing
+                  | FormFailure [String]
+                  | FormSuccess a
+instance Functor FormResult where
+    fmap _ FormMissing = FormMissing
+    fmap _ (FormFailure errs) = FormFailure errs
+    fmap f (FormSuccess a) = FormSuccess $ f a
+instance Applicative FormResult where
+    pure = FormSuccess
+    (FormSuccess f) <*> (FormSuccess g) = FormSuccess $ f g
+    (FormFailure x) <*> (FormFailure y) = FormFailure $ x ++ y
+    (FormFailure x) <*> _ = FormFailure x
+    _ <*> (FormFailure y) = FormFailure y
+    _ <*> _ = FormMissing
diff --git a/testsuite/tests/perf/compiler/T10421_Y.hs b/testsuite/tests/perf/compiler/T10421_Y.hs
new file mode 100644
index 0000000000..de28838e86
--- /dev/null
+++ b/testsuite/tests/perf/compiler/T10421_Y.hs
@@ -0,0 +1,17 @@
+-- Y.hs
+{-# OPTIONS_GHC -fomit-interface-pragmas #-}
+-- Imagine the values defined in this module are complicated
+-- and there is no useful inlining/strictness/etc. information
+
+module T10421_Y where
+
+import T10421_Form
+
+mreq :: a -> b -> c -> IO (FormResult d, ())
+mreq = undefined
+
+mopt :: a -> b -> c -> IO (FormResult d, ())
+mopt = undefined
+
+textField = undefined
+checkBoxField = undefined
diff --git a/testsuite/tests/perf/compiler/T10421a.hs b/testsuite/tests/perf/compiler/T10421a.hs
new file mode 100644
index 0000000000..3a58f6dd62
--- /dev/null
+++ b/testsuite/tests/perf/compiler/T10421a.hs
@@ -0,0 +1,54 @@
+-- Exponential with GHC 8.10
+--
+-- This is a smaller version of T10421, but demonstrates the same blow-up
+
+module RegBig where
+
+import Prelude
+
+import Control.Applicative
+import T10421a_Form
+
+data Register
+  = Register String
+             String
+             String
+             String
+             String
+             String
+             String
+             String
+             String
+             String
+             String
+             String
+
+registerForm :: FormResult String   -- a1
+             -> FormResult String
+             -> FormResult String   -- a3
+             -> FormResult String
+             -> FormResult String
+             -> FormResult String   -- a6
+             -> FormResult String   -- a7
+             -> FormResult String
+             -> FormResult String
+             -> FormResult String
+             -> FormResult String
+             -> FormResult String   -- a12
+             -> IO (FormResult Register)
+
+registerForm a1 a2 a3 a4 a5 a6 a7
+             a8 a9 a10 a11 a12
+ = return (Register <$> a1
+                   <*> a2
+                   <*> a3
+                   <*> a4
+                   <*> a5
+                   <*> a6
+                   <*> a7
+                   <*> a8
+                   <*> a9
+                   <*> a10
+                   <*> a11
+                   <*> a12
+      )
diff --git a/testsuite/tests/perf/compiler/T10421a_Form.hs b/testsuite/tests/perf/compiler/T10421a_Form.hs
new file mode 100644
index 0000000000..165768b6e9
--- /dev/null
+++ b/testsuite/tests/perf/compiler/T10421a_Form.hs
@@ -0,0 +1,19 @@
+-- Form.hs
+module T10421a_Form where
+
+import Control.Applicative
+
+data FormResult a = FormMissing
+                  | FormFailure [String]
+                  | FormSuccess a
+instance Functor FormResult where
+    fmap _ FormMissing = FormMissing
+    fmap _ (FormFailure errs) = FormFailure errs
+    fmap f (FormSuccess a) = FormSuccess $ f a
+instance Applicative FormResult where
+    pure = FormSuccess
+    (FormSuccess f) <*> (FormSuccess g) = FormSuccess $ f g
+    (FormFailure x) <*> (FormFailure y) = FormFailure $ x ++ y
+    (FormFailure x) <*> _ = FormFailure x
+    _ <*> (FormFailure y) = FormFailure y
+    _ <*> _ = FormMissing
diff --git a/testsuite/tests/perf/compiler/T13253-spj.hs b/testsuite/tests/perf/compiler/T13253-spj.hs
new file mode 100644
index 0000000000..9c8af39aca
--- /dev/null
+++ b/testsuite/tests/perf/compiler/T13253-spj.hs
@@ -0,0 +1,20 @@
+-- Exponential with GHC 8.10
+
+module T13253 where
+
+f :: Int -> Bool -> Bool
+{-# INLINE f #-}
+f y x = case x of { True -> y>0 ; False -> y<0 }
+
+foo y x = f (y+1) $
+          f (y+2) $
+          f (y+3) $
+          f (y+4) $
+          f (y+5) $
+          f (y+6) $
+          f (y+7) $
+          f (y+8) $
+          f (y+9) $
+          f (y+10) $
+          f (y+11) $
+          f y x
diff --git a/testsuite/tests/perf/compiler/T13253.hs b/testsuite/tests/perf/compiler/T13253.hs
new file mode 100644
index 0000000000..859bc06ff6
--- /dev/null
+++ b/testsuite/tests/perf/compiler/T13253.hs
@@ -0,0 +1,122 @@
+-- Exponential with GHC 8.10
+
+{-# LANGUAGE CPP #-}
+{-# LANGUAGE OverloadedStrings #-}
+
+module T13253 where
+
+import Control.Monad (liftM)
+import Control.Monad.Trans.RWS.Lazy -- check how strict behaves
+import Control.Monad.Trans.Reader (ReaderT)
+import Control.Monad.IO.Class (MonadIO (..))
+import Control.Monad.Trans.Class (MonadTrans (..))
+import Data.ByteString (ByteString)
+import Data.Monoid (Any (..))
+import Data.Semigroup (Semigroup (..))
+import Data.String (IsString (..))
+import System.Environment (getEnv)
+
+type Handler = ReaderT () IO
+type MForm = RWST (Maybe ([(String, Text)], ()), (), ()) Any [Int]
+type Text = ByteString -- close enough
+
+data HugeStruct = HugeStruct
+  !Text
+  !Text
+  !Text
+  !Text
+  !Text
+  !Text
+  !Text
+  !Text
+  !Text -- 9th
+  !Text
+  !Text
+
+data FormResult a = FormMissing
+                  | FormFailure [Text]
+                  | FormSuccess a
+    deriving Show
+instance Functor FormResult where
+    fmap _ FormMissing = FormMissing
+    fmap _ (FormFailure errs) = FormFailure errs
+    fmap f (FormSuccess a) = FormSuccess $ f a
+instance Applicative FormResult where
+    pure = FormSuccess
+    (FormSuccess f) <*> (FormSuccess g) = FormSuccess $ f g
+    (FormFailure x) <*> (FormFailure y) = FormFailure $ x ++ y
+    (FormFailure x) <*> _ = FormFailure x
+    _ <*> (FormFailure y) = FormFailure y
+    _ <*> _ = FormMissing
+instance Monoid m => Monoid (FormResult m) where
+    mempty = pure mempty
+    mappend = (<>)
+instance Semigroup m => Semigroup (FormResult m) where
+    x <> y = (<>) <$> x <*> y
+
+mreq :: MonadIO m => String -> MForm m (FormResult Text, ())
+-- fast
+--mreq v = pure (FormFailure [], ())
+-- slow
+mreq v = mhelper v (\m l -> FormFailure ["fail"]) FormSuccess
+
+askParams :: Monad m => MForm m (Maybe [(String, Text)])
+askParams = do
+    (x, _, _) <- ask
+    return $ liftM fst x
+
+mhelper
+    :: MonadIO m
+    => String
+    -> (() -> () -> FormResult b) -- on missing
+    -> (Text -> FormResult b)      -- on success
+    -> MForm m (FormResult b, ())
+mhelper v onMissing onFound = do
+    -- without tell, also faster
+    tell (Any True)
+    -- with different "askParams": faster.
+    -- mp <- liftIO $ read <$> readFile v
+    mp <- askParams
+    (res, x) <- case mp of
+        Nothing -> return (FormMissing, ())
+        Just p -> do
+            return $ case lookup v p of
+                Nothing -> (onMissing () (), ())
+                Just t -> (onFound t, ())
+    return (res, x)
+
+-- not inlining, also faster:
+-- {-# NOINLINE mhelper #-}
+
+sampleForm2 :: MForm Handler (FormResult HugeStruct)
+sampleForm2 = do
+    (x01, _) <- mreq "UNUSED"
+    (x02, _) <- mreq "UNUSED"
+    (x03, _) <- mreq "UNUSED"
+    (x04, _) <- mreq "UNUSED"
+    (x05, _) <- mreq "UNUSED"
+    (x06, _) <- mreq "UNUSED"
+    (x07, _) <- mreq "UNUSED"
+    (x08, _) <- mreq "UNUSED"
+    (x09, _) <- mreq "UNUSED"
+    (x10, _) <- mreq "UNUSED"
+    (x11, _) <- mreq "UNUSED"
+
+    let hugeStructRes = HugeStruct
+          <$> x01
+          <*> x02
+          <*> x03
+          <*> x04
+          <*> x05
+          <*> x06
+          <*> x07
+          <*> x08
+          <*> x09
+          <*> x10
+          <*> x11
+
+    pure hugeStructRes
+
+
+main :: IO ()
+main = pure ()
diff --git a/testsuite/tests/perf/compiler/T18140.hs b/testsuite/tests/perf/compiler/T18140.hs
new file mode 100644
index 0000000000..9b75b98054
--- /dev/null
+++ b/testsuite/tests/perf/compiler/T18140.hs
@@ -0,0 +1,57 @@
+-- Exponential with GHC 8.10
+
+{-# LANGUAGE BangPatterns  #-}
+module T18140 where
+
+
+data D = D
+  !(Maybe Bool)
+  !(Maybe Bool)
+  !(Maybe Bool)
+  !(Maybe Bool)
+  !(Maybe Bool)
+  !(Maybe Bool)
+  !(Maybe Bool)
+  !(Maybe Bool)
+  !(Maybe Bool)
+  !(Maybe Bool)
+  !(Maybe Bool)
+  !(Maybe Bool)
+  !(Maybe Bool)
+  !(Maybe Bool)
+  !(Maybe Bool)
+  !(Maybe Bool)
+  !(Maybe Bool)
+  !(Maybe Bool)
+
+maMB :: Maybe Bool -> Maybe Bool -> Maybe Bool
+maMB Nothing  y        = y
+maMB x        Nothing  = x
+maMB (Just x) (Just y) = Just (maB x y)
+
+maB :: Bool -> Bool -> Bool
+maB _ y = y
+
+maD :: D -> D -> D
+maD  (D x'1 x'2 x'3 x'4  x'5 x'6 x'7 x'8 x'9 x'10 x'11 x'12 x'13 x'14 x'15 x'16 x'17 x'18)
+     (D y'1 y'2 y'3 y'4  y'5 y'6 y'7 y'8 y'9 y'10 y'11 y'12 y'13 y'14 y'15 y'16 y'17 y'18)
+     = D
+      (maMB x'1 y'1)
+      (maMB x'2 y'2)
+      (maMB x'3 y'3)
+      (maMB x'4 y'4)
+      (maMB x'5 y'5)
+      (maMB x'6 y'6)
+      (maMB x'7 y'7)
+      (maMB x'8 y'8)
+      (maMB x'9 y'9)
+      (maMB x'10 y'10)
+      (maMB x'11 y'11)
+      (maMB x'12 y'12)
+      (maMB x'13 y'13)
+      (maMB x'14 y'14)
+      (maMB x'15 y'15)
+      (maMB x'16 y'16)
+      (maMB x'17 y'17)
+      (maMB x'18 y'18)
+
diff --git a/testsuite/tests/perf/compiler/all.T b/testsuite/tests/perf/compiler/all.T
index 77549999d7..52cd3e219a 100644
--- a/testsuite/tests/perf/compiler/all.T
+++ b/testsuite/tests/perf/compiler/all.T
@@ -388,3 +388,30 @@ test ('T18282',
       ],
       compile,
       ['-v0 -O'])
+test ('T18140',
+      [ collect_compiler_stats('bytes allocated',2)
+      ],
+      compile,
+      ['-v0 -O'])
+test('T10421',
+    [ only_ways(['normal']),
+      collect_compiler_stats('bytes allocated', 1)
+    ],
+    multimod_compile,
+    ['T10421', '-v0 -O'])
+test('T10421a',
+    [ only_ways(['normal']),
+      collect_compiler_stats('bytes allocated', 1)
+    ],
+    multimod_compile,
+    ['T10421a', '-v0 -O'])
+test ('T13253',
+      [ collect_compiler_stats('bytes allocated',2)
+      ],
+      compile,
+      ['-v0 -O'])
+test ('T13253-spj',
+      [ collect_compiler_stats('bytes allocated',2)
+      ],
+      compile,
+      ['-v0 -O'])
diff --git a/testsuite/tests/simplCore/should_compile/T13143.stderr b/testsuite/tests/simplCore/should_compile/T13143.stderr
index 6d069f6cbd..f90459114b 100644
--- a/testsuite/tests/simplCore/should_compile/T13143.stderr
+++ b/testsuite/tests/simplCore/should_compile/T13143.stderr
@@ -94,11 +94,11 @@ g [InlPrag=NOUSERINLINE[2]] :: Bool -> Bool -> Int -> Int
  Unf=Unf{Src=InlineStable, TopLvl=True, Value=True, ConLike=True,
          WorkFree=True, Expandable=True,
          Guidance=ALWAYS_IF(arity=3,unsat_ok=True,boring_ok=False)
-         Tmpl= \ (w [Occ=Once] :: Bool)
-                 (w1 [Occ=Once] :: Bool)
-                 (w2 [Occ=Once!] :: Int) ->
-                 case w2 of { GHC.Types.I# ww1 [Occ=Once] ->
-                 case T13143.$wg w w1 ww1 of ww2 [Occ=Once] { __DEFAULT ->
+         Tmpl= \ (w [Occ=Once1] :: Bool)
+                 (w1 [Occ=Once1] :: Bool)
+                 (w2 [Occ=Once1!] :: Int) ->
+                 case w2 of { GHC.Types.I# ww1 [Occ=Once1] ->
+                 case T13143.$wg w w1 ww1 of ww2 [Occ=Once1] { __DEFAULT ->
                  GHC.Types.I# ww2
                  }
                  }}]
diff --git a/testsuite/tests/simplCore/should_compile/T15631.stdout b/testsuite/tests/simplCore/should_compile/T15631.stdout
index b1ada8b039..cce6777d74 100644
--- a/testsuite/tests/simplCore/should_compile/T15631.stdout
+++ b/testsuite/tests/simplCore/should_compile/T15631.stdout
@@ -3,5 +3,5 @@
       case GHC.List.reverse1 @a w (GHC.Types.[] @a) of {
         [] -> case Foo.f1 @a of { GHC.Types.I# v1 -> GHC.Prim.+# ww2 v1 };
           case GHC.List.$wlenAcc
-                 case Foo.$wf @a w of ww [Occ=Once] { __DEFAULT ->
+                 case Foo.$wf @a w of ww [Occ=Once1] { __DEFAULT ->
       case Foo.$wf @a w of ww { __DEFAULT -> GHC.Types.I# ww }
diff --git a/testsuite/tests/simplCore/should_compile/T17901.stdout b/testsuite/tests/simplCore/should_compile/T17901.stdout
index 7a09f6e2df..3017c7a4a6 100644
--- a/testsuite/tests/simplCore/should_compile/T17901.stdout
+++ b/testsuite/tests/simplCore/should_compile/T17901.stdout
@@ -1,14 +1,14 @@
-                 (wombat1 [Occ=Once*!] :: T -> t)
+                 (wombat1 [Occ=Once3!] :: T -> t)
                    A -> wombat1 T17901.A;
                    B -> wombat1 T17901.B;
                    C -> wombat1 T17901.C
   = \ (@t) (wombat1 :: T -> t) (x :: T) ->
       case x of wild { __DEFAULT -> wombat1 wild }
-         Tmpl= \ (@t) (wombat2 [Occ=Once!] :: S -> t) (x [Occ=Once] :: S) ->
-                 case x of wild [Occ=Once] { __DEFAULT -> wombat2 wild }}]
+                 (wombat2 [Occ=Once1!] :: S -> t)
+                 case x of wild [Occ=Once1] { __DEFAULT -> wombat2 wild }}]
   = \ (@t) (wombat2 :: S -> t) (x :: S) ->
       case x of wild { __DEFAULT -> wombat2 wild }
-         Tmpl= \ (@t) (wombat3 [Occ=Once!] :: W -> t) (x [Occ=Once] :: W) ->
-                 case x of wild [Occ=Once] { __DEFAULT -> wombat3 wild }}]
+                 (wombat3 [Occ=Once1!] :: W -> t)
+                 case x of wild [Occ=Once1] { __DEFAULT -> wombat3 wild }}]
   = \ (@t) (wombat3 :: W -> t) (x :: W) ->
       case x of wild { __DEFAULT -> wombat3 wild }
diff --git a/testsuite/tests/simplCore/should_compile/T18355.stderr b/testsuite/tests/simplCore/should_compile/T18355.stderr
index 50efeca4b1..6b7372c5af 100644
--- a/testsuite/tests/simplCore/should_compile/T18355.stderr
+++ b/testsuite/tests/simplCore/should_compile/T18355.stderr
@@ -12,10 +12,10 @@ f :: forall {a}. Num a => a -> Bool -> a -> a
          WorkFree=True, Expandable=True,
          Guidance=ALWAYS_IF(arity=4,unsat_ok=True,boring_ok=False)
          Tmpl= \ (@a)
-                 ($dNum [Occ=Once*] :: Num a)
-                 (x [Occ=Once*] :: a)
-                 (b [Occ=Once!] :: Bool)
-                 (eta [Occ=Once*, OS=OneShot] :: a) ->
+                 ($dNum [Occ=Once2] :: Num a)
+                 (x [Occ=Once2] :: a)
+                 (b [Occ=Once1!] :: Bool)
+                 (eta [Occ=Once2, OS=OneShot] :: a) ->
                  case b of {
                    False -> - @a $dNum x eta;
                    True -> + @a $dNum x eta
@@ -41,7 +41,7 @@ T18355.$trModule4 = "main"#
 T18355.$trModule3 :: GHC.Types.TrName
 [GblId,
  Unf=Unf{Src=<vanilla>, TopLvl=True, Value=True, ConLike=True,
-         WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 20}]
+         WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 10}]
 T18355.$trModule3 = GHC.Types.TrNameS T18355.$trModule4
 
 -- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0}
@@ -55,14 +55,14 @@ T18355.$trModule2 = "T18355"#
 T18355.$trModule1 :: GHC.Types.TrName
 [GblId,
  Unf=Unf{Src=<vanilla>, TopLvl=True, Value=True, ConLike=True,
-         WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 20}]
+         WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 10}]
 T18355.$trModule1 = GHC.Types.TrNameS T18355.$trModule2
 
 -- RHS size: {terms: 3, types: 0, coercions: 0, joins: 0/0}
 T18355.$trModule :: GHC.Types.Module
 [GblId,
  Unf=Unf{Src=<vanilla>, TopLvl=True, Value=True, ConLike=True,
-         WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 30}]
+         WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 10}]
 T18355.$trModule
   = GHC.Types.Module T18355.$trModule3 T18355.$trModule1
 
diff --git a/testsuite/tests/simplCore/should_compile/T3717.stderr b/testsuite/tests/simplCore/should_compile/T3717.stderr
index f2fe900bfd..13fc4e943a 100644
--- a/testsuite/tests/simplCore/should_compile/T3717.stderr
+++ b/testsuite/tests/simplCore/should_compile/T3717.stderr
@@ -61,9 +61,9 @@ foo [InlPrag=NOUSERINLINE[2]] :: Int -> Int
  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)
-         Tmpl= \ (w [Occ=Once!] :: Int) ->
-                 case w of { GHC.Types.I# ww1 [Occ=Once] ->
-                 case T3717.$wfoo ww1 of ww2 [Occ=Once] { __DEFAULT ->
+         Tmpl= \ (w [Occ=Once1!] :: Int) ->
+                 case w of { GHC.Types.I# ww1 [Occ=Once1] ->
+                 case T3717.$wfoo ww1 of ww2 [Occ=Once1] { __DEFAULT ->
                  GHC.Types.I# ww2
                  }
                  }}]
diff --git a/testsuite/tests/simplCore/should_compile/T3772.stdout b/testsuite/tests/simplCore/should_compile/T3772.stdout
index 731e7f23a7..dae44e102b 100644
--- a/testsuite/tests/simplCore/should_compile/T3772.stdout
+++ b/testsuite/tests/simplCore/should_compile/T3772.stdout
@@ -69,8 +69,8 @@ foo [InlPrag=NOUSERINLINE[final]] :: Int -> ()
  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)
-         Tmpl= \ (w [Occ=Once!] :: Int) ->
-                 case w of { GHC.Types.I# ww1 [Occ=Once] -> T3772.$wfoo ww1 }}]
+         Tmpl= \ (w [Occ=Once1!] :: Int) ->
+                 case w of { GHC.Types.I# ww1 [Occ=Once1] -> T3772.$wfoo ww1 }}]
 foo
   = \ (w :: Int) -> case w of { GHC.Types.I# ww1 -> T3772.$wfoo ww1 }
 
diff --git a/testsuite/tests/simplCore/should_compile/T4908.stderr b/testsuite/tests/simplCore/should_compile/T4908.stderr
index 0074e4b1a0..76e46f98f3 100644
--- a/testsuite/tests/simplCore/should_compile/T4908.stderr
+++ b/testsuite/tests/simplCore/should_compile/T4908.stderr
@@ -85,8 +85,8 @@ f [InlPrag=NOUSERINLINE[2]] :: Int -> (Int, Int) -> Bool
  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= \ (w [Occ=Once!] :: Int) (w1 [Occ=Once] :: (Int, Int)) ->
-                 case w of { I# ww1 [Occ=Once] -> T4908.$wf ww1 w1 }}]
+         Tmpl= \ (w [Occ=Once1!] :: Int) (w1 [Occ=Once1] :: (Int, Int)) ->
+                 case w of { I# ww1 [Occ=Once1] -> T4908.$wf ww1 w1 }}]
 f = \ (w :: Int) (w1 :: (Int, Int)) ->
       case w of { I# ww1 -> T4908.$wf ww1 w1 }
 
diff --git a/testsuite/tests/simplCore/should_compile/T4930.stderr b/testsuite/tests/simplCore/should_compile/T4930.stderr
index 9560d1973c..b58298aedb 100644
--- a/testsuite/tests/simplCore/should_compile/T4930.stderr
+++ b/testsuite/tests/simplCore/should_compile/T4930.stderr
@@ -61,9 +61,9 @@ foo [InlPrag=NOUSERINLINE[2]] :: Int -> Int
  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)
-         Tmpl= \ (w [Occ=Once!] :: Int) ->
-                 case w of { GHC.Types.I# ww1 [Occ=Once] ->
-                 case T4930.$wfoo ww1 of ww2 [Occ=Once] { __DEFAULT ->
+         Tmpl= \ (w [Occ=Once1!] :: Int) ->
+                 case w of { GHC.Types.I# ww1 [Occ=Once1] ->
+                 case T4930.$wfoo ww1 of ww2 [Occ=Once1] { __DEFAULT ->
                  GHC.Types.I# ww2
                  }
                  }}]
diff --git a/testsuite/tests/simplCore/should_compile/T5366.stdout b/testsuite/tests/simplCore/should_compile/T5366.stdout
index 735d059fb5..92fed9ddda 100644
--- a/testsuite/tests/simplCore/should_compile/T5366.stdout
+++ b/testsuite/tests/simplCore/should_compile/T5366.stdout
@@ -1,2 +1,2 @@
-                 case ds of { Bar dt [Occ=Once] _ [Occ=Dead] -> GHC.Types.I# dt }}]
+                 case ds of { Bar dt [Occ=Once1] _ [Occ=Dead] -> GHC.Types.I# dt }}]
 f = \ (ds :: Bar) -> case ds of { Bar dt dt1 -> GHC.Types.I# dt }
diff --git a/testsuite/tests/simplCore/should_compile/T7360.stderr b/testsuite/tests/simplCore/should_compile/T7360.stderr
index d8ded3351f..ccf2147977 100644
--- a/testsuite/tests/simplCore/should_compile/T7360.stderr
+++ b/testsuite/tests/simplCore/should_compile/T7360.stderr
@@ -13,11 +13,11 @@ T7360.$WFoo3 [InlPrag=INLINE[final] CONLIKE] :: Int #-> Foo
  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)
-         Tmpl= \ (dt [Occ=Once!] :: Int) ->
-                 case dt of { GHC.Types.I# dt [Occ=Once] -> T7360.Foo3 dt }}]
+         Tmpl= \ (dt [Occ=Once1!] :: Int) ->
+                 case dt of { GHC.Types.I# dt [Occ=Once1] -> T7360.Foo3 dt }}]
 T7360.$WFoo3
-  = \ (dt [Occ=Once!] :: Int) ->
-      case dt of { GHC.Types.I# dt [Occ=Once] -> T7360.Foo3 dt }
+  = \ (dt [Occ=Once1!] :: Int) ->
+      case dt of { GHC.Types.I# dt [Occ=Once1] -> T7360.Foo3 dt }
 
 -- RHS size: {terms: 5, types: 2, coercions: 0, joins: 0/0}
 fun1 [InlPrag=NOINLINE] :: Foo -> ()
@@ -40,10 +40,10 @@ fun2 :: forall {a}. [a] -> ((), Int)
  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)
-         Tmpl= \ (@a) (x [Occ=Once] :: [a]) ->
+         Tmpl= \ (@a) (x [Occ=Once1] :: [a]) ->
                  (T7360.fun4,
-                  case x of wild [Occ=Once] { __DEFAULT ->
-                  case GHC.List.$wlenAcc @a wild 0# of ww2 [Occ=Once] { __DEFAULT ->
+                  case x of wild [Occ=Once1] { __DEFAULT ->
+                  case GHC.List.$wlenAcc @a wild 0# of ww2 [Occ=Once1] { __DEFAULT ->
                   GHC.Types.I# ww2
                   }
                   })}]
diff --git a/testsuite/tests/simplCore/should_compile/T7865.stdout b/testsuite/tests/simplCore/should_compile/T7865.stdout
index 7c5d779425..76088acdb0 100644
--- a/testsuite/tests/simplCore/should_compile/T7865.stdout
+++ b/testsuite/tests/simplCore/should_compile/T7865.stdout
@@ -1,7 +1,7 @@
 T7865.$wexpensive [InlPrag=NOINLINE]
 T7865.$wexpensive
 expensive [InlPrag=NOUSERINLINE[final]] :: Int -> Int
-                 case T7865.$wexpensive ww1 of ww2 [Occ=Once] { __DEFAULT ->
+                 case T7865.$wexpensive ww1 of ww2 [Occ=Once1] { __DEFAULT ->
 expensive
       case T7865.$wexpensive ww1 of ww2 { __DEFAULT -> GHC.Types.I# ww2 }
             case T7865.$wexpensive ww1 of ww2 { __DEFAULT ->
diff --git a/testsuite/tests/simplCore/should_compile/spec-inline.stderr b/testsuite/tests/simplCore/should_compile/spec-inline.stderr
index bf9cb1fd1c..c91b3ef901 100644
--- a/testsuite/tests/simplCore/should_compile/spec-inline.stderr
+++ b/testsuite/tests/simplCore/should_compile/spec-inline.stderr
@@ -118,8 +118,9 @@ Roman.foo_go [InlPrag=NOUSERINLINE[2]]
  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= \ (w [Occ=Once] :: Maybe Int) (w1 [Occ=Once] :: Maybe Int) ->
-                 case Roman.$wgo w w1 of ww [Occ=Once] { __DEFAULT ->
+         Tmpl= \ (w [Occ=Once1] :: Maybe Int)
+                 (w1 [Occ=Once1] :: Maybe Int) ->
+                 case Roman.$wgo w w1 of ww [Occ=Once1] { __DEFAULT ->
                  GHC.Types.I# ww
                  }}]
 Roman.foo_go
@@ -149,8 +150,8 @@ foo :: Int -> Int
  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)
-         Tmpl= \ (n [Occ=Once!] :: Int) ->
-                 case n of n1 [Occ=Once] { GHC.Types.I# _ [Occ=Dead] ->
+         Tmpl= \ (n [Occ=Once1!] :: Int) ->
+                 case n of n1 [Occ=Once1] { GHC.Types.I# _ [Occ=Dead] ->
                  Roman.foo_go (GHC.Maybe.Just @Int n1) Roman.foo1
                  }}]
 foo
diff --git a/testsuite/tests/stranal/should_compile/T16029.stdout b/testsuite/tests/stranal/should_compile/T16029.stdout
index 77957255c8..5b3a03a603 100644
--- a/testsuite/tests/stranal/should_compile/T16029.stdout
+++ b/testsuite/tests/stranal/should_compile/T16029.stdout
@@ -1,11 +1,11 @@
 T16029.$WMkT [InlPrag=INLINE[final] CONLIKE] :: Int #-> Int #-> T
-         Tmpl= \ (dt [Occ=Once!] :: Int) (dt [Occ=Once!] :: Int) ->
-  = \ (dt [Occ=Once!] :: Int) (dt [Occ=Once!] :: Int) ->
+         Tmpl= \ (dt [Occ=Once1!] :: Int) (dt [Occ=Once1!] :: Int) ->
+  = \ (dt [Occ=Once1!] :: Int) (dt [Occ=Once1!] :: Int) ->
   :: GHC.Prim.Int# -> GHC.Prim.Int#
   = \ (ww :: GHC.Prim.Int#) ->
 g2 [InlPrag=NOUSERINLINE[2]] :: T -> Int -> Int
-         Tmpl= \ (w [Occ=Once!] :: T) (w1 [Occ=Once!] :: Int) ->
+         Tmpl= \ (w [Occ=Once1!] :: T) (w1 [Occ=Once1!] :: Int) ->
   = \ (w :: T) (w1 :: Int) ->
 g1 [InlPrag=NOUSERINLINE[2]] :: S -> Int -> Int
-         Tmpl= \ (w [Occ=Once!] :: S) (w1 [Occ=Once!] :: Int) ->
+         Tmpl= \ (w [Occ=Once1!] :: S) (w1 [Occ=Once1!] :: Int) ->
   = \ (w :: S) (w1 :: Int) ->