Skip to content
GitLab
Projects
Groups
Snippets
/
Help
Help
Support
Community forum
Keyboard shortcuts
?
Submit feedback
Sign in / Register
Toggle navigation
Menu
Open sidebar
Glasgow Haskell Compiler
GHC
Commits
bbd67a5f
Commit
bbd67a5f
authored
Sep 15, 2007
by
nr@eecs.harvard.edu
Browse files
added foldUFM_Directly, used where appropriate, killed all warnings
parent
4559ed11
Changes
1
Hide whitespace changes
Inline
Side-by-side
compiler/utils/UniqFM.lhs
View file @
bbd67a5f
...
...
@@ -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}
Write
Preview
Supports
Markdown
0%
Try again
or
attach a new file
.
Cancel
You are about to add
0
people
to the discussion. Proceed with caution.
Finish editing this message first!
Cancel
Please
register
or
sign in
to comment