diff options
| author | Sebastian Graf <sebastian.graf@kit.edu> | 2021-10-21 17:17:45 +0200 |
|---|---|---|
| committer | Marge Bot <ben+marge-bot@smart-cactus.org> | 2021-10-22 19:22:31 -0400 |
| commit | dd2dba808aaa957c3d036b0025b412c499aace3d (patch) | |
| tree | 8ecf5f2a4b9b946ea878786ab101e668aedcfa19 /compiler/GHC/Core/Opt/WorkWrap/Utils.hs | |
| parent | 621608c990d01dd35cb2c4fb8fc49089bef81d57 (diff) | |
| download | haskell-dd2dba808aaa957c3d036b0025b412c499aace3d.tar.gz | |
WorkWrap: `isRecDataCon` should not eta-reduce NewTyCon field tys (#20539)
In #20539 we had a type
```hs
newtype Measured a = Measured { unmeasure :: () -> a }
```
and `isRecDataCon Measured` recursed into `go_arg_ty` for `(->) ()`, because
`unwrapNewTyConEtad_maybe` eta-reduced it. That triggered an assertion error a
bit later. Eta reducing the field type is completely wrong to do here! Just call
`unwrapNewTyCon_maybe` instead.
Fixes #20539 and adds a regression test T20539.
Diffstat (limited to 'compiler/GHC/Core/Opt/WorkWrap/Utils.hs')
| -rw-r--r-- | compiler/GHC/Core/Opt/WorkWrap/Utils.hs | 4 |
1 files changed, 3 insertions, 1 deletions
diff --git a/compiler/GHC/Core/Opt/WorkWrap/Utils.hs b/compiler/GHC/Core/Opt/WorkWrap/Utils.hs index df3608fe7d..38c103d866 100644 --- a/compiler/GHC/Core/Opt/WorkWrap/Utils.hs +++ b/compiler/GHC/Core/Opt/WorkWrap/Utils.hs @@ -1333,6 +1333,8 @@ isRecDataCon fam_envs fuel dc go_arg_ty :: IntWithInf -> RecTcChecker -> Type -> IsRecDataConResult go_arg_ty fuel rec_tc ty + --- | pprTrace "arg_ty" (ppr ty) False = undefined + | Just (_, _arg_ty, _res_ty) <- splitFunTy_maybe ty -- = go_arg_ty fuel rec_tc _arg_ty <||> go_arg_ty fuel rec_tc _res_ty -- Plausible, but unnecessary for CPR. @@ -1382,7 +1384,7 @@ isRecDataCon fam_envs fuel dc -- we expanded this TyCon once already, no need to test it multiple times Just rec_tc' - | Just (_tvs, rhs, _co) <- unwrapNewTyConEtad_maybe tc + | Just (_tvs, rhs, _co) <- unwrapNewTyCon_maybe tc -- See Note [Detecting recursive data constructors], points (2) and (3) -> go_arg_ty fuel rec_tc' rhs |