From 2dad6b8373e3079ff11c4d40e2512755b525172b Mon Sep 17 00:00:00 2001
From: simonpj <unknown>
Date: Fri, 20 Aug 1999 13:12:21 +0000
Subject: [PATCH] [project @ 1999-08-20 13:12:18 by simonpj] Change the
 renamer namesuppy for instance decls, so that it is indexed
 by the class/tycon *string* rather than the class/tycon
 pair. That way (C,TT) and (CT,T) both give the string
 "CTT", and hence give a different unique.

An alternative would have been to use "C/TT" and "CT/T"
respectively, but that would mean obscure errors while everyone
remembered to recompile everything.  So this seems more direct.

Julian reported this bug.
---
 ghc/compiler/basicTypes/OccName.lhs |   20 +++++++++-----------
 ghc/compiler/rename/RnEnv.lhs       |    9 ++++++---
 ghc/compiler/rename/RnMonad.lhs     |   12 +++++++-----
 3 files changed, 22 insertions(+), 19 deletions(-)

diff --git a/ghc/compiler/basicTypes/OccName.lhs b/ghc/compiler/basicTypes/OccName.lhs
index d2c28f1..f33c716 100644
--- a/ghc/compiler/basicTypes/OccName.lhs
+++ b/ghc/compiler/basicTypes/OccName.lhs
@@ -304,18 +304,16 @@ mkSuperDictSelOcc index cls_occ
 
 
 \begin{code}
-mkDFunOcc :: OccName 	-- class, eg "Ord"
-	  -> OccName 	-- tycon (or something convenient from the instance type)
-			--	eg "Maybe"
-	  -> Int	-- Unique to distinguish dfuns which share the previous two
-			--	eg 3
-	  -> OccName	-- "dOrdMaybe3"
-
-mkDFunOcc cls_occ tycon_occ index
-  = mk_deriv VarName "$f" (show_index ++ cls_str ++ tycon_str)
+mkDFunOcc :: EncodedString	-- Typically the class and type glommed together e.g. "OrdMaybe"
+	  -> Int		-- Unique to distinguish dfuns which share the previous two
+				--	eg 3
+	  -- The requirement is that the (string,index) pair be unique in this module
+
+	  -> OccName	-- "$fOrdMaybe3"
+
+mkDFunOcc string index
+  = mk_deriv VarName "$f" (show_index ++ string)
   where
-    cls_str   = occNameString cls_occ
-    tycon_str = occNameString tycon_occ
     show_index | index == 0 = ""
    	       | otherwise  = show index
 \end{code}
diff --git a/ghc/compiler/rename/RnEnv.lhs b/ghc/compiler/rename/RnEnv.lhs
index 61dd76a..9387aee 100644
--- a/ghc/compiler/rename/RnEnv.lhs
+++ b/ghc/compiler/rename/RnEnv.lhs
@@ -29,7 +29,7 @@ import Name		( Name, Provenance(..), ExportFlag(..), NamedThing(..),
 			)
 import NameSet
 import OccName		( OccName,
-			  mkDFunOcc, occNameUserString,
+			  mkDFunOcc, occNameUserString, occNameString,
 			  occNameFlavour
 			)
 import TysWiredIn	( tupleTyCon, unboxedTupleTyCon, listTyCon )
@@ -168,8 +168,11 @@ Make a name for the dict fun for an instance decl
 \begin{code}
 newDFunName :: (OccName, OccName) -> SrcLoc -> RnMS Name
 newDFunName key@(cl_occ, tycon_occ) loc
-  = newInstUniq key	`thenRn` \ inst_uniq ->
-    newImplicitBinder (mkDFunOcc cl_occ tycon_occ inst_uniq) loc
+  = newInstUniq string	`thenRn` \ inst_uniq ->
+    newImplicitBinder (mkDFunOcc string inst_uniq) loc
+  where
+	-- Any string that is somewhat unique will do
+    string = occNameString cl_occ ++ occNameString tycon_occ
 \end{code}
 
 \begin{code}
diff --git a/ghc/compiler/rename/RnMonad.lhs b/ghc/compiler/rename/RnMonad.lhs
index 5494fe3..944acb4 100644
--- a/ghc/compiler/rename/RnMonad.lhs
+++ b/ghc/compiler/rename/RnMonad.lhs
@@ -197,12 +197,14 @@ type FixityEnv = NameEnv RenamedFixitySig
 type RnNameSupply
  = ( UniqSupply
 
-   , FiniteMap (OccName, OccName) Int
+   , FiniteMap String Int
 	-- This is used as a name supply for dictionary functions
-	-- From the inst decl we derive a (class, tycon) pair;
+	-- From the inst decl we derive a string, usually by glomming together
+	-- the class and tycon name -- but it doesn't matter exactly how;
 	-- this map then gives a unique int for each inst decl with that
-	-- (class, tycon) pair.  (In Haskell 98 there can only be one,
-	-- but not so in more extended versions.)
+	-- string.  (In Haskell 98 there can only be one,
+	-- but not so in more extended versions; also class CC type T
+	-- and class C type TT might both give the string CCT
 	--	
 	-- We could just use one Int for all the instance decls, but this
 	-- way the uniques change less when you add an instance decl,	
@@ -615,7 +617,7 @@ setNameSupplyRn names' (RnDown {rn_ns = names_var}) l_down
   = writeIORef names_var names'
 
 -- See comments with RnNameSupply above.
-newInstUniq :: (OccName, OccName) -> RnM d Int
+newInstUniq :: String -> RnM d Int
 newInstUniq key (RnDown {rn_ns = names_var}) l_down
   = readIORef names_var				>>= \ (us, mapInst, cache) ->
     let
-- 
1.7.10.4