Commit ce987865 authored by Ryan Scott's avatar Ryan Scott Committed by Marge Bot

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.
parent 9ee58f8d
Pipeline #21556 failed with stages
in 1371 minutes and 44 seconds
......@@ -377,3 +377,19 @@ mk_mod_usage_info pit hsc_env this_mod direct_imports used_names
from generating many of these usages (at least in
one-shot mode), but that's even more bogus!
-}
{-
Note [Internal used_names]
~~~~~~~~~~~~~~~~~~~~~~~~~~
Most of the used_names are External Names, but we can have System
Names too. Two examples:
* Names arising from Language.Haskell.TH.newName.
See Note [Binders in Template Haskell] in GHC.ThToHs (and #5362).
* The names of auxiliary bindings in derived instances.
See Note [Auxiliary binders] in GHC.Tc.Deriv.Generate.
Such Names are always for locally-defined things, for which we don't gather
usage info, so we can just ignore them in ent_map. Moreover, they are always
System Names, hence the assert, just as a double check.
-}
......@@ -54,7 +54,7 @@ See Also: Note [The Name Cache] in GHC.Types.Name.Cache
newGlobalBinder :: Module -> OccName -> SrcSpan -> TcRnIf a b Name
-- Used for source code and interface files, to make the
-- Name for a thing, given its Module and OccName
-- See Note [The Name Cache]
-- See Note [The Name Cache] in GHC.Types.Name.Cache
--
-- The cache may already already have a binding for this thing,
-- because we may have seen an occurrence before, but now is the
......@@ -79,7 +79,7 @@ allocateGlobalBinder
:: NameCache
-> Module -> OccName -> SrcSpan
-> (NameCache, Name)
-- See Note [The Name Cache]
-- See Note [The Name Cache] in GHC.Types.Name.Cache
allocateGlobalBinder name_supply mod occ loc
= case lookupOrigNameCache (nsNames name_supply) mod occ of
-- A hit in the cache! We are at the binding site of the name.
......
......@@ -364,16 +364,6 @@ That is, in Y,
In the result of mkIfaceExports, the names are grouped by defining module,
so we may need to split up a single Avail into multiple ones.
Note [Internal used_names]
~~~~~~~~~~~~~~~~~~~~~~~~~~
Most of the used_names are External Names, but we can have Internal
Names too: see Note [Binders in Template Haskell] in "GHC.ThToHs", and
#5362 for an example. Such Names are always
- Such Names are always for locally-defined things, for which we
don't gather usage info, so we can just ignore them in ent_map
- They are always System Names, hence the assert, just as a double check.
-}
......
......@@ -818,15 +818,17 @@ the encloseing instance decl, if any.
Note [Looking up Exact RdrNames]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
Exact RdrNames are generated by Template Haskell. See Note [Binders
in Template Haskell] in Convert.
Exact RdrNames are generated by:
* Template Haskell (See Note [Binders in Template Haskell] in GHC.ThToHs)
* Derived instances (See Note [Auxiliary binders] in GHC.Tc.Deriv.Generate)
For data types and classes have Exact system Names in the binding
positions for constructors, TyCons etc. For example
[d| data T = MkT Int |]
when we splice in and Convert to HsSyn RdrName, we'll get
when we splice in and convert to HsSyn RdrName, we'll get
data (Exact (system Name "T")) = (Exact (system Name "MkT")) ...
These System names are generated by Convert.thRdrName
These System names are generated by GHC.ThToHs.thRdrName
But, constructors and the like need External Names, not System Names!
So we do the following
......
......@@ -38,11 +38,10 @@ import GHC.Tc.Gen.HsType
import GHC.Core.TyCo.Rep
import GHC.Core.TyCo.Ppr ( pprTyVars )
import GHC.Rename.Names ( extendGlobalRdrEnvRn )
import GHC.Rename.Bind
import GHC.Rename.Env
import GHC.Rename.Module ( addTcgDUs )
import GHC.Types.Avail
import GHC.Rename.Utils
import GHC.Core.Unify( tcUnifyTy )
import GHC.Core.Class
......@@ -294,11 +293,12 @@ renameDeriv inst_infos bagBinds
; traceTc "rnd" (vcat (map (\i -> pprInstInfoDetails i $$ text "") inst_infos))
; (aux_binds, aux_sigs) <- mapAndUnzipBagM return bagBinds
; let aux_val_binds = ValBinds noExtField aux_binds (bagToList aux_sigs)
; rn_aux_lhs <- rnTopBindsLHS emptyFsEnv aux_val_binds
; let bndrs = collectHsValBinders rn_aux_lhs
; envs <- extendGlobalRdrEnvRn (map avail bndrs) emptyFsEnv ;
; setEnvs envs $
do { (rn_aux, dus_aux) <- rnValBindsRHS (TopSigCtxt (mkNameSet bndrs)) rn_aux_lhs
-- Importantly, we use rnLocalValBindsLHS, not rnTopBindsLHS, to rename
-- auxiliary bindings as if they were defined locally.
-- See Note [Auxiliary binders] in GHC.Tc.Deriv.Generate.
; (bndrs, rn_aux_lhs) <- rnLocalValBindsLHS emptyFsEnv aux_val_binds
; bindLocalNames bndrs $
do { (rn_aux, dus_aux) <- rnLocalValBindsRHS (mkNameSet bndrs) rn_aux_lhs
; (rn_inst_infos, fvs_insts) <- mapAndUnzipM rn_inst_info inst_infos
; return (listToBag rn_inst_infos, rn_aux,
dus_aux `plusDU` usesOnly (plusFVs fvs_insts)) } }
......
This diff is collapsed.
......@@ -591,6 +591,10 @@ hasStockDeriving clas
= let (binds, deriv_stuff) = gen_fn loc tc
in return (binds, deriv_stuff, [])
-- Like `simple`, but monadic. The only monadic thing that these functions
-- do is allocate new Uniques, which are used for generating the names of
-- auxiliary bindings.
-- See Note [Auxiliary binders] in GHC.Tc.Deriv.Generate.
simpleM gen_fn loc tc _
= do { (binds, deriv_stuff) <- gen_fn loc tc
; return (binds, deriv_stuff, []) }
......
......@@ -608,7 +608,7 @@ mkDataConWrapperOcc, mkWorkerOcc,
mkGenR, mkGen1R,
mkDataConWorkerOcc, mkNewTyCoOcc,
mkInstTyCoOcc, mkEqPredCoOcc, mkClassOpAuxOcc,
mkCon2TagOcc, mkTag2ConOcc, mkMaxTagOcc,
mkCon2TagOcc, mkTag2ConOcc, mkMaxTagOcc, mkDataTOcc, mkDataCOcc,
mkTyConRepOcc
:: OccName -> OccName
......@@ -629,10 +629,13 @@ mkNewTyCoOcc = mk_simple_deriv tcName "N:" -- Coercion for newtypes
mkInstTyCoOcc = mk_simple_deriv tcName "D:" -- Coercion for type functions
mkEqPredCoOcc = mk_simple_deriv tcName "$co"
-- Used in derived instances
-- Used in derived instances for the names of auxilary bindings.
-- See Note [Auxiliary binders] in GHC.Tc.Deriv.Generate.
mkCon2TagOcc = mk_simple_deriv varName "$con2tag_"
mkTag2ConOcc = mk_simple_deriv varName "$tag2con_"
mkMaxTagOcc = mk_simple_deriv varName "$maxtag_"
mkDataTOcc = mk_simple_deriv varName "$t"
mkDataCOcc = mk_simple_deriv varName "$c"
-- TyConRepName stuff; see Note [Grand plan for Typeable] in GHC.Tc.Instance.Typeable
mkTyConRepOcc occ = mk_simple_deriv varName prefix occ
......@@ -697,16 +700,6 @@ mkDFunOcc info_str is_boot set
prefix | is_boot = "$fx"
| otherwise = "$f"
mkDataTOcc, mkDataCOcc
:: OccName -- ^ TyCon or data con string
-> OccSet -- ^ avoid these Occs
-> OccName -- ^ E.g. @$f3OrdMaybe@
-- data T = MkT ... deriving( Data ) needs definitions for
-- $tT :: Data.Generics.Basics.DataType
-- $cMkT :: Data.Generics.Basics.Constr
mkDataTOcc occ = chooseUniqueOcc VarName ("$t" ++ occNameString occ)
mkDataCOcc occ = chooseUniqueOcc VarName ("$c" ++ occNameString occ)
{-
Sometimes we need to pick an OccName that has not already been used,
given a set of in-use OccNames.
......
......@@ -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:
......
{-# 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)
......@@ -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, [''])
......@@ -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])
......@@ -191,6 +191,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)
......
Markdown is supported
0%
or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment