projects / ghc-hetmet.git / blobdiff
? search:
summary | shortlog | log | commit | commitdiff | tree
raw | inline | side by side
[project @ 1996-07-15 11:32:34 by partain]
[ghc-hetmet.git] / ghc / compiler / utils / UniqFM.lhs
diff --git a/ghc/compiler/utils/UniqFM.lhs b/ghc/compiler/utils/UniqFM.lhs
index 73b325c..09723c8 100644 (file)
--- a/ghc/compiler/utils/UniqFM.lhs
+++ b/ghc/compiler/utils/UniqFM.lhs
@@ -5,8 +5,8 @@
 
 Based on @FiniteMaps@ (as you would expect).
 
-Basically, the things need to be in class @NamedThing@, and we use the
-@getItsUnique@ method to grab their @Uniques@.
+Basically, the things need to be in class @Uniquable@, and we use the
+@uniqueOf@ method to grab their @Uniques@.
 
 (A similar thing to @UniqSet@, as opposed to @Set@.)
 
@@ -21,6 +21,7 @@ Basically, the things need to be in class @NamedThing@, and we use the
 
 module UniqFM (
        UniqFM,   -- abstract type
+       Uniquable(..), -- class to go with it
 
        emptyUFM,
        unitUFM,
@@ -32,8 +33,9 @@ module UniqFM (
        addToUFM_Directly,
        addListToUFM_Directly,
        IF_NOT_GHC(addToUFM_C COMMA)
-       IF_NOT_GHC(addListToUFM_C COMMA)
+       addListToUFM_C,
        delFromUFM,
+       delFromUFM_Directly,
        delListFromUFM,
        plusUFM,
        plusUFM_C,
@@ -49,18 +51,15 @@ module UniqFM (
        lookupWithDefaultUFM, lookupWithDefaultUFM_Directly,
        eltsUFM,
        ufmToList
-
-       -- to make the interface self-sufficient
     ) where
 
 #if defined(COMPILING_GHC)
-CHK_Ubiq() -- debugging consistency check
+IMP_Ubiq(){-uitous-}
 #endif
 
 import Unique          ( Unique, u2i, mkUniqueGrimily )
 import Util
-import Outputable      ( Outputable(..), NamedThing(..), ExportFlag )
-import Pretty          ( Pretty(..), PrettyRep )
+import Pretty          ( SYN_IE(Pretty), PrettyRep )
 import PprStyle                ( PprStyle )
 import SrcLoc          ( SrcLoc )
 
@@ -77,31 +76,32 @@ import SrcLoc               ( SrcLoc )
 %*                                                                     *
 %************************************************************************
 
-We use @FiniteMaps@, with a (@getItsUnique@-able) @Unique@ as ``key''.
+We use @FiniteMaps@, with a (@uniqueOf@-able) @Unique@ as ``key''.
 
 \begin{code}
 emptyUFM       :: UniqFM elt
 isNullUFM      :: UniqFM elt -> Bool
-unitUFM        :: NamedThing key => key -> elt -> UniqFM elt
+unitUFM                :: Uniquable key => key -> elt -> UniqFM elt
 unitDirectlyUFM -- got the Unique already
                :: Unique -> elt -> UniqFM elt
-listToUFM      :: NamedThing key => [(key,elt)] -> UniqFM elt
+listToUFM      :: Uniquable key => [(key,elt)] -> UniqFM elt
 listToUFM_Directly
                :: [(Unique, elt)] -> UniqFM elt
 
-addToUFM       :: NamedThing key => UniqFM elt -> key -> elt  -> UniqFM elt
-addListToUFM   :: NamedThing key => UniqFM elt -> [(key,elt)] -> UniqFM elt
+addToUFM       :: Uniquable key => UniqFM elt -> key -> elt  -> UniqFM elt
+addListToUFM   :: Uniquable key => UniqFM elt -> [(key,elt)] -> UniqFM elt
 addToUFM_Directly
                :: UniqFM elt -> Unique -> elt -> UniqFM elt
 
-addToUFM_C     :: NamedThing key => (elt -> elt -> elt)
+addToUFM_C     :: Uniquable key => (elt -> elt -> elt)
                           -> UniqFM elt -> key -> elt -> UniqFM elt
-addListToUFM_C :: NamedThing key => (elt -> elt -> elt)
+addListToUFM_C :: Uniquable key => (elt -> elt -> elt)
                           -> UniqFM elt -> [(key,elt)]
                           -> UniqFM elt
 
-delFromUFM     :: NamedThing key => UniqFM elt -> key   -> UniqFM elt
-delListFromUFM :: NamedThing key => UniqFM elt -> [key] -> UniqFM elt
+delFromUFM     :: Uniquable key => UniqFM elt -> key    -> UniqFM elt
+delListFromUFM :: Uniquable key => UniqFM elt -> [key] -> UniqFM elt
+delFromUFM_Directly :: UniqFM elt -> Unique -> UniqFM elt
 
 plusUFM                :: UniqFM elt -> UniqFM elt -> UniqFM elt
 
@@ -119,11 +119,11 @@ filterUFM :: (elt -> Bool) -> UniqFM elt -> UniqFM elt
 
 sizeUFM                :: UniqFM elt -> Int
 
-lookupUFM      :: NamedThing key => UniqFM elt -> key -> Maybe elt
+lookupUFM      :: Uniquable key => UniqFM elt -> key -> Maybe elt
 lookupUFM_Directly  -- when you've got the Unique already
                :: UniqFM elt -> Unique -> Maybe elt
 lookupWithDefaultUFM
-               :: NamedThing key => UniqFM elt -> elt -> key -> elt
+               :: Uniquable key => UniqFM elt -> elt -> key -> elt
 lookupWithDefaultUFM_Directly
                :: UniqFM elt -> elt -> Unique -> elt
 
@@ -138,89 +138,34 @@ ufmToList :: UniqFM elt -> [(Unique, elt)]
 %************************************************************************
 
 \begin{code}
-#if 0
-
-type IdFinMap   elt = UniqFM elt
-type TyVarFinMap elt = UniqFM elt
-type NameFinMap  elt = UniqFM elt
-type RegFinMap   elt = UniqFM elt
-
 #ifdef __GLASGOW_HASKELL__
 -- I don't think HBC was too happy about this (WDP 94/10)
 
 {-# SPECIALIZE
-    unitUFM :: Id        -> elt -> IdFinMap elt,
-                   TyVar -> elt -> TyVarFinMap elt,
-                   Name  -> elt -> NameFinMap elt
-    IF_NCG(COMMA    Reg   -> elt -> RegFinMap elt)
-  #-}
-{-# SPECIALIZE
-    listToUFM  :: [(Id,   elt)]     -> IdFinMap elt,
-                  [(TyVar,elt)]     -> TyVarFinMap elt,
-                  [(Name, elt)]     -> NameFinMap elt
-    IF_NCG(COMMA   [(Reg COMMA elt)] -> RegFinMap elt)
-  #-}
-{-# SPECIALIZE
-    addToUFM   :: IdFinMap    elt -> Id    -> elt  -> IdFinMap elt,
-                  TyVarFinMap elt -> TyVar -> elt  -> TyVarFinMap elt,
-                  NameFinMap  elt -> Name  -> elt  -> NameFinMap elt
-    IF_NCG(COMMA   RegFinMap   elt -> Reg   -> elt  -> RegFinMap elt)
+    addListToUFM :: UniqFM elt -> [(Name,   elt)] -> UniqFM elt
+                 , UniqFM elt -> [(RnName, elt)] -> UniqFM elt
   #-}
 {-# SPECIALIZE
-    addListToUFM :: IdFinMap   elt -> [(Id,   elt)] -> IdFinMap elt,
-                   TyVarFinMap elt -> [(TyVar,elt)] -> TyVarFinMap elt,
-                   NameFinMap  elt -> [(Name,elt)]  -> NameFinMap elt
-    IF_NCG(COMMA    RegFinMap   elt -> [(Reg COMMA elt)] -> RegFinMap elt)
+    addListToUFM_C :: (elt -> elt -> elt) -> UniqFM elt -> [(Name,  elt)] -> UniqFM elt
+                   , (elt -> elt -> elt) -> UniqFM elt -> [(RnName,elt)] -> UniqFM elt
   #-}
 {-# SPECIALIZE
-    addToUFM_C :: (elt -> elt -> elt)
-               -> IdFinMap elt -> Id -> elt -> IdFinMap elt,
-                  (elt -> elt -> elt)
-               -> TyVarFinMap elt -> TyVar -> elt -> TyVarFinMap elt,
-                  (elt -> elt -> elt)
-               -> NameFinMap elt -> Name -> elt -> NameFinMap elt
-    IF_NCG(COMMA   (elt -> elt -> elt)
-               -> RegFinMap elt -> Reg -> elt -> RegFinMap elt)
+    addToUFM   :: UniqFM elt -> Unique -> elt  -> UniqFM elt
   #-}
 {-# SPECIALIZE
-    addListToUFM_C :: (elt -> elt -> elt)
-               -> IdFinMap elt -> [(Id,elt)] -> IdFinMap elt,
-                  (elt -> elt -> elt)
-               -> TyVarFinMap elt -> [(TyVar,elt)] -> TyVarFinMap elt,
-                  (elt -> elt -> elt)
-               -> NameFinMap elt -> [(Name,elt)] -> NameFinMap elt
-    IF_NCG(COMMA   (elt -> elt -> elt)
-               -> RegFinMap elt -> [(Reg COMMA elt)] -> RegFinMap elt)
+    listToUFM  :: [(Unique, elt)]     -> UniqFM elt
+                , [(RnName, elt)]     -> UniqFM elt
   #-}
 {-# SPECIALIZE
-    delFromUFM :: IdFinMap elt    -> Id    -> IdFinMap elt,
-                  TyVarFinMap elt -> TyVar -> TyVarFinMap elt,
-                  NameFinMap elt  -> Name  -> NameFinMap elt
-    IF_NCG(COMMA    RegFinMap elt   -> Reg   -> RegFinMap elt)
+    lookupUFM  :: UniqFM elt -> Name   -> Maybe elt
+                , UniqFM elt -> RnName -> Maybe elt
+                , UniqFM elt -> Unique -> Maybe elt
   #-}
 {-# SPECIALIZE
-    delListFromUFM :: IdFinMap elt    -> [Id]   -> IdFinMap elt,
-                     TyVarFinMap elt -> [TyVar] -> TyVarFinMap elt,
-                     NameFinMap elt  -> [Name]  -> NameFinMap elt
-    IF_NCG(COMMA      RegFinMap elt   -> [Reg]   -> RegFinMap elt)
-  #-}
-
-{-# SPECIALIZE
-    lookupUFM  :: IdFinMap elt    -> Id    -> Maybe elt,
-                  TyVarFinMap elt -> TyVar -> Maybe elt,
-                  NameFinMap elt  -> Name  -> Maybe elt
-    IF_NCG(COMMA   RegFinMap elt   -> Reg   -> Maybe elt)
-  #-}
-{-# SPECIALIZE
-    lookupWithDefaultUFM
-               :: IdFinMap elt    -> elt -> Id    -> elt,
-                  TyVarFinMap elt -> elt -> TyVar -> elt,
-                  NameFinMap elt  -> elt -> Name  -> elt
-    IF_NCG(COMMA   RegFinMap elt   -> elt -> Reg   -> elt)
+    lookupWithDefaultUFM :: UniqFM elt -> elt -> RnName -> elt
   #-}
 
 #endif {- __GLASGOW_HASKELL__ -}
-#endif {- 0 -}
 \end{code}
 
 %************************************************************************
@@ -261,6 +206,9 @@ data UniqFM ele
            (UniqFM ele)
            (UniqFM ele)
 
+class Uniquable a where
+    uniqueOf :: a -> Unique
+
 -- for debugging only :-)
 {-
 instance Text (UniqFM a) where
@@ -285,7 +233,7 @@ First the ways of building a UniqFM.
 
 \begin{code}
 emptyUFM                    = EmptyUFM
-unitUFM             key elt = mkLeafUFM (u2i (getItsUnique key)) elt
+unitUFM             key elt = mkLeafUFM (u2i (uniqueOf key)) elt
 unitDirectlyUFM key elt = mkLeafUFM (u2i key) elt
 
 listToUFM key_elt_pairs
@@ -308,13 +256,13 @@ addToUFM fm key elt = addToUFM_C use_snd fm key elt
 addToUFM_Directly fm u elt = insert_ele use_snd fm (u2i u) elt
 
 addToUFM_C combiner fm key elt
-  = insert_ele combiner fm (u2i (getItsUnique key)) elt
+  = insert_ele combiner fm (u2i (uniqueOf key)) elt
 
 addListToUFM fm key_elt_pairs = addListToUFM_C use_snd fm key_elt_pairs
 addListToUFM_Directly fm uniq_elt_pairs = addListToUFM_directly_C use_snd fm uniq_elt_pairs
 
 addListToUFM_C combiner fm key_elt_pairs
- = foldl (\ fm (k, e) -> insert_ele combiner fm (u2i (getItsUnique k)) e)
+ = foldl (\ fm (k, e) -> insert_ele combiner fm (u2i (uniqueOf k)) e)
         fm key_elt_pairs
 
 addListToUFM_directly_C combiner fm uniq_elt_pairs
@@ -327,7 +275,8 @@ Now ways of removing things from UniqFM.
 \begin{code}
 delListFromUFM fm lst = foldl delFromUFM fm lst
 
-delFromUFM fm key = delete fm (u2i (getItsUnique key))
+delFromUFM          fm key = delete fm (u2i (uniqueOf key))
+delFromUFM_Directly fm u   = delete fm (u2i u)
 
 delete EmptyUFM _   = EmptyUFM
 delete fm       key = del_ele fm
@@ -436,8 +385,8 @@ minusUFM fm1 fm2     = minus_trees fm1 fm2
        --
        -- Notice the asymetry of subtraction
        --
-       minus_trees lf@(LeafUFM i a) t2        =
-               case lookup t2 i of
+       minus_trees lf@(LeafUFM i a) t2 =
+               case lookUp t2 i of
                  Nothing -> lf
                  Just b -> EmptyUFM
 
@@ -508,12 +457,12 @@ intersectUFM_C f _ EmptyUFM = EmptyUFM
 intersectUFM_C f fm1 fm2    = intersect_trees fm1 fm2
     where
        intersect_trees (LeafUFM i a) t2 =
-               case lookup t2 i of
+               case lookUp t2 i of
                  Nothing -> EmptyUFM
                  Just b -> mkLeafUFM i (f a b)
 
        intersect_trees t1 (LeafUFM i a) =
-               case lookup t1 i of
+               case lookUp t1 i of
                  Nothing -> EmptyUFM
                  Just b -> mkLeafUFM i (f b a)
 
@@ -596,21 +545,21 @@ looking up in a hurry is the {\em whole point} of this binary tree lark.
 Lookup up a binary tree is easy (and fast).
 
 \begin{code}
-lookupUFM        fm key = lookup fm (u2i (getItsUnique key))
-lookupUFM_Directly fm key = lookup fm (u2i key)
+lookupUFM         fm key = lookUp fm (u2i (uniqueOf key))
+lookupUFM_Directly fm key = lookUp fm (u2i key)
 
 lookupWithDefaultUFM fm deflt key
-  = case lookup fm (u2i (getItsUnique key)) of
+  = case lookUp fm (u2i (uniqueOf key)) of
       Nothing  -> deflt
       Just elt -> elt
 
 lookupWithDefaultUFM_Directly fm deflt key
-  = case lookup fm (u2i key) of
+  = case lookUp fm (u2i key) of
       Nothing  -> deflt
       Just elt -> elt
 
-lookup EmptyUFM _   = Nothing
-lookup fm i        = lookup_tree fm
+lookUp EmptyUFM _   = Nothing
+lookUp fm i        = lookup_tree fm
   where
        lookup_tree :: UniqFM a -> Maybe a
 
Glasgow Haskell Compiler with heterogeneous metaprogramming (generalized arrows and modal types)