projects / ghc-hetmet.git / blobdiff
? search:
summary | shortlog | log | commit | commitdiff | tree
raw | inline | side by side
[project @ 1997-06-05 08:51:03 by sof]
[ghc-hetmet.git] / ghc / compiler / utils / UniqFM.lhs
diff --git a/ghc/compiler/utils/UniqFM.lhs b/ghc/compiler/utils/UniqFM.lhs
index a2f4880..1cd56ff 100644 (file)
--- a/ghc/compiler/utils/UniqFM.lhs
+++ b/ghc/compiler/utils/UniqFM.lhs
@@ -28,12 +28,10 @@ module UniqFM (
        unitDirectlyUFM,
        listToUFM,
        listToUFM_Directly,
-       addToUFM,
-       addListToUFM,
+       addToUFM,addToUFM_C,
+       addListToUFM,addListToUFM_C,
        addToUFM_Directly,
        addListToUFM_Directly,
-       IF_NOT_GHC(addToUFM_C COMMA)
-       addListToUFM_C,
        delFromUFM,
        delFromUFM_Directly,
        delListFromUFM,
@@ -49,19 +47,27 @@ module UniqFM (
        isNullUFM,
        lookupUFM, lookupUFM_Directly,
        lookupWithDefaultUFM, lookupWithDefaultUFM_Directly,
-       eltsUFM,
+       eltsUFM, keysUFM,
        ufmToList
+#if defined(COMPILING_GHC)
+       ,FAST_STRING
+#endif
     ) where
 
+IMP_Ubiq()
+
 #if defined(COMPILING_GHC)
-IMP_Ubiq(){-uitous-}
+# if defined(__GLASGOW_HASKELL__) && __GLASGOW_HASKELL__ <= 201
+IMPORT_DELOOPER( SpecLoop )
+# else
+import {-# SOURCE #-} Name
+# endif
 #endif
 
 import Unique          ( Unique, u2i, mkUniqueGrimily )
 import Util
---import Outputable    ( Outputable(..), ExportFlag )
-import Pretty          ( Pretty(..), PrettyRep )
-import PprStyle                ( PprStyle )
+import Pretty          ( Doc )
+import Outputable      ( PprStyle, Outputable(..) )
 import SrcLoc          ( SrcLoc )
 
 #if ! OMIT_NATIVE_CODEGEN
@@ -128,6 +134,7 @@ lookupWithDefaultUFM
 lookupWithDefaultUFM_Directly
                :: UniqFM elt -> elt -> Unique -> elt
 
+keysUFM                :: UniqFM elt -> [Int]          -- Get the keys
 eltsUFM                :: UniqFM elt -> [elt]
 ufmToList      :: UniqFM elt -> [(Unique, elt)]
 \end{code}
@@ -139,89 +146,27 @@ 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)
+    addListToUFM :: UniqFM elt -> [(Name,   elt)] -> UniqFM 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_C :: (elt -> elt -> elt) -> UniqFM elt -> [(Name,  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)
+    addToUFM   :: UniqFM elt -> Unique -> 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)
+    listToUFM  :: [(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)
-  #-}
-{-# 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)
-  #-}
-{-# 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)
+    lookupUFM  :: UniqFM elt -> Name   -> Maybe elt
+                , UniqFM elt -> Unique -> Maybe elt
   #-}
 
 #endif {- __GLASGOW_HASKELL__ -}
-#endif {- 0 -}
 \end{code}
 
 %************************************************************************
@@ -441,8 +386,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
 
@@ -513,12 +458,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)
 
@@ -573,9 +518,12 @@ intersectUFM_C f fm1 fm2    = intersect_trees fm1 fm2
 Now the usual set of `collection' operators, like map, fold, etc.
 
 \begin{code}
-foldUFM fn a EmptyUFM = a
-foldUFM fn a fm              = fold_tree fn a fm
+foldUFM f a (NodeUFM _ _ t1 t2) = foldUFM f (foldUFM f a t2) t1
+foldUFM f a (LeafUFM _ obj)     = f obj a
+foldUFM f a EmptyUFM           = a
+\end{code}
 
+\begin{code}
 mapUFM fn EmptyUFM    = EmptyUFM
 mapUFM fn fm         = map_tree fn fm
 
@@ -601,21 +549,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 (uniqueOf 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 (uniqueOf 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
 
@@ -632,17 +580,15 @@ lookup fm i           = lookup_tree fm
 folds are *wonderful* things.
 
 \begin{code}
-eltsUFM EmptyUFM = []
-eltsUFM fm       = fold_tree (:) [] fm
+eltsUFM fm = foldUFM (:) [] fm
 
-ufmToList EmptyUFM = []
-ufmToList fm
-  = fold_tree (\ iu elt rest -> (mkUniqueGrimily iu, elt) : rest) [] fm
-  where
-    fold_tree f a (NodeUFM _ _ t1 t2) = fold_tree f (fold_tree f a t2) t1
-    fold_tree f a (LeafUFM iu obj)    = f iu obj a
+ufmToList fm = fold_tree (\ iu elt rest -> (mkUniqueGrimily iu, elt) : rest) [] fm
+
+keysUFM fm = fold_tree (\ iu elt rest -> IBOX(iu) : rest) [] fm
 
-    fold_tree f a EmptyUFM = panic "Should Never fold over an EmptyUFM"
+fold_tree f a (NodeUFM _ _ t1 t2) = fold_tree f (fold_tree f a t2) t1
+fold_tree f a (LeafUFM iu obj)    = f iu obj a
+fold_tree f a EmptyUFM           = a
 \end{code}
 
 %************************************************************************
@@ -752,14 +698,7 @@ insert_ele f n@(NodeUFM j p t1 t2) i a
                  (mkLeafUFM i a)
 \end{code}
 
-This has got a left to right ordering.
 
-\begin{code}
-fold_tree f a (NodeUFM _ _ t1 t2) = fold_tree f (fold_tree f a t2) t1
-fold_tree f a (LeafUFM _ obj)    = f obj a
-
-fold_tree f a EmptyUFM = panic "Should Never fold over an EmptyUFM"
-\end{code}
 
 \begin{code}
 map_tree f (NodeUFM j p t1 t2)
@@ -777,6 +716,7 @@ filter_tree f nd@(NodeUFM j p t1 t2)
 filter_tree f lf@(LeafUFM i obj)
   | f obj = lf
   | otherwise = EmptyUFM
+filter_tree f _ = panic "filter_tree failed"
 \end{code}
 
 %************************************************************************
@@ -877,12 +817,7 @@ shiftR_ n p = n `quot` (2 ^ p)
 #endif {- not GHC -}
 \end{code}
 
-Andy's extras: ToDo: to Util.
-
 \begin{code}
-use_fst :: a -> b -> a
-use_fst a b = a
-
 use_snd :: a -> b -> b
 use_snd a b = b
 \end{code}
Glasgow Haskell Compiler with heterogeneous metaprogramming (generalized arrows and modal types)