diff options
author | Sebastian Graf <sebastian.graf@kit.edu> | 2022-10-01 13:53:55 +0200 |
---|---|---|
committer | Marge Bot <ben+marge-bot@smart-cactus.org> | 2022-10-17 11:58:46 -0400 |
commit | c1e5719aa500cb9e0f2549eb9b9e2255038ac35d (patch) | |
tree | ca4eb95fb48ef7ba98c9e85e68f61ae87fcc9552 /testsuite | |
parent | 4a4641ca2f2a157dab0fe2df5316f79ffb52c047 (diff) | |
download | haskell-c1e5719aa500cb9e0f2549eb9b9e2255038ac35d.tar.gz |
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.
Diffstat (limited to 'testsuite')
-rw-r--r-- | testsuite/tests/stranal/sigs/T22241.hs | 31 | ||||
-rw-r--r-- | testsuite/tests/stranal/sigs/T22241.stderr | 24 | ||||
-rw-r--r-- | testsuite/tests/stranal/sigs/all.T | 1 |
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, ['']) |