Demand: Interleave usage and strictness demands (#18903)

As outlined in #18903, interleaving usage and strictness demands not
only means a more compact demand representation, but also allows us to
express demands that we weren't easily able to express before.

Call demands are *relative* in the sense that a call demand `Cn(cd)`
on `g` says "`g` is called `n` times. *Whenever `g` is called*, the
result is used according to `cd`". Example from #18903:

```hs
h :: Int -> Int
h m =
  let g :: Int -> (Int,Int)
      g 1 = (m, 0)
      g n = (2 * n, 2 `div` n)
      {-# NOINLINE g #-}
  in case m of
    1 -> 0
    2 -> snd (g m)
    _ -> uncurry (+) (g m)
```

Without the interleaved representation, we would just get `L` for the
strictness demand on `g`. Now we are able to express that whenever
`g` is called, its second component is used strictly in denoting `g`
by `1C1(P(1P(U),SP(U)))`. This would allow Nested CPR to unbox the
division, for example.

Fixes #18903.
While fixing regressions, I also discovered and fixed #18957.

Metric Decrease:
    T13253-spj

18 files changed, 128 insertions, 65 deletions

diff --git a/testsuite/tests/stranal/sigs/BottomFromInnerLambda.stderr b/testsuite/tests/stranal/sigs/BottomFromInnerLambda.stderr
index c3845dd6de..a2dade38df 100644
--- a/testsuite/tests/stranal/sigs/BottomFromInnerLambda.stderr
+++ b/testsuite/tests/stranal/sigs/BottomFromInnerLambda.stderr
@@ -1,8 +1,8 @@
 
 ==================== Strictness signatures ====================
 BottomFromInnerLambda.$trModule:
-BottomFromInnerLambda.expensive: <S(S),1*U(U)>
-BottomFromInnerLambda.f: <S(S),1*U(U)>
+BottomFromInnerLambda.expensive: <SP(MU)>
+BottomFromInnerLambda.f: <SP(MU)>
 
 
 
@@ -15,7 +15,7 @@ BottomFromInnerLambda.f:
 
 ==================== Strictness signatures ====================
 BottomFromInnerLambda.$trModule:
-BottomFromInnerLambda.expensive: <S(S),1*U(1*U)>
-BottomFromInnerLambda.f: <S(S),1*U(1*U)>
+BottomFromInnerLambda.expensive: <SP(SU)>
+BottomFromInnerLambda.f: <SP(SU)>
 
 
diff --git a/testsuite/tests/stranal/sigs/CaseBinderCPR.stderr b/testsuite/tests/stranal/sigs/CaseBinderCPR.stderr
index 54b0a44763..ca6d3015ff 100644
--- a/testsuite/tests/stranal/sigs/CaseBinderCPR.stderr
+++ b/testsuite/tests/stranal/sigs/CaseBinderCPR.stderr
@@ -1,7 +1,7 @@
 
 ==================== Strictness signatures ====================
 CaseBinderCPR.$trModule:
-CaseBinderCPR.f_list_cmp: <L,C(C1(U(U)))><S,1*U><S,1*U>
+CaseBinderCPR.f_list_cmp: <UCU(CS(P(MU)))><SU><SU>
 
 
 
@@ -13,6 +13,6 @@ CaseBinderCPR.f_list_cmp: m1
 
 ==================== Strictness signatures ====================
 CaseBinderCPR.$trModule:
-CaseBinderCPR.f_list_cmp: <L,C(C1(U(1*U)))><S,1*U><S,1*U>
+CaseBinderCPR.f_list_cmp: <UCU(CS(P(SU)))><SU><SU>
 
 
diff --git a/testsuite/tests/stranal/sigs/DmdAnalGADTs.stderr b/testsuite/tests/stranal/sigs/DmdAnalGADTs.stderr
index 6dd5576da4..41fae8f5ce 100644
--- a/testsuite/tests/stranal/sigs/DmdAnalGADTs.stderr
+++ b/testsuite/tests/stranal/sigs/DmdAnalGADTs.stderr
@@ -5,11 +5,11 @@ DmdAnalGADTs.$tc'B:
 DmdAnalGADTs.$tcD:
 DmdAnalGADTs.$trModule:
 DmdAnalGADTs.diverges: b
-DmdAnalGADTs.f: <S,1*U>
-DmdAnalGADTs.f': <S,1*U>
-DmdAnalGADTs.g: <S,1*U>
+DmdAnalGADTs.f: <SU>
+DmdAnalGADTs.f': <SU>
+DmdAnalGADTs.g: <SU>
 DmdAnalGADTs.hasCPR:
-DmdAnalGADTs.hasStrSig: <S,1*U(U)>
+DmdAnalGADTs.hasStrSig: <SP(U)>
 
 
 
@@ -33,10 +33,10 @@ DmdAnalGADTs.$tc'B:
 DmdAnalGADTs.$tcD:
 DmdAnalGADTs.$trModule:
 DmdAnalGADTs.diverges: b
-DmdAnalGADTs.f: <S,1*U>
-DmdAnalGADTs.f': <S,1*U>
-DmdAnalGADTs.g: <S,1*U>
+DmdAnalGADTs.f: <SU>
+DmdAnalGADTs.f': <SU>
+DmdAnalGADTs.g: <SU>
 DmdAnalGADTs.hasCPR:
-DmdAnalGADTs.hasStrSig: <S,1*U(U)>
+DmdAnalGADTs.hasStrSig: <SP(U)>
 
 
diff --git a/testsuite/tests/stranal/sigs/HyperStrUse.stderr b/testsuite/tests/stranal/sigs/HyperStrUse.stderr
index 1ae91db4d4..dc26e84381 100644
--- a/testsuite/tests/stranal/sigs/HyperStrUse.stderr
+++ b/testsuite/tests/stranal/sigs/HyperStrUse.stderr
@@ -1,7 +1,7 @@
 
 ==================== Strictness signatures ====================
 HyperStrUse.$trModule:
-HyperStrUse.f: <S(SL),1*U(1*U(U),A)><S,1*U>
+HyperStrUse.f: <SP(SP(U),A)><SU>
 
 
 
@@ -13,6 +13,6 @@ HyperStrUse.f: m1
 
 ==================== Strictness signatures ====================
 HyperStrUse.$trModule:
-HyperStrUse.f: <S(SL),1*U(1*U(U),A)><S,1*U>
+HyperStrUse.f: <SP(SP(U),A)><SU>
 
 
diff --git a/testsuite/tests/stranal/sigs/NewtypeArity.stderr b/testsuite/tests/stranal/sigs/NewtypeArity.stderr
index 55cfe94ac7..ebbbbc0c30 100644
--- a/testsuite/tests/stranal/sigs/NewtypeArity.stderr
+++ b/testsuite/tests/stranal/sigs/NewtypeArity.stderr
@@ -3,8 +3,8 @@
 Test.$tc'MkT:
 Test.$tcT:
 Test.$trModule:
-Test.t: <S,1*U(U)><S,1*U(U)>
-Test.t2: <S,1*U(U)><S,1*U(U)>
+Test.t: <SP(U)><SP(U)>
+Test.t2: <SP(U)><SP(U)>
 
 
 
@@ -21,7 +21,7 @@ Test.t2: m1
 Test.$tc'MkT:
 Test.$tcT:
 Test.$trModule:
-Test.t: <S,1*U(U)><S,1*U(U)>
-Test.t2: <S,1*U(U)><S,1*U(U)>
+Test.t: <SP(U)><SP(U)>
+Test.t2: <SP(U)><SP(U)>
 
 
diff --git a/testsuite/tests/stranal/sigs/StrAnalExample.stderr b/testsuite/tests/stranal/sigs/StrAnalExample.stderr
index eb2c5716bc..e9ac8bab6a 100644
--- a/testsuite/tests/stranal/sigs/StrAnalExample.stderr
+++ b/testsuite/tests/stranal/sigs/StrAnalExample.stderr
@@ -1,7 +1,7 @@
 
 ==================== Strictness signatures ====================
 StrAnalExample.$trModule:
-StrAnalExample.foo: <S,1*U>
+StrAnalExample.foo: <SU>
 
 
 
@@ -13,6 +13,6 @@ StrAnalExample.foo:
 
 ==================== Strictness signatures ====================
 StrAnalExample.$trModule:
-StrAnalExample.foo: <S,1*U>
+StrAnalExample.foo: <SU>
 
 
diff --git a/testsuite/tests/stranal/sigs/T12370.stderr b/testsuite/tests/stranal/sigs/T12370.stderr
index caa780b0d2..44a90106cf 100644
--- a/testsuite/tests/stranal/sigs/T12370.stderr
+++ b/testsuite/tests/stranal/sigs/T12370.stderr
@@ -1,8 +1,8 @@
 
 ==================== Strictness signatures ====================
 T12370.$trModule:
-T12370.bar: <S,1*U(U)><S,1*U(U)>
-T12370.foo: <S(SS),1*U(1*U(U),1*U(U))>
+T12370.bar: <SP(U)><SP(U)>
+T12370.foo: <SP(SP(U),SP(U))>
 
 
 
@@ -15,7 +15,7 @@ T12370.foo: m1
 
 ==================== Strictness signatures ====================
 T12370.$trModule:
-T12370.bar: <S,1*U(U)><S,1*U(U)>
-T12370.foo: <S(SS),1*U(1*U(U),1*U(U))>
+T12370.bar: <SP(U)><SP(U)>
+T12370.foo: <SP(SP(U),SP(U))>
 
 
diff --git a/testsuite/tests/stranal/sigs/T13380f.stderr b/testsuite/tests/stranal/sigs/T13380f.stderr
index dd53a9c971..a856a1794b 100644
--- a/testsuite/tests/stranal/sigs/T13380f.stderr
+++ b/testsuite/tests/stranal/sigs/T13380f.stderr
@@ -1,12 +1,12 @@
 
 ==================== Strictness signatures ====================
 T13380f.$trModule:
-T13380f.f: <S,1*U(U)><S,1*U(U)><L,U>
-T13380f.g: <S,1*U(U)><L,1*U(U)><L,U>
-T13380f.h: <S,1*U(U)><L,1*U(U)><L,U>
-T13380f.interruptibleCall: <L,U>
-T13380f.safeCall: <L,U>
-T13380f.unsafeCall: <L,U>
+T13380f.f: <SP(U)><SP(U)><U>
+T13380f.g: <SP(U)><1P(U)><U>
+T13380f.h: <SP(U)><1P(U)><U>
+T13380f.interruptibleCall: <U>
+T13380f.safeCall: <U>
+T13380f.unsafeCall: <U>
 
 
 
@@ -23,11 +23,11 @@ T13380f.unsafeCall:
 
 ==================== Strictness signatures ====================
 T13380f.$trModule:
-T13380f.f: <S,1*U(U)><S,1*U(U)><L,U>
-T13380f.g: <S,1*U(U)><L,1*U(U)><L,U>
-T13380f.h: <S,1*U(U)><L,1*U(U)><L,U>
-T13380f.interruptibleCall: <L,U>
-T13380f.safeCall: <L,U>
-T13380f.unsafeCall: <L,U>
+T13380f.f: <SP(U)><SP(U)><U>
+T13380f.g: <SP(U)><1P(U)><U>
+T13380f.h: <SP(U)><1P(U)><U>
+T13380f.interruptibleCall: <U>
+T13380f.safeCall: <U>
+T13380f.unsafeCall: <U>
 
 
diff --git a/testsuite/tests/stranal/sigs/T17932.stderr b/testsuite/tests/stranal/sigs/T17932.stderr
index 7ca56637df..072af8d45e 100644
--- a/testsuite/tests/stranal/sigs/T17932.stderr
+++ b/testsuite/tests/stranal/sigs/T17932.stderr
@@ -5,7 +5,7 @@ T17932.$tc'X:
 T17932.$tcOptions:
 T17932.$tcX:
 T17932.$trModule:
-T17932.flags: <S(SS),1*U(1*U,1*U)>
+T17932.flags: <SP(SU,SU)>
 
 
 
@@ -25,6 +25,6 @@ T17932.$tc'X:
 T17932.$tcOptions:
 T17932.$tcX:
 T17932.$trModule:
-T17932.flags: <S(SS),1*U(1*U,1*U)>
+T17932.flags: <SP(SU,SU)>
 
 
diff --git a/testsuite/tests/stranal/sigs/T18086.stderr b/testsuite/tests/stranal/sigs/T18086.stderr
index 6941e233f8..0ac4c846ee 100644
--- a/testsuite/tests/stranal/sigs/T18086.stderr
+++ b/testsuite/tests/stranal/sigs/T18086.stderr
@@ -1,8 +1,8 @@
 
 ==================== Strictness signatures ====================
 T18086.$trModule:
-T18086.m: <L,U>x
-T18086.panic: <L,U>x
+T18086.m: <U>x
+T18086.panic: <U>x
 
 
 
@@ -15,7 +15,7 @@ T18086.panic:
 
 ==================== Strictness signatures ====================
 T18086.$trModule:
-T18086.m: <L,U>x
-T18086.panic: <L,U>x
+T18086.m: <U>x
+T18086.panic: <U>x
 
 
diff --git a/testsuite/tests/stranal/sigs/T18957.hs b/testsuite/tests/stranal/sigs/T18957.hs
new file mode 100644
index 0000000000..9781b7cd58
--- /dev/null
+++ b/testsuite/tests/stranal/sigs/T18957.hs
@@ -0,0 +1,31 @@
+{-# OPTIONS_GHC -O2 -fforce-recomp #-}
+{-# LANGUAGE BangPatterns #-}
+
+-- | This ticket is about demand `seq` puts its first argument under and
+-- how that affects call demands.
+module T18957 where
+
+-- | Should put its first argument under head demand
+seq' :: a -> b -> b
+seq' a b = seq a b
+{-# NOINLINE seq' #-}
+
+-- | The first argument is evaluated at once, but called every time it's
+-- evaluated
+g :: (Int -> Int) -> Int -> Int
+g f x = if x < 100 then f x else 200
+
+-- | The first argument is evaluated multiple times, but called at most once
+-- every time it's evaluated
+h1 :: (Int -> Int) -> Int -> Int
+-- Note that seq' is like seq, but NOINLINE. See h2 below why
+h1 f x = f `seq'` if x < 100 then f x else 200
+
+-- | Like h1, but using `seq` directly, which will rewrite the call site
+-- of @f@ to use the case binder instead, which means we won't evaluate it an
+-- additional time. So evaluated once and called once.
+h2 :: (Int -> Int) -> Int -> Int
+h2 f x = f `seq` if x < 100 then f x else 200
+
+h3 :: (Int -> Int) -> Int -> Int
+h3 f x = if x < 100 then f x + f (x+1) else 200
diff --git a/testsuite/tests/stranal/sigs/T18957.stderr b/testsuite/tests/stranal/sigs/T18957.stderr
new file mode 100644
index 0000000000..c536410e0a
--- /dev/null
+++ b/testsuite/tests/stranal/sigs/T18957.stderr
@@ -0,0 +1,30 @@
+
+==================== Strictness signatures ====================
+T18957.$trModule:
+T18957.g: <1C1(U)><SP(U)>
+T18957.h1: <MC1(U)><SP(U)>
+T18957.h2: <SC1(U)><SP(U)>
+T18957.h3: <UCU(P(U))><SP(U)>
+T18957.seq': <SA><SU>
+
+
+
+==================== Cpr signatures ====================
+T18957.$trModule:
+T18957.g:
+T18957.h1:
+T18957.h2:
+T18957.h3: m1
+T18957.seq':
+
+
+
+==================== Strictness signatures ====================
+T18957.$trModule:
+T18957.g: <1C1(U)><SP(U)>
+T18957.h1: <MC1(U)><SP(U)>
+T18957.h2: <SC1(U)><SP(U)>
+T18957.h3: <UCU(P(U))><SP(U)>
+T18957.seq': <SA><SU>
+
+
diff --git a/testsuite/tests/stranal/sigs/T5075.stderr b/testsuite/tests/stranal/sigs/T5075.stderr
index e048ce2fb3..64a78d05ec 100644
--- a/testsuite/tests/stranal/sigs/T5075.stderr
+++ b/testsuite/tests/stranal/sigs/T5075.stderr
@@ -1,7 +1,7 @@
 
 ==================== Strictness signatures ====================
 T5075.$trModule:
-T5075.loop: <S(LLC(C(S))LLLLL),U(A,A,C(C1(U)),A,A,A,A,A)><L,U(A,A,C(C1(U)),A,A,A,C(U))><L,U>
+T5075.loop: <MP(A,A,MCM(CS(U)),A,A,A,A,A)><UP(A,A,UCU(CS(U)),A,A,A,UCU(U))><U>
 
 
 
@@ -13,6 +13,6 @@ T5075.loop:
 
 ==================== Strictness signatures ====================
 T5075.$trModule:
-T5075.loop: <S(LLC(C(S))LLLLL),1*U(A,A,C(C1(U)),A,A,A,A,A)><L,U(A,A,C(C1(U)),A,A,A,C(U))><L,U>
+T5075.loop: <SP(A,A,MCM(CS(U)),A,A,A,A,A)><UP(A,A,UCU(CS(U)),A,A,A,UCU(U))><U>
 
 
diff --git a/testsuite/tests/stranal/sigs/T8569.stderr b/testsuite/tests/stranal/sigs/T8569.stderr
index bfbd22e52e..cc7a5e9fb0 100644
--- a/testsuite/tests/stranal/sigs/T8569.stderr
+++ b/testsuite/tests/stranal/sigs/T8569.stderr
@@ -4,7 +4,7 @@ T8569.$tc'Rdata:
 T8569.$tc'Rint:
 T8569.$tcRep:
 T8569.$trModule:
-T8569.addUp: <S,1*U><L,U>
+T8569.addUp: <SU><U>
 
 
 
@@ -22,6 +22,6 @@ T8569.$tc'Rdata:
 T8569.$tc'Rint:
 T8569.$tcRep:
 T8569.$trModule:
-T8569.addUp: <S,1*U><L,U>
+T8569.addUp: <SU><U>
 
 
diff --git a/testsuite/tests/stranal/sigs/T8598.stderr b/testsuite/tests/stranal/sigs/T8598.stderr
index 8c56089bcd..7e68094018 100644
--- a/testsuite/tests/stranal/sigs/T8598.stderr
+++ b/testsuite/tests/stranal/sigs/T8598.stderr
@@ -1,7 +1,7 @@
 
 ==================== Strictness signatures ====================
 T8598.$trModule:
-T8598.fun: <S,1*U(U)>
+T8598.fun: <SP(U)>
 
 
 
@@ -13,6 +13,6 @@ T8598.fun: m1
 
 ==================== Strictness signatures ====================
 T8598.$trModule:
-T8598.fun: <S,1*U(U)>
+T8598.fun: <SP(U)>
 
 
diff --git a/testsuite/tests/stranal/sigs/UnsatFun.hs b/testsuite/tests/stranal/sigs/UnsatFun.hs
index c38c5cba1d..e9587245d1 100644
--- a/testsuite/tests/stranal/sigs/UnsatFun.hs
+++ b/testsuite/tests/stranal/sigs/UnsatFun.hs
@@ -35,6 +35,7 @@ h3 f = f 2 `seq` 3
 
 
 -- And here we check that the depth of the strictness
--- of h is applied correctly.
+-- of h is applied correctly. The lambda is unsaturated
+-- and thus x is absent.
 g3 :: Int -> Int
 g3 x = h3 (\_ _ -> error (show x))
diff --git a/testsuite/tests/stranal/sigs/UnsatFun.stderr b/testsuite/tests/stranal/sigs/UnsatFun.stderr
index 325d25ced7..18723bad40 100644
--- a/testsuite/tests/stranal/sigs/UnsatFun.stderr
+++ b/testsuite/tests/stranal/sigs/UnsatFun.stderr
@@ -1,13 +1,13 @@
 
 ==================== Strictness signatures ====================
 UnsatFun.$trModule:
-UnsatFun.f: <B,1*U(U)><B,A>b
-UnsatFun.g: <B,1*U(U)>b
-UnsatFun.g': <L,1*U(U)>
-UnsatFun.g3: <L,U(U)>
-UnsatFun.h: <C(S),1*C1(U)>
-UnsatFun.h2: <S,1*U><L,1*C1(U)>
-UnsatFun.h3: <C(S),1*C1(U)>
+UnsatFun.f: <SP(M)><B>b
+UnsatFun.g: <SP(M)>b
+UnsatFun.g': <1P(U)>
+UnsatFun.g3: <A>
+UnsatFun.h: <SCS(U)>
+UnsatFun.h2: <SU><1C1(U)>
+UnsatFun.h3: <SCS(A)>
 
 
 
@@ -25,12 +25,12 @@ UnsatFun.h3: m1
 
 ==================== Strictness signatures ====================
 UnsatFun.$trModule:
-UnsatFun.f: <B,1*U(U)><B,A>b
-UnsatFun.g: <B,1*U(U)>b
-UnsatFun.g': <L,1*U(U)>
-UnsatFun.g3: <L,U(U)>
-UnsatFun.h: <C(S),1*C1(U)>
-UnsatFun.h2: <S,1*U><L,1*C1(U)>
-UnsatFun.h3: <C(S),1*C1(U)>
+UnsatFun.f: <SP(M)><B>b
+UnsatFun.g: <SP(M)>b
+UnsatFun.g': <1P(U)>
+UnsatFun.g3: <A>
+UnsatFun.h: <SCS(U)>
+UnsatFun.h2: <SU><1C1(U)>
+UnsatFun.h3: <SCS(A)>
 
 
diff --git a/testsuite/tests/stranal/sigs/all.T b/testsuite/tests/stranal/sigs/all.T
index 387a1a7f7d..07cc815823 100644
--- a/testsuite/tests/stranal/sigs/all.T
+++ b/testsuite/tests/stranal/sigs/all.T
@@ -23,3 +23,4 @@ test('T17932', normal, compile, [''])
 test('T13380c', expect_broken('!3014'), compile, [''])
 test('T13380f', normal, compile, [''])
 test('T18086', normal, compile, ['-package ghc'])
+test('T18957', normal, compile, [''])