projects
/
ghc-hetmet.git
/ blobdiff
commit
grep
author
committer
pickaxe
?
search:
re
summary
|
shortlog
|
log
|
commit
|
commitdiff
|
tree
raw
|
inline
| side by side
Don't generate stub files when -fno-code is given.
[ghc-hetmet.git]
/
ghc
/
compiler
/
utils
/
UniqFM.lhs
diff --git
a/ghc/compiler/utils/UniqFM.lhs
b/ghc/compiler/utils/UniqFM.lhs
index
8512bad
..
84294aa
100644
(file)
--- a/
ghc/compiler/utils/UniqFM.lhs
+++ b/
ghc/compiler/utils/UniqFM.lhs
@@
-1,4
+1,4
@@
-%
+%ilter
% (c) The AQUA Project, Glasgow University, 1994-1998
%
\section[UniqFM]{Specialised finite maps, for things with @Uniques@}
% (c) The AQUA Project, Glasgow University, 1994-1998
%
\section[UniqFM]{Specialised finite maps, for things with @Uniques@}
@@
-19,7
+19,7
@@
module UniqFM (
unitDirectlyUFM,
listToUFM,
listToUFM_Directly,
unitDirectlyUFM,
listToUFM,
listToUFM_Directly,
- addToUFM,addToUFM_C,
+ addToUFM,addToUFM_C,addToUFM_Acc,
addListToUFM,addListToUFM_C,
addToUFM_Directly,
addListToUFM_Directly,
addListToUFM,addListToUFM_C,
addToUFM_Directly,
addListToUFM_Directly,
@@
-33,8
+33,8
@@
module UniqFM (
intersectUFM_C,
foldUFM,
mapUFM,
intersectUFM_C,
foldUFM,
mapUFM,
- elemUFM,
- filterUFM,
+ elemUFM, elemUFM_Directly,
+ filterUFM, filterUFM_Directly,
sizeUFM,
hashUFM,
isNullUFM,
sizeUFM,
hashUFM,
isNullUFM,
@@
-46,13
+46,12
@@
module UniqFM (
#include "HsVersions.h"
#include "HsVersions.h"
-import {-# SOURCE #-} Name ( Name )
-
-import Unique ( Uniquable(..), Unique, u2i, mkUniqueGrimily )
-import Panic
-import GlaExts -- Lots of Int# operations
+import Unique ( Uniquable(..), Unique, getKey#, mkUniqueGrimily )
+import Maybes ( maybeToBool )
import FastTypes
import Outputable
import FastTypes
import Outputable
+
+import GLAEXTS -- Lots of Int# operations
\end{code}
%************************************************************************
\end{code}
%************************************************************************
@@
-83,6
+82,13
@@
addToUFM_C :: Uniquable key => (elt -> elt -> elt) -- old -> new -> result
-> key -> elt -- new
-> UniqFM elt -- result
-> key -> elt -- new
-> UniqFM elt -- result
+addToUFM_Acc :: Uniquable key =>
+ (elt -> elts -> elts) -- Add to existing
+ -> (elt -> elts) -- New element
+ -> UniqFM elts -- old
+ -> key -> elt -- new
+ -> UniqFM elts -- result
+
addListToUFM_C :: Uniquable key => (elt -> elt -> elt)
-> UniqFM elt -> [(key,elt)]
-> UniqFM elt
addListToUFM_C :: Uniquable key => (elt -> elt -> elt)
-> UniqFM elt -> [(key,elt)]
-> UniqFM elt
@@
-104,10
+110,12
@@
intersectUFM_C :: (elt1 -> elt2 -> elt3)
foldUFM :: (elt -> a -> a) -> a -> UniqFM elt -> a
mapUFM :: (elt1 -> elt2) -> UniqFM elt1 -> UniqFM elt2
filterUFM :: (elt -> Bool) -> UniqFM elt -> UniqFM elt
foldUFM :: (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
sizeUFM :: UniqFM elt -> Int
hashUFM :: UniqFM elt -> Int
elemUFM :: Uniquable key => key -> UniqFM elt -> Bool
sizeUFM :: UniqFM elt -> Int
hashUFM :: UniqFM elt -> Int
elemUFM :: Uniquable key => key -> UniqFM elt -> Bool
+elemUFM_Directly:: Unique -> UniqFM elt -> Bool
lookupUFM :: Uniquable key => UniqFM elt -> key -> Maybe elt
lookupUFM_Directly -- when you've got the Unique already
lookupUFM :: Uniquable key => UniqFM elt -> key -> Maybe elt
lookupUFM_Directly -- when you've got the Unique already
@@
-152,7
+160,7
@@
ufmToList :: UniqFM elt -> [(Unique, elt)]
, UniqFM elt -> Unique -> Maybe elt
#-}
, UniqFM elt -> Unique -> Maybe elt
#-}
-#endif {- __GLASGOW_HASKELL__ -}
+#endif /* __GLASGOW_HASKELL__ */
#endif
\end{code}
#endif
\end{code}
@@
-193,6
+201,7
@@
data UniqFM ele
FastInt -- the delta
(UniqFM ele)
(UniqFM ele)
FastInt -- the delta
(UniqFM ele)
(UniqFM ele)
+-- INVARIANT: the children of a NodeUFM are never EmptyUFMs
{-
-- for debugging only :-)
{-
-- for debugging only :-)
@@
-219,8
+228,8
@@
First the ways of building a UniqFM.
\begin{code}
emptyUFM = EmptyUFM
\begin{code}
emptyUFM = EmptyUFM
-unitUFM key elt = mkLeafUFM (u2i (getUnique key)) elt
-unitDirectlyUFM key elt = mkLeafUFM (u2i key) elt
+unitUFM key elt = mkLeafUFM (getKey# (getUnique key)) elt
+unitDirectlyUFM key elt = mkLeafUFM (getKey# key) elt
listToUFM key_elt_pairs
= addListToUFM_C use_snd EmptyUFM key_elt_pairs
listToUFM key_elt_pairs
= addListToUFM_C use_snd EmptyUFM key_elt_pairs
@@
-239,20
+248,25
@@
could be optimised using it.
\begin{code}
addToUFM fm key elt = addToUFM_C use_snd fm key elt
\begin{code}
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_Directly fm u elt = insert_ele use_snd fm (getKey# u) elt
addToUFM_C combiner fm key elt
addToUFM_C combiner fm key elt
- = insert_ele combiner fm (u2i (getUnique key)) elt
+ = insert_ele combiner fm (getKey# (getUnique key)) elt
+
+addToUFM_Acc add unit fm key item
+ = insert_ele combiner fm (getKey# (getUnique key)) (unit item)
+ where
+ combiner old _unit_item = add item old
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
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 (getUnique k)) e)
+ = foldl (\ fm (k, e) -> insert_ele combiner fm (getKey# (getUnique k)) e)
fm key_elt_pairs
addListToUFM_directly_C combiner fm uniq_elt_pairs
fm key_elt_pairs
addListToUFM_directly_C combiner fm uniq_elt_pairs
- = foldl (\ fm (k, e) -> insert_ele combiner fm (u2i k) e)
+ = foldl (\ fm (k, e) -> insert_ele combiner fm (getKey# k) e)
fm uniq_elt_pairs
\end{code}
fm uniq_elt_pairs
\end{code}
@@
-261,8
+275,8
@@
Now ways of removing things from UniqFM.
\begin{code}
delListFromUFM fm lst = foldl delFromUFM fm lst
\begin{code}
delListFromUFM fm lst = foldl delFromUFM fm lst
-delFromUFM fm key = delete fm (u2i (getUnique key))
-delFromUFM_Directly fm u = delete fm (u2i u)
+delFromUFM fm key = delete fm (getKey# (getUnique key))
+delFromUFM_Directly fm u = delete fm (getKey# u)
delete EmptyUFM _ = EmptyUFM
delete fm key = del_ele fm
delete EmptyUFM _ = EmptyUFM
delete fm key = del_ele fm
@@
-333,25
+347,25
@@
plusUFM_C f fm1 fm2 = mix_trees fm1 fm2
-- t1 t2 t1' t2' t1 t2 + j'
-- / \
-- t1' t2'
-- t1 t2 t1' t2' t1 t2 + j'
-- / \
-- t1' t2'
- mix_branches (LeftRoot Leftt) -- | trace "LL" True
+ mix_branches (LeftRoot Leftt) -- | trace "LL" True
= mkSLNodeUFM
(NodeUFMData j p)
(mix_trees t1 right_t)
t2
= mkSLNodeUFM
(NodeUFMData j p)
(mix_trees t1 right_t)
t2
- mix_branches (LeftRoot Rightt) -- | trace "LR" True
+ mix_branches (LeftRoot Rightt) -- | trace "LR" True
= mkLSNodeUFM
(NodeUFMData j p)
t1
(mix_trees t2 right_t)
= mkLSNodeUFM
(NodeUFMData j p)
t1
(mix_trees t2 right_t)
- mix_branches (RightRoot Leftt) -- | trace "RL" True
+ mix_branches (RightRoot Leftt) -- | trace "RL" True
= mkSLNodeUFM
(NodeUFMData j' p')
(mix_trees left_t t1')
t2'
= mkSLNodeUFM
(NodeUFMData j' p')
(mix_trees left_t t1')
t2'
- mix_branches (RightRoot Rightt) -- | trace "RR" True
+ mix_branches (RightRoot Rightt) -- | trace "RR" True
= mkLSNodeUFM
(NodeUFMData j' p')
t1'
= mkLSNodeUFM
(NodeUFMData j' p')
t1'
@@
-513,7
+527,14
@@
mapUFM fn EmptyUFM = EmptyUFM
mapUFM fn fm = map_tree fn fm
filterUFM fn EmptyUFM = EmptyUFM
mapUFM fn fm = map_tree fn fm
filterUFM fn EmptyUFM = EmptyUFM
-filterUFM fn fm = filter_tree fn fm
+filterUFM fn fm = filter_tree pred fm
+ where
+ pred (i::FastInt) e = fn e
+
+filterUFM_Directly fn EmptyUFM = EmptyUFM
+filterUFM_Directly fn fm = filter_tree pred fm
+ where
+ pred i e = fn (mkUniqueGrimily (iBox i)) e
\end{code}
Note, this takes a long time, O(n), but
\end{code}
Note, this takes a long time, O(n), but
@@
-540,20
+561,19
@@
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}
Lookup up a binary tree is easy (and fast).
\begin{code}
-elemUFM key fm = case lookUp fm (u2i (getUnique key)) of
- Nothing -> False
- Just _ -> True
+elemUFM key fm = maybeToBool (lookupUFM fm key)
+elemUFM_Directly key fm = maybeToBool (lookupUFM_Directly fm key)
-lookupUFM fm key = lookUp fm (u2i (getUnique key))
-lookupUFM_Directly fm key = lookUp fm (u2i key)
+lookupUFM fm key = lookUp fm (getKey# (getUnique key))
+lookupUFM_Directly fm key = lookUp fm (getKey# key)
lookupWithDefaultUFM fm deflt key
lookupWithDefaultUFM fm deflt key
- = case lookUp fm (u2i (getUnique key)) of
+ = case lookUp fm (getKey# (getUnique key)) of
Nothing -> deflt
Just elt -> elt
lookupWithDefaultUFM_Directly fm deflt key
Nothing -> deflt
Just elt -> elt
lookupWithDefaultUFM_Directly fm deflt key
- = case lookUp fm (u2i key) of
+ = case lookUp fm (getKey# key) of
Nothing -> deflt
Just elt -> elt
Nothing -> deflt
Just elt -> elt
@@
-577,9
+597,9
@@
folds are *wonderful* things.
\begin{code}
eltsUFM fm = foldUFM (:) [] fm
\begin{code}
eltsUFM fm = foldUFM (:) [] fm
-ufmToList fm = fold_tree (\ iu elt rest -> (mkUniqueGrimily iu, elt) : rest) [] fm
+ufmToList fm = fold_tree (\ iu elt rest -> (mkUniqueGrimily (iBox iu), elt) : rest) [] fm
-keysUFM fm = fold_tree (\ iu elt rest -> mkUniqueGrimily iu : rest) [] fm
+keysUFM fm = fold_tree (\ iu elt rest -> mkUniqueGrimily (iBox iu) : rest) [] fm
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
@@
-651,7
+671,7
@@
and if necessary do $\lambda$ lifting on our functions that are bound.
\begin{code}
insert_ele
\begin{code}
insert_ele
- :: (a -> a -> a)
+ :: (a -> a -> a) -- old -> new -> result
-> UniqFM a
-> FastInt
-> a
-> UniqFM a
-> FastInt
-> a
@@
-697,19
+717,20
@@
insert_ele f n@(NodeUFM j p t1 t2) i a
\begin{code}
map_tree f (NodeUFM j p t1 t2)
\begin{code}
map_tree f (NodeUFM j p t1 t2)
- = mkSSNodeUFM (NodeUFMData j p) (map_tree f t1) (map_tree f 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 (LeafUFM i obj)
= mkLeafUFM i (f obj)
-
map_tree f _ = panic "map_tree failed"
\end{code}
\begin{code}
map_tree f _ = 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)
= mkSSNodeUFM (NodeUFMData j p) (filter_tree f t1) (filter_tree f t2)
filter_tree f lf@(LeafUFM i obj)
filter_tree f nd@(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 obj = lf
+ | f i obj = lf
| otherwise = EmptyUFM
filter_tree f _ = panic "filter_tree failed"
\end{code}
| otherwise = EmptyUFM
filter_tree f _ = panic "filter_tree failed"
\end{code}
@@
-813,11
+834,11
@@
shiftR_ n p = word2Int#((int2Word# n) `shiftr` p)
shiftr x y = shiftRL# x y
#endif
shiftr x y = shiftRL# x y
#endif
-#else {- not GHC -}
+#else /* not GHC */
shiftL_ n p = n * (2 ^ p)
shiftR_ n p = n `quot` (2 ^ p)
shiftL_ n p = n * (2 ^ p)
shiftR_ n p = n `quot` (2 ^ p)
-#endif {- not GHC -}
+#endif /* not GHC */
\end{code}
\begin{code}
\end{code}
\begin{code}