Use addToUFM_Acc where appropriate

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

diff --git a/compiler/basicTypes/OccName.lhs b/compiler/basicTypes/OccName.lhs
index b12a07f..8248b5f 100644 (file)
--- a/compiler/basicTypes/OccName.lhs
+++ b/compiler/basicTypes/OccName.lhs
@@ -49,7 +49,7 @@ module OccName (
        -- ** Derived 'OccName's
         isDerivedOccName,
        mkDataConWrapperOcc, mkWorkerOcc, mkDefaultMethodOcc,
-       mkDerivedTyConOcc, mkNewTyCoOcc, 
+       mkDerivedTyConOcc, mkNewTyCoOcc, mkClassOpAuxOcc,
         mkCon2TagOcc, mkTag2ConOcc, mkMaxTagOcc,
        mkClassTyConOcc, mkClassDataConOcc, mkDictOcc, mkIPOcc, 
        mkSpecOcc, mkForeignExportOcc, mkGenOcc1, mkGenOcc2,
@@ -58,7 +58,7 @@ module OccName (
        mkInstTyCoOcc, mkEqPredCoOcc,
         mkVectOcc, mkVectTyConOcc, mkVectDataConOcc, mkVectIsoOcc,
         mkPDataTyConOcc, mkPDataDataConOcc,
-        mkPReprTyConOcc,
+        mkPReprTyConOcc, 
         mkPADFunOcc,
 
        -- ** Deconstruction
@@ -75,7 +75,7 @@ module OccName (
        OccEnv, emptyOccEnv, unitOccEnv, extendOccEnv, mapOccEnv,
        lookupOccEnv, mkOccEnv, mkOccEnv_C, extendOccEnvList, elemOccEnv,
        occEnvElts, foldOccEnv, plusOccEnv, plusOccEnv_C, extendOccEnv_C,
-        filterOccEnv, delListFromOccEnv, delFromOccEnv,
+        extendOccEnv_Acc, filterOccEnv, delListFromOccEnv, delFromOccEnv,
 
        -- * The 'OccSet' type
        OccSet, emptyOccSet, unitOccSet, mkOccSet, extendOccSet, 
@@ -98,7 +98,6 @@ import BasicTypes
 import UniqFM
 import UniqSet
 import FastString
-import FastTypes
 import Outputable
 import Binary
 import Data.Char
@@ -304,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)
 
@@ -334,6 +335,7 @@ elemOccEnv   :: OccName -> OccEnv a -> Bool
 foldOccEnv   :: (a -> b -> b) -> b -> OccEnv a -> b
 occEnvElts   :: OccEnv a -> [a]
 extendOccEnv_C :: (a->a->a) -> OccEnv a -> OccName -> a -> OccEnv a
+extendOccEnv_Acc :: (a->b->b) -> (a->b) -> OccEnv b -> OccName -> a -> OccEnv b
 plusOccEnv     :: OccEnv a -> OccEnv a -> OccEnv a
 plusOccEnv_C   :: (a->a->a) -> OccEnv a -> OccEnv a -> OccEnv a
 mapOccEnv      :: (a->b) -> OccEnv a -> OccEnv b
@@ -353,6 +355,7 @@ occEnvElts (A x)     = eltsUFM x
 plusOccEnv (A x) (A y)  = A $ plusUFM x y 
 plusOccEnv_C f (A x) (A y)      = A $ plusUFM_C f x y 
 extendOccEnv_C f (A x) y z   = A $ addToUFM_C f x y z
+extendOccEnv_Acc f g (A x) y z   = A $ addToUFM_Acc f g x y z
 mapOccEnv f (A x)       = A $ mapUFM f x
 mkOccEnv_C comb l = A $ addListToUFM_C comb emptyUFM l
 delFromOccEnv (A x) y    = A $ delFromUFM x y
@@ -525,7 +528,7 @@ mkDataConWrapperOcc, mkWorkerOcc, mkDefaultMethodOcc, mkDerivedTyConOcc,
        mkClassTyConOcc, mkClassDataConOcc, mkDictOcc, mkIPOcc, 
        mkSpecOcc, mkForeignExportOcc, mkGenOcc1, mkGenOcc2,
        mkDataTOcc, mkDataCOcc, mkDataConWorkerOcc, mkNewTyCoOcc,
-       mkInstTyCoOcc, mkEqPredCoOcc, 
+       mkInstTyCoOcc, mkEqPredCoOcc, mkClassOpAuxOcc,
         mkCon2TagOcc, mkTag2ConOcc, mkMaxTagOcc,
        mkVectOcc, mkVectTyConOcc, mkVectDataConOcc, mkVectIsoOcc,
        mkPDataTyConOcc, mkPDataDataConOcc, mkPReprTyConOcc, mkPADFunOcc
@@ -535,6 +538,7 @@ mkDataConWrapperOcc, mkWorkerOcc, mkDefaultMethodOcc, mkDerivedTyConOcc,
 mkDataConWrapperOcc = mk_simple_deriv varName  "$W"
 mkWorkerOcc         = mk_simple_deriv varName  "$w"
 mkDefaultMethodOcc  = mk_simple_deriv varName  "$dm"
+mkClassOpAuxOcc     = mk_simple_deriv varName  "$c"
 mkDerivedTyConOcc   = mk_simple_deriv tcName   ":"     -- The : prefix makes sure it classifies
 mkClassTyConOcc     = mk_simple_deriv tcName   "T:"    -- as a tycon/datacon
 mkClassDataConOcc   = mk_simple_deriv dataName "D:"    -- We go straight to the "real" data con
@@ -543,9 +547,9 @@ mkDictOcc       = mk_simple_deriv varName  "$d"
 mkIPOcc                    = mk_simple_deriv varName  "$i"
 mkSpecOcc          = mk_simple_deriv varName  "$s"
 mkForeignExportOcc  = mk_simple_deriv varName  "$f"
-mkNewTyCoOcc        = mk_simple_deriv tcName  "NTCo:"  -- Coercion for newtypes
-mkInstTyCoOcc       = mk_simple_deriv tcName  "TFCo:"   -- Coercion for type functions
-mkEqPredCoOcc      = mk_simple_deriv tcName  "$co"
+mkNewTyCoOcc        = mk_simple_deriv tcName   "NTCo:" -- Coercion for newtypes
+mkInstTyCoOcc       = mk_simple_deriv tcName   "TFCo:"   -- Coercion for type functions
+mkEqPredCoOcc      = mk_simple_deriv tcName   "$co"
 
 -- used in derived instances
 mkCon2TagOcc        = mk_simple_deriv varName  "$con2tag_"