projects
/
ghc-hetmet.git
/ blobdiff
commit
grep
author
committer
pickaxe
?
search:
re
summary
|
shortlog
|
log
|
commit
|
commitdiff
|
tree
raw
|
inline
| side by side
refactoring only: use the parameterised InstalledPackageInfo
[ghc-hetmet.git]
/
compiler
/
utils
/
UniqFM.lhs
diff --git
a/compiler/utils/UniqFM.lhs
b/compiler/utils/UniqFM.lhs
index
b6810c8
..
2184f52
100644
(file)
--- a/
compiler/utils/UniqFM.lhs
+++ b/
compiler/utils/UniqFM.lhs
@@
-13,15
+13,10
@@
Basically, the things need to be in class @Uniquable@, and we use the
(A similar thing to @UniqSet@, as opposed to @Set@.)
\begin{code}
(A similar thing to @UniqSet@, as opposed to @Set@.)
\begin{code}
-{-# OPTIONS_GHC -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/WorkingConventions#Warnings
--- for details
-
+{-# OPTIONS -Wall -fno-warn-name-shadowing #-}
module UniqFM (
module UniqFM (
- UniqFM, -- abstract type
+ UniqFM(..), -- abstract type
+ -- (de-abstracted for MachRegs.trivColorable optimisation BL 2007/09)
emptyUFM,
unitUFM,
emptyUFM,
unitUFM,
@@
-41,7
+36,7
@@
module UniqFM (
intersectsUFM,
intersectUFM,
intersectUFM_C,
intersectsUFM,
intersectUFM,
intersectUFM_C,
- foldUFM,
+ foldUFM, foldUFM_Directly,
mapUFM,
elemUFM, elemUFM_Directly,
filterUFM, filterUFM_Directly,
mapUFM,
elemUFM, elemUFM_Directly,
filterUFM, filterUFM_Directly,
@@
-84,6
+79,7
@@
listToUFM_Directly
addToUFM :: Uniquable key => UniqFM elt -> key -> elt -> UniqFM elt
addListToUFM :: Uniquable 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
+addListToUFM_Directly :: UniqFM elt -> [(Unique,elt)] -> UniqFM elt
addToUFM_Directly
:: UniqFM elt -> Unique -> elt -> UniqFM elt
addToUFM_Directly
:: UniqFM elt -> Unique -> elt -> UniqFM elt
@@
-120,6
+116,7
@@
intersectUFM_C :: (elt1 -> elt2 -> elt3)
intersectsUFM :: UniqFM elt1 -> UniqFM elt2 -> Bool
foldUFM :: (elt -> a -> a) -> a -> UniqFM elt -> a
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
mapUFM :: (elt1 -> elt2) -> UniqFM elt1 -> UniqFM elt2
filterUFM :: (elt -> Bool) -> UniqFM elt -> UniqFM elt
filterUFM_Directly :: (Unique -> elt -> Bool) -> UniqFM elt -> UniqFM elt
@@
-277,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
= 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
addListToUFM_directly_C combiner fm uniq_elt_pairs
= foldl (\ fm (k, e) -> insert_ele combiner fm (getKey# k) e)
fm uniq_elt_pairs
@@
-290,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)
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
delete EmptyUFM _ = EmptyUFM
delete fm key = del_ele fm
where
@@
-299,7
+298,7
@@
delete fm key = del_ele fm
| j ==# key = EmptyUFM
| otherwise = lf -- no delete!
| 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
| j ># key
= mkSLNodeUFM (NodeUFMData j p) (del_ele t1) t2
| otherwise
@@
-313,8
+312,8
@@
Now ways of adding two UniqFM's together.
\begin{code}
plusUFM tr1 tr2 = plusUFM_C use_snd tr1 tr2
\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
plusUFM_C f fm1 fm2 = mix_trees fm1 fm2
where
mix_trees (LeafUFM i a) t2 = insert_ele (flip f) t2 i a
@@
-397,10
+396,10
@@
minusUFM fm1 fm2 = minus_trees fm1 fm2
--
-- Notice the asymetry of subtraction
--
--
-- 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
case lookUp t2 i of
Nothing -> lf
- Just b -> EmptyUFM
+ Just _ -> EmptyUFM
minus_trees t1 (LeafUFM i _) = delete t1 i
minus_trees t1 (LeafUFM i _) = delete t1 i
@@
-419,7
+418,7
@@
minusUFM fm1 fm2 = minus_trees fm1 fm2
--
-- Fast, Ehh !
--
--
-- Fast, Ehh !
--
- minus_branches (NewRoot nd _) = left_t
+ minus_branches (NewRoot _ _) = left_t
-- Now, if j == j':
--
-- Now, if j == j':
--
@@
-465,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 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 =
intersectUFM_C f fm1 fm2 = intersect_trees fm1 fm2
where
intersect_trees (LeafUFM i a) t2 =
@@
-493,7
+492,7
@@
intersectUFM_C f fm1 fm2 = intersect_trees fm1 fm2
--
-- Fast, Ehh !
--
--
-- Fast, Ehh !
--
- intersect_branches (NewRoot nd _) = EmptyUFM
+ intersect_branches (NewRoot _nd _) = EmptyUFM
-- Now, if j == j':
--
-- Now, if j == j':
--
@@
-524,7
+523,7
@@
intersectUFM_C f fm1 fm2 = intersect_trees fm1 fm2
intersect_branches (RightRoot Rightt)
= intersect_trees left_t t2'
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.
\end{code}
Now the usual set of `collection' operators, like map, fold, etc.
@@
-532,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
\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}
\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
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}
where
pred i e = fn (mkUniqueGrimily (iBox i)) e
\end{code}
@@
-590,6
+589,7
@@
lookupWithDefaultUFM_Directly fm deflt key
Nothing -> deflt
Just elt -> elt
Nothing -> deflt
Just elt -> elt
+lookUp :: UniqFM a -> Int# -> Maybe a
lookUp EmptyUFM _ = Nothing
lookUp fm i = lookup_tree fm
where
lookUp EmptyUFM _ = Nothing
lookUp fm i = lookup_tree fm
where
@@
-598,7
+598,7
@@
lookUp fm i = lookup_tree fm
lookup_tree (LeafUFM j b)
| j ==# i = Just b
| otherwise = Nothing
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
| j ># i = lookup_tree t1
| otherwise = lookup_tree t2
@@
-608,15
+608,15
@@
lookUp fm i = lookup_tree fm
folds are *wonderful* things.
\begin{code}
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 (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}
%************************************************************************
\end{code}
%************************************************************************
@@
-642,18
+642,21
@@
mkLeafUFM i a = LeafUFM i a
-- The *ONLY* ways of building a NodeUFM.
-- 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
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
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
mkLSNodeUFM (NodeUFMData j p) t1 t2
= ASSERT(correctNodeUFM (iBox j) (iBox p) t1 t2)
NodeUFM j p t1 t2
@@
-690,9
+693,9
@@
insert_ele
-> a
-> UniqFM a
-> 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)
| j ># i =
mkLLNodeUFM (getCommonNodeUFMData
(indexToRoot i)
@@
-729,23
+732,24
@@
insert_ele f n@(NodeUFM j p t1 t2) i a
\begin{code}
\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 (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
\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
= 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}
%************************************************************************
\end{code}
%************************************************************************
@@
-809,11
+813,11
@@
getCommonNodeUFMData (NodeUFMData i p) (NodeUFMData i2 p2)
ask_about_common_ancestor :: NodeUFMData -> NodeUFMData -> CommonRoot
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
| 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)
| j3 ==# j -> LeftRoot (decideSide (j ># j2))
| j3 ==# j2 -> RightRoot (decideSide (j <# j2))
| otherwise -> NewRoot nd (j ># j2)
@@
-846,5
+850,10
@@
shiftR_ n p = n `quot` (2 ^ p)
\begin{code}
use_snd :: a -> b -> b
\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}
\end{code}