summaryrefslogtreecommitdiff
path: root/compiler/utils/UniqFM.lhs
diff options
context:
space:
mode:
authorNorman Ramsey <nr@eecs.harvard.edu>2007-09-15 19:06:17 +0000
committerNorman Ramsey <nr@eecs.harvard.edu>2007-09-15 19:06:17 +0000
commitbbd67a5f4f3515ea5c37711815b2f6ad58cbd655 (patch)
treeabfa0dad44997b70b7db8d62fb849afbca1bb681 /compiler/utils/UniqFM.lhs
parent4559ed114a3c16ee6840abc503c5438d799505f1 (diff)
downloadhaskell-bbd67a5f4f3515ea5c37711815b2f6ad58cbd655.tar.gz
added foldUFM_Directly, used where appropriate, killed all warnings
Diffstat (limited to 'compiler/utils/UniqFM.lhs')
-rw-r--r--compiler/utils/UniqFM.lhs98
1 files changed, 53 insertions, 45 deletions
diff --git a/compiler/utils/UniqFM.lhs b/compiler/utils/UniqFM.lhs
index 242fe22c3c..2184f52db6 100644
--- a/compiler/utils/UniqFM.lhs
+++ b/compiler/utils/UniqFM.lhs
@@ -13,13 +13,7 @@ Basically, the things need to be in class @Uniquable@, and we use the
(A similar thing to @UniqSet@, as opposed to @Set@.)
\begin{code}
-{-# OPTIONS -w #-}
--- The above warning supression flag is a temporary kludge.
--- While working on this module you are encouraged to remove it and fix
--- any warnings in the module. See
--- http://hackage.haskell.org/trac/ghc/wiki/Commentary/CodingStyle#Warnings
--- for details
-
+{-# OPTIONS -Wall -fno-warn-name-shadowing #-}
module UniqFM (
UniqFM(..), -- abstract type
-- (de-abstracted for MachRegs.trivColorable optimisation BL 2007/09)
@@ -42,7 +36,7 @@ module UniqFM (
intersectsUFM,
intersectUFM,
intersectUFM_C,
- foldUFM,
+ foldUFM, foldUFM_Directly,
mapUFM,
elemUFM, elemUFM_Directly,
filterUFM, filterUFM_Directly,
@@ -85,6 +79,7 @@ listToUFM_Directly
addToUFM :: Uniquable key => UniqFM elt -> key -> elt -> UniqFM elt
addListToUFM :: Uniquable key => UniqFM elt -> [(key,elt)] -> UniqFM elt
+addListToUFM_Directly :: UniqFM elt -> [(Unique,elt)] -> UniqFM elt
addToUFM_Directly
:: UniqFM elt -> Unique -> elt -> UniqFM elt
@@ -121,6 +116,7 @@ intersectUFM_C :: (elt1 -> elt2 -> elt3)
intersectsUFM :: UniqFM elt1 -> UniqFM elt2 -> Bool
foldUFM :: (elt -> a -> a) -> a -> UniqFM elt -> a
+foldUFM_Directly:: (Unique -> elt -> a -> a) -> a -> UniqFM elt -> a
mapUFM :: (elt1 -> elt2) -> UniqFM elt1 -> UniqFM elt2
filterUFM :: (elt -> Bool) -> UniqFM elt -> UniqFM elt
filterUFM_Directly :: (Unique -> elt -> Bool) -> UniqFM elt -> UniqFM elt
@@ -278,6 +274,7 @@ addListToUFM_C combiner fm key_elt_pairs
= foldl (\ fm (k, e) -> insert_ele combiner fm (getKey# (getUnique k)) e)
fm key_elt_pairs
+addListToUFM_directly_C :: (elt -> elt -> elt) -> UniqFM elt -> [(Unique,elt)] -> UniqFM elt
addListToUFM_directly_C combiner fm uniq_elt_pairs
= foldl (\ fm (k, e) -> insert_ele combiner fm (getKey# k) e)
fm uniq_elt_pairs
@@ -291,6 +288,7 @@ delListFromUFM fm lst = foldl delFromUFM fm lst
delFromUFM fm key = delete fm (getKey# (getUnique key))
delFromUFM_Directly fm u = delete fm (getKey# u)
+delete :: UniqFM a -> Int# -> UniqFM a
delete EmptyUFM _ = EmptyUFM
delete fm key = del_ele fm
where
@@ -300,7 +298,7 @@ delete fm key = del_ele fm
| j ==# key = EmptyUFM
| otherwise = lf -- no delete!
- del_ele nd@(NodeUFM j p t1 t2)
+ del_ele (NodeUFM j p t1 t2)
| j ># key
= mkSLNodeUFM (NodeUFMData j p) (del_ele t1) t2
| otherwise
@@ -314,8 +312,8 @@ Now ways of adding two UniqFM's together.
\begin{code}
plusUFM tr1 tr2 = plusUFM_C use_snd tr1 tr2
-plusUFM_C f EmptyUFM tr = tr
-plusUFM_C f tr EmptyUFM = tr
+plusUFM_C _ EmptyUFM tr = tr
+plusUFM_C _ tr EmptyUFM = tr
plusUFM_C f fm1 fm2 = mix_trees fm1 fm2
where
mix_trees (LeafUFM i a) t2 = insert_ele (flip f) t2 i a
@@ -398,10 +396,10 @@ minusUFM fm1 fm2 = minus_trees fm1 fm2
--
-- Notice the asymetry of subtraction
--
- minus_trees lf@(LeafUFM i a) t2 =
+ minus_trees lf@(LeafUFM i _a) t2 =
case lookUp t2 i of
Nothing -> lf
- Just b -> EmptyUFM
+ Just _ -> EmptyUFM
minus_trees t1 (LeafUFM i _) = delete t1 i
@@ -420,7 +418,7 @@ minusUFM fm1 fm2 = minus_trees fm1 fm2
--
-- Fast, Ehh !
--
- minus_branches (NewRoot nd _) = left_t
+ minus_branches (NewRoot _ _) = left_t
-- Now, if j == j':
--
@@ -466,8 +464,8 @@ And taking the intersection of two UniqFM's.
intersectUFM t1 t2 = intersectUFM_C use_snd t1 t2
intersectsUFM t1 t2 = isNullUFM (intersectUFM_C (\ _ _ -> error "urk") t1 t2)
-intersectUFM_C f EmptyUFM _ = EmptyUFM
-intersectUFM_C f _ EmptyUFM = EmptyUFM
+intersectUFM_C _ EmptyUFM _ = EmptyUFM
+intersectUFM_C _ _ EmptyUFM = EmptyUFM
intersectUFM_C f fm1 fm2 = intersect_trees fm1 fm2
where
intersect_trees (LeafUFM i a) t2 =
@@ -494,7 +492,7 @@ intersectUFM_C f fm1 fm2 = intersect_trees fm1 fm2
--
-- Fast, Ehh !
--
- intersect_branches (NewRoot nd _) = EmptyUFM
+ intersect_branches (NewRoot _nd _) = EmptyUFM
-- Now, if j == j':
--
@@ -525,7 +523,7 @@ intersectUFM_C f fm1 fm2 = intersect_trees fm1 fm2
intersect_branches (RightRoot Rightt)
= intersect_trees left_t t2'
- intersect_trees x y = panic ("EmptyUFM found when intersecting trees")
+ intersect_trees _ _ = panic ("EmptyUFM found when intersecting trees")
\end{code}
Now the usual set of `collection' operators, like map, fold, etc.
@@ -533,20 +531,20 @@ Now the usual set of `collection' operators, like map, fold, etc.
\begin{code}
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
+foldUFM _ a EmptyUFM = a
\end{code}
\begin{code}
-mapUFM fn EmptyUFM = EmptyUFM
-mapUFM fn fm = map_tree fn fm
+mapUFM _fn EmptyUFM = EmptyUFM
+mapUFM fn fm = map_tree fn fm
-filterUFM fn EmptyUFM = EmptyUFM
-filterUFM fn fm = filter_tree pred fm
+filterUFM _fn EmptyUFM = EmptyUFM
+filterUFM fn fm = filter_tree pred fm
where
- pred (i::FastInt) e = fn e
+ pred (_::FastInt) e = fn e
-filterUFM_Directly fn EmptyUFM = EmptyUFM
-filterUFM_Directly fn fm = filter_tree pred fm
+filterUFM_Directly _fn EmptyUFM = EmptyUFM
+filterUFM_Directly fn fm = filter_tree pred fm
where
pred i e = fn (mkUniqueGrimily (iBox i)) e
\end{code}
@@ -591,6 +589,7 @@ lookupWithDefaultUFM_Directly fm deflt key
Nothing -> deflt
Just elt -> elt
+lookUp :: UniqFM a -> Int# -> Maybe a
lookUp EmptyUFM _ = Nothing
lookUp fm i = lookup_tree fm
where
@@ -599,7 +598,7 @@ lookUp fm i = lookup_tree fm
lookup_tree (LeafUFM j b)
| j ==# i = Just b
| otherwise = Nothing
- lookup_tree (NodeUFM j p t1 t2)
+ lookup_tree (NodeUFM j _ t1 t2)
| j ># i = lookup_tree t1
| otherwise = lookup_tree t2
@@ -609,15 +608,15 @@ lookUp fm i = lookup_tree fm
folds are *wonderful* things.
\begin{code}
-eltsUFM fm = foldUFM (:) [] fm
-
-ufmToList fm = fold_tree (\ iu elt rest -> (mkUniqueGrimily (iBox iu), elt) : rest) [] fm
-
-keysUFM fm = fold_tree (\ iu elt rest -> mkUniqueGrimily (iBox iu) : rest) [] fm
+eltsUFM fm = foldUFM (:) [] fm
+keysUFM fm = foldUFM_Directly (\u _ l -> u : l) [] fm
+ufmToList fm = foldUFM_Directly (\u e l -> (u, e) : l) [] fm
+foldUFM_Directly f = fold_tree (\iu e a -> f (mkUniqueGrimily (iBox iu)) e a)
+fold_tree :: (FastInt -> elt -> a -> a) -> a -> UniqFM elt -> a
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
+fold_tree _ a EmptyUFM = a
\end{code}
%************************************************************************
@@ -643,18 +642,21 @@ mkLeafUFM i a = LeafUFM i a
-- The *ONLY* ways of building a NodeUFM.
-mkSSNodeUFM (NodeUFMData j p) EmptyUFM t2 = t2
-mkSSNodeUFM (NodeUFMData j p) t1 EmptyUFM = t1
+mkSSNodeUFM, mkSLNodeUFM, mkLSNodeUFM, mkLLNodeUFM ::
+ NodeUFMData -> UniqFM a -> UniqFM a -> UniqFM a
+
+mkSSNodeUFM (NodeUFMData _ _) EmptyUFM t2 = t2
+mkSSNodeUFM (NodeUFMData _ _) t1 EmptyUFM = t1
mkSSNodeUFM (NodeUFMData j p) t1 t2
= ASSERT(correctNodeUFM (iBox j) (iBox p) t1 t2)
NodeUFM j p t1 t2
-mkSLNodeUFM (NodeUFMData j p) EmptyUFM t2 = t2
+mkSLNodeUFM (NodeUFMData _ _) EmptyUFM t2 = t2
mkSLNodeUFM (NodeUFMData j p) t1 t2
= ASSERT(correctNodeUFM (iBox j) (iBox p) t1 t2)
NodeUFM j p t1 t2
-mkLSNodeUFM (NodeUFMData j p) t1 EmptyUFM = t1
+mkLSNodeUFM (NodeUFMData _ _) t1 EmptyUFM = t1
mkLSNodeUFM (NodeUFMData j p) t1 t2
= ASSERT(correctNodeUFM (iBox j) (iBox p) t1 t2)
NodeUFM j p t1 t2
@@ -691,9 +693,9 @@ insert_ele
-> a
-> UniqFM a
-insert_ele f EmptyUFM i new = mkLeafUFM i new
+insert_ele _f EmptyUFM i new = mkLeafUFM i new
-insert_ele f (LeafUFM j old) i new
+insert_ele f (LeafUFM j old) i new
| j ># i =
mkLLNodeUFM (getCommonNodeUFMData
(indexToRoot i)
@@ -730,23 +732,24 @@ insert_ele f n@(NodeUFM j p t1 t2) i a
\begin{code}
+map_tree :: (a -> b) -> UniqFM a -> UniqFM b
map_tree f (NodeUFM j p t1 t2)
= mkLLNodeUFM (NodeUFMData j p) (map_tree f t1) (map_tree f t2)
-- NB. lazy! we know the tree is well-formed.
map_tree f (LeafUFM i obj)
= mkLeafUFM i (f obj)
-map_tree f _ = panic "map_tree failed"
+map_tree _ _ = panic "map_tree failed"
\end{code}
\begin{code}
filter_tree :: (FastInt -> a -> Bool) -> UniqFM a -> UniqFM a
-filter_tree f nd@(NodeUFM j p t1 t2)
+filter_tree f (NodeUFM j p t1 t2)
= mkSSNodeUFM (NodeUFMData j p) (filter_tree f t1) (filter_tree f t2)
filter_tree f lf@(LeafUFM i obj)
| f i obj = lf
| otherwise = EmptyUFM
-filter_tree f _ = panic "filter_tree failed"
+filter_tree _ _ = panic "filter_tree failed"
\end{code}
%************************************************************************
@@ -810,11 +813,11 @@ getCommonNodeUFMData (NodeUFMData i p) (NodeUFMData i2 p2)
ask_about_common_ancestor :: NodeUFMData -> NodeUFMData -> CommonRoot
-ask_about_common_ancestor x@(NodeUFMData j p) y@(NodeUFMData j2 p2)
+ask_about_common_ancestor x@(NodeUFMData j _p) y@(NodeUFMData j2 _p2)
| j ==# j2 = SameRoot
| otherwise
= case getCommonNodeUFMData x y of
- nd@(NodeUFMData j3 p3)
+ nd@(NodeUFMData j3 _p3)
| j3 ==# j -> LeftRoot (decideSide (j ># j2))
| j3 ==# j2 -> RightRoot (decideSide (j <# j2))
| otherwise -> NewRoot nd (j ># j2)
@@ -847,5 +850,10 @@ shiftR_ n p = n `quot` (2 ^ p)
\begin{code}
use_snd :: a -> b -> b
-use_snd a b = b
+use_snd _ b = b
+\end{code}
+
+\begin{code}
+_unused :: FS.FastString
+_unused = undefined
\end{code}