X-Git-Url: http://git.megacz.com/?p=ghc-hetmet.git;a=blobdiff_plain;f=compiler%2FbasicTypes%2FOccName.lhs;h=3a2338e8a4db47f357833f19832ceb04c0c06f1a;hp=10cf91eb790d2e4ed44f59c155dce936931c5042;hb=388e3356f71daffa62f1d4157e1e07e4c68f218a;hpb=46f02d59813499ba2aa44e7831e0b69ec6d8f25d

diff --git a/compiler/basicTypes/OccName.lhs b/compiler/basicTypes/OccName.lhs
index 10cf91e..3a2338e 100644
--- a/compiler/basicTypes/OccName.lhs
+++ b/compiler/basicTypes/OccName.lhs
@@ -9,7 +9,7 @@
 -- GHC uses several kinds of name internally:
 --
 -- * 'OccName.OccName' represents names as strings with just a little more information:
---   the "namespace" that the name came from, e.g. the namespace of value, type constructors or
+--   the \"namespace\" that the name came from, e.g. the namespace of value, type constructors or
 --   data constructors
 --
 -- * 'RdrName.RdrName': see "RdrName#name_types"
@@ -57,7 +57,7 @@ module OccName (
 	mkSuperDictSelOcc, mkLocalOcc, mkMethodOcc, mkInstTyTcOcc,
 	mkInstTyCoOcc, mkEqPredCoOcc,
         mkVectOcc, mkVectTyConOcc, mkVectDataConOcc, mkVectIsoOcc,
-        mkPArrayTyConOcc, mkPArrayDataConOcc,
+        mkPDataTyConOcc, mkPDataDataConOcc,
         mkPReprTyConOcc,
         mkPADFunOcc,
 
@@ -95,15 +95,11 @@ module OccName (
 import Util
 import Unique
 import BasicTypes
-import StaticFlags
 import UniqFM
 import UniqSet
 import FastString
-import FastTypes
 import Outputable
 import Binary
-
-import GHC.Exts
 import Data.Char
 \end{code}
 
@@ -307,22 +303,24 @@ mkClsOccFS = mkOccNameFS clsName
 
 OccEnvs are used mainly for the envts in ModIfaces.
 
+Note [The Unique of an OccName]
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
 They are efficient, because FastStrings have unique Int# keys.  We assume
-this key is less than 2^24, so we can make a Unique using
+this key is less than 2^24, and indeed FastStrings are allocated keys 
+sequentially starting at 0.
+
+So we can make a Unique using
 	mkUnique ns key  :: Unique
 where 'ns' is a Char reprsenting the name space.  This in turn makes it
 easy to build an OccEnv.
 
 \begin{code}
 instance Uniquable OccName where
-  getUnique (OccName ns fs)
-      = mkUnique char (iBox (uniqueOfFS fs))
-      where	-- See notes above about this getUnique function
-        char = case ns of
-		VarName   -> 'i'
-		DataName  -> 'd'
-		TvName    -> 'v'
-		TcClsName -> 't'
+      -- See Note [The Unique of an OccName]
+  getUnique (OccName VarName   fs) = mkVarOccUnique  fs
+  getUnique (OccName DataName  fs) = mkDataOccUnique fs
+  getUnique (OccName TvName    fs) = mkTvOccUnique   fs
+  getUnique (OccName TcClsName fs) = mkTcOccUnique   fs
 
 newtype OccEnv a = A (UniqFM a)
 
@@ -531,7 +529,7 @@ mkDataConWrapperOcc, mkWorkerOcc, mkDefaultMethodOcc, mkDerivedTyConOcc,
 	mkInstTyCoOcc, mkEqPredCoOcc, 
         mkCon2TagOcc, mkTag2ConOcc, mkMaxTagOcc,
 	mkVectOcc, mkVectTyConOcc, mkVectDataConOcc, mkVectIsoOcc,
-	mkPArrayTyConOcc, mkPArrayDataConOcc, mkPReprTyConOcc, mkPADFunOcc
+	mkPDataTyConOcc, mkPDataDataConOcc, mkPReprTyConOcc, mkPADFunOcc
    :: OccName -> OccName
 
 -- These derived variables have a prefix that no Haskell value could have
@@ -570,8 +568,8 @@ mkVectOcc          = mk_simple_deriv varName  "$v_"
 mkVectTyConOcc     = mk_simple_deriv tcName   ":V_"
 mkVectDataConOcc   = mk_simple_deriv dataName ":VD_"
 mkVectIsoOcc       = mk_simple_deriv varName  "$VI_"
-mkPArrayTyConOcc   = mk_simple_deriv tcName   ":VP_"
-mkPArrayDataConOcc = mk_simple_deriv dataName ":VPD_"
+mkPDataTyConOcc    = mk_simple_deriv tcName   ":VP_"
+mkPDataDataConOcc  = mk_simple_deriv dataName ":VPD_"
 mkPReprTyConOcc    = mk_simple_deriv tcName   ":VR_"
 mkPADFunOcc        = mk_simple_deriv varName  "$PA_"
 
@@ -603,31 +601,41 @@ mkLocalOcc uniq occ
 \begin{code}
 -- | Derive a name for the representation type constructor of a
 -- @data@\/@newtype@ instance.
-mkInstTyTcOcc :: Int			-- ^ DFun Index
-	      -> OccName		-- ^ Family name, e.g. @Map@
-	      -> OccName		-- ^ Nice unique version, e.g. @:R23Map@
-mkInstTyTcOcc index occ
-   = mk_deriv tcName ("R" ++ show index ++ ":") (occNameString occ)
+mkInstTyTcOcc :: String 		-- ^ Family name, e.g. @Map@
+              -> OccSet                 -- ^ avoid these Occs
+	      -> OccName		-- ^ @R:Map@
+mkInstTyTcOcc str set =
+  chooseUniqueOcc tcName ('R' : ':' : str) set
 \end{code}
 
 \begin{code}
 mkDFunOcc :: String		-- ^ Typically the class and type glommed together e.g. @OrdMaybe@.
 				-- Only used in debug mode, for extra clarity
 	  -> Bool		-- ^ Is this a hs-boot instance DFun?
-	  -> Int		-- ^ Unique index
+          -> OccSet             -- ^ avoid these Occs
 	  -> OccName		-- ^ E.g. @$f3OrdMaybe@
 
 -- In hs-boot files we make dict funs like $fx7ClsTy, which get bound to the real
 -- thing when we compile the mother module. Reason: we don't know exactly
 -- what the  mother module will call it.
 
-mkDFunOcc info_str is_boot index 
-  = mk_deriv VarName prefix string
+mkDFunOcc info_str is_boot set
+  = chooseUniqueOcc VarName (prefix ++ info_str) set
   where
     prefix | is_boot   = "$fx"
 	   | otherwise = "$f"
-    string | opt_PprStyle_Debug = show index ++ info_str
-	   | otherwise		= show index
+\end{code}
+
+Sometimes we need to pick an OccName that has not already been used,
+given a set of in-use OccNames.
+
+\begin{code}
+chooseUniqueOcc :: NameSpace -> String -> OccSet -> OccName
+chooseUniqueOcc ns str set = loop (mkOccName ns str) (0::Int)
+  where
+  loop occ n
+   | occ `elemOccSet` set = loop (mkOccName ns (str ++ show n)) (n+1)
+   | otherwise            = occ
 \end{code}
 
 We used to add a '$m' to indicate a method, but that gives rise to bad