isNullUFM,
lookupUFM, lookupUFM_Directly,
lookupWithDefaultUFM, lookupWithDefaultUFM_Directly,
- eltsUFM, keysUFM,
+ eltsUFM, keysUFM, splitUFM,
ufmToList
) where
elemUFM :: Uniquable key => key -> UniqFM elt -> Bool
elemUFM_Directly:: Unique -> UniqFM elt -> Bool
+splitUFM :: Uniquable key => UniqFM elt -> key -> (UniqFM elt, Maybe elt, UniqFM elt)
+ -- Splits a UFM into things less than, equal to, and greater than the key
lookupUFM :: Uniquable key => UniqFM elt -> key -> Maybe elt
lookupUFM_Directly -- when you've got the Unique already
:: UniqFM elt -> Unique -> Maybe elt
:: Uniquable key => UniqFM elt -> elt -> key -> elt
lookupWithDefaultUFM_Directly
:: UniqFM elt -> elt -> Unique -> elt
-
keysUFM :: UniqFM elt -> [Unique] -- Get the keys
eltsUFM :: UniqFM elt -> [elt]
ufmToList :: UniqFM elt -> [(Unique, elt)]
(mix_trees t2 t2')
-- Now the 4 different other ways; all like this:
--
- -- Given j >^ j' (and, say, j > j')
+ -- Given j >^ j' (and, say, j > j')
--
-- j j' j
-- / \ + / \ ==> / \
| otherwise = lookup_tree t2
lookup_tree EmptyUFM = panic "lookup Failed"
+
+-------------------
+splitUFM fm key = split fm (getKeyFastInt (getUnique key))
+
+split :: UniqFM a -> FastInt -> (UniqFM a, Maybe a, UniqFM a)
+-- Splits a UFM into things less than, equal to, and greater than the key
+split EmptyUFM _ = (EmptyUFM, Nothing, EmptyUFM)
+split fm i = go fm
+ where
+ go (LeafUFM j b) | i <# j = (EmptyUFM, Nothing, LeafUFM j b)
+ | i ># j = (LeafUFM j b, Nothing, EmptyUFM)
+ | otherwise = (EmptyUFM, Just b, EmptyUFM)
+
+ go (NodeUFM j p t1 t2)
+ | j ># i
+ , (lt, eq, gt) <- go t1 = (lt, eq, mkSLNodeUFM (NodeUFMData j p) gt t2)
+ | (lt, eq, gt) <- go t2 = (mkLSNodeUFM (NodeUFMData j p) t1 lt, eq, gt)
+
+ go EmptyUFM = panic "splitUFM failed"
\end{code}
folds are *wonderful* things.
\begin{code}
mkLeafUFM :: FastInt -> a -> UniqFM a
-mkLeafUFM i a = LeafUFM i a
+mkLeafUFM i a =
+ ASSERT (iBox i >= 0) -- Note [Uniques must be positive]
+ LeafUFM i a
-- The *ONLY* ways of building a NodeUFM.
| p <# p2 = getCommonNodeUFMData_ p2 (j `quotFastInt` (p2 `quotFastInt` p)) j2
| otherwise = getCommonNodeUFMData_ p j (j2 `quotFastInt` (p `quotFastInt` p2))
where
- j = i `quotFastInt` (shiftL1 p)
- j2 = i2 `quotFastInt` (shiftL1 p2)
+ !j = i `quotFastInt` (shiftL1 p)
+ !j2 = i2 `quotFastInt` (shiftL1 p2)
getCommonNodeUFMData_ :: FastInt -> FastInt -> FastInt -> NodeUFMData
use_snd _ b = b
\end{code}
+{- Note [Uniques must be positive]
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+The getCommonNodeUFMData function assumes that the nodes use
+positive uniques. Specifically, the inner `loop' shifts the
+low bits out of two uniques until the shifted uniques are the same.
+At the same time, it computes a new delta, by shifting
+to the left.
+
+The failure case I (JPD) encountered:
+If one of the uniques is negative, the shifting may continue
+until all 64 bits have been shifted out, resulting in a new delta
+of 0, which is wrong and can trigger later assertion failures.
+
+Where do the negative uniques come from? Both Simom M and
+I have run into this problem when hashing a data structure.
+In both cases, we have avoided the problem by ensuring that
+the hashes remain positive.
+-}