From f0ec06c76ccd6797d42736fd423adbbb238723b4 Mon Sep 17 00:00:00 2001 From: Sebastian Graf Date: Mon, 30 Nov 2020 17:08:40 +0100 Subject: WorkWrap: Unbox constructors with existentials (#18982) Consider ```hs data Ex where Ex :: e -> Int -> Ex f :: Ex -> Int f (Ex e n) = e `seq` n + 1 ``` Worker/wrapper should build the following worker for `f`: ```hs $wf :: forall e. e -> Int# -> Int# $wf e n = e `seq` n +# 1# ``` But previously it didn't, because `Ex` binds an existential. This patch lifts that condition. That entailed having to instantiate existential binders in `GHC.Core.Opt.WorkWrap.Utils.mkWWstr` via `GHC.Core.Utils.dataConRepFSInstPat`, requiring a bit of a refactoring around what is now `DataConPatContext`. CPR W/W still won't unbox DataCons with existentials. See `Note [Which types are unboxed?]` for details. I also refactored the various `tyCon*DataCon(s)_maybe` functions in `GHC.Core.TyCon`, deleting some of them which are no longer needed (`isDataProductType_maybe` and `isDataSumType_maybe`). I cleaned up a couple of call sites, some of which weren't very explicit about whether they cared for existentials or not. The test output of `T18013` changed, because we now unbox the `Rule` data type. Its constructor carries existential state and will be w/w'd now. In the particular example, the worker functions inlines right back into the wrapper, which then unnecessarily has a (quite big) stable unfolding. I think this kind of fallout is inevitable; see also Note [Don't w/w inline small non-loop-breaker things]. There's a new regression test case `T18982`. Fixes #18982. --- testsuite/tests/stranal/should_compile/T18982.hs | 41 ++++ .../tests/stranal/should_compile/T18982.stderr | 246 +++++++++++++++++++++ testsuite/tests/stranal/should_compile/all.T | 2 + 3 files changed, 289 insertions(+) create mode 100644 testsuite/tests/stranal/should_compile/T18982.hs create mode 100644 testsuite/tests/stranal/should_compile/T18982.stderr (limited to 'testsuite/tests/stranal') diff --git a/testsuite/tests/stranal/should_compile/T18982.hs b/testsuite/tests/stranal/should_compile/T18982.hs new file mode 100644 index 0000000000..e451d6bb76 --- /dev/null +++ b/testsuite/tests/stranal/should_compile/T18982.hs @@ -0,0 +1,41 @@ +{-# OPTIONS_GHC -O -fforce-recomp #-} +{-# LANGUAGE GADTs #-} + +module T18982 where + +data Box a where + Box :: a -> Box a + +data Ex a where + Ex :: e -> a -> Ex a + +data GADT a where + GADT :: Int -> GADT Int + +data ExGADT a where + ExGADT :: (e ~ Int) => e -> Int -> ExGADT Int + +-- | Expected worker type: +-- $wf :: Int# -> Int# +f :: Box Int -> Int +f (Box n) = n + 1 +{-# NOINLINE f #-} + +-- | Expected worker type: +-- $wg :: forall {e}. e -> Int# -> Int# +g :: Ex Int -> Int +g (Ex e n) = e `seq` n + 1 +{-# NOINLINE g #-} + +-- | Expected worker type: +-- $wh :: Int# -> Int# +h :: GADT a -> Int +h (GADT n) = n + 1 +{-# NOINLINE h #-} + +-- | Expected worker type: +-- $wi :: forall {e}. e -> Int# -> Int# +i :: ExGADT a -> Int +i (ExGADT e n) = e `seq` n + 1 +{-# NOINLINE i #-} + diff --git a/testsuite/tests/stranal/should_compile/T18982.stderr b/testsuite/tests/stranal/should_compile/T18982.stderr new file mode 100644 index 0000000000..3e6074e759 --- /dev/null +++ b/testsuite/tests/stranal/should_compile/T18982.stderr @@ -0,0 +1,246 @@ + +==================== Tidy Core ==================== +Result size of Tidy Core = {terms: 311, types: 249, coercions: 4, joins: 0/0} + +-- RHS size: {terms: 8, types: 11, coercions: 1, joins: 0/0} +T18982.$WExGADT :: forall e. (e ~ Int) => e %1 -> Int %1 -> ExGADT Int +T18982.$WExGADT = \ (@e) (dt :: e ~ Int) (dt :: e) (dt :: Int) -> T18982.ExGADT @Int @e @~(_N :: Int GHC.Prim.~# Int) dt dt dt + +-- RHS size: {terms: 3, types: 2, coercions: 1, joins: 0/0} +T18982.$WGADT :: Int %1 -> GADT Int +T18982.$WGADT = \ (dt :: Int) -> T18982.GADT @Int @~(_N :: Int GHC.Prim.~# Int) dt + +-- RHS size: {terms: 7, types: 8, coercions: 0, joins: 0/0} +T18982.$WEx :: forall e a. e %1 -> a %1 -> Ex a +T18982.$WEx = \ (@e) (@a) (dt :: e) (dt :: a) -> T18982.Ex @a @e dt dt + +-- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0} +T18982.$trModule4 :: GHC.Prim.Addr# +T18982.$trModule4 = "main"# + +-- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} +T18982.$trModule3 :: GHC.Types.TrName +T18982.$trModule3 = GHC.Types.TrNameS T18982.$trModule4 + +-- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0} +T18982.$trModule2 :: GHC.Prim.Addr# +T18982.$trModule2 = "T18982"# + +-- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} +T18982.$trModule1 :: GHC.Types.TrName +T18982.$trModule1 = GHC.Types.TrNameS T18982.$trModule2 + +-- RHS size: {terms: 3, types: 0, coercions: 0, joins: 0/0} +T18982.$trModule :: GHC.Types.Module +T18982.$trModule = GHC.Types.Module T18982.$trModule3 T18982.$trModule1 + +-- RHS size: {terms: 3, types: 1, coercions: 0, joins: 0/0} +$krep :: GHC.Types.KindRep +$krep = GHC.Types.KindRepTyConApp GHC.Types.$tcInt (GHC.Types.[] @GHC.Types.KindRep) + +-- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} +$krep1 :: GHC.Types.KindRep +$krep1 = GHC.Types.KindRepVar 1# + +-- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} +$krep2 :: GHC.Types.KindRep +$krep2 = GHC.Types.KindRepVar 0# + +-- RHS size: {terms: 3, types: 2, coercions: 0, joins: 0/0} +$krep3 :: [GHC.Types.KindRep] +$krep3 = GHC.Types.: @GHC.Types.KindRep $krep (GHC.Types.[] @GHC.Types.KindRep) + +-- RHS size: {terms: 3, types: 1, coercions: 0, joins: 0/0} +$krep4 :: [GHC.Types.KindRep] +$krep4 = GHC.Types.: @GHC.Types.KindRep $krep2 $krep3 + +-- RHS size: {terms: 3, types: 1, coercions: 0, joins: 0/0} +$krep5 :: [GHC.Types.KindRep] +$krep5 = GHC.Types.: @GHC.Types.KindRep GHC.Types.krep$* $krep4 + +-- RHS size: {terms: 3, types: 0, coercions: 0, joins: 0/0} +$krep6 :: GHC.Types.KindRep +$krep6 = GHC.Types.KindRepTyConApp GHC.Types.$tc~ $krep5 + +-- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0} +T18982.$tcBox2 :: GHC.Prim.Addr# +T18982.$tcBox2 = "Box"# + +-- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} +T18982.$tcBox1 :: GHC.Types.TrName +T18982.$tcBox1 = GHC.Types.TrNameS T18982.$tcBox2 + +-- RHS size: {terms: 7, types: 0, coercions: 0, joins: 0/0} +T18982.$tcBox :: GHC.Types.TyCon +T18982.$tcBox = GHC.Types.TyCon 16948648223906549518## 2491460178135962649## T18982.$trModule T18982.$tcBox1 0# GHC.Types.krep$*Arr* + +-- RHS size: {terms: 3, types: 2, coercions: 0, joins: 0/0} +$krep7 :: [GHC.Types.KindRep] +$krep7 = GHC.Types.: @GHC.Types.KindRep $krep2 (GHC.Types.[] @GHC.Types.KindRep) + +-- RHS size: {terms: 3, types: 0, coercions: 0, joins: 0/0} +$krep8 :: GHC.Types.KindRep +$krep8 = GHC.Types.KindRepTyConApp T18982.$tcBox $krep7 + +-- RHS size: {terms: 3, types: 0, coercions: 0, joins: 0/0} +T18982.$tc'Box1 :: GHC.Types.KindRep +T18982.$tc'Box1 = GHC.Types.KindRepFun $krep2 $krep8 + +-- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0} +T18982.$tc'Box3 :: GHC.Prim.Addr# +T18982.$tc'Box3 = "'Box"# + +-- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} +T18982.$tc'Box2 :: GHC.Types.TrName +T18982.$tc'Box2 = GHC.Types.TrNameS T18982.$tc'Box3 + +-- RHS size: {terms: 7, types: 0, coercions: 0, joins: 0/0} +T18982.$tc'Box :: GHC.Types.TyCon +T18982.$tc'Box = GHC.Types.TyCon 1412068769125067428## 8727214667407894081## T18982.$trModule T18982.$tc'Box2 1# T18982.$tc'Box1 + +-- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0} +T18982.$tcEx2 :: GHC.Prim.Addr# +T18982.$tcEx2 = "Ex"# + +-- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} +T18982.$tcEx1 :: GHC.Types.TrName +T18982.$tcEx1 = GHC.Types.TrNameS T18982.$tcEx2 + +-- RHS size: {terms: 7, types: 0, coercions: 0, joins: 0/0} +T18982.$tcEx :: GHC.Types.TyCon +T18982.$tcEx = GHC.Types.TyCon 4376661818164435927## 18005417598910668817## T18982.$trModule T18982.$tcEx1 0# GHC.Types.krep$*Arr* + +-- RHS size: {terms: 3, types: 2, coercions: 0, joins: 0/0} +$krep9 :: [GHC.Types.KindRep] +$krep9 = GHC.Types.: @GHC.Types.KindRep $krep1 (GHC.Types.[] @GHC.Types.KindRep) + +-- RHS size: {terms: 3, types: 0, coercions: 0, joins: 0/0} +$krep10 :: GHC.Types.KindRep +$krep10 = GHC.Types.KindRepTyConApp T18982.$tcEx $krep9 + +-- RHS size: {terms: 3, types: 0, coercions: 0, joins: 0/0} +$krep11 :: GHC.Types.KindRep +$krep11 = GHC.Types.KindRepFun $krep1 $krep10 + +-- RHS size: {terms: 3, types: 0, coercions: 0, joins: 0/0} +T18982.$tc'Ex1 :: GHC.Types.KindRep +T18982.$tc'Ex1 = GHC.Types.KindRepFun $krep2 $krep11 + +-- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0} +T18982.$tc'Ex3 :: GHC.Prim.Addr# +T18982.$tc'Ex3 = "'Ex"# + +-- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} +T18982.$tc'Ex2 :: GHC.Types.TrName +T18982.$tc'Ex2 = GHC.Types.TrNameS T18982.$tc'Ex3 + +-- RHS size: {terms: 7, types: 0, coercions: 0, joins: 0/0} +T18982.$tc'Ex :: GHC.Types.TyCon +T18982.$tc'Ex = GHC.Types.TyCon 14609381081172201359## 3077219645053200509## T18982.$trModule T18982.$tc'Ex2 2# T18982.$tc'Ex1 + +-- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0} +T18982.$tcGADT2 :: GHC.Prim.Addr# +T18982.$tcGADT2 = "GADT"# + +-- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} +T18982.$tcGADT1 :: GHC.Types.TrName +T18982.$tcGADT1 = GHC.Types.TrNameS T18982.$tcGADT2 + +-- RHS size: {terms: 7, types: 0, coercions: 0, joins: 0/0} +T18982.$tcGADT :: GHC.Types.TyCon +T18982.$tcGADT = GHC.Types.TyCon 9243924476135839950## 5096619276488416461## T18982.$trModule T18982.$tcGADT1 0# GHC.Types.krep$*Arr* + +-- RHS size: {terms: 3, types: 0, coercions: 0, joins: 0/0} +$krep12 :: GHC.Types.KindRep +$krep12 = GHC.Types.KindRepTyConApp T18982.$tcGADT $krep3 + +-- RHS size: {terms: 3, types: 0, coercions: 0, joins: 0/0} +T18982.$tc'GADT1 :: GHC.Types.KindRep +T18982.$tc'GADT1 = GHC.Types.KindRepFun $krep $krep12 + +-- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0} +T18982.$tc'GADT3 :: GHC.Prim.Addr# +T18982.$tc'GADT3 = "'GADT"# + +-- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} +T18982.$tc'GADT2 :: GHC.Types.TrName +T18982.$tc'GADT2 = GHC.Types.TrNameS T18982.$tc'GADT3 + +-- RHS size: {terms: 7, types: 0, coercions: 0, joins: 0/0} +T18982.$tc'GADT :: GHC.Types.TyCon +T18982.$tc'GADT = GHC.Types.TyCon 2077850259354179864## 16731205864486799217## T18982.$trModule T18982.$tc'GADT2 0# T18982.$tc'GADT1 + +-- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0} +T18982.$tcExGADT2 :: GHC.Prim.Addr# +T18982.$tcExGADT2 = "ExGADT"# + +-- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} +T18982.$tcExGADT1 :: GHC.Types.TrName +T18982.$tcExGADT1 = GHC.Types.TrNameS T18982.$tcExGADT2 + +-- RHS size: {terms: 7, types: 0, coercions: 0, joins: 0/0} +T18982.$tcExGADT :: GHC.Types.TyCon +T18982.$tcExGADT = GHC.Types.TyCon 6470898418160489500## 10361108917441214060## T18982.$trModule T18982.$tcExGADT1 0# GHC.Types.krep$*Arr* + +-- RHS size: {terms: 3, types: 0, coercions: 0, joins: 0/0} +$krep13 :: GHC.Types.KindRep +$krep13 = GHC.Types.KindRepTyConApp T18982.$tcExGADT $krep3 + +-- RHS size: {terms: 3, types: 0, coercions: 0, joins: 0/0} +$krep14 :: GHC.Types.KindRep +$krep14 = GHC.Types.KindRepFun $krep $krep13 + +-- RHS size: {terms: 3, types: 0, coercions: 0, joins: 0/0} +$krep15 :: GHC.Types.KindRep +$krep15 = GHC.Types.KindRepFun $krep2 $krep14 + +-- RHS size: {terms: 3, types: 0, coercions: 0, joins: 0/0} +T18982.$tc'ExGADT1 :: GHC.Types.KindRep +T18982.$tc'ExGADT1 = GHC.Types.KindRepFun $krep6 $krep15 + +-- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0} +T18982.$tc'ExGADT3 :: GHC.Prim.Addr# +T18982.$tc'ExGADT3 = "'ExGADT"# + +-- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} +T18982.$tc'ExGADT2 :: GHC.Types.TrName +T18982.$tc'ExGADT2 = GHC.Types.TrNameS T18982.$tc'ExGADT3 + +-- RHS size: {terms: 7, types: 0, coercions: 0, joins: 0/0} +T18982.$tc'ExGADT :: GHC.Types.TyCon +T18982.$tc'ExGADT = GHC.Types.TyCon 8468257409157161049## 5503123603717080600## T18982.$trModule T18982.$tc'ExGADT2 1# T18982.$tc'ExGADT1 + +-- RHS size: {terms: 11, types: 14, coercions: 0, joins: 0/0} +T18982.$wi :: forall {a} {e}. (a GHC.Prim.~# Int) -> e -> GHC.Prim.Int# -> GHC.Prim.Int# +T18982.$wi = \ (@a) (@e) (ww :: a GHC.Prim.~# Int) (ww1 :: e) (ww2 :: GHC.Prim.Int#) -> case ww1 of { __DEFAULT -> GHC.Prim.+# ww2 1# } + +-- RHS size: {terms: 15, types: 27, coercions: 1, joins: 0/0} +i :: forall a. ExGADT a -> Int +i = \ (@a) (w :: ExGADT a) -> case w of { ExGADT @e ww1 ww2 ww3 ww4 -> case ww4 of { GHC.Types.I# ww6 -> case T18982.$wi @a @e @~(ww1 :: a GHC.Prim.~# Int) ww3 ww6 of ww7 { __DEFAULT -> GHC.Types.I# ww7 } } } + +-- RHS size: {terms: 6, types: 10, coercions: 0, joins: 0/0} +T18982.$wh :: forall {a}. (a GHC.Prim.~# Int) -> GHC.Prim.Int# -> GHC.Prim.Int# +T18982.$wh = \ (@a) (ww :: a GHC.Prim.~# Int) (ww1 :: GHC.Prim.Int#) -> GHC.Prim.+# ww1 1# + +-- RHS size: {terms: 14, types: 18, coercions: 1, joins: 0/0} +h :: forall a. GADT a -> Int +h = \ (@a) (w :: GADT a) -> case w of { GADT ww1 ww2 -> case ww2 of { GHC.Types.I# ww4 -> case T18982.$wh @a @~(ww1 :: a GHC.Prim.~# Int) ww4 of ww5 { __DEFAULT -> GHC.Types.I# ww5 } } } + +-- RHS size: {terms: 9, types: 5, coercions: 0, joins: 0/0} +T18982.$wg :: forall {e}. e -> GHC.Prim.Int# -> GHC.Prim.Int# +T18982.$wg = \ (@e) (ww :: e) (ww1 :: GHC.Prim.Int#) -> case ww of { __DEFAULT -> GHC.Prim.+# ww1 1# } + +-- RHS size: {terms: 14, types: 12, coercions: 0, joins: 0/0} +g :: Ex Int -> Int +g = \ (w :: Ex Int) -> case w of { Ex @e ww1 ww2 -> case ww2 of { GHC.Types.I# ww4 -> case T18982.$wg @e ww1 ww4 of ww5 { __DEFAULT -> GHC.Types.I# ww5 } } } + +-- RHS size: {terms: 4, types: 1, coercions: 0, joins: 0/0} +T18982.$wf :: GHC.Prim.Int# -> GHC.Prim.Int# +T18982.$wf = \ (ww :: GHC.Prim.Int#) -> GHC.Prim.+# ww 1# + +-- RHS size: {terms: 13, types: 8, coercions: 0, joins: 0/0} +f :: Box Int -> Int +f = \ (w :: Box Int) -> case w of { Box ww1 -> case ww1 of { GHC.Types.I# ww3 -> case T18982.$wf ww3 of ww4 { __DEFAULT -> GHC.Types.I# ww4 } } } + + + diff --git a/testsuite/tests/stranal/should_compile/all.T b/testsuite/tests/stranal/should_compile/all.T index c00d61b8c2..28c8154a77 100644 --- a/testsuite/tests/stranal/should_compile/all.T +++ b/testsuite/tests/stranal/should_compile/all.T @@ -62,3 +62,5 @@ test('T18903', [ grep_errmsg(r'Dmd=\S+C\S+') ], compile, ['-ddump-simpl -dsuppr test('T18894', [ grep_errmsg(r'Dmd=\S+C\S+') ], compile, ['-ddump-stranal -dsuppress-uniques']) # We care about the Arity 2 on eta, as a result of the annotated Dmd test('T18894b', [ grep_errmsg(r'Arity=2') ], compile, ['-ddump-stranal -dsuppress-uniques -fno-call-arity -dppr-cols=200']) +# We care about the workers of f,g,h,i: +test('T18982', [ grep_errmsg(r'\$w. .*Int#$') ], compile, ['-dppr-cols=1000 -ddump-simpl -dsuppress-idinfo -dsuppress-uniques']) -- cgit v1.2.1