{-# LANGUAGE CPP #-}
{-# LANGUAGE TypeApplications #-}
module Data.HashMap.Internal.Debug
( valid
, Validity(..)
, Error(..)
, SubHash
, SubHashPath
) where
import Data.Bits (complement, countTrailingZeros, popCount, shiftL,
unsafeShiftL, (.&.), (.|.))
import Data.Hashable (Hashable)
import Data.HashMap.Internal (Bitmap, Hash, HashMap (..), Leaf (..),
bitsPerSubkey, fullBitmap, hash,
isLeafOrCollision, maxChildren, sparseIndex)
import Data.Semigroup (Sum (..))
import qualified Data.HashMap.Internal.Array as A
#if !MIN_VERSION_base(4,11,0)
import Data.Semigroup (Semigroup (..))
#endif
data Validity k = Invalid (Error k) SubHashPath | Valid
deriving (Validity k -> Validity k -> Bool
(Validity k -> Validity k -> Bool)
-> (Validity k -> Validity k -> Bool) -> Eq (Validity k)
forall k. Eq k => Validity k -> Validity k -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Validity k -> Validity k -> Bool
$c/= :: forall k. Eq k => Validity k -> Validity k -> Bool
== :: Validity k -> Validity k -> Bool
$c== :: forall k. Eq k => Validity k -> Validity k -> Bool
Eq, Int -> Validity k -> ShowS
[Validity k] -> ShowS
Validity k -> String
(Int -> Validity k -> ShowS)
-> (Validity k -> String)
-> ([Validity k] -> ShowS)
-> Show (Validity k)
forall k. Show k => Int -> Validity k -> ShowS
forall k. Show k => [Validity k] -> ShowS
forall k. Show k => Validity k -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Validity k] -> ShowS
$cshowList :: forall k. Show k => [Validity k] -> ShowS
show :: Validity k -> String
$cshow :: forall k. Show k => Validity k -> String
showsPrec :: Int -> Validity k -> ShowS
$cshowsPrec :: forall k. Show k => Int -> Validity k -> ShowS
Show)
instance Semigroup (Validity k) where
Validity k
Valid <> :: Validity k -> Validity k -> Validity k
<> Validity k
y = Validity k
y
Validity k
x <> Validity k
_ = Validity k
x
instance Monoid (Validity k) where
mempty :: Validity k
mempty = Validity k
forall k. Validity k
Valid
mappend :: Validity k -> Validity k -> Validity k
mappend = Validity k -> Validity k -> Validity k
forall a. Semigroup a => a -> a -> a
(<>)
data Error k
= INV1_internal_Empty
| INV2_Bitmap_unexpected_1_bits !Bitmap
| INV3_bad_BitmapIndexed_size !Int
| INV4_bitmap_array_size_mismatch !Bitmap !Int
| INV5_BitmapIndexed_invalid_single_subtree
| INV6_misplaced_hash !Hash
| INV7_key_hash_mismatch k !Hash
| INV8_bad_Full_size !Int
| INV9_Collision_size !Int
| INV10_Collision_duplicate_key k !Hash
deriving (Error k -> Error k -> Bool
(Error k -> Error k -> Bool)
-> (Error k -> Error k -> Bool) -> Eq (Error k)
forall k. Eq k => Error k -> Error k -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Error k -> Error k -> Bool
$c/= :: forall k. Eq k => Error k -> Error k -> Bool
== :: Error k -> Error k -> Bool
$c== :: forall k. Eq k => Error k -> Error k -> Bool
Eq, Int -> Error k -> ShowS
[Error k] -> ShowS
Error k -> String
(Int -> Error k -> ShowS)
-> (Error k -> String) -> ([Error k] -> ShowS) -> Show (Error k)
forall k. Show k => Int -> Error k -> ShowS
forall k. Show k => [Error k] -> ShowS
forall k. Show k => Error k -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Error k] -> ShowS
$cshowList :: forall k. Show k => [Error k] -> ShowS
show :: Error k -> String
$cshow :: forall k. Show k => Error k -> String
showsPrec :: Int -> Error k -> ShowS
$cshowsPrec :: forall k. Show k => Int -> Error k -> ShowS
Show)
type SubHash = Word
data SubHashPath = SubHashPath
{ SubHashPath -> Word
partialHash :: !Word
, SubHashPath -> Int
lengthInBits :: !Int
} deriving (SubHashPath -> SubHashPath -> Bool
(SubHashPath -> SubHashPath -> Bool)
-> (SubHashPath -> SubHashPath -> Bool) -> Eq SubHashPath
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SubHashPath -> SubHashPath -> Bool
$c/= :: SubHashPath -> SubHashPath -> Bool
== :: SubHashPath -> SubHashPath -> Bool
$c== :: SubHashPath -> SubHashPath -> Bool
Eq, Int -> SubHashPath -> ShowS
[SubHashPath] -> ShowS
SubHashPath -> String
(Int -> SubHashPath -> ShowS)
-> (SubHashPath -> String)
-> ([SubHashPath] -> ShowS)
-> Show SubHashPath
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SubHashPath] -> ShowS
$cshowList :: [SubHashPath] -> ShowS
show :: SubHashPath -> String
$cshow :: SubHashPath -> String
showsPrec :: Int -> SubHashPath -> ShowS
$cshowsPrec :: Int -> SubHashPath -> ShowS
Show)
initialSubHashPath :: SubHashPath
initialSubHashPath :: SubHashPath
initialSubHashPath = Word -> Int -> SubHashPath
SubHashPath Word
0 Int
0
addSubHash :: SubHashPath -> SubHash -> SubHashPath
addSubHash :: SubHashPath -> Word -> SubHashPath
addSubHash (SubHashPath Word
ph Int
l) Word
sh =
Word -> Int -> SubHashPath
SubHashPath (Word
ph Word -> Word -> Word
forall a. Bits a => a -> a -> a
.|. (Word
sh Word -> Int -> Word
forall a. Bits a => a -> Int -> a
`unsafeShiftL` Int
l)) (Int
l Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
bitsPerSubkey)
hashMatchesSubHashPath :: SubHashPath -> Hash -> Bool
hashMatchesSubHashPath :: SubHashPath -> Word -> Bool
hashMatchesSubHashPath (SubHashPath Word
ph Int
l) Word
h = Word -> Int -> Word
forall a. (Bits a, Num a) => a -> Int -> a
maskToLength Word
h Int
l Word -> Word -> Bool
forall a. Eq a => a -> a -> Bool
== Word
ph
where
maskToLength :: a -> Int -> a
maskToLength a
h' Int
l' = a
h' a -> a -> a
forall a. Bits a => a -> a -> a
.&. a -> a
forall a. Bits a => a -> a
complement (a -> a
forall a. Bits a => a -> a
complement a
0 a -> Int -> a
forall a. Bits a => a -> Int -> a
`shiftL` Int
l')
valid :: Hashable k => HashMap k v -> Validity k
valid :: HashMap k v -> Validity k
valid HashMap k v
Empty = Validity k
forall k. Validity k
Valid
valid HashMap k v
t = SubHashPath -> HashMap k v -> Validity k
forall k v. Hashable k => SubHashPath -> HashMap k v -> Validity k
validInternal SubHashPath
initialSubHashPath HashMap k v
t
where
validInternal :: SubHashPath -> HashMap k v -> Validity k
validInternal SubHashPath
p HashMap k v
Empty = Error k -> SubHashPath -> Validity k
forall k. Error k -> SubHashPath -> Validity k
Invalid Error k
forall k. Error k
INV1_internal_Empty SubHashPath
p
validInternal SubHashPath
p (Leaf Word
h Leaf k v
l) = SubHashPath -> Word -> Validity k
forall k. SubHashPath -> Word -> Validity k
validHash SubHashPath
p Word
h Validity k -> Validity k -> Validity k
forall a. Semigroup a => a -> a -> a
<> SubHashPath -> Word -> Leaf k v -> Validity k
forall k v.
Hashable k =>
SubHashPath -> Word -> Leaf k v -> Validity k
validLeaf SubHashPath
p Word
h Leaf k v
l
validInternal SubHashPath
p (Collision Word
h Array (Leaf k v)
ary) = SubHashPath -> Word -> Validity k
forall k. SubHashPath -> Word -> Validity k
validHash SubHashPath
p Word
h Validity k -> Validity k -> Validity k
forall a. Semigroup a => a -> a -> a
<> SubHashPath -> Word -> Array (Leaf k v) -> Validity k
forall k v.
Hashable k =>
SubHashPath -> Word -> Array (Leaf k v) -> Validity k
validCollision SubHashPath
p Word
h Array (Leaf k v)
ary
validInternal SubHashPath
p (BitmapIndexed Word
b Array (HashMap k v)
ary) = SubHashPath -> Word -> Array (HashMap k v) -> Validity k
validBitmapIndexed SubHashPath
p Word
b Array (HashMap k v)
ary
validInternal SubHashPath
p (Full Array (HashMap k v)
ary) = SubHashPath -> Array (HashMap k v) -> Validity k
validFull SubHashPath
p Array (HashMap k v)
ary
validHash :: SubHashPath -> Word -> Validity k
validHash SubHashPath
p Word
h | SubHashPath -> Word -> Bool
hashMatchesSubHashPath SubHashPath
p Word
h = Validity k
forall k. Validity k
Valid
| Bool
otherwise = Error k -> SubHashPath -> Validity k
forall k. Error k -> SubHashPath -> Validity k
Invalid (Word -> Error k
forall k. Word -> Error k
INV6_misplaced_hash Word
h) SubHashPath
p
validLeaf :: SubHashPath -> Word -> Leaf k v -> Validity k
validLeaf SubHashPath
p Word
h (L k
k v
_) | k -> Word
forall a. Hashable a => a -> Word
hash k
k Word -> Word -> Bool
forall a. Eq a => a -> a -> Bool
== Word
h = Validity k
forall k. Validity k
Valid
| Bool
otherwise = Error k -> SubHashPath -> Validity k
forall k. Error k -> SubHashPath -> Validity k
Invalid (k -> Word -> Error k
forall k. k -> Word -> Error k
INV7_key_hash_mismatch k
k Word
h) SubHashPath
p
validCollision :: SubHashPath -> Word -> Array (Leaf k v) -> Validity k
validCollision SubHashPath
p Word
h Array (Leaf k v)
ary = Validity k
forall k. Validity k
validCollisionSize Validity k -> Validity k -> Validity k
forall a. Semigroup a => a -> a -> a
<> (Leaf k v -> Validity k) -> Array (Leaf k v) -> Validity k
forall m a. Monoid m => (a -> m) -> Array a -> m
A.foldMap (SubHashPath -> Word -> Leaf k v -> Validity k
forall k v.
Hashable k =>
SubHashPath -> Word -> Leaf k v -> Validity k
validLeaf SubHashPath
p Word
h) Array (Leaf k v)
ary Validity k -> Validity k -> Validity k
forall a. Semigroup a => a -> a -> a
<> Validity k
distinctKeys
where
n :: Int
n = Array (Leaf k v) -> Int
forall a. Array a -> Int
A.length Array (Leaf k v)
ary
validCollisionSize :: Validity k
validCollisionSize | Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
2 = Error k -> SubHashPath -> Validity k
forall k. Error k -> SubHashPath -> Validity k
Invalid (Int -> Error k
forall k. Int -> Error k
INV9_Collision_size Int
n) SubHashPath
p
| Bool
otherwise = Validity k
forall k. Validity k
Valid
distinctKeys :: Validity k
distinctKeys = (Leaf k v -> Validity k) -> Array (Leaf k v) -> Validity k
forall m a. Monoid m => (a -> m) -> Array a -> m
A.foldMap (\(L k
k v
_) -> k -> Validity k
appearsOnce k
k) Array (Leaf k v)
ary
appearsOnce :: k -> Validity k
appearsOnce k
k | (Leaf k v -> Sum Int) -> Array (Leaf k v) -> Sum Int
forall m a. Monoid m => (a -> m) -> Array a -> m
A.foldMap (\(L k
k' v
_) -> if k
k' k -> k -> Bool
forall a. Eq a => a -> a -> Bool
== k
k then Int -> Sum Int
forall a. a -> Sum a
Sum @Int Int
1 else Int -> Sum Int
forall a. a -> Sum a
Sum Int
0) Array (Leaf k v)
ary Sum Int -> Sum Int -> Bool
forall a. Eq a => a -> a -> Bool
== Sum Int
1 = Validity k
forall k. Validity k
Valid
| Bool
otherwise = Error k -> SubHashPath -> Validity k
forall k. Error k -> SubHashPath -> Validity k
Invalid (k -> Word -> Error k
forall k. k -> Word -> Error k
INV10_Collision_duplicate_key k
k Word
h) SubHashPath
p
validBitmapIndexed :: SubHashPath -> Word -> Array (HashMap k v) -> Validity k
validBitmapIndexed SubHashPath
p Word
b Array (HashMap k v)
ary = Validity k
forall k. Validity k
validBitmap Validity k -> Validity k -> Validity k
forall a. Semigroup a => a -> a -> a
<> Validity k
forall k. Validity k
validArraySize Validity k -> Validity k -> Validity k
forall a. Semigroup a => a -> a -> a
<> SubHashPath -> Word -> Array (HashMap k v) -> Validity k
validSubTrees SubHashPath
p Word
b Array (HashMap k v)
ary
where
validBitmap :: Validity k
validBitmap | Word
b Word -> Word -> Word
forall a. Bits a => a -> a -> a
.&. Word -> Word
forall a. Bits a => a -> a
complement Word
fullBitmap Word -> Word -> Bool
forall a. Eq a => a -> a -> Bool
== Word
0 = Validity k
forall k. Validity k
Valid
| Bool
otherwise = Error k -> SubHashPath -> Validity k
forall k. Error k -> SubHashPath -> Validity k
Invalid (Word -> Error k
forall k. Word -> Error k
INV2_Bitmap_unexpected_1_bits Word
b) SubHashPath
p
n :: Int
n = Array (HashMap k v) -> Int
forall a. Array a -> Int
A.length Array (HashMap k v)
ary
validArraySize :: Validity k
validArraySize | Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
1 Bool -> Bool -> Bool
|| Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
maxChildren = Error k -> SubHashPath -> Validity k
forall k. Error k -> SubHashPath -> Validity k
Invalid (Int -> Error k
forall k. Int -> Error k
INV3_bad_BitmapIndexed_size Int
n) SubHashPath
p
| Word -> Int
forall a. Bits a => a -> Int
popCount Word
b Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
n = Validity k
forall k. Validity k
Valid
| Bool
otherwise = Error k -> SubHashPath -> Validity k
forall k. Error k -> SubHashPath -> Validity k
Invalid (Word -> Int -> Error k
forall k. Word -> Int -> Error k
INV4_bitmap_array_size_mismatch Word
b Int
n) SubHashPath
p
validSubTrees :: SubHashPath -> Word -> Array (HashMap k v) -> Validity k
validSubTrees SubHashPath
p Word
b Array (HashMap k v)
ary
| Array (HashMap k v) -> Int
forall a. Array a -> Int
A.length Array (HashMap k v)
ary Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
1
, HashMap k v -> Bool
forall k v. HashMap k v -> Bool
isLeafOrCollision (Array (HashMap k v) -> Int -> HashMap k v
forall a. Array a -> Int -> a
A.index Array (HashMap k v)
ary Int
0)
= Error k -> SubHashPath -> Validity k
forall k. Error k -> SubHashPath -> Validity k
Invalid Error k
forall k. Error k
INV5_BitmapIndexed_invalid_single_subtree SubHashPath
p
| Bool
otherwise = Word -> Validity k
go Word
b
where
go :: Word -> Validity k
go Word
0 = Validity k
forall k. Validity k
Valid
go Word
b' = SubHashPath -> HashMap k v -> Validity k
validInternal (SubHashPath -> Word -> SubHashPath
addSubHash SubHashPath
p (Int -> Word
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
c)) (Array (HashMap k v) -> Int -> HashMap k v
forall a. Array a -> Int -> a
A.index Array (HashMap k v)
ary Int
i) Validity k -> Validity k -> Validity k
forall a. Semigroup a => a -> a -> a
<> Word -> Validity k
go Word
b''
where
c :: Int
c = Word -> Int
forall b. FiniteBits b => b -> Int
countTrailingZeros Word
b'
m :: Word
m = Word
1 Word -> Int -> Word
forall a. Bits a => a -> Int -> a
`unsafeShiftL` Int
c
i :: Int
i = Word -> Word -> Int
sparseIndex Word
b Word
m
b'' :: Word
b'' = Word
b' Word -> Word -> Word
forall a. Bits a => a -> a -> a
.&. Word -> Word
forall a. Bits a => a -> a
complement Word
m
validFull :: SubHashPath -> Array (HashMap k v) -> Validity k
validFull SubHashPath
p Array (HashMap k v)
ary = Validity k
forall k. Validity k
validArraySize Validity k -> Validity k -> Validity k
forall a. Semigroup a => a -> a -> a
<> SubHashPath -> Word -> Array (HashMap k v) -> Validity k
validSubTrees SubHashPath
p Word
fullBitmap Array (HashMap k v)
ary
where
n :: Int
n = Array (HashMap k v) -> Int
forall a. Array a -> Int
A.length Array (HashMap k v)
ary
validArraySize :: Validity k
validArraySize | Int
n Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
maxChildren = Validity k
forall k. Validity k
Valid
| Bool
otherwise = Error k -> SubHashPath -> Validity k
forall k. Error k -> SubHashPath -> Validity k
Invalid (Int -> Error k
forall k. Int -> Error k
INV8_bad_Full_size Int
n) SubHashPath
p