Comment only

[ghc-hetmet.git] / compiler / basicTypes / OccName.lhs

diff --git a/compiler/basicTypes/OccName.lhs b/compiler/basicTypes/OccName.lhs
index c2aae5d..0736fea 100644 (file)
--- a/compiler/basicTypes/OccName.lhs
+++ b/compiler/basicTypes/OccName.lhs
@@ -57,7 +57,7 @@ module OccName (
        mkSuperDictSelOcc, mkLocalOcc, mkMethodOcc, mkInstTyTcOcc,
        mkInstTyCoOcc, mkEqPredCoOcc,
         mkVectOcc, mkVectTyConOcc, mkVectDataConOcc, mkVectIsoOcc,
-        mkPArrayTyConOcc, mkPArrayDataConOcc,
+        mkPDataTyConOcc, mkPDataDataConOcc,
         mkPReprTyConOcc,
         mkPADFunOcc,
 
@@ -65,7 +65,7 @@ module OccName (
        occNameFS, occNameString, occNameSpace, 
 
        isVarOcc, isTvOcc, isTcOcc, isDataOcc, isDataSymOcc, isSymOcc, isValOcc,
-       parenSymOcc, reportIfUnused, 
+       parenSymOcc, startsWithUnderscore, 
        
        isTcClsNameSpace, isTvNameSpace, isDataConNameSpace, isVarNameSpace, isValNameSpace,
 
@@ -95,15 +95,12 @@ 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}
 
@@ -463,13 +460,12 @@ parenSymOcc occ doc | isSymOcc occ = parens doc
 
 
 \begin{code}
-reportIfUnused :: OccName -> Bool
--- ^ Haskell 98 encourages compilers to suppress warnings about
--- unused names in a pattern if they start with @_@: this implements
--- that test
-reportIfUnused occ = case occNameString occ of
-                       ('_' : _) -> False
-                       _other    -> True
+startsWithUnderscore :: OccName -> Bool
+-- ^ Haskell 98 encourages compilers to suppress warnings about unsed
+-- names in a pattern if they start with @_@: this implements that test
+startsWithUnderscore occ = case occNameString occ of
+                            ('_' : _) -> True
+                            _other    -> False
 \end{code}
 
 
@@ -532,7 +528,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
@@ -571,8 +567,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_"
 
@@ -604,31 +600,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