module Radix.Word.Foundation
  ( Key
  , Prefix
  , Mask

  , beyond
  , upper
  , lower

  , zeroBit
  , mask
  , branchingBit
  ) where

import           Data.Bits



-- | Key as stored in the data structure.
type Key = Word

-- | Part of the 'Key' from the largest bit to the 'Mask' bit, plus the 'Mask' bit.
type Prefix = Word

{-# INLINE beyond #-}
-- | \(\mathcal{O}(1)\).
--   Whether the key does not match the prefix.
beyond :: Prefix -> Key -> Bool
beyond :: Mask -> Mask -> Bool
beyond Mask
p Mask
k = (Mask
k Mask -> Mask -> Mask
forall a. Bits a => a -> a -> a
`xor` Mask
p) Mask -> Mask -> Mask
forall a. Bits a => a -> a -> a
.&. (Mask
p Mask -> Mask -> Mask
forall a. Bits a => a -> a -> a
`xor` Mask -> Mask
forall a. Num a => a -> a
negate Mask
p) Mask -> Mask -> Bool
forall a. Eq a => a -> a -> Bool
/= Mask
0

{-# INLINE upper #-}
-- | \(\mathcal{O}(1)\).
--   Largest key that can reside under this prefix.
upper :: Prefix -> Key
upper :: Mask -> Mask
upper Mask
p = Mask
p Mask -> Mask -> Mask
forall a. Bits a => a -> a -> a
.|. (Mask
p Mask -> Mask -> Mask
forall a. Num a => a -> a -> a
- Mask
1)

{-# INLINE lower #-}
-- | \(\mathcal{O}(1)\).
--   Smallest key that can reside under this prefix.
lower :: Prefix -> Key
lower :: Mask -> Mask
lower Mask
p = Mask
p Mask -> Mask -> Mask
forall a. Bits a => a -> a -> a
.&. (Mask
p Mask -> Mask -> Mask
forall a. Num a => a -> a -> a
- Mask
1)



-- | Masking bit.
type Mask = Word

{-# INLINE zeroBit #-}
-- | \(\mathcal{O}(1)\).
--   Get the state of the masked bit from the 'Key'.
zeroBit :: Key -> Mask -> Bool
zeroBit :: Mask -> Mask -> Bool
zeroBit Mask
k Mask
m = (Mask
k Mask -> Mask -> Mask
forall a. Bits a => a -> a -> a
.&. Mask
m) Mask -> Mask -> Bool
forall a. Eq a => a -> a -> Bool
== Mask
0

{-# INLINE mask #-}
-- | \(\mathcal{O}(1)\).
--   Trim the 'Key' down to the masking bit.
mask :: Key -> Mask -> Word
mask :: Mask -> Mask -> Mask
mask Mask
k Mask
m = Mask
k Mask -> Mask -> Mask
forall a. Bits a => a -> a -> a
.&. (Mask -> Mask
forall a. Num a => a -> a
negate Mask
m Mask -> Mask -> Mask
forall a. Bits a => a -> a -> a
`xor` Mask
m)

{-# INLINE branchingBit #-}
-- | \(\mathcal{O}(1)\).
--   Find the bit two 'Prefix'es disagree on.
--
--   Note that using this function on two equal integers yields @1 << (-1)@,
--   which results in undefined behavior.
branchingBit :: Prefix -> Prefix -> Mask
branchingBit :: Mask -> Mask -> Mask
branchingBit Mask
p Mask
o =
  Mask
1 Mask -> Int -> Mask
forall a. Bits a => a -> Int -> a
`unsafeShiftL` (Mask -> Int
forall b. FiniteBits b => b -> Int
finiteBitSize (Mask
0 :: Word) Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1 Int -> Int -> Int
forall a. Num a => a -> a -> a
- Mask -> Int
forall b. FiniteBits b => b -> Int
countLeadingZeros (Mask
p Mask -> Mask -> Mask
forall a. Bits a => a -> a -> a
`xor` Mask
o))