|
-- Note: to avoid silly thunks, this function must be strict in the |
|
-- key. See issue #232. We don't need to force the HashMap argument |
|
-- because it's already in WHNF (having just been matched) and we |
|
-- just put it directly in an array. |
|
two :: Shift -> Hash -> k -> v -> Hash -> HashMap k v -> ST s (HashMap k v) |
|
two = go |
|
where |
|
go s h1 k1 v1 h2 t2 |
|
| bp1 == bp2 = do |
|
st <- go (s+bitsPerSubkey) h1 k1 v1 h2 t2 |
|
ary <- A.singletonM st |
|
return $ BitmapIndexed bp1 ary |
|
| otherwise = do |
|
mary <- A.new 2 $! Leaf h1 (L k1 v1) |
|
A.write mary idx2 t2 |
|
ary <- A.unsafeFreeze mary |
|
return $ BitmapIndexed (bp1 .|. bp2) ary |
|
where |
|
bp1 = mask h1 s |
|
bp2 = mask h2 s |
|
idx2 | index h1 s < index h2 s = 1 |
|
| otherwise = 0 |
So apparently two must be strict in the key, but it's not obvious that it is.
Maybe the strictness is inferred from the L constructor application?!
In any case it might be best to clarify this with a ! on k1.
