diff options
| author | Matthew Pickering <matthewtpickering@gmail.com> | 2023-03-29 11:48:25 +0100 |
|---|---|---|
| committer | Matthew Pickering <matthewtpickering@gmail.com> | 2023-03-29 11:48:25 +0100 |
| commit | d2dee3f82dcfdfc49cfb708222bb78aea0713cd6 (patch) | |
| tree | 3b3a5d03e29ab9bd39a036a086f4b6dcda3d1805 | |
| parent | d97354a82b6f79c4d9a4d389fafdd94375454f59 (diff) | |
| download | haskell-wip/23184-9.4.tar.gz | |
Backport fix to #23184 to 9.4wip/23184-9.4
This backports the fix suggested in #23184 to GHC-9.4
It is from the larger patch (!7861):
```
commit 6656f0165a30fc2a22208532ba384fc8e2f11b46
Author: Simon Peyton Jones <simonpj@microsoft.com>
Date: Fri Jul 23 23:57:01 2021 +0100
A bunch of changes related to eta reduction
This is a large collection of changes all relating to eta
reduction, originally triggered by #18993, but there followed
a long saga.
Specifics:
...lots of lines omitted...
Other incidental changes
* Fix a fairly long-standing outright bug in the ApplyToVal case of
GHC.Core.Opt.Simplify.mkDupableContWithDmds. I was failing to take the
tail of 'dmds' in the recursive call, which meant the demands were All
Wrong. I have no idea why this has not caused problems before now.
```
| -rw-r--r-- | compiler/GHC/Core/Opt/Simplify.hs | 4 |
1 files changed, 2 insertions, 2 deletions
diff --git a/compiler/GHC/Core/Opt/Simplify.hs b/compiler/GHC/Core/Opt/Simplify.hs index a4c3bf239b..978eaf87ac 100644 --- a/compiler/GHC/Core/Opt/Simplify.hs +++ b/compiler/GHC/Core/Opt/Simplify.hs @@ -3557,8 +3557,8 @@ mkDupableContWithDmds env dmds -- let a = ...arg... -- in [...hole...] a -- NB: sc_dup /= OkToDup; that is caught earlier by contIsDupable - do { let (dmd:_) = dmds -- Never fails - ; (floats1, cont') <- mkDupableContWithDmds env dmds cont + do { let (dmd:cont_dmds) = dmds -- Never fails + ; (floats1, cont') <- mkDupableContWithDmds env cont_dmds cont ; let env' = env `setInScopeFromF` floats1 ; (_, se', arg') <- simplArg env' dup se arg ; (let_floats2, arg'') <- makeTrivial env NotTopLevel dmd (fsLit "karg") arg' |