From f0c1eb8b5640b0ec86b9fabb465ea5b841808d56 Mon Sep 17 00:00:00 2001
From: Ben Gamari <bgamari.foss@gmail.com>
Date: Thu, 31 May 2018 07:49:55 -0400
Subject: [PATCH] Conservatively estimate levity in worker/wrapper
The worker/wrapper transform needs to determine the levity of the result to
determine whether it needs to introduce a lambda to preserve laziness of the
result. For this is previously used isUnliftedType. However, this may fail in
the presence of levity polymorphism.
We now instead use isLiftedType_maybe, assuming that a lambda is needed if the
levity of the result cannot be determined.
Fixes #15186.
Test Plan: make test=T15186
Reviewers: simonpj, goldfire, tdammers
Reviewed By: simonpj
Subscribers: rwbarton, thomie, carter
GHC Trac Issues: #15186
Differential Revision: https://phabricator.haskell.org/D4755
---
compiler/stranal/WwLib.hs | 12 +++++++++++-
testsuite/tests/simplCore/should_compile/all.T | 2 +-
2 files changed, 12 insertions(+), 2 deletions(-)
diff --git a/compiler/stranal/WwLib.hs b/compiler/stranal/WwLib.hs
index ab0a4d1ee19b..040a6d7da97f 100644
--- a/compiler/stranal/WwLib.hs
+++ b/compiler/stranal/WwLib.hs
@@ -269,11 +269,21 @@ mkWorkerArgs dflags args res_ty
| otherwise
= (args ++ [voidArgId], args ++ [voidPrimId])
where
+ -- See "Making wrapper args" section above
needsAValueLambda =
- isUnliftedType res_ty
+ lifted
+ -- We may encounter a levity-polymorphic result, in which case we
+ -- conservatively assume that we have laziness that needs preservation.
+ -- See #15186.
|| not (gopt Opt_FunToThunk dflags)
-- see Note [Protecting the last value argument]
+ -- Might the result be lifted?
+ lifted =
+ case isLiftedType_maybe res_ty of
+ Just lifted -> lifted
+ Nothing -> True
+
{-
Note [Protecting the last value argument]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
diff --git a/testsuite/tests/simplCore/should_compile/all.T b/testsuite/tests/simplCore/should_compile/all.T
index a430521c89ff..5ad7dba94a16 100644
--- a/testsuite/tests/simplCore/should_compile/all.T
+++ b/testsuite/tests/simplCore/should_compile/all.T
@@ -315,4 +315,4 @@ test('T15002', [ req_profiling ], compile, ['-O -fprof-auto -prof'])
test('T15005', normal, compile, ['-O'])
# we omit profiling because it affects the optimiser and makes the test fail
test('T15056', [extra_files(['T15056a.hs']), omit_ways(['profasm'])], multimod_compile, ['T15056', '-O -v0 -ddump-rule-firings'])
-test('T15186', expect_broken(15186), multimod_compile, ['T15186', '-v0'])
+test('T15186', normal, multimod_compile, ['T15186', '-v0'])
--
GitLab