Commit c41d214a authored by Simon Peyton Jones's avatar Simon Peyton Jones
Browse files

Unique-ify the names of top-level auxiliary bindings in derived instances (Trac #7947)

The problem and its solution are explained in
   Note [Auxiliary binders]
in TcGenDeriv
parent 863854a3
...@@ -65,6 +65,7 @@ import Pair ...@@ -65,6 +65,7 @@ import Pair
import Bag import Bag
import Fingerprint import Fingerprint
import TcEnv (InstInfo) import TcEnv (InstInfo)
import StaticFlags( opt_PprStyle_Debug )
import ListSetOps ( assocMaybe ) import ListSetOps ( assocMaybe )
import Data.List ( partition, intersperse ) import Data.List ( partition, intersperse )
...@@ -2294,6 +2295,11 @@ f_Pat = nlVarPat f_RDR ...@@ -2294,6 +2295,11 @@ f_Pat = nlVarPat f_RDR
k_Pat = nlVarPat k_RDR k_Pat = nlVarPat k_RDR
z_Pat = nlVarPat z_RDR z_Pat = nlVarPat z_RDR
minusInt_RDR, tagToEnum_RDR, error_RDR :: RdrName
minusInt_RDR = getRdrName (primOpId IntSubOp )
tagToEnum_RDR = getRdrName (primOpId TagToEnumOp)
error_RDR = getRdrName eRROR_ID
con2tag_RDR, tag2con_RDR, maxtag_RDR :: TyCon -> RdrName con2tag_RDR, tag2con_RDR, maxtag_RDR :: TyCon -> RdrName
-- Generates Orig s RdrName, for the binding positions -- Generates Orig s RdrName, for the binding positions
con2tag_RDR tycon = mk_tc_deriv_name tycon mkCon2TagOcc con2tag_RDR tycon = mk_tc_deriv_name tycon mkCon2TagOcc
...@@ -2304,13 +2310,40 @@ mk_tc_deriv_name :: TyCon -> (OccName -> OccName) -> RdrName ...@@ -2304,13 +2310,40 @@ mk_tc_deriv_name :: TyCon -> (OccName -> OccName) -> RdrName
mk_tc_deriv_name tycon occ_fun = mkAuxBinderName (tyConName tycon) occ_fun mk_tc_deriv_name tycon occ_fun = mkAuxBinderName (tyConName tycon) occ_fun
mkAuxBinderName :: Name -> (OccName -> OccName) -> RdrName mkAuxBinderName :: Name -> (OccName -> OccName) -> RdrName
mkAuxBinderName parent occ_fun = mkRdrUnqual (occ_fun (nameOccName parent)) -- ^ Make a top-level binder name for an auxiliary binding for a parent name
-- Was: mkDerivedRdrName name occ_fun, which made an original name -- See Note [Auxiliary binders]
-- But: (a) that does not work well for standalone-deriving mkAuxBinderName parent occ_fun
-- (b) an unqualified name is just fine, provided it can't clash with user code = mkRdrUnqual (occ_fun uniq_parent_occ)
where
uniq_parent_occ = mkOccName (occNameSpace parent_occ) uniq_string
minusInt_RDR, tagToEnum_RDR, error_RDR :: RdrName uniq_string
minusInt_RDR = getRdrName (primOpId IntSubOp ) | opt_PprStyle_Debug = showSDocSimple (ppr parent_occ <> underscore <> ppr parent_uniq)
tagToEnum_RDR = getRdrName (primOpId TagToEnumOp) | otherwise = show parent_uniq
error_RDR = getRdrName eRROR_ID -- The debug thing is just to generate longer, but perhaps more perspicuous, names
parent_uniq = nameUnique parent
parent_occ = nameOccName parent
\end{code} \end{code}
Note [Auxiliary binders]
~~~~~~~~~~~~~~~~~~~~~~~~
We often want to make a top-level auxiliary binding. E.g. for comparison we haev
instance Ord T where
compare a b = $con2tag a `compare` $con2tag b
$con2tag :: T -> Int
$con2tag = ...code....
Of course these top-level bindings should all have distinct name, and we are
generating RdrNames here. We can't just use the TyCon or DataCon to distinguish
becuase with standalone deriving two imported TyCons might both be called T!
(See Trac #7947.)
So we use the *unique* from the parent name (T in this example) as part of the
OccName we generate for the new binding.
In the past we used mkDerivedRdrName name occ_fun, which made an original name
But: (a) that does not work well for standalone-deriving either
(b) an unqualified name is just fine, provided it can't clash with user code
{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE StandaloneDeriving #-}
module T7947 where
import Data.Data
import Data.Typeable
import T7947a
import qualified T7947b as B
deriving instance Typeable A
deriving instance Typeable B.B
deriving instance Data A
deriving instance Data B.B
module T7947a where
data A = C1 | C2 | C
module T7947b where
data B = D1 | D2 | C
...@@ -52,4 +52,5 @@ test('T7269', normal, compile, ['']) ...@@ -52,4 +52,5 @@ test('T7269', normal, compile, [''])
test('T9069', normal, compile, ['']) test('T9069', normal, compile, [''])
test('T9359', normal, compile, ['']) test('T9359', normal, compile, [''])
test('T4896', normal, compile, ['']) test('T4896', normal, compile, [''])
test('T7947', extra_clean(['T7947a.o', 'T7947a.hi', 'T7947b.o', 'T7947b.hi']), multimod_compile, ['T7947', '-v0'])
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