diff --git a/ghc/compiler/basicTypes/OccName.lhs b/ghc/compiler/basicTypes/OccName.lhs
index d2c28f1b8ed1b6c06c85924dc5e93d63f984f10a..f33c71660118fe0a7e8b965678311a704b67de90 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 61dd76a6dc6bc7e71e5078841885a6ae759f9477..9387aee365a90dd318652b16c07448667dcf9737 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 5494fe39744296a96aa9732c40924e5c593c62c1..944acb4b3ea0d8bc7514309c0bbb4c0d207df99f 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