{-# LANGUAGE CPP #-}
{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE UnboxedTuples #-}
{-# LANGUAGE MagicHash #-}
{-# LANGUAGE PatternGuards #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE Trustworthy #-}
{-# OPTIONS_GHC -Wall -funbox-strict-fields -fno-warn-orphans -fno-warn-type-defaults -O2 #-}
#ifdef ST_HACK
{-# OPTIONS_GHC -fno-full-laziness #-}
#endif
--------------------------------------------------------------------------------
-- |
-- Copyright   : (c) Edward Kmett 2015
-- License     : BSD-style
-- Maintainer  : Edward Kmett <ekmett@gmail.com>
-- Portability : non-portable
--
-- This module suppose a Word64-based array-mapped PATRICIA Trie.
--
-- The most significant nybble is isolated by using techniques based on
-- <https://www.fpcomplete.com/user/edwardk/revisiting-matrix-multiplication/part-4>
-- but modified to work nybble-by-nybble rather than bit-by-bit.
--
--------------------------------------------------------------------------------
module Data.Discrimination.Internal.WordMap
  ( WordMap
  , singleton
  , empty
  , insert
  , lookup
  , member
  , fromList
  ) where

import Control.Applicative hiding (empty)
import Control.DeepSeq
import Control.Monad.ST hiding (runST)
import Data.Bits
import Data.Discrimination.Internal.SmallArray
import Data.Foldable
import Data.Functor
import Data.Monoid
import Data.Traversable
import Data.Word
import qualified GHC.Exts as Exts
import Prelude hiding (lookup, length, foldr)
import GHC.Types
import GHC.ST

type Key = Word64
type Mask = Word16
type Offset = Int

ptrEq :: a -> a -> Bool
ptrEq :: a -> a -> Bool
ptrEq a
x a
y = Int# -> Bool
isTrue# (a -> a -> Int#
forall a. a -> a -> Int#
Exts.reallyUnsafePtrEquality# a
x a
y Int# -> Int# -> Int#
Exts.==# Int#
1#)
{-# INLINEABLE ptrEq #-}

ptrNeq :: a -> a -> Bool
ptrNeq :: a -> a -> Bool
ptrNeq a
x a
y = Int# -> Bool
isTrue# (a -> a -> Int#
forall a. a -> a -> Int#
Exts.reallyUnsafePtrEquality# a
x a
y Int# -> Int# -> Int#
Exts./=# Int#
1#)
{-# INLINEABLE ptrNeq #-}

data WordMap v
  = Full !Key !Offset !(SmallArray (WordMap v))
  | Node !Key !Offset !Mask !(SmallArray (WordMap v))
  | Tip  !Key v
  | Nil
  deriving Int -> WordMap v -> ShowS
[WordMap v] -> ShowS
WordMap v -> String
(Int -> WordMap v -> ShowS)
-> (WordMap v -> String)
-> ([WordMap v] -> ShowS)
-> Show (WordMap v)
forall v. Show v => Int -> WordMap v -> ShowS
forall v. Show v => [WordMap v] -> ShowS
forall v. Show v => WordMap v -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [WordMap v] -> ShowS
$cshowList :: forall v. Show v => [WordMap v] -> ShowS
show :: WordMap v -> String
$cshow :: forall v. Show v => WordMap v -> String
showsPrec :: Int -> WordMap v -> ShowS
$cshowsPrec :: forall v. Show v => Int -> WordMap v -> ShowS
Show

node :: Key -> Offset -> Mask -> SmallArray (WordMap v) -> WordMap v
node :: Key -> Int -> Mask -> SmallArray (WordMap v) -> WordMap v
node Key
k Int
o Mask
0xffff SmallArray (WordMap v)
a = Key -> Int -> SmallArray (WordMap v) -> WordMap v
forall v. Key -> Int -> SmallArray (WordMap v) -> WordMap v
Full Key
k Int
o SmallArray (WordMap v)
a
node Key
k Int
o Mask
m SmallArray (WordMap v)
a      = Key -> Int -> Mask -> SmallArray (WordMap v) -> WordMap v
forall v. Key -> Int -> Mask -> SmallArray (WordMap v) -> WordMap v
Node Key
k Int
o Mask
m SmallArray (WordMap v)
a
{-# INLINE node #-}

instance NFData v => NFData (WordMap v) where
  rnf :: WordMap v -> ()
rnf (Full Key
_ Int
_ SmallArray (WordMap v)
a)   = SmallArray (WordMap v) -> ()
forall a. NFData a => a -> ()
rnf SmallArray (WordMap v)
a
  rnf (Node Key
_ Int
_ Mask
_ SmallArray (WordMap v)
a) = SmallArray (WordMap v) -> ()
forall a. NFData a => a -> ()
rnf SmallArray (WordMap v)
a
  rnf (Tip Key
_ v
v) = v -> ()
forall a. NFData a => a -> ()
rnf v
v
  rnf WordMap v
Nil = ()

instance Functor WordMap where
  fmap :: (a -> b) -> WordMap a -> WordMap b
fmap a -> b
f = WordMap a -> WordMap b
go where
    go :: WordMap a -> WordMap b
go (Full Key
k Int
o SmallArray (WordMap a)
a) = Key -> Int -> SmallArray (WordMap b) -> WordMap b
forall v. Key -> Int -> SmallArray (WordMap v) -> WordMap v
Full Key
k Int
o ((WordMap a -> WordMap b)
-> SmallArray (WordMap a) -> SmallArray (WordMap b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap WordMap a -> WordMap b
go SmallArray (WordMap a)
a)
    go (Node Key
k Int
o Mask
m SmallArray (WordMap a)
a) = Key -> Int -> Mask -> SmallArray (WordMap b) -> WordMap b
forall v. Key -> Int -> Mask -> SmallArray (WordMap v) -> WordMap v
Node Key
k Int
o Mask
m ((WordMap a -> WordMap b)
-> SmallArray (WordMap a) -> SmallArray (WordMap b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap WordMap a -> WordMap b
go SmallArray (WordMap a)
a)
    go (Tip Key
k a
v) = Key -> b -> WordMap b
forall v. Key -> v -> WordMap v
Tip Key
k (a -> b
f a
v)
    go WordMap a
Nil = WordMap b
forall v. WordMap v
Nil
  {-# INLINEABLE fmap #-}

instance Foldable WordMap where
  foldMap :: (a -> m) -> WordMap a -> m
foldMap a -> m
f = WordMap a -> m
go where
    go :: WordMap a -> m
go (Full Key
_ Int
_ SmallArray (WordMap a)
a) = (WordMap a -> m) -> SmallArray (WordMap a) -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap WordMap a -> m
go SmallArray (WordMap a)
a
    go (Node Key
_ Int
_ Mask
_ SmallArray (WordMap a)
a) = (WordMap a -> m) -> SmallArray (WordMap a) -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap WordMap a -> m
go SmallArray (WordMap a)
a
    go (Tip Key
_ a
v) = a -> m
f a
v
    go WordMap a
Nil = m
forall a. Monoid a => a
mempty
  {-# INLINEABLE foldMap #-}

instance Traversable WordMap where
  traverse :: (a -> f b) -> WordMap a -> f (WordMap b)
traverse a -> f b
f = WordMap a -> f (WordMap b)
go where
    go :: WordMap a -> f (WordMap b)
go (Full Key
k Int
o SmallArray (WordMap a)
a) = Key -> Int -> SmallArray (WordMap b) -> WordMap b
forall v. Key -> Int -> SmallArray (WordMap v) -> WordMap v
Full Key
k Int
o (SmallArray (WordMap b) -> WordMap b)
-> f (SmallArray (WordMap b)) -> f (WordMap b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (WordMap a -> f (WordMap b))
-> SmallArray (WordMap a) -> f (SmallArray (WordMap b))
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse WordMap a -> f (WordMap b)
go SmallArray (WordMap a)
a
    go (Node Key
k Int
o Mask
m SmallArray (WordMap a)
a) = Key -> Int -> Mask -> SmallArray (WordMap b) -> WordMap b
forall v. Key -> Int -> Mask -> SmallArray (WordMap v) -> WordMap v
Node Key
k Int
o Mask
m (SmallArray (WordMap b) -> WordMap b)
-> f (SmallArray (WordMap b)) -> f (WordMap b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (WordMap a -> f (WordMap b))
-> SmallArray (WordMap a) -> f (SmallArray (WordMap b))
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse WordMap a -> f (WordMap b)
go SmallArray (WordMap a)
a
    go (Tip Key
k a
v) = Key -> b -> WordMap b
forall v. Key -> v -> WordMap v
Tip Key
k (b -> WordMap b) -> f b -> f (WordMap b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> a -> f b
f a
v
    go WordMap a
Nil = WordMap b -> f (WordMap b)
forall (f :: * -> *) a. Applicative f => a -> f a
pure WordMap b
forall v. WordMap v
Nil
  {-# INLINEABLE traverse #-}

-- Note: 'level 0' will return a negative shift, don't use it
level :: Key -> Int
level :: Key -> Int
level Key
w = Int
60 Int -> Int -> Int
forall a. Num a => a -> a -> a
- (Key -> Int
forall b. FiniteBits b => b -> Int
countLeadingZeros Key
w Int -> Int -> Int
forall a. Bits a => a -> a -> a
.&. Int
0x7c)
{-# INLINE level #-}

maskBit :: Key -> Offset -> Int
maskBit :: Key -> Int -> Int
maskBit Key
k Int
o = Key -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Key -> Int -> Key
forall a. Bits a => a -> Int -> a
unsafeShiftR Key
k Int
o Key -> Key -> Key
forall a. Bits a => a -> a -> a
.&. Key
0xf)
{-# INLINE maskBit #-}

mask :: Key -> Offset -> Word16
mask :: Key -> Int -> Mask
mask Key
k Int
o = Mask -> Int -> Mask
forall a. Bits a => a -> Int -> a
unsafeShiftL Mask
1 (Key -> Int -> Int
maskBit Key
k Int
o)
{-# INLINE mask #-}

-- offset :: Int -> Word16 -> Int
-- offset k w = popCount $ w .&. (unsafeShiftL 1 k - 1)
-- {-# INLINE offset #-}

fork :: Int -> Key -> WordMap v -> Key -> WordMap v -> WordMap v
fork :: Int -> Key -> WordMap v -> Key -> WordMap v -> WordMap v
fork Int
o Key
k WordMap v
n Key
ok WordMap v
on = Key -> Int -> Mask -> SmallArray (WordMap v) -> WordMap v
forall v. Key -> Int -> Mask -> SmallArray (WordMap v) -> WordMap v
Node (Key
k Key -> Key -> Key
forall a. Bits a => a -> a -> a
.&. Key -> Int -> Key
forall a. Bits a => a -> Int -> a
unsafeShiftL Key
0xfffffffffffffff0 Int
o) Int
o (Key -> Int -> Mask
mask Key
k Int
o Mask -> Mask -> Mask
forall a. Bits a => a -> a -> a
.|. Key -> Int -> Mask
mask Key
ok Int
o) (SmallArray (WordMap v) -> WordMap v)
-> SmallArray (WordMap v) -> WordMap v
forall a b. (a -> b) -> a -> b
$ (forall s. ST s (SmallArray (WordMap v))) -> SmallArray (WordMap v)
forall a. (forall s. ST s a) -> a
runST ((forall s. ST s (SmallArray (WordMap v)))
 -> SmallArray (WordMap v))
-> (forall s. ST s (SmallArray (WordMap v)))
-> SmallArray (WordMap v)
forall a b. (a -> b) -> a -> b
$ do
  SmallMutableArray s (WordMap v)
arr <- Int
-> WordMap v
-> ST s (SmallMutableArray (PrimState (ST s)) (WordMap v))
forall (m :: * -> *) a.
PrimMonad m =>
Int -> a -> m (SmallMutableArray (PrimState m) a)
newSmallArray Int
2 WordMap v
n
  SmallMutableArray (PrimState (ST s)) (WordMap v)
-> Int -> WordMap v -> ST s ()
forall (m :: * -> *) a.
PrimMonad m =>
SmallMutableArray (PrimState m) a -> Int -> a -> m ()
writeSmallArray SmallMutableArray s (WordMap v)
SmallMutableArray (PrimState (ST s)) (WordMap v)
arr (Bool -> Int
forall a. Enum a => a -> Int
fromEnum (Key
k Key -> Key -> Bool
forall a. Ord a => a -> a -> Bool
< Key
ok)) WordMap v
on
  SmallMutableArray (PrimState (ST s)) (WordMap v)
-> ST s (SmallArray (WordMap v))
forall (m :: * -> *) a.
PrimMonad m =>
SmallMutableArray (PrimState m) a -> m (SmallArray a)
unsafeFreezeSmallArray SmallMutableArray s (WordMap v)
SmallMutableArray (PrimState (ST s)) (WordMap v)
arr

insert :: Key -> v -> WordMap v -> WordMap v
insert :: Key -> v -> WordMap v -> WordMap v
insert !Key
k v
v WordMap v
xs0 = WordMap v -> WordMap v
go WordMap v
xs0 where
  go :: WordMap v -> WordMap v
go on :: WordMap v
on@(Full Key
ok Int
n SmallArray (WordMap v)
as)
    | Key
wd Key -> Key -> Bool
forall a. Ord a => a -> a -> Bool
> Key
0xf = Int -> Key -> WordMap v -> Key -> WordMap v -> WordMap v
forall v. Int -> Key -> WordMap v -> Key -> WordMap v -> WordMap v
fork (Key -> Int
level Key
okk) Key
k (Key -> v -> WordMap v
forall v. Key -> v -> WordMap v
Tip Key
k v
v) Key
ok WordMap v
on
    | !WordMap v
oz <- SmallArray (WordMap v) -> Int -> WordMap v
forall a. SmallArray a -> Int -> a
indexSmallArray SmallArray (WordMap v)
as Int
d
    , !WordMap v
z <- WordMap v -> WordMap v
go WordMap v
oz
    , WordMap v -> WordMap v -> Bool
forall a. a -> a -> Bool
ptrNeq WordMap v
z WordMap v
oz = Key -> Int -> SmallArray (WordMap v) -> WordMap v
forall v. Key -> Int -> SmallArray (WordMap v) -> WordMap v
Full Key
ok Int
n (Int
-> WordMap v -> SmallArray (WordMap v) -> SmallArray (WordMap v)
forall a. Int -> a -> SmallArray a -> SmallArray a
update16 Int
d WordMap v
z SmallArray (WordMap v)
as)
    | Bool
otherwise = WordMap v
on
    where
      okk :: Key
okk = Key -> Key -> Key
forall a. Bits a => a -> a -> a
xor Key
ok Key
k
      wd :: Key
wd  = Key -> Int -> Key
forall a. Bits a => a -> Int -> a
unsafeShiftR Key
okk Int
n
      d :: Int
d   = Key -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Key
wd
  go on :: WordMap v
on@(Node Key
ok Int
n Mask
m SmallArray (WordMap v)
as)
    | Key
wd Key -> Key -> Bool
forall a. Ord a => a -> a -> Bool
> Key
0xf = Int -> Key -> WordMap v -> Key -> WordMap v -> WordMap v
forall v. Int -> Key -> WordMap v -> Key -> WordMap v -> WordMap v
fork (Key -> Int
level Key
okk) Key
k (Key -> v -> WordMap v
forall v. Key -> v -> WordMap v
Tip Key
k v
v) Key
ok WordMap v
on
    | Mask
m Mask -> Mask -> Mask
forall a. Bits a => a -> a -> a
.&. Mask
b Mask -> Mask -> Bool
forall a. Eq a => a -> a -> Bool
== Mask
0 = Key -> Int -> Mask -> SmallArray (WordMap v) -> WordMap v
forall v. Key -> Int -> Mask -> SmallArray (WordMap v) -> WordMap v
node Key
ok Int
n (Mask
m Mask -> Mask -> Mask
forall a. Bits a => a -> a -> a
.|. Mask
b) (Int
-> WordMap v -> SmallArray (WordMap v) -> SmallArray (WordMap v)
forall a. Int -> a -> SmallArray a -> SmallArray a
insertSmallArray Int
odm (Key -> v -> WordMap v
forall v. Key -> v -> WordMap v
Tip Key
k v
v) SmallArray (WordMap v)
as)
    | !WordMap v
oz <- SmallArray (WordMap v) -> Int -> WordMap v
forall a. SmallArray a -> Int -> a
indexSmallArray SmallArray (WordMap v)
as Int
odm
    , !WordMap v
z <- WordMap v -> WordMap v
go WordMap v
oz
    , WordMap v -> WordMap v -> Bool
forall a. a -> a -> Bool
ptrNeq WordMap v
z WordMap v
oz = Key -> Int -> Mask -> SmallArray (WordMap v) -> WordMap v
forall v. Key -> Int -> Mask -> SmallArray (WordMap v) -> WordMap v
Node Key
ok Int
n Mask
m (Int
-> WordMap v -> SmallArray (WordMap v) -> SmallArray (WordMap v)
forall a. Int -> a -> SmallArray a -> SmallArray a
updateSmallArray Int
odm WordMap v
z SmallArray (WordMap v)
as)
    | Bool
otherwise = WordMap v
on
    where
      okk :: Key
okk = Key -> Key -> Key
forall a. Bits a => a -> a -> a
xor Key
ok Key
k
      wd :: Key
wd  = Key -> Int -> Key
forall a. Bits a => a -> Int -> a
unsafeShiftR Key
okk Int
n
      d :: Int
d   = Key -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Key
wd
      b :: Mask
b   = Mask -> Int -> Mask
forall a. Bits a => a -> Int -> a
unsafeShiftL Mask
1 Int
d
      odm :: Int
odm = Mask -> Int
forall a. Bits a => a -> Int
popCount (Mask -> Int) -> Mask -> Int
forall a b. (a -> b) -> a -> b
$ Mask
m Mask -> Mask -> Mask
forall a. Bits a => a -> a -> a
.&. (Mask
b Mask -> Mask -> Mask
forall a. Num a => a -> a -> a
- Mask
1)
  go on :: WordMap v
on@(Tip Key
ok v
ov)
    | Key
k Key -> Key -> Bool
forall a. Eq a => a -> a -> Bool
/= Key
ok    = Int -> Key -> WordMap v -> Key -> WordMap v -> WordMap v
forall v. Int -> Key -> WordMap v -> Key -> WordMap v -> WordMap v
fork (Key -> Int
level (Key -> Key -> Key
forall a. Bits a => a -> a -> a
xor Key
ok Key
k)) Key
k (Key -> v -> WordMap v
forall v. Key -> v -> WordMap v
Tip Key
k v
v) Key
ok WordMap v
on
    | v -> v -> Bool
forall a. a -> a -> Bool
ptrEq v
v v
ov = WordMap v
on
    | Bool
otherwise  = Key -> v -> WordMap v
forall v. Key -> v -> WordMap v
Tip Key
k v
v
  go WordMap v
Nil = Key -> v -> WordMap v
forall v. Key -> v -> WordMap v
Tip Key
k v
v
{-# INLINEABLE insert #-}


lookup :: Key -> WordMap v -> Maybe v
lookup :: Key -> WordMap v -> Maybe v
lookup !Key
k (Full Key
ok Int
o SmallArray (WordMap v)
a)
  | Key
z <- Key -> Int -> Key
forall a. Bits a => a -> Int -> a
unsafeShiftR (Key -> Key -> Key
forall a. Bits a => a -> a -> a
xor Key
k Key
ok) Int
o, Key
z Key -> Key -> Bool
forall a. Ord a => a -> a -> Bool
<= Key
0xf = Key -> WordMap v -> Maybe v
forall v. Key -> WordMap v -> Maybe v
lookup Key
k (WordMap v -> Maybe v) -> WordMap v -> Maybe v
forall a b. (a -> b) -> a -> b
$ SmallArray (WordMap v) -> Int -> WordMap v
forall a. SmallArray a -> Int -> a
indexSmallArray SmallArray (WordMap v)
a (Key -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Key
z)
  | Bool
otherwise = Maybe v
forall a. Maybe a
Nothing
lookup Key
k (Node Key
ok Int
o Mask
m SmallArray (WordMap v)
a)
  | Key
z Key -> Key -> Bool
forall a. Ord a => a -> a -> Bool
<= Key
0xf Bool -> Bool -> Bool
&& Mask
m Mask -> Mask -> Mask
forall a. Bits a => a -> a -> a
.&. Mask
b Mask -> Mask -> Bool
forall a. Eq a => a -> a -> Bool
/= Mask
0 = Key -> WordMap v -> Maybe v
forall v. Key -> WordMap v -> Maybe v
lookup Key
k (SmallArray (WordMap v) -> Int -> WordMap v
forall a. SmallArray a -> Int -> a
indexSmallArray SmallArray (WordMap v)
a (Mask -> Int
forall a. Bits a => a -> Int
popCount (Mask
m Mask -> Mask -> Mask
forall a. Bits a => a -> a -> a
.&. (Mask
b Mask -> Mask -> Mask
forall a. Num a => a -> a -> a
- Mask
1))))
  | Bool
otherwise = Maybe v
forall a. Maybe a
Nothing
  where
    z :: Key
z = Key -> Int -> Key
forall a. Bits a => a -> Int -> a
unsafeShiftR (Key -> Key -> Key
forall a. Bits a => a -> a -> a
xor Key
k Key
ok) Int
o
    b :: Mask
b = Mask -> Int -> Mask
forall a. Bits a => a -> Int -> a
unsafeShiftL Mask
1 (Key -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Key
z)
lookup Key
k (Tip Key
ok v
ov)
  | Key
k Key -> Key -> Bool
forall a. Eq a => a -> a -> Bool
== Key
ok   = v -> Maybe v
forall a. a -> Maybe a
Just v
ov
  | Bool
otherwise = Maybe v
forall a. Maybe a
Nothing
lookup Key
_ WordMap v
Nil = Maybe v
forall a. Maybe a
Nothing
{-# INLINEABLE lookup #-}

member :: Key -> WordMap v -> Bool
member :: Key -> WordMap v -> Bool
member !Key
k (Full Key
ok Int
o SmallArray (WordMap v)
a)
  | Key
z <- Key -> Int -> Key
forall a. Bits a => a -> Int -> a
unsafeShiftR (Key -> Key -> Key
forall a. Bits a => a -> a -> a
xor Key
k Key
ok) Int
o = Key
z Key -> Key -> Bool
forall a. Ord a => a -> a -> Bool
<= Key
0xf Bool -> Bool -> Bool
&& Key -> WordMap v -> Bool
forall v. Key -> WordMap v -> Bool
member Key
k (SmallArray (WordMap v) -> Int -> WordMap v
forall a. SmallArray a -> Int -> a
indexSmallArray SmallArray (WordMap v)
a (Key -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Key
z))
member Key
k (Node Key
ok Int
o Mask
m SmallArray (WordMap v)
a)
  | Key
z <- Key -> Int -> Key
forall a. Bits a => a -> Int -> a
unsafeShiftR (Key -> Key -> Key
forall a. Bits a => a -> a -> a
xor Key
k Key
ok) Int
o
  = Key
z Key -> Key -> Bool
forall a. Ord a => a -> a -> Bool
<= Key
0xf Bool -> Bool -> Bool
&& let b :: Mask
b = Mask -> Int -> Mask
forall a. Bits a => a -> Int -> a
unsafeShiftL Mask
1 (Key -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Key
z) in
    Mask
m Mask -> Mask -> Mask
forall a. Bits a => a -> a -> a
.&. Mask
b Mask -> Mask -> Bool
forall a. Eq a => a -> a -> Bool
/= Mask
0 Bool -> Bool -> Bool
&& Key -> WordMap v -> Bool
forall v. Key -> WordMap v -> Bool
member Key
k (SmallArray (WordMap v) -> Int -> WordMap v
forall a. SmallArray a -> Int -> a
indexSmallArray SmallArray (WordMap v)
a (Mask -> Int
forall a. Bits a => a -> Int
popCount (Mask
m Mask -> Mask -> Mask
forall a. Bits a => a -> a -> a
.&. (Mask
b Mask -> Mask -> Mask
forall a. Num a => a -> a -> a
- Mask
1))))
member Key
k (Tip Key
ok v
_) = Key
k Key -> Key -> Bool
forall a. Eq a => a -> a -> Bool
== Key
ok
member Key
_ WordMap v
Nil = Bool
False
{-# INLINEABLE member #-}

updateSmallArray :: Int -> a -> SmallArray a -> SmallArray a
updateSmallArray :: Int -> a -> SmallArray a -> SmallArray a
updateSmallArray !Int
k a
a SmallArray a
i = (forall s. ST s (SmallArray a)) -> SmallArray a
forall a. (forall s. ST s a) -> a
runST ((forall s. ST s (SmallArray a)) -> SmallArray a)
-> (forall s. ST s (SmallArray a)) -> SmallArray a
forall a b. (a -> b) -> a -> b
$ do
  let n :: Int
n = SmallArray a -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length SmallArray a
i
  SmallMutableArray s a
o <- Int -> a -> ST s (SmallMutableArray (PrimState (ST s)) a)
forall (m :: * -> *) a.
PrimMonad m =>
Int -> a -> m (SmallMutableArray (PrimState m) a)
newSmallArray Int
n a
forall a. HasCallStack => a
undefined
  SmallMutableArray (PrimState (ST s)) a
-> Int -> SmallArray a -> Int -> Int -> ST s ()
forall (m :: * -> *) a.
PrimMonad m =>
SmallMutableArray (PrimState m) a
-> Int -> SmallArray a -> Int -> Int -> m ()
copySmallArray SmallMutableArray s a
SmallMutableArray (PrimState (ST s)) a
o Int
0 SmallArray a
i Int
0 Int
n
  SmallMutableArray (PrimState (ST s)) a -> Int -> a -> ST s ()
forall (m :: * -> *) a.
PrimMonad m =>
SmallMutableArray (PrimState m) a -> Int -> a -> m ()
writeSmallArray SmallMutableArray s a
SmallMutableArray (PrimState (ST s)) a
o Int
k a
a
  SmallMutableArray (PrimState (ST s)) a -> ST s (SmallArray a)
forall (m :: * -> *) a.
PrimMonad m =>
SmallMutableArray (PrimState m) a -> m (SmallArray a)
unsafeFreezeSmallArray SmallMutableArray s a
SmallMutableArray (PrimState (ST s)) a
o
{-# INLINEABLE updateSmallArray #-}

update16 :: Int -> a -> SmallArray a -> SmallArray a
update16 :: Int -> a -> SmallArray a -> SmallArray a
update16 !Int
k a
a SmallArray a
i = (forall s. ST s (SmallArray a)) -> SmallArray a
forall a. (forall s. ST s a) -> a
runST ((forall s. ST s (SmallArray a)) -> SmallArray a)
-> (forall s. ST s (SmallArray a)) -> SmallArray a
forall a b. (a -> b) -> a -> b
$ do
  SmallMutableArray s a
o <- SmallArray a -> ST s (SmallMutableArray s a)
forall a s. SmallArray a -> ST s (SmallMutableArray s a)
clone16 SmallArray a
i
  SmallMutableArray (PrimState (ST s)) a -> Int -> a -> ST s ()
forall (m :: * -> *) a.
PrimMonad m =>
SmallMutableArray (PrimState m) a -> Int -> a -> m ()
writeSmallArray SmallMutableArray s a
SmallMutableArray (PrimState (ST s)) a
o Int
k a
a
  SmallMutableArray (PrimState (ST s)) a -> ST s (SmallArray a)
forall (m :: * -> *) a.
PrimMonad m =>
SmallMutableArray (PrimState m) a -> m (SmallArray a)
unsafeFreezeSmallArray SmallMutableArray s a
SmallMutableArray (PrimState (ST s)) a
o
{-# INLINEABLE update16 #-}

insertSmallArray :: Int -> a -> SmallArray a -> SmallArray a
insertSmallArray :: Int -> a -> SmallArray a -> SmallArray a
insertSmallArray !Int
k a
a SmallArray a
i = (forall s. ST s (SmallArray a)) -> SmallArray a
forall a. (forall s. ST s a) -> a
runST ((forall s. ST s (SmallArray a)) -> SmallArray a)
-> (forall s. ST s (SmallArray a)) -> SmallArray a
forall a b. (a -> b) -> a -> b
$ do
  let n :: Int
n = SmallArray a -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length SmallArray a
i
  SmallMutableArray s a
o <- Int -> a -> ST s (SmallMutableArray (PrimState (ST s)) a)
forall (m :: * -> *) a.
PrimMonad m =>
Int -> a -> m (SmallMutableArray (PrimState m) a)
newSmallArray (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) a
a
  SmallMutableArray (PrimState (ST s)) a
-> Int -> SmallArray a -> Int -> Int -> ST s ()
forall (m :: * -> *) a.
PrimMonad m =>
SmallMutableArray (PrimState m) a
-> Int -> SmallArray a -> Int -> Int -> m ()
copySmallArray  SmallMutableArray s a
SmallMutableArray (PrimState (ST s)) a
o Int
0 SmallArray a
i Int
0 Int
k
  SmallMutableArray (PrimState (ST s)) a
-> Int -> SmallArray a -> Int -> Int -> ST s ()
forall (m :: * -> *) a.
PrimMonad m =>
SmallMutableArray (PrimState m) a
-> Int -> SmallArray a -> Int -> Int -> m ()
copySmallArray  SmallMutableArray s a
SmallMutableArray (PrimState (ST s)) a
o (Int
kInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1) SmallArray a
i Int
k (Int
nInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
k)
  SmallMutableArray (PrimState (ST s)) a -> ST s (SmallArray a)
forall (m :: * -> *) a.
PrimMonad m =>
SmallMutableArray (PrimState m) a -> m (SmallArray a)
unsafeFreezeSmallArray SmallMutableArray s a
SmallMutableArray (PrimState (ST s)) a
o
{-# INLINEABLE insertSmallArray #-}

clone16 :: SmallArray a -> ST s (SmallMutableArray s a)
clone16 :: SmallArray a -> ST s (SmallMutableArray s a)
clone16 SmallArray a
i = do
  SmallMutableArray s a
o <- Int -> a -> ST s (SmallMutableArray (PrimState (ST s)) a)
forall (m :: * -> *) a.
PrimMonad m =>
Int -> a -> m (SmallMutableArray (PrimState m) a)
newSmallArray Int
16 a
forall a. HasCallStack => a
undefined
  SmallArray a -> Int -> ST s a
forall (m :: * -> *) a. Monad m => SmallArray a -> Int -> m a
indexSmallArrayM SmallArray a
i Int
0 ST s a -> (a -> ST s ()) -> ST s ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= SmallMutableArray (PrimState (ST s)) a -> Int -> a -> ST s ()
forall (m :: * -> *) a.
PrimMonad m =>
SmallMutableArray (PrimState m) a -> Int -> a -> m ()
writeSmallArray SmallMutableArray s a
SmallMutableArray (PrimState (ST s)) a
o Int
0
  SmallArray a -> Int -> ST s a
forall (m :: * -> *) a. Monad m => SmallArray a -> Int -> m a
indexSmallArrayM SmallArray a
i Int
1 ST s a -> (a -> ST s ()) -> ST s ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= SmallMutableArray (PrimState (ST s)) a -> Int -> a -> ST s ()
forall (m :: * -> *) a.
PrimMonad m =>
SmallMutableArray (PrimState m) a -> Int -> a -> m ()
writeSmallArray SmallMutableArray s a
SmallMutableArray (PrimState (ST s)) a
o Int
1
  SmallArray a -> Int -> ST s a
forall (m :: * -> *) a. Monad m => SmallArray a -> Int -> m a
indexSmallArrayM SmallArray a
i Int
2 ST s a -> (a -> ST s ()) -> ST s ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= SmallMutableArray (PrimState (ST s)) a -> Int -> a -> ST s ()
forall (m :: * -> *) a.
PrimMonad m =>
SmallMutableArray (PrimState m) a -> Int -> a -> m ()
writeSmallArray SmallMutableArray s a
SmallMutableArray (PrimState (ST s)) a
o Int
2
  SmallArray a -> Int -> ST s a
forall (m :: * -> *) a. Monad m => SmallArray a -> Int -> m a
indexSmallArrayM SmallArray a
i Int
3 ST s a -> (a -> ST s ()) -> ST s ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= SmallMutableArray (PrimState (ST s)) a -> Int -> a -> ST s ()
forall (m :: * -> *) a.
PrimMonad m =>
SmallMutableArray (PrimState m) a -> Int -> a -> m ()
writeSmallArray SmallMutableArray s a
SmallMutableArray (PrimState (ST s)) a
o Int
3
  SmallArray a -> Int -> ST s a
forall (m :: * -> *) a. Monad m => SmallArray a -> Int -> m a
indexSmallArrayM SmallArray a
i Int
4 ST s a -> (a -> ST s ()) -> ST s ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= SmallMutableArray (PrimState (ST s)) a -> Int -> a -> ST s ()
forall (m :: * -> *) a.
PrimMonad m =>
SmallMutableArray (PrimState m) a -> Int -> a -> m ()
writeSmallArray SmallMutableArray s a
SmallMutableArray (PrimState (ST s)) a
o Int
4
  SmallArray a -> Int -> ST s a
forall (m :: * -> *) a. Monad m => SmallArray a -> Int -> m a
indexSmallArrayM SmallArray a
i Int
5 ST s a -> (a -> ST s ()) -> ST s ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= SmallMutableArray (PrimState (ST s)) a -> Int -> a -> ST s ()
forall (m :: * -> *) a.
PrimMonad m =>
SmallMutableArray (PrimState m) a -> Int -> a -> m ()
writeSmallArray SmallMutableArray s a
SmallMutableArray (PrimState (ST s)) a
o Int
5
  SmallArray a -> Int -> ST s a
forall (m :: * -> *) a. Monad m => SmallArray a -> Int -> m a
indexSmallArrayM SmallArray a
i Int
6 ST s a -> (a -> ST s ()) -> ST s ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= SmallMutableArray (PrimState (ST s)) a -> Int -> a -> ST s ()
forall (m :: * -> *) a.
PrimMonad m =>
SmallMutableArray (PrimState m) a -> Int -> a -> m ()
writeSmallArray SmallMutableArray s a
SmallMutableArray (PrimState (ST s)) a
o Int
6
  SmallArray a -> Int -> ST s a
forall (m :: * -> *) a. Monad m => SmallArray a -> Int -> m a
indexSmallArrayM SmallArray a
i Int
7 ST s a -> (a -> ST s ()) -> ST s ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= SmallMutableArray (PrimState (ST s)) a -> Int -> a -> ST s ()
forall (m :: * -> *) a.
PrimMonad m =>
SmallMutableArray (PrimState m) a -> Int -> a -> m ()
writeSmallArray SmallMutableArray s a
SmallMutableArray (PrimState (ST s)) a
o Int
7
  SmallArray a -> Int -> ST s a
forall (m :: * -> *) a. Monad m => SmallArray a -> Int -> m a
indexSmallArrayM SmallArray a
i Int
8 ST s a -> (a -> ST s ()) -> ST s ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= SmallMutableArray (PrimState (ST s)) a -> Int -> a -> ST s ()
forall (m :: * -> *) a.
PrimMonad m =>
SmallMutableArray (PrimState m) a -> Int -> a -> m ()
writeSmallArray SmallMutableArray s a
SmallMutableArray (PrimState (ST s)) a
o Int
8
  SmallArray a -> Int -> ST s a
forall (m :: * -> *) a. Monad m => SmallArray a -> Int -> m a
indexSmallArrayM SmallArray a
i Int
9 ST s a -> (a -> ST s ()) -> ST s ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= SmallMutableArray (PrimState (ST s)) a -> Int -> a -> ST s ()
forall (m :: * -> *) a.
PrimMonad m =>
SmallMutableArray (PrimState m) a -> Int -> a -> m ()
writeSmallArray SmallMutableArray s a
SmallMutableArray (PrimState (ST s)) a
o Int
9
  SmallArray a -> Int -> ST s a
forall (m :: * -> *) a. Monad m => SmallArray a -> Int -> m a
indexSmallArrayM SmallArray a
i Int
10 ST s a -> (a -> ST s ()) -> ST s ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= SmallMutableArray (PrimState (ST s)) a -> Int -> a -> ST s ()
forall (m :: * -> *) a.
PrimMonad m =>
SmallMutableArray (PrimState m) a -> Int -> a -> m ()
writeSmallArray SmallMutableArray s a
SmallMutableArray (PrimState (ST s)) a
o Int
10
  SmallArray a -> Int -> ST s a
forall (m :: * -> *) a. Monad m => SmallArray a -> Int -> m a
indexSmallArrayM SmallArray a
i Int
11 ST s a -> (a -> ST s ()) -> ST s ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= SmallMutableArray (PrimState (ST s)) a -> Int -> a -> ST s ()
forall (m :: * -> *) a.
PrimMonad m =>
SmallMutableArray (PrimState m) a -> Int -> a -> m ()
writeSmallArray SmallMutableArray s a
SmallMutableArray (PrimState (ST s)) a
o Int
11
  SmallArray a -> Int -> ST s a
forall (m :: * -> *) a. Monad m => SmallArray a -> Int -> m a
indexSmallArrayM SmallArray a
i Int
12 ST s a -> (a -> ST s ()) -> ST s ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= SmallMutableArray (PrimState (ST s)) a -> Int -> a -> ST s ()
forall (m :: * -> *) a.
PrimMonad m =>
SmallMutableArray (PrimState m) a -> Int -> a -> m ()
writeSmallArray SmallMutableArray s a
SmallMutableArray (PrimState (ST s)) a
o Int
12
  SmallArray a -> Int -> ST s a
forall (m :: * -> *) a. Monad m => SmallArray a -> Int -> m a
indexSmallArrayM SmallArray a
i Int
13 ST s a -> (a -> ST s ()) -> ST s ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= SmallMutableArray (PrimState (ST s)) a -> Int -> a -> ST s ()
forall (m :: * -> *) a.
PrimMonad m =>
SmallMutableArray (PrimState m) a -> Int -> a -> m ()
writeSmallArray SmallMutableArray s a
SmallMutableArray (PrimState (ST s)) a
o Int
13
  SmallArray a -> Int -> ST s a
forall (m :: * -> *) a. Monad m => SmallArray a -> Int -> m a
indexSmallArrayM SmallArray a
i Int
14 ST s a -> (a -> ST s ()) -> ST s ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= SmallMutableArray (PrimState (ST s)) a -> Int -> a -> ST s ()
forall (m :: * -> *) a.
PrimMonad m =>
SmallMutableArray (PrimState m) a -> Int -> a -> m ()
writeSmallArray SmallMutableArray s a
SmallMutableArray (PrimState (ST s)) a
o Int
14
  SmallArray a -> Int -> ST s a
forall (m :: * -> *) a. Monad m => SmallArray a -> Int -> m a
indexSmallArrayM SmallArray a
i Int
15 ST s a -> (a -> ST s ()) -> ST s ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= SmallMutableArray (PrimState (ST s)) a -> Int -> a -> ST s ()
forall (m :: * -> *) a.
PrimMonad m =>
SmallMutableArray (PrimState m) a -> Int -> a -> m ()
writeSmallArray SmallMutableArray s a
SmallMutableArray (PrimState (ST s)) a
o Int
15
  SmallMutableArray s a -> ST s (SmallMutableArray s a)
forall (m :: * -> *) a. Monad m => a -> m a
return SmallMutableArray s a
o
{-# INLINE clone16 #-}

-- | Build a singleton WordMap
singleton :: Key -> v -> WordMap v
singleton :: Key -> v -> WordMap v
singleton !Key
k v
v = Key -> v -> WordMap v
forall v. Key -> v -> WordMap v
Tip Key
k v
v
{-# INLINE singleton #-}

fromList :: [(Word64,v)] -> WordMap v
fromList :: [(Key, v)] -> WordMap v
fromList [(Key, v)]
xs = (WordMap v -> (Key, v) -> WordMap v)
-> WordMap v -> [(Key, v)] -> WordMap v
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' (\WordMap v
r (Key
k,v
v) -> Key -> v -> WordMap v -> WordMap v
forall v. Key -> v -> WordMap v -> WordMap v
insert Key
k v
v WordMap v
r) WordMap v
forall v. WordMap v
Nil [(Key, v)]
xs
{-# INLINE fromList #-}

empty :: WordMap a
empty :: WordMap a
empty = WordMap a
forall v. WordMap v
Nil
{-# INLINE empty #-}