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

23 files changed, 267 insertions, 76 deletions

diff --git a/testsuite/tests/stranal/should_compile/T10694.stderr b/testsuite/tests/stranal/should_compile/T10694.stderr
index df5bd122d0..45060226c1 100644
--- a/testsuite/tests/stranal/should_compile/T10694.stderr
+++ b/testsuite/tests/stranal/should_compile/T10694.stderr
@@ -4,7 +4,7 @@ Result size of Tidy Core = {terms: 74, types: 65, coercions: 0, joins: 0/4}
 
 -- RHS size: {terms: 39, types: 25, coercions: 0, joins: 0/4}
 T10694.$wpm [InlPrag=NOINLINE] :: Int -> Int -> (# Int, Int #)
-[GblId, Arity=2, Str=<L,U(U)><L,U(U)>, Unf=OtherCon []]
+[GblId, Arity=2, Str=<UP(U)><UP(U)>, Unf=OtherCon []]
 T10694.$wpm
   = \ (w :: Int) (w1 :: Int) ->
       let {
@@ -26,25 +26,25 @@ T10694.$wpm
       (# GHC.List.$w!! @Int l3 0#, GHC.List.$w!! @Int l3 1# #)
 
 -- RHS size: {terms: 10, types: 11, coercions: 0, joins: 0/0}
-pm [InlPrag=NOUSERINLINE[0]] :: Int -> Int -> (Int, Int)
+pm [InlPrag=[final]] :: Int -> Int -> (Int, Int)
 [GblId,
  Arity=2,
- Str=<L,U(U)><L,U(U)>,
+ Str=<UP(U)><UP(U)>,
  Cpr=m1,
  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) ->
-                 case T10694.$wpm w w1 of { (# ww1 [Occ=Once], ww2 [Occ=Once] #) -> (ww1, ww2) }}]
+         Tmpl= \ (w [Occ=Once1] :: Int) (w1 [Occ=Once1] :: Int) ->
+                 case T10694.$wpm w w1 of { (# ww1 [Occ=Once1], ww2 [Occ=Once1] #) -> (ww1, ww2) }}]
 pm = \ (w :: Int) (w1 :: Int) -> case T10694.$wpm w w1 of { (# ww1, ww2 #) -> (ww1, ww2) }
 
 -- RHS size: {terms: 8, types: 9, coercions: 0, joins: 0/0}
 m :: Int -> Int -> Int
 [GblId,
  Arity=2,
- Str=<L,U(U)><L,U(U)>,
+ Str=<UP(U)><UP(U)>,
  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= \ (x [Occ=Once] :: Int) (y [Occ=Once] :: Int) -> case pm x y of { (_ [Occ=Dead], mr [Occ=Once]) -> mr }}]
+         Tmpl= \ (x [Occ=Once1] :: Int) (y [Occ=Once1] :: Int) -> case pm x y of { (_ [Occ=Dead], mr [Occ=Once1]) -> mr }}]
 m = \ (x :: Int) (y :: Int) -> case T10694.$wpm x y of { (# ww1, ww2 #) -> ww2 }
 
 -- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0}
@@ -54,7 +54,7 @@ T10694.$trModule4 = "main"#
 
 -- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0}
 T10694.$trModule3 :: GHC.Types.TrName
-[GblId, Unf=Unf{Src=<vanilla>, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 20}]
+[GblId, Unf=Unf{Src=<vanilla>, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 10}]
 T10694.$trModule3 = GHC.Types.TrNameS T10694.$trModule4
 
 -- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0}
@@ -64,12 +64,12 @@ T10694.$trModule2 = "T10694"#
 
 -- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0}
 T10694.$trModule1 :: GHC.Types.TrName
-[GblId, Unf=Unf{Src=<vanilla>, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 20}]
+[GblId, Unf=Unf{Src=<vanilla>, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 10}]
 T10694.$trModule1 = GHC.Types.TrNameS T10694.$trModule2
 
 -- RHS size: {terms: 3, types: 0, coercions: 0, joins: 0/0}
 T10694.$trModule :: GHC.Types.Module
-[GblId, Unf=Unf{Src=<vanilla>, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 30}]
+[GblId, Unf=Unf{Src=<vanilla>, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 10}]
 T10694.$trModule = GHC.Types.Module T10694.$trModule3 T10694.$trModule1
 
 
diff --git a/testsuite/tests/stranal/should_compile/T13031.stdout b/testsuite/tests/stranal/should_compile/T13031.stdout
index c42eecb616..0b40ec8eeb 100644
--- a/testsuite/tests/stranal/should_compile/T13031.stdout
+++ b/testsuite/tests/stranal/should_compile/T13031.stdout
@@ -1,2 +1,2 @@
 hello
-[GblId, Arity=3, Str=<L,U><L,U><L,U>b, Cpr=b, Unf=OtherCon []]
+[GblId, Arity=3, Str=<U><U><U>b, Cpr=b, Unf=OtherCon []]
diff --git a/testsuite/tests/stranal/should_compile/T18903.hs b/testsuite/tests/stranal/should_compile/T18903.hs
new file mode 100644
index 0000000000..e88a0eea8b
--- /dev/null
+++ b/testsuite/tests/stranal/should_compile/T18903.hs
@@ -0,0 +1,16 @@
+{-# OPTIONS_GHC -O2 -fforce-recomp #-}
+
+-- | The point of this test is that @g@ get's a demand that says "whenever @g@
+-- is called, the second component of the pair is evaluated strictly".
+module T18903 where
+
+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)
diff --git a/testsuite/tests/stranal/should_compile/T18903.stderr b/testsuite/tests/stranal/should_compile/T18903.stderr
new file mode 100644
index 0000000000..4adbdd566c
--- /dev/null
+++ b/testsuite/tests/stranal/should_compile/T18903.stderr
@@ -0,0 +1,109 @@
+
+==================== Tidy Core ====================
+Result size of Tidy Core
+  = {terms: 84, types: 55, coercions: 0, joins: 0/1}
+
+-- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0}
+T18903.$trModule4 :: GHC.Prim.Addr#
+[GblId,
+ Unf=Unf{Src=<vanilla>, TopLvl=True, Value=True, ConLike=True,
+         WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 20 0}]
+T18903.$trModule4 = "main"#
+
+-- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0}
+T18903.$trModule3 :: GHC.Types.TrName
+[GblId,
+ Unf=Unf{Src=<vanilla>, TopLvl=True, Value=True, ConLike=True,
+         WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 10}]
+T18903.$trModule3 = GHC.Types.TrNameS T18903.$trModule4
+
+-- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0}
+T18903.$trModule2 :: GHC.Prim.Addr#
+[GblId,
+ Unf=Unf{Src=<vanilla>, TopLvl=True, Value=True, ConLike=True,
+         WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 30 0}]
+T18903.$trModule2 = "T18903"#
+
+-- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0}
+T18903.$trModule1 :: GHC.Types.TrName
+[GblId,
+ Unf=Unf{Src=<vanilla>, TopLvl=True, Value=True, ConLike=True,
+         WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 10}]
+T18903.$trModule1 = GHC.Types.TrNameS T18903.$trModule2
+
+-- RHS size: {terms: 3, types: 0, coercions: 0, joins: 0/0}
+T18903.$trModule :: GHC.Types.Module
+[GblId,
+ Unf=Unf{Src=<vanilla>, TopLvl=True, Value=True, ConLike=True,
+         WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 10}]
+T18903.$trModule
+  = GHC.Types.Module T18903.$trModule3 T18903.$trModule1
+
+-- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0}
+T18903.h1 :: Int
+[GblId,
+ Unf=Unf{Src=<vanilla>, TopLvl=True, Value=True, ConLike=True,
+         WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 10}]
+T18903.h1 = GHC.Types.I# 0#
+
+-- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0}
+T18903.h2 :: Int
+[GblId,
+ Unf=Unf{Src=<vanilla>, TopLvl=True, Value=True, ConLike=True,
+         WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 10}]
+T18903.h2 = GHC.Types.I# -2#
+
+-- RHS size: {terms: 56, types: 41, coercions: 0, joins: 0/1}
+T18903.$wh [InlPrag=[2]] :: GHC.Prim.Int# -> Int
+[GblId,
+ Arity=1,
+ Str=<MU>,
+ Unf=Unf{Src=<vanilla>, TopLvl=True, Value=True, ConLike=True,
+         WorkFree=True, Expandable=True, Guidance=IF_ARGS [70] 262 10}]
+T18903.$wh
+  = \ (ww :: GHC.Prim.Int#) ->
+      let {
+        $wg [InlPrag=NOINLINE, Dmd=1C1(P(1P(U),SP(U)))]
+          :: GHC.Prim.Int# -> (# Int, Int #)
+        [LclId, Arity=1, Str=<SU>, Unf=OtherCon []]
+        $wg
+          = \ (ww1 [OS=OneShot] :: GHC.Prim.Int#) ->
+              case ww1 of ds {
+                __DEFAULT ->
+                  (# GHC.Types.I# (GHC.Prim.*# 2# ds),
+                     case ds of {
+                       __DEFAULT ->
+                         case GHC.Classes.divInt# 2# ds of ww4 { __DEFAULT ->
+                         GHC.Types.I# ww4
+                         };
+                       -1# -> T18903.h2;
+                       0# -> case GHC.Real.divZeroError of wild1 { }
+                     } #);
+                1# -> (# GHC.Types.I# ww, T18903.h1 #)
+              } } in
+      case ww of ds {
+        __DEFAULT ->
+          case $wg ds of { (# ww2, ww3 #) ->
+          case ww2 of { GHC.Types.I# x ->
+          case ww3 of { GHC.Types.I# y -> GHC.Types.I# (GHC.Prim.+# x y) }
+          }
+          };
+        1# -> T18903.h1;
+        2# -> case $wg 2# of { (# ww2, ww3 #) -> ww3 }
+      }
+
+-- RHS size: {terms: 6, types: 3, coercions: 0, joins: 0/0}
+h [InlPrag=[2]] :: Int -> Int
+[GblId,
+ Arity=1,
+ Str=<SP(MU)>,
+ 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=Once1!] :: Int) ->
+                 case w of { GHC.Types.I# ww1 [Occ=Once1] -> T18903.$wh ww1 }}]
+h = \ (w :: Int) ->
+      case w of { GHC.Types.I# ww1 -> T18903.$wh ww1 }
+
+
+
diff --git a/testsuite/tests/stranal/should_compile/all.T b/testsuite/tests/stranal/should_compile/all.T
index bb3fcd2952..1262ad426e 100644
--- a/testsuite/tests/stranal/should_compile/all.T
+++ b/testsuite/tests/stranal/should_compile/all.T
@@ -55,3 +55,6 @@ test('T13380b',  [ grep_errmsg('bigDeadAction') ], compile, ['-dppr-cols=200 -dd
 
 # We just want to find the worker of foo in there:
 test('T18122',  [ grep_errmsg(r'wfoo =') ], compile, ['-ddump-simpl'])
+
+# We care about the call demand on $wg
+test('T18903',  [ grep_errmsg(r'Dmd=\S+C\S+') ], compile, ['-ddump-simpl -dsuppress-uniques'])
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, [''])