From cdba10d1ca94e4581d318ced123b9851db434abd Mon Sep 17 00:00:00 2001 From: Sebastian Graf Date: Thu, 21 Oct 2021 17:17:45 +0200 Subject: 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. --- compiler/GHC/Core/Opt/WorkWrap/Utils.hs | 4 +++- testsuite/tests/cpranal/should_compile/T20539.hs | 7 +++++++ testsuite/tests/cpranal/should_compile/all.T | 2 +- 3 files changed, 11 insertions(+), 2 deletions(-) create mode 100644 testsuite/tests/cpranal/should_compile/T20539.hs 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 diff --git a/testsuite/tests/cpranal/should_compile/T20539.hs b/testsuite/tests/cpranal/should_compile/T20539.hs new file mode 100644 index 0000000000..a2943cf91e --- /dev/null +++ b/testsuite/tests/cpranal/should_compile/T20539.hs @@ -0,0 +1,7 @@ +module T20593 where + +newtype Measured a = Measured { unmeasure :: () -> a } +data Subdiagram = Subdiagram () (Measured ()) + +mkSubdiagram :: () -> Subdiagram +mkSubdiagram d = Subdiagram d (Measured (\_ -> ())) diff --git a/testsuite/tests/cpranal/should_compile/all.T b/testsuite/tests/cpranal/should_compile/all.T index 03d2b10d68..f33b43fe3a 100644 --- a/testsuite/tests/cpranal/should_compile/all.T +++ b/testsuite/tests/cpranal/should_compile/all.T @@ -21,4 +21,4 @@ test('T18401', [ grep_errmsg(r'^T18401\.\S+ ::') ], compile, ['-ddump-simpl -dsu # It won't match if the Cpr=1 is missing, which is what we're trying to assess. test('T18824', [ grep_errmsg(r'JoinId[^\n]*Cpr') ], compile, ['-ddump-exitify -dppr-cols=1000 -dsuppress-uniques']) - +test('T20539', [], compile, ['']) # simply should not crash -- cgit v1.2.1