module StmHamt.IntOps where

import StmHamt.Prelude hiding (mask, index)
import StmHamt.Types


{-# INLINE atDepth #-}
atDepth :: Int -> Int -> Int
atDepth :: Int -> Int -> Int
atDepth Int
depth Int
hash = Int -> Int -> Int
forall a. Bits a => a -> Int -> a
unsafeShiftR Int
hash Int
depth

{-# INLINE indexAtDepth #-}
indexAtDepth :: Int -> Int -> Int
indexAtDepth :: Int -> Int -> Int
indexAtDepth Int
depth Int
hash = Int -> Int
index (Int -> Int -> Int
atDepth Int
depth Int
hash)

{-# INLINE index #-}
index :: Int -> Int
index :: Int -> Int
index Int
hash = Int
mask Int -> Int -> Int
forall a. Bits a => a -> a -> a
.&. Int
hash

{-# INLINE depthStep #-}
depthStep :: Int
depthStep :: Int
depthStep = Int
5

{-# NOINLINE mask #-}
mask :: Int
mask :: Int
mask = Int -> Int
forall a. Bits a => Int -> a
bit Int
depthStep Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1

{-# INLINE nextDepth #-}
nextDepth :: Int -> Int
nextDepth :: Int -> Int
nextDepth = (Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
depthStep)