diff options
author | Ryan Scott <ryan.gl.scott@gmail.com> | 2020-06-16 07:41:07 -0400 |
---|---|---|
committer | Marge Bot <ben+marge-bot@smart-cactus.org> | 2020-06-27 11:55:21 -0400 |
commit | ce987865d7594ecbcb3d27435eef773e95b2db85 (patch) | |
tree | f3c7893f9c2987465943148bd398b02d0d2f20b0 /testsuite/tests/deriving | |
parent | 9ee58f8d900884ac8b721b6b95dbfa6500f39431 (diff) | |
download | haskell-ce987865d7594ecbcb3d27435eef773e95b2db85.tar.gz |
Revamp the treatment of auxiliary bindings for derived instances
This started as a simple fix for #18321 that organically grew into a
much more sweeping refactor of how auxiliary bindings for derived
instances are handled. I have rewritten `Note [Auxiliary binders]`
in `GHC.Tc.Deriv.Generate` to explain all of the moving parts, but
the highlights are:
* Previously, the OccName of each auxiliary binding would be given
a suffix containing a hash of its package name, module name, and
parent data type to avoid name clashes. This was needlessly
complicated, so we take the more direct approach of generating
`Exact` `RdrName`s for each auxiliary binding with the same
`OccName`, but using an underlying `System` `Name` with a fresh
`Unique` for each binding. Unlike hashes, allocating new `Unique`s
does not require any cleverness and avoid name clashes all the
same...
* ...speaking of which, in order to convince the renamer that multiple
auxiliary bindings with the same `OccName` (but different
`Unique`s) are kosher, we now use `rnLocalValBindsLHS` instead of
`rnTopBindsLHS` to rename auxiliary bindings. Again, see
`Note [Auxiliary binders]` for the full story.
* I have removed the `DerivHsBind` constructor for
`DerivStuff`—which was only used for `Data.Data`-related
auxiliary bindings—and refactored `gen_Data_binds` to use
`DerivAuxBind` instead. This brings the treatment of
`Data.Data`-related auxiliary bindings in line with every other
form of auxiliary binding.
Fixes #18321.
Diffstat (limited to 'testsuite/tests/deriving')
4 files changed, 72 insertions, 51 deletions
diff --git a/testsuite/tests/deriving/should_compile/T14682.stderr b/testsuite/tests/deriving/should_compile/T14682.stderr index 2bf9552ff9..e0c8b332ed 100644 --- a/testsuite/tests/deriving/should_compile/T14682.stderr +++ b/testsuite/tests/deriving/should_compile/T14682.stderr @@ -23,8 +23,8 @@ Derived class instances: Data.Data.gfoldl k z (T14682.Foo a1 a2) = ((z (\ a1 a2 -> T14682.Foo a1 a2) `k` a1) `k` a2) Data.Data.gunfold k z _ = k (k (z (\ a1 a2 -> T14682.Foo a1 a2))) - Data.Data.toConstr (T14682.Foo _ _) = T14682.$cFoo - Data.Data.dataTypeOf _ = T14682.$tFoo + Data.Data.toConstr (T14682.Foo _ _) = $cFoo + Data.Data.dataTypeOf _ = $tFoo instance GHC.Classes.Eq T14682.Foo where (GHC.Classes.==) (T14682.Foo a1 a2) (T14682.Foo b1 b2) @@ -71,14 +71,12 @@ Derived class instances: = (GHC.Ix.inRange (a1, b1) c1 GHC.Classes.&& GHC.Ix.inRange (a2, b2) c2) - T14682.$con2tag_B4iUvrAY4wB3YczpMJQUOX :: - T14682.Foo -> GHC.Prim.Int# - T14682.$con2tag_B4iUvrAY4wB3YczpMJQUOX (T14682.Foo _ _) = 0# - T14682.$tFoo :: Data.Data.DataType - T14682.$cFoo :: Data.Data.Constr - T14682.$tFoo = Data.Data.mkDataType "Foo" [T14682.$cFoo] - T14682.$cFoo - = Data.Data.mkConstr T14682.$tFoo "Foo" [] Data.Data.Prefix + $tFoo :: Data.Data.DataType + $cFoo :: Data.Data.Constr + $con2tag_Foo :: T14682.Foo -> GHC.Prim.Int# + $con2tag_Foo (T14682.Foo _ _) = 0# + $tFoo = Data.Data.mkDataType "Foo" [$cFoo] + $cFoo = Data.Data.mkConstr $tFoo "Foo" [] Data.Data.Prefix Derived type family instances: diff --git a/testsuite/tests/deriving/should_compile/T18321.hs b/testsuite/tests/deriving/should_compile/T18321.hs new file mode 100644 index 0000000000..5391cf602b --- /dev/null +++ b/testsuite/tests/deriving/should_compile/T18321.hs @@ -0,0 +1,15 @@ +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE StandaloneDeriving #-} +{-# LANGUAGE TemplateHaskell #-} +module T18321 where + +import Data.Ix + +data T = MkT deriving (Eq, Ord, Ix) +$(return []) +deriving instance Enum T + +data S a = MkS +deriving instance Enum (S Int) +$(return []) +deriving instance Enum (S Bool) diff --git a/testsuite/tests/deriving/should_compile/all.T b/testsuite/tests/deriving/should_compile/all.T index 8a363e72f9..f6e9d43b06 100644 --- a/testsuite/tests/deriving/should_compile/all.T +++ b/testsuite/tests/deriving/should_compile/all.T @@ -124,3 +124,4 @@ test('T17339', normal, compile, ['-ddump-simpl -dsuppress-idinfo -dno-typeable-binds']) test('T17880', normal, compile, ['']) test('T18055', normal, compile, ['']) +test('T18321', normal, compile, ['']) diff --git a/testsuite/tests/deriving/should_compile/drv-empty-data.stderr b/testsuite/tests/deriving/should_compile/drv-empty-data.stderr index d6e4eee4b0..cb6a89b226 100644 --- a/testsuite/tests/deriving/should_compile/drv-empty-data.stderr +++ b/testsuite/tests/deriving/should_compile/drv-empty-data.stderr @@ -20,7 +20,7 @@ Derived class instances: Data.Data.gfoldl _ _ z = case z of Data.Data.gunfold k z c = case Data.Data.constrIndex c of Data.Data.toConstr z = case z of - Data.Data.dataTypeOf _ = DrvEmptyData.$tVoid + Data.Data.dataTypeOf _ = $tVoid Data.Data.dataCast1 f = Data.Typeable.gcast1 f instance GHC.Base.Functor DrvEmptyData.Void where @@ -48,8 +48,8 @@ Derived class instances: Language.Haskell.TH.Syntax.lift z = GHC.Base.pure (case z of) Language.Haskell.TH.Syntax.liftTyped z = GHC.Base.pure (case z of) - DrvEmptyData.$tVoid :: Data.Data.DataType - DrvEmptyData.$tVoid = Data.Data.mkDataType "Void" [] + $tVoid :: Data.Data.DataType + $tVoid = Data.Data.mkDataType "Void" [] Derived type family instances: type GHC.Generics.Rep (DrvEmptyData.Void a) = GHC.Generics.D1 @@ -64,124 +64,124 @@ Derived type family instances: ==================== Filling in method body ==================== -GHC.Read.Read [DrvEmptyData.Void a[ssk:2]] +GHC.Read.Read [DrvEmptyData.Void a[ssk:1]] GHC.Read.readsPrec = GHC.Read.$dmreadsPrec - @(DrvEmptyData.Void a[ssk:2]) + @(DrvEmptyData.Void a[ssk:1]) ==================== Filling in method body ==================== -GHC.Show.Show [DrvEmptyData.Void a[ssk:2]] - GHC.Show.show = GHC.Show.$dmshow @(DrvEmptyData.Void a[ssk:2]) +GHC.Show.Show [DrvEmptyData.Void a[ssk:1]] + GHC.Show.show = GHC.Show.$dmshow @(DrvEmptyData.Void a[ssk:1]) ==================== Filling in method body ==================== -GHC.Show.Show [DrvEmptyData.Void a[ssk:2]] +GHC.Show.Show [DrvEmptyData.Void a[ssk:1]] GHC.Show.showList = GHC.Show.$dmshowList - @(DrvEmptyData.Void a[ssk:2]) + @(DrvEmptyData.Void a[ssk:1]) ==================== Filling in method body ==================== -GHC.Classes.Ord [DrvEmptyData.Void a[ssk:2]] - GHC.Classes.< = GHC.Classes.$dm< @(DrvEmptyData.Void a[ssk:2]) +GHC.Classes.Ord [DrvEmptyData.Void a[ssk:1]] + GHC.Classes.< = GHC.Classes.$dm< @(DrvEmptyData.Void a[ssk:1]) ==================== Filling in method body ==================== -GHC.Classes.Ord [DrvEmptyData.Void a[ssk:2]] - GHC.Classes.<= = GHC.Classes.$dm<= @(DrvEmptyData.Void a[ssk:2]) +GHC.Classes.Ord [DrvEmptyData.Void a[ssk:1]] + GHC.Classes.<= = GHC.Classes.$dm<= @(DrvEmptyData.Void a[ssk:1]) ==================== Filling in method body ==================== -GHC.Classes.Ord [DrvEmptyData.Void a[ssk:2]] - GHC.Classes.> = GHC.Classes.$dm> @(DrvEmptyData.Void a[ssk:2]) +GHC.Classes.Ord [DrvEmptyData.Void a[ssk:1]] + GHC.Classes.> = GHC.Classes.$dm> @(DrvEmptyData.Void a[ssk:1]) ==================== Filling in method body ==================== -GHC.Classes.Ord [DrvEmptyData.Void a[ssk:2]] - GHC.Classes.>= = GHC.Classes.$dm>= @(DrvEmptyData.Void a[ssk:2]) +GHC.Classes.Ord [DrvEmptyData.Void a[ssk:1]] + GHC.Classes.>= = GHC.Classes.$dm>= @(DrvEmptyData.Void a[ssk:1]) ==================== Filling in method body ==================== -GHC.Classes.Ord [DrvEmptyData.Void a[ssk:2]] - GHC.Classes.max = GHC.Classes.$dmmax @(DrvEmptyData.Void a[ssk:2]) +GHC.Classes.Ord [DrvEmptyData.Void a[ssk:1]] + GHC.Classes.max = GHC.Classes.$dmmax @(DrvEmptyData.Void a[ssk:1]) ==================== Filling in method body ==================== -GHC.Classes.Ord [DrvEmptyData.Void a[ssk:2]] - GHC.Classes.min = GHC.Classes.$dmmin @(DrvEmptyData.Void a[ssk:2]) +GHC.Classes.Ord [DrvEmptyData.Void a[ssk:1]] + GHC.Classes.min = GHC.Classes.$dmmin @(DrvEmptyData.Void a[ssk:1]) ==================== Filling in method body ==================== -GHC.Classes.Eq [DrvEmptyData.Void a[ssk:2]] - GHC.Classes./= = GHC.Classes.$dm/= @(DrvEmptyData.Void a[ssk:2]) +GHC.Classes.Eq [DrvEmptyData.Void a[ssk:1]] + GHC.Classes./= = GHC.Classes.$dm/= @(DrvEmptyData.Void a[ssk:1]) ==================== Filling in method body ==================== -Data.Data.Data [DrvEmptyData.Void a[ssk:2]] +Data.Data.Data [DrvEmptyData.Void a[ssk:1]] Data.Data.dataCast2 = Data.Data.$dmdataCast2 - @(DrvEmptyData.Void a[ssk:2]) + @(DrvEmptyData.Void a[ssk:1]) ==================== Filling in method body ==================== -Data.Data.Data [DrvEmptyData.Void a[ssk:2]] - Data.Data.gmapT = Data.Data.$dmgmapT @(DrvEmptyData.Void a[ssk:2]) +Data.Data.Data [DrvEmptyData.Void a[ssk:1]] + Data.Data.gmapT = Data.Data.$dmgmapT @(DrvEmptyData.Void a[ssk:1]) ==================== Filling in method body ==================== -Data.Data.Data [DrvEmptyData.Void a[ssk:2]] +Data.Data.Data [DrvEmptyData.Void a[ssk:1]] Data.Data.gmapQl = Data.Data.$dmgmapQl - @(DrvEmptyData.Void a[ssk:2]) + @(DrvEmptyData.Void a[ssk:1]) ==================== Filling in method body ==================== -Data.Data.Data [DrvEmptyData.Void a[ssk:2]] +Data.Data.Data [DrvEmptyData.Void a[ssk:1]] Data.Data.gmapQr = Data.Data.$dmgmapQr - @(DrvEmptyData.Void a[ssk:2]) + @(DrvEmptyData.Void a[ssk:1]) ==================== Filling in method body ==================== -Data.Data.Data [DrvEmptyData.Void a[ssk:2]] - Data.Data.gmapQ = Data.Data.$dmgmapQ @(DrvEmptyData.Void a[ssk:2]) +Data.Data.Data [DrvEmptyData.Void a[ssk:1]] + Data.Data.gmapQ = Data.Data.$dmgmapQ @(DrvEmptyData.Void a[ssk:1]) ==================== Filling in method body ==================== -Data.Data.Data [DrvEmptyData.Void a[ssk:2]] +Data.Data.Data [DrvEmptyData.Void a[ssk:1]] Data.Data.gmapQi = Data.Data.$dmgmapQi - @(DrvEmptyData.Void a[ssk:2]) + @(DrvEmptyData.Void a[ssk:1]) ==================== Filling in method body ==================== -Data.Data.Data [DrvEmptyData.Void a[ssk:2]] - Data.Data.gmapM = Data.Data.$dmgmapM @(DrvEmptyData.Void a[ssk:2]) +Data.Data.Data [DrvEmptyData.Void a[ssk:1]] + Data.Data.gmapM = Data.Data.$dmgmapM @(DrvEmptyData.Void a[ssk:1]) ==================== Filling in method body ==================== -Data.Data.Data [DrvEmptyData.Void a[ssk:2]] +Data.Data.Data [DrvEmptyData.Void a[ssk:1]] Data.Data.gmapMp = Data.Data.$dmgmapMp - @(DrvEmptyData.Void a[ssk:2]) + @(DrvEmptyData.Void a[ssk:1]) ==================== Filling in method body ==================== -Data.Data.Data [DrvEmptyData.Void a[ssk:2]] +Data.Data.Data [DrvEmptyData.Void a[ssk:1]] Data.Data.gmapMo = Data.Data.$dmgmapMo - @(DrvEmptyData.Void a[ssk:2]) + @(DrvEmptyData.Void a[ssk:1]) @@ -193,6 +193,13 @@ Data.Foldable.Foldable [DrvEmptyData.Void] ==================== Filling in method body ==================== Data.Foldable.Foldable [DrvEmptyData.Void] + Data.Foldable.foldMap' = Data.Foldable.$dmfoldMap' + @(DrvEmptyData.Void) + + + +==================== Filling in method body ==================== +Data.Foldable.Foldable [DrvEmptyData.Void] Data.Foldable.foldr = Data.Foldable.$dmfoldr @(DrvEmptyData.Void) |