DmdAnal: Look through unfoldings of DataCon wrappers (#22241)

Previously, the demand signature we computed upfront for a DataCon wrapper

lacked boxity information and was much less precise than the demand transformer

for the DataCon worker.

In this patch we adopt the solution to look through unfoldings of DataCon

wrappers during Demand Analysis, but still attach a demand signature for other

passes such as the Simplifier.

See `Note [DmdAnal for DataCon wrappers]` for more details.

Fixes #22241.

3 files changed, 56 insertions, 0 deletions

diff --git a/testsuite/tests/stranal/sigs/T22241.hs b/testsuite/tests/stranal/sigs/T22241.hs
new file mode 100644
index 0000000000..21bf7b1d6b
--- /dev/null
+++ b/testsuite/tests/stranal/sigs/T22241.hs
@@ -0,0 +1,31 @@
+module T22241 where
+
+data D = D { unD :: !Int }
+
+-- We should unbox y here, which only happens if DmdAnal sees that $WD will
+-- unbox it.
+f :: Bool -> Int -> D
+f x y = D (go x)
+  where
+    go False = y
+    go True  = go False
+{-# NOINLINE f #-}
+
+
+
+data T a = T Int !a
+get (T _ x) = x
+
+-- Here, the goal is to discard `unD (f True z)` and thus `z` as absent by
+-- looking through $WT in `j` *during the first pass of DmdAnal*!
+g :: Bool -> Int -> Int -> Bool
+g x y z | even y    = get (fst t)
+        | y > 13    = not (get (fst t))
+        | otherwise = False
+  where
+    t | x         = j (unD (f True z))
+      | otherwise = j (unD (f False z))
+      where
+        j a = (T a x, True)
+        {-# NOINLINE j #-}
+{-# NOINLINE g #-}
diff --git a/testsuite/tests/stranal/sigs/T22241.stderr b/testsuite/tests/stranal/sigs/T22241.stderr
new file mode 100644
index 0000000000..284fe2cf76
--- /dev/null
+++ b/testsuite/tests/stranal/sigs/T22241.stderr
@@ -0,0 +1,24 @@
+
+==================== Strictness signatures ====================
+T22241.f: <1L><S!P(L)>
+T22241.g: <L><1!P(L)><A>
+T22241.get: <1!P(A,1L)>
+T22241.unD: <1!P(L)>
+
+
+
+==================== Cpr signatures ====================
+T22241.f: 1
+T22241.g:
+T22241.get:
+T22241.unD: 1
+
+
+
+==================== Strictness signatures ====================
+T22241.f: <1L><1!P(SL)>
+T22241.g: <ML><1!P(L)><A>
+T22241.get: <1!P(A,1L)>
+T22241.unD: <1!P(L)>
+
+
diff --git a/testsuite/tests/stranal/sigs/all.T b/testsuite/tests/stranal/sigs/all.T
index 73ecf7be57..01ea48cfe8 100644
--- a/testsuite/tests/stranal/sigs/all.T
+++ b/testsuite/tests/stranal/sigs/all.T
@@ -37,3 +37,4 @@ test('T21717', normal, compile, [''])
 test('T21754', normal, compile, [''])
 test('T21888', normal, compile, [''])
 test('T21888a', normal, compile, [''])
+test('T22241', normal, compile, [''])