From 63b88617e5b2ca505367dfafe3bcc0b7575c52e7 Mon Sep 17 00:00:00 2001
From: Tom Sydney Kerckhove <syd@fpcomplete.com>
Date: Tue, 14 Aug 2018 12:48:57 +0200
Subject: [PATCH 01/69] Intermediary commit

---
 Data/HashMap/Base.hs | 73 ++++++++++++++++++--------------------------
 stack.yaml           |  3 ++
 2 files changed, 33 insertions(+), 43 deletions(-)
 create mode 100644 stack.yaml

diff --git a/Data/HashMap/Base.hs b/Data/HashMap/Base.hs
index 553d2b3a..9085181a 100644
--- a/Data/HashMap/Base.hs
+++ b/Data/HashMap/Base.hs
@@ -181,7 +181,7 @@ data HashMap k v
     | BitmapIndexed !Bitmap !(A.Array (HashMap k v))
     | Leaf !Hash !(Leaf k v)
     | Full !(A.Array (HashMap k v))
-    | Collision !Hash !(A.Array (Leaf k v))
+    | Collision !Hash !Salt !(HashMap k v)
       deriving (Typeable)
 
 type role HashMap nominal representational
@@ -191,7 +191,7 @@ instance (NFData k, NFData v) => NFData (HashMap k v) where
     rnf (BitmapIndexed _ ary) = rnf ary
     rnf (Leaf _ l)            = rnf l
     rnf (Full ary)            = rnf ary
-    rnf (Collision _ ary)     = rnf ary
+    rnf (Collision _ _ ary)     = rnf ary
 
 instance Functor (HashMap k) where
     fmap = map
@@ -231,6 +231,7 @@ hashMapDataType :: DataType
 hashMapDataType = mkDataType "Data.HashMap.Base.HashMap" [fromListConstr]
 
 type Hash   = Word
+type Salt   = Int
 type Bitmap = Word
 type Shift  = Int
 
@@ -293,8 +294,8 @@ equal1 eq = go
       = bm1 == bm2 && A.sameArray1 go ary1 ary2
     go (Leaf h1 l1) (Leaf h2 l2) = h1 == h2 && leafEq l1 l2
     go (Full ary1) (Full ary2) = A.sameArray1 go ary1 ary2
-    go (Collision h1 ary1) (Collision h2 ary2)
-      = h1 == h2 && isPermutationBy leafEq (A.toList ary1) (A.toList ary2)
+    go (Collision h1 s1 hm1) (Collision h2 s2 hm2)
+      = h1 == h2 && s1 == s2 && go hm1 hm2
     go _ _ = False
 
     leafEq (L k1 v1) (L k2 v2) = k1 == k2 && eq v1 v2
@@ -311,10 +312,10 @@ equal2 eqk eqv t1 t2 = go (toList' t1 []) (toList' t2 [])
       | k1 == k2 &&
         leafEq l1 l2
       = go tl1 tl2
-    go (Collision k1 ary1 : tl1) (Collision k2 ary2 : tl2)
-      | k1 == k2 &&
-        A.length ary1 == A.length ary2 &&
-        isPermutationBy leafEq (A.toList ary1) (A.toList ary2)
+    go (Collision h1 s1 hm1 : tl1) (Collision h2 s2 hm2 : tl2)
+      | h1 == h2 &&
+        s1 == s2 &&
+        go (toList' hm1 []) (toList' hm2 [])
       = go tl1 tl2
     go [] [] = True
     go _  _  = False
@@ -345,13 +346,13 @@ cmp cmpk cmpv t1 t2 = go (toList' t1 []) (toList' t2 [])
       = compare k1 k2 `mappend`
         leafCompare l1 l2 `mappend`
         go tl1 tl2
-    go (Collision k1 ary1 : tl1) (Collision k2 ary2 : tl2)
-      = compare k1 k2 `mappend`
-        compare (A.length ary1) (A.length ary2) `mappend`
-        unorderedCompare leafCompare (A.toList ary1) (A.toList ary2) `mappend`
+    go (Collision h1 s1 hm1 : tl1) (Collision h2 s2 hm2 : tl2)
+      = compare h1 h2 `mappend`
+        compare s1 s2 `mappend`
+        go (toList' hm1 []) (toList' hm2 []) `mappend`
         go tl1 tl2
-    go (Leaf _ _ : _) (Collision _ _ : _) = LT
-    go (Collision _ _ : _) (Leaf _ _ : _) = GT
+    go (Leaf _ _ : _) (Collision _ _ _ : _) = LT
+    go (Collision _ _ _ : _) (Leaf _ _ : _) = GT
     go [] [] = EQ
     go [] _  = LT
     go _  [] = GT
@@ -366,9 +367,9 @@ equalKeys1 eq t1 t2 = go (toList' t1 []) (toList' t2 [])
     go (Leaf k1 l1 : tl1) (Leaf k2 l2 : tl2)
       | k1 == k2 && leafEq l1 l2
       = go tl1 tl2
-    go (Collision k1 ary1 : tl1) (Collision k2 ary2 : tl2)
-      | k1 == k2 && A.length ary1 == A.length ary2 &&
-        isPermutationBy leafEq (A.toList ary1) (A.toList ary2)
+    go (Collision h1 s1 hm1 : tl1) (Collision h2 s2 hm2 : tl2)
+      | h1 == h2 && s1 == s2 &&
+        go (toList' hm1 []) (toList' hm2 [])
       = go tl1 tl2
     go [] [] = True
     go _  _  = False
@@ -385,8 +386,8 @@ equalKeys = go
       = bm1 == bm2 && A.sameArray1 go ary1 ary2
     go (Leaf h1 l1) (Leaf h2 l2) = h1 == h2 && leafEq l1 l2
     go (Full ary1) (Full ary2) = A.sameArray1 go ary1 ary2
-    go (Collision h1 ary1) (Collision h2 ary2)
-      = h1 == h2 && isPermutationBy leafEq (A.toList ary1) (A.toList ary2)
+    go (Collision h1 s1 hm1) (Collision h2 s2 hm2)
+      = h1 == h2 && s1 == s2 && go hm1 hm2
     go _ _ = False
 
     leafEq (L k1 _) (L k2 _) = k1 == k2
@@ -401,20 +402,13 @@ instance H.Hashable2 HashMap where
           = s `hashLeafWithSalt` l `go` tl
         -- For collisions we hashmix hash value
         -- and then array of values' hashes sorted
-        go s (Collision h a : tl)
-          = (s `H.hashWithSalt` h) `hashCollisionWithSalt` a `go` tl
+        go s (Collision h s' hm' : tl)
+          = (((s `H.hashWithSalt` h) `H.hashWithSalt` s') `go` (toList' hm' [])) `go` tl
         go s (_ : tl) = s `go` tl
 
         -- hashLeafWithSalt :: Int -> Leaf k v -> Int
         hashLeafWithSalt s (L k v) = (s `hk` k) `hv` v
 
-        -- hashCollisionWithSalt :: Int -> A.Array (Leaf k v) -> Int
-        hashCollisionWithSalt s
-          = L.foldl' H.hashWithSalt s . arrayHashesSorted s
-
-        -- arrayHashesSorted :: Int -> A.Array (Leaf k v) -> [Int]
-        arrayHashesSorted s = L.sort . L.map (hashLeafWithSalt s) . A.toList
-
 instance (Hashable k) => H.Hashable1 (HashMap k) where
     liftHashWithSalt = H.liftHashWithSalt2 H.hashWithSalt
 #endif
@@ -428,33 +422,26 @@ instance (Hashable k, Hashable v) => Hashable (HashMap k v) where
           = s `hashLeafWithSalt` l `go` tl
         -- For collisions we hashmix hash value
         -- and then array of values' hashes sorted
-        go s (Collision h a : tl)
-          = (s `H.hashWithSalt` h) `hashCollisionWithSalt` a `go` tl
+        go s (Collision h s' hm' : tl)
+          = (((s `H.hashWithSalt` h) `H.hashWithSalt` s') `go` (toList' hm' [])) `go` tl
         go s (_ : tl) = s `go` tl
 
         hashLeafWithSalt :: Int -> Leaf k v -> Int
         hashLeafWithSalt s (L k v) = s `H.hashWithSalt` k `H.hashWithSalt` v
 
-        hashCollisionWithSalt :: Int -> A.Array (Leaf k v) -> Int
-        hashCollisionWithSalt s
-          = L.foldl' H.hashWithSalt s . arrayHashesSorted s
-
-        arrayHashesSorted :: Int -> A.Array (Leaf k v) -> [Int]
-        arrayHashesSorted s = L.sort . L.map (hashLeafWithSalt s) . A.toList
-
-  -- Helper to get 'Leaf's and 'Collision's as a list.
+  -- Helper to get 'Leaf's as a list.
 toList' :: HashMap k v -> [HashMap k v] -> [HashMap k v]
 toList' (BitmapIndexed _ ary) a = A.foldr toList' a ary
 toList' (Full ary)            a = A.foldr toList' a ary
 toList' l@(Leaf _ _)          a = l : a
-toList' c@(Collision _ _)     a = c : a
+toList' (Collision _ _ hm)    a = toList' hm a
 toList' Empty                 a = a
 
 -- Helper function to detect 'Leaf's and 'Collision's.
 isLeafOrCollision :: HashMap k v -> Bool
-isLeafOrCollision (Leaf _ _)      = True
-isLeafOrCollision (Collision _ _) = True
-isLeafOrCollision _               = False
+isLeafOrCollision (Leaf _ _)        = True
+isLeafOrCollision (Collision _ _ _) = True
+isLeafOrCollision _                 = False
 
 ------------------------------------------------------------------------
 -- * Construction
@@ -483,7 +470,7 @@ size t = go t 0
     go (Leaf _ _)            n = n + 1
     go (BitmapIndexed _ ary) n = A.foldl' (flip go) n ary
     go (Full ary)            n = A.foldl' (flip go) n ary
-    go (Collision _ ary)     n = n + A.length ary
+    go (Collision _ _ hm)    n = go hm n
 
 -- | /O(log n)/ Return 'True' if the specified key is present in the
 -- map, 'False' otherwise.
diff --git a/stack.yaml b/stack.yaml
new file mode 100644
index 00000000..d082516b
--- /dev/null
+++ b/stack.yaml
@@ -0,0 +1,3 @@
+resolver: lts-10.10
+packages:
+- .

From c96f41e220ab265686afcbbf4fa26e185b2223e9 Mon Sep 17 00:00:00 2001
From: Tom Sydney Kerckhove <syd@fpcomplete.com>
Date: Tue, 14 Aug 2018 14:06:23 +0200
Subject: [PATCH 02/69] Halfway through

---
 Data/HashMap/Base.hs | 312 +++++++++++++++++++++----------------------
 1 file changed, 154 insertions(+), 158 deletions(-)

diff --git a/Data/HashMap/Base.hs b/Data/HashMap/Base.hs
index 9085181a..58eb42fe 100644
--- a/Data/HashMap/Base.hs
+++ b/Data/HashMap/Base.hs
@@ -78,6 +78,7 @@ module Data.HashMap.Base
 
       -- Internals used by the strict version
     , Hash
+    , Salt
     , Bitmap
     , bitmapIndexedOrFull
     , collision
@@ -161,9 +162,9 @@ import Data.Coerce (coerce)
 -- | A set of values.  A set cannot contain duplicate values.
 ------------------------------------------------------------------------
 
--- | Convenience function.  Compute a hash value for the given value.
-hash :: H.Hashable a => a -> Hash
-hash = fromIntegral . H.hash
+-- | Convenience function.  Compute a hash value for the given value with a given salt.
+hashWithSalt :: H.Hashable a => Salt -> a -> Hash
+hashWithSalt s v = fromIntegral $ H.hashWithSalt s v
 
 data Leaf k v = L !k v
   deriving (Eq)
@@ -181,7 +182,7 @@ data HashMap k v
     | BitmapIndexed !Bitmap !(A.Array (HashMap k v))
     | Leaf !Hash !(Leaf k v)
     | Full !(A.Array (HashMap k v))
-    | Collision !Hash !Salt !(HashMap k v)
+    | Collision !Hash !Salt !(HashMap k v) -- The new salt (TODO remove this comment)
       deriving (Typeable)
 
 type role HashMap nominal representational
@@ -452,7 +453,7 @@ empty = Empty
 
 -- | /O(1)/ Construct a map with a single element.
 singleton :: (Hashable k) => k -> v -> HashMap k v
-singleton k v = Leaf (hash k) (L k v)
+singleton k v = Leaf (hashWithSalt defaultSalt k) (L k v)
 
 ------------------------------------------------------------------------
 -- * Basic interface
@@ -493,18 +494,18 @@ lookup k m = case lookup# k m of
 {-# INLINE lookup #-}
 
 lookup# :: (Eq k, Hashable k) => k -> HashMap k v -> (# (# #) | v #)
-lookup# k m = lookupCont (\_ -> (# (# #) | #)) (\v _i -> (# | v #)) (hash k) k m
+lookup# k m = lookupCont (\_ -> (# (# #) | #)) (\v _i -> (# | v #)) (hashWithSalt defaultSalt k) defaultSalt k m
 {-# INLINABLE lookup# #-}
 
 #else
 
-lookup k m = lookupCont (\_ -> Nothing) (\v _i -> Just v) (hash k) k m
+lookup k m = lookupCont (\_ -> Nothing) (\v _i -> Just v) (hashWithSalt s k) defaultSalt k m
 {-# INLINABLE lookup #-}
 #endif
 
 -- | lookup' is a version of lookup that takes the hash separately.
 -- It is used to implement alterF.
-lookup' :: Eq k => Hash -> k -> HashMap k v -> Maybe v
+lookup' :: Eq k => Hash -> Salt -> k -> HashMap k v -> Maybe v
 #if __GLASGOW_HASKELL__ >= 802
 -- GHC does not yet perform a worker-wrapper transformation on
 -- unboxed sums automatically. That seems likely to happen at some
@@ -512,12 +513,12 @@ lookup' :: Eq k => Hash -> k -> HashMap k v -> Maybe v
 -- lookup' would probably prefer to be implemented in terms of its own
 -- lookup'#, but it's not important enough and we don't want too much
 -- code.
-lookup' h k m = case lookupRecordCollision# h k m of
+lookup' h s k m = case lookupRecordCollision# h s k m of
   (# (# #) | #) -> Nothing
   (# | (# a, _i #) #) -> Just a
 {-# INLINE lookup' #-}
 #else
-lookup' h k m = lookupCont (\_ -> Nothing) (\v _i -> Just v) h k m
+lookup' h s k m = lookupCont (\_ -> Nothing) (\v _i -> Just v) h s k m
 {-# INLINABLE lookup' #-}
 #endif
 
@@ -538,9 +539,9 @@ data LookupRes a = Absent | Present a !Int
 --   Key not in map           => Absent
 --   Key in map, no collision => Present v (-1)
 --   Key in map, collision    => Present v position
-lookupRecordCollision :: Eq k => Hash -> k -> HashMap k v -> LookupRes v
+lookupRecordCollision :: Eq k => Hash -> Salt -> k -> HashMap k v -> LookupRes v
 #if __GLASGOW_HASKELL__ >= 802
-lookupRecordCollision h k m = case lookupRecordCollision# h k m of
+lookupRecordCollision h s k m = case lookupRecordCollision# h s k m of
   (# (# #) | #) -> Absent
   (# | (# a, i #) #) -> Present a (I# i) -- GHC will eliminate the I#
 {-# INLINE lookupRecordCollision #-}
@@ -550,15 +551,15 @@ lookupRecordCollision h k m = case lookupRecordCollision# h k m of
 -- may be changing in GHC 8.6 or so (there is some work in progress), but
 -- for now we use Int# explicitly here. We don't need to push the Int#
 -- into lookupCont because inlining takes care of that.
-lookupRecordCollision# :: Eq k => Hash -> k -> HashMap k v -> (# (# #) | (# v, Int# #) #)
-lookupRecordCollision# h k m =
-    lookupCont (\_ -> (# (# #) | #)) (\v (I# i) -> (# | (# v, i #) #)) h k m
+lookupRecordCollision# :: Eq k => Hash -> Salt -> k -> HashMap k v -> (# (# #) | (# v, Int# #) #)
+lookupRecordCollision# h s k m =
+    lookupCont (\_ -> (# (# #) | #)) (\v (I# i) -> (# | (# v, i #) #)) h s k m
 -- INLINABLE to specialize to the Eq instance.
 {-# INLINABLE lookupRecordCollision# #-}
 
 #else /* GHC < 8.2 so there are no unboxed sums */
 
-lookupRecordCollision h k m = lookupCont (\_ -> Absent) Present h k m
+lookupRecordCollision h s k m = lookupCont (\_ -> Absent) Present h s k m
 {-# INLINABLE lookupRecordCollision #-}
 #endif
 
@@ -580,23 +581,24 @@ lookupCont ::
   => ((# #) -> r)    -- Absent continuation
   -> (v -> Int -> r) -- Present continuation
   -> Hash -- The hash of the key
+  -> Salt -- The salt that was used to obtain that hash
   -> k -> HashMap k v -> r
-lookupCont absent present !h0 !k0 !m0 = go h0 k0 0 m0
+lookupCont absent present !h0 !s0 !k0 !m0 = go h0 s0 k0 0 m0
   where
-    go :: Eq k => Hash -> k -> Int -> HashMap k v -> r
-    go !_ !_ !_ Empty = absent (# #)
-    go h k _ (Leaf hx (L kx x))
+    go :: Eq k => Hash -> Salt -> k -> Int -> HashMap k v -> r
+    go !_ !_ !_ !_ Empty = absent (# #)
+    go h _ k _ (Leaf hx (L kx x))
         | h == hx && k == kx = present x (-1)
         | otherwise          = absent (# #)
-    go h k s (BitmapIndexed b v)
+    go h s k bs (BitmapIndexed b v)
         | b .&. m == 0 = absent (# #)
         | otherwise    =
-            go h k (s+bitsPerSubkey) (A.index v (sparseIndex b m))
+            go h s k (bs+bitsPerSubkey) (A.index v (sparseIndex b m))
       where m = mask h s
-    go h k s (Full v) =
-      go h k (s+bitsPerSubkey) (A.index v (index h s))
-    go h k _ (Collision hx v)
-        | h == hx   = lookupInArrayCont absent present k v
+    go h s k bs (Full v) =
+      go h s k (bs+bitsPerSubkey) (A.index v (index h s))
+    go h s k _ (Collision hx sx hmx)
+        | h == hx   = go h sx k 0 hmx
         | otherwise = absent (# #)
 {-# INLINE lookupCont #-}
 
@@ -621,14 +623,26 @@ lookupDefault def k t = case lookup k t of
 infixl 9 !
 
 -- | Create a 'Collision' value with two 'Leaf' values.
-collision :: Hash -> Leaf k v -> Leaf k v -> HashMap k v
-collision h !e1 !e2 =
-    let v = A.run $ do mary <- A.new 2 e1
-                       A.write mary 1 e2
-                       return mary
-    in Collision h v
+collision :: (Eq k, Hashable k) => Hash -> Salt -> Leaf k v -> Leaf k v -> HashMap k v
+collision h s !(L k1 v1) !(L k2 v2) =
+  let s' = nextSalt s
+      rehash = hashWithSalt s'
+      h1 = rehash k1
+      h2 = rehash k2
+      hm = runST $ two 0 h1 k1 v1 h2 k2 v2
+  in Collision h s' hm
 {-# INLINE collision #-}
 
+defaultSalt :: Int
+#if WORD_SIZE_IN_BITS == 64
+defaultSalt = -2578643520546668380  -- 0xdc36d1615b7400a4
+#else
+defaultSalt = 0x087fc72c
+#endif
+
+nextSalt :: Salt -> Salt
+nextSalt = (+1)
+
 -- | Create a 'BitmapIndexed' or 'Full' node.
 bitmapIndexedOrFull :: Bitmap -> A.Array (HashMap k v) -> HashMap k v
 bitmapIndexedOrFull b ary
@@ -640,42 +654,43 @@ bitmapIndexedOrFull b ary
 -- key in this map.  If this map previously contained a mapping for
 -- the key, the old value is replaced.
 insert :: (Eq k, Hashable k) => k -> v -> HashMap k v -> HashMap k v
-insert k v m = insert' (hash k) k v m
+insert k v m = insert' (hashWithSalt defaultSalt k) defaultSalt k v m
 {-# INLINABLE insert #-}
 
-insert' :: Eq k => Hash -> k -> v -> HashMap k v -> HashMap k v
-insert' h0 k0 v0 m0 = go h0 k0 v0 0 m0
+insert' :: (Eq k, Hashable k) => Hash -> Salt -> k -> v -> HashMap k v -> HashMap k v
+insert' h0 s0 k0 v0 m0 = go h0 s0 k0 v0 0 m0
   where
-    go !h !k x !_ Empty = Leaf h (L k x)
-    go h k x s t@(Leaf hy l@(L ky y))
+    go :: (Eq k, Hashable k) => Hash -> Salt -> k -> v -> Int -> HashMap k v -> HashMap k v
+    go !h _ !k x !_ Empty = Leaf h (L k x)
+    go h s k x bs t@(Leaf hy l@(L ky y))
         | hy == h = if ky == k
                     then if x `ptrEq` y
                          then t
                          else Leaf h (L k x)
-                    else collision h l (L k x)
-        | otherwise = runST (two s h k x hy ky y)
-    go h k x s t@(BitmapIndexed b ary)
+                    else collision h s l (L k x)
+        | otherwise = runST (two bs h k x hy ky y)
+    go h s k x bs t@(BitmapIndexed b ary)
         | b .&. m == 0 =
             let !ary' = A.insert ary i $! Leaf h (L k x)
             in bitmapIndexedOrFull (b .|. m) ary'
         | otherwise =
             let !st  = A.index ary i
-                !st' = go h k x (s+bitsPerSubkey) st
+                !st' = go h s k x (bs+bitsPerSubkey) st
             in if st' `ptrEq` st
                then t
                else BitmapIndexed b (A.update ary i st')
-      where m = mask h s
+      where m = mask h bs
             i = sparseIndex b m
-    go h k x s t@(Full ary) =
+    go h s k x bs t@(Full ary) =
         let !st  = A.index ary i
-            !st' = go h k x (s+bitsPerSubkey) st
+            !st' = go h s k x (bs+bitsPerSubkey) st
         in if st' `ptrEq` st
             then t
             else Full (update16 ary i st')
-      where i = index h s
-    go h k x s t@(Collision hy v)
-        | h == hy   = Collision h (updateOrSnocWith const k x v)
-        | otherwise = go h k x s $ BitmapIndexed (mask hy s) (A.singleton t)
+      where i = index h bs
+    go h s k x bs t@(Collision hx sx hmx)
+        | h == hx   = Collision hx sx $ insert' (hashWithSalt sx k) sx k x hmx
+        | otherwise = go h s k x bs $ BitmapIndexed (mask hx bs) (A.singleton t)
 {-# INLINABLE insert' #-}
 
 -- Insert optimized for the case when we know the key is not in the map.
@@ -685,75 +700,63 @@ insert' h0 k0 v0 m0 = go h0 k0 v0 0 m0
 -- We can skip:
 --  - the key equality check on a Leaf
 --  - check for its existence in the array for a hash collision
-insertNewKey :: Hash -> k -> v -> HashMap k v -> HashMap k v
-insertNewKey !h0 !k0 x0 !m0 = go h0 k0 x0 0 m0
+insertNewKey :: (Eq k, Hashable k) => Hash -> Salt -> k -> v -> HashMap k v -> HashMap k v
+insertNewKey !h0 !s0 !k0 x0 !m0 = go h0 s0 k0 x0 0 m0
   where
-    go !h !k x !_ Empty = Leaf h (L k x)
-    go h k x s (Leaf hy l@(L ky y))
-      | hy == h = collision h l (L k x)
-      | otherwise = runST (two s h k x hy ky y)
-    go h k x s (BitmapIndexed b ary)
+    go !h _ !k x !_ Empty = Leaf h (L k x)
+    go h s k x bs (Leaf hy l@(L ky y))
+      | hy == h = collision h s l (L k x)
+      | otherwise = runST (two bs h k x hy ky y)
+    go h s k x bs (BitmapIndexed b ary)
         | b .&. m == 0 =
             let !ary' = A.insert ary i $! Leaf h (L k x)
             in bitmapIndexedOrFull (b .|. m) ary'
         | otherwise =
             let !st  = A.index ary i
-                !st' = go h k x (s+bitsPerSubkey) st
+                !st' = go h s k x (bs+bitsPerSubkey) st
             in BitmapIndexed b (A.update ary i st')
-      where m = mask h s
+      where m = mask h bs
             i = sparseIndex b m
-    go h k x s (Full ary) =
+    go h s k x bs (Full ary) =
         let !st  = A.index ary i
-            !st' = go h k x (s+bitsPerSubkey) st
+            !st' = go h s k x (bs+bitsPerSubkey) st
         in Full (update16 ary i st')
-      where i = index h s
-    go h k x s t@(Collision hy v)
-        | h == hy   = Collision h (snocNewLeaf (L k x) v)
+      where i = index h bs
+    go h s k x bs t@(Collision hx sx hmx)
+        | h == hx   = Collision hx sx $ insertNewKey (hashWithSalt sx k) sx k x hmx
         | otherwise =
-            go h k x s $ BitmapIndexed (mask hy s) (A.singleton t)
-      where
-        snocNewLeaf :: Leaf k v -> A.Array (Leaf k v) -> A.Array (Leaf k v)
-        snocNewLeaf leaf ary = A.run $ do
-          let n = A.length ary
-          mary <- A.new_ (n + 1)
-          A.copy ary 0 mary 0 n
-          A.write mary n leaf
-          return mary
+            go h s k x bs $ BitmapIndexed (mask hx bs) (A.singleton t)
 {-# NOINLINE insertNewKey #-}
 
 
 -- Insert optimized for the case when we know the key is in the map.
 --
--- It is only valid to call this when the key exists in the map and you know the
--- hash collision position if there was one. This information can be obtained
--- from 'lookupRecordCollision'. If there is no collision pass (-1) as collPos
--- (first argument).
---
 -- We can skip the key equality check on a Leaf because we know the leaf must be
 -- for this key.
-insertKeyExists :: Int -> Hash -> k -> v -> HashMap k v -> HashMap k v
-insertKeyExists !collPos0 !h0 !k0 x0 !m0 = go collPos0 h0 k0 x0 0 m0
+insertKeyExists :: (Hashable k) => Hash -> Salt -> k -> v -> HashMap k v -> HashMap k v
+insertKeyExists !h0 !s0 !k0 x0 !m0 = go h0 s0 k0 x0 0 m0
   where
-    go !_collPos !h !k x !_s (Leaf _hy _kx)
+    go !h _ !k x !_s (Leaf _hy _kx)
         = Leaf h (L k x)
-    go collPos h k x s (BitmapIndexed b ary)
+    go h s k x bs (BitmapIndexed b ary)
         | b .&. m == 0 =
             let !ary' = A.insert ary i $ Leaf h (L k x)
             in bitmapIndexedOrFull (b .|. m) ary'
         | otherwise =
             let !st  = A.index ary i
-                !st' = go collPos h k x (s+bitsPerSubkey) st
+                !st' = go h s k x (bs+bitsPerSubkey) st
             in BitmapIndexed b (A.update ary i st')
-      where m = mask h s
+      where m = mask h bs
             i = sparseIndex b m
-    go collPos h k x s (Full ary) =
+    go h s k x bs (Full ary) =
         let !st  = A.index ary i
-            !st' = go collPos h k x (s+bitsPerSubkey) st
+            !st' = go h s k x (bs+bitsPerSubkey) st
         in Full (update16 ary i st')
-      where i = index h s
-    go collPos h k x _s (Collision _hy v)
-        | collPos >= 0 = Collision h (setAtPosition collPos k x v)
-        | otherwise = Empty -- error "Internal error: go {collPos negative}"
+      where i = index h bs
+    go h s k x bs t@(Collision hx sx hmx)
+        | h == hx   = Collision hx sx $ insertKeyExists (hashWithSalt sx k) sx k x hmx
+        | otherwise =
+            go h s k x bs $ BitmapIndexed (mask hx bs) (A.singleton t)
     go _ _ _ _ _ Empty = Empty -- error "Internal error: go Empty"
 
 {-# NOINLINE insertKeyExists #-}
@@ -768,37 +771,38 @@ setAtPosition i k x ary = A.update ary i (L k x)
 
 -- | In-place update version of insert
 unsafeInsert :: (Eq k, Hashable k) => k -> v -> HashMap k v -> HashMap k v
-unsafeInsert k0 v0 m0 = runST (go h0 k0 v0 0 m0)
+unsafeInsert k0 v0 m0 = runST (go h0 s0 k0 v0 0 m0)
   where
-    h0 = hash k0
-    go !h !k x !_ Empty = return $! Leaf h (L k x)
-    go h k x s t@(Leaf hy l@(L ky y))
+    h0 = hashWithSalt s0 k0
+    s0 = defaultSalt
+    go !h _ !k x !_ Empty = return $! Leaf h (L k x)
+    go h s k x bs t@(Leaf hy l@(L ky y))
         | hy == h = if ky == k
                     then if x `ptrEq` y
                          then return t
                          else return $! Leaf h (L k x)
-                    else return $! collision h l (L k x)
-        | otherwise = two s h k x hy ky y
-    go h k x s t@(BitmapIndexed b ary)
+                    else return $! collision h s l (L k x)
+        | otherwise = two bs h k x hy ky y
+    go h s k x bs t@(BitmapIndexed b ary)
         | b .&. m == 0 = do
             ary' <- A.insertM ary i $! Leaf h (L k x)
             return $! bitmapIndexedOrFull (b .|. m) ary'
         | otherwise = do
             st <- A.indexM ary i
-            st' <- go h k x (s+bitsPerSubkey) st
+            st' <- go h s k x (bs+bitsPerSubkey) st
             A.unsafeUpdateM ary i st'
             return t
-      where m = mask h s
+      where m = mask h bs
             i = sparseIndex b m
-    go h k x s t@(Full ary) = do
+    go h s k x bs t@(Full ary) = do
         st <- A.indexM ary i
-        st' <- go h k x (s+bitsPerSubkey) st
+        st' <- go h s k x (bs+bitsPerSubkey) st
         A.unsafeUpdateM ary i st'
         return t
-      where i = index h s
-    go h k x s t@(Collision hy v)
-        | h == hy   = return $! Collision h (updateOrSnocWith const k x v)
-        | otherwise = go h k x s $ BitmapIndexed (mask hy s) (A.singleton t)
+      where i = index h bs
+    go h s k x bs t@(Collision hx sx hmx)
+        | h == hx   = Collision hx sx <$> go (hashWithSalt sx k) sx k x 0 hmx
+        | otherwise = go h s k x bs $ BitmapIndexed (mask hx bs) (A.singleton t)
 {-# INLINABLE unsafeInsert #-}
 
 -- | Create a map from two key-value pairs which hashes don't collide.
@@ -843,45 +847,43 @@ insertWith f k new m = insertModifying new (\old -> (# f new old #)) k m
 -- thunks in the tree.
 insertModifying :: (Eq k, Hashable k) => v -> (v -> (# v #)) -> k -> HashMap k v
             -> HashMap k v
-insertModifying x f k0 m0 = go h0 k0 0 m0
+insertModifying x f k0 m0 = go h0 s0 k0 0 m0
   where
-    !h0 = hash k0
-    go !h !k !_ Empty = Leaf h (L k x)
-    go h k s t@(Leaf hy l@(L ky y))
+    !h0 = hashWithSalt s0 k0
+    !s0 = defaultSalt
+    go !h _ !k !_ Empty = Leaf h (L k x)
+    go h s k bs t@(Leaf hy l@(L ky y))
         | hy == h = if ky == k
                     then case f y of
                       (# v' #) | ptrEq y v' -> t
                                | otherwise -> Leaf h (L k (v'))
-                    else collision h l (L k x)
-        | otherwise = runST (two s h k x hy ky y)
-    go h k s t@(BitmapIndexed b ary)
+                    else collision h s l (L k x)
+        | otherwise = runST (two bs h k x hy ky y)
+    go h s k bs t@(BitmapIndexed b ary)
         | b .&. m == 0 =
             let ary' = A.insert ary i $! Leaf h (L k x)
             in bitmapIndexedOrFull (b .|. m) ary'
         | otherwise =
             let !st   = A.index ary i
-                !st'  = go h k (s+bitsPerSubkey) st
+                !st'  = go h s k (bs+bitsPerSubkey) st
                 ary'  = A.update ary i $! st'
             in if ptrEq st st'
                then t
                else BitmapIndexed b ary'
-      where m = mask h s
+      where m = mask h bs
             i = sparseIndex b m
-    go h k s t@(Full ary) =
+    go h s k bs t@(Full ary) =
         let !st   = A.index ary i
-            !st'  = go h k (s+bitsPerSubkey) st
+            !st'  = go h s k (bs+bitsPerSubkey) st
             ary' = update16 ary i $! st'
         in if ptrEq st st'
            then t
            else Full ary'
-      where i = index h s
-    go h k s t@(Collision hy v)
-        | h == hy   =
-            let !v' = insertModifyingArr x f k v
-            in if A.unsafeSameArray v v'
-               then t
-               else Collision h v'
-        | otherwise = go h k s $ BitmapIndexed (mask hy s) (A.singleton t)
+      where i = index h bs
+    go h s k bs t@(Collision hx sx hmx)
+        | h == hx   =
+            go (hashWithSalt sx k) sx k 0 hmx
+        | otherwise = go h s k bs $ BitmapIndexed (mask hx bs) (A.singleton t)
 {-# INLINABLE insertModifying #-}
 
 -- Like insertModifying for arrays; used to implement insertModifying
@@ -908,56 +910,57 @@ insertModifyingArr x f k0 ary0 = go k0 ary0 0 (A.length ary0)
 unsafeInsertWith :: forall k v. (Eq k, Hashable k)
                  => (v -> v -> v) -> k -> v -> HashMap k v
                  -> HashMap k v
-unsafeInsertWith f k0 v0 m0 = runST (go h0 k0 v0 0 m0)
+unsafeInsertWith f k0 v0 m0 = runST (go h0 s0 k0 v0 0 m0)
   where
-    h0 = hash k0
-    go :: Hash -> k -> v -> Shift -> HashMap k v -> ST s (HashMap k v)
-    go !h !k x !_ Empty = return $! Leaf h (L k x)
-    go h k x s (Leaf hy l@(L ky y))
+    h0 = hashWithSalt s0 k0
+    s0 = defaultSalt
+    go :: Hash -> Salt -> k -> v -> Shift -> HashMap k v -> ST s (HashMap k v)
+    go !h _ !k x !_ Empty = return $! Leaf h (L k x)
+    go h s k x bs (Leaf hy l@(L ky y))
         | hy == h = if ky == k
                     then return $! Leaf h (L k (f x y))
-                    else return $! collision h l (L k x)
-        | otherwise = two s h k x hy ky y
-    go h k x s t@(BitmapIndexed b ary)
+                    else return $! collision h s l (L k x)
+        | otherwise = two bs h k x hy ky y
+    go h s k x bs t@(BitmapIndexed b ary)
         | b .&. m == 0 = do
             ary' <- A.insertM ary i $! Leaf h (L k x)
             return $! bitmapIndexedOrFull (b .|. m) ary'
         | otherwise = do
             st <- A.indexM ary i
-            st' <- go h k x (s+bitsPerSubkey) st
+            st' <- go h s k x (bs+bitsPerSubkey) st
             A.unsafeUpdateM ary i st'
             return t
-      where m = mask h s
+      where m = mask h bs
             i = sparseIndex b m
-    go h k x s t@(Full ary) = do
+    go h s k x bs t@(Full ary) = do
         st <- A.indexM ary i
-        st' <- go h k x (s+bitsPerSubkey) st
+        st' <- go h s k x (bs+bitsPerSubkey) st
         A.unsafeUpdateM ary i st'
         return t
-      where i = index h s
-    go h k x s t@(Collision hy v)
-        | h == hy   = return $! Collision h (updateOrSnocWith f k x v)
-        | otherwise = go h k x s $ BitmapIndexed (mask hy s) (A.singleton t)
+      where i = index h bs
+    go h s k x bs t@(Collision hx sx hmx)
+        | h == hx   = Collision hx sx <$> go (hashWithSalt sx k) sx k x 0 hmx
+        | otherwise = go h s k x bs $ BitmapIndexed (mask hx bs) (A.singleton t)
 {-# INLINABLE unsafeInsertWith #-}
 
 -- | /O(log n)/ Remove the mapping for the specified key from this map
 -- if present.
 delete :: (Eq k, Hashable k) => k -> HashMap k v -> HashMap k v
-delete k m = delete' (hash k) k m
+delete k m = delete' (hashWithSalt defaultSalt k) defaultSalt k m
 {-# INLINABLE delete #-}
 
-delete' :: Eq k => Hash -> k -> HashMap k v -> HashMap k v
-delete' h0 k0 m0 = go h0 k0 0 m0
+delete' :: (Eq k, Hashable k) => Hash -> Salt -> k -> HashMap k v -> HashMap k v
+delete' h0 s0 k0 m0 = go h0 s0 k0 0 m0
   where
-    go !_ !_ !_ Empty = Empty
-    go h k _ t@(Leaf hy (L ky _))
+    go !_ _ !_ !_ Empty = Empty
+    go h _ k _ t@(Leaf hy (L ky _))
         | hy == h && ky == k = Empty
         | otherwise          = t
-    go h k s t@(BitmapIndexed b ary)
+    go h s k bs t@(BitmapIndexed b ary)
         | b .&. m == 0 = t
         | otherwise =
             let !st = A.index ary i
-                !st' = go h k (s+bitsPerSubkey) st
+                !st' = go h s k (bs+bitsPerSubkey) st
             in if st' `ptrEq` st
                 then t
                 else case st' of
@@ -972,11 +975,11 @@ delete' h0 k0 m0 = go h0 k0 0 m0
                       bIndexed = BitmapIndexed (b .&. complement m) (A.delete ary i)
                 l | isLeafOrCollision l && A.length ary == 1 -> l
                 _ -> BitmapIndexed b (A.update ary i st')
-      where m = mask h s
+      where m = mask h bs
             i = sparseIndex b m
-    go h k s t@(Full ary) =
+    go h s k bs t@(Full ary) =
         let !st   = A.index ary i
-            !st' = go h k (s+bitsPerSubkey) st
+            !st' = go h s k (bs+bitsPerSubkey) st
         in if st' `ptrEq` st
             then t
             else case st' of
@@ -985,16 +988,9 @@ delete' h0 k0 m0 = go h0 k0 0 m0
                     bm   = fullNodeMask .&. complement (1 `unsafeShiftL` i)
                 in BitmapIndexed bm ary'
             _ -> Full (A.update ary i st')
-      where i = index h s
-    go h k _ t@(Collision hy v)
-        | h == hy = case indexOf k v of
-            Just i
-                | A.length v == 2 ->
-                    if i == 0
-                    then Leaf h (A.index v 1)
-                    else Leaf h (A.index v 0)
-                | otherwise -> Collision h (A.delete v i)
-            Nothing -> t
+      where i = index h bs
+    go h s k _ t@(Collision hx sx hmx)
+        | h == hx = go (hashWithSalt sx k) sx k 0 hmx
         | otherwise = t
 {-# INLINABLE delete' #-}
 

From 561214d03c837785d8ea6d139e6f92249340a8ce Mon Sep 17 00:00:00 2001
From: Tom Sydney Kerckhove <syd@fpcomplete.com>
Date: Tue, 14 Aug 2018 14:43:08 +0200
Subject: [PATCH 03/69] Until unionWithKey

---
 Data/HashMap/Base.hs | 75 ++++++++++++++++++++------------------------
 1 file changed, 34 insertions(+), 41 deletions(-)

diff --git a/Data/HashMap/Base.hs b/Data/HashMap/Base.hs
index 58eb42fe..5ff2da4d 100644
--- a/Data/HashMap/Base.hs
+++ b/Data/HashMap/Base.hs
@@ -996,20 +996,16 @@ delete' h0 s0 k0 m0 = go h0 s0 k0 0 m0
 
 -- | Delete optimized for the case when we know the key is in the map.
 --
--- It is only valid to call this when the key exists in the map and you know the
--- hash collision position if there was one. This information can be obtained
--- from 'lookupRecordCollision'. If there is no collision pass (-1) as collPos.
---
 -- We can skip:
 --  - the key equality check on the leaf, if we reach a leaf it must be the key
-deleteKeyExists :: Int -> Hash -> k -> HashMap k v -> HashMap k v
-deleteKeyExists !collPos0 !h0 !k0 !m0 = go collPos0 h0 k0 0 m0
+deleteKeyExists :: Hashable k => Hash -> Salt -> k -> HashMap k v -> HashMap k v
+deleteKeyExists !h0 s0 !k0 !m0 = go h0 s0 k0 0 m0
   where
-    go :: Int -> Hash -> k -> Int -> HashMap k v -> HashMap k v
-    go !_collPos !_h !_k !_s (Leaf _ _) = Empty
-    go collPos h k s (BitmapIndexed b ary) =
+    go :: Hashable k => Hash -> Salt -> k -> Int -> HashMap k v -> HashMap k v
+    go !_h !_s !_k !_bs (Leaf _ _) = Empty
+    go h s k bs (BitmapIndexed b ary) =
             let !st = A.index ary i
-                !st' = go collPos h k (s+bitsPerSubkey) st
+                !st' = go h s k (bs+bitsPerSubkey) st
             in case st' of
                 Empty | A.length ary == 1 -> Empty
                       | A.length ary == 2 ->
@@ -1022,24 +1018,21 @@ deleteKeyExists !collPos0 !h0 !k0 !m0 = go collPos0 h0 k0 0 m0
                       bIndexed = BitmapIndexed (b .&. complement m) (A.delete ary i)
                 l | isLeafOrCollision l && A.length ary == 1 -> l
                 _ -> BitmapIndexed b (A.update ary i st')
-      where m = mask h s
+      where m = mask h bs
             i = sparseIndex b m
-    go collPos h k s (Full ary) =
+    go h s k bs (Full ary) =
         let !st   = A.index ary i
-            !st' = go collPos h k (s+bitsPerSubkey) st
+            !st' = go h s k (bs+bitsPerSubkey) st
         in case st' of
             Empty ->
                 let ary' = A.delete ary i
                     bm   = fullNodeMask .&. complement (1 `unsafeShiftL` i)
                 in BitmapIndexed bm ary'
             _ -> Full (A.update ary i st')
-      where i = index h s
-    go collPos h _ _ (Collision _hy v)
-      | A.length v == 2
-      = if collPos == 0
-        then Leaf h (A.index v 1)
-        else Leaf h (A.index v 0)
-      | otherwise = Collision h (A.delete v collPos)
+      where i = index h bs
+    go h s k _ t@(Collision hx sx hmx)
+        | h == hx = go (hashWithSalt sx k) sx k 0 hmx
+        | otherwise = Empty -- error "Internal error: unexpected collision"
     go !_ !_ !_ !_ Empty = Empty -- error "Internal error: deleteKeyExists empty"
 {-# NOINLINE deleteKeyExists #-}
 
@@ -1060,36 +1053,34 @@ adjust f k m = adjust# (\v -> (# f v #)) k m
 adjust# :: (Eq k, Hashable k) => (v -> (# v #)) -> k -> HashMap k v -> HashMap k v
 adjust# f k0 m0 = go h0 k0 0 m0
   where
-    h0 = hash k0
+    h0 = hashWithSalt s0 k0
+    s0 = defaultSalt
     go !_ !_ !_ Empty = Empty
     go h k _ t@(Leaf hy (L ky y))
         | hy == h && ky == k = case f y of
             (# y' #) | ptrEq y y' -> t
                      | otherwise -> Leaf h (L k y')
         | otherwise          = t
-    go h k s t@(BitmapIndexed b ary)
+    go h k bs t@(BitmapIndexed b ary)
         | b .&. m == 0 = t
         | otherwise = let !st   = A.index ary i
-                          !st'  = go h k (s+bitsPerSubkey) st
+                          !st'  = go h k (bs+bitsPerSubkey) st
                           ary' = A.update ary i $! st'
                       in if ptrEq st st'
                          then t
                          else BitmapIndexed b ary'
-      where m = mask h s
+      where m = mask h bs
             i = sparseIndex b m
-    go h k s t@(Full ary) =
-        let i    = index h s
+    go h k bs t@(Full ary) =
+        let i    = index h bs
             !st   = A.index ary i
-            !st'  = go h k (s+bitsPerSubkey) st
+            !st'  = go h k (bs+bitsPerSubkey) st
             ary' = update16 ary i $! st'
         in if ptrEq st st'
            then t
            else Full ary'
-    go h k _ t@(Collision hy v)
-        | h == hy   = let !v' = updateWith# f k v
-                      in if A.unsafeSameArray v v'
-                         then t
-                         else Collision h v'
+    go h k _ t@(Collision hx sx hmx)
+        | h == hx   = go (hashWithSalt sx k) k 0 hmx
         | otherwise = t
 {-# INLINABLE adjust# #-}
 
@@ -1129,12 +1120,13 @@ alterF :: (Functor f, Eq k, Hashable k)
 -- @f@ and a functor that is similar to Const but not actually Const.
 alterF f = \ !k !m ->
   let
-    !h = hash k
-    mv = lookup' h k m
+    !h = hashWithSalt s k
+    s = defaultSalt
+    mv = lookup' h s k m
   in (<$> f mv) $ \fres ->
     case fres of
-      Nothing -> delete' h k m
-      Just v' -> insert' h k v' m
+      Nothing -> delete' h s k m
+      Just v' -> insert' h s k v' m
 
 -- We unconditionally rewrite alterF in RULES, but we expose an
 -- unfolding just in case it's used in some way that prevents the
@@ -1235,14 +1227,14 @@ alterFEager f !k m = (<$> f mv) $ \fres ->
       Absent -> m
 
       -- Key did exist
-      Present _ collPos -> deleteKeyExists collPos h k m
+      Present _ _ -> deleteKeyExists h s k m
 
     ------------------------------
     -- Update value
     Just v' -> case lookupRes of
 
       -- Key did not exist before, insert v' under a new key
-      Absent -> insertNewKey h k v' m
+      Absent -> insertNewKey h s k v' m
 
       -- Key existed before
       Present v collPos ->
@@ -1250,10 +1242,11 @@ alterFEager f !k m = (<$> f mv) $ \fres ->
         -- If the value is identical, no-op
         then m
         -- If the value changed, update the value.
-        else insertKeyExists collPos h k v' m
+        else insertKeyExists h s k v' m
 
-  where !h = hash k
-        !lookupRes = lookupRecordCollision h k m
+  where !h = hashWithSalt s k
+        !s = defaultSalt
+        !lookupRes = lookupRecordCollision h s k m
         !mv = case lookupRes of
            Absent -> Nothing
            Present v _ -> Just v

From 69a5f957fcca725dfd11a7bc473b9ffa0ef24216 Mon Sep 17 00:00:00 2001
From: Tom Sydney Kerckhove <syd@fpcomplete.com>
Date: Tue, 14 Aug 2018 14:50:59 +0200
Subject: [PATCH 04/69] Until mapWithKey

---
 Data/HashMap/Base.hs | 81 ++++++++++++++++++++++----------------------
 1 file changed, 41 insertions(+), 40 deletions(-)

diff --git a/Data/HashMap/Base.hs b/Data/HashMap/Base.hs
index 5ff2da4d..3e3ddcde 100644
--- a/Data/HashMap/Base.hs
+++ b/Data/HashMap/Base.hs
@@ -1276,86 +1276,87 @@ unionWith f = unionWithKey (const f)
 -- result.
 unionWithKey :: (Eq k, Hashable k) => (k -> v -> v -> v) -> HashMap k v -> HashMap k v
           -> HashMap k v
-unionWithKey f = go 0
+unionWithKey f = go 0 s0
   where
+    s0 = defaultSalt
     -- empty vs. anything
-    go !_ t1 Empty = t1
-    go _ Empty t2 = t2
+    go !_ !_ t1 Empty = t1
+    go _ _ Empty t2 = t2
     -- leaf vs. leaf
-    go s t1@(Leaf h1 l1@(L k1 v1)) t2@(Leaf h2 l2@(L k2 v2))
+    go bs s t1@(Leaf h1 l1@(L k1 v1)) t2@(Leaf h2 l2@(L k2 v2))
         | h1 == h2  = if k1 == k2
                       then Leaf h1 (L k1 (f k1 v1 v2))
-                      else collision h1 l1 l2
-        | otherwise = goDifferentHash s h1 h2 t1 t2
-    go s t1@(Leaf h1 (L k1 v1)) t2@(Collision h2 ls2)
-        | h1 == h2  = Collision h1 (updateOrSnocWithKey f k1 v1 ls2)
-        | otherwise = goDifferentHash s h1 h2 t1 t2
-    go s t1@(Collision h1 ls1) t2@(Leaf h2 (L k2 v2))
-        | h1 == h2  = Collision h1 (updateOrSnocWithKey (flip . f) k2 v2 ls1)
-        | otherwise = goDifferentHash s h1 h2 t1 t2
-    go s t1@(Collision h1 ls1) t2@(Collision h2 ls2)
-        | h1 == h2  = Collision h1 (updateOrConcatWithKey f ls1 ls2)
-        | otherwise = goDifferentHash s h1 h2 t1 t2
+                      else collision h1 s l1 l2
+        | otherwise = goDifferentHash bs s h1 h2 t1 t2
+    go bs s t1@(Leaf h1 (L k1 v1)) t2@(Collision h2 s2 hm2)
+        | h1 == h2  = Collision h1 s2 $ insert' (hashWithSalt s2 k1) s2 k1 v1 hm2
+        | otherwise = goDifferentHash bs s h1 h2 t1 t2
+    go bs s t1@(Collision h1 s1 hm1) t2@(Leaf h2 (L k2 v2))
+        | h1 == h2  = Collision h1 s1 $ insert' (hashWithSalt s1 k2) s1 k2 v2 hm1
+        | otherwise = goDifferentHash bs s h1 h2 t1 t2
+    go bs s t1@(Collision h1 s1 hm1) t2@(Collision h2 _ hm2) -- Second salt must be equal
+        | h1 == h2  = Collision h1 s1 $ go 0 s1 hm1 hm2
+        | otherwise = goDifferentHash bs s h1 h2 t1 t2
     -- branch vs. branch
-    go s (BitmapIndexed b1 ary1) (BitmapIndexed b2 ary2) =
+    go bs s (BitmapIndexed b1 ary1) (BitmapIndexed b2 ary2) =
         let b'   = b1 .|. b2
-            ary' = unionArrayBy (go (s+bitsPerSubkey)) b1 b2 ary1 ary2
+            ary' = unionArrayBy (go (bs+bitsPerSubkey) s) b1 b2 ary1 ary2
         in bitmapIndexedOrFull b' ary'
-    go s (BitmapIndexed b1 ary1) (Full ary2) =
-        let ary' = unionArrayBy (go (s+bitsPerSubkey)) b1 fullNodeMask ary1 ary2
+    go bs s (BitmapIndexed b1 ary1) (Full ary2) =
+        let ary' = unionArrayBy (go (bs+bitsPerSubkey) s) b1 fullNodeMask ary1 ary2
         in Full ary'
-    go s (Full ary1) (BitmapIndexed b2 ary2) =
-        let ary' = unionArrayBy (go (s+bitsPerSubkey)) fullNodeMask b2 ary1 ary2
+    go bs s (Full ary1) (BitmapIndexed b2 ary2) =
+        let ary' = unionArrayBy (go (bs+bitsPerSubkey) s) fullNodeMask b2 ary1 ary2
         in Full ary'
-    go s (Full ary1) (Full ary2) =
-        let ary' = unionArrayBy (go (s+bitsPerSubkey)) fullNodeMask fullNodeMask
+    go bs s (Full ary1) (Full ary2) =
+        let ary' = unionArrayBy (go (bs+bitsPerSubkey) s) fullNodeMask fullNodeMask
                    ary1 ary2
         in Full ary'
     -- leaf vs. branch
-    go s (BitmapIndexed b1 ary1) t2
+    go bs s (BitmapIndexed b1 ary1) t2
         | b1 .&. m2 == 0 = let ary' = A.insert ary1 i t2
                                b'   = b1 .|. m2
                            in bitmapIndexedOrFull b' ary'
         | otherwise      = let ary' = A.updateWith' ary1 i $ \st1 ->
-                                   go (s+bitsPerSubkey) st1 t2
+                                   go (bs+bitsPerSubkey) s st1 t2
                            in BitmapIndexed b1 ary'
         where
           h2 = leafHashCode t2
-          m2 = mask h2 s
+          m2 = mask h2 bs
           i = sparseIndex b1 m2
-    go s t1 (BitmapIndexed b2 ary2)
+    go bs s t1 (BitmapIndexed b2 ary2)
         | b2 .&. m1 == 0 = let ary' = A.insert ary2 i $! t1
                                b'   = b2 .|. m1
                            in bitmapIndexedOrFull b' ary'
         | otherwise      = let ary' = A.updateWith' ary2 i $ \st2 ->
-                                   go (s+bitsPerSubkey) t1 st2
+                                   go (bs+bitsPerSubkey) s t1 st2
                            in BitmapIndexed b2 ary'
       where
         h1 = leafHashCode t1
-        m1 = mask h1 s
+        m1 = mask h1 bs
         i = sparseIndex b2 m1
-    go s (Full ary1) t2 =
+    go bs s (Full ary1) t2 =
         let h2   = leafHashCode t2
-            i    = index h2 s
-            ary' = update16With' ary1 i $ \st1 -> go (s+bitsPerSubkey) st1 t2
+            i    = index h2 bs
+            ary' = update16With' ary1 i $ \st1 -> go (bs+bitsPerSubkey) s st1 t2
         in Full ary'
-    go s t1 (Full ary2) =
+    go bs s t1 (Full ary2) =
         let h1   = leafHashCode t1
-            i    = index h1 s
-            ary' = update16With' ary2 i $ \st2 -> go (s+bitsPerSubkey) t1 st2
+            i    = index h1 bs
+            ary' = update16With' ary2 i $ \st2 -> go (bs+bitsPerSubkey) s t1 st2
         in Full ary'
 
     leafHashCode (Leaf h _) = h
-    leafHashCode (Collision h _) = h
+    leafHashCode (Collision h _ _) = h
     leafHashCode _ = error "leafHashCode"
 
-    goDifferentHash s h1 h2 t1 t2
-        | m1 == m2  = BitmapIndexed m1 (A.singleton $! go (s+bitsPerSubkey) t1 t2)
+    goDifferentHash bs s h1 h2 t1 t2
+        | m1 == m2  = BitmapIndexed m1 (A.singleton $! go (bs+bitsPerSubkey) s t1 t2)
         | m1 <  m2  = BitmapIndexed (m1 .|. m2) (A.pair t1 t2)
         | otherwise = BitmapIndexed (m1 .|. m2) (A.pair t2 t1)
       where
-        m1 = mask h1 s
-        m2 = mask h2 s
+        m1 = mask h1 bs
+        m2 = mask h2 bs
 {-# INLINE unionWithKey #-}
 
 -- | Strict in the result of @f@.

From aaf7dda9f276062fba66387b589a5fe8d536002a Mon Sep 17 00:00:00 2001
From: Tom Sydney Kerckhove <syd@fpcomplete.com>
Date: Tue, 14 Aug 2018 14:52:45 +0200
Subject: [PATCH 05/69] until filterMapAux

---
 Data/HashMap/Base.hs | 11 +++++------
 1 file changed, 5 insertions(+), 6 deletions(-)

diff --git a/Data/HashMap/Base.hs b/Data/HashMap/Base.hs
index 3e3ddcde..c0f95556 100644
--- a/Data/HashMap/Base.hs
+++ b/Data/HashMap/Base.hs
@@ -1409,8 +1409,7 @@ mapWithKey f = go
     go (Full ary) = Full $ A.map go ary
     -- Why map strictly over collision arrays? Because there's no
     -- point suspending the O(1) work this does for each leaf.
-    go (Collision h ary) = Collision h $
-                           A.map' (\ (L k v) -> L k (f k v)) ary
+    go (Collision h s hm) = Collision h s $ go hm
 {-# INLINE mapWithKey #-}
 
 -- | /O(n)/ Transform this map by applying a function to every value.
@@ -1438,8 +1437,8 @@ traverseWithKey f = go
     go (Leaf h (L k v))      = Leaf h . L k <$> f k v
     go (BitmapIndexed b ary) = BitmapIndexed b <$> A.traverse go ary
     go (Full ary)            = Full <$> A.traverse go ary
-    go (Collision h ary)     =
-        Collision h <$> A.traverse' (\ (L k v) -> L k <$> f k v) ary
+    go (Collision h s hm)    =
+        Collision h s <$> go hm
 {-# INLINE traverseWithKey #-}
 
 ------------------------------------------------------------------------
@@ -1525,7 +1524,7 @@ foldlWithKey' f = go
     go z (Leaf _ (L k v))      = f z k v
     go z (BitmapIndexed _ ary) = A.foldl' go z ary
     go z (Full ary)            = A.foldl' go z ary
-    go z (Collision _ ary)     = A.foldl' (\ z' (L k v) -> f z' k v) z ary
+    go z (Collision _ _ hm)    = go z hm
 {-# INLINE foldlWithKey' #-}
 
 -- | /O(n)/ Reduce this map by applying a binary operator to all
@@ -1545,7 +1544,7 @@ foldrWithKey f = go
     go z (Leaf _ (L k v))      = f k v z
     go z (BitmapIndexed _ ary) = A.foldr (flip go) z ary
     go z (Full ary)            = A.foldr (flip go) z ary
-    go z (Collision _ ary)     = A.foldr (\ (L k v) z' -> f k v z') z ary
+    go z (Collision _ _ hm)    = go z hm
 {-# INLINE foldrWithKey #-}
 
 ------------------------------------------------------------------------

From 609881947c005293a7ba09264556d6f6b4f55086 Mon Sep 17 00:00:00 2001
From: Tom Sydney Kerckhove <syd@fpcomplete.com>
Date: Tue, 14 Aug 2018 14:56:13 +0200
Subject: [PATCH 06/69] Finished a module

---
 Data/HashMap/Base.hs | 26 ++------------------------
 1 file changed, 2 insertions(+), 24 deletions(-)

diff --git a/Data/HashMap/Base.hs b/Data/HashMap/Base.hs
index c0f95556..bfa6a107 100644
--- a/Data/HashMap/Base.hs
+++ b/Data/HashMap/Base.hs
@@ -82,7 +82,7 @@ module Data.HashMap.Base
     , Bitmap
     , bitmapIndexedOrFull
     , collision
-    , hash
+    , hashWithSalt
     , mask
     , index
     , bitsPerSubkey
@@ -1594,7 +1594,7 @@ filterMapAux onLeaf onColl = go
         | otherwise = Empty
     go (BitmapIndexed b ary) = filterA ary b
     go (Full ary) = filterA ary fullNodeMask
-    go (Collision h ary) = filterC ary h
+    go (Collision _ _ hm) = go hm
 
     filterA ary0 b0 =
         let !n = A.length ary0
@@ -1624,28 +1624,6 @@ filterMapAux onLeaf onColl = go
                          (bi `unsafeShiftL` 1) n
                 t     -> do A.write mary j t
                             step ary mary b (i+1) (j+1) (bi `unsafeShiftL` 1) n
-
-    filterC ary0 h =
-        let !n = A.length ary0
-        in runST $ do
-            mary <- A.new_ n
-            step ary0 mary 0 0 n
-      where
-        step :: A.Array (Leaf k v1) -> A.MArray s (Leaf k v2)
-             -> Int -> Int -> Int
-             -> ST s (HashMap k v2)
-        step !ary !mary i !j n
-            | i >= n    = case j of
-                0 -> return Empty
-                1 -> do l <- A.read mary 0
-                        return $! Leaf h l
-                _ | i == j -> do ary2 <- A.unsafeFreeze mary
-                                 return $! Collision h ary2
-                  | otherwise -> do ary2 <- A.trim mary j
-                                    return $! Collision h ary2
-            | Just el <- onColl $! A.index ary i
-                = A.write mary j el >> step ary mary (i+1) (j+1) n
-            | otherwise = step ary mary (i+1) j n
 {-# INLINE filterMapAux #-}
 
 -- | /O(n)/ Filter this map by retaining only elements which values

From 209ee6b864d91a35a4614c354d67a5b1524c5921 Mon Sep 17 00:00:00 2001
From: Tom Sydney Kerckhove <syd@fpcomplete.com>
Date: Tue, 14 Aug 2018 15:19:30 +0200
Subject: [PATCH 07/69] Something that compiles

---
 Data/HashMap/Base.hs        |   1 +
 Data/HashMap/Strict/Base.hs | 196 +++++++++++++++++++-----------------
 2 files changed, 102 insertions(+), 95 deletions(-)

diff --git a/Data/HashMap/Base.hs b/Data/HashMap/Base.hs
index bfa6a107..05fa160c 100644
--- a/Data/HashMap/Base.hs
+++ b/Data/HashMap/Base.hs
@@ -83,6 +83,7 @@ module Data.HashMap.Base
     , bitmapIndexedOrFull
     , collision
     , hashWithSalt
+    , defaultSalt
     , mask
     , index
     , bitsPerSubkey
diff --git a/Data/HashMap/Strict/Base.hs b/Data/HashMap/Strict/Base.hs
index 890d18ff..c5edb9b2 100644
--- a/Data/HashMap/Strict/Base.hs
+++ b/Data/HashMap/Strict/Base.hs
@@ -148,99 +148,102 @@ insert k !v = HM.insert k v
 -- >   where f new old = new + old
 insertWith :: (Eq k, Hashable k) => (v -> v -> v) -> k -> v -> HashMap k v
            -> HashMap k v
-insertWith f k0 v0 m0 = go h0 k0 v0 0 m0
+insertWith f k0 v0 m0 = go h0 s0 k0 v0 0 m0
   where
-    h0 = hash k0
-    go !h !k x !_ Empty = leaf h k x
-    go h k x s (Leaf hy l@(L ky y))
+    h0 = hashWithSalt s0 k0
+    s0 = defaultSalt
+    go !h _ !k x !_ Empty = leaf h k x
+    go h s k x bs (Leaf hy l@(L ky y))
         | hy == h = if ky == k
                     then leaf h k (f x y)
-                    else x `seq` (collision h l (L k x))
-        | otherwise = x `seq` runST (two s h k x hy ky y)
-    go h k x s (BitmapIndexed b ary)
+                    else x `seq` (collision h s l (L k x))
+        | otherwise = x `seq` runST (two bs h k x hy ky y)
+    go h s k x bs (BitmapIndexed b ary)
         | b .&. m == 0 =
             let ary' = A.insert ary i $! leaf h k x
             in bitmapIndexedOrFull (b .|. m) ary'
         | otherwise =
             let st   = A.index ary i
-                st'  = go h k x (s+bitsPerSubkey) st
+                st'  = go h s k x (bs+bitsPerSubkey) st
                 ary' = A.update ary i $! st'
             in BitmapIndexed b ary'
-      where m = mask h s
+      where m = mask h bs
             i = sparseIndex b m
-    go h k x s (Full ary) =
+    go h s k x bs (Full ary) =
         let st   = A.index ary i
-            st'  = go h k x (s+bitsPerSubkey) st
+            st'  = go h s k x (bs+bitsPerSubkey) st
             ary' = update16 ary i $! st'
         in Full ary'
-      where i = index h s
-    go h k x s t@(Collision hy v)
-        | h == hy   = Collision h (updateOrSnocWith f k x v)
-        | otherwise = go h k x s $ BitmapIndexed (mask hy s) (A.singleton t)
+      where i = index h bs
+    go h s k x bs t@(Collision hx sx hm)
+        | h == hx   = Collision hx sx $ go (hashWithSalt sx k) sx k x 0 hm
+        | otherwise = go h s k x bs $ BitmapIndexed (mask hx bs) (A.singleton t)
 {-# INLINABLE insertWith #-}
 
 -- | In-place update version of insertWith
 unsafeInsertWith :: (Eq k, Hashable k) => (v -> v -> v) -> k -> v -> HashMap k v
                  -> HashMap k v
-unsafeInsertWith f k0 v0 m0 = runST (go h0 k0 v0 0 m0)
+unsafeInsertWith f k0 v0 m0 = runST (go h0 s0 k0 v0 0 m0)
   where
-    h0 = hash k0
-    go !h !k x !_ Empty = return $! leaf h k x
-    go h k x s (Leaf hy l@(L ky y))
+    h0 = hashWithSalt s0 k0
+    s0 = defaultSalt
+    go !h !_ !k x !_ Empty = return $! leaf h k x
+    go h s k x bs (Leaf hy l@(L ky y))
         | hy == h = if ky == k
                     then return $! leaf h k (f x y)
                     else do
                         let l' = x `seq` (L k x)
-                        return $! collision h l l'
-        | otherwise = x `seq` two s h k x hy ky y
-    go h k x s t@(BitmapIndexed b ary)
+                        return $! collision h s l l'
+        | otherwise = x `seq` two bs h k x hy ky y
+    go h s k x bs t@(BitmapIndexed b ary)
         | b .&. m == 0 = do
             ary' <- A.insertM ary i $! leaf h k x
             return $! bitmapIndexedOrFull (b .|. m) ary'
         | otherwise = do
             st <- A.indexM ary i
-            st' <- go h k x (s+bitsPerSubkey) st
+            st' <- go h s k x (bs+bitsPerSubkey) st
             A.unsafeUpdateM ary i st'
             return t
-      where m = mask h s
+      where m = mask h bs
             i = sparseIndex b m
-    go h k x s t@(Full ary) = do
+    go h s k x bs t@(Full ary) = do
         st <- A.indexM ary i
-        st' <- go h k x (s+bitsPerSubkey) st
+        st' <- go h s k x (bs+bitsPerSubkey) st
         A.unsafeUpdateM ary i st'
         return t
-      where i = index h s
-    go h k x s t@(Collision hy v)
-        | h == hy   = return $! Collision h (updateOrSnocWith f k x v)
-        | otherwise = go h k x s $ BitmapIndexed (mask hy s) (A.singleton t)
+      where i = index h bs
+    go h s k x bs t@(Collision hx sx hm)
+        | h == hx   = Collision hx sx <$> go (hashWithSalt sx k) sx k x 0 hm
+        | otherwise = go h s k x bs $ BitmapIndexed (mask hx bs) (A.singleton t)
 {-# INLINABLE unsafeInsertWith #-}
 
 -- | /O(log n)/ Adjust the value tied to a given key in this map only
 -- if it is present. Otherwise, leave the map alone.
 adjust :: (Eq k, Hashable k) => (v -> v) -> k -> HashMap k v -> HashMap k v
-adjust f k0 m0 = go h0 k0 0 m0
+adjust f k0 m0 = go h0 s0 k0 0 m0
   where
-    h0 = hash k0
-    go !_ !_ !_ Empty = Empty
-    go h k _ t@(Leaf hy (L ky y))
+    h0 = hashWithSalt s0 k0
+    s0 = defaultSalt
+    go !_ !_ !_ !_ Empty = Empty
+    go h _ k _ t@(Leaf hy (L ky y))
         | hy == h && ky == k = leaf h k (f y)
         | otherwise          = t
-    go h k s t@(BitmapIndexed b ary)
+    go h s k bs t@(BitmapIndexed b ary)
         | b .&. m == 0 = t
         | otherwise = let st   = A.index ary i
-                          st'  = go h k (s+bitsPerSubkey) st
+                          st'  = go h s k (bs+bitsPerSubkey) st
                           ary' = A.update ary i $! st'
                       in BitmapIndexed b ary'
-      where m = mask h s
+      where m = mask h bs
             i = sparseIndex b m
-    go h k s (Full ary) =
-        let i    = index h s
+    go h s k bs (Full ary) =
+        let i    = index h bs
             st   = A.index ary i
-            st'  = go h k (s+bitsPerSubkey) st
+            st'  = go h s k (bs+bitsPerSubkey) st
             ary' = update16 ary i $! st'
         in Full ary'
-    go h k _ t@(Collision hy v)
-        | h == hy   = Collision h (updateWith f k v)
+    go h s k _ t@(Collision hx sx hm)
+        | h == hx   = Collision hx sx $ go (hashWithSalt sx k) sx k 0 hm
         | otherwise = t
 {-# INLINABLE adjust #-}
 
@@ -277,12 +280,13 @@ alterF :: (Functor f, Eq k, Hashable k)
 -- version; otherwise someone could tell the difference using a lazy
 -- @f@ and a functor that is similar to Const but not actually Const.
 alterF f = \ !k !m ->
-  let !h = hash k
-      mv = lookup' h k m
+  let !h = hashWithSalt s k
+      s = defaultSalt
+      mv = lookup' h s k m
   in (<$> f mv) $ \fres ->
     case fres of
-      Nothing -> delete' h k m
-      Just !v' -> insert' h k v' m
+      Nothing -> delete' h s k m
+      Just !v' -> insert' h s k v' m
 
 -- We rewrite this function unconditionally in RULES, but we expose
 -- an unfolding just in case it's used in a context where the rules
@@ -361,14 +365,14 @@ alterFEager f !k !m = (<$> f mv) $ \fres ->
       Absent -> m
 
       -- Key did exist, no collision
-      Present _ collPos -> deleteKeyExists collPos h k m
+      Present _ _ -> deleteKeyExists h s k m
 
     ------------------------------
     -- Update value
     Just v' -> case lookupRes of
 
       -- Key did not exist before, insert v' under a new key
-      Absent -> insertNewKey h k v' m
+      Absent -> insertNewKey h s k v' m
 
       -- Key existed before, no hash collision
       Present v collPos -> v' `seq`
@@ -376,10 +380,11 @@ alterFEager f !k !m = (<$> f mv) $ \fres ->
         -- If the value is identical, no-op
         then m
         -- If the value changed, update the value.
-        else insertKeyExists collPos h k v' m
+        else insertKeyExists h s k v' m
 
-  where !h = hash k
-        !lookupRes = lookupRecordCollision h k m
+  where !h = hashWithSalt s k
+        !s = defaultSalt
+        !lookupRes = lookupRecordCollision h s k m
         !mv = case lookupRes of
           Absent -> Nothing
           Present v _ -> Just v
@@ -400,86 +405,87 @@ unionWith f = unionWithKey (const f)
 -- the provided function (first argument) will be used to compute the result.
 unionWithKey :: (Eq k, Hashable k) => (k -> v -> v -> v) -> HashMap k v -> HashMap k v
           -> HashMap k v
-unionWithKey f = go 0
+unionWithKey f = go 0 s0
   where
+    s0 = defaultSalt
     -- empty vs. anything
-    go !_ t1 Empty = t1
-    go _ Empty t2 = t2
+    go !_ !_ t1 Empty = t1
+    go _ _ Empty t2 = t2
     -- leaf vs. leaf
-    go s t1@(Leaf h1 l1@(L k1 v1)) t2@(Leaf h2 l2@(L k2 v2))
+    go bs s t1@(Leaf h1 l1@(L k1 v1)) t2@(Leaf h2 l2@(L k2 v2))
         | h1 == h2  = if k1 == k2
                       then leaf h1 k1 (f k1 v1 v2)
-                      else collision h1 l1 l2
-        | otherwise = goDifferentHash s h1 h2 t1 t2
-    go s t1@(Leaf h1 (L k1 v1)) t2@(Collision h2 ls2)
-        | h1 == h2  = Collision h1 (updateOrSnocWithKey f k1 v1 ls2)
-        | otherwise = goDifferentHash s h1 h2 t1 t2
-    go s t1@(Collision h1 ls1) t2@(Leaf h2 (L k2 v2))
-        | h1 == h2  = Collision h1 (updateOrSnocWithKey (flip . f) k2 v2 ls1)
-        | otherwise = goDifferentHash s h1 h2 t1 t2
-    go s t1@(Collision h1 ls1) t2@(Collision h2 ls2)
-        | h1 == h2  = Collision h1 (updateOrConcatWithKey f ls1 ls2)
-        | otherwise = goDifferentHash s h1 h2 t1 t2
+                      else collision h1 s l1 l2
+        | otherwise = goDifferentHash bs s h1 h2 t1 t2
+    go bs s t1@(Leaf h1 (L k1 v1)) t2@(Collision h2 s2 hm2)
+        | h1 == h2  = Collision h1 s2 $ insert' (hashWithSalt s2 k1) s2 k1 v1 hm2
+        | otherwise = goDifferentHash bs s h1 h2 t1 t2
+    go bs s t1@(Collision h1 s1 hm1) t2@(Leaf h2 (L k2 v2))
+        | h1 == h2  = Collision h1 s1 $ insert' (hashWithSalt s1 k2) s1 k2 v2 hm1
+        | otherwise = goDifferentHash bs s h1 h2 t1 t2
+    go bs s t1@(Collision h1 s1 hm1) t2@(Collision h2 _ hm2) -- Second salt must be equal
+        | h1 == h2  = Collision h1 s1 $ go 0 s1 hm1 hm2
+        | otherwise = goDifferentHash bs s h1 h2 t1 t2
     -- branch vs. branch
-    go s (BitmapIndexed b1 ary1) (BitmapIndexed b2 ary2) =
+    go bs s (BitmapIndexed b1 ary1) (BitmapIndexed b2 ary2) =
         let b'   = b1 .|. b2
-            ary' = unionArrayBy (go (s+bitsPerSubkey)) b1 b2 ary1 ary2
+            ary' = unionArrayBy (go (bs+bitsPerSubkey) s) b1 b2 ary1 ary2
         in bitmapIndexedOrFull b' ary'
-    go s (BitmapIndexed b1 ary1) (Full ary2) =
-        let ary' = unionArrayBy (go (s+bitsPerSubkey)) b1 fullNodeMask ary1 ary2
+    go bs s (BitmapIndexed b1 ary1) (Full ary2) =
+        let ary' = unionArrayBy (go (bs+bitsPerSubkey) s) b1 fullNodeMask ary1 ary2
         in Full ary'
-    go s (Full ary1) (BitmapIndexed b2 ary2) =
-        let ary' = unionArrayBy (go (s+bitsPerSubkey)) fullNodeMask b2 ary1 ary2
+    go bs s (Full ary1) (BitmapIndexed b2 ary2) =
+        let ary' = unionArrayBy (go (bs+bitsPerSubkey) s) fullNodeMask b2 ary1 ary2
         in Full ary'
-    go s (Full ary1) (Full ary2) =
-        let ary' = unionArrayBy (go (s+bitsPerSubkey)) fullNodeMask fullNodeMask
+    go bs s (Full ary1) (Full ary2) =
+        let ary' = unionArrayBy (go (bs+bitsPerSubkey) s) fullNodeMask fullNodeMask
                    ary1 ary2
         in Full ary'
     -- leaf vs. branch
-    go s (BitmapIndexed b1 ary1) t2
+    go bs s (BitmapIndexed b1 ary1) t2
         | b1 .&. m2 == 0 = let ary' = A.insert ary1 i t2
                                b'   = b1 .|. m2
                            in bitmapIndexedOrFull b' ary'
         | otherwise      = let ary' = A.updateWith' ary1 i $ \st1 ->
-                                   go (s+bitsPerSubkey) st1 t2
+                                   go (bs+bitsPerSubkey) s st1 t2
                            in BitmapIndexed b1 ary'
         where
           h2 = leafHashCode t2
-          m2 = mask h2 s
+          m2 = mask h2 bs
           i = sparseIndex b1 m2
-    go s t1 (BitmapIndexed b2 ary2)
+    go bs s t1 (BitmapIndexed b2 ary2)
         | b2 .&. m1 == 0 = let ary' = A.insert ary2 i $! t1
                                b'   = b2 .|. m1
                            in bitmapIndexedOrFull b' ary'
         | otherwise      = let ary' = A.updateWith' ary2 i $ \st2 ->
-                                   go (s+bitsPerSubkey) t1 st2
+                                   go (bs+bitsPerSubkey) s t1 st2
                            in BitmapIndexed b2 ary'
       where
         h1 = leafHashCode t1
-        m1 = mask h1 s
+        m1 = mask h1 bs
         i = sparseIndex b2 m1
-    go s (Full ary1) t2 =
+    go bs s (Full ary1) t2 =
         let h2   = leafHashCode t2
-            i    = index h2 s
-            ary' = update16With' ary1 i $ \st1 -> go (s+bitsPerSubkey) st1 t2
+            i    = index h2 bs
+            ary' = update16With' ary1 i $ \st1 -> go (bs+bitsPerSubkey) s st1 t2
         in Full ary'
-    go s t1 (Full ary2) =
+    go bs s t1 (Full ary2) =
         let h1   = leafHashCode t1
-            i    = index h1 s
-            ary' = update16With' ary2 i $ \st2 -> go (s+bitsPerSubkey) t1 st2
+            i    = index h1 bs
+            ary' = update16With' ary2 i $ \st2 -> go (bs+bitsPerSubkey) s t1 st2
         in Full ary'
 
     leafHashCode (Leaf h _) = h
-    leafHashCode (Collision h _) = h
+    leafHashCode (Collision h _ _) = h
     leafHashCode _ = error "leafHashCode"
 
-    goDifferentHash s h1 h2 t1 t2
-        | m1 == m2  = BitmapIndexed m1 (A.singleton $! go (s+bitsPerSubkey) t1 t2)
+    goDifferentHash bs s h1 h2 t1 t2
+        | m1 == m2  = BitmapIndexed m1 (A.singleton $! go (bs+bitsPerSubkey) s t1 t2)
         | m1 <  m2  = BitmapIndexed (m1 .|. m2) (A.pair t1 t2)
         | otherwise = BitmapIndexed (m1 .|. m2) (A.pair t2 t1)
       where
-        m1 = mask h1 s
-        m2 = mask h2 s
+        m1 = mask h1 bs
+        m2 = mask h2 bs
 {-# INLINE unionWithKey #-}
 
 ------------------------------------------------------------------------
@@ -493,8 +499,8 @@ mapWithKey f = go
     go (Leaf h (L k v))      = leaf h k (f k v)
     go (BitmapIndexed b ary) = BitmapIndexed b $ A.map' go ary
     go (Full ary)            = Full $ A.map' go ary
-    go (Collision h ary)     =
-        Collision h $ A.map' (\ (L k v) -> let !v' = f k v in L k v') ary
+    go (Collision h s hm)     =
+        Collision h s $ go hm
 {-# INLINE mapWithKey #-}
 
 -- | /O(n)/ Transform this map by applying a function to every value.
@@ -545,8 +551,8 @@ traverseWithKey f = go
     go (Leaf h (L k v))      = leaf h k <$> f k v
     go (BitmapIndexed b ary) = BitmapIndexed b <$> A.traverse' go ary
     go (Full ary)            = Full <$> A.traverse' go ary
-    go (Collision h ary)     =
-        Collision h <$> A.traverse' (\ (L k v) -> (L k $!) <$> f k v) ary
+    go (Collision h s hm)     =
+        Collision h s <$> go hm
 {-# INLINE traverseWithKey #-}
 
 ------------------------------------------------------------------------

From f5474ddcba725d1917598e96538d3ad64cc3e6bd Mon Sep 17 00:00:00 2001
From: Tom Sydney Kerckhove <syd@fpcomplete.com>
Date: Tue, 14 Aug 2018 20:49:54 +0200
Subject: [PATCH 08/69] Fixed double collisions

---
 Data/HashMap/Base.hs                |  24 +-
 hashmap-strict-properties.prof.html | 931 ++++++++++++++++++++++++++++
 helper.hs                           |  19 +
 3 files changed, 963 insertions(+), 11 deletions(-)
 create mode 100644 hashmap-strict-properties.prof.html
 create mode 100644 helper.hs

diff --git a/Data/HashMap/Base.hs b/Data/HashMap/Base.hs
index 05fa160c..f0857028 100644
--- a/Data/HashMap/Base.hs
+++ b/Data/HashMap/Base.hs
@@ -625,12 +625,14 @@ infixl 9 !
 
 -- | Create a 'Collision' value with two 'Leaf' values.
 collision :: (Eq k, Hashable k) => Hash -> Salt -> Leaf k v -> Leaf k v -> HashMap k v
-collision h s !(L k1 v1) !(L k2 v2) =
+collision h s !l1@(L k1 v1) !l2@(L k2 v2) =
   let s' = nextSalt s
       rehash = hashWithSalt s'
       h1 = rehash k1
       h2 = rehash k2
-      hm = runST $ two 0 h1 k1 v1 h2 k2 v2
+      hm = if h1 == h2
+        then Collision h s' $ collision h1 s' l1 l2
+        else runST $ two 0 h1 k1 v1 h2 k2 v2
   in Collision h s' hm
 {-# INLINE collision #-}
 
@@ -690,7 +692,7 @@ insert' h0 s0 k0 v0 m0 = go h0 s0 k0 v0 0 m0
             else Full (update16 ary i st')
       where i = index h bs
     go h s k x bs t@(Collision hx sx hmx)
-        | h == hx   = Collision hx sx $ insert' (hashWithSalt sx k) sx k x hmx
+        | h == hx   = Collision hx sx $ go (hashWithSalt sx k) sx k x 0 hmx
         | otherwise = go h s k x bs $ BitmapIndexed (mask hx bs) (A.singleton t)
 {-# INLINABLE insert' #-}
 
@@ -724,7 +726,7 @@ insertNewKey !h0 !s0 !k0 x0 !m0 = go h0 s0 k0 x0 0 m0
         in Full (update16 ary i st')
       where i = index h bs
     go h s k x bs t@(Collision hx sx hmx)
-        | h == hx   = Collision hx sx $ insertNewKey (hashWithSalt sx k) sx k x hmx
+        | h == hx   = Collision hx sx $ go (hashWithSalt sx k) sx k x 0 hmx
         | otherwise =
             go h s k x bs $ BitmapIndexed (mask hx bs) (A.singleton t)
 {-# NOINLINE insertNewKey #-}
@@ -755,7 +757,7 @@ insertKeyExists !h0 !s0 !k0 x0 !m0 = go h0 s0 k0 x0 0 m0
         in Full (update16 ary i st')
       where i = index h bs
     go h s k x bs t@(Collision hx sx hmx)
-        | h == hx   = Collision hx sx $ insertKeyExists (hashWithSalt sx k) sx k x hmx
+        | h == hx   = Collision hx sx $ go (hashWithSalt sx k) sx k x 0 hmx
         | otherwise =
             go h s k x bs $ BitmapIndexed (mask hx bs) (A.singleton t)
     go _ _ _ _ _ Empty = Empty -- error "Internal error: go Empty"
@@ -776,7 +778,7 @@ unsafeInsert k0 v0 m0 = runST (go h0 s0 k0 v0 0 m0)
   where
     h0 = hashWithSalt s0 k0
     s0 = defaultSalt
-    go !h _ !k x !_ Empty = return $! Leaf h (L k x)
+    go !h !_ !k x !_ Empty = return $! Leaf h (L k x)
     go h s k x bs t@(Leaf hy l@(L ky y))
         | hy == h = if ky == k
                     then if x `ptrEq` y
@@ -883,7 +885,7 @@ insertModifying x f k0 m0 = go h0 s0 k0 0 m0
       where i = index h bs
     go h s k bs t@(Collision hx sx hmx)
         | h == hx   =
-            go (hashWithSalt sx k) sx k 0 hmx
+            Collision hx sx $ go (hashWithSalt sx k) sx k 0 hmx
         | otherwise = go h s k bs $ BitmapIndexed (mask hx bs) (A.singleton t)
 {-# INLINABLE insertModifying #-}
 
@@ -991,7 +993,7 @@ delete' h0 s0 k0 m0 = go h0 s0 k0 0 m0
             _ -> Full (A.update ary i st')
       where i = index h bs
     go h s k _ t@(Collision hx sx hmx)
-        | h == hx = go (hashWithSalt sx k) sx k 0 hmx
+        | h == hx = Collision hx sx $ go (hashWithSalt sx k) sx k 0 hmx
         | otherwise = t
 {-# INLINABLE delete' #-}
 
@@ -1032,7 +1034,7 @@ deleteKeyExists !h0 s0 !k0 !m0 = go h0 s0 k0 0 m0
             _ -> Full (A.update ary i st')
       where i = index h bs
     go h s k _ t@(Collision hx sx hmx)
-        | h == hx = go (hashWithSalt sx k) sx k 0 hmx
+        | h == hx = Collision hx sx $ go (hashWithSalt sx k) sx k 0 hmx
         | otherwise = Empty -- error "Internal error: unexpected collision"
     go !_ !_ !_ !_ Empty = Empty -- error "Internal error: deleteKeyExists empty"
 {-# NOINLINE deleteKeyExists #-}
@@ -1081,7 +1083,7 @@ adjust# f k0 m0 = go h0 k0 0 m0
            then t
            else Full ary'
     go h k _ t@(Collision hx sx hmx)
-        | h == hx   = go (hashWithSalt sx k) k 0 hmx
+        | h == hx   = Collision hx sx $ go (hashWithSalt sx k) k 0 hmx
         | otherwise = t
 {-# INLINABLE adjust# #-}
 
@@ -1595,7 +1597,7 @@ filterMapAux onLeaf onColl = go
         | otherwise = Empty
     go (BitmapIndexed b ary) = filterA ary b
     go (Full ary) = filterA ary fullNodeMask
-    go (Collision _ _ hm) = go hm
+    go (Collision _ _ hm) = undefined hm -- TODO
 
     filterA ary0 b0 =
         let !n = A.length ary0
diff --git a/hashmap-strict-properties.prof.html b/hashmap-strict-properties.prof.html
new file mode 100644
index 00000000..d7558312
--- /dev/null
+++ b/hashmap-strict-properties.prof.html
@@ -0,0 +1,931 @@
+<!DOCTYPE html>
+<html>
+  <head>
+    <meta charset="UTF-8">
+    <title>hashmap-strict-properties</title>
+<script type="text/javascript">var $prof = [{"5081":[">>=","Test.Framework.Improving",2,100,100,["5082"]],"5076":["runImprovingIO.action","Test.Framework.Improving",0,100,100,["5081"]],"5098":["quickCheckWithResult","Test.QuickCheck.Test",1,100,100,["5100"]],"5138":[">>=.\\","Test.QuickCheck.Gen",1595,100,100,["5163"]],"5219":["shrinking","Test.QuickCheck.Property",40,100,100,["5220"]],"5244":["callback","Test.QuickCheck.Property",40,100,100,["5245"]],"5222":["shrinking.props","Test.QuickCheck.Property",40,100,100,["5244"]],"5070":["runTestTree","Test.Framework.Runners.Core",0,100,100,["5071"]],"5249":["forAllShrink.\\.\\","Test.QuickCheck.Property",40,100,100,["5287"]],"5069":["runTests'","Test.Framework.Runners.Core",0,100,100,["5070"]],"4927":["defaultMainWithOpts","Test.Framework.Runners.Console",1,100,100,["4936"]],"5248":["property","Test.QuickCheck.Property",20,100,100,["5249"]],"5071":["runTestTree.go","Test.Framework.Runners.Core",0,100,100,["5072"]],"5074":["runProperty","Test.Framework.Providers.QuickCheck2",0,100,100,["5075"]],"5163":[">>=.\\.(...)","Test.QuickCheck.Gen",1595,100,100,["5217"]],"5221":["fmap.\\","Test.QuickCheck.Gen",140,100,100,["5222"]],"4923":["defaultMain","Test.Framework.Runners.Console",0,100,100,["4924"]],"5100":["withNullTerminal","Test.QuickCheck.Text",1,100,100,["5102"]],"5247":["mapProp","Test.QuickCheck.Property",100,100,100,["5248"]],"5067":["poolWorker","Test.Framework.Runners.ThreadPool",1,100,100,["5069"]],"5082":[">>=.\\","Test.Framework.Improving",2,100,100,["5098"]],"5075":["runImprovingIO","Test.Framework.Improving",0,100,100,["5076"]],"5287.indiv":["pEq (indiv)","Main",20,100,100,[]],"5246":["mapRoseResult","Test.QuickCheck.Property",100,100,100,["5247"]],"5220":["fmap","Test.QuickCheck.Gen",140,100,100,["5221"]],"4922":["main","Main",0,100,100,["4923"]],"5072":["runSimpleTest","Test.Framework.Runners.Core",0,100,100,["5073"]],"5137":[">>=","Test.QuickCheck.Gen",1368,100,100,["5138"]],"4936":["runTests","Test.Framework.Runners.Core",1,100,100,["5060"]],"2460":["MAIN","MAIN",0,100,100,["4922"]],"5287":["pEq","Main",20,100,100,["5287.indiv"]],"4924":["defaultMainWithArgs","Test.Framework.Runners.Console",1,100,100,["4927"]],"5060":["executeOnPool","Test.Framework.Runners.ThreadPool",1,100,100,["5067"]],"5102":["quickCheckWithResult.\\","Test.QuickCheck.Test",1,100,100,["5136"]],"5245":["mapTotalResult","Test.QuickCheck.Property",100,100,100,["5246"]],"5217":["forAllShrink.\\","Test.QuickCheck.Property",40,100,100,["5219"]],"5073":["runTest","Test.Framework.Providers.QuickCheck2",0,100,100,["5074"]],"5136":["property","Test.QuickCheck.Property",100,100,100,["5137"]]},"2460"];</script>
+<style>
+/* General
+ ******************************************************************************/
+
+html {
+    font-family:      sans-serif;
+    font-size:        14px;
+    background-color: #222;
+    color:            #ddd;
+    overflow:         hidden;
+}
+
+body {
+    display: table;
+    margin:  0px;
+    height: 100%;
+    width:  100%;
+}
+
+a {
+    color: #8ee2f9;
+}
+
+#details-tree {
+    position: absolute;
+    left:     0px;
+    height:   100%;
+    width:    33%;
+}
+
+#details {
+    border-bottom: solid 4px #888;
+    height:        33%;
+    overflow:      auto;
+    top:           0px;
+    position:      relative;
+}
+
+#tree {
+    bottom:   0px;
+    height:   66%;
+    overflow: auto;
+    position: absolute;
+    width:    100%;
+}
+
+#map {
+    border-left: solid 4px #888;
+    position: absolute;
+    left:     33%;
+    right:    0px;
+    height:   100%;
+}
+
+/* Details
+ ******************************************************************************/
+
+#details h1 {
+    font-size:   16px;
+    font-weight: bold;
+    margin:      5px;
+}
+
+#details .controls {
+    margin: 5px;
+}
+
+#details table {
+    margin: 5px;
+}
+
+#details td {
+    padding-right: 15px;
+}
+
+#details .credits {
+    font-size: 12px;
+    position:  absolute;
+    bottom:    0px;
+    margin:    5px;
+}
+
+/* Tree browser
+ ******************************************************************************/
+
+.tree-browser .node {
+    padding: 2px;
+}
+
+.tree-browser .chevron {
+    position:   absolute;
+    width:      20px;
+    text-align: center;
+}
+
+.tree-browser .name {
+    position: relative;
+    left:     20px;
+    padding:  2px 5px 2px 5px;
+}
+
+.tree-browser .selected {
+    border: 2px solid #fff;
+}
+
+.tree-browser .children {
+    margin-top:   6px;
+    margin-left:  10px;
+    padding-left: 10px;
+    border-left:  1px dashed #888;
+}
+</style>
+<script type="text/javascript">
+/*! jQuery v3.2.1 | (c) JS Foundation and other contributors | jquery.org/license */
+!function(a,b){"use strict";"object"==typeof module&&"object"==typeof module.exports?module.exports=a.document?b(a,!0):function(a){if(!a.document)throw new Error("jQuery requires a window with a document");return b(a)}:b(a)}("undefined"!=typeof window?window:this,function(a,b){"use strict";var c=[],d=a.document,e=Object.getPrototypeOf,f=c.slice,g=c.concat,h=c.push,i=c.indexOf,j={},k=j.toString,l=j.hasOwnProperty,m=l.toString,n=m.call(Object),o={};function p(a,b){b=b||d;var c=b.createElement("script");c.text=a,b.head.appendChild(c).parentNode.removeChild(c)}var q="3.2.1",r=function(a,b){return new r.fn.init(a,b)},s=/^[\s\uFEFF\xA0]+|[\s\uFEFF\xA0]+$/g,t=/^-ms-/,u=/-([a-z])/g,v=function(a,b){return b.toUpperCase()};r.fn=r.prototype={jquery:q,constructor:r,length:0,toArray:function(){return f.call(this)},get:function(a){return null==a?f.call(this):a<0?this[a+this.length]:this[a]},pushStack:function(a){var b=r.merge(this.constructor(),a);return b.prevObject=this,b},each:function(a){return r.each(this,a)},map:function(a){return this.pushStack(r.map(this,function(b,c){return a.call(b,c,b)}))},slice:function(){return this.pushStack(f.apply(this,arguments))},first:function(){return this.eq(0)},last:function(){return this.eq(-1)},eq:function(a){var b=this.length,c=+a+(a<0?b:0);return this.pushStack(c>=0&&c<b?[this[c]]:[])},end:function(){return this.prevObject||this.constructor()},push:h,sort:c.sort,splice:c.splice},r.extend=r.fn.extend=function(){var a,b,c,d,e,f,g=arguments[0]||{},h=1,i=arguments.length,j=!1;for("boolean"==typeof g&&(j=g,g=arguments[h]||{},h++),"object"==typeof g||r.isFunction(g)||(g={}),h===i&&(g=this,h--);h<i;h++)if(null!=(a=arguments[h]))for(b in a)c=g[b],d=a[b],g!==d&&(j&&d&&(r.isPlainObject(d)||(e=Array.isArray(d)))?(e?(e=!1,f=c&&Array.isArray(c)?c:[]):f=c&&r.isPlainObject(c)?c:{},g[b]=r.extend(j,f,d)):void 0!==d&&(g[b]=d));return g},r.extend({expando:"jQuery"+(q+Math.random()).replace(/\D/g,""),isReady:!0,error:function(a){throw new Error(a)},noop:function(){},isFunction:function(a){return"function"===r.type(a)},isWindow:function(a){return null!=a&&a===a.window},isNumeric:function(a){var b=r.type(a);return("number"===b||"string"===b)&&!isNaN(a-parseFloat(a))},isPlainObject:function(a){var b,c;return!(!a||"[object Object]"!==k.call(a))&&(!(b=e(a))||(c=l.call(b,"constructor")&&b.constructor,"function"==typeof c&&m.call(c)===n))},isEmptyObject:function(a){var b;for(b in a)return!1;return!0},type:function(a){return null==a?a+"":"object"==typeof a||"function"==typeof a?j[k.call(a)]||"object":typeof a},globalEval:function(a){p(a)},camelCase:function(a){return a.replace(t,"ms-").replace(u,v)},each:function(a,b){var c,d=0;if(w(a)){for(c=a.length;d<c;d++)if(b.call(a[d],d,a[d])===!1)break}else for(d in a)if(b.call(a[d],d,a[d])===!1)break;return a},trim:function(a){return null==a?"":(a+"").replace(s,"")},makeArray:function(a,b){var c=b||[];return null!=a&&(w(Object(a))?r.merge(c,"string"==typeof a?[a]:a):h.call(c,a)),c},inArray:function(a,b,c){return null==b?-1:i.call(b,a,c)},merge:function(a,b){for(var c=+b.length,d=0,e=a.length;d<c;d++)a[e++]=b[d];return a.length=e,a},grep:function(a,b,c){for(var d,e=[],f=0,g=a.length,h=!c;f<g;f++)d=!b(a[f],f),d!==h&&e.push(a[f]);return e},map:function(a,b,c){var d,e,f=0,h=[];if(w(a))for(d=a.length;f<d;f++)e=b(a[f],f,c),null!=e&&h.push(e);else for(f in a)e=b(a[f],f,c),null!=e&&h.push(e);return g.apply([],h)},guid:1,proxy:function(a,b){var c,d,e;if("string"==typeof b&&(c=a[b],b=a,a=c),r.isFunction(a))return d=f.call(arguments,2),e=function(){return a.apply(b||this,d.concat(f.call(arguments)))},e.guid=a.guid=a.guid||r.guid++,e},now:Date.now,support:o}),"function"==typeof Symbol&&(r.fn[Symbol.iterator]=c[Symbol.iterator]),r.each("Boolean Number String Function Array Date RegExp Object Error Symbol".split(" "),function(a,b){j["[object "+b+"]"]=b.toLowerCase()});function w(a){var b=!!a&&"length"in a&&a.length,c=r.type(a);return"function"!==c&&!r.isWindow(a)&&("array"===c||0===b||"number"==typeof b&&b>0&&b-1 in a)}var x=function(a){var b,c,d,e,f,g,h,i,j,k,l,m,n,o,p,q,r,s,t,u="sizzle"+1*new Date,v=a.document,w=0,x=0,y=ha(),z=ha(),A=ha(),B=function(a,b){return a===b&&(l=!0),0},C={}.hasOwnProperty,D=[],E=D.pop,F=D.push,G=D.push,H=D.slice,I=function(a,b){for(var c=0,d=a.length;c<d;c++)if(a[c]===b)return c;return-1},J="checked|selected|async|autofocus|autoplay|controls|defer|disabled|hidden|ismap|loop|multiple|open|readonly|required|scoped",K="[\\x20\\t\\r\\n\\f]",L="(?:\\\\.|[\\w-]|[^\0-\\xa0])+",M="\\["+K+"*("+L+")(?:"+K+"*([*^$|!~]?=)"+K+"*(?:'((?:\\\\.|[^\\\\'])*)'|\"((?:\\\\.|[^\\\\\"])*)\"|("+L+"))|)"+K+"*\\]",N=":("+L+")(?:\\((('((?:\\\\.|[^\\\\'])*)'|\"((?:\\\\.|[^\\\\\"])*)\")|((?:\\\\.|[^\\\\()[\\]]|"+M+")*)|.*)\\)|)",O=new RegExp(K+"+","g"),P=new RegExp("^"+K+"+|((?:^|[^\\\\])(?:\\\\.)*)"+K+"+$","g"),Q=new RegExp("^"+K+"*,"+K+"*"),R=new RegExp("^"+K+"*([>+~]|"+K+")"+K+"*"),S=new RegExp("="+K+"*([^\\]'\"]*?)"+K+"*\\]","g"),T=new RegExp(N),U=new RegExp("^"+L+"$"),V={ID:new RegExp("^#("+L+")"),CLASS:new RegExp("^\\.("+L+")"),TAG:new RegExp("^("+L+"|[*])"),ATTR:new RegExp("^"+M),PSEUDO:new RegExp("^"+N),CHILD:new RegExp("^:(only|first|last|nth|nth-last)-(child|of-type)(?:\\("+K+"*(even|odd|(([+-]|)(\\d*)n|)"+K+"*(?:([+-]|)"+K+"*(\\d+)|))"+K+"*\\)|)","i"),bool:new RegExp("^(?:"+J+")$","i"),needsContext:new RegExp("^"+K+"*[>+~]|:(even|odd|eq|gt|lt|nth|first|last)(?:\\("+K+"*((?:-\\d)?\\d*)"+K+"*\\)|)(?=[^-]|$)","i")},W=/^(?:input|select|textarea|button)$/i,X=/^h\d$/i,Y=/^[^{]+\{\s*\[native \w/,Z=/^(?:#([\w-]+)|(\w+)|\.([\w-]+))$/,$=/[+~]/,_=new RegExp("\\\\([\\da-f]{1,6}"+K+"?|("+K+")|.)","ig"),aa=function(a,b,c){var d="0x"+b-65536;return d!==d||c?b:d<0?String.fromCharCode(d+65536):String.fromCharCode(d>>10|55296,1023&d|56320)},ba=/([\0-\x1f\x7f]|^-?\d)|^-$|[^\0-\x1f\x7f-\uFFFF\w-]/g,ca=function(a,b){return b?"\0"===a?"\ufffd":a.slice(0,-1)+"\\"+a.charCodeAt(a.length-1).toString(16)+" ":"\\"+a},da=function(){m()},ea=ta(function(a){return a.disabled===!0&&("form"in a||"label"in a)},{dir:"parentNode",next:"legend"});try{G.apply(D=H.call(v.childNodes),v.childNodes),D[v.childNodes.length].nodeType}catch(fa){G={apply:D.length?function(a,b){F.apply(a,H.call(b))}:function(a,b){var c=a.length,d=0;while(a[c++]=b[d++]);a.length=c-1}}}function ga(a,b,d,e){var f,h,j,k,l,o,r,s=b&&b.ownerDocument,w=b?b.nodeType:9;if(d=d||[],"string"!=typeof a||!a||1!==w&&9!==w&&11!==w)return d;if(!e&&((b?b.ownerDocument||b:v)!==n&&m(b),b=b||n,p)){if(11!==w&&(l=Z.exec(a)))if(f=l[1]){if(9===w){if(!(j=b.getElementById(f)))return d;if(j.id===f)return d.push(j),d}else if(s&&(j=s.getElementById(f))&&t(b,j)&&j.id===f)return d.push(j),d}else{if(l[2])return G.apply(d,b.getElementsByTagName(a)),d;if((f=l[3])&&c.getElementsByClassName&&b.getElementsByClassName)return G.apply(d,b.getElementsByClassName(f)),d}if(c.qsa&&!A[a+" "]&&(!q||!q.test(a))){if(1!==w)s=b,r=a;else if("object"!==b.nodeName.toLowerCase()){(k=b.getAttribute("id"))?k=k.replace(ba,ca):b.setAttribute("id",k=u),o=g(a),h=o.length;while(h--)o[h]="#"+k+" "+sa(o[h]);r=o.join(","),s=$.test(a)&&qa(b.parentNode)||b}if(r)try{return G.apply(d,s.querySelectorAll(r)),d}catch(x){}finally{k===u&&b.removeAttribute("id")}}}return i(a.replace(P,"$1"),b,d,e)}function ha(){var a=[];function b(c,e){return a.push(c+" ")>d.cacheLength&&delete b[a.shift()],b[c+" "]=e}return b}function ia(a){return a[u]=!0,a}function ja(a){var b=n.createElement("fieldset");try{return!!a(b)}catch(c){return!1}finally{b.parentNode&&b.parentNode.removeChild(b),b=null}}function ka(a,b){var c=a.split("|"),e=c.length;while(e--)d.attrHandle[c[e]]=b}function la(a,b){var c=b&&a,d=c&&1===a.nodeType&&1===b.nodeType&&a.sourceIndex-b.sourceIndex;if(d)return d;if(c)while(c=c.nextSibling)if(c===b)return-1;return a?1:-1}function ma(a){return function(b){var c=b.nodeName.toLowerCase();return"input"===c&&b.type===a}}function na(a){return function(b){var c=b.nodeName.toLowerCase();return("input"===c||"button"===c)&&b.type===a}}function oa(a){return function(b){return"form"in b?b.parentNode&&b.disabled===!1?"label"in b?"label"in b.parentNode?b.parentNode.disabled===a:b.disabled===a:b.isDisabled===a||b.isDisabled!==!a&&ea(b)===a:b.disabled===a:"label"in b&&b.disabled===a}}function pa(a){return ia(function(b){return b=+b,ia(function(c,d){var e,f=a([],c.length,b),g=f.length;while(g--)c[e=f[g]]&&(c[e]=!(d[e]=c[e]))})})}function qa(a){return a&&"undefined"!=typeof a.getElementsByTagName&&a}c=ga.support={},f=ga.isXML=function(a){var b=a&&(a.ownerDocument||a).documentElement;return!!b&&"HTML"!==b.nodeName},m=ga.setDocument=function(a){var b,e,g=a?a.ownerDocument||a:v;return g!==n&&9===g.nodeType&&g.documentElement?(n=g,o=n.documentElement,p=!f(n),v!==n&&(e=n.defaultView)&&e.top!==e&&(e.addEventListener?e.addEventListener("unload",da,!1):e.attachEvent&&e.attachEvent("onunload",da)),c.attributes=ja(function(a){return a.className="i",!a.getAttribute("className")}),c.getElementsByTagName=ja(function(a){return a.appendChild(n.createComment("")),!a.getElementsByTagName("*").length}),c.getElementsByClassName=Y.test(n.getElementsByClassName),c.getById=ja(function(a){return o.appendChild(a).id=u,!n.getElementsByName||!n.getElementsByName(u).length}),c.getById?(d.filter.ID=function(a){var b=a.replace(_,aa);return function(a){return a.getAttribute("id")===b}},d.find.ID=function(a,b){if("undefined"!=typeof b.getElementById&&p){var c=b.getElementById(a);return c?[c]:[]}}):(d.filter.ID=function(a){var b=a.replace(_,aa);return function(a){var c="undefined"!=typeof a.getAttributeNode&&a.getAttributeNode("id");return c&&c.value===b}},d.find.ID=function(a,b){if("undefined"!=typeof b.getElementById&&p){var c,d,e,f=b.getElementById(a);if(f){if(c=f.getAttributeNode("id"),c&&c.value===a)return[f];e=b.getElementsByName(a),d=0;while(f=e[d++])if(c=f.getAttributeNode("id"),c&&c.value===a)return[f]}return[]}}),d.find.TAG=c.getElementsByTagName?function(a,b){return"undefined"!=typeof b.getElementsByTagName?b.getElementsByTagName(a):c.qsa?b.querySelectorAll(a):void 0}:function(a,b){var c,d=[],e=0,f=b.getElementsByTagName(a);if("*"===a){while(c=f[e++])1===c.nodeType&&d.push(c);return d}return f},d.find.CLASS=c.getElementsByClassName&&function(a,b){if("undefined"!=typeof b.getElementsByClassName&&p)return b.getElementsByClassName(a)},r=[],q=[],(c.qsa=Y.test(n.querySelectorAll))&&(ja(function(a){o.appendChild(a).innerHTML="<a id='"+u+"'></a><select id='"+u+"-\r\\' msallowcapture=''><option selected=''></option></select>",a.querySelectorAll("[msallowcapture^='']").length&&q.push("[*^$]="+K+"*(?:''|\"\")"),a.querySelectorAll("[selected]").length||q.push("\\["+K+"*(?:value|"+J+")"),a.querySelectorAll("[id~="+u+"-]").length||q.push("~="),a.querySelectorAll(":checked").length||q.push(":checked"),a.querySelectorAll("a#"+u+"+*").length||q.push(".#.+[+~]")}),ja(function(a){a.innerHTML="<a href='' disabled='disabled'></a><select disabled='disabled'><option/></select>";var b=n.createElement("input");b.setAttribute("type","hidden"),a.appendChild(b).setAttribute("name","D"),a.querySelectorAll("[name=d]").length&&q.push("name"+K+"*[*^$|!~]?="),2!==a.querySelectorAll(":enabled").length&&q.push(":enabled",":disabled"),o.appendChild(a).disabled=!0,2!==a.querySelectorAll(":disabled").length&&q.push(":enabled",":disabled"),a.querySelectorAll("*,:x"),q.push(",.*:")})),(c.matchesSelector=Y.test(s=o.matches||o.webkitMatchesSelector||o.mozMatchesSelector||o.oMatchesSelector||o.msMatchesSelector))&&ja(function(a){c.disconnectedMatch=s.call(a,"*"),s.call(a,"[s!='']:x"),r.push("!=",N)}),q=q.length&&new RegExp(q.join("|")),r=r.length&&new RegExp(r.join("|")),b=Y.test(o.compareDocumentPosition),t=b||Y.test(o.contains)?function(a,b){var c=9===a.nodeType?a.documentElement:a,d=b&&b.parentNode;return a===d||!(!d||1!==d.nodeType||!(c.contains?c.contains(d):a.compareDocumentPosition&&16&a.compareDocumentPosition(d)))}:function(a,b){if(b)while(b=b.parentNode)if(b===a)return!0;return!1},B=b?function(a,b){if(a===b)return l=!0,0;var d=!a.compareDocumentPosition-!b.compareDocumentPosition;return d?d:(d=(a.ownerDocument||a)===(b.ownerDocument||b)?a.compareDocumentPosition(b):1,1&d||!c.sortDetached&&b.compareDocumentPosition(a)===d?a===n||a.ownerDocument===v&&t(v,a)?-1:b===n||b.ownerDocument===v&&t(v,b)?1:k?I(k,a)-I(k,b):0:4&d?-1:1)}:function(a,b){if(a===b)return l=!0,0;var c,d=0,e=a.parentNode,f=b.parentNode,g=[a],h=[b];if(!e||!f)return a===n?-1:b===n?1:e?-1:f?1:k?I(k,a)-I(k,b):0;if(e===f)return la(a,b);c=a;while(c=c.parentNode)g.unshift(c);c=b;while(c=c.parentNode)h.unshift(c);while(g[d]===h[d])d++;return d?la(g[d],h[d]):g[d]===v?-1:h[d]===v?1:0},n):n},ga.matches=function(a,b){return ga(a,null,null,b)},ga.matchesSelector=function(a,b){if((a.ownerDocument||a)!==n&&m(a),b=b.replace(S,"='$1']"),c.matchesSelector&&p&&!A[b+" "]&&(!r||!r.test(b))&&(!q||!q.test(b)))try{var d=s.call(a,b);if(d||c.disconnectedMatch||a.document&&11!==a.document.nodeType)return d}catch(e){}return ga(b,n,null,[a]).length>0},ga.contains=function(a,b){return(a.ownerDocument||a)!==n&&m(a),t(a,b)},ga.attr=function(a,b){(a.ownerDocument||a)!==n&&m(a);var e=d.attrHandle[b.toLowerCase()],f=e&&C.call(d.attrHandle,b.toLowerCase())?e(a,b,!p):void 0;return void 0!==f?f:c.attributes||!p?a.getAttribute(b):(f=a.getAttributeNode(b))&&f.specified?f.value:null},ga.escape=function(a){return(a+"").replace(ba,ca)},ga.error=function(a){throw new Error("Syntax error, unrecognized expression: "+a)},ga.uniqueSort=function(a){var b,d=[],e=0,f=0;if(l=!c.detectDuplicates,k=!c.sortStable&&a.slice(0),a.sort(B),l){while(b=a[f++])b===a[f]&&(e=d.push(f));while(e--)a.splice(d[e],1)}return k=null,a},e=ga.getText=function(a){var b,c="",d=0,f=a.nodeType;if(f){if(1===f||9===f||11===f){if("string"==typeof a.textContent)return a.textContent;for(a=a.firstChild;a;a=a.nextSibling)c+=e(a)}else if(3===f||4===f)return a.nodeValue}else while(b=a[d++])c+=e(b);return c},d=ga.selectors={cacheLength:50,createPseudo:ia,match:V,attrHandle:{},find:{},relative:{">":{dir:"parentNode",first:!0}," ":{dir:"parentNode"},"+":{dir:"previousSibling",first:!0},"~":{dir:"previousSibling"}},preFilter:{ATTR:function(a){return a[1]=a[1].replace(_,aa),a[3]=(a[3]||a[4]||a[5]||"").replace(_,aa),"~="===a[2]&&(a[3]=" "+a[3]+" "),a.slice(0,4)},CHILD:function(a){return a[1]=a[1].toLowerCase(),"nth"===a[1].slice(0,3)?(a[3]||ga.error(a[0]),a[4]=+(a[4]?a[5]+(a[6]||1):2*("even"===a[3]||"odd"===a[3])),a[5]=+(a[7]+a[8]||"odd"===a[3])):a[3]&&ga.error(a[0]),a},PSEUDO:function(a){var b,c=!a[6]&&a[2];return V.CHILD.test(a[0])?null:(a[3]?a[2]=a[4]||a[5]||"":c&&T.test(c)&&(b=g(c,!0))&&(b=c.indexOf(")",c.length-b)-c.length)&&(a[0]=a[0].slice(0,b),a[2]=c.slice(0,b)),a.slice(0,3))}},filter:{TAG:function(a){var b=a.replace(_,aa).toLowerCase();return"*"===a?function(){return!0}:function(a){return a.nodeName&&a.nodeName.toLowerCase()===b}},CLASS:function(a){var b=y[a+" "];return b||(b=new RegExp("(^|"+K+")"+a+"("+K+"|$)"))&&y(a,function(a){return b.test("string"==typeof a.className&&a.className||"undefined"!=typeof a.getAttribute&&a.getAttribute("class")||"")})},ATTR:function(a,b,c){return function(d){var e=ga.attr(d,a);return null==e?"!="===b:!b||(e+="","="===b?e===c:"!="===b?e!==c:"^="===b?c&&0===e.indexOf(c):"*="===b?c&&e.indexOf(c)>-1:"$="===b?c&&e.slice(-c.length)===c:"~="===b?(" "+e.replace(O," ")+" ").indexOf(c)>-1:"|="===b&&(e===c||e.slice(0,c.length+1)===c+"-"))}},CHILD:function(a,b,c,d,e){var f="nth"!==a.slice(0,3),g="last"!==a.slice(-4),h="of-type"===b;return 1===d&&0===e?function(a){return!!a.parentNode}:function(b,c,i){var j,k,l,m,n,o,p=f!==g?"nextSibling":"previousSibling",q=b.parentNode,r=h&&b.nodeName.toLowerCase(),s=!i&&!h,t=!1;if(q){if(f){while(p){m=b;while(m=m[p])if(h?m.nodeName.toLowerCase()===r:1===m.nodeType)return!1;o=p="only"===a&&!o&&"nextSibling"}return!0}if(o=[g?q.firstChild:q.lastChild],g&&s){m=q,l=m[u]||(m[u]={}),k=l[m.uniqueID]||(l[m.uniqueID]={}),j=k[a]||[],n=j[0]===w&&j[1],t=n&&j[2],m=n&&q.childNodes[n];while(m=++n&&m&&m[p]||(t=n=0)||o.pop())if(1===m.nodeType&&++t&&m===b){k[a]=[w,n,t];break}}else if(s&&(m=b,l=m[u]||(m[u]={}),k=l[m.uniqueID]||(l[m.uniqueID]={}),j=k[a]||[],n=j[0]===w&&j[1],t=n),t===!1)while(m=++n&&m&&m[p]||(t=n=0)||o.pop())if((h?m.nodeName.toLowerCase()===r:1===m.nodeType)&&++t&&(s&&(l=m[u]||(m[u]={}),k=l[m.uniqueID]||(l[m.uniqueID]={}),k[a]=[w,t]),m===b))break;return t-=e,t===d||t%d===0&&t/d>=0}}},PSEUDO:function(a,b){var c,e=d.pseudos[a]||d.setFilters[a.toLowerCase()]||ga.error("unsupported pseudo: "+a);return e[u]?e(b):e.length>1?(c=[a,a,"",b],d.setFilters.hasOwnProperty(a.toLowerCase())?ia(function(a,c){var d,f=e(a,b),g=f.length;while(g--)d=I(a,f[g]),a[d]=!(c[d]=f[g])}):function(a){return e(a,0,c)}):e}},pseudos:{not:ia(function(a){var b=[],c=[],d=h(a.replace(P,"$1"));return d[u]?ia(function(a,b,c,e){var f,g=d(a,null,e,[]),h=a.length;while(h--)(f=g[h])&&(a[h]=!(b[h]=f))}):function(a,e,f){return b[0]=a,d(b,null,f,c),b[0]=null,!c.pop()}}),has:ia(function(a){return function(b){return ga(a,b).length>0}}),contains:ia(function(a){return a=a.replace(_,aa),function(b){return(b.textContent||b.innerText||e(b)).indexOf(a)>-1}}),lang:ia(function(a){return U.test(a||"")||ga.error("unsupported lang: "+a),a=a.replace(_,aa).toLowerCase(),function(b){var c;do if(c=p?b.lang:b.getAttribute("xml:lang")||b.getAttribute("lang"))return c=c.toLowerCase(),c===a||0===c.indexOf(a+"-");while((b=b.parentNode)&&1===b.nodeType);return!1}}),target:function(b){var c=a.location&&a.location.hash;return c&&c.slice(1)===b.id},root:function(a){return a===o},focus:function(a){return a===n.activeElement&&(!n.hasFocus||n.hasFocus())&&!!(a.type||a.href||~a.tabIndex)},enabled:oa(!1),disabled:oa(!0),checked:function(a){var b=a.nodeName.toLowerCase();return"input"===b&&!!a.checked||"option"===b&&!!a.selected},selected:function(a){return a.parentNode&&a.parentNode.selectedIndex,a.selected===!0},empty:function(a){for(a=a.firstChild;a;a=a.nextSibling)if(a.nodeType<6)return!1;return!0},parent:function(a){return!d.pseudos.empty(a)},header:function(a){return X.test(a.nodeName)},input:function(a){return W.test(a.nodeName)},button:function(a){var b=a.nodeName.toLowerCase();return"input"===b&&"button"===a.type||"button"===b},text:function(a){var b;return"input"===a.nodeName.toLowerCase()&&"text"===a.type&&(null==(b=a.getAttribute("type"))||"text"===b.toLowerCase())},first:pa(function(){return[0]}),last:pa(function(a,b){return[b-1]}),eq:pa(function(a,b,c){return[c<0?c+b:c]}),even:pa(function(a,b){for(var c=0;c<b;c+=2)a.push(c);return a}),odd:pa(function(a,b){for(var c=1;c<b;c+=2)a.push(c);return a}),lt:pa(function(a,b,c){for(var d=c<0?c+b:c;--d>=0;)a.push(d);return a}),gt:pa(function(a,b,c){for(var d=c<0?c+b:c;++d<b;)a.push(d);return a})}},d.pseudos.nth=d.pseudos.eq;for(b in{radio:!0,checkbox:!0,file:!0,password:!0,image:!0})d.pseudos[b]=ma(b);for(b in{submit:!0,reset:!0})d.pseudos[b]=na(b);function ra(){}ra.prototype=d.filters=d.pseudos,d.setFilters=new ra,g=ga.tokenize=function(a,b){var c,e,f,g,h,i,j,k=z[a+" "];if(k)return b?0:k.slice(0);h=a,i=[],j=d.preFilter;while(h){c&&!(e=Q.exec(h))||(e&&(h=h.slice(e[0].length)||h),i.push(f=[])),c=!1,(e=R.exec(h))&&(c=e.shift(),f.push({value:c,type:e[0].replace(P," ")}),h=h.slice(c.length));for(g in d.filter)!(e=V[g].exec(h))||j[g]&&!(e=j[g](e))||(c=e.shift(),f.push({value:c,type:g,matches:e}),h=h.slice(c.length));if(!c)break}return b?h.length:h?ga.error(a):z(a,i).slice(0)};function sa(a){for(var b=0,c=a.length,d="";b<c;b++)d+=a[b].value;return d}function ta(a,b,c){var d=b.dir,e=b.next,f=e||d,g=c&&"parentNode"===f,h=x++;return b.first?function(b,c,e){while(b=b[d])if(1===b.nodeType||g)return a(b,c,e);return!1}:function(b,c,i){var j,k,l,m=[w,h];if(i){while(b=b[d])if((1===b.nodeType||g)&&a(b,c,i))return!0}else while(b=b[d])if(1===b.nodeType||g)if(l=b[u]||(b[u]={}),k=l[b.uniqueID]||(l[b.uniqueID]={}),e&&e===b.nodeName.toLowerCase())b=b[d]||b;else{if((j=k[f])&&j[0]===w&&j[1]===h)return m[2]=j[2];if(k[f]=m,m[2]=a(b,c,i))return!0}return!1}}function ua(a){return a.length>1?function(b,c,d){var e=a.length;while(e--)if(!a[e](b,c,d))return!1;return!0}:a[0]}function va(a,b,c){for(var d=0,e=b.length;d<e;d++)ga(a,b[d],c);return c}function wa(a,b,c,d,e){for(var f,g=[],h=0,i=a.length,j=null!=b;h<i;h++)(f=a[h])&&(c&&!c(f,d,e)||(g.push(f),j&&b.push(h)));return g}function xa(a,b,c,d,e,f){return d&&!d[u]&&(d=xa(d)),e&&!e[u]&&(e=xa(e,f)),ia(function(f,g,h,i){var j,k,l,m=[],n=[],o=g.length,p=f||va(b||"*",h.nodeType?[h]:h,[]),q=!a||!f&&b?p:wa(p,m,a,h,i),r=c?e||(f?a:o||d)?[]:g:q;if(c&&c(q,r,h,i),d){j=wa(r,n),d(j,[],h,i),k=j.length;while(k--)(l=j[k])&&(r[n[k]]=!(q[n[k]]=l))}if(f){if(e||a){if(e){j=[],k=r.length;while(k--)(l=r[k])&&j.push(q[k]=l);e(null,r=[],j,i)}k=r.length;while(k--)(l=r[k])&&(j=e?I(f,l):m[k])>-1&&(f[j]=!(g[j]=l))}}else r=wa(r===g?r.splice(o,r.length):r),e?e(null,g,r,i):G.apply(g,r)})}function ya(a){for(var b,c,e,f=a.length,g=d.relative[a[0].type],h=g||d.relative[" "],i=g?1:0,k=ta(function(a){return a===b},h,!0),l=ta(function(a){return I(b,a)>-1},h,!0),m=[function(a,c,d){var e=!g&&(d||c!==j)||((b=c).nodeType?k(a,c,d):l(a,c,d));return b=null,e}];i<f;i++)if(c=d.relative[a[i].type])m=[ta(ua(m),c)];else{if(c=d.filter[a[i].type].apply(null,a[i].matches),c[u]){for(e=++i;e<f;e++)if(d.relative[a[e].type])break;return xa(i>1&&ua(m),i>1&&sa(a.slice(0,i-1).concat({value:" "===a[i-2].type?"*":""})).replace(P,"$1"),c,i<e&&ya(a.slice(i,e)),e<f&&ya(a=a.slice(e)),e<f&&sa(a))}m.push(c)}return ua(m)}function za(a,b){var c=b.length>0,e=a.length>0,f=function(f,g,h,i,k){var l,o,q,r=0,s="0",t=f&&[],u=[],v=j,x=f||e&&d.find.TAG("*",k),y=w+=null==v?1:Math.random()||.1,z=x.length;for(k&&(j=g===n||g||k);s!==z&&null!=(l=x[s]);s++){if(e&&l){o=0,g||l.ownerDocument===n||(m(l),h=!p);while(q=a[o++])if(q(l,g||n,h)){i.push(l);break}k&&(w=y)}c&&((l=!q&&l)&&r--,f&&t.push(l))}if(r+=s,c&&s!==r){o=0;while(q=b[o++])q(t,u,g,h);if(f){if(r>0)while(s--)t[s]||u[s]||(u[s]=E.call(i));u=wa(u)}G.apply(i,u),k&&!f&&u.length>0&&r+b.length>1&&ga.uniqueSort(i)}return k&&(w=y,j=v),t};return c?ia(f):f}return h=ga.compile=function(a,b){var c,d=[],e=[],f=A[a+" "];if(!f){b||(b=g(a)),c=b.length;while(c--)f=ya(b[c]),f[u]?d.push(f):e.push(f);f=A(a,za(e,d)),f.selector=a}return f},i=ga.select=function(a,b,c,e){var f,i,j,k,l,m="function"==typeof a&&a,n=!e&&g(a=m.selector||a);if(c=c||[],1===n.length){if(i=n[0]=n[0].slice(0),i.length>2&&"ID"===(j=i[0]).type&&9===b.nodeType&&p&&d.relative[i[1].type]){if(b=(d.find.ID(j.matches[0].replace(_,aa),b)||[])[0],!b)return c;m&&(b=b.parentNode),a=a.slice(i.shift().value.length)}f=V.needsContext.test(a)?0:i.length;while(f--){if(j=i[f],d.relative[k=j.type])break;if((l=d.find[k])&&(e=l(j.matches[0].replace(_,aa),$.test(i[0].type)&&qa(b.parentNode)||b))){if(i.splice(f,1),a=e.length&&sa(i),!a)return G.apply(c,e),c;break}}}return(m||h(a,n))(e,b,!p,c,!b||$.test(a)&&qa(b.parentNode)||b),c},c.sortStable=u.split("").sort(B).join("")===u,c.detectDuplicates=!!l,m(),c.sortDetached=ja(function(a){return 1&a.compareDocumentPosition(n.createElement("fieldset"))}),ja(function(a){return a.innerHTML="<a href='#'></a>","#"===a.firstChild.getAttribute("href")})||ka("type|href|height|width",function(a,b,c){if(!c)return a.getAttribute(b,"type"===b.toLowerCase()?1:2)}),c.attributes&&ja(function(a){return a.innerHTML="<input/>",a.firstChild.setAttribute("value",""),""===a.firstChild.getAttribute("value")})||ka("value",function(a,b,c){if(!c&&"input"===a.nodeName.toLowerCase())return a.defaultValue}),ja(function(a){return null==a.getAttribute("disabled")})||ka(J,function(a,b,c){var d;if(!c)return a[b]===!0?b.toLowerCase():(d=a.getAttributeNode(b))&&d.specified?d.value:null}),ga}(a);r.find=x,r.expr=x.selectors,r.expr[":"]=r.expr.pseudos,r.uniqueSort=r.unique=x.uniqueSort,r.text=x.getText,r.isXMLDoc=x.isXML,r.contains=x.contains,r.escapeSelector=x.escape;var y=function(a,b,c){var d=[],e=void 0!==c;while((a=a[b])&&9!==a.nodeType)if(1===a.nodeType){if(e&&r(a).is(c))break;d.push(a)}return d},z=function(a,b){for(var c=[];a;a=a.nextSibling)1===a.nodeType&&a!==b&&c.push(a);return c},A=r.expr.match.needsContext;function B(a,b){return a.nodeName&&a.nodeName.toLowerCase()===b.toLowerCase()}var C=/^<([a-z][^\/\0>:\x20\t\r\n\f]*)[\x20\t\r\n\f]*\/?>(?:<\/\1>|)$/i,D=/^.[^:#\[\.,]*$/;function E(a,b,c){return r.isFunction(b)?r.grep(a,function(a,d){return!!b.call(a,d,a)!==c}):b.nodeType?r.grep(a,function(a){return a===b!==c}):"string"!=typeof b?r.grep(a,function(a){return i.call(b,a)>-1!==c}):D.test(b)?r.filter(b,a,c):(b=r.filter(b,a),r.grep(a,function(a){return i.call(b,a)>-1!==c&&1===a.nodeType}))}r.filter=function(a,b,c){var d=b[0];return c&&(a=":not("+a+")"),1===b.length&&1===d.nodeType?r.find.matchesSelector(d,a)?[d]:[]:r.find.matches(a,r.grep(b,function(a){return 1===a.nodeType}))},r.fn.extend({find:function(a){var b,c,d=this.length,e=this;if("string"!=typeof a)return this.pushStack(r(a).filter(function(){for(b=0;b<d;b++)if(r.contains(e[b],this))return!0}));for(c=this.pushStack([]),b=0;b<d;b++)r.find(a,e[b],c);return d>1?r.uniqueSort(c):c},filter:function(a){return this.pushStack(E(this,a||[],!1))},not:function(a){return this.pushStack(E(this,a||[],!0))},is:function(a){return!!E(this,"string"==typeof a&&A.test(a)?r(a):a||[],!1).length}});var F,G=/^(?:\s*(<[\w\W]+>)[^>]*|#([\w-]+))$/,H=r.fn.init=function(a,b,c){var e,f;if(!a)return this;if(c=c||F,"string"==typeof a){if(e="<"===a[0]&&">"===a[a.length-1]&&a.length>=3?[null,a,null]:G.exec(a),!e||!e[1]&&b)return!b||b.jquery?(b||c).find(a):this.constructor(b).find(a);if(e[1]){if(b=b instanceof r?b[0]:b,r.merge(this,r.parseHTML(e[1],b&&b.nodeType?b.ownerDocument||b:d,!0)),C.test(e[1])&&r.isPlainObject(b))for(e in b)r.isFunction(this[e])?this[e](b[e]):this.attr(e,b[e]);return this}return f=d.getElementById(e[2]),f&&(this[0]=f,this.length=1),this}return a.nodeType?(this[0]=a,this.length=1,this):r.isFunction(a)?void 0!==c.ready?c.ready(a):a(r):r.makeArray(a,this)};H.prototype=r.fn,F=r(d);var I=/^(?:parents|prev(?:Until|All))/,J={children:!0,contents:!0,next:!0,prev:!0};r.fn.extend({has:function(a){var b=r(a,this),c=b.length;return this.filter(function(){for(var a=0;a<c;a++)if(r.contains(this,b[a]))return!0})},closest:function(a,b){var c,d=0,e=this.length,f=[],g="string"!=typeof a&&r(a);if(!A.test(a))for(;d<e;d++)for(c=this[d];c&&c!==b;c=c.parentNode)if(c.nodeType<11&&(g?g.index(c)>-1:1===c.nodeType&&r.find.matchesSelector(c,a))){f.push(c);break}return this.pushStack(f.length>1?r.uniqueSort(f):f)},index:function(a){return a?"string"==typeof a?i.call(r(a),this[0]):i.call(this,a.jquery?a[0]:a):this[0]&&this[0].parentNode?this.first().prevAll().length:-1},add:function(a,b){return this.pushStack(r.uniqueSort(r.merge(this.get(),r(a,b))))},addBack:function(a){return this.add(null==a?this.prevObject:this.prevObject.filter(a))}});function K(a,b){while((a=a[b])&&1!==a.nodeType);return a}r.each({parent:function(a){var b=a.parentNode;return b&&11!==b.nodeType?b:null},parents:function(a){return y(a,"parentNode")},parentsUntil:function(a,b,c){return y(a,"parentNode",c)},next:function(a){return K(a,"nextSibling")},prev:function(a){return K(a,"previousSibling")},nextAll:function(a){return y(a,"nextSibling")},prevAll:function(a){return y(a,"previousSibling")},nextUntil:function(a,b,c){return y(a,"nextSibling",c)},prevUntil:function(a,b,c){return y(a,"previousSibling",c)},siblings:function(a){return z((a.parentNode||{}).firstChild,a)},children:function(a){return z(a.firstChild)},contents:function(a){return B(a,"iframe")?a.contentDocument:(B(a,"template")&&(a=a.content||a),r.merge([],a.childNodes))}},function(a,b){r.fn[a]=function(c,d){var e=r.map(this,b,c);return"Until"!==a.slice(-5)&&(d=c),d&&"string"==typeof d&&(e=r.filter(d,e)),this.length>1&&(J[a]||r.uniqueSort(e),I.test(a)&&e.reverse()),this.pushStack(e)}});var L=/[^\x20\t\r\n\f]+/g;function M(a){var b={};return r.each(a.match(L)||[],function(a,c){b[c]=!0}),b}r.Callbacks=function(a){a="string"==typeof a?M(a):r.extend({},a);var b,c,d,e,f=[],g=[],h=-1,i=function(){for(e=e||a.once,d=b=!0;g.length;h=-1){c=g.shift();while(++h<f.length)f[h].apply(c[0],c[1])===!1&&a.stopOnFalse&&(h=f.length,c=!1)}a.memory||(c=!1),b=!1,e&&(f=c?[]:"")},j={add:function(){return f&&(c&&!b&&(h=f.length-1,g.push(c)),function d(b){r.each(b,function(b,c){r.isFunction(c)?a.unique&&j.has(c)||f.push(c):c&&c.length&&"string"!==r.type(c)&&d(c)})}(arguments),c&&!b&&i()),this},remove:function(){return r.each(arguments,function(a,b){var c;while((c=r.inArray(b,f,c))>-1)f.splice(c,1),c<=h&&h--}),this},has:function(a){return a?r.inArray(a,f)>-1:f.length>0},empty:function(){return f&&(f=[]),this},disable:function(){return e=g=[],f=c="",this},disabled:function(){return!f},lock:function(){return e=g=[],c||b||(f=c=""),this},locked:function(){return!!e},fireWith:function(a,c){return e||(c=c||[],c=[a,c.slice?c.slice():c],g.push(c),b||i()),this},fire:function(){return j.fireWith(this,arguments),this},fired:function(){return!!d}};return j};function N(a){return a}function O(a){throw a}function P(a,b,c,d){var e;try{a&&r.isFunction(e=a.promise)?e.call(a).done(b).fail(c):a&&r.isFunction(e=a.then)?e.call(a,b,c):b.apply(void 0,[a].slice(d))}catch(a){c.apply(void 0,[a])}}r.extend({Deferred:function(b){var c=[["notify","progress",r.Callbacks("memory"),r.Callbacks("memory"),2],["resolve","done",r.Callbacks("once memory"),r.Callbacks("once memory"),0,"resolved"],["reject","fail",r.Callbacks("once memory"),r.Callbacks("once memory"),1,"rejected"]],d="pending",e={state:function(){return d},always:function(){return f.done(arguments).fail(arguments),this},"catch":function(a){return e.then(null,a)},pipe:function(){var a=arguments;return r.Deferred(function(b){r.each(c,function(c,d){var e=r.isFunction(a[d[4]])&&a[d[4]];f[d[1]](function(){var a=e&&e.apply(this,arguments);a&&r.isFunction(a.promise)?a.promise().progress(b.notify).done(b.resolve).fail(b.reject):b[d[0]+"With"](this,e?[a]:arguments)})}),a=null}).promise()},then:function(b,d,e){var f=0;function g(b,c,d,e){return function(){var h=this,i=arguments,j=function(){var a,j;if(!(b<f)){if(a=d.apply(h,i),a===c.promise())throw new TypeError("Thenable self-resolution");j=a&&("object"==typeof a||"function"==typeof a)&&a.then,r.isFunction(j)?e?j.call(a,g(f,c,N,e),g(f,c,O,e)):(f++,j.call(a,g(f,c,N,e),g(f,c,O,e),g(f,c,N,c.notifyWith))):(d!==N&&(h=void 0,i=[a]),(e||c.resolveWith)(h,i))}},k=e?j:function(){try{j()}catch(a){r.Deferred.exceptionHook&&r.Deferred.exceptionHook(a,k.stackTrace),b+1>=f&&(d!==O&&(h=void 0,i=[a]),c.rejectWith(h,i))}};b?k():(r.Deferred.getStackHook&&(k.stackTrace=r.Deferred.getStackHook()),a.setTimeout(k))}}return r.Deferred(function(a){c[0][3].add(g(0,a,r.isFunction(e)?e:N,a.notifyWith)),c[1][3].add(g(0,a,r.isFunction(b)?b:N)),c[2][3].add(g(0,a,r.isFunction(d)?d:O))}).promise()},promise:function(a){return null!=a?r.extend(a,e):e}},f={};return r.each(c,function(a,b){var g=b[2],h=b[5];e[b[1]]=g.add,h&&g.add(function(){d=h},c[3-a][2].disable,c[0][2].lock),g.add(b[3].fire),f[b[0]]=function(){return f[b[0]+"With"](this===f?void 0:this,arguments),this},f[b[0]+"With"]=g.fireWith}),e.promise(f),b&&b.call(f,f),f},when:function(a){var b=arguments.length,c=b,d=Array(c),e=f.call(arguments),g=r.Deferred(),h=function(a){return function(c){d[a]=this,e[a]=arguments.length>1?f.call(arguments):c,--b||g.resolveWith(d,e)}};if(b<=1&&(P(a,g.done(h(c)).resolve,g.reject,!b),"pending"===g.state()||r.isFunction(e[c]&&e[c].then)))return g.then();while(c--)P(e[c],h(c),g.reject);return g.promise()}});var Q=/^(Eval|Internal|Range|Reference|Syntax|Type|URI)Error$/;r.Deferred.exceptionHook=function(b,c){a.console&&a.console.warn&&b&&Q.test(b.name)&&a.console.warn("jQuery.Deferred exception: "+b.message,b.stack,c)},r.readyException=function(b){a.setTimeout(function(){throw b})};var R=r.Deferred();r.fn.ready=function(a){return R.then(a)["catch"](function(a){r.readyException(a)}),this},r.extend({isReady:!1,readyWait:1,ready:function(a){(a===!0?--r.readyWait:r.isReady)||(r.isReady=!0,a!==!0&&--r.readyWait>0||R.resolveWith(d,[r]))}}),r.ready.then=R.then;function S(){d.removeEventListener("DOMContentLoaded",S),
+a.removeEventListener("load",S),r.ready()}"complete"===d.readyState||"loading"!==d.readyState&&!d.documentElement.doScroll?a.setTimeout(r.ready):(d.addEventListener("DOMContentLoaded",S),a.addEventListener("load",S));var T=function(a,b,c,d,e,f,g){var h=0,i=a.length,j=null==c;if("object"===r.type(c)){e=!0;for(h in c)T(a,b,h,c[h],!0,f,g)}else if(void 0!==d&&(e=!0,r.isFunction(d)||(g=!0),j&&(g?(b.call(a,d),b=null):(j=b,b=function(a,b,c){return j.call(r(a),c)})),b))for(;h<i;h++)b(a[h],c,g?d:d.call(a[h],h,b(a[h],c)));return e?a:j?b.call(a):i?b(a[0],c):f},U=function(a){return 1===a.nodeType||9===a.nodeType||!+a.nodeType};function V(){this.expando=r.expando+V.uid++}V.uid=1,V.prototype={cache:function(a){var b=a[this.expando];return b||(b={},U(a)&&(a.nodeType?a[this.expando]=b:Object.defineProperty(a,this.expando,{value:b,configurable:!0}))),b},set:function(a,b,c){var d,e=this.cache(a);if("string"==typeof b)e[r.camelCase(b)]=c;else for(d in b)e[r.camelCase(d)]=b[d];return e},get:function(a,b){return void 0===b?this.cache(a):a[this.expando]&&a[this.expando][r.camelCase(b)]},access:function(a,b,c){return void 0===b||b&&"string"==typeof b&&void 0===c?this.get(a,b):(this.set(a,b,c),void 0!==c?c:b)},remove:function(a,b){var c,d=a[this.expando];if(void 0!==d){if(void 0!==b){Array.isArray(b)?b=b.map(r.camelCase):(b=r.camelCase(b),b=b in d?[b]:b.match(L)||[]),c=b.length;while(c--)delete d[b[c]]}(void 0===b||r.isEmptyObject(d))&&(a.nodeType?a[this.expando]=void 0:delete a[this.expando])}},hasData:function(a){var b=a[this.expando];return void 0!==b&&!r.isEmptyObject(b)}};var W=new V,X=new V,Y=/^(?:\{[\w\W]*\}|\[[\w\W]*\])$/,Z=/[A-Z]/g;function $(a){return"true"===a||"false"!==a&&("null"===a?null:a===+a+""?+a:Y.test(a)?JSON.parse(a):a)}function _(a,b,c){var d;if(void 0===c&&1===a.nodeType)if(d="data-"+b.replace(Z,"-$&").toLowerCase(),c=a.getAttribute(d),"string"==typeof c){try{c=$(c)}catch(e){}X.set(a,b,c)}else c=void 0;return c}r.extend({hasData:function(a){return X.hasData(a)||W.hasData(a)},data:function(a,b,c){return X.access(a,b,c)},removeData:function(a,b){X.remove(a,b)},_data:function(a,b,c){return W.access(a,b,c)},_removeData:function(a,b){W.remove(a,b)}}),r.fn.extend({data:function(a,b){var c,d,e,f=this[0],g=f&&f.attributes;if(void 0===a){if(this.length&&(e=X.get(f),1===f.nodeType&&!W.get(f,"hasDataAttrs"))){c=g.length;while(c--)g[c]&&(d=g[c].name,0===d.indexOf("data-")&&(d=r.camelCase(d.slice(5)),_(f,d,e[d])));W.set(f,"hasDataAttrs",!0)}return e}return"object"==typeof a?this.each(function(){X.set(this,a)}):T(this,function(b){var c;if(f&&void 0===b){if(c=X.get(f,a),void 0!==c)return c;if(c=_(f,a),void 0!==c)return c}else this.each(function(){X.set(this,a,b)})},null,b,arguments.length>1,null,!0)},removeData:function(a){return this.each(function(){X.remove(this,a)})}}),r.extend({queue:function(a,b,c){var d;if(a)return b=(b||"fx")+"queue",d=W.get(a,b),c&&(!d||Array.isArray(c)?d=W.access(a,b,r.makeArray(c)):d.push(c)),d||[]},dequeue:function(a,b){b=b||"fx";var c=r.queue(a,b),d=c.length,e=c.shift(),f=r._queueHooks(a,b),g=function(){r.dequeue(a,b)};"inprogress"===e&&(e=c.shift(),d--),e&&("fx"===b&&c.unshift("inprogress"),delete f.stop,e.call(a,g,f)),!d&&f&&f.empty.fire()},_queueHooks:function(a,b){var c=b+"queueHooks";return W.get(a,c)||W.access(a,c,{empty:r.Callbacks("once memory").add(function(){W.remove(a,[b+"queue",c])})})}}),r.fn.extend({queue:function(a,b){var c=2;return"string"!=typeof a&&(b=a,a="fx",c--),arguments.length<c?r.queue(this[0],a):void 0===b?this:this.each(function(){var c=r.queue(this,a,b);r._queueHooks(this,a),"fx"===a&&"inprogress"!==c[0]&&r.dequeue(this,a)})},dequeue:function(a){return this.each(function(){r.dequeue(this,a)})},clearQueue:function(a){return this.queue(a||"fx",[])},promise:function(a,b){var c,d=1,e=r.Deferred(),f=this,g=this.length,h=function(){--d||e.resolveWith(f,[f])};"string"!=typeof a&&(b=a,a=void 0),a=a||"fx";while(g--)c=W.get(f[g],a+"queueHooks"),c&&c.empty&&(d++,c.empty.add(h));return h(),e.promise(b)}});var aa=/[+-]?(?:\d*\.|)\d+(?:[eE][+-]?\d+|)/.source,ba=new RegExp("^(?:([+-])=|)("+aa+")([a-z%]*)$","i"),ca=["Top","Right","Bottom","Left"],da=function(a,b){return a=b||a,"none"===a.style.display||""===a.style.display&&r.contains(a.ownerDocument,a)&&"none"===r.css(a,"display")},ea=function(a,b,c,d){var e,f,g={};for(f in b)g[f]=a.style[f],a.style[f]=b[f];e=c.apply(a,d||[]);for(f in b)a.style[f]=g[f];return e};function fa(a,b,c,d){var e,f=1,g=20,h=d?function(){return d.cur()}:function(){return r.css(a,b,"")},i=h(),j=c&&c[3]||(r.cssNumber[b]?"":"px"),k=(r.cssNumber[b]||"px"!==j&&+i)&&ba.exec(r.css(a,b));if(k&&k[3]!==j){j=j||k[3],c=c||[],k=+i||1;do f=f||".5",k/=f,r.style(a,b,k+j);while(f!==(f=h()/i)&&1!==f&&--g)}return c&&(k=+k||+i||0,e=c[1]?k+(c[1]+1)*c[2]:+c[2],d&&(d.unit=j,d.start=k,d.end=e)),e}var ga={};function ha(a){var b,c=a.ownerDocument,d=a.nodeName,e=ga[d];return e?e:(b=c.body.appendChild(c.createElement(d)),e=r.css(b,"display"),b.parentNode.removeChild(b),"none"===e&&(e="block"),ga[d]=e,e)}function ia(a,b){for(var c,d,e=[],f=0,g=a.length;f<g;f++)d=a[f],d.style&&(c=d.style.display,b?("none"===c&&(e[f]=W.get(d,"display")||null,e[f]||(d.style.display="")),""===d.style.display&&da(d)&&(e[f]=ha(d))):"none"!==c&&(e[f]="none",W.set(d,"display",c)));for(f=0;f<g;f++)null!=e[f]&&(a[f].style.display=e[f]);return a}r.fn.extend({show:function(){return ia(this,!0)},hide:function(){return ia(this)},toggle:function(a){return"boolean"==typeof a?a?this.show():this.hide():this.each(function(){da(this)?r(this).show():r(this).hide()})}});var ja=/^(?:checkbox|radio)$/i,ka=/<([a-z][^\/\0>\x20\t\r\n\f]+)/i,la=/^$|\/(?:java|ecma)script/i,ma={option:[1,"<select multiple='multiple'>","</select>"],thead:[1,"<table>","</table>"],col:[2,"<table><colgroup>","</colgroup></table>"],tr:[2,"<table><tbody>","</tbody></table>"],td:[3,"<table><tbody><tr>","</tr></tbody></table>"],_default:[0,"",""]};ma.optgroup=ma.option,ma.tbody=ma.tfoot=ma.colgroup=ma.caption=ma.thead,ma.th=ma.td;function na(a,b){var c;return c="undefined"!=typeof a.getElementsByTagName?a.getElementsByTagName(b||"*"):"undefined"!=typeof a.querySelectorAll?a.querySelectorAll(b||"*"):[],void 0===b||b&&B(a,b)?r.merge([a],c):c}function oa(a,b){for(var c=0,d=a.length;c<d;c++)W.set(a[c],"globalEval",!b||W.get(b[c],"globalEval"))}var pa=/<|&#?\w+;/;function qa(a,b,c,d,e){for(var f,g,h,i,j,k,l=b.createDocumentFragment(),m=[],n=0,o=a.length;n<o;n++)if(f=a[n],f||0===f)if("object"===r.type(f))r.merge(m,f.nodeType?[f]:f);else if(pa.test(f)){g=g||l.appendChild(b.createElement("div")),h=(ka.exec(f)||["",""])[1].toLowerCase(),i=ma[h]||ma._default,g.innerHTML=i[1]+r.htmlPrefilter(f)+i[2],k=i[0];while(k--)g=g.lastChild;r.merge(m,g.childNodes),g=l.firstChild,g.textContent=""}else m.push(b.createTextNode(f));l.textContent="",n=0;while(f=m[n++])if(d&&r.inArray(f,d)>-1)e&&e.push(f);else if(j=r.contains(f.ownerDocument,f),g=na(l.appendChild(f),"script"),j&&oa(g),c){k=0;while(f=g[k++])la.test(f.type||"")&&c.push(f)}return l}!function(){var a=d.createDocumentFragment(),b=a.appendChild(d.createElement("div")),c=d.createElement("input");c.setAttribute("type","radio"),c.setAttribute("checked","checked"),c.setAttribute("name","t"),b.appendChild(c),o.checkClone=b.cloneNode(!0).cloneNode(!0).lastChild.checked,b.innerHTML="<textarea>x</textarea>",o.noCloneChecked=!!b.cloneNode(!0).lastChild.defaultValue}();var ra=d.documentElement,sa=/^key/,ta=/^(?:mouse|pointer|contextmenu|drag|drop)|click/,ua=/^([^.]*)(?:\.(.+)|)/;function va(){return!0}function wa(){return!1}function xa(){try{return d.activeElement}catch(a){}}function ya(a,b,c,d,e,f){var g,h;if("object"==typeof b){"string"!=typeof c&&(d=d||c,c=void 0);for(h in b)ya(a,h,c,d,b[h],f);return a}if(null==d&&null==e?(e=c,d=c=void 0):null==e&&("string"==typeof c?(e=d,d=void 0):(e=d,d=c,c=void 0)),e===!1)e=wa;else if(!e)return a;return 1===f&&(g=e,e=function(a){return r().off(a),g.apply(this,arguments)},e.guid=g.guid||(g.guid=r.guid++)),a.each(function(){r.event.add(this,b,e,d,c)})}r.event={global:{},add:function(a,b,c,d,e){var f,g,h,i,j,k,l,m,n,o,p,q=W.get(a);if(q){c.handler&&(f=c,c=f.handler,e=f.selector),e&&r.find.matchesSelector(ra,e),c.guid||(c.guid=r.guid++),(i=q.events)||(i=q.events={}),(g=q.handle)||(g=q.handle=function(b){return"undefined"!=typeof r&&r.event.triggered!==b.type?r.event.dispatch.apply(a,arguments):void 0}),b=(b||"").match(L)||[""],j=b.length;while(j--)h=ua.exec(b[j])||[],n=p=h[1],o=(h[2]||"").split(".").sort(),n&&(l=r.event.special[n]||{},n=(e?l.delegateType:l.bindType)||n,l=r.event.special[n]||{},k=r.extend({type:n,origType:p,data:d,handler:c,guid:c.guid,selector:e,needsContext:e&&r.expr.match.needsContext.test(e),namespace:o.join(".")},f),(m=i[n])||(m=i[n]=[],m.delegateCount=0,l.setup&&l.setup.call(a,d,o,g)!==!1||a.addEventListener&&a.addEventListener(n,g)),l.add&&(l.add.call(a,k),k.handler.guid||(k.handler.guid=c.guid)),e?m.splice(m.delegateCount++,0,k):m.push(k),r.event.global[n]=!0)}},remove:function(a,b,c,d,e){var f,g,h,i,j,k,l,m,n,o,p,q=W.hasData(a)&&W.get(a);if(q&&(i=q.events)){b=(b||"").match(L)||[""],j=b.length;while(j--)if(h=ua.exec(b[j])||[],n=p=h[1],o=(h[2]||"").split(".").sort(),n){l=r.event.special[n]||{},n=(d?l.delegateType:l.bindType)||n,m=i[n]||[],h=h[2]&&new RegExp("(^|\\.)"+o.join("\\.(?:.*\\.|)")+"(\\.|$)"),g=f=m.length;while(f--)k=m[f],!e&&p!==k.origType||c&&c.guid!==k.guid||h&&!h.test(k.namespace)||d&&d!==k.selector&&("**"!==d||!k.selector)||(m.splice(f,1),k.selector&&m.delegateCount--,l.remove&&l.remove.call(a,k));g&&!m.length&&(l.teardown&&l.teardown.call(a,o,q.handle)!==!1||r.removeEvent(a,n,q.handle),delete i[n])}else for(n in i)r.event.remove(a,n+b[j],c,d,!0);r.isEmptyObject(i)&&W.remove(a,"handle events")}},dispatch:function(a){var b=r.event.fix(a),c,d,e,f,g,h,i=new Array(arguments.length),j=(W.get(this,"events")||{})[b.type]||[],k=r.event.special[b.type]||{};for(i[0]=b,c=1;c<arguments.length;c++)i[c]=arguments[c];if(b.delegateTarget=this,!k.preDispatch||k.preDispatch.call(this,b)!==!1){h=r.event.handlers.call(this,b,j),c=0;while((f=h[c++])&&!b.isPropagationStopped()){b.currentTarget=f.elem,d=0;while((g=f.handlers[d++])&&!b.isImmediatePropagationStopped())b.rnamespace&&!b.rnamespace.test(g.namespace)||(b.handleObj=g,b.data=g.data,e=((r.event.special[g.origType]||{}).handle||g.handler).apply(f.elem,i),void 0!==e&&(b.result=e)===!1&&(b.preventDefault(),b.stopPropagation()))}return k.postDispatch&&k.postDispatch.call(this,b),b.result}},handlers:function(a,b){var c,d,e,f,g,h=[],i=b.delegateCount,j=a.target;if(i&&j.nodeType&&!("click"===a.type&&a.button>=1))for(;j!==this;j=j.parentNode||this)if(1===j.nodeType&&("click"!==a.type||j.disabled!==!0)){for(f=[],g={},c=0;c<i;c++)d=b[c],e=d.selector+" ",void 0===g[e]&&(g[e]=d.needsContext?r(e,this).index(j)>-1:r.find(e,this,null,[j]).length),g[e]&&f.push(d);f.length&&h.push({elem:j,handlers:f})}return j=this,i<b.length&&h.push({elem:j,handlers:b.slice(i)}),h},addProp:function(a,b){Object.defineProperty(r.Event.prototype,a,{enumerable:!0,configurable:!0,get:r.isFunction(b)?function(){if(this.originalEvent)return b(this.originalEvent)}:function(){if(this.originalEvent)return this.originalEvent[a]},set:function(b){Object.defineProperty(this,a,{enumerable:!0,configurable:!0,writable:!0,value:b})}})},fix:function(a){return a[r.expando]?a:new r.Event(a)},special:{load:{noBubble:!0},focus:{trigger:function(){if(this!==xa()&&this.focus)return this.focus(),!1},delegateType:"focusin"},blur:{trigger:function(){if(this===xa()&&this.blur)return this.blur(),!1},delegateType:"focusout"},click:{trigger:function(){if("checkbox"===this.type&&this.click&&B(this,"input"))return this.click(),!1},_default:function(a){return B(a.target,"a")}},beforeunload:{postDispatch:function(a){void 0!==a.result&&a.originalEvent&&(a.originalEvent.returnValue=a.result)}}}},r.removeEvent=function(a,b,c){a.removeEventListener&&a.removeEventListener(b,c)},r.Event=function(a,b){return this instanceof r.Event?(a&&a.type?(this.originalEvent=a,this.type=a.type,this.isDefaultPrevented=a.defaultPrevented||void 0===a.defaultPrevented&&a.returnValue===!1?va:wa,this.target=a.target&&3===a.target.nodeType?a.target.parentNode:a.target,this.currentTarget=a.currentTarget,this.relatedTarget=a.relatedTarget):this.type=a,b&&r.extend(this,b),this.timeStamp=a&&a.timeStamp||r.now(),void(this[r.expando]=!0)):new r.Event(a,b)},r.Event.prototype={constructor:r.Event,isDefaultPrevented:wa,isPropagationStopped:wa,isImmediatePropagationStopped:wa,isSimulated:!1,preventDefault:function(){var a=this.originalEvent;this.isDefaultPrevented=va,a&&!this.isSimulated&&a.preventDefault()},stopPropagation:function(){var a=this.originalEvent;this.isPropagationStopped=va,a&&!this.isSimulated&&a.stopPropagation()},stopImmediatePropagation:function(){var a=this.originalEvent;this.isImmediatePropagationStopped=va,a&&!this.isSimulated&&a.stopImmediatePropagation(),this.stopPropagation()}},r.each({altKey:!0,bubbles:!0,cancelable:!0,changedTouches:!0,ctrlKey:!0,detail:!0,eventPhase:!0,metaKey:!0,pageX:!0,pageY:!0,shiftKey:!0,view:!0,"char":!0,charCode:!0,key:!0,keyCode:!0,button:!0,buttons:!0,clientX:!0,clientY:!0,offsetX:!0,offsetY:!0,pointerId:!0,pointerType:!0,screenX:!0,screenY:!0,targetTouches:!0,toElement:!0,touches:!0,which:function(a){var b=a.button;return null==a.which&&sa.test(a.type)?null!=a.charCode?a.charCode:a.keyCode:!a.which&&void 0!==b&&ta.test(a.type)?1&b?1:2&b?3:4&b?2:0:a.which}},r.event.addProp),r.each({mouseenter:"mouseover",mouseleave:"mouseout",pointerenter:"pointerover",pointerleave:"pointerout"},function(a,b){r.event.special[a]={delegateType:b,bindType:b,handle:function(a){var c,d=this,e=a.relatedTarget,f=a.handleObj;return e&&(e===d||r.contains(d,e))||(a.type=f.origType,c=f.handler.apply(this,arguments),a.type=b),c}}}),r.fn.extend({on:function(a,b,c,d){return ya(this,a,b,c,d)},one:function(a,b,c,d){return ya(this,a,b,c,d,1)},off:function(a,b,c){var d,e;if(a&&a.preventDefault&&a.handleObj)return d=a.handleObj,r(a.delegateTarget).off(d.namespace?d.origType+"."+d.namespace:d.origType,d.selector,d.handler),this;if("object"==typeof a){for(e in a)this.off(e,b,a[e]);return this}return b!==!1&&"function"!=typeof b||(c=b,b=void 0),c===!1&&(c=wa),this.each(function(){r.event.remove(this,a,c,b)})}});var za=/<(?!area|br|col|embed|hr|img|input|link|meta|param)(([a-z][^\/\0>\x20\t\r\n\f]*)[^>]*)\/>/gi,Aa=/<script|<style|<link/i,Ba=/checked\s*(?:[^=]|=\s*.checked.)/i,Ca=/^true\/(.*)/,Da=/^\s*<!(?:\[CDATA\[|--)|(?:\]\]|--)>\s*$/g;function Ea(a,b){return B(a,"table")&&B(11!==b.nodeType?b:b.firstChild,"tr")?r(">tbody",a)[0]||a:a}function Fa(a){return a.type=(null!==a.getAttribute("type"))+"/"+a.type,a}function Ga(a){var b=Ca.exec(a.type);return b?a.type=b[1]:a.removeAttribute("type"),a}function Ha(a,b){var c,d,e,f,g,h,i,j;if(1===b.nodeType){if(W.hasData(a)&&(f=W.access(a),g=W.set(b,f),j=f.events)){delete g.handle,g.events={};for(e in j)for(c=0,d=j[e].length;c<d;c++)r.event.add(b,e,j[e][c])}X.hasData(a)&&(h=X.access(a),i=r.extend({},h),X.set(b,i))}}function Ia(a,b){var c=b.nodeName.toLowerCase();"input"===c&&ja.test(a.type)?b.checked=a.checked:"input"!==c&&"textarea"!==c||(b.defaultValue=a.defaultValue)}function Ja(a,b,c,d){b=g.apply([],b);var e,f,h,i,j,k,l=0,m=a.length,n=m-1,q=b[0],s=r.isFunction(q);if(s||m>1&&"string"==typeof q&&!o.checkClone&&Ba.test(q))return a.each(function(e){var f=a.eq(e);s&&(b[0]=q.call(this,e,f.html())),Ja(f,b,c,d)});if(m&&(e=qa(b,a[0].ownerDocument,!1,a,d),f=e.firstChild,1===e.childNodes.length&&(e=f),f||d)){for(h=r.map(na(e,"script"),Fa),i=h.length;l<m;l++)j=e,l!==n&&(j=r.clone(j,!0,!0),i&&r.merge(h,na(j,"script"))),c.call(a[l],j,l);if(i)for(k=h[h.length-1].ownerDocument,r.map(h,Ga),l=0;l<i;l++)j=h[l],la.test(j.type||"")&&!W.access(j,"globalEval")&&r.contains(k,j)&&(j.src?r._evalUrl&&r._evalUrl(j.src):p(j.textContent.replace(Da,""),k))}return a}function Ka(a,b,c){for(var d,e=b?r.filter(b,a):a,f=0;null!=(d=e[f]);f++)c||1!==d.nodeType||r.cleanData(na(d)),d.parentNode&&(c&&r.contains(d.ownerDocument,d)&&oa(na(d,"script")),d.parentNode.removeChild(d));return a}r.extend({htmlPrefilter:function(a){return a.replace(za,"<$1></$2>")},clone:function(a,b,c){var d,e,f,g,h=a.cloneNode(!0),i=r.contains(a.ownerDocument,a);if(!(o.noCloneChecked||1!==a.nodeType&&11!==a.nodeType||r.isXMLDoc(a)))for(g=na(h),f=na(a),d=0,e=f.length;d<e;d++)Ia(f[d],g[d]);if(b)if(c)for(f=f||na(a),g=g||na(h),d=0,e=f.length;d<e;d++)Ha(f[d],g[d]);else Ha(a,h);return g=na(h,"script"),g.length>0&&oa(g,!i&&na(a,"script")),h},cleanData:function(a){for(var b,c,d,e=r.event.special,f=0;void 0!==(c=a[f]);f++)if(U(c)){if(b=c[W.expando]){if(b.events)for(d in b.events)e[d]?r.event.remove(c,d):r.removeEvent(c,d,b.handle);c[W.expando]=void 0}c[X.expando]&&(c[X.expando]=void 0)}}}),r.fn.extend({detach:function(a){return Ka(this,a,!0)},remove:function(a){return Ka(this,a)},text:function(a){return T(this,function(a){return void 0===a?r.text(this):this.empty().each(function(){1!==this.nodeType&&11!==this.nodeType&&9!==this.nodeType||(this.textContent=a)})},null,a,arguments.length)},append:function(){return Ja(this,arguments,function(a){if(1===this.nodeType||11===this.nodeType||9===this.nodeType){var b=Ea(this,a);b.appendChild(a)}})},prepend:function(){return Ja(this,arguments,function(a){if(1===this.nodeType||11===this.nodeType||9===this.nodeType){var b=Ea(this,a);b.insertBefore(a,b.firstChild)}})},before:function(){return Ja(this,arguments,function(a){this.parentNode&&this.parentNode.insertBefore(a,this)})},after:function(){return Ja(this,arguments,function(a){this.parentNode&&this.parentNode.insertBefore(a,this.nextSibling)})},empty:function(){for(var a,b=0;null!=(a=this[b]);b++)1===a.nodeType&&(r.cleanData(na(a,!1)),a.textContent="");return this},clone:function(a,b){return a=null!=a&&a,b=null==b?a:b,this.map(function(){return r.clone(this,a,b)})},html:function(a){return T(this,function(a){var b=this[0]||{},c=0,d=this.length;if(void 0===a&&1===b.nodeType)return b.innerHTML;if("string"==typeof a&&!Aa.test(a)&&!ma[(ka.exec(a)||["",""])[1].toLowerCase()]){a=r.htmlPrefilter(a);try{for(;c<d;c++)b=this[c]||{},1===b.nodeType&&(r.cleanData(na(b,!1)),b.innerHTML=a);b=0}catch(e){}}b&&this.empty().append(a)},null,a,arguments.length)},replaceWith:function(){var a=[];return Ja(this,arguments,function(b){var c=this.parentNode;r.inArray(this,a)<0&&(r.cleanData(na(this)),c&&c.replaceChild(b,this))},a)}}),r.each({appendTo:"append",prependTo:"prepend",insertBefore:"before",insertAfter:"after",replaceAll:"replaceWith"},function(a,b){r.fn[a]=function(a){for(var c,d=[],e=r(a),f=e.length-1,g=0;g<=f;g++)c=g===f?this:this.clone(!0),r(e[g])[b](c),h.apply(d,c.get());return this.pushStack(d)}});var La=/^margin/,Ma=new RegExp("^("+aa+")(?!px)[a-z%]+$","i"),Na=function(b){var c=b.ownerDocument.defaultView;return c&&c.opener||(c=a),c.getComputedStyle(b)};!function(){function b(){if(i){i.style.cssText="box-sizing:border-box;position:relative;display:block;margin:auto;border:1px;padding:1px;top:1%;width:50%",i.innerHTML="",ra.appendChild(h);var b=a.getComputedStyle(i);c="1%"!==b.top,g="2px"===b.marginLeft,e="4px"===b.width,i.style.marginRight="50%",f="4px"===b.marginRight,ra.removeChild(h),i=null}}var c,e,f,g,h=d.createElement("div"),i=d.createElement("div");i.style&&(i.style.backgroundClip="content-box",i.cloneNode(!0).style.backgroundClip="",o.clearCloneStyle="content-box"===i.style.backgroundClip,h.style.cssText="border:0;width:8px;height:0;top:0;left:-9999px;padding:0;margin-top:1px;position:absolute",h.appendChild(i),r.extend(o,{pixelPosition:function(){return b(),c},boxSizingReliable:function(){return b(),e},pixelMarginRight:function(){return b(),f},reliableMarginLeft:function(){return b(),g}}))}();function Oa(a,b,c){var d,e,f,g,h=a.style;return c=c||Na(a),c&&(g=c.getPropertyValue(b)||c[b],""!==g||r.contains(a.ownerDocument,a)||(g=r.style(a,b)),!o.pixelMarginRight()&&Ma.test(g)&&La.test(b)&&(d=h.width,e=h.minWidth,f=h.maxWidth,h.minWidth=h.maxWidth=h.width=g,g=c.width,h.width=d,h.minWidth=e,h.maxWidth=f)),void 0!==g?g+"":g}function Pa(a,b){return{get:function(){return a()?void delete this.get:(this.get=b).apply(this,arguments)}}}var Qa=/^(none|table(?!-c[ea]).+)/,Ra=/^--/,Sa={position:"absolute",visibility:"hidden",display:"block"},Ta={letterSpacing:"0",fontWeight:"400"},Ua=["Webkit","Moz","ms"],Va=d.createElement("div").style;function Wa(a){if(a in Va)return a;var b=a[0].toUpperCase()+a.slice(1),c=Ua.length;while(c--)if(a=Ua[c]+b,a in Va)return a}function Xa(a){var b=r.cssProps[a];return b||(b=r.cssProps[a]=Wa(a)||a),b}function Ya(a,b,c){var d=ba.exec(b);return d?Math.max(0,d[2]-(c||0))+(d[3]||"px"):b}function Za(a,b,c,d,e){var f,g=0;for(f=c===(d?"border":"content")?4:"width"===b?1:0;f<4;f+=2)"margin"===c&&(g+=r.css(a,c+ca[f],!0,e)),d?("content"===c&&(g-=r.css(a,"padding"+ca[f],!0,e)),"margin"!==c&&(g-=r.css(a,"border"+ca[f]+"Width",!0,e))):(g+=r.css(a,"padding"+ca[f],!0,e),"padding"!==c&&(g+=r.css(a,"border"+ca[f]+"Width",!0,e)));return g}function $a(a,b,c){var d,e=Na(a),f=Oa(a,b,e),g="border-box"===r.css(a,"boxSizing",!1,e);return Ma.test(f)?f:(d=g&&(o.boxSizingReliable()||f===a.style[b]),"auto"===f&&(f=a["offset"+b[0].toUpperCase()+b.slice(1)]),f=parseFloat(f)||0,f+Za(a,b,c||(g?"border":"content"),d,e)+"px")}r.extend({cssHooks:{opacity:{get:function(a,b){if(b){var c=Oa(a,"opacity");return""===c?"1":c}}}},cssNumber:{animationIterationCount:!0,columnCount:!0,fillOpacity:!0,flexGrow:!0,flexShrink:!0,fontWeight:!0,lineHeight:!0,opacity:!0,order:!0,orphans:!0,widows:!0,zIndex:!0,zoom:!0},cssProps:{"float":"cssFloat"},style:function(a,b,c,d){if(a&&3!==a.nodeType&&8!==a.nodeType&&a.style){var e,f,g,h=r.camelCase(b),i=Ra.test(b),j=a.style;return i||(b=Xa(h)),g=r.cssHooks[b]||r.cssHooks[h],void 0===c?g&&"get"in g&&void 0!==(e=g.get(a,!1,d))?e:j[b]:(f=typeof c,"string"===f&&(e=ba.exec(c))&&e[1]&&(c=fa(a,b,e),f="number"),null!=c&&c===c&&("number"===f&&(c+=e&&e[3]||(r.cssNumber[h]?"":"px")),o.clearCloneStyle||""!==c||0!==b.indexOf("background")||(j[b]="inherit"),g&&"set"in g&&void 0===(c=g.set(a,c,d))||(i?j.setProperty(b,c):j[b]=c)),void 0)}},css:function(a,b,c,d){var e,f,g,h=r.camelCase(b),i=Ra.test(b);return i||(b=Xa(h)),g=r.cssHooks[b]||r.cssHooks[h],g&&"get"in g&&(e=g.get(a,!0,c)),void 0===e&&(e=Oa(a,b,d)),"normal"===e&&b in Ta&&(e=Ta[b]),""===c||c?(f=parseFloat(e),c===!0||isFinite(f)?f||0:e):e}}),r.each(["height","width"],function(a,b){r.cssHooks[b]={get:function(a,c,d){if(c)return!Qa.test(r.css(a,"display"))||a.getClientRects().length&&a.getBoundingClientRect().width?$a(a,b,d):ea(a,Sa,function(){return $a(a,b,d)})},set:function(a,c,d){var e,f=d&&Na(a),g=d&&Za(a,b,d,"border-box"===r.css(a,"boxSizing",!1,f),f);return g&&(e=ba.exec(c))&&"px"!==(e[3]||"px")&&(a.style[b]=c,c=r.css(a,b)),Ya(a,c,g)}}}),r.cssHooks.marginLeft=Pa(o.reliableMarginLeft,function(a,b){if(b)return(parseFloat(Oa(a,"marginLeft"))||a.getBoundingClientRect().left-ea(a,{marginLeft:0},function(){return a.getBoundingClientRect().left}))+"px"}),r.each({margin:"",padding:"",border:"Width"},function(a,b){r.cssHooks[a+b]={expand:function(c){for(var d=0,e={},f="string"==typeof c?c.split(" "):[c];d<4;d++)e[a+ca[d]+b]=f[d]||f[d-2]||f[0];return e}},La.test(a)||(r.cssHooks[a+b].set=Ya)}),r.fn.extend({css:function(a,b){return T(this,function(a,b,c){var d,e,f={},g=0;if(Array.isArray(b)){for(d=Na(a),e=b.length;g<e;g++)f[b[g]]=r.css(a,b[g],!1,d);return f}return void 0!==c?r.style(a,b,c):r.css(a,b)},a,b,arguments.length>1)}});function _a(a,b,c,d,e){return new _a.prototype.init(a,b,c,d,e)}r.Tween=_a,_a.prototype={constructor:_a,init:function(a,b,c,d,e,f){this.elem=a,this.prop=c,this.easing=e||r.easing._default,this.options=b,this.start=this.now=this.cur(),this.end=d,this.unit=f||(r.cssNumber[c]?"":"px")},cur:function(){var a=_a.propHooks[this.prop];return a&&a.get?a.get(this):_a.propHooks._default.get(this)},run:function(a){var b,c=_a.propHooks[this.prop];return this.options.duration?this.pos=b=r.easing[this.easing](a,this.options.duration*a,0,1,this.options.duration):this.pos=b=a,this.now=(this.end-this.start)*b+this.start,this.options.step&&this.options.step.call(this.elem,this.now,this),c&&c.set?c.set(this):_a.propHooks._default.set(this),this}},_a.prototype.init.prototype=_a.prototype,_a.propHooks={_default:{get:function(a){var b;return 1!==a.elem.nodeType||null!=a.elem[a.prop]&&null==a.elem.style[a.prop]?a.elem[a.prop]:(b=r.css(a.elem,a.prop,""),b&&"auto"!==b?b:0)},set:function(a){r.fx.step[a.prop]?r.fx.step[a.prop](a):1!==a.elem.nodeType||null==a.elem.style[r.cssProps[a.prop]]&&!r.cssHooks[a.prop]?a.elem[a.prop]=a.now:r.style(a.elem,a.prop,a.now+a.unit)}}},_a.propHooks.scrollTop=_a.propHooks.scrollLeft={set:function(a){a.elem.nodeType&&a.elem.parentNode&&(a.elem[a.prop]=a.now)}},r.easing={linear:function(a){return a},swing:function(a){return.5-Math.cos(a*Math.PI)/2},_default:"swing"},r.fx=_a.prototype.init,r.fx.step={};var ab,bb,cb=/^(?:toggle|show|hide)$/,db=/queueHooks$/;function eb(){bb&&(d.hidden===!1&&a.requestAnimationFrame?a.requestAnimationFrame(eb):a.setTimeout(eb,r.fx.interval),r.fx.tick())}function fb(){return a.setTimeout(function(){ab=void 0}),ab=r.now()}function gb(a,b){var c,d=0,e={height:a};for(b=b?1:0;d<4;d+=2-b)c=ca[d],e["margin"+c]=e["padding"+c]=a;return b&&(e.opacity=e.width=a),e}function hb(a,b,c){for(var d,e=(kb.tweeners[b]||[]).concat(kb.tweeners["*"]),f=0,g=e.length;f<g;f++)if(d=e[f].call(c,b,a))return d}function ib(a,b,c){var d,e,f,g,h,i,j,k,l="width"in b||"height"in b,m=this,n={},o=a.style,p=a.nodeType&&da(a),q=W.get(a,"fxshow");c.queue||(g=r._queueHooks(a,"fx"),null==g.unqueued&&(g.unqueued=0,h=g.empty.fire,g.empty.fire=function(){g.unqueued||h()}),g.unqueued++,m.always(function(){m.always(function(){g.unqueued--,r.queue(a,"fx").length||g.empty.fire()})}));for(d in b)if(e=b[d],cb.test(e)){if(delete b[d],f=f||"toggle"===e,e===(p?"hide":"show")){if("show"!==e||!q||void 0===q[d])continue;p=!0}n[d]=q&&q[d]||r.style(a,d)}if(i=!r.isEmptyObject(b),i||!r.isEmptyObject(n)){l&&1===a.nodeType&&(c.overflow=[o.overflow,o.overflowX,o.overflowY],j=q&&q.display,null==j&&(j=W.get(a,"display")),k=r.css(a,"display"),"none"===k&&(j?k=j:(ia([a],!0),j=a.style.display||j,k=r.css(a,"display"),ia([a]))),("inline"===k||"inline-block"===k&&null!=j)&&"none"===r.css(a,"float")&&(i||(m.done(function(){o.display=j}),null==j&&(k=o.display,j="none"===k?"":k)),o.display="inline-block")),c.overflow&&(o.overflow="hidden",m.always(function(){o.overflow=c.overflow[0],o.overflowX=c.overflow[1],o.overflowY=c.overflow[2]})),i=!1;for(d in n)i||(q?"hidden"in q&&(p=q.hidden):q=W.access(a,"fxshow",{display:j}),f&&(q.hidden=!p),p&&ia([a],!0),m.done(function(){p||ia([a]),W.remove(a,"fxshow");for(d in n)r.style(a,d,n[d])})),i=hb(p?q[d]:0,d,m),d in q||(q[d]=i.start,p&&(i.end=i.start,i.start=0))}}function jb(a,b){var c,d,e,f,g;for(c in a)if(d=r.camelCase(c),e=b[d],f=a[c],Array.isArray(f)&&(e=f[1],f=a[c]=f[0]),c!==d&&(a[d]=f,delete a[c]),g=r.cssHooks[d],g&&"expand"in g){f=g.expand(f),delete a[d];for(c in f)c in a||(a[c]=f[c],b[c]=e)}else b[d]=e}function kb(a,b,c){var d,e,f=0,g=kb.prefilters.length,h=r.Deferred().always(function(){delete i.elem}),i=function(){if(e)return!1;for(var b=ab||fb(),c=Math.max(0,j.startTime+j.duration-b),d=c/j.duration||0,f=1-d,g=0,i=j.tweens.length;g<i;g++)j.tweens[g].run(f);return h.notifyWith(a,[j,f,c]),f<1&&i?c:(i||h.notifyWith(a,[j,1,0]),h.resolveWith(a,[j]),!1)},j=h.promise({elem:a,props:r.extend({},b),opts:r.extend(!0,{specialEasing:{},easing:r.easing._default},c),originalProperties:b,originalOptions:c,startTime:ab||fb(),duration:c.duration,tweens:[],createTween:function(b,c){var d=r.Tween(a,j.opts,b,c,j.opts.specialEasing[b]||j.opts.easing);return j.tweens.push(d),d},stop:function(b){var c=0,d=b?j.tweens.length:0;if(e)return this;for(e=!0;c<d;c++)j.tweens[c].run(1);return b?(h.notifyWith(a,[j,1,0]),h.resolveWith(a,[j,b])):h.rejectWith(a,[j,b]),this}}),k=j.props;for(jb(k,j.opts.specialEasing);f<g;f++)if(d=kb.prefilters[f].call(j,a,k,j.opts))return r.isFunction(d.stop)&&(r._queueHooks(j.elem,j.opts.queue).stop=r.proxy(d.stop,d)),d;return r.map(k,hb,j),r.isFunction(j.opts.start)&&j.opts.start.call(a,j),j.progress(j.opts.progress).done(j.opts.done,j.opts.complete).fail(j.opts.fail).always(j.opts.always),r.fx.timer(r.extend(i,{elem:a,anim:j,queue:j.opts.queue})),j}r.Animation=r.extend(kb,{tweeners:{"*":[function(a,b){var c=this.createTween(a,b);return fa(c.elem,a,ba.exec(b),c),c}]},tweener:function(a,b){r.isFunction(a)?(b=a,a=["*"]):a=a.match(L);for(var c,d=0,e=a.length;d<e;d++)c=a[d],kb.tweeners[c]=kb.tweeners[c]||[],kb.tweeners[c].unshift(b)},prefilters:[ib],prefilter:function(a,b){b?kb.prefilters.unshift(a):kb.prefilters.push(a)}}),r.speed=function(a,b,c){var d=a&&"object"==typeof a?r.extend({},a):{complete:c||!c&&b||r.isFunction(a)&&a,duration:a,easing:c&&b||b&&!r.isFunction(b)&&b};return r.fx.off?d.duration=0:"number"!=typeof d.duration&&(d.duration in r.fx.speeds?d.duration=r.fx.speeds[d.duration]:d.duration=r.fx.speeds._default),null!=d.queue&&d.queue!==!0||(d.queue="fx"),d.old=d.complete,d.complete=function(){r.isFunction(d.old)&&d.old.call(this),d.queue&&r.dequeue(this,d.queue)},d},r.fn.extend({fadeTo:function(a,b,c,d){return this.filter(da).css("opacity",0).show().end().animate({opacity:b},a,c,d)},animate:function(a,b,c,d){var e=r.isEmptyObject(a),f=r.speed(b,c,d),g=function(){var b=kb(this,r.extend({},a),f);(e||W.get(this,"finish"))&&b.stop(!0)};return g.finish=g,e||f.queue===!1?this.each(g):this.queue(f.queue,g)},stop:function(a,b,c){var d=function(a){var b=a.stop;delete a.stop,b(c)};return"string"!=typeof a&&(c=b,b=a,a=void 0),b&&a!==!1&&this.queue(a||"fx",[]),this.each(function(){var b=!0,e=null!=a&&a+"queueHooks",f=r.timers,g=W.get(this);if(e)g[e]&&g[e].stop&&d(g[e]);else for(e in g)g[e]&&g[e].stop&&db.test(e)&&d(g[e]);for(e=f.length;e--;)f[e].elem!==this||null!=a&&f[e].queue!==a||(f[e].anim.stop(c),b=!1,f.splice(e,1));!b&&c||r.dequeue(this,a)})},finish:function(a){return a!==!1&&(a=a||"fx"),this.each(function(){var b,c=W.get(this),d=c[a+"queue"],e=c[a+"queueHooks"],f=r.timers,g=d?d.length:0;for(c.finish=!0,r.queue(this,a,[]),e&&e.stop&&e.stop.call(this,!0),b=f.length;b--;)f[b].elem===this&&f[b].queue===a&&(f[b].anim.stop(!0),f.splice(b,1));for(b=0;b<g;b++)d[b]&&d[b].finish&&d[b].finish.call(this);delete c.finish})}}),r.each(["toggle","show","hide"],function(a,b){var c=r.fn[b];r.fn[b]=function(a,d,e){return null==a||"boolean"==typeof a?c.apply(this,arguments):this.animate(gb(b,!0),a,d,e)}}),r.each({slideDown:gb("show"),slideUp:gb("hide"),slideToggle:gb("toggle"),fadeIn:{opacity:"show"},fadeOut:{opacity:"hide"},fadeToggle:{opacity:"toggle"}},function(a,b){r.fn[a]=function(a,c,d){return this.animate(b,a,c,d)}}),r.timers=[],r.fx.tick=function(){var a,b=0,c=r.timers;for(ab=r.now();b<c.length;b++)a=c[b],a()||c[b]!==a||c.splice(b--,1);c.length||r.fx.stop(),ab=void 0},r.fx.timer=function(a){r.timers.push(a),r.fx.start()},r.fx.interval=13,r.fx.start=function(){bb||(bb=!0,eb())},r.fx.stop=function(){bb=null},r.fx.speeds={slow:600,fast:200,_default:400},r.fn.delay=function(b,c){return b=r.fx?r.fx.speeds[b]||b:b,c=c||"fx",this.queue(c,function(c,d){var e=a.setTimeout(c,b);d.stop=function(){a.clearTimeout(e)}})},function(){var a=d.createElement("input"),b=d.createElement("select"),c=b.appendChild(d.createElement("option"));a.type="checkbox",o.checkOn=""!==a.value,o.optSelected=c.selected,a=d.createElement("input"),a.value="t",a.type="radio",o.radioValue="t"===a.value}();var lb,mb=r.expr.attrHandle;r.fn.extend({attr:function(a,b){return T(this,r.attr,a,b,arguments.length>1)},removeAttr:function(a){return this.each(function(){r.removeAttr(this,a)})}}),r.extend({attr:function(a,b,c){var d,e,f=a.nodeType;if(3!==f&&8!==f&&2!==f)return"undefined"==typeof a.getAttribute?r.prop(a,b,c):(1===f&&r.isXMLDoc(a)||(e=r.attrHooks[b.toLowerCase()]||(r.expr.match.bool.test(b)?lb:void 0)),void 0!==c?null===c?void r.removeAttr(a,b):e&&"set"in e&&void 0!==(d=e.set(a,c,b))?d:(a.setAttribute(b,c+""),c):e&&"get"in e&&null!==(d=e.get(a,b))?d:(d=r.find.attr(a,b),
+null==d?void 0:d))},attrHooks:{type:{set:function(a,b){if(!o.radioValue&&"radio"===b&&B(a,"input")){var c=a.value;return a.setAttribute("type",b),c&&(a.value=c),b}}}},removeAttr:function(a,b){var c,d=0,e=b&&b.match(L);if(e&&1===a.nodeType)while(c=e[d++])a.removeAttribute(c)}}),lb={set:function(a,b,c){return b===!1?r.removeAttr(a,c):a.setAttribute(c,c),c}},r.each(r.expr.match.bool.source.match(/\w+/g),function(a,b){var c=mb[b]||r.find.attr;mb[b]=function(a,b,d){var e,f,g=b.toLowerCase();return d||(f=mb[g],mb[g]=e,e=null!=c(a,b,d)?g:null,mb[g]=f),e}});var nb=/^(?:input|select|textarea|button)$/i,ob=/^(?:a|area)$/i;r.fn.extend({prop:function(a,b){return T(this,r.prop,a,b,arguments.length>1)},removeProp:function(a){return this.each(function(){delete this[r.propFix[a]||a]})}}),r.extend({prop:function(a,b,c){var d,e,f=a.nodeType;if(3!==f&&8!==f&&2!==f)return 1===f&&r.isXMLDoc(a)||(b=r.propFix[b]||b,e=r.propHooks[b]),void 0!==c?e&&"set"in e&&void 0!==(d=e.set(a,c,b))?d:a[b]=c:e&&"get"in e&&null!==(d=e.get(a,b))?d:a[b]},propHooks:{tabIndex:{get:function(a){var b=r.find.attr(a,"tabindex");return b?parseInt(b,10):nb.test(a.nodeName)||ob.test(a.nodeName)&&a.href?0:-1}}},propFix:{"for":"htmlFor","class":"className"}}),o.optSelected||(r.propHooks.selected={get:function(a){var b=a.parentNode;return b&&b.parentNode&&b.parentNode.selectedIndex,null},set:function(a){var b=a.parentNode;b&&(b.selectedIndex,b.parentNode&&b.parentNode.selectedIndex)}}),r.each(["tabIndex","readOnly","maxLength","cellSpacing","cellPadding","rowSpan","colSpan","useMap","frameBorder","contentEditable"],function(){r.propFix[this.toLowerCase()]=this});function pb(a){var b=a.match(L)||[];return b.join(" ")}function qb(a){return a.getAttribute&&a.getAttribute("class")||""}r.fn.extend({addClass:function(a){var b,c,d,e,f,g,h,i=0;if(r.isFunction(a))return this.each(function(b){r(this).addClass(a.call(this,b,qb(this)))});if("string"==typeof a&&a){b=a.match(L)||[];while(c=this[i++])if(e=qb(c),d=1===c.nodeType&&" "+pb(e)+" "){g=0;while(f=b[g++])d.indexOf(" "+f+" ")<0&&(d+=f+" ");h=pb(d),e!==h&&c.setAttribute("class",h)}}return this},removeClass:function(a){var b,c,d,e,f,g,h,i=0;if(r.isFunction(a))return this.each(function(b){r(this).removeClass(a.call(this,b,qb(this)))});if(!arguments.length)return this.attr("class","");if("string"==typeof a&&a){b=a.match(L)||[];while(c=this[i++])if(e=qb(c),d=1===c.nodeType&&" "+pb(e)+" "){g=0;while(f=b[g++])while(d.indexOf(" "+f+" ")>-1)d=d.replace(" "+f+" "," ");h=pb(d),e!==h&&c.setAttribute("class",h)}}return this},toggleClass:function(a,b){var c=typeof a;return"boolean"==typeof b&&"string"===c?b?this.addClass(a):this.removeClass(a):r.isFunction(a)?this.each(function(c){r(this).toggleClass(a.call(this,c,qb(this),b),b)}):this.each(function(){var b,d,e,f;if("string"===c){d=0,e=r(this),f=a.match(L)||[];while(b=f[d++])e.hasClass(b)?e.removeClass(b):e.addClass(b)}else void 0!==a&&"boolean"!==c||(b=qb(this),b&&W.set(this,"__className__",b),this.setAttribute&&this.setAttribute("class",b||a===!1?"":W.get(this,"__className__")||""))})},hasClass:function(a){var b,c,d=0;b=" "+a+" ";while(c=this[d++])if(1===c.nodeType&&(" "+pb(qb(c))+" ").indexOf(b)>-1)return!0;return!1}});var rb=/\r/g;r.fn.extend({val:function(a){var b,c,d,e=this[0];{if(arguments.length)return d=r.isFunction(a),this.each(function(c){var e;1===this.nodeType&&(e=d?a.call(this,c,r(this).val()):a,null==e?e="":"number"==typeof e?e+="":Array.isArray(e)&&(e=r.map(e,function(a){return null==a?"":a+""})),b=r.valHooks[this.type]||r.valHooks[this.nodeName.toLowerCase()],b&&"set"in b&&void 0!==b.set(this,e,"value")||(this.value=e))});if(e)return b=r.valHooks[e.type]||r.valHooks[e.nodeName.toLowerCase()],b&&"get"in b&&void 0!==(c=b.get(e,"value"))?c:(c=e.value,"string"==typeof c?c.replace(rb,""):null==c?"":c)}}}),r.extend({valHooks:{option:{get:function(a){var b=r.find.attr(a,"value");return null!=b?b:pb(r.text(a))}},select:{get:function(a){var b,c,d,e=a.options,f=a.selectedIndex,g="select-one"===a.type,h=g?null:[],i=g?f+1:e.length;for(d=f<0?i:g?f:0;d<i;d++)if(c=e[d],(c.selected||d===f)&&!c.disabled&&(!c.parentNode.disabled||!B(c.parentNode,"optgroup"))){if(b=r(c).val(),g)return b;h.push(b)}return h},set:function(a,b){var c,d,e=a.options,f=r.makeArray(b),g=e.length;while(g--)d=e[g],(d.selected=r.inArray(r.valHooks.option.get(d),f)>-1)&&(c=!0);return c||(a.selectedIndex=-1),f}}}}),r.each(["radio","checkbox"],function(){r.valHooks[this]={set:function(a,b){if(Array.isArray(b))return a.checked=r.inArray(r(a).val(),b)>-1}},o.checkOn||(r.valHooks[this].get=function(a){return null===a.getAttribute("value")?"on":a.value})});var sb=/^(?:focusinfocus|focusoutblur)$/;r.extend(r.event,{trigger:function(b,c,e,f){var g,h,i,j,k,m,n,o=[e||d],p=l.call(b,"type")?b.type:b,q=l.call(b,"namespace")?b.namespace.split("."):[];if(h=i=e=e||d,3!==e.nodeType&&8!==e.nodeType&&!sb.test(p+r.event.triggered)&&(p.indexOf(".")>-1&&(q=p.split("."),p=q.shift(),q.sort()),k=p.indexOf(":")<0&&"on"+p,b=b[r.expando]?b:new r.Event(p,"object"==typeof b&&b),b.isTrigger=f?2:3,b.namespace=q.join("."),b.rnamespace=b.namespace?new RegExp("(^|\\.)"+q.join("\\.(?:.*\\.|)")+"(\\.|$)"):null,b.result=void 0,b.target||(b.target=e),c=null==c?[b]:r.makeArray(c,[b]),n=r.event.special[p]||{},f||!n.trigger||n.trigger.apply(e,c)!==!1)){if(!f&&!n.noBubble&&!r.isWindow(e)){for(j=n.delegateType||p,sb.test(j+p)||(h=h.parentNode);h;h=h.parentNode)o.push(h),i=h;i===(e.ownerDocument||d)&&o.push(i.defaultView||i.parentWindow||a)}g=0;while((h=o[g++])&&!b.isPropagationStopped())b.type=g>1?j:n.bindType||p,m=(W.get(h,"events")||{})[b.type]&&W.get(h,"handle"),m&&m.apply(h,c),m=k&&h[k],m&&m.apply&&U(h)&&(b.result=m.apply(h,c),b.result===!1&&b.preventDefault());return b.type=p,f||b.isDefaultPrevented()||n._default&&n._default.apply(o.pop(),c)!==!1||!U(e)||k&&r.isFunction(e[p])&&!r.isWindow(e)&&(i=e[k],i&&(e[k]=null),r.event.triggered=p,e[p](),r.event.triggered=void 0,i&&(e[k]=i)),b.result}},simulate:function(a,b,c){var d=r.extend(new r.Event,c,{type:a,isSimulated:!0});r.event.trigger(d,null,b)}}),r.fn.extend({trigger:function(a,b){return this.each(function(){r.event.trigger(a,b,this)})},triggerHandler:function(a,b){var c=this[0];if(c)return r.event.trigger(a,b,c,!0)}}),r.each("blur focus focusin focusout resize scroll click dblclick mousedown mouseup mousemove mouseover mouseout mouseenter mouseleave change select submit keydown keypress keyup contextmenu".split(" "),function(a,b){r.fn[b]=function(a,c){return arguments.length>0?this.on(b,null,a,c):this.trigger(b)}}),r.fn.extend({hover:function(a,b){return this.mouseenter(a).mouseleave(b||a)}}),o.focusin="onfocusin"in a,o.focusin||r.each({focus:"focusin",blur:"focusout"},function(a,b){var c=function(a){r.event.simulate(b,a.target,r.event.fix(a))};r.event.special[b]={setup:function(){var d=this.ownerDocument||this,e=W.access(d,b);e||d.addEventListener(a,c,!0),W.access(d,b,(e||0)+1)},teardown:function(){var d=this.ownerDocument||this,e=W.access(d,b)-1;e?W.access(d,b,e):(d.removeEventListener(a,c,!0),W.remove(d,b))}}});var tb=a.location,ub=r.now(),vb=/\?/;r.parseXML=function(b){var c;if(!b||"string"!=typeof b)return null;try{c=(new a.DOMParser).parseFromString(b,"text/xml")}catch(d){c=void 0}return c&&!c.getElementsByTagName("parsererror").length||r.error("Invalid XML: "+b),c};var wb=/\[\]$/,xb=/\r?\n/g,yb=/^(?:submit|button|image|reset|file)$/i,zb=/^(?:input|select|textarea|keygen)/i;function Ab(a,b,c,d){var e;if(Array.isArray(b))r.each(b,function(b,e){c||wb.test(a)?d(a,e):Ab(a+"["+("object"==typeof e&&null!=e?b:"")+"]",e,c,d)});else if(c||"object"!==r.type(b))d(a,b);else for(e in b)Ab(a+"["+e+"]",b[e],c,d)}r.param=function(a,b){var c,d=[],e=function(a,b){var c=r.isFunction(b)?b():b;d[d.length]=encodeURIComponent(a)+"="+encodeURIComponent(null==c?"":c)};if(Array.isArray(a)||a.jquery&&!r.isPlainObject(a))r.each(a,function(){e(this.name,this.value)});else for(c in a)Ab(c,a[c],b,e);return d.join("&")},r.fn.extend({serialize:function(){return r.param(this.serializeArray())},serializeArray:function(){return this.map(function(){var a=r.prop(this,"elements");return a?r.makeArray(a):this}).filter(function(){var a=this.type;return this.name&&!r(this).is(":disabled")&&zb.test(this.nodeName)&&!yb.test(a)&&(this.checked||!ja.test(a))}).map(function(a,b){var c=r(this).val();return null==c?null:Array.isArray(c)?r.map(c,function(a){return{name:b.name,value:a.replace(xb,"\r\n")}}):{name:b.name,value:c.replace(xb,"\r\n")}}).get()}});var Bb=/%20/g,Cb=/#.*$/,Db=/([?&])_=[^&]*/,Eb=/^(.*?):[ \t]*([^\r\n]*)$/gm,Fb=/^(?:about|app|app-storage|.+-extension|file|res|widget):$/,Gb=/^(?:GET|HEAD)$/,Hb=/^\/\//,Ib={},Jb={},Kb="*/".concat("*"),Lb=d.createElement("a");Lb.href=tb.href;function Mb(a){return function(b,c){"string"!=typeof b&&(c=b,b="*");var d,e=0,f=b.toLowerCase().match(L)||[];if(r.isFunction(c))while(d=f[e++])"+"===d[0]?(d=d.slice(1)||"*",(a[d]=a[d]||[]).unshift(c)):(a[d]=a[d]||[]).push(c)}}function Nb(a,b,c,d){var e={},f=a===Jb;function g(h){var i;return e[h]=!0,r.each(a[h]||[],function(a,h){var j=h(b,c,d);return"string"!=typeof j||f||e[j]?f?!(i=j):void 0:(b.dataTypes.unshift(j),g(j),!1)}),i}return g(b.dataTypes[0])||!e["*"]&&g("*")}function Ob(a,b){var c,d,e=r.ajaxSettings.flatOptions||{};for(c in b)void 0!==b[c]&&((e[c]?a:d||(d={}))[c]=b[c]);return d&&r.extend(!0,a,d),a}function Pb(a,b,c){var d,e,f,g,h=a.contents,i=a.dataTypes;while("*"===i[0])i.shift(),void 0===d&&(d=a.mimeType||b.getResponseHeader("Content-Type"));if(d)for(e in h)if(h[e]&&h[e].test(d)){i.unshift(e);break}if(i[0]in c)f=i[0];else{for(e in c){if(!i[0]||a.converters[e+" "+i[0]]){f=e;break}g||(g=e)}f=f||g}if(f)return f!==i[0]&&i.unshift(f),c[f]}function Qb(a,b,c,d){var e,f,g,h,i,j={},k=a.dataTypes.slice();if(k[1])for(g in a.converters)j[g.toLowerCase()]=a.converters[g];f=k.shift();while(f)if(a.responseFields[f]&&(c[a.responseFields[f]]=b),!i&&d&&a.dataFilter&&(b=a.dataFilter(b,a.dataType)),i=f,f=k.shift())if("*"===f)f=i;else if("*"!==i&&i!==f){if(g=j[i+" "+f]||j["* "+f],!g)for(e in j)if(h=e.split(" "),h[1]===f&&(g=j[i+" "+h[0]]||j["* "+h[0]])){g===!0?g=j[e]:j[e]!==!0&&(f=h[0],k.unshift(h[1]));break}if(g!==!0)if(g&&a["throws"])b=g(b);else try{b=g(b)}catch(l){return{state:"parsererror",error:g?l:"No conversion from "+i+" to "+f}}}return{state:"success",data:b}}r.extend({active:0,lastModified:{},etag:{},ajaxSettings:{url:tb.href,type:"GET",isLocal:Fb.test(tb.protocol),global:!0,processData:!0,async:!0,contentType:"application/x-www-form-urlencoded; charset=UTF-8",accepts:{"*":Kb,text:"text/plain",html:"text/html",xml:"application/xml, text/xml",json:"application/json, text/javascript"},contents:{xml:/\bxml\b/,html:/\bhtml/,json:/\bjson\b/},responseFields:{xml:"responseXML",text:"responseText",json:"responseJSON"},converters:{"* text":String,"text html":!0,"text json":JSON.parse,"text xml":r.parseXML},flatOptions:{url:!0,context:!0}},ajaxSetup:function(a,b){return b?Ob(Ob(a,r.ajaxSettings),b):Ob(r.ajaxSettings,a)},ajaxPrefilter:Mb(Ib),ajaxTransport:Mb(Jb),ajax:function(b,c){"object"==typeof b&&(c=b,b=void 0),c=c||{};var e,f,g,h,i,j,k,l,m,n,o=r.ajaxSetup({},c),p=o.context||o,q=o.context&&(p.nodeType||p.jquery)?r(p):r.event,s=r.Deferred(),t=r.Callbacks("once memory"),u=o.statusCode||{},v={},w={},x="canceled",y={readyState:0,getResponseHeader:function(a){var b;if(k){if(!h){h={};while(b=Eb.exec(g))h[b[1].toLowerCase()]=b[2]}b=h[a.toLowerCase()]}return null==b?null:b},getAllResponseHeaders:function(){return k?g:null},setRequestHeader:function(a,b){return null==k&&(a=w[a.toLowerCase()]=w[a.toLowerCase()]||a,v[a]=b),this},overrideMimeType:function(a){return null==k&&(o.mimeType=a),this},statusCode:function(a){var b;if(a)if(k)y.always(a[y.status]);else for(b in a)u[b]=[u[b],a[b]];return this},abort:function(a){var b=a||x;return e&&e.abort(b),A(0,b),this}};if(s.promise(y),o.url=((b||o.url||tb.href)+"").replace(Hb,tb.protocol+"//"),o.type=c.method||c.type||o.method||o.type,o.dataTypes=(o.dataType||"*").toLowerCase().match(L)||[""],null==o.crossDomain){j=d.createElement("a");try{j.href=o.url,j.href=j.href,o.crossDomain=Lb.protocol+"//"+Lb.host!=j.protocol+"//"+j.host}catch(z){o.crossDomain=!0}}if(o.data&&o.processData&&"string"!=typeof o.data&&(o.data=r.param(o.data,o.traditional)),Nb(Ib,o,c,y),k)return y;l=r.event&&o.global,l&&0===r.active++&&r.event.trigger("ajaxStart"),o.type=o.type.toUpperCase(),o.hasContent=!Gb.test(o.type),f=o.url.replace(Cb,""),o.hasContent?o.data&&o.processData&&0===(o.contentType||"").indexOf("application/x-www-form-urlencoded")&&(o.data=o.data.replace(Bb,"+")):(n=o.url.slice(f.length),o.data&&(f+=(vb.test(f)?"&":"?")+o.data,delete o.data),o.cache===!1&&(f=f.replace(Db,"$1"),n=(vb.test(f)?"&":"?")+"_="+ub++ +n),o.url=f+n),o.ifModified&&(r.lastModified[f]&&y.setRequestHeader("If-Modified-Since",r.lastModified[f]),r.etag[f]&&y.setRequestHeader("If-None-Match",r.etag[f])),(o.data&&o.hasContent&&o.contentType!==!1||c.contentType)&&y.setRequestHeader("Content-Type",o.contentType),y.setRequestHeader("Accept",o.dataTypes[0]&&o.accepts[o.dataTypes[0]]?o.accepts[o.dataTypes[0]]+("*"!==o.dataTypes[0]?", "+Kb+"; q=0.01":""):o.accepts["*"]);for(m in o.headers)y.setRequestHeader(m,o.headers[m]);if(o.beforeSend&&(o.beforeSend.call(p,y,o)===!1||k))return y.abort();if(x="abort",t.add(o.complete),y.done(o.success),y.fail(o.error),e=Nb(Jb,o,c,y)){if(y.readyState=1,l&&q.trigger("ajaxSend",[y,o]),k)return y;o.async&&o.timeout>0&&(i=a.setTimeout(function(){y.abort("timeout")},o.timeout));try{k=!1,e.send(v,A)}catch(z){if(k)throw z;A(-1,z)}}else A(-1,"No Transport");function A(b,c,d,h){var j,m,n,v,w,x=c;k||(k=!0,i&&a.clearTimeout(i),e=void 0,g=h||"",y.readyState=b>0?4:0,j=b>=200&&b<300||304===b,d&&(v=Pb(o,y,d)),v=Qb(o,v,y,j),j?(o.ifModified&&(w=y.getResponseHeader("Last-Modified"),w&&(r.lastModified[f]=w),w=y.getResponseHeader("etag"),w&&(r.etag[f]=w)),204===b||"HEAD"===o.type?x="nocontent":304===b?x="notmodified":(x=v.state,m=v.data,n=v.error,j=!n)):(n=x,!b&&x||(x="error",b<0&&(b=0))),y.status=b,y.statusText=(c||x)+"",j?s.resolveWith(p,[m,x,y]):s.rejectWith(p,[y,x,n]),y.statusCode(u),u=void 0,l&&q.trigger(j?"ajaxSuccess":"ajaxError",[y,o,j?m:n]),t.fireWith(p,[y,x]),l&&(q.trigger("ajaxComplete",[y,o]),--r.active||r.event.trigger("ajaxStop")))}return y},getJSON:function(a,b,c){return r.get(a,b,c,"json")},getScript:function(a,b){return r.get(a,void 0,b,"script")}}),r.each(["get","post"],function(a,b){r[b]=function(a,c,d,e){return r.isFunction(c)&&(e=e||d,d=c,c=void 0),r.ajax(r.extend({url:a,type:b,dataType:e,data:c,success:d},r.isPlainObject(a)&&a))}}),r._evalUrl=function(a){return r.ajax({url:a,type:"GET",dataType:"script",cache:!0,async:!1,global:!1,"throws":!0})},r.fn.extend({wrapAll:function(a){var b;return this[0]&&(r.isFunction(a)&&(a=a.call(this[0])),b=r(a,this[0].ownerDocument).eq(0).clone(!0),this[0].parentNode&&b.insertBefore(this[0]),b.map(function(){var a=this;while(a.firstElementChild)a=a.firstElementChild;return a}).append(this)),this},wrapInner:function(a){return r.isFunction(a)?this.each(function(b){r(this).wrapInner(a.call(this,b))}):this.each(function(){var b=r(this),c=b.contents();c.length?c.wrapAll(a):b.append(a)})},wrap:function(a){var b=r.isFunction(a);return this.each(function(c){r(this).wrapAll(b?a.call(this,c):a)})},unwrap:function(a){return this.parent(a).not("body").each(function(){r(this).replaceWith(this.childNodes)}),this}}),r.expr.pseudos.hidden=function(a){return!r.expr.pseudos.visible(a)},r.expr.pseudos.visible=function(a){return!!(a.offsetWidth||a.offsetHeight||a.getClientRects().length)},r.ajaxSettings.xhr=function(){try{return new a.XMLHttpRequest}catch(b){}};var Rb={0:200,1223:204},Sb=r.ajaxSettings.xhr();o.cors=!!Sb&&"withCredentials"in Sb,o.ajax=Sb=!!Sb,r.ajaxTransport(function(b){var c,d;if(o.cors||Sb&&!b.crossDomain)return{send:function(e,f){var g,h=b.xhr();if(h.open(b.type,b.url,b.async,b.username,b.password),b.xhrFields)for(g in b.xhrFields)h[g]=b.xhrFields[g];b.mimeType&&h.overrideMimeType&&h.overrideMimeType(b.mimeType),b.crossDomain||e["X-Requested-With"]||(e["X-Requested-With"]="XMLHttpRequest");for(g in e)h.setRequestHeader(g,e[g]);c=function(a){return function(){c&&(c=d=h.onload=h.onerror=h.onabort=h.onreadystatechange=null,"abort"===a?h.abort():"error"===a?"number"!=typeof h.status?f(0,"error"):f(h.status,h.statusText):f(Rb[h.status]||h.status,h.statusText,"text"!==(h.responseType||"text")||"string"!=typeof h.responseText?{binary:h.response}:{text:h.responseText},h.getAllResponseHeaders()))}},h.onload=c(),d=h.onerror=c("error"),void 0!==h.onabort?h.onabort=d:h.onreadystatechange=function(){4===h.readyState&&a.setTimeout(function(){c&&d()})},c=c("abort");try{h.send(b.hasContent&&b.data||null)}catch(i){if(c)throw i}},abort:function(){c&&c()}}}),r.ajaxPrefilter(function(a){a.crossDomain&&(a.contents.script=!1)}),r.ajaxSetup({accepts:{script:"text/javascript, application/javascript, application/ecmascript, application/x-ecmascript"},contents:{script:/\b(?:java|ecma)script\b/},converters:{"text script":function(a){return r.globalEval(a),a}}}),r.ajaxPrefilter("script",function(a){void 0===a.cache&&(a.cache=!1),a.crossDomain&&(a.type="GET")}),r.ajaxTransport("script",function(a){if(a.crossDomain){var b,c;return{send:function(e,f){b=r("<script>").prop({charset:a.scriptCharset,src:a.url}).on("load error",c=function(a){b.remove(),c=null,a&&f("error"===a.type?404:200,a.type)}),d.head.appendChild(b[0])},abort:function(){c&&c()}}}});var Tb=[],Ub=/(=)\?(?=&|$)|\?\?/;r.ajaxSetup({jsonp:"callback",jsonpCallback:function(){var a=Tb.pop()||r.expando+"_"+ub++;return this[a]=!0,a}}),r.ajaxPrefilter("json jsonp",function(b,c,d){var e,f,g,h=b.jsonp!==!1&&(Ub.test(b.url)?"url":"string"==typeof b.data&&0===(b.contentType||"").indexOf("application/x-www-form-urlencoded")&&Ub.test(b.data)&&"data");if(h||"jsonp"===b.dataTypes[0])return e=b.jsonpCallback=r.isFunction(b.jsonpCallback)?b.jsonpCallback():b.jsonpCallback,h?b[h]=b[h].replace(Ub,"$1"+e):b.jsonp!==!1&&(b.url+=(vb.test(b.url)?"&":"?")+b.jsonp+"="+e),b.converters["script json"]=function(){return g||r.error(e+" was not called"),g[0]},b.dataTypes[0]="json",f=a[e],a[e]=function(){g=arguments},d.always(function(){void 0===f?r(a).removeProp(e):a[e]=f,b[e]&&(b.jsonpCallback=c.jsonpCallback,Tb.push(e)),g&&r.isFunction(f)&&f(g[0]),g=f=void 0}),"script"}),o.createHTMLDocument=function(){var a=d.implementation.createHTMLDocument("").body;return a.innerHTML="<form></form><form></form>",2===a.childNodes.length}(),r.parseHTML=function(a,b,c){if("string"!=typeof a)return[];"boolean"==typeof b&&(c=b,b=!1);var e,f,g;return b||(o.createHTMLDocument?(b=d.implementation.createHTMLDocument(""),e=b.createElement("base"),e.href=d.location.href,b.head.appendChild(e)):b=d),f=C.exec(a),g=!c&&[],f?[b.createElement(f[1])]:(f=qa([a],b,g),g&&g.length&&r(g).remove(),r.merge([],f.childNodes))},r.fn.load=function(a,b,c){var d,e,f,g=this,h=a.indexOf(" ");return h>-1&&(d=pb(a.slice(h)),a=a.slice(0,h)),r.isFunction(b)?(c=b,b=void 0):b&&"object"==typeof b&&(e="POST"),g.length>0&&r.ajax({url:a,type:e||"GET",dataType:"html",data:b}).done(function(a){f=arguments,g.html(d?r("<div>").append(r.parseHTML(a)).find(d):a)}).always(c&&function(a,b){g.each(function(){c.apply(this,f||[a.responseText,b,a])})}),this},r.each(["ajaxStart","ajaxStop","ajaxComplete","ajaxError","ajaxSuccess","ajaxSend"],function(a,b){r.fn[b]=function(a){return this.on(b,a)}}),r.expr.pseudos.animated=function(a){return r.grep(r.timers,function(b){return a===b.elem}).length},r.offset={setOffset:function(a,b,c){var d,e,f,g,h,i,j,k=r.css(a,"position"),l=r(a),m={};"static"===k&&(a.style.position="relative"),h=l.offset(),f=r.css(a,"top"),i=r.css(a,"left"),j=("absolute"===k||"fixed"===k)&&(f+i).indexOf("auto")>-1,j?(d=l.position(),g=d.top,e=d.left):(g=parseFloat(f)||0,e=parseFloat(i)||0),r.isFunction(b)&&(b=b.call(a,c,r.extend({},h))),null!=b.top&&(m.top=b.top-h.top+g),null!=b.left&&(m.left=b.left-h.left+e),"using"in b?b.using.call(a,m):l.css(m)}},r.fn.extend({offset:function(a){if(arguments.length)return void 0===a?this:this.each(function(b){r.offset.setOffset(this,a,b)});var b,c,d,e,f=this[0];if(f)return f.getClientRects().length?(d=f.getBoundingClientRect(),b=f.ownerDocument,c=b.documentElement,e=b.defaultView,{top:d.top+e.pageYOffset-c.clientTop,left:d.left+e.pageXOffset-c.clientLeft}):{top:0,left:0}},position:function(){if(this[0]){var a,b,c=this[0],d={top:0,left:0};return"fixed"===r.css(c,"position")?b=c.getBoundingClientRect():(a=this.offsetParent(),b=this.offset(),B(a[0],"html")||(d=a.offset()),d={top:d.top+r.css(a[0],"borderTopWidth",!0),left:d.left+r.css(a[0],"borderLeftWidth",!0)}),{top:b.top-d.top-r.css(c,"marginTop",!0),left:b.left-d.left-r.css(c,"marginLeft",!0)}}},offsetParent:function(){return this.map(function(){var a=this.offsetParent;while(a&&"static"===r.css(a,"position"))a=a.offsetParent;return a||ra})}}),r.each({scrollLeft:"pageXOffset",scrollTop:"pageYOffset"},function(a,b){var c="pageYOffset"===b;r.fn[a]=function(d){return T(this,function(a,d,e){var f;return r.isWindow(a)?f=a:9===a.nodeType&&(f=a.defaultView),void 0===e?f?f[b]:a[d]:void(f?f.scrollTo(c?f.pageXOffset:e,c?e:f.pageYOffset):a[d]=e)},a,d,arguments.length)}}),r.each(["top","left"],function(a,b){r.cssHooks[b]=Pa(o.pixelPosition,function(a,c){if(c)return c=Oa(a,b),Ma.test(c)?r(a).position()[b]+"px":c})}),r.each({Height:"height",Width:"width"},function(a,b){r.each({padding:"inner"+a,content:b,"":"outer"+a},function(c,d){r.fn[d]=function(e,f){var g=arguments.length&&(c||"boolean"!=typeof e),h=c||(e===!0||f===!0?"margin":"border");return T(this,function(b,c,e){var f;return r.isWindow(b)?0===d.indexOf("outer")?b["inner"+a]:b.document.documentElement["client"+a]:9===b.nodeType?(f=b.documentElement,Math.max(b.body["scroll"+a],f["scroll"+a],b.body["offset"+a],f["offset"+a],f["client"+a])):void 0===e?r.css(b,c,h):r.style(b,c,e,h)},b,g?e:void 0,g)}})}),r.fn.extend({bind:function(a,b,c){return this.on(a,null,b,c)},unbind:function(a,b){return this.off(a,null,b)},delegate:function(a,b,c,d){return this.on(b,a,c,d)},undelegate:function(a,b,c){return 1===arguments.length?this.off(a,"**"):this.off(b,a||"**",c)}}),r.holdReady=function(a){a?r.readyWait++:r.ready(!0)},r.isArray=Array.isArray,r.parseJSON=JSON.parse,r.nodeName=B,"function"==typeof define&&define.amd&&define("jquery",[],function(){return r});var Vb=a.jQuery,Wb=a.$;return r.noConflict=function(b){return a.$===r&&(a.$=Wb),b&&a.jQuery===r&&(a.jQuery=Vb),r},b||(a.jQuery=a.$=r),r});
+</script>
+<script type="text/javascript">
+Unicode.UP_TRIANGLE    = '\u25B3';
+Unicode.RIGHT_TRIANGLE = '\u25B7';
+Unicode.DOWN_TRIANGLE  = '\u25BD';
+
+function Unicode() {
+}
+</script>
+<script type="text/javascript">
+function Model() {
+    this.listeners = [];
+}
+
+Model.prototype.addChangeListener = function(listener) {
+    // Check for duplicates.
+    for (var i = 0; i < this.listeners.length; i++) {
+        if (listener == this.listeners[i]) return;
+    }
+
+    this.listeners.push(listener);
+};
+
+Model.prototype.removeChangeListener = function(listener) {
+    var listeners = [];
+    for (var i = 0; i < this.listeners.length; i++) {
+        if (listener != this.listeners[i]) {
+            listeners.push(this.listeners[i]);
+        }
+    }
+    this.listeners = listeners;
+};
+
+Model.prototype.triggerChange = function() {
+    for (var i in this.listeners) {
+        this.listeners[i].onChange(this);
+    }
+};
+</script>
+<script type="text/javascript">
+ResizingCanvas.prototype = new Model();
+ResizingCanvas.prototype.constructor = ResizingCanvas;
+
+function ResizingCanvas(container) {
+    Model.call(this);
+
+    this.container = container;
+    this.canvas    = document.createElement('canvas');
+    container.append($(this.canvas));
+
+    var _this = this;
+    window.setInterval(function() {
+        _this.checkSize();
+    }, 300);
+}
+
+ResizingCanvas.prototype.checkSize = function() {
+    var width  = Math.floor(this.container.width());
+    var height = Math.floor(this.container.height());
+    if (width !== this.canvas.width || height !== this.canvas.height) {
+        this.canvas.width  = width;
+        this.canvas.height = height;
+        this.triggerChange();
+    }
+};
+
+ResizingCanvas.prototype.getCanvas = function() {
+    return this.canvas;
+};
+</script>
+<script type="text/javascript">
+Node.prototype = new Model();
+Node.prototype.constructor = Node;
+
+function Node(prof, selection, sorting, parent, id) {
+    Model.call(this);
+    var _this = this;
+
+    // Set general properties
+    _this.prof      = prof;
+    _this.sorting   = sorting;
+    _this.parent    = parent;
+    _this.id        = id;
+    _this.expanded  = false;
+    _this.selection = selection;
+
+    // Set data
+    var data = prof[id];
+    _this.name     = data[0];
+    _this.module   = data[1];
+    _this.entries  = data[2];
+    _this.time     = data[3];
+    _this.alloc    = data[4];
+    _this.childIds = data[5];
+    _this.children = [];
+
+    if (sorting) sorting.addChangeListener(_this);
+}
+
+Node.prototype.isExpandable = function() {
+    return this.childIds.length > 0;
+};
+
+Node.prototype.toggleExpanded = function() {
+    this.setExpanded(!this.expanded);
+};
+
+Node.prototype.computeChildren = function() {
+    var _this = this;
+
+    if (_this.expanded && _this.children.length <= 0) {
+        _this.children = [];
+        for (var i in _this.childIds) {
+            var childId = _this.childIds[i];
+            _this.children.push(new Node(
+                    _this.prof, _this.selection, _this.sorting,
+                    _this, childId));
+        }
+    } else if (!_this.expanded && _this.children.length > 0) {
+        _this.children = [];
+    }
+
+    _this.children.sort(function(a, b) {
+        return b.getCost() - a.getCost();
+    });
+};
+
+Node.prototype.setExpanded = function(expanded) {
+    var _this = this;
+    if (_this.expanded === expanded) return;
+    _this.expanded = expanded;
+    _this.computeChildren();
+    _this.triggerChange();
+};
+
+Node.prototype.getCanonicalName = function() {
+    return this.name;
+};
+
+Node.prototype.getModuleName = function() {
+    return this.module;
+};
+
+Node.prototype.getFullName = function() {
+    return this.module + '.' + this.name;
+};
+
+Node.prototype.getEntries = function() {
+    return this.entries;
+};
+
+Node.prototype.getColor = function() {
+    var hash = 5381;
+    var str  = this.getFullName();
+    for (var i = 0; i < str.length; i++) {
+        hash = (hash << 5) + hash + str.charCodeAt(i);
+    }
+
+    var h = hash % 360;
+    var s = "100%";
+    var l = "40%";
+    return 'hsl(' + h + ', ' + s + ', ' + l + ')';
+};
+
+Node.prototype.getCost = function() {
+    return this.sorting.getCost(this);
+};
+
+Node.prototype.getTime = function() {
+    return this.time;
+};
+
+Node.prototype.getAlloc = function() {
+    return this.alloc;
+};
+
+Node.prototype.isSelected = function() {
+    return this == this.selection.getSelectedNode();
+};
+
+Node.prototype.select = function() {
+    this.selection.setSelectedNode(this);
+};
+
+Node.prototype.onChange = function(sorting) {
+    this.computeChildren();
+    this.triggerChange();
+};
+</script>
+<script type="text/javascript">
+Selection.prototype = new Model();
+Selection.prototype.constructor = Selection;
+
+function Selection() {
+    Model.call(this);
+
+    this.selectedNode = undefined;
+}
+
+Selection.prototype.getSelectedNode = function() {
+    return this.selectedNode;
+};
+
+Selection.prototype.setSelectedNode = function(node) {
+    if (this.selectedNode == node) return;
+
+    var previousSelectedNode = this.selectedNode;
+    this.selectedNode = node;
+    if (previousSelectedNode) previousSelectedNode.triggerChange();
+    if (node) node.triggerChange();
+    this.triggerChange();
+};
+</script>
+<script type="text/javascript">
+Zoom.prototype = new Model();
+Zoom.prototype.constructor = Zoom;
+
+function Zoom(zoom) {
+    Model.call(this);
+
+    this.zoom = zoom;
+}
+
+Zoom.prototype.setZoom = function(zoom) {
+    if (zoom) {
+        this.zoom = zoom;
+        this.triggerChange();
+    }
+};
+
+Zoom.prototype.getZoom = function() {
+    return this.zoom;
+};
+</script>
+<script type="text/javascript">
+function mk(el) {
+    return $(document.createElement(el));
+}
+
+function Details(container, selection, sorting, zoom) {
+    this.container = container;
+    this.selection = selection;
+    this.sorting   = sorting;
+    this.zoom      = zoom;
+
+    this.mkElement();
+    selection.addChangeListener(this);
+    zoom.addChangeListener(this);
+}
+
+Details.prototype.mkElement = function() {
+    var _this = this;
+
+    var controls = mk('div').addClass('controls');
+
+    var up = mk('button').addClass('up').text(Unicode.UP_TRIANGLE + ' parent');
+    up.prop('title', 'Jump to parent node');
+    controls.append(up);
+
+    var down = mk('button').addClass('down').text(
+            Unicode.DOWN_TRIANGLE + ' zoom');
+    down.prop('title', 'Zoom to this node');
+    controls.append(down);
+
+    var combo = mk('select').addClass('sorting');
+    for (var k in Sorting.methods) {
+        combo.append(mk('option').attr('value', k)
+                .text(Sorting.methods[k].name));
+    }
+    combo.change(function() {
+        _this.sorting.setMethodByKey(combo.val());
+    });
+    controls.append(combo);
+
+    var canonical = mk('h1').addClass('canonical');
+
+    var table = mk('table');
+
+    table.append(mk('tr')
+            .append(mk('td').text('Module'))
+            .append(mk('td').append(mk('code').addClass('module'))));
+
+    table.append(mk('tr')
+            .append(mk('td').text('Entries'))
+            .append(mk('td').addClass('entries')));
+
+    table.append(mk('tr')
+            .append(mk('td').text('Time'))
+            .append(mk('td').addClass('time')));
+
+    table.append(mk('tr')
+            .append(mk('td').text('Alloc'))
+            .append(mk('td').addClass('alloc')));
+
+    table.append(mk('tr').addClass('mainTimeRow')
+            .append(mk('td').text('MAIN Time'))
+            .append(mk('td').addClass('mainTime')));
+
+    table.append(mk('tr').addClass('mainAllocRow')
+            .append(mk('td').text('MAIN Alloc'))
+            .append(mk('td').addClass('mainAlloc')));
+
+    var credits = mk('p').addClass('credits');
+    credits.html('Generated by ' +
+        '<a href="http://github.com/jaspervdj/profiteur" ' +
+        'target="_blank">profiteur</a>.');
+
+    this.container.append(controls);
+    this.container.append(canonical);
+    this.container.append(table);
+    this.container.append(credits);
+};
+
+Details.prototype.render = function(node) {
+    var _this = this;
+
+    this.container.children('.canonical').text(node.getCanonicalName());
+
+    var up = this.container.find('.up');
+    up.off();
+    if (node.parent) {
+        up.prop('dispabled', true);
+        up.click(function () {
+            node.parent.select();
+            if (node == _this.zoom.getZoom()) {
+                _this.zoom.setZoom(node.parent);
+            }
+        });
+    } else {
+        up.prop('dispabled', false);
+    }
+
+    var down = this.container.find('.down');
+    down.off();
+    down.click(function () {
+        _this.zoom.setZoom(node);
+    });
+
+    var mainTime  = node.getTime();
+    var mainAlloc = node.getAlloc();
+    var time      = mainTime;
+    var alloc     = mainAlloc;
+
+    var zoom = _this.zoom.getZoom();
+    if (zoom.parent && zoom.getTime() > 0) {
+        time = time * 100 / zoom.getTime();
+    }
+    if (zoom.parent && zoom.getAlloc() > 0) {
+        alloc = alloc * 100 / zoom.getAlloc();
+    }
+
+    /* The default Number.prototype.toFixed adds 0s and we don't want that. */
+    var precision = 3;
+    function formatNum(value) {
+        var power = Math.pow(10, precision || 0);
+        return String(Math.round(value * power) / power);
+    }
+
+    this.container.find('.module').text(node.getModuleName());
+    this.container.find('.entries').text(node.getEntries());
+    this.container.find('.time').text(formatNum(time));
+    this.container.find('.alloc').text(formatNum(alloc));
+    this.container.find('.mainTime').text(formatNum(mainTime));
+    this.container.find('.mainAlloc').text(formatNum(mainAlloc));
+
+    if (zoom.parent) {
+        this.container.find('.mainTimeRow').show();
+        this.container.find('.mainAllocRow').show();
+    } else {
+        this.container.find('.mainTimeRow').hide();
+        this.container.find('.mainAllocRow').hide();
+    }
+};
+
+Details.prototype.onChange = function() {
+    var node = this.selection.getSelectedNode();
+    if (node) this.render(node);
+};
+</script>
+<script type="text/javascript">
+Sorting.prototype = new Model();
+Sorting.prototype.constructor = Sorting;
+
+Sorting.methods = {
+    'by-time': {
+        name:    'View by time',
+        getCost: function(node) {
+            return node.getTime();
+        }
+    },
+    'by-alloc': {
+        name:    'View by alloc',
+        getCost: function(node) {
+            return node.getAlloc();
+        }
+    }
+};
+
+function Sorting() {
+    Model.call(this);
+
+    this.method = Sorting.methods['by-time'];
+}
+
+Sorting.prototype.setMethodByKey = function(key) {
+    this.setMethod(Sorting.methods[key]);
+};
+
+Sorting.prototype.setMethod = function(method) {
+    this.method = method;
+    this.triggerChange();
+};
+
+Sorting.prototype.getCost = function(node) {
+    return this.method.getCost(node);
+};
+</script>
+<script type="text/javascript">
+TreeMap.HORI = 0;
+TreeMap.VERT = 1;
+
+function TreeMap(resizableCanvas, selection, sorting, zoom) {
+    var _this          = this;
+    this.canvas        = resizableCanvas.getCanvas();
+    this.rects         = {};
+    this.hover         = undefined;
+    this.selection     = selection;
+    this.sorting       = undefined;
+    this.zoom          = zoom;
+    this.renderTimeout = undefined;
+
+    $(this.canvas).mousemove(function(event) {
+        var node = _this.findMouseEventNode(event);
+        if (_this.hover != node) {
+            _this.hover = node;  // Only update when needed
+            if (node) _this.canvas.title = node.getCanonicalName();
+        }
+    });
+
+    $(this.canvas).click(function(event) {
+        var node = _this.findMouseEventNode(event);
+        if (node) {
+            // Select a node on the first click, expand it on second.
+            if (node.isSelected()) {
+                node.setExpanded(true);
+            } else {
+                node.select();
+            }
+        }
+    });
+
+    resizableCanvas.addChangeListener(this);
+    zoom.addChangeListener(this);
+    sorting.addChangeListener(this);
+    this.onChange(zoom);
+}
+
+TreeMap.prototype.mkRect = function(x, y, w, h) {
+    if (x == null || y == null || w == null || h == null) {
+        throw 'foo';
+    }
+
+    return {
+        x: x,
+        y: y,
+        w: w,
+        h: h
+    };
+};
+
+TreeMap.prototype.mkRootRect = function() {
+    return this.mkRect(0, 0, this.canvas.width, this.canvas.height);
+};
+
+TreeMap.prototype.findMouseEventNode = function(event) {
+    var _this  = this;
+    var offset = $(this.canvas).offset();
+    var x      = event.pageX - offset.left;
+    var y      = event.pageY - offset.top;
+
+    function find(node) {
+        for (var i = 0; i < node.children.length; i++) {
+            var r = _this.rects[node.children[i].id];
+            if (r && x >= r.x && x < r.x + r.w &&
+                    y >= r.y && y < r.y + r.h) {
+                return find(node.children[i]);
+            }
+        }
+
+        return node;
+    }
+
+    return node = this.zoom.getZoom() ? find(this.zoom.getZoom()) : undefined;
+};
+
+TreeMap.prototype.layoutChildren = function(node) {
+    var _this = this;
+
+    if (node.children.length > 0 && _this.rects[node.children[0].id]) {
+        return;  // Already layed out.
+    }
+
+    // Sum of areas
+    function sumCosts(nodes) {
+        var sum = 0;
+        for (var i = 0; i < nodes.length; i++) sum += nodes[i].getCost();
+        return sum;
+    }
+
+    // Assume that nodes is not empty. Calculates the worst aspect ratio
+    // when laying out the given nodes along the given side.
+    function worst(nodes, side) {
+        var cost = sumCosts(nodes);
+
+        function aspect(node) {
+            return Math.max(
+                    node.getCost() / cost,
+                    cost / node.getCost());
+        }
+
+        var max = aspect(nodes[0]);
+        for (var i = 1; i < nodes.length; i++) {
+            var a = aspect(nodes[i]);
+            if (a > max) max = a;
+        }
+
+        return max;
+    }
+
+    // Layout nodes after a split in the given direction.
+    function layoutRow(rect, nodes, dir) {
+        var cost = sumCosts(nodes);
+        var x    = rect.x;
+        var y    = rect.y;
+        for (var i = 0; i < nodes.length; i++) {
+            if (dir === TreeMap.HORI) {
+                var w = rect.w;
+                var h = rect.h * nodes[i].getCost() / cost;
+                _this.rects[nodes[i].id] = _this.mkRect(x, y, w, h);
+                y += h;
+            } else {
+                var w = rect.w * nodes[i].getCost() / cost;
+                var h = rect.h;
+                _this.rects[nodes[i].id] = _this.mkRect(x, y, w, h);
+                x += w;
+            }
+        }
+    }
+
+    // Main recursive worker. Nodes should not be empty.
+    function subdivide(rect, nodes, row, side, dir) {
+        var n = nodes[0];
+
+        if (row.length <= 0 ||
+                worst(row, side) >= worst(row.concat([n]), side)) {
+            var remaining = nodes.slice(1);
+            if (remaining.length <= 0) {
+                layoutRow(rect, row.concat([n]), dir);
+            } else {
+                subdivide(rect, remaining, row.concat([n]), side, dir);
+            }
+        } else {
+            var fillCost = sumCosts(row);
+            var nextCost = sumCosts(nodes);
+            var cost     = fillCost + nextCost;
+            var fillRect = undefined;
+            var nextRect = undefined;
+            if (dir === TreeMap.HORI) {
+                var w = rect.w * fillCost / cost;
+                fillRect = _this.mkRect(rect.x, rect.y, w, rect.h);
+                nextRect = _this.mkRect(
+                        rect.x + w, rect.y, rect.w - w, rect.h);
+            } else {
+                var h = rect.h * fillCost / cost;
+                fillRect = _this.mkRect(rect.x, rect.y, rect.w, h);
+                nextRect = _this.mkRect(
+                        rect.x, rect.y + h, rect.w, rect.h - h);
+            }
+
+            layoutRow(fillRect, row, dir);
+            squarify(nextRect, nodes);
+        }
+    }
+
+    // Top-level layouter
+    function squarify(rect, nodes) {
+        var cost = sumCosts(nodes);
+        var dir  = undefined;
+        var side = undefined;
+        if (rect.w > rect.h) {
+            dir  = TreeMap.HORI;
+            side = Math.sqrt(cost * rect.w / rect.h);
+        } else {
+            dir  = TreeMap.VERT;
+            side = Math.sqrt(cost * rect.h / rect.w);
+        }
+
+        subdivide(rect, nodes, [], side, dir);
+    }
+
+    // Go!
+    squarify(_this.rects[node.id], node.children);
+};
+
+TreeMap.prototype.render = function() {
+    var _this   = this;
+    window.clearTimeout(_this.renderTimeout);
+    _this.renderTimeout = window.setTimeout(function() {
+        var context = _this.canvas.getContext('2d');
+
+        // Clear frame
+        context.fillStyle = '#ffffff';
+        context.fillRect(0, 0, _this.canvas.width, _this.canvas.height);
+
+        // Recursively render all nodes
+        _this.renderNode(_this.zoom.getZoom());
+
+        // Render selection
+        var selected = _this.selection.getSelectedNode()
+        if (selected && _this.rects[selected.id]) {
+            var rect = _this.rects[selected.id];
+            context.lineWidth   = 3;
+            context.strokeStyle = '#ffffff';
+            context.strokeRect(rect.x, rect.y, rect.w, rect.h);
+        }
+    }, 50);
+};
+
+TreeMap.prototype.renderNode = function(node) {
+    var _this   = this;
+    var context = this.canvas.getContext('2d');
+    var rect    = this.rects[node.id];
+
+    // The user is not going to see it anyway.
+    if (!rect || rect.w < 2 || rect.h < 2) return;
+
+    // Fill entire area
+    context.fillStyle = node.getColor();
+    context.fillRect(rect.x, rect.y, rect.w, rect.h);
+    context.strokeStyle = 'black';
+    context.strokeRect(rect.x, rect.y, rect.w, rect.h);
+
+    // Draw children on top.
+    if (node.children.length > 0) {
+        _this.layoutChildren(node);
+        for (var i = 0; i < node.children.length; i++) {
+            _this.renderNode(node.children[i]);
+        }
+    }
+};
+
+TreeMap.prototype.onChange = function(source) {
+    var _this = this;
+
+    if (source instanceof ResizingCanvas ||
+            source instanceof Sorting ||
+            source instanceof Zoom) {
+        var node = _this.zoom.getZoom();
+        _this.rects = {};
+        _this.rects[node.id] = _this.mkRootRect();
+        _this.render();
+        node.addChangeListener(this);
+    } else if (source instanceof Node) {
+        _this.render();
+        for (var i = 0; i < source.children.length; i++) {
+            source.children[i].addChangeListener(this);
+        }
+    }
+};
+</script>
+<script type="text/javascript">
+function mk(el) {
+    return $(document.createElement(el));
+}
+
+function TreeBrowser(container, zoom) {
+    this.zoom      = zoom;
+    this.elements  = {};
+    this.container = container;
+
+    zoom.addChangeListener(this);
+    this.onChange(zoom);
+}
+
+TreeBrowser.prototype.mkElement = function(node) {
+    var div = mk('div').addClass('tree-browser node');
+
+    if (node.isExpandable()) {
+        var chevron = mk('span').addClass('tree-browser chevron');
+        chevron.click(function() { node.toggleExpanded(); });
+        div.append(chevron);
+    }
+
+    var code = mk('code').text(node.getCanonicalName());
+    code.addClass('tree-browser name');
+    code.attr('style', 'background-color: ' + node.getColor());
+    code.click(function() { node.select(); });
+    div.append(code);
+
+    var children = mk('div').addClass('tree-browser children');
+    div.append(children);
+
+    return div;
+};
+
+TreeBrowser.prototype.renderNode = function(element, node) {
+    if (node.isExpandable()) {
+        element.children('.chevron').text(
+                node.expanded ? Unicode.DOWN_TRIANGLE : Unicode.RIGHT_TRIANGLE);
+    }
+
+    element.children('.name').toggleClass('selected', node.isSelected());
+
+    var children = element.children('.children');
+    if (node.children.length > 0) {
+        if (children.is(':empty')) {
+            for (var i = 0; i < node.children.length; i++) {
+                var div = this.mkElement(node.children[i]);
+                this.elements[node.children[i].id] = div;
+                this.renderNode(div, node.children[i]);
+                children.append(div);
+            }
+        } else {
+            children.children().detach();
+            for (var i = 0; i < node.children.length; i++) {
+                var div = this.elements[node.children[i].id];
+                children.append(div);
+            }
+        }
+    }
+
+    if (node.children.length <= 0 && !children.is(':empty')) {
+        children.empty();
+    }
+};
+
+TreeBrowser.prototype.scrollToNode = function(node) {
+    var element  = this.elements[node.id];
+    var position = element.position();
+    var top      = this.container.scrollTop();
+    var left     = this.container.scrollLeft();
+    var height   = this.container.height();
+    var width    = this.container.width();
+
+    if (position.top < 0 || position.top >= height ||
+            position.left < 0 || position.left >= width) {
+        this.container.scrollTop(top + position.top - height / 2);
+        this.container.scrollLeft(left + position.left);
+    }
+};
+
+TreeBrowser.prototype.onChange = function(source) {
+    var _this   = this;
+    if (source instanceof Zoom) {
+        var node = _this.zoom.getZoom();
+        _this.container.empty();
+        _this.elements = [];
+        _this.elements[node.id] = _this.mkElement(node);
+        _this.container.append(_this.elements[node.id]);
+        _this.renderNode(_this.elements[node.id], node);
+        node.addChangeListener(_this);
+    } else if (source instanceof Node) {
+        var element = _this.elements[source.id];
+
+        if (!element) return;  // Invisible source changed what?
+
+        _this.renderNode(element, source);
+        for (var i = 0; i < source.children.length; i++) {
+            source.children[i].addChangeListener(_this);
+        }
+
+        if (source.isSelected()) _this.scrollToNode(source);
+    }
+}
+</script>
+<script type="text/javascript">
+////////////////////////////////////////////////////////////////////////////////
+// Hooking up
+////////////////////////////////////////////////////////////////////////////////
+
+function main() {
+    var selection = new Selection();
+    var sorting = new Sorting();
+    var root = new Node($prof[0], selection, sorting, undefined, $prof[1]);
+
+    var zoom = new Zoom(root);
+    var tb = new TreeBrowser($('#tree'), zoom);
+    var rc = new ResizingCanvas($('#map'));
+    var tm = new TreeMap(rc, selection, sorting, zoom);
+    var details = new Details($('#details'), selection, sorting, zoom);
+    selection.setSelectedNode(root);
+}
+
+$(document).ready(function () {
+    // alert('Hello wooorld');
+    main();
+});
+</script>
+  </head>
+  <body>
+<div id="details-tree">
+    <div id="details"></div>
+    <div id="tree"></div>
+</div>
+
+<div id="map"></div>
+
+  </body></html>
diff --git a/helper.hs b/helper.hs
new file mode 100644
index 00000000..433cb648
--- /dev/null
+++ b/helper.hs
@@ -0,0 +1,19 @@
+{-# LANGUAGE GeneralizedNewtypeDeriving #-}
+
+module Main
+    ( module Main
+    , module Data.HashMap.Base
+    ) where
+
+import Data.HashMap.Base
+import Data.Hashable
+import Test.QuickCheck
+
+newtype Key = K
+    { unK :: Int
+    } deriving (Arbitrary, Eq, Ord, Read, Show)
+
+instance Hashable Key where
+    hashWithSalt salt k = Data.Hashable.hashWithSalt salt (unK k) `mod` 20
+
+main = pure ()

From 3db53fc4986fbcedf5de9000b210deaddf141012 Mon Sep 17 00:00:00 2001
From: Tom Sydney Kerckhove <syd@fpcomplete.com>
Date: Wed, 15 Aug 2018 08:30:03 +0200
Subject: [PATCH 09/69] fixed some bugs

---
 Data/HashMap/Base.hs | 44 +++++++++++++++++++++++---------------------
 helper.hs            |  3 +++
 2 files changed, 26 insertions(+), 21 deletions(-)

diff --git a/Data/HashMap/Base.hs b/Data/HashMap/Base.hs
index f0857028..7286e0fc 100644
--- a/Data/HashMap/Base.hs
+++ b/Data/HashMap/Base.hs
@@ -168,7 +168,7 @@ hashWithSalt :: H.Hashable a => Salt -> a -> Hash
 hashWithSalt s v = fromIntegral $ H.hashWithSalt s v
 
 data Leaf k v = L !k v
-  deriving (Eq)
+  deriving (Show, Eq)
 
 instance (NFData k, NFData v) => NFData (Leaf k v) where
     rnf (L k v) = rnf k `seq` rnf v
@@ -184,7 +184,7 @@ data HashMap k v
     | Leaf !Hash !(Leaf k v)
     | Full !(A.Array (HashMap k v))
     | Collision !Hash !Salt !(HashMap k v) -- The new salt (TODO remove this comment)
-      deriving (Typeable)
+      deriving (Show, Typeable)
 
 type role HashMap nominal representational
 
@@ -264,9 +264,9 @@ instance (Eq k, Hashable k, Read k, Read e) => Read (HashMap k e) where
 
     readListPrec = readListPrecDefault
 
-instance (Show k, Show v) => Show (HashMap k v) where
-    showsPrec d m = showParen (d > 10) $
-      showString "fromList " . shows (toList m)
+--instance (Show k, Show v) => Show (HashMap k v) where
+--    showsPrec d m = showParen (d > 10) $
+--      showString "fromList " . shows (toList m)
 
 instance Traversable (HashMap k) where
     traverse f = traverseWithKey (const f)
@@ -506,7 +506,7 @@ lookup k m = lookupCont (\_ -> Nothing) (\v _i -> Just v) (hashWithSalt s k) def
 
 -- | lookup' is a version of lookup that takes the hash separately.
 -- It is used to implement alterF.
-lookup' :: Eq k => Hash -> Salt -> k -> HashMap k v -> Maybe v
+lookup' :: (Eq k, Hashable k) => Hash -> Salt -> k -> HashMap k v -> Maybe v
 #if __GLASGOW_HASKELL__ >= 802
 -- GHC does not yet perform a worker-wrapper transformation on
 -- unboxed sums automatically. That seems likely to happen at some
@@ -540,7 +540,7 @@ data LookupRes a = Absent | Present a !Int
 --   Key not in map           => Absent
 --   Key in map, no collision => Present v (-1)
 --   Key in map, collision    => Present v position
-lookupRecordCollision :: Eq k => Hash -> Salt -> k -> HashMap k v -> LookupRes v
+lookupRecordCollision :: (Eq k, Hashable k) => Hash -> Salt -> k -> HashMap k v -> LookupRes v
 #if __GLASGOW_HASKELL__ >= 802
 lookupRecordCollision h s k m = case lookupRecordCollision# h s k m of
   (# (# #) | #) -> Absent
@@ -552,7 +552,7 @@ lookupRecordCollision h s k m = case lookupRecordCollision# h s k m of
 -- may be changing in GHC 8.6 or so (there is some work in progress), but
 -- for now we use Int# explicitly here. We don't need to push the Int#
 -- into lookupCont because inlining takes care of that.
-lookupRecordCollision# :: Eq k => Hash -> Salt -> k -> HashMap k v -> (# (# #) | (# v, Int# #) #)
+lookupRecordCollision# :: (Eq k, Hashable k) => Hash -> Salt -> k -> HashMap k v -> (# (# #) | (# v, Int# #) #)
 lookupRecordCollision# h s k m =
     lookupCont (\_ -> (# (# #) | #)) (\v (I# i) -> (# | (# v, i #) #)) h s k m
 -- INLINABLE to specialize to the Eq instance.
@@ -578,7 +578,7 @@ lookupCont ::
 #else
   forall r k v.
 #endif
-     Eq k
+     (Eq k, Hashable k)
   => ((# #) -> r)    -- Absent continuation
   -> (v -> Int -> r) -- Present continuation
   -> Hash -- The hash of the key
@@ -595,11 +595,11 @@ lookupCont absent present !h0 !s0 !k0 !m0 = go h0 s0 k0 0 m0
         | b .&. m == 0 = absent (# #)
         | otherwise    =
             go h s k (bs+bitsPerSubkey) (A.index v (sparseIndex b m))
-      where m = mask h s
+      where m = mask h bs
     go h s k bs (Full v) =
-      go h s k (bs+bitsPerSubkey) (A.index v (index h s))
+      go h s k (bs+bitsPerSubkey) (A.index v (index h bs))
     go h s k _ (Collision hx sx hmx)
-        | h == hx   = go h sx k 0 hmx
+        | h == hx   = go (hashWithSalt sx k) sx k 0 hmx
         | otherwise = absent (# #)
 {-# INLINE lookupCont #-}
 
@@ -625,15 +625,17 @@ infixl 9 !
 
 -- | Create a 'Collision' value with two 'Leaf' values.
 collision :: (Eq k, Hashable k) => Hash -> Salt -> Leaf k v -> Leaf k v -> HashMap k v
-collision h s !l1@(L k1 v1) !l2@(L k2 v2) =
-  let s' = nextSalt s
-      rehash = hashWithSalt s'
-      h1 = rehash k1
-      h2 = rehash k2
-      hm = if h1 == h2
-        then Collision h s' $ collision h1 s' l1 l2
-        else runST $ two 0 h1 k1 v1 h2 k2 v2
-  in Collision h s' hm
+collision h0 s0 !l1@(L k1 v1) !l2@(L k2 v2) = go h0 s0
+  where
+    go h s =
+      let s' = nextSalt s
+          rehash = hashWithSalt s'
+          h1 = rehash k1
+          h2 = rehash k2
+          hm = if h1 == h2
+            then go h1 s'
+            else runST $ two 0 h1 k1 v1 h2 k2 v2
+      in Collision h s' hm
 {-# INLINE collision #-}
 
 defaultSalt :: Int
diff --git a/helper.hs b/helper.hs
index 433cb648..79715b0e 100644
--- a/helper.hs
+++ b/helper.hs
@@ -1,13 +1,16 @@
 {-# LANGUAGE GeneralizedNewtypeDeriving #-}
+{-# OPTIONS_GHC -fno-warn-type-defaults #-}
 
 module Main
     ( module Main
     , module Data.HashMap.Base
+    , ppShow
     ) where
 
 import Data.HashMap.Base
 import Data.Hashable
 import Test.QuickCheck
+import Text.Show.Pretty
 
 newtype Key = K
     { unK :: Int

From feeb8c452f9100705f2621d5f7694d1fbf67d13b Mon Sep 17 00:00:00 2001
From: Tom Sydney Kerckhove <syd@fpcomplete.com>
Date: Wed, 15 Aug 2018 08:36:17 +0200
Subject: [PATCH 10/69] At least now the test completes

---
 tests/HashMapProperties.hs | 19 +++++++++----------
 1 file changed, 9 insertions(+), 10 deletions(-)

diff --git a/tests/HashMapProperties.hs b/tests/HashMapProperties.hs
index ded3be6d..26e5f562 100644
--- a/tests/HashMapProperties.hs
+++ b/tests/HashMapProperties.hs
@@ -128,19 +128,17 @@ pInsert k v = M.insert k v `eq_` HM.insert k v
 pDelete :: Key -> [(Key, Int)] -> Bool
 pDelete k = M.delete k `eq_` HM.delete k
 
-newtype AlwaysCollide = AC Int
-    deriving (Arbitrary, Eq, Ord, Show)
-
-instance Hashable AlwaysCollide where
-    hashWithSalt _ _ = 1
-
 -- White-box test that tests the case of deleting one of two keys from
 -- a map, where the keys' hash values collide.
-pDeleteCollision :: AlwaysCollide -> AlwaysCollide -> AlwaysCollide -> Int
+pDeleteCollision :: Key -> Key -> Key -> Int
                  -> Property
-pDeleteCollision k1 k2 k3 idx = (k1 /= k2) && (k2 /= k3) && (k1 /= k3) ==>
-                                HM.member toKeep $ HM.delete toDelete $
-                                HM.fromList [(k1, 1 :: Int), (k2, 2), (k3, 3)]
+pDeleteCollision k1 k2 k3 idx =
+  (k1 /= k2) && (k2 /= k3) && (k1 /= k3) &&
+  (hashWithSalt defaultSalt k1 == hashWithSalt defaultSalt k2) &&
+  (hashWithSalt defaultSalt k2 == hashWithSalt defaultSalt k3) &&
+  (hashWithSalt defaultSalt k1 == hashWithSalt defaultSalt k3) ==>
+  HM.member toKeep $ HM.delete toDelete $
+  HM.fromList [(k1, 1 :: Int), (k2, 2), (k3, 3)]
   where
     which = idx `mod` 3
     toDelete
@@ -153,6 +151,7 @@ pDeleteCollision k1 k2 k3 idx = (k1 /= k2) && (k2 /= k3) && (k1 /= k3) ==>
         | which == 1 = k3
         | which == 2 = k1
         | otherwise = error "Impossible"
+    defaultSalt = -2578643520546668380 -- TODO what do do with this test?
 
 pInsertWith :: Key -> [(Key, Int)] -> Bool
 pInsertWith k = M.insertWith (+) k 1 `eq_` HM.insertWith (+) k 1

From e725b1f1b24d7964343d7f29ada9d7df536ece0b Mon Sep 17 00:00:00 2001
From: Tom Sydney Kerckhove <syd@fpcomplete.com>
Date: Wed, 15 Aug 2018 08:49:52 +0200
Subject: [PATCH 11/69] Fixed the unions

---
 Data/HashMap/Base.hs        | 8 ++++----
 Data/HashMap/Strict/Base.hs | 8 ++++----
 2 files changed, 8 insertions(+), 8 deletions(-)

diff --git a/Data/HashMap/Base.hs b/Data/HashMap/Base.hs
index 7286e0fc..96717cd7 100644
--- a/Data/HashMap/Base.hs
+++ b/Data/HashMap/Base.hs
@@ -1293,11 +1293,11 @@ unionWithKey f = go 0 s0
                       then Leaf h1 (L k1 (f k1 v1 v2))
                       else collision h1 s l1 l2
         | otherwise = goDifferentHash bs s h1 h2 t1 t2
-    go bs s t1@(Leaf h1 (L k1 v1)) t2@(Collision h2 s2 hm2)
-        | h1 == h2  = Collision h1 s2 $ insert' (hashWithSalt s2 k1) s2 k1 v1 hm2
+    go bs s t1@(Leaf h1 l1@(L k1 v1)) t2@(Collision h2 s2 hm2)
+        | h1 == h2  = Collision h1 s2 $ go 0 s2 (Leaf (hashWithSalt s2 k1) l1) hm2
         | otherwise = goDifferentHash bs s h1 h2 t1 t2
-    go bs s t1@(Collision h1 s1 hm1) t2@(Leaf h2 (L k2 v2))
-        | h1 == h2  = Collision h1 s1 $ insert' (hashWithSalt s1 k2) s1 k2 v2 hm1
+    go bs s t1@(Collision h1 s1 hm1) t2@(Leaf h2 l2@(L k2 v2))
+        | h1 == h2  = Collision h1 s1 $ go 0 s1 hm1 (Leaf (hashWithSalt s1 k2) l2)
         | otherwise = goDifferentHash bs s h1 h2 t1 t2
     go bs s t1@(Collision h1 s1 hm1) t2@(Collision h2 _ hm2) -- Second salt must be equal
         | h1 == h2  = Collision h1 s1 $ go 0 s1 hm1 hm2
diff --git a/Data/HashMap/Strict/Base.hs b/Data/HashMap/Strict/Base.hs
index c5edb9b2..3e165f6a 100644
--- a/Data/HashMap/Strict/Base.hs
+++ b/Data/HashMap/Strict/Base.hs
@@ -417,11 +417,11 @@ unionWithKey f = go 0 s0
                       then leaf h1 k1 (f k1 v1 v2)
                       else collision h1 s l1 l2
         | otherwise = goDifferentHash bs s h1 h2 t1 t2
-    go bs s t1@(Leaf h1 (L k1 v1)) t2@(Collision h2 s2 hm2)
-        | h1 == h2  = Collision h1 s2 $ insert' (hashWithSalt s2 k1) s2 k1 v1 hm2
+    go bs s t1@(Leaf h1 l1@(L k1 v1)) t2@(Collision h2 s2 hm2)
+        | h1 == h2  = Collision h1 s2 $ go 0 s2 (Leaf (hashWithSalt s2 k1) l1) hm2
         | otherwise = goDifferentHash bs s h1 h2 t1 t2
-    go bs s t1@(Collision h1 s1 hm1) t2@(Leaf h2 (L k2 v2))
-        | h1 == h2  = Collision h1 s1 $ insert' (hashWithSalt s1 k2) s1 k2 v2 hm1
+    go bs s t1@(Collision h1 s1 hm1) t2@(Leaf h2 l2@(L k2 v2))
+        | h1 == h2  = Collision h1 s1 $ go 0 s1 hm1 (Leaf (hashWithSalt s1 k2) l2)
         | otherwise = goDifferentHash bs s h1 h2 t1 t2
     go bs s t1@(Collision h1 s1 hm1) t2@(Collision h2 _ hm2) -- Second salt must be equal
         | h1 == h2  = Collision h1 s1 $ go 0 s1 hm1 hm2

From e687bba82113bf17df5dc67e28fbd6c2c40fe6ad Mon Sep 17 00:00:00 2001
From: Tom Sydney Kerckhove <syd@fpcomplete.com>
Date: Wed, 15 Aug 2018 08:58:47 +0200
Subject: [PATCH 12/69] Made strict hashmap tests pass

---
 Data/HashMap/Base.hs        | 17 ++++++-----------
 Data/HashMap/Strict/Base.hs |  5 +----
 tests/HashMapProperties.hs  |  8 +++++++-
 3 files changed, 14 insertions(+), 16 deletions(-)

diff --git a/Data/HashMap/Base.hs b/Data/HashMap/Base.hs
index 96717cd7..f630f78f 100644
--- a/Data/HashMap/Base.hs
+++ b/Data/HashMap/Base.hs
@@ -1558,12 +1558,9 @@ foldrWithKey f = go
 -- | /O(n)/ Transform this map by applying a function to every value
 --   and retaining only some of them.
 mapMaybeWithKey :: (k -> v1 -> Maybe v2) -> HashMap k v1 -> HashMap k v2
-mapMaybeWithKey f = filterMapAux onLeaf onColl
+mapMaybeWithKey f = filterMapAux onLeaf
   where onLeaf (Leaf h (L k v)) | Just v' <- f k v = Just (Leaf h (L k v'))
         onLeaf _ = Nothing
-
-        onColl (L k v) | Just v' <- f k v = Just (L k v')
-                       | otherwise = Nothing
 {-# INLINE mapMaybeWithKey #-}
 
 -- | /O(n)/ Transform this map by applying a function to every value
@@ -1575,12 +1572,9 @@ mapMaybe f = mapMaybeWithKey (const f)
 -- | /O(n)/ Filter this map by retaining only elements satisfying a
 -- predicate.
 filterWithKey :: forall k v. (k -> v -> Bool) -> HashMap k v -> HashMap k v
-filterWithKey pred = filterMapAux onLeaf onColl
+filterWithKey pred = filterMapAux onLeaf
   where onLeaf t@(Leaf _ (L k v)) | pred k v = Just t
         onLeaf _ = Nothing
-
-        onColl el@(L k v) | pred k v = Just el
-        onColl _ = Nothing
 {-# INLINE filterWithKey #-}
 
 
@@ -1588,10 +1582,9 @@ filterWithKey pred = filterMapAux onLeaf onColl
 --   allowing the former to former to reuse terms.
 filterMapAux :: forall k v1 v2
               . (HashMap k v1 -> Maybe (HashMap k v2))
-             -> (Leaf k v1 -> Maybe (Leaf k v2))
              -> HashMap k v1
              -> HashMap k v2
-filterMapAux onLeaf onColl = go
+filterMapAux onLeaf = go
   where
     go Empty = Empty
     go t@Leaf{}
@@ -1599,7 +1592,7 @@ filterMapAux onLeaf onColl = go
         | otherwise = Empty
     go (BitmapIndexed b ary) = filterA ary b
     go (Full ary) = filterA ary fullNodeMask
-    go (Collision _ _ hm) = undefined hm -- TODO
+    go (Collision h s hm) = filterC h s hm
 
     filterA ary0 b0 =
         let !n = A.length ary0
@@ -1629,6 +1622,8 @@ filterMapAux onLeaf onColl = go
                          (bi `unsafeShiftL` 1) n
                 t     -> do A.write mary j t
                             step ary mary b (i+1) (j+1) (bi `unsafeShiftL` 1) n
+
+    filterC h s hm = Collision h s $ go hm -- TODO deal with the collision being deleted?
 {-# INLINE filterMapAux #-}
 
 -- | /O(n)/ Filter this map by retaining only elements which values
diff --git a/Data/HashMap/Strict/Base.hs b/Data/HashMap/Strict/Base.hs
index 3e165f6a..edfeb03d 100644
--- a/Data/HashMap/Strict/Base.hs
+++ b/Data/HashMap/Strict/Base.hs
@@ -515,12 +515,9 @@ map f = mapWithKey (const f)
 -- | /O(n)/ Transform this map by applying a function to every value
 --   and retaining only some of them.
 mapMaybeWithKey :: (k -> v1 -> Maybe v2) -> HashMap k v1 -> HashMap k v2
-mapMaybeWithKey f = filterMapAux onLeaf onColl
+mapMaybeWithKey f = filterMapAux onLeaf
   where onLeaf (Leaf h (L k v)) | Just v' <- f k v = Just (leaf h k v')
         onLeaf _ = Nothing
-
-        onColl (L k v) | Just v' <- f k v = Just (L k v')
-                       | otherwise = Nothing
 {-# INLINE mapMaybeWithKey #-}
 
 -- | /O(n)/ Transform this map by applying a function to every value
diff --git a/tests/HashMapProperties.hs b/tests/HashMapProperties.hs
index 26e5f562..1bff4973 100644
--- a/tests/HashMapProperties.hs
+++ b/tests/HashMapProperties.hs
@@ -128,9 +128,15 @@ pInsert k v = M.insert k v `eq_` HM.insert k v
 pDelete :: Key -> [(Key, Int)] -> Bool
 pDelete k = M.delete k `eq_` HM.delete k
 
+newtype MostlyCollide = AC Int
+    deriving (Arbitrary, Eq, Ord, Show)
+
+instance Hashable MostlyCollide where
+    hashWithSalt s (AC i) = (hashWithSalt s i) `mod` 3
+
 -- White-box test that tests the case of deleting one of two keys from
 -- a map, where the keys' hash values collide.
-pDeleteCollision :: Key -> Key -> Key -> Int
+pDeleteCollision :: MostlyCollide -> MostlyCollide -> MostlyCollide -> Int
                  -> Property
 pDeleteCollision k1 k2 k3 idx =
   (k1 /= k2) && (k2 /= k3) && (k1 /= k3) &&

From 789dd5efa62b5dd0ed53f07df64a9230e83cd07a Mon Sep 17 00:00:00 2001
From: Tom Sydney Kerckhove <syd@fpcomplete.com>
Date: Wed, 15 Aug 2018 09:11:00 +0200
Subject: [PATCH 13/69] Now without storing the salt anywhere

---
 Data/HashMap/Base.hs        | 125 ++++++++++++++++++------------------
 Data/HashMap/Strict/Base.hs |  34 +++++-----
 2 files changed, 79 insertions(+), 80 deletions(-)

diff --git a/Data/HashMap/Base.hs b/Data/HashMap/Base.hs
index f630f78f..58c45521 100644
--- a/Data/HashMap/Base.hs
+++ b/Data/HashMap/Base.hs
@@ -84,6 +84,7 @@ module Data.HashMap.Base
     , collision
     , hashWithSalt
     , defaultSalt
+    , nextSalt
     , mask
     , index
     , bitsPerSubkey
@@ -183,7 +184,7 @@ data HashMap k v
     | BitmapIndexed !Bitmap !(A.Array (HashMap k v))
     | Leaf !Hash !(Leaf k v)
     | Full !(A.Array (HashMap k v))
-    | Collision !Hash !Salt !(HashMap k v) -- The new salt (TODO remove this comment)
+    | Collision !Hash !(HashMap k v)
       deriving (Show, Typeable)
 
 type role HashMap nominal representational
@@ -193,7 +194,7 @@ instance (NFData k, NFData v) => NFData (HashMap k v) where
     rnf (BitmapIndexed _ ary) = rnf ary
     rnf (Leaf _ l)            = rnf l
     rnf (Full ary)            = rnf ary
-    rnf (Collision _ _ ary)     = rnf ary
+    rnf (Collision _ ary)     = rnf ary
 
 instance Functor (HashMap k) where
     fmap = map
@@ -296,8 +297,8 @@ equal1 eq = go
       = bm1 == bm2 && A.sameArray1 go ary1 ary2
     go (Leaf h1 l1) (Leaf h2 l2) = h1 == h2 && leafEq l1 l2
     go (Full ary1) (Full ary2) = A.sameArray1 go ary1 ary2
-    go (Collision h1 s1 hm1) (Collision h2 s2 hm2)
-      = h1 == h2 && s1 == s2 && go hm1 hm2
+    go (Collision h1 hm1) (Collision h2 hm2)
+      = h1 == h2 && go hm1 hm2
     go _ _ = False
 
     leafEq (L k1 v1) (L k2 v2) = k1 == k2 && eq v1 v2
@@ -314,9 +315,8 @@ equal2 eqk eqv t1 t2 = go (toList' t1 []) (toList' t2 [])
       | k1 == k2 &&
         leafEq l1 l2
       = go tl1 tl2
-    go (Collision h1 s1 hm1 : tl1) (Collision h2 s2 hm2 : tl2)
+    go (Collision h1 hm1 : tl1) (Collision h2 hm2 : tl2)
       | h1 == h2 &&
-        s1 == s2 &&
         go (toList' hm1 []) (toList' hm2 [])
       = go tl1 tl2
     go [] [] = True
@@ -348,13 +348,12 @@ cmp cmpk cmpv t1 t2 = go (toList' t1 []) (toList' t2 [])
       = compare k1 k2 `mappend`
         leafCompare l1 l2 `mappend`
         go tl1 tl2
-    go (Collision h1 s1 hm1 : tl1) (Collision h2 s2 hm2 : tl2)
+    go (Collision h1 hm1 : tl1) (Collision h2 hm2 : tl2)
       = compare h1 h2 `mappend`
-        compare s1 s2 `mappend`
         go (toList' hm1 []) (toList' hm2 []) `mappend`
         go tl1 tl2
-    go (Leaf _ _ : _) (Collision _ _ _ : _) = LT
-    go (Collision _ _ _ : _) (Leaf _ _ : _) = GT
+    go (Leaf _ _ : _) (Collision _ _ : _) = LT
+    go (Collision _ _ : _) (Leaf _ _ : _) = GT
     go [] [] = EQ
     go [] _  = LT
     go _  [] = GT
@@ -369,8 +368,8 @@ equalKeys1 eq t1 t2 = go (toList' t1 []) (toList' t2 [])
     go (Leaf k1 l1 : tl1) (Leaf k2 l2 : tl2)
       | k1 == k2 && leafEq l1 l2
       = go tl1 tl2
-    go (Collision h1 s1 hm1 : tl1) (Collision h2 s2 hm2 : tl2)
-      | h1 == h2 && s1 == s2 &&
+    go (Collision h1 hm1 : tl1) (Collision h2 hm2 : tl2)
+      | h1 == h2 &&
         go (toList' hm1 []) (toList' hm2 [])
       = go tl1 tl2
     go [] [] = True
@@ -388,8 +387,8 @@ equalKeys = go
       = bm1 == bm2 && A.sameArray1 go ary1 ary2
     go (Leaf h1 l1) (Leaf h2 l2) = h1 == h2 && leafEq l1 l2
     go (Full ary1) (Full ary2) = A.sameArray1 go ary1 ary2
-    go (Collision h1 s1 hm1) (Collision h2 s2 hm2)
-      = h1 == h2 && s1 == s2 && go hm1 hm2
+    go (Collision h1 hm1) (Collision h2 hm2)
+      = h1 == h2 && go hm1 hm2
     go _ _ = False
 
     leafEq (L k1 _) (L k2 _) = k1 == k2
@@ -404,8 +403,8 @@ instance H.Hashable2 HashMap where
           = s `hashLeafWithSalt` l `go` tl
         -- For collisions we hashmix hash value
         -- and then array of values' hashes sorted
-        go s (Collision h s' hm' : tl)
-          = (((s `H.hashWithSalt` h) `H.hashWithSalt` s') `go` (toList' hm' [])) `go` tl
+        go s (Collision h hm' : tl)
+          = ((s `H.hashWithSalt` h) `go` (toList' hm' [])) `go` tl
         go s (_ : tl) = s `go` tl
 
         -- hashLeafWithSalt :: Int -> Leaf k v -> Int
@@ -424,8 +423,8 @@ instance (Hashable k, Hashable v) => Hashable (HashMap k v) where
           = s `hashLeafWithSalt` l `go` tl
         -- For collisions we hashmix hash value
         -- and then array of values' hashes sorted
-        go s (Collision h s' hm' : tl)
-          = (((s `H.hashWithSalt` h) `H.hashWithSalt` s') `go` (toList' hm' [])) `go` tl
+        go s (Collision h hm' : tl)
+          = ((s `H.hashWithSalt` h) `go` (toList' hm' [])) `go` tl
         go s (_ : tl) = s `go` tl
 
         hashLeafWithSalt :: Int -> Leaf k v -> Int
@@ -436,13 +435,13 @@ toList' :: HashMap k v -> [HashMap k v] -> [HashMap k v]
 toList' (BitmapIndexed _ ary) a = A.foldr toList' a ary
 toList' (Full ary)            a = A.foldr toList' a ary
 toList' l@(Leaf _ _)          a = l : a
-toList' (Collision _ _ hm)    a = toList' hm a
+toList' (Collision _ hm)    a = toList' hm a
 toList' Empty                 a = a
 
 -- Helper function to detect 'Leaf's and 'Collision's.
 isLeafOrCollision :: HashMap k v -> Bool
 isLeafOrCollision (Leaf _ _)        = True
-isLeafOrCollision (Collision _ _ _) = True
+isLeafOrCollision (Collision _ _) = True
 isLeafOrCollision _                 = False
 
 ------------------------------------------------------------------------
@@ -472,7 +471,7 @@ size t = go t 0
     go (Leaf _ _)            n = n + 1
     go (BitmapIndexed _ ary) n = A.foldl' (flip go) n ary
     go (Full ary)            n = A.foldl' (flip go) n ary
-    go (Collision _ _ hm)    n = go hm n
+    go (Collision _ hm)      n = go hm n
 
 -- | /O(log n)/ Return 'True' if the specified key is present in the
 -- map, 'False' otherwise.
@@ -598,8 +597,8 @@ lookupCont absent present !h0 !s0 !k0 !m0 = go h0 s0 k0 0 m0
       where m = mask h bs
     go h s k bs (Full v) =
       go h s k (bs+bitsPerSubkey) (A.index v (index h bs))
-    go h s k _ (Collision hx sx hmx)
-        | h == hx   = go (hashWithSalt sx k) sx k 0 hmx
+    go h s k _ (Collision hx hmx)
+        | h == hx   = go (hashWithSalt (nextSalt s) k) (nextSalt s) k 0 hmx
         | otherwise = absent (# #)
 {-# INLINE lookupCont #-}
 
@@ -635,7 +634,7 @@ collision h0 s0 !l1@(L k1 v1) !l2@(L k2 v2) = go h0 s0
           hm = if h1 == h2
             then go h1 s'
             else runST $ two 0 h1 k1 v1 h2 k2 v2
-      in Collision h s' hm
+      in Collision h hm
 {-# INLINE collision #-}
 
 defaultSalt :: Int
@@ -693,8 +692,8 @@ insert' h0 s0 k0 v0 m0 = go h0 s0 k0 v0 0 m0
             then t
             else Full (update16 ary i st')
       where i = index h bs
-    go h s k x bs t@(Collision hx sx hmx)
-        | h == hx   = Collision hx sx $ go (hashWithSalt sx k) sx k x 0 hmx
+    go h s k x bs t@(Collision hx hmx)
+        | h == hx   = Collision hx $ go (hashWithSalt (nextSalt s) k) (nextSalt s) k x 0 hmx
         | otherwise = go h s k x bs $ BitmapIndexed (mask hx bs) (A.singleton t)
 {-# INLINABLE insert' #-}
 
@@ -727,8 +726,8 @@ insertNewKey !h0 !s0 !k0 x0 !m0 = go h0 s0 k0 x0 0 m0
             !st' = go h s k x (bs+bitsPerSubkey) st
         in Full (update16 ary i st')
       where i = index h bs
-    go h s k x bs t@(Collision hx sx hmx)
-        | h == hx   = Collision hx sx $ go (hashWithSalt sx k) sx k x 0 hmx
+    go h s k x bs t@(Collision hx hmx)
+        | h == hx   = Collision hx $ go (hashWithSalt (nextSalt s) k) (nextSalt s) k x 0 hmx
         | otherwise =
             go h s k x bs $ BitmapIndexed (mask hx bs) (A.singleton t)
 {-# NOINLINE insertNewKey #-}
@@ -758,8 +757,8 @@ insertKeyExists !h0 !s0 !k0 x0 !m0 = go h0 s0 k0 x0 0 m0
             !st' = go h s k x (bs+bitsPerSubkey) st
         in Full (update16 ary i st')
       where i = index h bs
-    go h s k x bs t@(Collision hx sx hmx)
-        | h == hx   = Collision hx sx $ go (hashWithSalt sx k) sx k x 0 hmx
+    go h s k x bs t@(Collision hx hmx)
+        | h == hx   = Collision hx $ go (hashWithSalt (nextSalt s) k) (nextSalt s) k x 0 hmx
         | otherwise =
             go h s k x bs $ BitmapIndexed (mask hx bs) (A.singleton t)
     go _ _ _ _ _ Empty = Empty -- error "Internal error: go Empty"
@@ -805,8 +804,8 @@ unsafeInsert k0 v0 m0 = runST (go h0 s0 k0 v0 0 m0)
         A.unsafeUpdateM ary i st'
         return t
       where i = index h bs
-    go h s k x bs t@(Collision hx sx hmx)
-        | h == hx   = Collision hx sx <$> go (hashWithSalt sx k) sx k x 0 hmx
+    go h s k x bs t@(Collision hx hmx)
+        | h == hx   = Collision hx <$> go (hashWithSalt (nextSalt s) k) (nextSalt s) k x 0 hmx
         | otherwise = go h s k x bs $ BitmapIndexed (mask hx bs) (A.singleton t)
 {-# INLINABLE unsafeInsert #-}
 
@@ -885,9 +884,9 @@ insertModifying x f k0 m0 = go h0 s0 k0 0 m0
            then t
            else Full ary'
       where i = index h bs
-    go h s k bs t@(Collision hx sx hmx)
+    go h s k bs t@(Collision hx hmx)
         | h == hx   =
-            Collision hx sx $ go (hashWithSalt sx k) sx k 0 hmx
+            Collision hx $ go (hashWithSalt (nextSalt s) k) (nextSalt s) k 0 hmx
         | otherwise = go h s k bs $ BitmapIndexed (mask hx bs) (A.singleton t)
 {-# INLINABLE insertModifying #-}
 
@@ -943,8 +942,8 @@ unsafeInsertWith f k0 v0 m0 = runST (go h0 s0 k0 v0 0 m0)
         A.unsafeUpdateM ary i st'
         return t
       where i = index h bs
-    go h s k x bs t@(Collision hx sx hmx)
-        | h == hx   = Collision hx sx <$> go (hashWithSalt sx k) sx k x 0 hmx
+    go h s k x bs t@(Collision hx hmx)
+        | h == hx   = Collision hx <$> go (hashWithSalt (nextSalt s) k) (nextSalt s) k x 0 hmx
         | otherwise = go h s k x bs $ BitmapIndexed (mask hx bs) (A.singleton t)
 {-# INLINABLE unsafeInsertWith #-}
 
@@ -994,8 +993,8 @@ delete' h0 s0 k0 m0 = go h0 s0 k0 0 m0
                 in BitmapIndexed bm ary'
             _ -> Full (A.update ary i st')
       where i = index h bs
-    go h s k _ t@(Collision hx sx hmx)
-        | h == hx = Collision hx sx $ go (hashWithSalt sx k) sx k 0 hmx
+    go h s k _ t@(Collision hx hmx)
+        | h == hx = Collision hx $ go (hashWithSalt (nextSalt s) k) (nextSalt s) k 0 hmx
         | otherwise = t
 {-# INLINABLE delete' #-}
 
@@ -1035,8 +1034,8 @@ deleteKeyExists !h0 s0 !k0 !m0 = go h0 s0 k0 0 m0
                 in BitmapIndexed bm ary'
             _ -> Full (A.update ary i st')
       where i = index h bs
-    go h s k _ t@(Collision hx sx hmx)
-        | h == hx = Collision hx sx $ go (hashWithSalt sx k) sx k 0 hmx
+    go h s k _ t@(Collision hx hmx)
+        | h == hx = Collision hx $ go (hashWithSalt (nextSalt s) k) (nextSalt s) k 0 hmx
         | otherwise = Empty -- error "Internal error: unexpected collision"
     go !_ !_ !_ !_ Empty = Empty -- error "Internal error: deleteKeyExists empty"
 {-# NOINLINE deleteKeyExists #-}
@@ -1056,36 +1055,36 @@ adjust f k m = adjust# (\v -> (# f v #)) k m
 
 -- | Much like 'adjust', but not inherently leaky.
 adjust# :: (Eq k, Hashable k) => (v -> (# v #)) -> k -> HashMap k v -> HashMap k v
-adjust# f k0 m0 = go h0 k0 0 m0
+adjust# f k0 m0 = go h0 s0 k0 0 m0
   where
     h0 = hashWithSalt s0 k0
     s0 = defaultSalt
-    go !_ !_ !_ Empty = Empty
-    go h k _ t@(Leaf hy (L ky y))
+    go !_ !_ !_ !_ Empty = Empty
+    go h _ k _ t@(Leaf hy (L ky y))
         | hy == h && ky == k = case f y of
             (# y' #) | ptrEq y y' -> t
                      | otherwise -> Leaf h (L k y')
         | otherwise          = t
-    go h k bs t@(BitmapIndexed b ary)
+    go h s k bs t@(BitmapIndexed b ary)
         | b .&. m == 0 = t
         | otherwise = let !st   = A.index ary i
-                          !st'  = go h k (bs+bitsPerSubkey) st
+                          !st'  = go h s k (bs+bitsPerSubkey) st
                           ary' = A.update ary i $! st'
                       in if ptrEq st st'
                          then t
                          else BitmapIndexed b ary'
       where m = mask h bs
             i = sparseIndex b m
-    go h k bs t@(Full ary) =
+    go h s k bs t@(Full ary) =
         let i    = index h bs
             !st   = A.index ary i
-            !st'  = go h k (bs+bitsPerSubkey) st
+            !st'  = go h s k (bs+bitsPerSubkey) st
             ary' = update16 ary i $! st'
         in if ptrEq st st'
            then t
            else Full ary'
-    go h k _ t@(Collision hx sx hmx)
-        | h == hx   = Collision hx sx $ go (hashWithSalt sx k) k 0 hmx
+    go h s k _ t@(Collision hx hmx)
+        | h == hx   = Collision hx $ go (hashWithSalt (nextSalt s) k) (nextSalt s) k 0 hmx
         | otherwise = t
 {-# INLINABLE adjust# #-}
 
@@ -1293,14 +1292,14 @@ unionWithKey f = go 0 s0
                       then Leaf h1 (L k1 (f k1 v1 v2))
                       else collision h1 s l1 l2
         | otherwise = goDifferentHash bs s h1 h2 t1 t2
-    go bs s t1@(Leaf h1 l1@(L k1 v1)) t2@(Collision h2 s2 hm2)
-        | h1 == h2  = Collision h1 s2 $ go 0 s2 (Leaf (hashWithSalt s2 k1) l1) hm2
+    go bs s t1@(Leaf h1 l1@(L k1 v1)) t2@(Collision h2 hm2)
+        | h1 == h2  = Collision h1 $ go 0 (nextSalt s) (Leaf (hashWithSalt (nextSalt s) k1) l1) hm2
         | otherwise = goDifferentHash bs s h1 h2 t1 t2
-    go bs s t1@(Collision h1 s1 hm1) t2@(Leaf h2 l2@(L k2 v2))
-        | h1 == h2  = Collision h1 s1 $ go 0 s1 hm1 (Leaf (hashWithSalt s1 k2) l2)
+    go bs s t1@(Collision h1 hm1) t2@(Leaf h2 l2@(L k2 v2))
+        | h1 == h2  = Collision h1 $ go 0 (nextSalt s) hm1 (Leaf (hashWithSalt (nextSalt s) k2) l2)
         | otherwise = goDifferentHash bs s h1 h2 t1 t2
-    go bs s t1@(Collision h1 s1 hm1) t2@(Collision h2 _ hm2) -- Second salt must be equal
-        | h1 == h2  = Collision h1 s1 $ go 0 s1 hm1 hm2
+    go bs s t1@(Collision h1 hm1) t2@(Collision h2 hm2)
+        | h1 == h2  = Collision h1 $ go 0 (nextSalt s) hm1 hm2
         | otherwise = goDifferentHash bs s h1 h2 t1 t2
     -- branch vs. branch
     go bs s (BitmapIndexed b1 ary1) (BitmapIndexed b2 ary2) =
@@ -1352,7 +1351,7 @@ unionWithKey f = go 0 s0
         in Full ary'
 
     leafHashCode (Leaf h _) = h
-    leafHashCode (Collision h _ _) = h
+    leafHashCode (Collision h _) = h
     leafHashCode _ = error "leafHashCode"
 
     goDifferentHash bs s h1 h2 t1 t2
@@ -1414,7 +1413,7 @@ mapWithKey f = go
     go (Full ary) = Full $ A.map go ary
     -- Why map strictly over collision arrays? Because there's no
     -- point suspending the O(1) work this does for each leaf.
-    go (Collision h s hm) = Collision h s $ go hm
+    go (Collision h hm) = Collision h $ go hm
 {-# INLINE mapWithKey #-}
 
 -- | /O(n)/ Transform this map by applying a function to every value.
@@ -1442,8 +1441,8 @@ traverseWithKey f = go
     go (Leaf h (L k v))      = Leaf h . L k <$> f k v
     go (BitmapIndexed b ary) = BitmapIndexed b <$> A.traverse go ary
     go (Full ary)            = Full <$> A.traverse go ary
-    go (Collision h s hm)    =
-        Collision h s <$> go hm
+    go (Collision h hm)    =
+        Collision h <$> go hm
 {-# INLINE traverseWithKey #-}
 
 ------------------------------------------------------------------------
@@ -1529,7 +1528,7 @@ foldlWithKey' f = go
     go z (Leaf _ (L k v))      = f z k v
     go z (BitmapIndexed _ ary) = A.foldl' go z ary
     go z (Full ary)            = A.foldl' go z ary
-    go z (Collision _ _ hm)    = go z hm
+    go z (Collision _ hm)    = go z hm
 {-# INLINE foldlWithKey' #-}
 
 -- | /O(n)/ Reduce this map by applying a binary operator to all
@@ -1549,7 +1548,7 @@ foldrWithKey f = go
     go z (Leaf _ (L k v))      = f k v z
     go z (BitmapIndexed _ ary) = A.foldr (flip go) z ary
     go z (Full ary)            = A.foldr (flip go) z ary
-    go z (Collision _ _ hm)    = go z hm
+    go z (Collision _ hm)    = go z hm
 {-# INLINE foldrWithKey #-}
 
 ------------------------------------------------------------------------
@@ -1592,7 +1591,7 @@ filterMapAux onLeaf = go
         | otherwise = Empty
     go (BitmapIndexed b ary) = filterA ary b
     go (Full ary) = filterA ary fullNodeMask
-    go (Collision h s hm) = filterC h s hm
+    go (Collision h hm) = filterC h hm
 
     filterA ary0 b0 =
         let !n = A.length ary0
@@ -1623,7 +1622,7 @@ filterMapAux onLeaf = go
                 t     -> do A.write mary j t
                             step ary mary b (i+1) (j+1) (bi `unsafeShiftL` 1) n
 
-    filterC h s hm = Collision h s $ go hm -- TODO deal with the collision being deleted?
+    filterC h hm = Collision h $ go hm -- TODO deal with the collision being deleted?
 {-# INLINE filterMapAux #-}
 
 -- | /O(n)/ Filter this map by retaining only elements which values
diff --git a/Data/HashMap/Strict/Base.hs b/Data/HashMap/Strict/Base.hs
index edfeb03d..92005593 100644
--- a/Data/HashMap/Strict/Base.hs
+++ b/Data/HashMap/Strict/Base.hs
@@ -175,8 +175,8 @@ insertWith f k0 v0 m0 = go h0 s0 k0 v0 0 m0
             ary' = update16 ary i $! st'
         in Full ary'
       where i = index h bs
-    go h s k x bs t@(Collision hx sx hm)
-        | h == hx   = Collision hx sx $ go (hashWithSalt sx k) sx k x 0 hm
+    go h s k x bs t@(Collision hx hm)
+        | h == hx   = Collision hx $ go (hashWithSalt (nextSalt s) k) (nextSalt s) k x 0 hm
         | otherwise = go h s k x bs $ BitmapIndexed (mask hx bs) (A.singleton t)
 {-# INLINABLE insertWith #-}
 
@@ -212,8 +212,8 @@ unsafeInsertWith f k0 v0 m0 = runST (go h0 s0 k0 v0 0 m0)
         A.unsafeUpdateM ary i st'
         return t
       where i = index h bs
-    go h s k x bs t@(Collision hx sx hm)
-        | h == hx   = Collision hx sx <$> go (hashWithSalt sx k) sx k x 0 hm
+    go h s k x bs t@(Collision hx hm)
+        | h == hx   = Collision hx <$> go (hashWithSalt (nextSalt s) k) (nextSalt s) k x 0 hm
         | otherwise = go h s k x bs $ BitmapIndexed (mask hx bs) (A.singleton t)
 {-# INLINABLE unsafeInsertWith #-}
 
@@ -242,8 +242,8 @@ adjust f k0 m0 = go h0 s0 k0 0 m0
             st'  = go h s k (bs+bitsPerSubkey) st
             ary' = update16 ary i $! st'
         in Full ary'
-    go h s k _ t@(Collision hx sx hm)
-        | h == hx   = Collision hx sx $ go (hashWithSalt sx k) sx k 0 hm
+    go h s k _ t@(Collision hx hm)
+        | h == hx   = Collision hx $ go (hashWithSalt (nextSalt s) k) (nextSalt s) k 0 hm
         | otherwise = t
 {-# INLINABLE adjust #-}
 
@@ -417,14 +417,14 @@ unionWithKey f = go 0 s0
                       then leaf h1 k1 (f k1 v1 v2)
                       else collision h1 s l1 l2
         | otherwise = goDifferentHash bs s h1 h2 t1 t2
-    go bs s t1@(Leaf h1 l1@(L k1 v1)) t2@(Collision h2 s2 hm2)
-        | h1 == h2  = Collision h1 s2 $ go 0 s2 (Leaf (hashWithSalt s2 k1) l1) hm2
+    go bs s t1@(Leaf h1 l1@(L k1 v1)) t2@(Collision h2 hm2)
+        | h1 == h2  = Collision h1 $ go 0 (nextSalt s) (Leaf (hashWithSalt (nextSalt s) k1) l1) hm2
         | otherwise = goDifferentHash bs s h1 h2 t1 t2
-    go bs s t1@(Collision h1 s1 hm1) t2@(Leaf h2 l2@(L k2 v2))
-        | h1 == h2  = Collision h1 s1 $ go 0 s1 hm1 (Leaf (hashWithSalt s1 k2) l2)
+    go bs s t1@(Collision h1 hm1) t2@(Leaf h2 l2@(L k2 v2))
+        | h1 == h2  = Collision h1 $ go 0 (nextSalt s) hm1 (Leaf (hashWithSalt (nextSalt s) k2) l2)
         | otherwise = goDifferentHash bs s h1 h2 t1 t2
-    go bs s t1@(Collision h1 s1 hm1) t2@(Collision h2 _ hm2) -- Second salt must be equal
-        | h1 == h2  = Collision h1 s1 $ go 0 s1 hm1 hm2
+    go bs s t1@(Collision h1 hm1) t2@(Collision h2 hm2) -- Second salt must be equal
+        | h1 == h2  = Collision h1 $ go 0 (nextSalt s) hm1 hm2
         | otherwise = goDifferentHash bs s h1 h2 t1 t2
     -- branch vs. branch
     go bs s (BitmapIndexed b1 ary1) (BitmapIndexed b2 ary2) =
@@ -476,7 +476,7 @@ unionWithKey f = go 0 s0
         in Full ary'
 
     leafHashCode (Leaf h _) = h
-    leafHashCode (Collision h _ _) = h
+    leafHashCode (Collision h _) = h
     leafHashCode _ = error "leafHashCode"
 
     goDifferentHash bs s h1 h2 t1 t2
@@ -499,8 +499,8 @@ mapWithKey f = go
     go (Leaf h (L k v))      = leaf h k (f k v)
     go (BitmapIndexed b ary) = BitmapIndexed b $ A.map' go ary
     go (Full ary)            = Full $ A.map' go ary
-    go (Collision h s hm)     =
-        Collision h s $ go hm
+    go (Collision h hm)     =
+        Collision h $ go hm
 {-# INLINE mapWithKey #-}
 
 -- | /O(n)/ Transform this map by applying a function to every value.
@@ -548,8 +548,8 @@ traverseWithKey f = go
     go (Leaf h (L k v))      = leaf h k <$> f k v
     go (BitmapIndexed b ary) = BitmapIndexed b <$> A.traverse' go ary
     go (Full ary)            = Full <$> A.traverse' go ary
-    go (Collision h s hm)     =
-        Collision h s <$> go hm
+    go (Collision h hm)     =
+        Collision h <$> go hm
 {-# INLINE traverseWithKey #-}
 
 ------------------------------------------------------------------------

From 5c6aa0f77919deb2f94062b8fc14b20bb1f0735a Mon Sep 17 00:00:00 2001
From: Tom Sydney Kerckhove <syd@fpcomplete.com>
Date: Wed, 15 Aug 2018 09:13:39 +0200
Subject: [PATCH 14/69] Putting back the show instance

---
 Data/HashMap/Base.hs | 10 +++++-----
 1 file changed, 5 insertions(+), 5 deletions(-)

diff --git a/Data/HashMap/Base.hs b/Data/HashMap/Base.hs
index 58c45521..f51b2bb0 100644
--- a/Data/HashMap/Base.hs
+++ b/Data/HashMap/Base.hs
@@ -169,7 +169,7 @@ hashWithSalt :: H.Hashable a => Salt -> a -> Hash
 hashWithSalt s v = fromIntegral $ H.hashWithSalt s v
 
 data Leaf k v = L !k v
-  deriving (Show, Eq)
+  deriving (Eq)
 
 instance (NFData k, NFData v) => NFData (Leaf k v) where
     rnf (L k v) = rnf k `seq` rnf v
@@ -185,7 +185,7 @@ data HashMap k v
     | Leaf !Hash !(Leaf k v)
     | Full !(A.Array (HashMap k v))
     | Collision !Hash !(HashMap k v)
-      deriving (Show, Typeable)
+      deriving (Typeable)
 
 type role HashMap nominal representational
 
@@ -265,9 +265,9 @@ instance (Eq k, Hashable k, Read k, Read e) => Read (HashMap k e) where
 
     readListPrec = readListPrecDefault
 
---instance (Show k, Show v) => Show (HashMap k v) where
---    showsPrec d m = showParen (d > 10) $
---      showString "fromList " . shows (toList m)
+instance (Show k, Show v) => Show (HashMap k v) where
+    showsPrec d m = showParen (d > 10) $
+      showString "fromList " . shows (toList m)
 
 instance Traversable (HashMap k) where
     traverse f = traverseWithKey (const f)

From a1b5427ec83946f884e35927961a3a8d5cd48b6f Mon Sep 17 00:00:00 2001
From: Tom Sydney Kerckhove <syd@fpcomplete.com>
Date: Wed, 15 Aug 2018 09:18:56 +0200
Subject: [PATCH 15/69] Fixed the filter function as well, to not retain too
 many collisions

---
 Data/HashMap/Base.hs | 7 ++++++-
 1 file changed, 6 insertions(+), 1 deletion(-)

diff --git a/Data/HashMap/Base.hs b/Data/HashMap/Base.hs
index f51b2bb0..0a3ec190 100644
--- a/Data/HashMap/Base.hs
+++ b/Data/HashMap/Base.hs
@@ -1622,7 +1622,12 @@ filterMapAux onLeaf = go
                 t     -> do A.write mary j t
                             step ary mary b (i+1) (j+1) (bi `unsafeShiftL` 1) n
 
-    filterC h hm = Collision h $ go hm -- TODO deal with the collision being deleted?
+    filterC h hm =
+      let hm' = go hm
+      in case hm' of
+        Empty -> Empty
+        Leaf _ l -> Leaf h l
+        _ -> Collision h hm'
 {-# INLINE filterMapAux #-}
 
 -- | /O(n)/ Filter this map by retaining only elements which values

From 9eb436e23c87f9a411792be0e52f24e1d95427da Mon Sep 17 00:00:00 2001
From: Tom Sydney Kerckhove <syd@fpcomplete.com>
Date: Wed, 15 Aug 2018 12:28:08 +0200
Subject: [PATCH 16/69] Fixed compilation warnings

---
 Data/HashMap/Base.hs        | 93 ++-----------------------------------
 Data/HashMap/Strict/Base.hs | 51 ++------------------
 2 files changed, 8 insertions(+), 136 deletions(-)

diff --git a/Data/HashMap/Base.hs b/Data/HashMap/Base.hs
index 0a3ec190..f231f664 100644
--- a/Data/HashMap/Base.hs
+++ b/Data/HashMap/Base.hs
@@ -137,7 +137,6 @@ import qualified Data.Hashable as H
 import Data.Hashable (Hashable)
 import Data.HashMap.Unsafe (runST)
 import Data.HashMap.UnsafeShift (unsafeShiftL, unsafeShiftR)
-import Data.HashMap.List (isPermutationBy, unorderedCompare)
 import Data.Typeable (Typeable)
 
 import GHC.Exts (isTrue#)
@@ -624,7 +623,7 @@ infixl 9 !
 
 -- | Create a 'Collision' value with two 'Leaf' values.
 collision :: (Eq k, Hashable k) => Hash -> Salt -> Leaf k v -> Leaf k v -> HashMap k v
-collision h0 s0 !l1@(L k1 v1) !l2@(L k2 v2) = go h0 s0
+collision h0 s0 !(L k1 v1) !(L k2 v2) = go h0 s0
   where
     go h s =
       let s' = nextSalt s
@@ -765,14 +764,6 @@ insertKeyExists !h0 !s0 !k0 x0 !m0 = go h0 s0 k0 x0 0 m0
 
 {-# NOINLINE insertKeyExists #-}
 
--- Replace the ith Leaf with Leaf k v.
---
--- This does not check that @i@ is within bounds of the array.
-setAtPosition :: Int -> k -> v -> A.Array (Leaf k v) -> A.Array (Leaf k v)
-setAtPosition i k x ary = A.update ary i (L k x)
-{-# INLINE setAtPosition #-}
-
-
 -- | In-place update version of insert
 unsafeInsert :: (Eq k, Hashable k) => k -> v -> HashMap k v -> HashMap k v
 unsafeInsert k0 v0 m0 = runST (go h0 s0 k0 v0 0 m0)
@@ -890,26 +881,6 @@ insertModifying x f k0 m0 = go h0 s0 k0 0 m0
         | otherwise = go h s k bs $ BitmapIndexed (mask hx bs) (A.singleton t)
 {-# INLINABLE insertModifying #-}
 
--- Like insertModifying for arrays; used to implement insertModifying
-insertModifyingArr :: Eq k => v -> (v -> (# v #)) -> k -> A.Array (Leaf k v)
-                 -> A.Array (Leaf k v)
-insertModifyingArr x f k0 ary0 = go k0 ary0 0 (A.length ary0)
-  where
-    go !k !ary !i !n
-        | i >= n = A.run $ do
-            -- Not found, append to the end.
-            mary <- A.new_ (n + 1)
-            A.copy ary 0 mary 0 n
-            A.write mary n (L k x)
-            return mary
-        | otherwise = case A.index ary i of
-            (L kx y) | k == kx   -> case f y of
-                                      (# y' #) -> if ptrEq y y'
-                                                  then ary
-                                                  else A.update ary i (L k y')
-                     | otherwise -> go k ary (i+1) n
-{-# INLINE insertModifyingArr #-}
-
 -- | In-place update version of insertWith
 unsafeInsertWith :: forall k v. (Eq k, Hashable k)
                  => (v -> v -> v) -> k -> v -> HashMap k v
@@ -1034,7 +1005,7 @@ deleteKeyExists !h0 s0 !k0 !m0 = go h0 s0 k0 0 m0
                 in BitmapIndexed bm ary'
             _ -> Full (A.update ary i st')
       where i = index h bs
-    go h s k _ t@(Collision hx hmx)
+    go h s k _ (Collision hx hmx)
         | h == hx = Collision hx $ go (hashWithSalt (nextSalt s) k) (nextSalt s) k 0 hmx
         | otherwise = Empty -- error "Internal error: unexpected collision"
     go !_ !_ !_ !_ Empty = Empty -- error "Internal error: deleteKeyExists empty"
@@ -1241,7 +1212,7 @@ alterFEager f !k m = (<$> f mv) $ \fres ->
       Absent -> insertNewKey h s k v' m
 
       -- Key existed before
-      Present v collPos ->
+      Present v _ ->
         if v `ptrEq` v'
         -- If the value is identical, no-op
         then m
@@ -1292,10 +1263,10 @@ unionWithKey f = go 0 s0
                       then Leaf h1 (L k1 (f k1 v1 v2))
                       else collision h1 s l1 l2
         | otherwise = goDifferentHash bs s h1 h2 t1 t2
-    go bs s t1@(Leaf h1 l1@(L k1 v1)) t2@(Collision h2 hm2)
+    go bs s t1@(Leaf h1 l1@(L k1 _)) t2@(Collision h2 hm2)
         | h1 == h2  = Collision h1 $ go 0 (nextSalt s) (Leaf (hashWithSalt (nextSalt s) k1) l1) hm2
         | otherwise = goDifferentHash bs s h1 h2 t1 t2
-    go bs s t1@(Collision h1 hm1) t2@(Leaf h2 l2@(L k2 v2))
+    go bs s t1@(Collision h1 hm1) t2@(Leaf h2 l2@(L k2 _))
         | h1 == h2  = Collision h1 $ go 0 (nextSalt s) hm1 (Leaf (hashWithSalt (nextSalt s) k2) l2)
         | otherwise = goDifferentHash bs s h1 h2 t1 t2
     go bs s t1@(Collision h1 hm1) t2@(Collision h2 hm2)
@@ -1678,26 +1649,6 @@ fromListWith f = L.foldl' (\ m (k, v) -> unsafeInsertWith f k v m) empty
 ------------------------------------------------------------------------
 -- Array operations
 
--- | /O(n)/ Look up the value associated with the given key in an
--- array.
-lookupInArrayCont ::
-#if __GLASGOW_HASKELL__ >= 802
-  forall rep (r :: TYPE rep) k v.
-#else
-  forall r k v.
-#endif
-  Eq k => ((# #) -> r) -> (v -> Int -> r) -> k -> A.Array (Leaf k v) -> r
-lookupInArrayCont absent present k0 ary0 = go k0 ary0 0 (A.length ary0)
-  where
-    go :: Eq k => k -> A.Array (Leaf k v) -> Int -> Int -> r
-    go !k !ary !i !n
-        | i >= n    = absent (# #)
-        | otherwise = case A.index ary i of
-            (L kx v)
-                | k == kx   -> present v i
-                | otherwise -> go k ary (i+1) n
-{-# INLINE lookupInArrayCont #-}
-
 -- | /O(n)/ Lookup the value associated with the given key in this
 -- array.  Returns 'Nothing' if the key wasn't found.
 indexOf :: Eq k => k -> A.Array (Leaf k v) -> Maybe Int
@@ -1711,40 +1662,6 @@ indexOf k0 ary0 = go k0 ary0 0 (A.length ary0)
                 | otherwise -> go k ary (i+1) n
 {-# INLINABLE indexOf #-}
 
-updateWith# :: Eq k => (v -> (# v #)) -> k -> A.Array (Leaf k v) -> A.Array (Leaf k v)
-updateWith# f k0 ary0 = go k0 ary0 0 (A.length ary0)
-  where
-    go !k !ary !i !n
-        | i >= n    = ary
-        | otherwise = case A.index ary i of
-            (L kx y) | k == kx -> case f y of
-                          (# y' #)
-                             | ptrEq y y' -> ary
-                             | otherwise -> A.update ary i (L k y')
-                     | otherwise -> go k ary (i+1) n
-{-# INLINABLE updateWith# #-}
-
-updateOrSnocWith :: Eq k => (v -> v -> v) -> k -> v -> A.Array (Leaf k v)
-                 -> A.Array (Leaf k v)
-updateOrSnocWith f = updateOrSnocWithKey (const f)
-{-# INLINABLE updateOrSnocWith #-}
-
-updateOrSnocWithKey :: Eq k => (k -> v -> v -> v) -> k -> v -> A.Array (Leaf k v)
-                 -> A.Array (Leaf k v)
-updateOrSnocWithKey f k0 v0 ary0 = go k0 v0 ary0 0 (A.length ary0)
-  where
-    go !k v !ary !i !n
-        | i >= n = A.run $ do
-            -- Not found, append to the end.
-            mary <- A.new_ (n + 1)
-            A.copy ary 0 mary 0 n
-            A.write mary n (L k v)
-            return mary
-        | otherwise = case A.index ary i of
-            (L kx y) | k == kx   -> A.update ary i (L k (f k v y))
-                     | otherwise -> go k v ary (i+1) n
-{-# INLINABLE updateOrSnocWithKey #-}
-
 updateOrConcatWith :: Eq k => (v -> v -> v) -> A.Array (Leaf k v) -> A.Array (Leaf k v) -> A.Array (Leaf k v)
 updateOrConcatWith f = updateOrConcatWithKey (const f)
 {-# INLINABLE updateOrConcatWith #-}
diff --git a/Data/HashMap/Strict/Base.hs b/Data/HashMap/Strict/Base.hs
index 92005593..37dad0c0 100644
--- a/Data/HashMap/Strict/Base.hs
+++ b/Data/HashMap/Strict/Base.hs
@@ -375,7 +375,7 @@ alterFEager f !k !m = (<$> f mv) $ \fres ->
       Absent -> insertNewKey h s k v' m
 
       -- Key existed before, no hash collision
-      Present v collPos -> v' `seq`
+      Present v _ -> v' `seq`
         if v `ptrEq` v'
         -- If the value is identical, no-op
         then m
@@ -417,10 +417,10 @@ unionWithKey f = go 0 s0
                       then leaf h1 k1 (f k1 v1 v2)
                       else collision h1 s l1 l2
         | otherwise = goDifferentHash bs s h1 h2 t1 t2
-    go bs s t1@(Leaf h1 l1@(L k1 v1)) t2@(Collision h2 hm2)
+    go bs s t1@(Leaf h1 l1@(L k1 _)) t2@(Collision h2 hm2)
         | h1 == h2  = Collision h1 $ go 0 (nextSalt s) (Leaf (hashWithSalt (nextSalt s) k1) l1) hm2
         | otherwise = goDifferentHash bs s h1 h2 t1 t2
-    go bs s t1@(Collision h1 hm1) t2@(Leaf h2 l2@(L k2 v2))
+    go bs s t1@(Collision h1 hm1) t2@(Leaf h2 l2@(L k2 _))
         | h1 == h2  = Collision h1 $ go 0 (nextSalt s) hm1 (Leaf (hashWithSalt (nextSalt s) k2) l2)
         | otherwise = goDifferentHash bs s h1 h2 t1 t2
     go bs s t1@(Collision h1 hm1) t2@(Collision h2 hm2) -- Second salt must be equal
@@ -618,51 +618,6 @@ fromListWith :: (Eq k, Hashable k) => (v -> v -> v) -> [(k, v)] -> HashMap k v
 fromListWith f = L.foldl' (\ m (k, v) -> unsafeInsertWith f k v m) empty
 {-# INLINE fromListWith #-}
 
-------------------------------------------------------------------------
--- Array operations
-
-updateWith :: Eq k => (v -> v) -> k -> A.Array (Leaf k v) -> A.Array (Leaf k v)
-updateWith f k0 ary0 = go k0 ary0 0 (A.length ary0)
-  where
-    go !k !ary !i !n
-        | i >= n    = ary
-        | otherwise = case A.index ary i of
-            (L kx y) | k == kx   -> let !v' = f y in A.update ary i (L k v')
-                     | otherwise -> go k ary (i+1) n
-{-# INLINABLE updateWith #-}
-
--- | Append the given key and value to the array. If the key is
--- already present, instead update the value of the key by applying
--- the given function to the new and old value (in that order). The
--- value is always evaluated to WHNF before being inserted into the
--- array.
-updateOrSnocWith :: Eq k => (v -> v -> v) -> k -> v -> A.Array (Leaf k v)
-                 -> A.Array (Leaf k v)
-updateOrSnocWith f = updateOrSnocWithKey (const f)
-{-# INLINABLE updateOrSnocWith #-}
-
--- | Append the given key and value to the array. If the key is
--- already present, instead update the value of the key by applying
--- the given function to the new and old value (in that order). The
--- value is always evaluated to WHNF before being inserted into the
--- array.
-updateOrSnocWithKey :: Eq k => (k -> v -> v -> v) -> k -> v -> A.Array (Leaf k v)
-                 -> A.Array (Leaf k v)
-updateOrSnocWithKey f k0 v0 ary0 = go k0 v0 ary0 0 (A.length ary0)
-  where
-    go !k v !ary !i !n
-        | i >= n = A.run $ do
-            -- Not found, append to the end.
-            mary <- A.new_ (n + 1)
-            A.copy ary 0 mary 0 n
-            let !l = v `seq` (L k v)
-            A.write mary n l
-            return mary
-        | otherwise = case A.index ary i of
-            (L kx y) | k == kx   -> let !v' = f k v y in A.update ary i (L k v')
-                     | otherwise -> go k v ary (i+1) n
-{-# INLINABLE updateOrSnocWithKey #-}
-
 ------------------------------------------------------------------------
 -- Smart constructors
 --

From 8edc380a5bfa25377bb1fd75fbd2ae657416d105 Mon Sep 17 00:00:00 2001
From: Tom Sydney Kerckhove <syd@fpcomplete.com>
Date: Wed, 15 Aug 2018 12:35:19 +0200
Subject: [PATCH 17/69] woops

---
 hashmap-strict-properties.prof.html | 931 ----------------------------
 1 file changed, 931 deletions(-)
 delete mode 100644 hashmap-strict-properties.prof.html

diff --git a/hashmap-strict-properties.prof.html b/hashmap-strict-properties.prof.html
deleted file mode 100644
index d7558312..00000000
--- a/hashmap-strict-properties.prof.html
+++ /dev/null
@@ -1,931 +0,0 @@
-<!DOCTYPE html>
-<html>
-  <head>
-    <meta charset="UTF-8">
-    <title>hashmap-strict-properties</title>
-<script type="text/javascript">var $prof = [{"5081":[">>=","Test.Framework.Improving",2,100,100,["5082"]],"5076":["runImprovingIO.action","Test.Framework.Improving",0,100,100,["5081"]],"5098":["quickCheckWithResult","Test.QuickCheck.Test",1,100,100,["5100"]],"5138":[">>=.\\","Test.QuickCheck.Gen",1595,100,100,["5163"]],"5219":["shrinking","Test.QuickCheck.Property",40,100,100,["5220"]],"5244":["callback","Test.QuickCheck.Property",40,100,100,["5245"]],"5222":["shrinking.props","Test.QuickCheck.Property",40,100,100,["5244"]],"5070":["runTestTree","Test.Framework.Runners.Core",0,100,100,["5071"]],"5249":["forAllShrink.\\.\\","Test.QuickCheck.Property",40,100,100,["5287"]],"5069":["runTests'","Test.Framework.Runners.Core",0,100,100,["5070"]],"4927":["defaultMainWithOpts","Test.Framework.Runners.Console",1,100,100,["4936"]],"5248":["property","Test.QuickCheck.Property",20,100,100,["5249"]],"5071":["runTestTree.go","Test.Framework.Runners.Core",0,100,100,["5072"]],"5074":["runProperty","Test.Framework.Providers.QuickCheck2",0,100,100,["5075"]],"5163":[">>=.\\.(...)","Test.QuickCheck.Gen",1595,100,100,["5217"]],"5221":["fmap.\\","Test.QuickCheck.Gen",140,100,100,["5222"]],"4923":["defaultMain","Test.Framework.Runners.Console",0,100,100,["4924"]],"5100":["withNullTerminal","Test.QuickCheck.Text",1,100,100,["5102"]],"5247":["mapProp","Test.QuickCheck.Property",100,100,100,["5248"]],"5067":["poolWorker","Test.Framework.Runners.ThreadPool",1,100,100,["5069"]],"5082":[">>=.\\","Test.Framework.Improving",2,100,100,["5098"]],"5075":["runImprovingIO","Test.Framework.Improving",0,100,100,["5076"]],"5287.indiv":["pEq (indiv)","Main",20,100,100,[]],"5246":["mapRoseResult","Test.QuickCheck.Property",100,100,100,["5247"]],"5220":["fmap","Test.QuickCheck.Gen",140,100,100,["5221"]],"4922":["main","Main",0,100,100,["4923"]],"5072":["runSimpleTest","Test.Framework.Runners.Core",0,100,100,["5073"]],"5137":[">>=","Test.QuickCheck.Gen",1368,100,100,["5138"]],"4936":["runTests","Test.Framework.Runners.Core",1,100,100,["5060"]],"2460":["MAIN","MAIN",0,100,100,["4922"]],"5287":["pEq","Main",20,100,100,["5287.indiv"]],"4924":["defaultMainWithArgs","Test.Framework.Runners.Console",1,100,100,["4927"]],"5060":["executeOnPool","Test.Framework.Runners.ThreadPool",1,100,100,["5067"]],"5102":["quickCheckWithResult.\\","Test.QuickCheck.Test",1,100,100,["5136"]],"5245":["mapTotalResult","Test.QuickCheck.Property",100,100,100,["5246"]],"5217":["forAllShrink.\\","Test.QuickCheck.Property",40,100,100,["5219"]],"5073":["runTest","Test.Framework.Providers.QuickCheck2",0,100,100,["5074"]],"5136":["property","Test.QuickCheck.Property",100,100,100,["5137"]]},"2460"];</script>
-<style>
-/* General
- ******************************************************************************/
-
-html {
-    font-family:      sans-serif;
-    font-size:        14px;
-    background-color: #222;
-    color:            #ddd;
-    overflow:         hidden;
-}
-
-body {
-    display: table;
-    margin:  0px;
-    height: 100%;
-    width:  100%;
-}
-
-a {
-    color: #8ee2f9;
-}
-
-#details-tree {
-    position: absolute;
-    left:     0px;
-    height:   100%;
-    width:    33%;
-}
-
-#details {
-    border-bottom: solid 4px #888;
-    height:        33%;
-    overflow:      auto;
-    top:           0px;
-    position:      relative;
-}
-
-#tree {
-    bottom:   0px;
-    height:   66%;
-    overflow: auto;
-    position: absolute;
-    width:    100%;
-}
-
-#map {
-    border-left: solid 4px #888;
-    position: absolute;
-    left:     33%;
-    right:    0px;
-    height:   100%;
-}
-
-/* Details
- ******************************************************************************/
-
-#details h1 {
-    font-size:   16px;
-    font-weight: bold;
-    margin:      5px;
-}
-
-#details .controls {
-    margin: 5px;
-}
-
-#details table {
-    margin: 5px;
-}
-
-#details td {
-    padding-right: 15px;
-}
-
-#details .credits {
-    font-size: 12px;
-    position:  absolute;
-    bottom:    0px;
-    margin:    5px;
-}
-
-/* Tree browser
- ******************************************************************************/
-
-.tree-browser .node {
-    padding: 2px;
-}
-
-.tree-browser .chevron {
-    position:   absolute;
-    width:      20px;
-    text-align: center;
-}
-
-.tree-browser .name {
-    position: relative;
-    left:     20px;
-    padding:  2px 5px 2px 5px;
-}
-
-.tree-browser .selected {
-    border: 2px solid #fff;
-}
-
-.tree-browser .children {
-    margin-top:   6px;
-    margin-left:  10px;
-    padding-left: 10px;
-    border-left:  1px dashed #888;
-}
-</style>
-<script type="text/javascript">
-/*! jQuery v3.2.1 | (c) JS Foundation and other contributors | jquery.org/license */
-!function(a,b){"use strict";"object"==typeof module&&"object"==typeof module.exports?module.exports=a.document?b(a,!0):function(a){if(!a.document)throw new Error("jQuery requires a window with a document");return b(a)}:b(a)}("undefined"!=typeof window?window:this,function(a,b){"use strict";var c=[],d=a.document,e=Object.getPrototypeOf,f=c.slice,g=c.concat,h=c.push,i=c.indexOf,j={},k=j.toString,l=j.hasOwnProperty,m=l.toString,n=m.call(Object),o={};function p(a,b){b=b||d;var c=b.createElement("script");c.text=a,b.head.appendChild(c).parentNode.removeChild(c)}var q="3.2.1",r=function(a,b){return new r.fn.init(a,b)},s=/^[\s\uFEFF\xA0]+|[\s\uFEFF\xA0]+$/g,t=/^-ms-/,u=/-([a-z])/g,v=function(a,b){return b.toUpperCase()};r.fn=r.prototype={jquery:q,constructor:r,length:0,toArray:function(){return f.call(this)},get:function(a){return null==a?f.call(this):a<0?this[a+this.length]:this[a]},pushStack:function(a){var b=r.merge(this.constructor(),a);return b.prevObject=this,b},each:function(a){return r.each(this,a)},map:function(a){return this.pushStack(r.map(this,function(b,c){return a.call(b,c,b)}))},slice:function(){return this.pushStack(f.apply(this,arguments))},first:function(){return this.eq(0)},last:function(){return this.eq(-1)},eq:function(a){var b=this.length,c=+a+(a<0?b:0);return this.pushStack(c>=0&&c<b?[this[c]]:[])},end:function(){return this.prevObject||this.constructor()},push:h,sort:c.sort,splice:c.splice},r.extend=r.fn.extend=function(){var a,b,c,d,e,f,g=arguments[0]||{},h=1,i=arguments.length,j=!1;for("boolean"==typeof g&&(j=g,g=arguments[h]||{},h++),"object"==typeof g||r.isFunction(g)||(g={}),h===i&&(g=this,h--);h<i;h++)if(null!=(a=arguments[h]))for(b in a)c=g[b],d=a[b],g!==d&&(j&&d&&(r.isPlainObject(d)||(e=Array.isArray(d)))?(e?(e=!1,f=c&&Array.isArray(c)?c:[]):f=c&&r.isPlainObject(c)?c:{},g[b]=r.extend(j,f,d)):void 0!==d&&(g[b]=d));return g},r.extend({expando:"jQuery"+(q+Math.random()).replace(/\D/g,""),isReady:!0,error:function(a){throw new Error(a)},noop:function(){},isFunction:function(a){return"function"===r.type(a)},isWindow:function(a){return null!=a&&a===a.window},isNumeric:function(a){var b=r.type(a);return("number"===b||"string"===b)&&!isNaN(a-parseFloat(a))},isPlainObject:function(a){var b,c;return!(!a||"[object Object]"!==k.call(a))&&(!(b=e(a))||(c=l.call(b,"constructor")&&b.constructor,"function"==typeof c&&m.call(c)===n))},isEmptyObject:function(a){var b;for(b in a)return!1;return!0},type:function(a){return null==a?a+"":"object"==typeof a||"function"==typeof a?j[k.call(a)]||"object":typeof a},globalEval:function(a){p(a)},camelCase:function(a){return a.replace(t,"ms-").replace(u,v)},each:function(a,b){var c,d=0;if(w(a)){for(c=a.length;d<c;d++)if(b.call(a[d],d,a[d])===!1)break}else for(d in a)if(b.call(a[d],d,a[d])===!1)break;return a},trim:function(a){return null==a?"":(a+"").replace(s,"")},makeArray:function(a,b){var c=b||[];return null!=a&&(w(Object(a))?r.merge(c,"string"==typeof a?[a]:a):h.call(c,a)),c},inArray:function(a,b,c){return null==b?-1:i.call(b,a,c)},merge:function(a,b){for(var c=+b.length,d=0,e=a.length;d<c;d++)a[e++]=b[d];return a.length=e,a},grep:function(a,b,c){for(var d,e=[],f=0,g=a.length,h=!c;f<g;f++)d=!b(a[f],f),d!==h&&e.push(a[f]);return e},map:function(a,b,c){var d,e,f=0,h=[];if(w(a))for(d=a.length;f<d;f++)e=b(a[f],f,c),null!=e&&h.push(e);else for(f in a)e=b(a[f],f,c),null!=e&&h.push(e);return g.apply([],h)},guid:1,proxy:function(a,b){var c,d,e;if("string"==typeof b&&(c=a[b],b=a,a=c),r.isFunction(a))return d=f.call(arguments,2),e=function(){return a.apply(b||this,d.concat(f.call(arguments)))},e.guid=a.guid=a.guid||r.guid++,e},now:Date.now,support:o}),"function"==typeof Symbol&&(r.fn[Symbol.iterator]=c[Symbol.iterator]),r.each("Boolean Number String Function Array Date RegExp Object Error Symbol".split(" "),function(a,b){j["[object "+b+"]"]=b.toLowerCase()});function w(a){var b=!!a&&"length"in a&&a.length,c=r.type(a);return"function"!==c&&!r.isWindow(a)&&("array"===c||0===b||"number"==typeof b&&b>0&&b-1 in a)}var x=function(a){var b,c,d,e,f,g,h,i,j,k,l,m,n,o,p,q,r,s,t,u="sizzle"+1*new Date,v=a.document,w=0,x=0,y=ha(),z=ha(),A=ha(),B=function(a,b){return a===b&&(l=!0),0},C={}.hasOwnProperty,D=[],E=D.pop,F=D.push,G=D.push,H=D.slice,I=function(a,b){for(var c=0,d=a.length;c<d;c++)if(a[c]===b)return c;return-1},J="checked|selected|async|autofocus|autoplay|controls|defer|disabled|hidden|ismap|loop|multiple|open|readonly|required|scoped",K="[\\x20\\t\\r\\n\\f]",L="(?:\\\\.|[\\w-]|[^\0-\\xa0])+",M="\\["+K+"*("+L+")(?:"+K+"*([*^$|!~]?=)"+K+"*(?:'((?:\\\\.|[^\\\\'])*)'|\"((?:\\\\.|[^\\\\\"])*)\"|("+L+"))|)"+K+"*\\]",N=":("+L+")(?:\\((('((?:\\\\.|[^\\\\'])*)'|\"((?:\\\\.|[^\\\\\"])*)\")|((?:\\\\.|[^\\\\()[\\]]|"+M+")*)|.*)\\)|)",O=new RegExp(K+"+","g"),P=new RegExp("^"+K+"+|((?:^|[^\\\\])(?:\\\\.)*)"+K+"+$","g"),Q=new RegExp("^"+K+"*,"+K+"*"),R=new RegExp("^"+K+"*([>+~]|"+K+")"+K+"*"),S=new RegExp("="+K+"*([^\\]'\"]*?)"+K+"*\\]","g"),T=new RegExp(N),U=new RegExp("^"+L+"$"),V={ID:new RegExp("^#("+L+")"),CLASS:new RegExp("^\\.("+L+")"),TAG:new RegExp("^("+L+"|[*])"),ATTR:new RegExp("^"+M),PSEUDO:new RegExp("^"+N),CHILD:new RegExp("^:(only|first|last|nth|nth-last)-(child|of-type)(?:\\("+K+"*(even|odd|(([+-]|)(\\d*)n|)"+K+"*(?:([+-]|)"+K+"*(\\d+)|))"+K+"*\\)|)","i"),bool:new RegExp("^(?:"+J+")$","i"),needsContext:new RegExp("^"+K+"*[>+~]|:(even|odd|eq|gt|lt|nth|first|last)(?:\\("+K+"*((?:-\\d)?\\d*)"+K+"*\\)|)(?=[^-]|$)","i")},W=/^(?:input|select|textarea|button)$/i,X=/^h\d$/i,Y=/^[^{]+\{\s*\[native \w/,Z=/^(?:#([\w-]+)|(\w+)|\.([\w-]+))$/,$=/[+~]/,_=new RegExp("\\\\([\\da-f]{1,6}"+K+"?|("+K+")|.)","ig"),aa=function(a,b,c){var d="0x"+b-65536;return d!==d||c?b:d<0?String.fromCharCode(d+65536):String.fromCharCode(d>>10|55296,1023&d|56320)},ba=/([\0-\x1f\x7f]|^-?\d)|^-$|[^\0-\x1f\x7f-\uFFFF\w-]/g,ca=function(a,b){return b?"\0"===a?"\ufffd":a.slice(0,-1)+"\\"+a.charCodeAt(a.length-1).toString(16)+" ":"\\"+a},da=function(){m()},ea=ta(function(a){return a.disabled===!0&&("form"in a||"label"in a)},{dir:"parentNode",next:"legend"});try{G.apply(D=H.call(v.childNodes),v.childNodes),D[v.childNodes.length].nodeType}catch(fa){G={apply:D.length?function(a,b){F.apply(a,H.call(b))}:function(a,b){var c=a.length,d=0;while(a[c++]=b[d++]);a.length=c-1}}}function ga(a,b,d,e){var f,h,j,k,l,o,r,s=b&&b.ownerDocument,w=b?b.nodeType:9;if(d=d||[],"string"!=typeof a||!a||1!==w&&9!==w&&11!==w)return d;if(!e&&((b?b.ownerDocument||b:v)!==n&&m(b),b=b||n,p)){if(11!==w&&(l=Z.exec(a)))if(f=l[1]){if(9===w){if(!(j=b.getElementById(f)))return d;if(j.id===f)return d.push(j),d}else if(s&&(j=s.getElementById(f))&&t(b,j)&&j.id===f)return d.push(j),d}else{if(l[2])return G.apply(d,b.getElementsByTagName(a)),d;if((f=l[3])&&c.getElementsByClassName&&b.getElementsByClassName)return G.apply(d,b.getElementsByClassName(f)),d}if(c.qsa&&!A[a+" "]&&(!q||!q.test(a))){if(1!==w)s=b,r=a;else if("object"!==b.nodeName.toLowerCase()){(k=b.getAttribute("id"))?k=k.replace(ba,ca):b.setAttribute("id",k=u),o=g(a),h=o.length;while(h--)o[h]="#"+k+" "+sa(o[h]);r=o.join(","),s=$.test(a)&&qa(b.parentNode)||b}if(r)try{return G.apply(d,s.querySelectorAll(r)),d}catch(x){}finally{k===u&&b.removeAttribute("id")}}}return i(a.replace(P,"$1"),b,d,e)}function ha(){var a=[];function b(c,e){return a.push(c+" ")>d.cacheLength&&delete b[a.shift()],b[c+" "]=e}return b}function ia(a){return a[u]=!0,a}function ja(a){var b=n.createElement("fieldset");try{return!!a(b)}catch(c){return!1}finally{b.parentNode&&b.parentNode.removeChild(b),b=null}}function ka(a,b){var c=a.split("|"),e=c.length;while(e--)d.attrHandle[c[e]]=b}function la(a,b){var c=b&&a,d=c&&1===a.nodeType&&1===b.nodeType&&a.sourceIndex-b.sourceIndex;if(d)return d;if(c)while(c=c.nextSibling)if(c===b)return-1;return a?1:-1}function ma(a){return function(b){var c=b.nodeName.toLowerCase();return"input"===c&&b.type===a}}function na(a){return function(b){var c=b.nodeName.toLowerCase();return("input"===c||"button"===c)&&b.type===a}}function oa(a){return function(b){return"form"in b?b.parentNode&&b.disabled===!1?"label"in b?"label"in b.parentNode?b.parentNode.disabled===a:b.disabled===a:b.isDisabled===a||b.isDisabled!==!a&&ea(b)===a:b.disabled===a:"label"in b&&b.disabled===a}}function pa(a){return ia(function(b){return b=+b,ia(function(c,d){var e,f=a([],c.length,b),g=f.length;while(g--)c[e=f[g]]&&(c[e]=!(d[e]=c[e]))})})}function qa(a){return a&&"undefined"!=typeof a.getElementsByTagName&&a}c=ga.support={},f=ga.isXML=function(a){var b=a&&(a.ownerDocument||a).documentElement;return!!b&&"HTML"!==b.nodeName},m=ga.setDocument=function(a){var b,e,g=a?a.ownerDocument||a:v;return g!==n&&9===g.nodeType&&g.documentElement?(n=g,o=n.documentElement,p=!f(n),v!==n&&(e=n.defaultView)&&e.top!==e&&(e.addEventListener?e.addEventListener("unload",da,!1):e.attachEvent&&e.attachEvent("onunload",da)),c.attributes=ja(function(a){return a.className="i",!a.getAttribute("className")}),c.getElementsByTagName=ja(function(a){return a.appendChild(n.createComment("")),!a.getElementsByTagName("*").length}),c.getElementsByClassName=Y.test(n.getElementsByClassName),c.getById=ja(function(a){return o.appendChild(a).id=u,!n.getElementsByName||!n.getElementsByName(u).length}),c.getById?(d.filter.ID=function(a){var b=a.replace(_,aa);return function(a){return a.getAttribute("id")===b}},d.find.ID=function(a,b){if("undefined"!=typeof b.getElementById&&p){var c=b.getElementById(a);return c?[c]:[]}}):(d.filter.ID=function(a){var b=a.replace(_,aa);return function(a){var c="undefined"!=typeof a.getAttributeNode&&a.getAttributeNode("id");return c&&c.value===b}},d.find.ID=function(a,b){if("undefined"!=typeof b.getElementById&&p){var c,d,e,f=b.getElementById(a);if(f){if(c=f.getAttributeNode("id"),c&&c.value===a)return[f];e=b.getElementsByName(a),d=0;while(f=e[d++])if(c=f.getAttributeNode("id"),c&&c.value===a)return[f]}return[]}}),d.find.TAG=c.getElementsByTagName?function(a,b){return"undefined"!=typeof b.getElementsByTagName?b.getElementsByTagName(a):c.qsa?b.querySelectorAll(a):void 0}:function(a,b){var c,d=[],e=0,f=b.getElementsByTagName(a);if("*"===a){while(c=f[e++])1===c.nodeType&&d.push(c);return d}return f},d.find.CLASS=c.getElementsByClassName&&function(a,b){if("undefined"!=typeof b.getElementsByClassName&&p)return b.getElementsByClassName(a)},r=[],q=[],(c.qsa=Y.test(n.querySelectorAll))&&(ja(function(a){o.appendChild(a).innerHTML="<a id='"+u+"'></a><select id='"+u+"-\r\\' msallowcapture=''><option selected=''></option></select>",a.querySelectorAll("[msallowcapture^='']").length&&q.push("[*^$]="+K+"*(?:''|\"\")"),a.querySelectorAll("[selected]").length||q.push("\\["+K+"*(?:value|"+J+")"),a.querySelectorAll("[id~="+u+"-]").length||q.push("~="),a.querySelectorAll(":checked").length||q.push(":checked"),a.querySelectorAll("a#"+u+"+*").length||q.push(".#.+[+~]")}),ja(function(a){a.innerHTML="<a href='' disabled='disabled'></a><select disabled='disabled'><option/></select>";var b=n.createElement("input");b.setAttribute("type","hidden"),a.appendChild(b).setAttribute("name","D"),a.querySelectorAll("[name=d]").length&&q.push("name"+K+"*[*^$|!~]?="),2!==a.querySelectorAll(":enabled").length&&q.push(":enabled",":disabled"),o.appendChild(a).disabled=!0,2!==a.querySelectorAll(":disabled").length&&q.push(":enabled",":disabled"),a.querySelectorAll("*,:x"),q.push(",.*:")})),(c.matchesSelector=Y.test(s=o.matches||o.webkitMatchesSelector||o.mozMatchesSelector||o.oMatchesSelector||o.msMatchesSelector))&&ja(function(a){c.disconnectedMatch=s.call(a,"*"),s.call(a,"[s!='']:x"),r.push("!=",N)}),q=q.length&&new RegExp(q.join("|")),r=r.length&&new RegExp(r.join("|")),b=Y.test(o.compareDocumentPosition),t=b||Y.test(o.contains)?function(a,b){var c=9===a.nodeType?a.documentElement:a,d=b&&b.parentNode;return a===d||!(!d||1!==d.nodeType||!(c.contains?c.contains(d):a.compareDocumentPosition&&16&a.compareDocumentPosition(d)))}:function(a,b){if(b)while(b=b.parentNode)if(b===a)return!0;return!1},B=b?function(a,b){if(a===b)return l=!0,0;var d=!a.compareDocumentPosition-!b.compareDocumentPosition;return d?d:(d=(a.ownerDocument||a)===(b.ownerDocument||b)?a.compareDocumentPosition(b):1,1&d||!c.sortDetached&&b.compareDocumentPosition(a)===d?a===n||a.ownerDocument===v&&t(v,a)?-1:b===n||b.ownerDocument===v&&t(v,b)?1:k?I(k,a)-I(k,b):0:4&d?-1:1)}:function(a,b){if(a===b)return l=!0,0;var c,d=0,e=a.parentNode,f=b.parentNode,g=[a],h=[b];if(!e||!f)return a===n?-1:b===n?1:e?-1:f?1:k?I(k,a)-I(k,b):0;if(e===f)return la(a,b);c=a;while(c=c.parentNode)g.unshift(c);c=b;while(c=c.parentNode)h.unshift(c);while(g[d]===h[d])d++;return d?la(g[d],h[d]):g[d]===v?-1:h[d]===v?1:0},n):n},ga.matches=function(a,b){return ga(a,null,null,b)},ga.matchesSelector=function(a,b){if((a.ownerDocument||a)!==n&&m(a),b=b.replace(S,"='$1']"),c.matchesSelector&&p&&!A[b+" "]&&(!r||!r.test(b))&&(!q||!q.test(b)))try{var d=s.call(a,b);if(d||c.disconnectedMatch||a.document&&11!==a.document.nodeType)return d}catch(e){}return ga(b,n,null,[a]).length>0},ga.contains=function(a,b){return(a.ownerDocument||a)!==n&&m(a),t(a,b)},ga.attr=function(a,b){(a.ownerDocument||a)!==n&&m(a);var e=d.attrHandle[b.toLowerCase()],f=e&&C.call(d.attrHandle,b.toLowerCase())?e(a,b,!p):void 0;return void 0!==f?f:c.attributes||!p?a.getAttribute(b):(f=a.getAttributeNode(b))&&f.specified?f.value:null},ga.escape=function(a){return(a+"").replace(ba,ca)},ga.error=function(a){throw new Error("Syntax error, unrecognized expression: "+a)},ga.uniqueSort=function(a){var b,d=[],e=0,f=0;if(l=!c.detectDuplicates,k=!c.sortStable&&a.slice(0),a.sort(B),l){while(b=a[f++])b===a[f]&&(e=d.push(f));while(e--)a.splice(d[e],1)}return k=null,a},e=ga.getText=function(a){var b,c="",d=0,f=a.nodeType;if(f){if(1===f||9===f||11===f){if("string"==typeof a.textContent)return a.textContent;for(a=a.firstChild;a;a=a.nextSibling)c+=e(a)}else if(3===f||4===f)return a.nodeValue}else while(b=a[d++])c+=e(b);return c},d=ga.selectors={cacheLength:50,createPseudo:ia,match:V,attrHandle:{},find:{},relative:{">":{dir:"parentNode",first:!0}," ":{dir:"parentNode"},"+":{dir:"previousSibling",first:!0},"~":{dir:"previousSibling"}},preFilter:{ATTR:function(a){return a[1]=a[1].replace(_,aa),a[3]=(a[3]||a[4]||a[5]||"").replace(_,aa),"~="===a[2]&&(a[3]=" "+a[3]+" "),a.slice(0,4)},CHILD:function(a){return a[1]=a[1].toLowerCase(),"nth"===a[1].slice(0,3)?(a[3]||ga.error(a[0]),a[4]=+(a[4]?a[5]+(a[6]||1):2*("even"===a[3]||"odd"===a[3])),a[5]=+(a[7]+a[8]||"odd"===a[3])):a[3]&&ga.error(a[0]),a},PSEUDO:function(a){var b,c=!a[6]&&a[2];return V.CHILD.test(a[0])?null:(a[3]?a[2]=a[4]||a[5]||"":c&&T.test(c)&&(b=g(c,!0))&&(b=c.indexOf(")",c.length-b)-c.length)&&(a[0]=a[0].slice(0,b),a[2]=c.slice(0,b)),a.slice(0,3))}},filter:{TAG:function(a){var b=a.replace(_,aa).toLowerCase();return"*"===a?function(){return!0}:function(a){return a.nodeName&&a.nodeName.toLowerCase()===b}},CLASS:function(a){var b=y[a+" "];return b||(b=new RegExp("(^|"+K+")"+a+"("+K+"|$)"))&&y(a,function(a){return b.test("string"==typeof a.className&&a.className||"undefined"!=typeof a.getAttribute&&a.getAttribute("class")||"")})},ATTR:function(a,b,c){return function(d){var e=ga.attr(d,a);return null==e?"!="===b:!b||(e+="","="===b?e===c:"!="===b?e!==c:"^="===b?c&&0===e.indexOf(c):"*="===b?c&&e.indexOf(c)>-1:"$="===b?c&&e.slice(-c.length)===c:"~="===b?(" "+e.replace(O," ")+" ").indexOf(c)>-1:"|="===b&&(e===c||e.slice(0,c.length+1)===c+"-"))}},CHILD:function(a,b,c,d,e){var f="nth"!==a.slice(0,3),g="last"!==a.slice(-4),h="of-type"===b;return 1===d&&0===e?function(a){return!!a.parentNode}:function(b,c,i){var j,k,l,m,n,o,p=f!==g?"nextSibling":"previousSibling",q=b.parentNode,r=h&&b.nodeName.toLowerCase(),s=!i&&!h,t=!1;if(q){if(f){while(p){m=b;while(m=m[p])if(h?m.nodeName.toLowerCase()===r:1===m.nodeType)return!1;o=p="only"===a&&!o&&"nextSibling"}return!0}if(o=[g?q.firstChild:q.lastChild],g&&s){m=q,l=m[u]||(m[u]={}),k=l[m.uniqueID]||(l[m.uniqueID]={}),j=k[a]||[],n=j[0]===w&&j[1],t=n&&j[2],m=n&&q.childNodes[n];while(m=++n&&m&&m[p]||(t=n=0)||o.pop())if(1===m.nodeType&&++t&&m===b){k[a]=[w,n,t];break}}else if(s&&(m=b,l=m[u]||(m[u]={}),k=l[m.uniqueID]||(l[m.uniqueID]={}),j=k[a]||[],n=j[0]===w&&j[1],t=n),t===!1)while(m=++n&&m&&m[p]||(t=n=0)||o.pop())if((h?m.nodeName.toLowerCase()===r:1===m.nodeType)&&++t&&(s&&(l=m[u]||(m[u]={}),k=l[m.uniqueID]||(l[m.uniqueID]={}),k[a]=[w,t]),m===b))break;return t-=e,t===d||t%d===0&&t/d>=0}}},PSEUDO:function(a,b){var c,e=d.pseudos[a]||d.setFilters[a.toLowerCase()]||ga.error("unsupported pseudo: "+a);return e[u]?e(b):e.length>1?(c=[a,a,"",b],d.setFilters.hasOwnProperty(a.toLowerCase())?ia(function(a,c){var d,f=e(a,b),g=f.length;while(g--)d=I(a,f[g]),a[d]=!(c[d]=f[g])}):function(a){return e(a,0,c)}):e}},pseudos:{not:ia(function(a){var b=[],c=[],d=h(a.replace(P,"$1"));return d[u]?ia(function(a,b,c,e){var f,g=d(a,null,e,[]),h=a.length;while(h--)(f=g[h])&&(a[h]=!(b[h]=f))}):function(a,e,f){return b[0]=a,d(b,null,f,c),b[0]=null,!c.pop()}}),has:ia(function(a){return function(b){return ga(a,b).length>0}}),contains:ia(function(a){return a=a.replace(_,aa),function(b){return(b.textContent||b.innerText||e(b)).indexOf(a)>-1}}),lang:ia(function(a){return U.test(a||"")||ga.error("unsupported lang: "+a),a=a.replace(_,aa).toLowerCase(),function(b){var c;do if(c=p?b.lang:b.getAttribute("xml:lang")||b.getAttribute("lang"))return c=c.toLowerCase(),c===a||0===c.indexOf(a+"-");while((b=b.parentNode)&&1===b.nodeType);return!1}}),target:function(b){var c=a.location&&a.location.hash;return c&&c.slice(1)===b.id},root:function(a){return a===o},focus:function(a){return a===n.activeElement&&(!n.hasFocus||n.hasFocus())&&!!(a.type||a.href||~a.tabIndex)},enabled:oa(!1),disabled:oa(!0),checked:function(a){var b=a.nodeName.toLowerCase();return"input"===b&&!!a.checked||"option"===b&&!!a.selected},selected:function(a){return a.parentNode&&a.parentNode.selectedIndex,a.selected===!0},empty:function(a){for(a=a.firstChild;a;a=a.nextSibling)if(a.nodeType<6)return!1;return!0},parent:function(a){return!d.pseudos.empty(a)},header:function(a){return X.test(a.nodeName)},input:function(a){return W.test(a.nodeName)},button:function(a){var b=a.nodeName.toLowerCase();return"input"===b&&"button"===a.type||"button"===b},text:function(a){var b;return"input"===a.nodeName.toLowerCase()&&"text"===a.type&&(null==(b=a.getAttribute("type"))||"text"===b.toLowerCase())},first:pa(function(){return[0]}),last:pa(function(a,b){return[b-1]}),eq:pa(function(a,b,c){return[c<0?c+b:c]}),even:pa(function(a,b){for(var c=0;c<b;c+=2)a.push(c);return a}),odd:pa(function(a,b){for(var c=1;c<b;c+=2)a.push(c);return a}),lt:pa(function(a,b,c){for(var d=c<0?c+b:c;--d>=0;)a.push(d);return a}),gt:pa(function(a,b,c){for(var d=c<0?c+b:c;++d<b;)a.push(d);return a})}},d.pseudos.nth=d.pseudos.eq;for(b in{radio:!0,checkbox:!0,file:!0,password:!0,image:!0})d.pseudos[b]=ma(b);for(b in{submit:!0,reset:!0})d.pseudos[b]=na(b);function ra(){}ra.prototype=d.filters=d.pseudos,d.setFilters=new ra,g=ga.tokenize=function(a,b){var c,e,f,g,h,i,j,k=z[a+" "];if(k)return b?0:k.slice(0);h=a,i=[],j=d.preFilter;while(h){c&&!(e=Q.exec(h))||(e&&(h=h.slice(e[0].length)||h),i.push(f=[])),c=!1,(e=R.exec(h))&&(c=e.shift(),f.push({value:c,type:e[0].replace(P," ")}),h=h.slice(c.length));for(g in d.filter)!(e=V[g].exec(h))||j[g]&&!(e=j[g](e))||(c=e.shift(),f.push({value:c,type:g,matches:e}),h=h.slice(c.length));if(!c)break}return b?h.length:h?ga.error(a):z(a,i).slice(0)};function sa(a){for(var b=0,c=a.length,d="";b<c;b++)d+=a[b].value;return d}function ta(a,b,c){var d=b.dir,e=b.next,f=e||d,g=c&&"parentNode"===f,h=x++;return b.first?function(b,c,e){while(b=b[d])if(1===b.nodeType||g)return a(b,c,e);return!1}:function(b,c,i){var j,k,l,m=[w,h];if(i){while(b=b[d])if((1===b.nodeType||g)&&a(b,c,i))return!0}else while(b=b[d])if(1===b.nodeType||g)if(l=b[u]||(b[u]={}),k=l[b.uniqueID]||(l[b.uniqueID]={}),e&&e===b.nodeName.toLowerCase())b=b[d]||b;else{if((j=k[f])&&j[0]===w&&j[1]===h)return m[2]=j[2];if(k[f]=m,m[2]=a(b,c,i))return!0}return!1}}function ua(a){return a.length>1?function(b,c,d){var e=a.length;while(e--)if(!a[e](b,c,d))return!1;return!0}:a[0]}function va(a,b,c){for(var d=0,e=b.length;d<e;d++)ga(a,b[d],c);return c}function wa(a,b,c,d,e){for(var f,g=[],h=0,i=a.length,j=null!=b;h<i;h++)(f=a[h])&&(c&&!c(f,d,e)||(g.push(f),j&&b.push(h)));return g}function xa(a,b,c,d,e,f){return d&&!d[u]&&(d=xa(d)),e&&!e[u]&&(e=xa(e,f)),ia(function(f,g,h,i){var j,k,l,m=[],n=[],o=g.length,p=f||va(b||"*",h.nodeType?[h]:h,[]),q=!a||!f&&b?p:wa(p,m,a,h,i),r=c?e||(f?a:o||d)?[]:g:q;if(c&&c(q,r,h,i),d){j=wa(r,n),d(j,[],h,i),k=j.length;while(k--)(l=j[k])&&(r[n[k]]=!(q[n[k]]=l))}if(f){if(e||a){if(e){j=[],k=r.length;while(k--)(l=r[k])&&j.push(q[k]=l);e(null,r=[],j,i)}k=r.length;while(k--)(l=r[k])&&(j=e?I(f,l):m[k])>-1&&(f[j]=!(g[j]=l))}}else r=wa(r===g?r.splice(o,r.length):r),e?e(null,g,r,i):G.apply(g,r)})}function ya(a){for(var b,c,e,f=a.length,g=d.relative[a[0].type],h=g||d.relative[" "],i=g?1:0,k=ta(function(a){return a===b},h,!0),l=ta(function(a){return I(b,a)>-1},h,!0),m=[function(a,c,d){var e=!g&&(d||c!==j)||((b=c).nodeType?k(a,c,d):l(a,c,d));return b=null,e}];i<f;i++)if(c=d.relative[a[i].type])m=[ta(ua(m),c)];else{if(c=d.filter[a[i].type].apply(null,a[i].matches),c[u]){for(e=++i;e<f;e++)if(d.relative[a[e].type])break;return xa(i>1&&ua(m),i>1&&sa(a.slice(0,i-1).concat({value:" "===a[i-2].type?"*":""})).replace(P,"$1"),c,i<e&&ya(a.slice(i,e)),e<f&&ya(a=a.slice(e)),e<f&&sa(a))}m.push(c)}return ua(m)}function za(a,b){var c=b.length>0,e=a.length>0,f=function(f,g,h,i,k){var l,o,q,r=0,s="0",t=f&&[],u=[],v=j,x=f||e&&d.find.TAG("*",k),y=w+=null==v?1:Math.random()||.1,z=x.length;for(k&&(j=g===n||g||k);s!==z&&null!=(l=x[s]);s++){if(e&&l){o=0,g||l.ownerDocument===n||(m(l),h=!p);while(q=a[o++])if(q(l,g||n,h)){i.push(l);break}k&&(w=y)}c&&((l=!q&&l)&&r--,f&&t.push(l))}if(r+=s,c&&s!==r){o=0;while(q=b[o++])q(t,u,g,h);if(f){if(r>0)while(s--)t[s]||u[s]||(u[s]=E.call(i));u=wa(u)}G.apply(i,u),k&&!f&&u.length>0&&r+b.length>1&&ga.uniqueSort(i)}return k&&(w=y,j=v),t};return c?ia(f):f}return h=ga.compile=function(a,b){var c,d=[],e=[],f=A[a+" "];if(!f){b||(b=g(a)),c=b.length;while(c--)f=ya(b[c]),f[u]?d.push(f):e.push(f);f=A(a,za(e,d)),f.selector=a}return f},i=ga.select=function(a,b,c,e){var f,i,j,k,l,m="function"==typeof a&&a,n=!e&&g(a=m.selector||a);if(c=c||[],1===n.length){if(i=n[0]=n[0].slice(0),i.length>2&&"ID"===(j=i[0]).type&&9===b.nodeType&&p&&d.relative[i[1].type]){if(b=(d.find.ID(j.matches[0].replace(_,aa),b)||[])[0],!b)return c;m&&(b=b.parentNode),a=a.slice(i.shift().value.length)}f=V.needsContext.test(a)?0:i.length;while(f--){if(j=i[f],d.relative[k=j.type])break;if((l=d.find[k])&&(e=l(j.matches[0].replace(_,aa),$.test(i[0].type)&&qa(b.parentNode)||b))){if(i.splice(f,1),a=e.length&&sa(i),!a)return G.apply(c,e),c;break}}}return(m||h(a,n))(e,b,!p,c,!b||$.test(a)&&qa(b.parentNode)||b),c},c.sortStable=u.split("").sort(B).join("")===u,c.detectDuplicates=!!l,m(),c.sortDetached=ja(function(a){return 1&a.compareDocumentPosition(n.createElement("fieldset"))}),ja(function(a){return a.innerHTML="<a href='#'></a>","#"===a.firstChild.getAttribute("href")})||ka("type|href|height|width",function(a,b,c){if(!c)return a.getAttribute(b,"type"===b.toLowerCase()?1:2)}),c.attributes&&ja(function(a){return a.innerHTML="<input/>",a.firstChild.setAttribute("value",""),""===a.firstChild.getAttribute("value")})||ka("value",function(a,b,c){if(!c&&"input"===a.nodeName.toLowerCase())return a.defaultValue}),ja(function(a){return null==a.getAttribute("disabled")})||ka(J,function(a,b,c){var d;if(!c)return a[b]===!0?b.toLowerCase():(d=a.getAttributeNode(b))&&d.specified?d.value:null}),ga}(a);r.find=x,r.expr=x.selectors,r.expr[":"]=r.expr.pseudos,r.uniqueSort=r.unique=x.uniqueSort,r.text=x.getText,r.isXMLDoc=x.isXML,r.contains=x.contains,r.escapeSelector=x.escape;var y=function(a,b,c){var d=[],e=void 0!==c;while((a=a[b])&&9!==a.nodeType)if(1===a.nodeType){if(e&&r(a).is(c))break;d.push(a)}return d},z=function(a,b){for(var c=[];a;a=a.nextSibling)1===a.nodeType&&a!==b&&c.push(a);return c},A=r.expr.match.needsContext;function B(a,b){return a.nodeName&&a.nodeName.toLowerCase()===b.toLowerCase()}var C=/^<([a-z][^\/\0>:\x20\t\r\n\f]*)[\x20\t\r\n\f]*\/?>(?:<\/\1>|)$/i,D=/^.[^:#\[\.,]*$/;function E(a,b,c){return r.isFunction(b)?r.grep(a,function(a,d){return!!b.call(a,d,a)!==c}):b.nodeType?r.grep(a,function(a){return a===b!==c}):"string"!=typeof b?r.grep(a,function(a){return i.call(b,a)>-1!==c}):D.test(b)?r.filter(b,a,c):(b=r.filter(b,a),r.grep(a,function(a){return i.call(b,a)>-1!==c&&1===a.nodeType}))}r.filter=function(a,b,c){var d=b[0];return c&&(a=":not("+a+")"),1===b.length&&1===d.nodeType?r.find.matchesSelector(d,a)?[d]:[]:r.find.matches(a,r.grep(b,function(a){return 1===a.nodeType}))},r.fn.extend({find:function(a){var b,c,d=this.length,e=this;if("string"!=typeof a)return this.pushStack(r(a).filter(function(){for(b=0;b<d;b++)if(r.contains(e[b],this))return!0}));for(c=this.pushStack([]),b=0;b<d;b++)r.find(a,e[b],c);return d>1?r.uniqueSort(c):c},filter:function(a){return this.pushStack(E(this,a||[],!1))},not:function(a){return this.pushStack(E(this,a||[],!0))},is:function(a){return!!E(this,"string"==typeof a&&A.test(a)?r(a):a||[],!1).length}});var F,G=/^(?:\s*(<[\w\W]+>)[^>]*|#([\w-]+))$/,H=r.fn.init=function(a,b,c){var e,f;if(!a)return this;if(c=c||F,"string"==typeof a){if(e="<"===a[0]&&">"===a[a.length-1]&&a.length>=3?[null,a,null]:G.exec(a),!e||!e[1]&&b)return!b||b.jquery?(b||c).find(a):this.constructor(b).find(a);if(e[1]){if(b=b instanceof r?b[0]:b,r.merge(this,r.parseHTML(e[1],b&&b.nodeType?b.ownerDocument||b:d,!0)),C.test(e[1])&&r.isPlainObject(b))for(e in b)r.isFunction(this[e])?this[e](b[e]):this.attr(e,b[e]);return this}return f=d.getElementById(e[2]),f&&(this[0]=f,this.length=1),this}return a.nodeType?(this[0]=a,this.length=1,this):r.isFunction(a)?void 0!==c.ready?c.ready(a):a(r):r.makeArray(a,this)};H.prototype=r.fn,F=r(d);var I=/^(?:parents|prev(?:Until|All))/,J={children:!0,contents:!0,next:!0,prev:!0};r.fn.extend({has:function(a){var b=r(a,this),c=b.length;return this.filter(function(){for(var a=0;a<c;a++)if(r.contains(this,b[a]))return!0})},closest:function(a,b){var c,d=0,e=this.length,f=[],g="string"!=typeof a&&r(a);if(!A.test(a))for(;d<e;d++)for(c=this[d];c&&c!==b;c=c.parentNode)if(c.nodeType<11&&(g?g.index(c)>-1:1===c.nodeType&&r.find.matchesSelector(c,a))){f.push(c);break}return this.pushStack(f.length>1?r.uniqueSort(f):f)},index:function(a){return a?"string"==typeof a?i.call(r(a),this[0]):i.call(this,a.jquery?a[0]:a):this[0]&&this[0].parentNode?this.first().prevAll().length:-1},add:function(a,b){return this.pushStack(r.uniqueSort(r.merge(this.get(),r(a,b))))},addBack:function(a){return this.add(null==a?this.prevObject:this.prevObject.filter(a))}});function K(a,b){while((a=a[b])&&1!==a.nodeType);return a}r.each({parent:function(a){var b=a.parentNode;return b&&11!==b.nodeType?b:null},parents:function(a){return y(a,"parentNode")},parentsUntil:function(a,b,c){return y(a,"parentNode",c)},next:function(a){return K(a,"nextSibling")},prev:function(a){return K(a,"previousSibling")},nextAll:function(a){return y(a,"nextSibling")},prevAll:function(a){return y(a,"previousSibling")},nextUntil:function(a,b,c){return y(a,"nextSibling",c)},prevUntil:function(a,b,c){return y(a,"previousSibling",c)},siblings:function(a){return z((a.parentNode||{}).firstChild,a)},children:function(a){return z(a.firstChild)},contents:function(a){return B(a,"iframe")?a.contentDocument:(B(a,"template")&&(a=a.content||a),r.merge([],a.childNodes))}},function(a,b){r.fn[a]=function(c,d){var e=r.map(this,b,c);return"Until"!==a.slice(-5)&&(d=c),d&&"string"==typeof d&&(e=r.filter(d,e)),this.length>1&&(J[a]||r.uniqueSort(e),I.test(a)&&e.reverse()),this.pushStack(e)}});var L=/[^\x20\t\r\n\f]+/g;function M(a){var b={};return r.each(a.match(L)||[],function(a,c){b[c]=!0}),b}r.Callbacks=function(a){a="string"==typeof a?M(a):r.extend({},a);var b,c,d,e,f=[],g=[],h=-1,i=function(){for(e=e||a.once,d=b=!0;g.length;h=-1){c=g.shift();while(++h<f.length)f[h].apply(c[0],c[1])===!1&&a.stopOnFalse&&(h=f.length,c=!1)}a.memory||(c=!1),b=!1,e&&(f=c?[]:"")},j={add:function(){return f&&(c&&!b&&(h=f.length-1,g.push(c)),function d(b){r.each(b,function(b,c){r.isFunction(c)?a.unique&&j.has(c)||f.push(c):c&&c.length&&"string"!==r.type(c)&&d(c)})}(arguments),c&&!b&&i()),this},remove:function(){return r.each(arguments,function(a,b){var c;while((c=r.inArray(b,f,c))>-1)f.splice(c,1),c<=h&&h--}),this},has:function(a){return a?r.inArray(a,f)>-1:f.length>0},empty:function(){return f&&(f=[]),this},disable:function(){return e=g=[],f=c="",this},disabled:function(){return!f},lock:function(){return e=g=[],c||b||(f=c=""),this},locked:function(){return!!e},fireWith:function(a,c){return e||(c=c||[],c=[a,c.slice?c.slice():c],g.push(c),b||i()),this},fire:function(){return j.fireWith(this,arguments),this},fired:function(){return!!d}};return j};function N(a){return a}function O(a){throw a}function P(a,b,c,d){var e;try{a&&r.isFunction(e=a.promise)?e.call(a).done(b).fail(c):a&&r.isFunction(e=a.then)?e.call(a,b,c):b.apply(void 0,[a].slice(d))}catch(a){c.apply(void 0,[a])}}r.extend({Deferred:function(b){var c=[["notify","progress",r.Callbacks("memory"),r.Callbacks("memory"),2],["resolve","done",r.Callbacks("once memory"),r.Callbacks("once memory"),0,"resolved"],["reject","fail",r.Callbacks("once memory"),r.Callbacks("once memory"),1,"rejected"]],d="pending",e={state:function(){return d},always:function(){return f.done(arguments).fail(arguments),this},"catch":function(a){return e.then(null,a)},pipe:function(){var a=arguments;return r.Deferred(function(b){r.each(c,function(c,d){var e=r.isFunction(a[d[4]])&&a[d[4]];f[d[1]](function(){var a=e&&e.apply(this,arguments);a&&r.isFunction(a.promise)?a.promise().progress(b.notify).done(b.resolve).fail(b.reject):b[d[0]+"With"](this,e?[a]:arguments)})}),a=null}).promise()},then:function(b,d,e){var f=0;function g(b,c,d,e){return function(){var h=this,i=arguments,j=function(){var a,j;if(!(b<f)){if(a=d.apply(h,i),a===c.promise())throw new TypeError("Thenable self-resolution");j=a&&("object"==typeof a||"function"==typeof a)&&a.then,r.isFunction(j)?e?j.call(a,g(f,c,N,e),g(f,c,O,e)):(f++,j.call(a,g(f,c,N,e),g(f,c,O,e),g(f,c,N,c.notifyWith))):(d!==N&&(h=void 0,i=[a]),(e||c.resolveWith)(h,i))}},k=e?j:function(){try{j()}catch(a){r.Deferred.exceptionHook&&r.Deferred.exceptionHook(a,k.stackTrace),b+1>=f&&(d!==O&&(h=void 0,i=[a]),c.rejectWith(h,i))}};b?k():(r.Deferred.getStackHook&&(k.stackTrace=r.Deferred.getStackHook()),a.setTimeout(k))}}return r.Deferred(function(a){c[0][3].add(g(0,a,r.isFunction(e)?e:N,a.notifyWith)),c[1][3].add(g(0,a,r.isFunction(b)?b:N)),c[2][3].add(g(0,a,r.isFunction(d)?d:O))}).promise()},promise:function(a){return null!=a?r.extend(a,e):e}},f={};return r.each(c,function(a,b){var g=b[2],h=b[5];e[b[1]]=g.add,h&&g.add(function(){d=h},c[3-a][2].disable,c[0][2].lock),g.add(b[3].fire),f[b[0]]=function(){return f[b[0]+"With"](this===f?void 0:this,arguments),this},f[b[0]+"With"]=g.fireWith}),e.promise(f),b&&b.call(f,f),f},when:function(a){var b=arguments.length,c=b,d=Array(c),e=f.call(arguments),g=r.Deferred(),h=function(a){return function(c){d[a]=this,e[a]=arguments.length>1?f.call(arguments):c,--b||g.resolveWith(d,e)}};if(b<=1&&(P(a,g.done(h(c)).resolve,g.reject,!b),"pending"===g.state()||r.isFunction(e[c]&&e[c].then)))return g.then();while(c--)P(e[c],h(c),g.reject);return g.promise()}});var Q=/^(Eval|Internal|Range|Reference|Syntax|Type|URI)Error$/;r.Deferred.exceptionHook=function(b,c){a.console&&a.console.warn&&b&&Q.test(b.name)&&a.console.warn("jQuery.Deferred exception: "+b.message,b.stack,c)},r.readyException=function(b){a.setTimeout(function(){throw b})};var R=r.Deferred();r.fn.ready=function(a){return R.then(a)["catch"](function(a){r.readyException(a)}),this},r.extend({isReady:!1,readyWait:1,ready:function(a){(a===!0?--r.readyWait:r.isReady)||(r.isReady=!0,a!==!0&&--r.readyWait>0||R.resolveWith(d,[r]))}}),r.ready.then=R.then;function S(){d.removeEventListener("DOMContentLoaded",S),
-a.removeEventListener("load",S),r.ready()}"complete"===d.readyState||"loading"!==d.readyState&&!d.documentElement.doScroll?a.setTimeout(r.ready):(d.addEventListener("DOMContentLoaded",S),a.addEventListener("load",S));var T=function(a,b,c,d,e,f,g){var h=0,i=a.length,j=null==c;if("object"===r.type(c)){e=!0;for(h in c)T(a,b,h,c[h],!0,f,g)}else if(void 0!==d&&(e=!0,r.isFunction(d)||(g=!0),j&&(g?(b.call(a,d),b=null):(j=b,b=function(a,b,c){return j.call(r(a),c)})),b))for(;h<i;h++)b(a[h],c,g?d:d.call(a[h],h,b(a[h],c)));return e?a:j?b.call(a):i?b(a[0],c):f},U=function(a){return 1===a.nodeType||9===a.nodeType||!+a.nodeType};function V(){this.expando=r.expando+V.uid++}V.uid=1,V.prototype={cache:function(a){var b=a[this.expando];return b||(b={},U(a)&&(a.nodeType?a[this.expando]=b:Object.defineProperty(a,this.expando,{value:b,configurable:!0}))),b},set:function(a,b,c){var d,e=this.cache(a);if("string"==typeof b)e[r.camelCase(b)]=c;else for(d in b)e[r.camelCase(d)]=b[d];return e},get:function(a,b){return void 0===b?this.cache(a):a[this.expando]&&a[this.expando][r.camelCase(b)]},access:function(a,b,c){return void 0===b||b&&"string"==typeof b&&void 0===c?this.get(a,b):(this.set(a,b,c),void 0!==c?c:b)},remove:function(a,b){var c,d=a[this.expando];if(void 0!==d){if(void 0!==b){Array.isArray(b)?b=b.map(r.camelCase):(b=r.camelCase(b),b=b in d?[b]:b.match(L)||[]),c=b.length;while(c--)delete d[b[c]]}(void 0===b||r.isEmptyObject(d))&&(a.nodeType?a[this.expando]=void 0:delete a[this.expando])}},hasData:function(a){var b=a[this.expando];return void 0!==b&&!r.isEmptyObject(b)}};var W=new V,X=new V,Y=/^(?:\{[\w\W]*\}|\[[\w\W]*\])$/,Z=/[A-Z]/g;function $(a){return"true"===a||"false"!==a&&("null"===a?null:a===+a+""?+a:Y.test(a)?JSON.parse(a):a)}function _(a,b,c){var d;if(void 0===c&&1===a.nodeType)if(d="data-"+b.replace(Z,"-$&").toLowerCase(),c=a.getAttribute(d),"string"==typeof c){try{c=$(c)}catch(e){}X.set(a,b,c)}else c=void 0;return c}r.extend({hasData:function(a){return X.hasData(a)||W.hasData(a)},data:function(a,b,c){return X.access(a,b,c)},removeData:function(a,b){X.remove(a,b)},_data:function(a,b,c){return W.access(a,b,c)},_removeData:function(a,b){W.remove(a,b)}}),r.fn.extend({data:function(a,b){var c,d,e,f=this[0],g=f&&f.attributes;if(void 0===a){if(this.length&&(e=X.get(f),1===f.nodeType&&!W.get(f,"hasDataAttrs"))){c=g.length;while(c--)g[c]&&(d=g[c].name,0===d.indexOf("data-")&&(d=r.camelCase(d.slice(5)),_(f,d,e[d])));W.set(f,"hasDataAttrs",!0)}return e}return"object"==typeof a?this.each(function(){X.set(this,a)}):T(this,function(b){var c;if(f&&void 0===b){if(c=X.get(f,a),void 0!==c)return c;if(c=_(f,a),void 0!==c)return c}else this.each(function(){X.set(this,a,b)})},null,b,arguments.length>1,null,!0)},removeData:function(a){return this.each(function(){X.remove(this,a)})}}),r.extend({queue:function(a,b,c){var d;if(a)return b=(b||"fx")+"queue",d=W.get(a,b),c&&(!d||Array.isArray(c)?d=W.access(a,b,r.makeArray(c)):d.push(c)),d||[]},dequeue:function(a,b){b=b||"fx";var c=r.queue(a,b),d=c.length,e=c.shift(),f=r._queueHooks(a,b),g=function(){r.dequeue(a,b)};"inprogress"===e&&(e=c.shift(),d--),e&&("fx"===b&&c.unshift("inprogress"),delete f.stop,e.call(a,g,f)),!d&&f&&f.empty.fire()},_queueHooks:function(a,b){var c=b+"queueHooks";return W.get(a,c)||W.access(a,c,{empty:r.Callbacks("once memory").add(function(){W.remove(a,[b+"queue",c])})})}}),r.fn.extend({queue:function(a,b){var c=2;return"string"!=typeof a&&(b=a,a="fx",c--),arguments.length<c?r.queue(this[0],a):void 0===b?this:this.each(function(){var c=r.queue(this,a,b);r._queueHooks(this,a),"fx"===a&&"inprogress"!==c[0]&&r.dequeue(this,a)})},dequeue:function(a){return this.each(function(){r.dequeue(this,a)})},clearQueue:function(a){return this.queue(a||"fx",[])},promise:function(a,b){var c,d=1,e=r.Deferred(),f=this,g=this.length,h=function(){--d||e.resolveWith(f,[f])};"string"!=typeof a&&(b=a,a=void 0),a=a||"fx";while(g--)c=W.get(f[g],a+"queueHooks"),c&&c.empty&&(d++,c.empty.add(h));return h(),e.promise(b)}});var aa=/[+-]?(?:\d*\.|)\d+(?:[eE][+-]?\d+|)/.source,ba=new RegExp("^(?:([+-])=|)("+aa+")([a-z%]*)$","i"),ca=["Top","Right","Bottom","Left"],da=function(a,b){return a=b||a,"none"===a.style.display||""===a.style.display&&r.contains(a.ownerDocument,a)&&"none"===r.css(a,"display")},ea=function(a,b,c,d){var e,f,g={};for(f in b)g[f]=a.style[f],a.style[f]=b[f];e=c.apply(a,d||[]);for(f in b)a.style[f]=g[f];return e};function fa(a,b,c,d){var e,f=1,g=20,h=d?function(){return d.cur()}:function(){return r.css(a,b,"")},i=h(),j=c&&c[3]||(r.cssNumber[b]?"":"px"),k=(r.cssNumber[b]||"px"!==j&&+i)&&ba.exec(r.css(a,b));if(k&&k[3]!==j){j=j||k[3],c=c||[],k=+i||1;do f=f||".5",k/=f,r.style(a,b,k+j);while(f!==(f=h()/i)&&1!==f&&--g)}return c&&(k=+k||+i||0,e=c[1]?k+(c[1]+1)*c[2]:+c[2],d&&(d.unit=j,d.start=k,d.end=e)),e}var ga={};function ha(a){var b,c=a.ownerDocument,d=a.nodeName,e=ga[d];return e?e:(b=c.body.appendChild(c.createElement(d)),e=r.css(b,"display"),b.parentNode.removeChild(b),"none"===e&&(e="block"),ga[d]=e,e)}function ia(a,b){for(var c,d,e=[],f=0,g=a.length;f<g;f++)d=a[f],d.style&&(c=d.style.display,b?("none"===c&&(e[f]=W.get(d,"display")||null,e[f]||(d.style.display="")),""===d.style.display&&da(d)&&(e[f]=ha(d))):"none"!==c&&(e[f]="none",W.set(d,"display",c)));for(f=0;f<g;f++)null!=e[f]&&(a[f].style.display=e[f]);return a}r.fn.extend({show:function(){return ia(this,!0)},hide:function(){return ia(this)},toggle:function(a){return"boolean"==typeof a?a?this.show():this.hide():this.each(function(){da(this)?r(this).show():r(this).hide()})}});var ja=/^(?:checkbox|radio)$/i,ka=/<([a-z][^\/\0>\x20\t\r\n\f]+)/i,la=/^$|\/(?:java|ecma)script/i,ma={option:[1,"<select multiple='multiple'>","</select>"],thead:[1,"<table>","</table>"],col:[2,"<table><colgroup>","</colgroup></table>"],tr:[2,"<table><tbody>","</tbody></table>"],td:[3,"<table><tbody><tr>","</tr></tbody></table>"],_default:[0,"",""]};ma.optgroup=ma.option,ma.tbody=ma.tfoot=ma.colgroup=ma.caption=ma.thead,ma.th=ma.td;function na(a,b){var c;return c="undefined"!=typeof a.getElementsByTagName?a.getElementsByTagName(b||"*"):"undefined"!=typeof a.querySelectorAll?a.querySelectorAll(b||"*"):[],void 0===b||b&&B(a,b)?r.merge([a],c):c}function oa(a,b){for(var c=0,d=a.length;c<d;c++)W.set(a[c],"globalEval",!b||W.get(b[c],"globalEval"))}var pa=/<|&#?\w+;/;function qa(a,b,c,d,e){for(var f,g,h,i,j,k,l=b.createDocumentFragment(),m=[],n=0,o=a.length;n<o;n++)if(f=a[n],f||0===f)if("object"===r.type(f))r.merge(m,f.nodeType?[f]:f);else if(pa.test(f)){g=g||l.appendChild(b.createElement("div")),h=(ka.exec(f)||["",""])[1].toLowerCase(),i=ma[h]||ma._default,g.innerHTML=i[1]+r.htmlPrefilter(f)+i[2],k=i[0];while(k--)g=g.lastChild;r.merge(m,g.childNodes),g=l.firstChild,g.textContent=""}else m.push(b.createTextNode(f));l.textContent="",n=0;while(f=m[n++])if(d&&r.inArray(f,d)>-1)e&&e.push(f);else if(j=r.contains(f.ownerDocument,f),g=na(l.appendChild(f),"script"),j&&oa(g),c){k=0;while(f=g[k++])la.test(f.type||"")&&c.push(f)}return l}!function(){var a=d.createDocumentFragment(),b=a.appendChild(d.createElement("div")),c=d.createElement("input");c.setAttribute("type","radio"),c.setAttribute("checked","checked"),c.setAttribute("name","t"),b.appendChild(c),o.checkClone=b.cloneNode(!0).cloneNode(!0).lastChild.checked,b.innerHTML="<textarea>x</textarea>",o.noCloneChecked=!!b.cloneNode(!0).lastChild.defaultValue}();var ra=d.documentElement,sa=/^key/,ta=/^(?:mouse|pointer|contextmenu|drag|drop)|click/,ua=/^([^.]*)(?:\.(.+)|)/;function va(){return!0}function wa(){return!1}function xa(){try{return d.activeElement}catch(a){}}function ya(a,b,c,d,e,f){var g,h;if("object"==typeof b){"string"!=typeof c&&(d=d||c,c=void 0);for(h in b)ya(a,h,c,d,b[h],f);return a}if(null==d&&null==e?(e=c,d=c=void 0):null==e&&("string"==typeof c?(e=d,d=void 0):(e=d,d=c,c=void 0)),e===!1)e=wa;else if(!e)return a;return 1===f&&(g=e,e=function(a){return r().off(a),g.apply(this,arguments)},e.guid=g.guid||(g.guid=r.guid++)),a.each(function(){r.event.add(this,b,e,d,c)})}r.event={global:{},add:function(a,b,c,d,e){var f,g,h,i,j,k,l,m,n,o,p,q=W.get(a);if(q){c.handler&&(f=c,c=f.handler,e=f.selector),e&&r.find.matchesSelector(ra,e),c.guid||(c.guid=r.guid++),(i=q.events)||(i=q.events={}),(g=q.handle)||(g=q.handle=function(b){return"undefined"!=typeof r&&r.event.triggered!==b.type?r.event.dispatch.apply(a,arguments):void 0}),b=(b||"").match(L)||[""],j=b.length;while(j--)h=ua.exec(b[j])||[],n=p=h[1],o=(h[2]||"").split(".").sort(),n&&(l=r.event.special[n]||{},n=(e?l.delegateType:l.bindType)||n,l=r.event.special[n]||{},k=r.extend({type:n,origType:p,data:d,handler:c,guid:c.guid,selector:e,needsContext:e&&r.expr.match.needsContext.test(e),namespace:o.join(".")},f),(m=i[n])||(m=i[n]=[],m.delegateCount=0,l.setup&&l.setup.call(a,d,o,g)!==!1||a.addEventListener&&a.addEventListener(n,g)),l.add&&(l.add.call(a,k),k.handler.guid||(k.handler.guid=c.guid)),e?m.splice(m.delegateCount++,0,k):m.push(k),r.event.global[n]=!0)}},remove:function(a,b,c,d,e){var f,g,h,i,j,k,l,m,n,o,p,q=W.hasData(a)&&W.get(a);if(q&&(i=q.events)){b=(b||"").match(L)||[""],j=b.length;while(j--)if(h=ua.exec(b[j])||[],n=p=h[1],o=(h[2]||"").split(".").sort(),n){l=r.event.special[n]||{},n=(d?l.delegateType:l.bindType)||n,m=i[n]||[],h=h[2]&&new RegExp("(^|\\.)"+o.join("\\.(?:.*\\.|)")+"(\\.|$)"),g=f=m.length;while(f--)k=m[f],!e&&p!==k.origType||c&&c.guid!==k.guid||h&&!h.test(k.namespace)||d&&d!==k.selector&&("**"!==d||!k.selector)||(m.splice(f,1),k.selector&&m.delegateCount--,l.remove&&l.remove.call(a,k));g&&!m.length&&(l.teardown&&l.teardown.call(a,o,q.handle)!==!1||r.removeEvent(a,n,q.handle),delete i[n])}else for(n in i)r.event.remove(a,n+b[j],c,d,!0);r.isEmptyObject(i)&&W.remove(a,"handle events")}},dispatch:function(a){var b=r.event.fix(a),c,d,e,f,g,h,i=new Array(arguments.length),j=(W.get(this,"events")||{})[b.type]||[],k=r.event.special[b.type]||{};for(i[0]=b,c=1;c<arguments.length;c++)i[c]=arguments[c];if(b.delegateTarget=this,!k.preDispatch||k.preDispatch.call(this,b)!==!1){h=r.event.handlers.call(this,b,j),c=0;while((f=h[c++])&&!b.isPropagationStopped()){b.currentTarget=f.elem,d=0;while((g=f.handlers[d++])&&!b.isImmediatePropagationStopped())b.rnamespace&&!b.rnamespace.test(g.namespace)||(b.handleObj=g,b.data=g.data,e=((r.event.special[g.origType]||{}).handle||g.handler).apply(f.elem,i),void 0!==e&&(b.result=e)===!1&&(b.preventDefault(),b.stopPropagation()))}return k.postDispatch&&k.postDispatch.call(this,b),b.result}},handlers:function(a,b){var c,d,e,f,g,h=[],i=b.delegateCount,j=a.target;if(i&&j.nodeType&&!("click"===a.type&&a.button>=1))for(;j!==this;j=j.parentNode||this)if(1===j.nodeType&&("click"!==a.type||j.disabled!==!0)){for(f=[],g={},c=0;c<i;c++)d=b[c],e=d.selector+" ",void 0===g[e]&&(g[e]=d.needsContext?r(e,this).index(j)>-1:r.find(e,this,null,[j]).length),g[e]&&f.push(d);f.length&&h.push({elem:j,handlers:f})}return j=this,i<b.length&&h.push({elem:j,handlers:b.slice(i)}),h},addProp:function(a,b){Object.defineProperty(r.Event.prototype,a,{enumerable:!0,configurable:!0,get:r.isFunction(b)?function(){if(this.originalEvent)return b(this.originalEvent)}:function(){if(this.originalEvent)return this.originalEvent[a]},set:function(b){Object.defineProperty(this,a,{enumerable:!0,configurable:!0,writable:!0,value:b})}})},fix:function(a){return a[r.expando]?a:new r.Event(a)},special:{load:{noBubble:!0},focus:{trigger:function(){if(this!==xa()&&this.focus)return this.focus(),!1},delegateType:"focusin"},blur:{trigger:function(){if(this===xa()&&this.blur)return this.blur(),!1},delegateType:"focusout"},click:{trigger:function(){if("checkbox"===this.type&&this.click&&B(this,"input"))return this.click(),!1},_default:function(a){return B(a.target,"a")}},beforeunload:{postDispatch:function(a){void 0!==a.result&&a.originalEvent&&(a.originalEvent.returnValue=a.result)}}}},r.removeEvent=function(a,b,c){a.removeEventListener&&a.removeEventListener(b,c)},r.Event=function(a,b){return this instanceof r.Event?(a&&a.type?(this.originalEvent=a,this.type=a.type,this.isDefaultPrevented=a.defaultPrevented||void 0===a.defaultPrevented&&a.returnValue===!1?va:wa,this.target=a.target&&3===a.target.nodeType?a.target.parentNode:a.target,this.currentTarget=a.currentTarget,this.relatedTarget=a.relatedTarget):this.type=a,b&&r.extend(this,b),this.timeStamp=a&&a.timeStamp||r.now(),void(this[r.expando]=!0)):new r.Event(a,b)},r.Event.prototype={constructor:r.Event,isDefaultPrevented:wa,isPropagationStopped:wa,isImmediatePropagationStopped:wa,isSimulated:!1,preventDefault:function(){var a=this.originalEvent;this.isDefaultPrevented=va,a&&!this.isSimulated&&a.preventDefault()},stopPropagation:function(){var a=this.originalEvent;this.isPropagationStopped=va,a&&!this.isSimulated&&a.stopPropagation()},stopImmediatePropagation:function(){var a=this.originalEvent;this.isImmediatePropagationStopped=va,a&&!this.isSimulated&&a.stopImmediatePropagation(),this.stopPropagation()}},r.each({altKey:!0,bubbles:!0,cancelable:!0,changedTouches:!0,ctrlKey:!0,detail:!0,eventPhase:!0,metaKey:!0,pageX:!0,pageY:!0,shiftKey:!0,view:!0,"char":!0,charCode:!0,key:!0,keyCode:!0,button:!0,buttons:!0,clientX:!0,clientY:!0,offsetX:!0,offsetY:!0,pointerId:!0,pointerType:!0,screenX:!0,screenY:!0,targetTouches:!0,toElement:!0,touches:!0,which:function(a){var b=a.button;return null==a.which&&sa.test(a.type)?null!=a.charCode?a.charCode:a.keyCode:!a.which&&void 0!==b&&ta.test(a.type)?1&b?1:2&b?3:4&b?2:0:a.which}},r.event.addProp),r.each({mouseenter:"mouseover",mouseleave:"mouseout",pointerenter:"pointerover",pointerleave:"pointerout"},function(a,b){r.event.special[a]={delegateType:b,bindType:b,handle:function(a){var c,d=this,e=a.relatedTarget,f=a.handleObj;return e&&(e===d||r.contains(d,e))||(a.type=f.origType,c=f.handler.apply(this,arguments),a.type=b),c}}}),r.fn.extend({on:function(a,b,c,d){return ya(this,a,b,c,d)},one:function(a,b,c,d){return ya(this,a,b,c,d,1)},off:function(a,b,c){var d,e;if(a&&a.preventDefault&&a.handleObj)return d=a.handleObj,r(a.delegateTarget).off(d.namespace?d.origType+"."+d.namespace:d.origType,d.selector,d.handler),this;if("object"==typeof a){for(e in a)this.off(e,b,a[e]);return this}return b!==!1&&"function"!=typeof b||(c=b,b=void 0),c===!1&&(c=wa),this.each(function(){r.event.remove(this,a,c,b)})}});var za=/<(?!area|br|col|embed|hr|img|input|link|meta|param)(([a-z][^\/\0>\x20\t\r\n\f]*)[^>]*)\/>/gi,Aa=/<script|<style|<link/i,Ba=/checked\s*(?:[^=]|=\s*.checked.)/i,Ca=/^true\/(.*)/,Da=/^\s*<!(?:\[CDATA\[|--)|(?:\]\]|--)>\s*$/g;function Ea(a,b){return B(a,"table")&&B(11!==b.nodeType?b:b.firstChild,"tr")?r(">tbody",a)[0]||a:a}function Fa(a){return a.type=(null!==a.getAttribute("type"))+"/"+a.type,a}function Ga(a){var b=Ca.exec(a.type);return b?a.type=b[1]:a.removeAttribute("type"),a}function Ha(a,b){var c,d,e,f,g,h,i,j;if(1===b.nodeType){if(W.hasData(a)&&(f=W.access(a),g=W.set(b,f),j=f.events)){delete g.handle,g.events={};for(e in j)for(c=0,d=j[e].length;c<d;c++)r.event.add(b,e,j[e][c])}X.hasData(a)&&(h=X.access(a),i=r.extend({},h),X.set(b,i))}}function Ia(a,b){var c=b.nodeName.toLowerCase();"input"===c&&ja.test(a.type)?b.checked=a.checked:"input"!==c&&"textarea"!==c||(b.defaultValue=a.defaultValue)}function Ja(a,b,c,d){b=g.apply([],b);var e,f,h,i,j,k,l=0,m=a.length,n=m-1,q=b[0],s=r.isFunction(q);if(s||m>1&&"string"==typeof q&&!o.checkClone&&Ba.test(q))return a.each(function(e){var f=a.eq(e);s&&(b[0]=q.call(this,e,f.html())),Ja(f,b,c,d)});if(m&&(e=qa(b,a[0].ownerDocument,!1,a,d),f=e.firstChild,1===e.childNodes.length&&(e=f),f||d)){for(h=r.map(na(e,"script"),Fa),i=h.length;l<m;l++)j=e,l!==n&&(j=r.clone(j,!0,!0),i&&r.merge(h,na(j,"script"))),c.call(a[l],j,l);if(i)for(k=h[h.length-1].ownerDocument,r.map(h,Ga),l=0;l<i;l++)j=h[l],la.test(j.type||"")&&!W.access(j,"globalEval")&&r.contains(k,j)&&(j.src?r._evalUrl&&r._evalUrl(j.src):p(j.textContent.replace(Da,""),k))}return a}function Ka(a,b,c){for(var d,e=b?r.filter(b,a):a,f=0;null!=(d=e[f]);f++)c||1!==d.nodeType||r.cleanData(na(d)),d.parentNode&&(c&&r.contains(d.ownerDocument,d)&&oa(na(d,"script")),d.parentNode.removeChild(d));return a}r.extend({htmlPrefilter:function(a){return a.replace(za,"<$1></$2>")},clone:function(a,b,c){var d,e,f,g,h=a.cloneNode(!0),i=r.contains(a.ownerDocument,a);if(!(o.noCloneChecked||1!==a.nodeType&&11!==a.nodeType||r.isXMLDoc(a)))for(g=na(h),f=na(a),d=0,e=f.length;d<e;d++)Ia(f[d],g[d]);if(b)if(c)for(f=f||na(a),g=g||na(h),d=0,e=f.length;d<e;d++)Ha(f[d],g[d]);else Ha(a,h);return g=na(h,"script"),g.length>0&&oa(g,!i&&na(a,"script")),h},cleanData:function(a){for(var b,c,d,e=r.event.special,f=0;void 0!==(c=a[f]);f++)if(U(c)){if(b=c[W.expando]){if(b.events)for(d in b.events)e[d]?r.event.remove(c,d):r.removeEvent(c,d,b.handle);c[W.expando]=void 0}c[X.expando]&&(c[X.expando]=void 0)}}}),r.fn.extend({detach:function(a){return Ka(this,a,!0)},remove:function(a){return Ka(this,a)},text:function(a){return T(this,function(a){return void 0===a?r.text(this):this.empty().each(function(){1!==this.nodeType&&11!==this.nodeType&&9!==this.nodeType||(this.textContent=a)})},null,a,arguments.length)},append:function(){return Ja(this,arguments,function(a){if(1===this.nodeType||11===this.nodeType||9===this.nodeType){var b=Ea(this,a);b.appendChild(a)}})},prepend:function(){return Ja(this,arguments,function(a){if(1===this.nodeType||11===this.nodeType||9===this.nodeType){var b=Ea(this,a);b.insertBefore(a,b.firstChild)}})},before:function(){return Ja(this,arguments,function(a){this.parentNode&&this.parentNode.insertBefore(a,this)})},after:function(){return Ja(this,arguments,function(a){this.parentNode&&this.parentNode.insertBefore(a,this.nextSibling)})},empty:function(){for(var a,b=0;null!=(a=this[b]);b++)1===a.nodeType&&(r.cleanData(na(a,!1)),a.textContent="");return this},clone:function(a,b){return a=null!=a&&a,b=null==b?a:b,this.map(function(){return r.clone(this,a,b)})},html:function(a){return T(this,function(a){var b=this[0]||{},c=0,d=this.length;if(void 0===a&&1===b.nodeType)return b.innerHTML;if("string"==typeof a&&!Aa.test(a)&&!ma[(ka.exec(a)||["",""])[1].toLowerCase()]){a=r.htmlPrefilter(a);try{for(;c<d;c++)b=this[c]||{},1===b.nodeType&&(r.cleanData(na(b,!1)),b.innerHTML=a);b=0}catch(e){}}b&&this.empty().append(a)},null,a,arguments.length)},replaceWith:function(){var a=[];return Ja(this,arguments,function(b){var c=this.parentNode;r.inArray(this,a)<0&&(r.cleanData(na(this)),c&&c.replaceChild(b,this))},a)}}),r.each({appendTo:"append",prependTo:"prepend",insertBefore:"before",insertAfter:"after",replaceAll:"replaceWith"},function(a,b){r.fn[a]=function(a){for(var c,d=[],e=r(a),f=e.length-1,g=0;g<=f;g++)c=g===f?this:this.clone(!0),r(e[g])[b](c),h.apply(d,c.get());return this.pushStack(d)}});var La=/^margin/,Ma=new RegExp("^("+aa+")(?!px)[a-z%]+$","i"),Na=function(b){var c=b.ownerDocument.defaultView;return c&&c.opener||(c=a),c.getComputedStyle(b)};!function(){function b(){if(i){i.style.cssText="box-sizing:border-box;position:relative;display:block;margin:auto;border:1px;padding:1px;top:1%;width:50%",i.innerHTML="",ra.appendChild(h);var b=a.getComputedStyle(i);c="1%"!==b.top,g="2px"===b.marginLeft,e="4px"===b.width,i.style.marginRight="50%",f="4px"===b.marginRight,ra.removeChild(h),i=null}}var c,e,f,g,h=d.createElement("div"),i=d.createElement("div");i.style&&(i.style.backgroundClip="content-box",i.cloneNode(!0).style.backgroundClip="",o.clearCloneStyle="content-box"===i.style.backgroundClip,h.style.cssText="border:0;width:8px;height:0;top:0;left:-9999px;padding:0;margin-top:1px;position:absolute",h.appendChild(i),r.extend(o,{pixelPosition:function(){return b(),c},boxSizingReliable:function(){return b(),e},pixelMarginRight:function(){return b(),f},reliableMarginLeft:function(){return b(),g}}))}();function Oa(a,b,c){var d,e,f,g,h=a.style;return c=c||Na(a),c&&(g=c.getPropertyValue(b)||c[b],""!==g||r.contains(a.ownerDocument,a)||(g=r.style(a,b)),!o.pixelMarginRight()&&Ma.test(g)&&La.test(b)&&(d=h.width,e=h.minWidth,f=h.maxWidth,h.minWidth=h.maxWidth=h.width=g,g=c.width,h.width=d,h.minWidth=e,h.maxWidth=f)),void 0!==g?g+"":g}function Pa(a,b){return{get:function(){return a()?void delete this.get:(this.get=b).apply(this,arguments)}}}var Qa=/^(none|table(?!-c[ea]).+)/,Ra=/^--/,Sa={position:"absolute",visibility:"hidden",display:"block"},Ta={letterSpacing:"0",fontWeight:"400"},Ua=["Webkit","Moz","ms"],Va=d.createElement("div").style;function Wa(a){if(a in Va)return a;var b=a[0].toUpperCase()+a.slice(1),c=Ua.length;while(c--)if(a=Ua[c]+b,a in Va)return a}function Xa(a){var b=r.cssProps[a];return b||(b=r.cssProps[a]=Wa(a)||a),b}function Ya(a,b,c){var d=ba.exec(b);return d?Math.max(0,d[2]-(c||0))+(d[3]||"px"):b}function Za(a,b,c,d,e){var f,g=0;for(f=c===(d?"border":"content")?4:"width"===b?1:0;f<4;f+=2)"margin"===c&&(g+=r.css(a,c+ca[f],!0,e)),d?("content"===c&&(g-=r.css(a,"padding"+ca[f],!0,e)),"margin"!==c&&(g-=r.css(a,"border"+ca[f]+"Width",!0,e))):(g+=r.css(a,"padding"+ca[f],!0,e),"padding"!==c&&(g+=r.css(a,"border"+ca[f]+"Width",!0,e)));return g}function $a(a,b,c){var d,e=Na(a),f=Oa(a,b,e),g="border-box"===r.css(a,"boxSizing",!1,e);return Ma.test(f)?f:(d=g&&(o.boxSizingReliable()||f===a.style[b]),"auto"===f&&(f=a["offset"+b[0].toUpperCase()+b.slice(1)]),f=parseFloat(f)||0,f+Za(a,b,c||(g?"border":"content"),d,e)+"px")}r.extend({cssHooks:{opacity:{get:function(a,b){if(b){var c=Oa(a,"opacity");return""===c?"1":c}}}},cssNumber:{animationIterationCount:!0,columnCount:!0,fillOpacity:!0,flexGrow:!0,flexShrink:!0,fontWeight:!0,lineHeight:!0,opacity:!0,order:!0,orphans:!0,widows:!0,zIndex:!0,zoom:!0},cssProps:{"float":"cssFloat"},style:function(a,b,c,d){if(a&&3!==a.nodeType&&8!==a.nodeType&&a.style){var e,f,g,h=r.camelCase(b),i=Ra.test(b),j=a.style;return i||(b=Xa(h)),g=r.cssHooks[b]||r.cssHooks[h],void 0===c?g&&"get"in g&&void 0!==(e=g.get(a,!1,d))?e:j[b]:(f=typeof c,"string"===f&&(e=ba.exec(c))&&e[1]&&(c=fa(a,b,e),f="number"),null!=c&&c===c&&("number"===f&&(c+=e&&e[3]||(r.cssNumber[h]?"":"px")),o.clearCloneStyle||""!==c||0!==b.indexOf("background")||(j[b]="inherit"),g&&"set"in g&&void 0===(c=g.set(a,c,d))||(i?j.setProperty(b,c):j[b]=c)),void 0)}},css:function(a,b,c,d){var e,f,g,h=r.camelCase(b),i=Ra.test(b);return i||(b=Xa(h)),g=r.cssHooks[b]||r.cssHooks[h],g&&"get"in g&&(e=g.get(a,!0,c)),void 0===e&&(e=Oa(a,b,d)),"normal"===e&&b in Ta&&(e=Ta[b]),""===c||c?(f=parseFloat(e),c===!0||isFinite(f)?f||0:e):e}}),r.each(["height","width"],function(a,b){r.cssHooks[b]={get:function(a,c,d){if(c)return!Qa.test(r.css(a,"display"))||a.getClientRects().length&&a.getBoundingClientRect().width?$a(a,b,d):ea(a,Sa,function(){return $a(a,b,d)})},set:function(a,c,d){var e,f=d&&Na(a),g=d&&Za(a,b,d,"border-box"===r.css(a,"boxSizing",!1,f),f);return g&&(e=ba.exec(c))&&"px"!==(e[3]||"px")&&(a.style[b]=c,c=r.css(a,b)),Ya(a,c,g)}}}),r.cssHooks.marginLeft=Pa(o.reliableMarginLeft,function(a,b){if(b)return(parseFloat(Oa(a,"marginLeft"))||a.getBoundingClientRect().left-ea(a,{marginLeft:0},function(){return a.getBoundingClientRect().left}))+"px"}),r.each({margin:"",padding:"",border:"Width"},function(a,b){r.cssHooks[a+b]={expand:function(c){for(var d=0,e={},f="string"==typeof c?c.split(" "):[c];d<4;d++)e[a+ca[d]+b]=f[d]||f[d-2]||f[0];return e}},La.test(a)||(r.cssHooks[a+b].set=Ya)}),r.fn.extend({css:function(a,b){return T(this,function(a,b,c){var d,e,f={},g=0;if(Array.isArray(b)){for(d=Na(a),e=b.length;g<e;g++)f[b[g]]=r.css(a,b[g],!1,d);return f}return void 0!==c?r.style(a,b,c):r.css(a,b)},a,b,arguments.length>1)}});function _a(a,b,c,d,e){return new _a.prototype.init(a,b,c,d,e)}r.Tween=_a,_a.prototype={constructor:_a,init:function(a,b,c,d,e,f){this.elem=a,this.prop=c,this.easing=e||r.easing._default,this.options=b,this.start=this.now=this.cur(),this.end=d,this.unit=f||(r.cssNumber[c]?"":"px")},cur:function(){var a=_a.propHooks[this.prop];return a&&a.get?a.get(this):_a.propHooks._default.get(this)},run:function(a){var b,c=_a.propHooks[this.prop];return this.options.duration?this.pos=b=r.easing[this.easing](a,this.options.duration*a,0,1,this.options.duration):this.pos=b=a,this.now=(this.end-this.start)*b+this.start,this.options.step&&this.options.step.call(this.elem,this.now,this),c&&c.set?c.set(this):_a.propHooks._default.set(this),this}},_a.prototype.init.prototype=_a.prototype,_a.propHooks={_default:{get:function(a){var b;return 1!==a.elem.nodeType||null!=a.elem[a.prop]&&null==a.elem.style[a.prop]?a.elem[a.prop]:(b=r.css(a.elem,a.prop,""),b&&"auto"!==b?b:0)},set:function(a){r.fx.step[a.prop]?r.fx.step[a.prop](a):1!==a.elem.nodeType||null==a.elem.style[r.cssProps[a.prop]]&&!r.cssHooks[a.prop]?a.elem[a.prop]=a.now:r.style(a.elem,a.prop,a.now+a.unit)}}},_a.propHooks.scrollTop=_a.propHooks.scrollLeft={set:function(a){a.elem.nodeType&&a.elem.parentNode&&(a.elem[a.prop]=a.now)}},r.easing={linear:function(a){return a},swing:function(a){return.5-Math.cos(a*Math.PI)/2},_default:"swing"},r.fx=_a.prototype.init,r.fx.step={};var ab,bb,cb=/^(?:toggle|show|hide)$/,db=/queueHooks$/;function eb(){bb&&(d.hidden===!1&&a.requestAnimationFrame?a.requestAnimationFrame(eb):a.setTimeout(eb,r.fx.interval),r.fx.tick())}function fb(){return a.setTimeout(function(){ab=void 0}),ab=r.now()}function gb(a,b){var c,d=0,e={height:a};for(b=b?1:0;d<4;d+=2-b)c=ca[d],e["margin"+c]=e["padding"+c]=a;return b&&(e.opacity=e.width=a),e}function hb(a,b,c){for(var d,e=(kb.tweeners[b]||[]).concat(kb.tweeners["*"]),f=0,g=e.length;f<g;f++)if(d=e[f].call(c,b,a))return d}function ib(a,b,c){var d,e,f,g,h,i,j,k,l="width"in b||"height"in b,m=this,n={},o=a.style,p=a.nodeType&&da(a),q=W.get(a,"fxshow");c.queue||(g=r._queueHooks(a,"fx"),null==g.unqueued&&(g.unqueued=0,h=g.empty.fire,g.empty.fire=function(){g.unqueued||h()}),g.unqueued++,m.always(function(){m.always(function(){g.unqueued--,r.queue(a,"fx").length||g.empty.fire()})}));for(d in b)if(e=b[d],cb.test(e)){if(delete b[d],f=f||"toggle"===e,e===(p?"hide":"show")){if("show"!==e||!q||void 0===q[d])continue;p=!0}n[d]=q&&q[d]||r.style(a,d)}if(i=!r.isEmptyObject(b),i||!r.isEmptyObject(n)){l&&1===a.nodeType&&(c.overflow=[o.overflow,o.overflowX,o.overflowY],j=q&&q.display,null==j&&(j=W.get(a,"display")),k=r.css(a,"display"),"none"===k&&(j?k=j:(ia([a],!0),j=a.style.display||j,k=r.css(a,"display"),ia([a]))),("inline"===k||"inline-block"===k&&null!=j)&&"none"===r.css(a,"float")&&(i||(m.done(function(){o.display=j}),null==j&&(k=o.display,j="none"===k?"":k)),o.display="inline-block")),c.overflow&&(o.overflow="hidden",m.always(function(){o.overflow=c.overflow[0],o.overflowX=c.overflow[1],o.overflowY=c.overflow[2]})),i=!1;for(d in n)i||(q?"hidden"in q&&(p=q.hidden):q=W.access(a,"fxshow",{display:j}),f&&(q.hidden=!p),p&&ia([a],!0),m.done(function(){p||ia([a]),W.remove(a,"fxshow");for(d in n)r.style(a,d,n[d])})),i=hb(p?q[d]:0,d,m),d in q||(q[d]=i.start,p&&(i.end=i.start,i.start=0))}}function jb(a,b){var c,d,e,f,g;for(c in a)if(d=r.camelCase(c),e=b[d],f=a[c],Array.isArray(f)&&(e=f[1],f=a[c]=f[0]),c!==d&&(a[d]=f,delete a[c]),g=r.cssHooks[d],g&&"expand"in g){f=g.expand(f),delete a[d];for(c in f)c in a||(a[c]=f[c],b[c]=e)}else b[d]=e}function kb(a,b,c){var d,e,f=0,g=kb.prefilters.length,h=r.Deferred().always(function(){delete i.elem}),i=function(){if(e)return!1;for(var b=ab||fb(),c=Math.max(0,j.startTime+j.duration-b),d=c/j.duration||0,f=1-d,g=0,i=j.tweens.length;g<i;g++)j.tweens[g].run(f);return h.notifyWith(a,[j,f,c]),f<1&&i?c:(i||h.notifyWith(a,[j,1,0]),h.resolveWith(a,[j]),!1)},j=h.promise({elem:a,props:r.extend({},b),opts:r.extend(!0,{specialEasing:{},easing:r.easing._default},c),originalProperties:b,originalOptions:c,startTime:ab||fb(),duration:c.duration,tweens:[],createTween:function(b,c){var d=r.Tween(a,j.opts,b,c,j.opts.specialEasing[b]||j.opts.easing);return j.tweens.push(d),d},stop:function(b){var c=0,d=b?j.tweens.length:0;if(e)return this;for(e=!0;c<d;c++)j.tweens[c].run(1);return b?(h.notifyWith(a,[j,1,0]),h.resolveWith(a,[j,b])):h.rejectWith(a,[j,b]),this}}),k=j.props;for(jb(k,j.opts.specialEasing);f<g;f++)if(d=kb.prefilters[f].call(j,a,k,j.opts))return r.isFunction(d.stop)&&(r._queueHooks(j.elem,j.opts.queue).stop=r.proxy(d.stop,d)),d;return r.map(k,hb,j),r.isFunction(j.opts.start)&&j.opts.start.call(a,j),j.progress(j.opts.progress).done(j.opts.done,j.opts.complete).fail(j.opts.fail).always(j.opts.always),r.fx.timer(r.extend(i,{elem:a,anim:j,queue:j.opts.queue})),j}r.Animation=r.extend(kb,{tweeners:{"*":[function(a,b){var c=this.createTween(a,b);return fa(c.elem,a,ba.exec(b),c),c}]},tweener:function(a,b){r.isFunction(a)?(b=a,a=["*"]):a=a.match(L);for(var c,d=0,e=a.length;d<e;d++)c=a[d],kb.tweeners[c]=kb.tweeners[c]||[],kb.tweeners[c].unshift(b)},prefilters:[ib],prefilter:function(a,b){b?kb.prefilters.unshift(a):kb.prefilters.push(a)}}),r.speed=function(a,b,c){var d=a&&"object"==typeof a?r.extend({},a):{complete:c||!c&&b||r.isFunction(a)&&a,duration:a,easing:c&&b||b&&!r.isFunction(b)&&b};return r.fx.off?d.duration=0:"number"!=typeof d.duration&&(d.duration in r.fx.speeds?d.duration=r.fx.speeds[d.duration]:d.duration=r.fx.speeds._default),null!=d.queue&&d.queue!==!0||(d.queue="fx"),d.old=d.complete,d.complete=function(){r.isFunction(d.old)&&d.old.call(this),d.queue&&r.dequeue(this,d.queue)},d},r.fn.extend({fadeTo:function(a,b,c,d){return this.filter(da).css("opacity",0).show().end().animate({opacity:b},a,c,d)},animate:function(a,b,c,d){var e=r.isEmptyObject(a),f=r.speed(b,c,d),g=function(){var b=kb(this,r.extend({},a),f);(e||W.get(this,"finish"))&&b.stop(!0)};return g.finish=g,e||f.queue===!1?this.each(g):this.queue(f.queue,g)},stop:function(a,b,c){var d=function(a){var b=a.stop;delete a.stop,b(c)};return"string"!=typeof a&&(c=b,b=a,a=void 0),b&&a!==!1&&this.queue(a||"fx",[]),this.each(function(){var b=!0,e=null!=a&&a+"queueHooks",f=r.timers,g=W.get(this);if(e)g[e]&&g[e].stop&&d(g[e]);else for(e in g)g[e]&&g[e].stop&&db.test(e)&&d(g[e]);for(e=f.length;e--;)f[e].elem!==this||null!=a&&f[e].queue!==a||(f[e].anim.stop(c),b=!1,f.splice(e,1));!b&&c||r.dequeue(this,a)})},finish:function(a){return a!==!1&&(a=a||"fx"),this.each(function(){var b,c=W.get(this),d=c[a+"queue"],e=c[a+"queueHooks"],f=r.timers,g=d?d.length:0;for(c.finish=!0,r.queue(this,a,[]),e&&e.stop&&e.stop.call(this,!0),b=f.length;b--;)f[b].elem===this&&f[b].queue===a&&(f[b].anim.stop(!0),f.splice(b,1));for(b=0;b<g;b++)d[b]&&d[b].finish&&d[b].finish.call(this);delete c.finish})}}),r.each(["toggle","show","hide"],function(a,b){var c=r.fn[b];r.fn[b]=function(a,d,e){return null==a||"boolean"==typeof a?c.apply(this,arguments):this.animate(gb(b,!0),a,d,e)}}),r.each({slideDown:gb("show"),slideUp:gb("hide"),slideToggle:gb("toggle"),fadeIn:{opacity:"show"},fadeOut:{opacity:"hide"},fadeToggle:{opacity:"toggle"}},function(a,b){r.fn[a]=function(a,c,d){return this.animate(b,a,c,d)}}),r.timers=[],r.fx.tick=function(){var a,b=0,c=r.timers;for(ab=r.now();b<c.length;b++)a=c[b],a()||c[b]!==a||c.splice(b--,1);c.length||r.fx.stop(),ab=void 0},r.fx.timer=function(a){r.timers.push(a),r.fx.start()},r.fx.interval=13,r.fx.start=function(){bb||(bb=!0,eb())},r.fx.stop=function(){bb=null},r.fx.speeds={slow:600,fast:200,_default:400},r.fn.delay=function(b,c){return b=r.fx?r.fx.speeds[b]||b:b,c=c||"fx",this.queue(c,function(c,d){var e=a.setTimeout(c,b);d.stop=function(){a.clearTimeout(e)}})},function(){var a=d.createElement("input"),b=d.createElement("select"),c=b.appendChild(d.createElement("option"));a.type="checkbox",o.checkOn=""!==a.value,o.optSelected=c.selected,a=d.createElement("input"),a.value="t",a.type="radio",o.radioValue="t"===a.value}();var lb,mb=r.expr.attrHandle;r.fn.extend({attr:function(a,b){return T(this,r.attr,a,b,arguments.length>1)},removeAttr:function(a){return this.each(function(){r.removeAttr(this,a)})}}),r.extend({attr:function(a,b,c){var d,e,f=a.nodeType;if(3!==f&&8!==f&&2!==f)return"undefined"==typeof a.getAttribute?r.prop(a,b,c):(1===f&&r.isXMLDoc(a)||(e=r.attrHooks[b.toLowerCase()]||(r.expr.match.bool.test(b)?lb:void 0)),void 0!==c?null===c?void r.removeAttr(a,b):e&&"set"in e&&void 0!==(d=e.set(a,c,b))?d:(a.setAttribute(b,c+""),c):e&&"get"in e&&null!==(d=e.get(a,b))?d:(d=r.find.attr(a,b),
-null==d?void 0:d))},attrHooks:{type:{set:function(a,b){if(!o.radioValue&&"radio"===b&&B(a,"input")){var c=a.value;return a.setAttribute("type",b),c&&(a.value=c),b}}}},removeAttr:function(a,b){var c,d=0,e=b&&b.match(L);if(e&&1===a.nodeType)while(c=e[d++])a.removeAttribute(c)}}),lb={set:function(a,b,c){return b===!1?r.removeAttr(a,c):a.setAttribute(c,c),c}},r.each(r.expr.match.bool.source.match(/\w+/g),function(a,b){var c=mb[b]||r.find.attr;mb[b]=function(a,b,d){var e,f,g=b.toLowerCase();return d||(f=mb[g],mb[g]=e,e=null!=c(a,b,d)?g:null,mb[g]=f),e}});var nb=/^(?:input|select|textarea|button)$/i,ob=/^(?:a|area)$/i;r.fn.extend({prop:function(a,b){return T(this,r.prop,a,b,arguments.length>1)},removeProp:function(a){return this.each(function(){delete this[r.propFix[a]||a]})}}),r.extend({prop:function(a,b,c){var d,e,f=a.nodeType;if(3!==f&&8!==f&&2!==f)return 1===f&&r.isXMLDoc(a)||(b=r.propFix[b]||b,e=r.propHooks[b]),void 0!==c?e&&"set"in e&&void 0!==(d=e.set(a,c,b))?d:a[b]=c:e&&"get"in e&&null!==(d=e.get(a,b))?d:a[b]},propHooks:{tabIndex:{get:function(a){var b=r.find.attr(a,"tabindex");return b?parseInt(b,10):nb.test(a.nodeName)||ob.test(a.nodeName)&&a.href?0:-1}}},propFix:{"for":"htmlFor","class":"className"}}),o.optSelected||(r.propHooks.selected={get:function(a){var b=a.parentNode;return b&&b.parentNode&&b.parentNode.selectedIndex,null},set:function(a){var b=a.parentNode;b&&(b.selectedIndex,b.parentNode&&b.parentNode.selectedIndex)}}),r.each(["tabIndex","readOnly","maxLength","cellSpacing","cellPadding","rowSpan","colSpan","useMap","frameBorder","contentEditable"],function(){r.propFix[this.toLowerCase()]=this});function pb(a){var b=a.match(L)||[];return b.join(" ")}function qb(a){return a.getAttribute&&a.getAttribute("class")||""}r.fn.extend({addClass:function(a){var b,c,d,e,f,g,h,i=0;if(r.isFunction(a))return this.each(function(b){r(this).addClass(a.call(this,b,qb(this)))});if("string"==typeof a&&a){b=a.match(L)||[];while(c=this[i++])if(e=qb(c),d=1===c.nodeType&&" "+pb(e)+" "){g=0;while(f=b[g++])d.indexOf(" "+f+" ")<0&&(d+=f+" ");h=pb(d),e!==h&&c.setAttribute("class",h)}}return this},removeClass:function(a){var b,c,d,e,f,g,h,i=0;if(r.isFunction(a))return this.each(function(b){r(this).removeClass(a.call(this,b,qb(this)))});if(!arguments.length)return this.attr("class","");if("string"==typeof a&&a){b=a.match(L)||[];while(c=this[i++])if(e=qb(c),d=1===c.nodeType&&" "+pb(e)+" "){g=0;while(f=b[g++])while(d.indexOf(" "+f+" ")>-1)d=d.replace(" "+f+" "," ");h=pb(d),e!==h&&c.setAttribute("class",h)}}return this},toggleClass:function(a,b){var c=typeof a;return"boolean"==typeof b&&"string"===c?b?this.addClass(a):this.removeClass(a):r.isFunction(a)?this.each(function(c){r(this).toggleClass(a.call(this,c,qb(this),b),b)}):this.each(function(){var b,d,e,f;if("string"===c){d=0,e=r(this),f=a.match(L)||[];while(b=f[d++])e.hasClass(b)?e.removeClass(b):e.addClass(b)}else void 0!==a&&"boolean"!==c||(b=qb(this),b&&W.set(this,"__className__",b),this.setAttribute&&this.setAttribute("class",b||a===!1?"":W.get(this,"__className__")||""))})},hasClass:function(a){var b,c,d=0;b=" "+a+" ";while(c=this[d++])if(1===c.nodeType&&(" "+pb(qb(c))+" ").indexOf(b)>-1)return!0;return!1}});var rb=/\r/g;r.fn.extend({val:function(a){var b,c,d,e=this[0];{if(arguments.length)return d=r.isFunction(a),this.each(function(c){var e;1===this.nodeType&&(e=d?a.call(this,c,r(this).val()):a,null==e?e="":"number"==typeof e?e+="":Array.isArray(e)&&(e=r.map(e,function(a){return null==a?"":a+""})),b=r.valHooks[this.type]||r.valHooks[this.nodeName.toLowerCase()],b&&"set"in b&&void 0!==b.set(this,e,"value")||(this.value=e))});if(e)return b=r.valHooks[e.type]||r.valHooks[e.nodeName.toLowerCase()],b&&"get"in b&&void 0!==(c=b.get(e,"value"))?c:(c=e.value,"string"==typeof c?c.replace(rb,""):null==c?"":c)}}}),r.extend({valHooks:{option:{get:function(a){var b=r.find.attr(a,"value");return null!=b?b:pb(r.text(a))}},select:{get:function(a){var b,c,d,e=a.options,f=a.selectedIndex,g="select-one"===a.type,h=g?null:[],i=g?f+1:e.length;for(d=f<0?i:g?f:0;d<i;d++)if(c=e[d],(c.selected||d===f)&&!c.disabled&&(!c.parentNode.disabled||!B(c.parentNode,"optgroup"))){if(b=r(c).val(),g)return b;h.push(b)}return h},set:function(a,b){var c,d,e=a.options,f=r.makeArray(b),g=e.length;while(g--)d=e[g],(d.selected=r.inArray(r.valHooks.option.get(d),f)>-1)&&(c=!0);return c||(a.selectedIndex=-1),f}}}}),r.each(["radio","checkbox"],function(){r.valHooks[this]={set:function(a,b){if(Array.isArray(b))return a.checked=r.inArray(r(a).val(),b)>-1}},o.checkOn||(r.valHooks[this].get=function(a){return null===a.getAttribute("value")?"on":a.value})});var sb=/^(?:focusinfocus|focusoutblur)$/;r.extend(r.event,{trigger:function(b,c,e,f){var g,h,i,j,k,m,n,o=[e||d],p=l.call(b,"type")?b.type:b,q=l.call(b,"namespace")?b.namespace.split("."):[];if(h=i=e=e||d,3!==e.nodeType&&8!==e.nodeType&&!sb.test(p+r.event.triggered)&&(p.indexOf(".")>-1&&(q=p.split("."),p=q.shift(),q.sort()),k=p.indexOf(":")<0&&"on"+p,b=b[r.expando]?b:new r.Event(p,"object"==typeof b&&b),b.isTrigger=f?2:3,b.namespace=q.join("."),b.rnamespace=b.namespace?new RegExp("(^|\\.)"+q.join("\\.(?:.*\\.|)")+"(\\.|$)"):null,b.result=void 0,b.target||(b.target=e),c=null==c?[b]:r.makeArray(c,[b]),n=r.event.special[p]||{},f||!n.trigger||n.trigger.apply(e,c)!==!1)){if(!f&&!n.noBubble&&!r.isWindow(e)){for(j=n.delegateType||p,sb.test(j+p)||(h=h.parentNode);h;h=h.parentNode)o.push(h),i=h;i===(e.ownerDocument||d)&&o.push(i.defaultView||i.parentWindow||a)}g=0;while((h=o[g++])&&!b.isPropagationStopped())b.type=g>1?j:n.bindType||p,m=(W.get(h,"events")||{})[b.type]&&W.get(h,"handle"),m&&m.apply(h,c),m=k&&h[k],m&&m.apply&&U(h)&&(b.result=m.apply(h,c),b.result===!1&&b.preventDefault());return b.type=p,f||b.isDefaultPrevented()||n._default&&n._default.apply(o.pop(),c)!==!1||!U(e)||k&&r.isFunction(e[p])&&!r.isWindow(e)&&(i=e[k],i&&(e[k]=null),r.event.triggered=p,e[p](),r.event.triggered=void 0,i&&(e[k]=i)),b.result}},simulate:function(a,b,c){var d=r.extend(new r.Event,c,{type:a,isSimulated:!0});r.event.trigger(d,null,b)}}),r.fn.extend({trigger:function(a,b){return this.each(function(){r.event.trigger(a,b,this)})},triggerHandler:function(a,b){var c=this[0];if(c)return r.event.trigger(a,b,c,!0)}}),r.each("blur focus focusin focusout resize scroll click dblclick mousedown mouseup mousemove mouseover mouseout mouseenter mouseleave change select submit keydown keypress keyup contextmenu".split(" "),function(a,b){r.fn[b]=function(a,c){return arguments.length>0?this.on(b,null,a,c):this.trigger(b)}}),r.fn.extend({hover:function(a,b){return this.mouseenter(a).mouseleave(b||a)}}),o.focusin="onfocusin"in a,o.focusin||r.each({focus:"focusin",blur:"focusout"},function(a,b){var c=function(a){r.event.simulate(b,a.target,r.event.fix(a))};r.event.special[b]={setup:function(){var d=this.ownerDocument||this,e=W.access(d,b);e||d.addEventListener(a,c,!0),W.access(d,b,(e||0)+1)},teardown:function(){var d=this.ownerDocument||this,e=W.access(d,b)-1;e?W.access(d,b,e):(d.removeEventListener(a,c,!0),W.remove(d,b))}}});var tb=a.location,ub=r.now(),vb=/\?/;r.parseXML=function(b){var c;if(!b||"string"!=typeof b)return null;try{c=(new a.DOMParser).parseFromString(b,"text/xml")}catch(d){c=void 0}return c&&!c.getElementsByTagName("parsererror").length||r.error("Invalid XML: "+b),c};var wb=/\[\]$/,xb=/\r?\n/g,yb=/^(?:submit|button|image|reset|file)$/i,zb=/^(?:input|select|textarea|keygen)/i;function Ab(a,b,c,d){var e;if(Array.isArray(b))r.each(b,function(b,e){c||wb.test(a)?d(a,e):Ab(a+"["+("object"==typeof e&&null!=e?b:"")+"]",e,c,d)});else if(c||"object"!==r.type(b))d(a,b);else for(e in b)Ab(a+"["+e+"]",b[e],c,d)}r.param=function(a,b){var c,d=[],e=function(a,b){var c=r.isFunction(b)?b():b;d[d.length]=encodeURIComponent(a)+"="+encodeURIComponent(null==c?"":c)};if(Array.isArray(a)||a.jquery&&!r.isPlainObject(a))r.each(a,function(){e(this.name,this.value)});else for(c in a)Ab(c,a[c],b,e);return d.join("&")},r.fn.extend({serialize:function(){return r.param(this.serializeArray())},serializeArray:function(){return this.map(function(){var a=r.prop(this,"elements");return a?r.makeArray(a):this}).filter(function(){var a=this.type;return this.name&&!r(this).is(":disabled")&&zb.test(this.nodeName)&&!yb.test(a)&&(this.checked||!ja.test(a))}).map(function(a,b){var c=r(this).val();return null==c?null:Array.isArray(c)?r.map(c,function(a){return{name:b.name,value:a.replace(xb,"\r\n")}}):{name:b.name,value:c.replace(xb,"\r\n")}}).get()}});var Bb=/%20/g,Cb=/#.*$/,Db=/([?&])_=[^&]*/,Eb=/^(.*?):[ \t]*([^\r\n]*)$/gm,Fb=/^(?:about|app|app-storage|.+-extension|file|res|widget):$/,Gb=/^(?:GET|HEAD)$/,Hb=/^\/\//,Ib={},Jb={},Kb="*/".concat("*"),Lb=d.createElement("a");Lb.href=tb.href;function Mb(a){return function(b,c){"string"!=typeof b&&(c=b,b="*");var d,e=0,f=b.toLowerCase().match(L)||[];if(r.isFunction(c))while(d=f[e++])"+"===d[0]?(d=d.slice(1)||"*",(a[d]=a[d]||[]).unshift(c)):(a[d]=a[d]||[]).push(c)}}function Nb(a,b,c,d){var e={},f=a===Jb;function g(h){var i;return e[h]=!0,r.each(a[h]||[],function(a,h){var j=h(b,c,d);return"string"!=typeof j||f||e[j]?f?!(i=j):void 0:(b.dataTypes.unshift(j),g(j),!1)}),i}return g(b.dataTypes[0])||!e["*"]&&g("*")}function Ob(a,b){var c,d,e=r.ajaxSettings.flatOptions||{};for(c in b)void 0!==b[c]&&((e[c]?a:d||(d={}))[c]=b[c]);return d&&r.extend(!0,a,d),a}function Pb(a,b,c){var d,e,f,g,h=a.contents,i=a.dataTypes;while("*"===i[0])i.shift(),void 0===d&&(d=a.mimeType||b.getResponseHeader("Content-Type"));if(d)for(e in h)if(h[e]&&h[e].test(d)){i.unshift(e);break}if(i[0]in c)f=i[0];else{for(e in c){if(!i[0]||a.converters[e+" "+i[0]]){f=e;break}g||(g=e)}f=f||g}if(f)return f!==i[0]&&i.unshift(f),c[f]}function Qb(a,b,c,d){var e,f,g,h,i,j={},k=a.dataTypes.slice();if(k[1])for(g in a.converters)j[g.toLowerCase()]=a.converters[g];f=k.shift();while(f)if(a.responseFields[f]&&(c[a.responseFields[f]]=b),!i&&d&&a.dataFilter&&(b=a.dataFilter(b,a.dataType)),i=f,f=k.shift())if("*"===f)f=i;else if("*"!==i&&i!==f){if(g=j[i+" "+f]||j["* "+f],!g)for(e in j)if(h=e.split(" "),h[1]===f&&(g=j[i+" "+h[0]]||j["* "+h[0]])){g===!0?g=j[e]:j[e]!==!0&&(f=h[0],k.unshift(h[1]));break}if(g!==!0)if(g&&a["throws"])b=g(b);else try{b=g(b)}catch(l){return{state:"parsererror",error:g?l:"No conversion from "+i+" to "+f}}}return{state:"success",data:b}}r.extend({active:0,lastModified:{},etag:{},ajaxSettings:{url:tb.href,type:"GET",isLocal:Fb.test(tb.protocol),global:!0,processData:!0,async:!0,contentType:"application/x-www-form-urlencoded; charset=UTF-8",accepts:{"*":Kb,text:"text/plain",html:"text/html",xml:"application/xml, text/xml",json:"application/json, text/javascript"},contents:{xml:/\bxml\b/,html:/\bhtml/,json:/\bjson\b/},responseFields:{xml:"responseXML",text:"responseText",json:"responseJSON"},converters:{"* text":String,"text html":!0,"text json":JSON.parse,"text xml":r.parseXML},flatOptions:{url:!0,context:!0}},ajaxSetup:function(a,b){return b?Ob(Ob(a,r.ajaxSettings),b):Ob(r.ajaxSettings,a)},ajaxPrefilter:Mb(Ib),ajaxTransport:Mb(Jb),ajax:function(b,c){"object"==typeof b&&(c=b,b=void 0),c=c||{};var e,f,g,h,i,j,k,l,m,n,o=r.ajaxSetup({},c),p=o.context||o,q=o.context&&(p.nodeType||p.jquery)?r(p):r.event,s=r.Deferred(),t=r.Callbacks("once memory"),u=o.statusCode||{},v={},w={},x="canceled",y={readyState:0,getResponseHeader:function(a){var b;if(k){if(!h){h={};while(b=Eb.exec(g))h[b[1].toLowerCase()]=b[2]}b=h[a.toLowerCase()]}return null==b?null:b},getAllResponseHeaders:function(){return k?g:null},setRequestHeader:function(a,b){return null==k&&(a=w[a.toLowerCase()]=w[a.toLowerCase()]||a,v[a]=b),this},overrideMimeType:function(a){return null==k&&(o.mimeType=a),this},statusCode:function(a){var b;if(a)if(k)y.always(a[y.status]);else for(b in a)u[b]=[u[b],a[b]];return this},abort:function(a){var b=a||x;return e&&e.abort(b),A(0,b),this}};if(s.promise(y),o.url=((b||o.url||tb.href)+"").replace(Hb,tb.protocol+"//"),o.type=c.method||c.type||o.method||o.type,o.dataTypes=(o.dataType||"*").toLowerCase().match(L)||[""],null==o.crossDomain){j=d.createElement("a");try{j.href=o.url,j.href=j.href,o.crossDomain=Lb.protocol+"//"+Lb.host!=j.protocol+"//"+j.host}catch(z){o.crossDomain=!0}}if(o.data&&o.processData&&"string"!=typeof o.data&&(o.data=r.param(o.data,o.traditional)),Nb(Ib,o,c,y),k)return y;l=r.event&&o.global,l&&0===r.active++&&r.event.trigger("ajaxStart"),o.type=o.type.toUpperCase(),o.hasContent=!Gb.test(o.type),f=o.url.replace(Cb,""),o.hasContent?o.data&&o.processData&&0===(o.contentType||"").indexOf("application/x-www-form-urlencoded")&&(o.data=o.data.replace(Bb,"+")):(n=o.url.slice(f.length),o.data&&(f+=(vb.test(f)?"&":"?")+o.data,delete o.data),o.cache===!1&&(f=f.replace(Db,"$1"),n=(vb.test(f)?"&":"?")+"_="+ub++ +n),o.url=f+n),o.ifModified&&(r.lastModified[f]&&y.setRequestHeader("If-Modified-Since",r.lastModified[f]),r.etag[f]&&y.setRequestHeader("If-None-Match",r.etag[f])),(o.data&&o.hasContent&&o.contentType!==!1||c.contentType)&&y.setRequestHeader("Content-Type",o.contentType),y.setRequestHeader("Accept",o.dataTypes[0]&&o.accepts[o.dataTypes[0]]?o.accepts[o.dataTypes[0]]+("*"!==o.dataTypes[0]?", "+Kb+"; q=0.01":""):o.accepts["*"]);for(m in o.headers)y.setRequestHeader(m,o.headers[m]);if(o.beforeSend&&(o.beforeSend.call(p,y,o)===!1||k))return y.abort();if(x="abort",t.add(o.complete),y.done(o.success),y.fail(o.error),e=Nb(Jb,o,c,y)){if(y.readyState=1,l&&q.trigger("ajaxSend",[y,o]),k)return y;o.async&&o.timeout>0&&(i=a.setTimeout(function(){y.abort("timeout")},o.timeout));try{k=!1,e.send(v,A)}catch(z){if(k)throw z;A(-1,z)}}else A(-1,"No Transport");function A(b,c,d,h){var j,m,n,v,w,x=c;k||(k=!0,i&&a.clearTimeout(i),e=void 0,g=h||"",y.readyState=b>0?4:0,j=b>=200&&b<300||304===b,d&&(v=Pb(o,y,d)),v=Qb(o,v,y,j),j?(o.ifModified&&(w=y.getResponseHeader("Last-Modified"),w&&(r.lastModified[f]=w),w=y.getResponseHeader("etag"),w&&(r.etag[f]=w)),204===b||"HEAD"===o.type?x="nocontent":304===b?x="notmodified":(x=v.state,m=v.data,n=v.error,j=!n)):(n=x,!b&&x||(x="error",b<0&&(b=0))),y.status=b,y.statusText=(c||x)+"",j?s.resolveWith(p,[m,x,y]):s.rejectWith(p,[y,x,n]),y.statusCode(u),u=void 0,l&&q.trigger(j?"ajaxSuccess":"ajaxError",[y,o,j?m:n]),t.fireWith(p,[y,x]),l&&(q.trigger("ajaxComplete",[y,o]),--r.active||r.event.trigger("ajaxStop")))}return y},getJSON:function(a,b,c){return r.get(a,b,c,"json")},getScript:function(a,b){return r.get(a,void 0,b,"script")}}),r.each(["get","post"],function(a,b){r[b]=function(a,c,d,e){return r.isFunction(c)&&(e=e||d,d=c,c=void 0),r.ajax(r.extend({url:a,type:b,dataType:e,data:c,success:d},r.isPlainObject(a)&&a))}}),r._evalUrl=function(a){return r.ajax({url:a,type:"GET",dataType:"script",cache:!0,async:!1,global:!1,"throws":!0})},r.fn.extend({wrapAll:function(a){var b;return this[0]&&(r.isFunction(a)&&(a=a.call(this[0])),b=r(a,this[0].ownerDocument).eq(0).clone(!0),this[0].parentNode&&b.insertBefore(this[0]),b.map(function(){var a=this;while(a.firstElementChild)a=a.firstElementChild;return a}).append(this)),this},wrapInner:function(a){return r.isFunction(a)?this.each(function(b){r(this).wrapInner(a.call(this,b))}):this.each(function(){var b=r(this),c=b.contents();c.length?c.wrapAll(a):b.append(a)})},wrap:function(a){var b=r.isFunction(a);return this.each(function(c){r(this).wrapAll(b?a.call(this,c):a)})},unwrap:function(a){return this.parent(a).not("body").each(function(){r(this).replaceWith(this.childNodes)}),this}}),r.expr.pseudos.hidden=function(a){return!r.expr.pseudos.visible(a)},r.expr.pseudos.visible=function(a){return!!(a.offsetWidth||a.offsetHeight||a.getClientRects().length)},r.ajaxSettings.xhr=function(){try{return new a.XMLHttpRequest}catch(b){}};var Rb={0:200,1223:204},Sb=r.ajaxSettings.xhr();o.cors=!!Sb&&"withCredentials"in Sb,o.ajax=Sb=!!Sb,r.ajaxTransport(function(b){var c,d;if(o.cors||Sb&&!b.crossDomain)return{send:function(e,f){var g,h=b.xhr();if(h.open(b.type,b.url,b.async,b.username,b.password),b.xhrFields)for(g in b.xhrFields)h[g]=b.xhrFields[g];b.mimeType&&h.overrideMimeType&&h.overrideMimeType(b.mimeType),b.crossDomain||e["X-Requested-With"]||(e["X-Requested-With"]="XMLHttpRequest");for(g in e)h.setRequestHeader(g,e[g]);c=function(a){return function(){c&&(c=d=h.onload=h.onerror=h.onabort=h.onreadystatechange=null,"abort"===a?h.abort():"error"===a?"number"!=typeof h.status?f(0,"error"):f(h.status,h.statusText):f(Rb[h.status]||h.status,h.statusText,"text"!==(h.responseType||"text")||"string"!=typeof h.responseText?{binary:h.response}:{text:h.responseText},h.getAllResponseHeaders()))}},h.onload=c(),d=h.onerror=c("error"),void 0!==h.onabort?h.onabort=d:h.onreadystatechange=function(){4===h.readyState&&a.setTimeout(function(){c&&d()})},c=c("abort");try{h.send(b.hasContent&&b.data||null)}catch(i){if(c)throw i}},abort:function(){c&&c()}}}),r.ajaxPrefilter(function(a){a.crossDomain&&(a.contents.script=!1)}),r.ajaxSetup({accepts:{script:"text/javascript, application/javascript, application/ecmascript, application/x-ecmascript"},contents:{script:/\b(?:java|ecma)script\b/},converters:{"text script":function(a){return r.globalEval(a),a}}}),r.ajaxPrefilter("script",function(a){void 0===a.cache&&(a.cache=!1),a.crossDomain&&(a.type="GET")}),r.ajaxTransport("script",function(a){if(a.crossDomain){var b,c;return{send:function(e,f){b=r("<script>").prop({charset:a.scriptCharset,src:a.url}).on("load error",c=function(a){b.remove(),c=null,a&&f("error"===a.type?404:200,a.type)}),d.head.appendChild(b[0])},abort:function(){c&&c()}}}});var Tb=[],Ub=/(=)\?(?=&|$)|\?\?/;r.ajaxSetup({jsonp:"callback",jsonpCallback:function(){var a=Tb.pop()||r.expando+"_"+ub++;return this[a]=!0,a}}),r.ajaxPrefilter("json jsonp",function(b,c,d){var e,f,g,h=b.jsonp!==!1&&(Ub.test(b.url)?"url":"string"==typeof b.data&&0===(b.contentType||"").indexOf("application/x-www-form-urlencoded")&&Ub.test(b.data)&&"data");if(h||"jsonp"===b.dataTypes[0])return e=b.jsonpCallback=r.isFunction(b.jsonpCallback)?b.jsonpCallback():b.jsonpCallback,h?b[h]=b[h].replace(Ub,"$1"+e):b.jsonp!==!1&&(b.url+=(vb.test(b.url)?"&":"?")+b.jsonp+"="+e),b.converters["script json"]=function(){return g||r.error(e+" was not called"),g[0]},b.dataTypes[0]="json",f=a[e],a[e]=function(){g=arguments},d.always(function(){void 0===f?r(a).removeProp(e):a[e]=f,b[e]&&(b.jsonpCallback=c.jsonpCallback,Tb.push(e)),g&&r.isFunction(f)&&f(g[0]),g=f=void 0}),"script"}),o.createHTMLDocument=function(){var a=d.implementation.createHTMLDocument("").body;return a.innerHTML="<form></form><form></form>",2===a.childNodes.length}(),r.parseHTML=function(a,b,c){if("string"!=typeof a)return[];"boolean"==typeof b&&(c=b,b=!1);var e,f,g;return b||(o.createHTMLDocument?(b=d.implementation.createHTMLDocument(""),e=b.createElement("base"),e.href=d.location.href,b.head.appendChild(e)):b=d),f=C.exec(a),g=!c&&[],f?[b.createElement(f[1])]:(f=qa([a],b,g),g&&g.length&&r(g).remove(),r.merge([],f.childNodes))},r.fn.load=function(a,b,c){var d,e,f,g=this,h=a.indexOf(" ");return h>-1&&(d=pb(a.slice(h)),a=a.slice(0,h)),r.isFunction(b)?(c=b,b=void 0):b&&"object"==typeof b&&(e="POST"),g.length>0&&r.ajax({url:a,type:e||"GET",dataType:"html",data:b}).done(function(a){f=arguments,g.html(d?r("<div>").append(r.parseHTML(a)).find(d):a)}).always(c&&function(a,b){g.each(function(){c.apply(this,f||[a.responseText,b,a])})}),this},r.each(["ajaxStart","ajaxStop","ajaxComplete","ajaxError","ajaxSuccess","ajaxSend"],function(a,b){r.fn[b]=function(a){return this.on(b,a)}}),r.expr.pseudos.animated=function(a){return r.grep(r.timers,function(b){return a===b.elem}).length},r.offset={setOffset:function(a,b,c){var d,e,f,g,h,i,j,k=r.css(a,"position"),l=r(a),m={};"static"===k&&(a.style.position="relative"),h=l.offset(),f=r.css(a,"top"),i=r.css(a,"left"),j=("absolute"===k||"fixed"===k)&&(f+i).indexOf("auto")>-1,j?(d=l.position(),g=d.top,e=d.left):(g=parseFloat(f)||0,e=parseFloat(i)||0),r.isFunction(b)&&(b=b.call(a,c,r.extend({},h))),null!=b.top&&(m.top=b.top-h.top+g),null!=b.left&&(m.left=b.left-h.left+e),"using"in b?b.using.call(a,m):l.css(m)}},r.fn.extend({offset:function(a){if(arguments.length)return void 0===a?this:this.each(function(b){r.offset.setOffset(this,a,b)});var b,c,d,e,f=this[0];if(f)return f.getClientRects().length?(d=f.getBoundingClientRect(),b=f.ownerDocument,c=b.documentElement,e=b.defaultView,{top:d.top+e.pageYOffset-c.clientTop,left:d.left+e.pageXOffset-c.clientLeft}):{top:0,left:0}},position:function(){if(this[0]){var a,b,c=this[0],d={top:0,left:0};return"fixed"===r.css(c,"position")?b=c.getBoundingClientRect():(a=this.offsetParent(),b=this.offset(),B(a[0],"html")||(d=a.offset()),d={top:d.top+r.css(a[0],"borderTopWidth",!0),left:d.left+r.css(a[0],"borderLeftWidth",!0)}),{top:b.top-d.top-r.css(c,"marginTop",!0),left:b.left-d.left-r.css(c,"marginLeft",!0)}}},offsetParent:function(){return this.map(function(){var a=this.offsetParent;while(a&&"static"===r.css(a,"position"))a=a.offsetParent;return a||ra})}}),r.each({scrollLeft:"pageXOffset",scrollTop:"pageYOffset"},function(a,b){var c="pageYOffset"===b;r.fn[a]=function(d){return T(this,function(a,d,e){var f;return r.isWindow(a)?f=a:9===a.nodeType&&(f=a.defaultView),void 0===e?f?f[b]:a[d]:void(f?f.scrollTo(c?f.pageXOffset:e,c?e:f.pageYOffset):a[d]=e)},a,d,arguments.length)}}),r.each(["top","left"],function(a,b){r.cssHooks[b]=Pa(o.pixelPosition,function(a,c){if(c)return c=Oa(a,b),Ma.test(c)?r(a).position()[b]+"px":c})}),r.each({Height:"height",Width:"width"},function(a,b){r.each({padding:"inner"+a,content:b,"":"outer"+a},function(c,d){r.fn[d]=function(e,f){var g=arguments.length&&(c||"boolean"!=typeof e),h=c||(e===!0||f===!0?"margin":"border");return T(this,function(b,c,e){var f;return r.isWindow(b)?0===d.indexOf("outer")?b["inner"+a]:b.document.documentElement["client"+a]:9===b.nodeType?(f=b.documentElement,Math.max(b.body["scroll"+a],f["scroll"+a],b.body["offset"+a],f["offset"+a],f["client"+a])):void 0===e?r.css(b,c,h):r.style(b,c,e,h)},b,g?e:void 0,g)}})}),r.fn.extend({bind:function(a,b,c){return this.on(a,null,b,c)},unbind:function(a,b){return this.off(a,null,b)},delegate:function(a,b,c,d){return this.on(b,a,c,d)},undelegate:function(a,b,c){return 1===arguments.length?this.off(a,"**"):this.off(b,a||"**",c)}}),r.holdReady=function(a){a?r.readyWait++:r.ready(!0)},r.isArray=Array.isArray,r.parseJSON=JSON.parse,r.nodeName=B,"function"==typeof define&&define.amd&&define("jquery",[],function(){return r});var Vb=a.jQuery,Wb=a.$;return r.noConflict=function(b){return a.$===r&&(a.$=Wb),b&&a.jQuery===r&&(a.jQuery=Vb),r},b||(a.jQuery=a.$=r),r});
-</script>
-<script type="text/javascript">
-Unicode.UP_TRIANGLE    = '\u25B3';
-Unicode.RIGHT_TRIANGLE = '\u25B7';
-Unicode.DOWN_TRIANGLE  = '\u25BD';
-
-function Unicode() {
-}
-</script>
-<script type="text/javascript">
-function Model() {
-    this.listeners = [];
-}
-
-Model.prototype.addChangeListener = function(listener) {
-    // Check for duplicates.
-    for (var i = 0; i < this.listeners.length; i++) {
-        if (listener == this.listeners[i]) return;
-    }
-
-    this.listeners.push(listener);
-};
-
-Model.prototype.removeChangeListener = function(listener) {
-    var listeners = [];
-    for (var i = 0; i < this.listeners.length; i++) {
-        if (listener != this.listeners[i]) {
-            listeners.push(this.listeners[i]);
-        }
-    }
-    this.listeners = listeners;
-};
-
-Model.prototype.triggerChange = function() {
-    for (var i in this.listeners) {
-        this.listeners[i].onChange(this);
-    }
-};
-</script>
-<script type="text/javascript">
-ResizingCanvas.prototype = new Model();
-ResizingCanvas.prototype.constructor = ResizingCanvas;
-
-function ResizingCanvas(container) {
-    Model.call(this);
-
-    this.container = container;
-    this.canvas    = document.createElement('canvas');
-    container.append($(this.canvas));
-
-    var _this = this;
-    window.setInterval(function() {
-        _this.checkSize();
-    }, 300);
-}
-
-ResizingCanvas.prototype.checkSize = function() {
-    var width  = Math.floor(this.container.width());
-    var height = Math.floor(this.container.height());
-    if (width !== this.canvas.width || height !== this.canvas.height) {
-        this.canvas.width  = width;
-        this.canvas.height = height;
-        this.triggerChange();
-    }
-};
-
-ResizingCanvas.prototype.getCanvas = function() {
-    return this.canvas;
-};
-</script>
-<script type="text/javascript">
-Node.prototype = new Model();
-Node.prototype.constructor = Node;
-
-function Node(prof, selection, sorting, parent, id) {
-    Model.call(this);
-    var _this = this;
-
-    // Set general properties
-    _this.prof      = prof;
-    _this.sorting   = sorting;
-    _this.parent    = parent;
-    _this.id        = id;
-    _this.expanded  = false;
-    _this.selection = selection;
-
-    // Set data
-    var data = prof[id];
-    _this.name     = data[0];
-    _this.module   = data[1];
-    _this.entries  = data[2];
-    _this.time     = data[3];
-    _this.alloc    = data[4];
-    _this.childIds = data[5];
-    _this.children = [];
-
-    if (sorting) sorting.addChangeListener(_this);
-}
-
-Node.prototype.isExpandable = function() {
-    return this.childIds.length > 0;
-};
-
-Node.prototype.toggleExpanded = function() {
-    this.setExpanded(!this.expanded);
-};
-
-Node.prototype.computeChildren = function() {
-    var _this = this;
-
-    if (_this.expanded && _this.children.length <= 0) {
-        _this.children = [];
-        for (var i in _this.childIds) {
-            var childId = _this.childIds[i];
-            _this.children.push(new Node(
-                    _this.prof, _this.selection, _this.sorting,
-                    _this, childId));
-        }
-    } else if (!_this.expanded && _this.children.length > 0) {
-        _this.children = [];
-    }
-
-    _this.children.sort(function(a, b) {
-        return b.getCost() - a.getCost();
-    });
-};
-
-Node.prototype.setExpanded = function(expanded) {
-    var _this = this;
-    if (_this.expanded === expanded) return;
-    _this.expanded = expanded;
-    _this.computeChildren();
-    _this.triggerChange();
-};
-
-Node.prototype.getCanonicalName = function() {
-    return this.name;
-};
-
-Node.prototype.getModuleName = function() {
-    return this.module;
-};
-
-Node.prototype.getFullName = function() {
-    return this.module + '.' + this.name;
-};
-
-Node.prototype.getEntries = function() {
-    return this.entries;
-};
-
-Node.prototype.getColor = function() {
-    var hash = 5381;
-    var str  = this.getFullName();
-    for (var i = 0; i < str.length; i++) {
-        hash = (hash << 5) + hash + str.charCodeAt(i);
-    }
-
-    var h = hash % 360;
-    var s = "100%";
-    var l = "40%";
-    return 'hsl(' + h + ', ' + s + ', ' + l + ')';
-};
-
-Node.prototype.getCost = function() {
-    return this.sorting.getCost(this);
-};
-
-Node.prototype.getTime = function() {
-    return this.time;
-};
-
-Node.prototype.getAlloc = function() {
-    return this.alloc;
-};
-
-Node.prototype.isSelected = function() {
-    return this == this.selection.getSelectedNode();
-};
-
-Node.prototype.select = function() {
-    this.selection.setSelectedNode(this);
-};
-
-Node.prototype.onChange = function(sorting) {
-    this.computeChildren();
-    this.triggerChange();
-};
-</script>
-<script type="text/javascript">
-Selection.prototype = new Model();
-Selection.prototype.constructor = Selection;
-
-function Selection() {
-    Model.call(this);
-
-    this.selectedNode = undefined;
-}
-
-Selection.prototype.getSelectedNode = function() {
-    return this.selectedNode;
-};
-
-Selection.prototype.setSelectedNode = function(node) {
-    if (this.selectedNode == node) return;
-
-    var previousSelectedNode = this.selectedNode;
-    this.selectedNode = node;
-    if (previousSelectedNode) previousSelectedNode.triggerChange();
-    if (node) node.triggerChange();
-    this.triggerChange();
-};
-</script>
-<script type="text/javascript">
-Zoom.prototype = new Model();
-Zoom.prototype.constructor = Zoom;
-
-function Zoom(zoom) {
-    Model.call(this);
-
-    this.zoom = zoom;
-}
-
-Zoom.prototype.setZoom = function(zoom) {
-    if (zoom) {
-        this.zoom = zoom;
-        this.triggerChange();
-    }
-};
-
-Zoom.prototype.getZoom = function() {
-    return this.zoom;
-};
-</script>
-<script type="text/javascript">
-function mk(el) {
-    return $(document.createElement(el));
-}
-
-function Details(container, selection, sorting, zoom) {
-    this.container = container;
-    this.selection = selection;
-    this.sorting   = sorting;
-    this.zoom      = zoom;
-
-    this.mkElement();
-    selection.addChangeListener(this);
-    zoom.addChangeListener(this);
-}
-
-Details.prototype.mkElement = function() {
-    var _this = this;
-
-    var controls = mk('div').addClass('controls');
-
-    var up = mk('button').addClass('up').text(Unicode.UP_TRIANGLE + ' parent');
-    up.prop('title', 'Jump to parent node');
-    controls.append(up);
-
-    var down = mk('button').addClass('down').text(
-            Unicode.DOWN_TRIANGLE + ' zoom');
-    down.prop('title', 'Zoom to this node');
-    controls.append(down);
-
-    var combo = mk('select').addClass('sorting');
-    for (var k in Sorting.methods) {
-        combo.append(mk('option').attr('value', k)
-                .text(Sorting.methods[k].name));
-    }
-    combo.change(function() {
-        _this.sorting.setMethodByKey(combo.val());
-    });
-    controls.append(combo);
-
-    var canonical = mk('h1').addClass('canonical');
-
-    var table = mk('table');
-
-    table.append(mk('tr')
-            .append(mk('td').text('Module'))
-            .append(mk('td').append(mk('code').addClass('module'))));
-
-    table.append(mk('tr')
-            .append(mk('td').text('Entries'))
-            .append(mk('td').addClass('entries')));
-
-    table.append(mk('tr')
-            .append(mk('td').text('Time'))
-            .append(mk('td').addClass('time')));
-
-    table.append(mk('tr')
-            .append(mk('td').text('Alloc'))
-            .append(mk('td').addClass('alloc')));
-
-    table.append(mk('tr').addClass('mainTimeRow')
-            .append(mk('td').text('MAIN Time'))
-            .append(mk('td').addClass('mainTime')));
-
-    table.append(mk('tr').addClass('mainAllocRow')
-            .append(mk('td').text('MAIN Alloc'))
-            .append(mk('td').addClass('mainAlloc')));
-
-    var credits = mk('p').addClass('credits');
-    credits.html('Generated by ' +
-        '<a href="http://github.com/jaspervdj/profiteur" ' +
-        'target="_blank">profiteur</a>.');
-
-    this.container.append(controls);
-    this.container.append(canonical);
-    this.container.append(table);
-    this.container.append(credits);
-};
-
-Details.prototype.render = function(node) {
-    var _this = this;
-
-    this.container.children('.canonical').text(node.getCanonicalName());
-
-    var up = this.container.find('.up');
-    up.off();
-    if (node.parent) {
-        up.prop('dispabled', true);
-        up.click(function () {
-            node.parent.select();
-            if (node == _this.zoom.getZoom()) {
-                _this.zoom.setZoom(node.parent);
-            }
-        });
-    } else {
-        up.prop('dispabled', false);
-    }
-
-    var down = this.container.find('.down');
-    down.off();
-    down.click(function () {
-        _this.zoom.setZoom(node);
-    });
-
-    var mainTime  = node.getTime();
-    var mainAlloc = node.getAlloc();
-    var time      = mainTime;
-    var alloc     = mainAlloc;
-
-    var zoom = _this.zoom.getZoom();
-    if (zoom.parent && zoom.getTime() > 0) {
-        time = time * 100 / zoom.getTime();
-    }
-    if (zoom.parent && zoom.getAlloc() > 0) {
-        alloc = alloc * 100 / zoom.getAlloc();
-    }
-
-    /* The default Number.prototype.toFixed adds 0s and we don't want that. */
-    var precision = 3;
-    function formatNum(value) {
-        var power = Math.pow(10, precision || 0);
-        return String(Math.round(value * power) / power);
-    }
-
-    this.container.find('.module').text(node.getModuleName());
-    this.container.find('.entries').text(node.getEntries());
-    this.container.find('.time').text(formatNum(time));
-    this.container.find('.alloc').text(formatNum(alloc));
-    this.container.find('.mainTime').text(formatNum(mainTime));
-    this.container.find('.mainAlloc').text(formatNum(mainAlloc));
-
-    if (zoom.parent) {
-        this.container.find('.mainTimeRow').show();
-        this.container.find('.mainAllocRow').show();
-    } else {
-        this.container.find('.mainTimeRow').hide();
-        this.container.find('.mainAllocRow').hide();
-    }
-};
-
-Details.prototype.onChange = function() {
-    var node = this.selection.getSelectedNode();
-    if (node) this.render(node);
-};
-</script>
-<script type="text/javascript">
-Sorting.prototype = new Model();
-Sorting.prototype.constructor = Sorting;
-
-Sorting.methods = {
-    'by-time': {
-        name:    'View by time',
-        getCost: function(node) {
-            return node.getTime();
-        }
-    },
-    'by-alloc': {
-        name:    'View by alloc',
-        getCost: function(node) {
-            return node.getAlloc();
-        }
-    }
-};
-
-function Sorting() {
-    Model.call(this);
-
-    this.method = Sorting.methods['by-time'];
-}
-
-Sorting.prototype.setMethodByKey = function(key) {
-    this.setMethod(Sorting.methods[key]);
-};
-
-Sorting.prototype.setMethod = function(method) {
-    this.method = method;
-    this.triggerChange();
-};
-
-Sorting.prototype.getCost = function(node) {
-    return this.method.getCost(node);
-};
-</script>
-<script type="text/javascript">
-TreeMap.HORI = 0;
-TreeMap.VERT = 1;
-
-function TreeMap(resizableCanvas, selection, sorting, zoom) {
-    var _this          = this;
-    this.canvas        = resizableCanvas.getCanvas();
-    this.rects         = {};
-    this.hover         = undefined;
-    this.selection     = selection;
-    this.sorting       = undefined;
-    this.zoom          = zoom;
-    this.renderTimeout = undefined;
-
-    $(this.canvas).mousemove(function(event) {
-        var node = _this.findMouseEventNode(event);
-        if (_this.hover != node) {
-            _this.hover = node;  // Only update when needed
-            if (node) _this.canvas.title = node.getCanonicalName();
-        }
-    });
-
-    $(this.canvas).click(function(event) {
-        var node = _this.findMouseEventNode(event);
-        if (node) {
-            // Select a node on the first click, expand it on second.
-            if (node.isSelected()) {
-                node.setExpanded(true);
-            } else {
-                node.select();
-            }
-        }
-    });
-
-    resizableCanvas.addChangeListener(this);
-    zoom.addChangeListener(this);
-    sorting.addChangeListener(this);
-    this.onChange(zoom);
-}
-
-TreeMap.prototype.mkRect = function(x, y, w, h) {
-    if (x == null || y == null || w == null || h == null) {
-        throw 'foo';
-    }
-
-    return {
-        x: x,
-        y: y,
-        w: w,
-        h: h
-    };
-};
-
-TreeMap.prototype.mkRootRect = function() {
-    return this.mkRect(0, 0, this.canvas.width, this.canvas.height);
-};
-
-TreeMap.prototype.findMouseEventNode = function(event) {
-    var _this  = this;
-    var offset = $(this.canvas).offset();
-    var x      = event.pageX - offset.left;
-    var y      = event.pageY - offset.top;
-
-    function find(node) {
-        for (var i = 0; i < node.children.length; i++) {
-            var r = _this.rects[node.children[i].id];
-            if (r && x >= r.x && x < r.x + r.w &&
-                    y >= r.y && y < r.y + r.h) {
-                return find(node.children[i]);
-            }
-        }
-
-        return node;
-    }
-
-    return node = this.zoom.getZoom() ? find(this.zoom.getZoom()) : undefined;
-};
-
-TreeMap.prototype.layoutChildren = function(node) {
-    var _this = this;
-
-    if (node.children.length > 0 && _this.rects[node.children[0].id]) {
-        return;  // Already layed out.
-    }
-
-    // Sum of areas
-    function sumCosts(nodes) {
-        var sum = 0;
-        for (var i = 0; i < nodes.length; i++) sum += nodes[i].getCost();
-        return sum;
-    }
-
-    // Assume that nodes is not empty. Calculates the worst aspect ratio
-    // when laying out the given nodes along the given side.
-    function worst(nodes, side) {
-        var cost = sumCosts(nodes);
-
-        function aspect(node) {
-            return Math.max(
-                    node.getCost() / cost,
-                    cost / node.getCost());
-        }
-
-        var max = aspect(nodes[0]);
-        for (var i = 1; i < nodes.length; i++) {
-            var a = aspect(nodes[i]);
-            if (a > max) max = a;
-        }
-
-        return max;
-    }
-
-    // Layout nodes after a split in the given direction.
-    function layoutRow(rect, nodes, dir) {
-        var cost = sumCosts(nodes);
-        var x    = rect.x;
-        var y    = rect.y;
-        for (var i = 0; i < nodes.length; i++) {
-            if (dir === TreeMap.HORI) {
-                var w = rect.w;
-                var h = rect.h * nodes[i].getCost() / cost;
-                _this.rects[nodes[i].id] = _this.mkRect(x, y, w, h);
-                y += h;
-            } else {
-                var w = rect.w * nodes[i].getCost() / cost;
-                var h = rect.h;
-                _this.rects[nodes[i].id] = _this.mkRect(x, y, w, h);
-                x += w;
-            }
-        }
-    }
-
-    // Main recursive worker. Nodes should not be empty.
-    function subdivide(rect, nodes, row, side, dir) {
-        var n = nodes[0];
-
-        if (row.length <= 0 ||
-                worst(row, side) >= worst(row.concat([n]), side)) {
-            var remaining = nodes.slice(1);
-            if (remaining.length <= 0) {
-                layoutRow(rect, row.concat([n]), dir);
-            } else {
-                subdivide(rect, remaining, row.concat([n]), side, dir);
-            }
-        } else {
-            var fillCost = sumCosts(row);
-            var nextCost = sumCosts(nodes);
-            var cost     = fillCost + nextCost;
-            var fillRect = undefined;
-            var nextRect = undefined;
-            if (dir === TreeMap.HORI) {
-                var w = rect.w * fillCost / cost;
-                fillRect = _this.mkRect(rect.x, rect.y, w, rect.h);
-                nextRect = _this.mkRect(
-                        rect.x + w, rect.y, rect.w - w, rect.h);
-            } else {
-                var h = rect.h * fillCost / cost;
-                fillRect = _this.mkRect(rect.x, rect.y, rect.w, h);
-                nextRect = _this.mkRect(
-                        rect.x, rect.y + h, rect.w, rect.h - h);
-            }
-
-            layoutRow(fillRect, row, dir);
-            squarify(nextRect, nodes);
-        }
-    }
-
-    // Top-level layouter
-    function squarify(rect, nodes) {
-        var cost = sumCosts(nodes);
-        var dir  = undefined;
-        var side = undefined;
-        if (rect.w > rect.h) {
-            dir  = TreeMap.HORI;
-            side = Math.sqrt(cost * rect.w / rect.h);
-        } else {
-            dir  = TreeMap.VERT;
-            side = Math.sqrt(cost * rect.h / rect.w);
-        }
-
-        subdivide(rect, nodes, [], side, dir);
-    }
-
-    // Go!
-    squarify(_this.rects[node.id], node.children);
-};
-
-TreeMap.prototype.render = function() {
-    var _this   = this;
-    window.clearTimeout(_this.renderTimeout);
-    _this.renderTimeout = window.setTimeout(function() {
-        var context = _this.canvas.getContext('2d');
-
-        // Clear frame
-        context.fillStyle = '#ffffff';
-        context.fillRect(0, 0, _this.canvas.width, _this.canvas.height);
-
-        // Recursively render all nodes
-        _this.renderNode(_this.zoom.getZoom());
-
-        // Render selection
-        var selected = _this.selection.getSelectedNode()
-        if (selected && _this.rects[selected.id]) {
-            var rect = _this.rects[selected.id];
-            context.lineWidth   = 3;
-            context.strokeStyle = '#ffffff';
-            context.strokeRect(rect.x, rect.y, rect.w, rect.h);
-        }
-    }, 50);
-};
-
-TreeMap.prototype.renderNode = function(node) {
-    var _this   = this;
-    var context = this.canvas.getContext('2d');
-    var rect    = this.rects[node.id];
-
-    // The user is not going to see it anyway.
-    if (!rect || rect.w < 2 || rect.h < 2) return;
-
-    // Fill entire area
-    context.fillStyle = node.getColor();
-    context.fillRect(rect.x, rect.y, rect.w, rect.h);
-    context.strokeStyle = 'black';
-    context.strokeRect(rect.x, rect.y, rect.w, rect.h);
-
-    // Draw children on top.
-    if (node.children.length > 0) {
-        _this.layoutChildren(node);
-        for (var i = 0; i < node.children.length; i++) {
-            _this.renderNode(node.children[i]);
-        }
-    }
-};
-
-TreeMap.prototype.onChange = function(source) {
-    var _this = this;
-
-    if (source instanceof ResizingCanvas ||
-            source instanceof Sorting ||
-            source instanceof Zoom) {
-        var node = _this.zoom.getZoom();
-        _this.rects = {};
-        _this.rects[node.id] = _this.mkRootRect();
-        _this.render();
-        node.addChangeListener(this);
-    } else if (source instanceof Node) {
-        _this.render();
-        for (var i = 0; i < source.children.length; i++) {
-            source.children[i].addChangeListener(this);
-        }
-    }
-};
-</script>
-<script type="text/javascript">
-function mk(el) {
-    return $(document.createElement(el));
-}
-
-function TreeBrowser(container, zoom) {
-    this.zoom      = zoom;
-    this.elements  = {};
-    this.container = container;
-
-    zoom.addChangeListener(this);
-    this.onChange(zoom);
-}
-
-TreeBrowser.prototype.mkElement = function(node) {
-    var div = mk('div').addClass('tree-browser node');
-
-    if (node.isExpandable()) {
-        var chevron = mk('span').addClass('tree-browser chevron');
-        chevron.click(function() { node.toggleExpanded(); });
-        div.append(chevron);
-    }
-
-    var code = mk('code').text(node.getCanonicalName());
-    code.addClass('tree-browser name');
-    code.attr('style', 'background-color: ' + node.getColor());
-    code.click(function() { node.select(); });
-    div.append(code);
-
-    var children = mk('div').addClass('tree-browser children');
-    div.append(children);
-
-    return div;
-};
-
-TreeBrowser.prototype.renderNode = function(element, node) {
-    if (node.isExpandable()) {
-        element.children('.chevron').text(
-                node.expanded ? Unicode.DOWN_TRIANGLE : Unicode.RIGHT_TRIANGLE);
-    }
-
-    element.children('.name').toggleClass('selected', node.isSelected());
-
-    var children = element.children('.children');
-    if (node.children.length > 0) {
-        if (children.is(':empty')) {
-            for (var i = 0; i < node.children.length; i++) {
-                var div = this.mkElement(node.children[i]);
-                this.elements[node.children[i].id] = div;
-                this.renderNode(div, node.children[i]);
-                children.append(div);
-            }
-        } else {
-            children.children().detach();
-            for (var i = 0; i < node.children.length; i++) {
-                var div = this.elements[node.children[i].id];
-                children.append(div);
-            }
-        }
-    }
-
-    if (node.children.length <= 0 && !children.is(':empty')) {
-        children.empty();
-    }
-};
-
-TreeBrowser.prototype.scrollToNode = function(node) {
-    var element  = this.elements[node.id];
-    var position = element.position();
-    var top      = this.container.scrollTop();
-    var left     = this.container.scrollLeft();
-    var height   = this.container.height();
-    var width    = this.container.width();
-
-    if (position.top < 0 || position.top >= height ||
-            position.left < 0 || position.left >= width) {
-        this.container.scrollTop(top + position.top - height / 2);
-        this.container.scrollLeft(left + position.left);
-    }
-};
-
-TreeBrowser.prototype.onChange = function(source) {
-    var _this   = this;
-    if (source instanceof Zoom) {
-        var node = _this.zoom.getZoom();
-        _this.container.empty();
-        _this.elements = [];
-        _this.elements[node.id] = _this.mkElement(node);
-        _this.container.append(_this.elements[node.id]);
-        _this.renderNode(_this.elements[node.id], node);
-        node.addChangeListener(_this);
-    } else if (source instanceof Node) {
-        var element = _this.elements[source.id];
-
-        if (!element) return;  // Invisible source changed what?
-
-        _this.renderNode(element, source);
-        for (var i = 0; i < source.children.length; i++) {
-            source.children[i].addChangeListener(_this);
-        }
-
-        if (source.isSelected()) _this.scrollToNode(source);
-    }
-}
-</script>
-<script type="text/javascript">
-////////////////////////////////////////////////////////////////////////////////
-// Hooking up
-////////////////////////////////////////////////////////////////////////////////
-
-function main() {
-    var selection = new Selection();
-    var sorting = new Sorting();
-    var root = new Node($prof[0], selection, sorting, undefined, $prof[1]);
-
-    var zoom = new Zoom(root);
-    var tb = new TreeBrowser($('#tree'), zoom);
-    var rc = new ResizingCanvas($('#map'));
-    var tm = new TreeMap(rc, selection, sorting, zoom);
-    var details = new Details($('#details'), selection, sorting, zoom);
-    selection.setSelectedNode(root);
-}
-
-$(document).ready(function () {
-    // alert('Hello wooorld');
-    main();
-});
-</script>
-  </head>
-  <body>
-<div id="details-tree">
-    <div id="details"></div>
-    <div id="tree"></div>
-</div>
-
-<div id="map"></div>
-
-  </body></html>

From 29d9f901ff1a823e78432b807abd85b7bbba2322 Mon Sep 17 00:00:00 2001
From: Tom Sydney Kerckhove <syd@fpcomplete.com>
Date: Wed, 15 Aug 2018 12:38:19 +0200
Subject: [PATCH 18/69] Deleted a rogue comment

---
 Data/HashMap/Strict/Base.hs | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/Data/HashMap/Strict/Base.hs b/Data/HashMap/Strict/Base.hs
index 37dad0c0..f15597a5 100644
--- a/Data/HashMap/Strict/Base.hs
+++ b/Data/HashMap/Strict/Base.hs
@@ -423,7 +423,7 @@ unionWithKey f = go 0 s0
     go bs s t1@(Collision h1 hm1) t2@(Leaf h2 l2@(L k2 _))
         | h1 == h2  = Collision h1 $ go 0 (nextSalt s) hm1 (Leaf (hashWithSalt (nextSalt s) k2) l2)
         | otherwise = goDifferentHash bs s h1 h2 t1 t2
-    go bs s t1@(Collision h1 hm1) t2@(Collision h2 hm2) -- Second salt must be equal
+    go bs s t1@(Collision h1 hm1) t2@(Collision h2 hm2)
         | h1 == h2  = Collision h1 $ go 0 (nextSalt s) hm1 hm2
         | otherwise = goDifferentHash bs s h1 h2 t1 t2
     -- branch vs. branch

From 42dc26f763521c3b8329e0c9b7e7fa2fb27c0781 Mon Sep 17 00:00:00 2001
From: Tom Sydney Kerckhove <syd@fpcomplete.com>
Date: Tue, 21 Aug 2018 12:28:00 +0200
Subject: [PATCH 19/69] little comment

---
 Data/HashMap/Base.hs | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/Data/HashMap/Base.hs b/Data/HashMap/Base.hs
index f231f664..4073e16c 100644
--- a/Data/HashMap/Base.hs
+++ b/Data/HashMap/Base.hs
@@ -183,7 +183,7 @@ data HashMap k v
     | BitmapIndexed !Bitmap !(A.Array (HashMap k v))
     | Leaf !Hash !(Leaf k v)
     | Full !(A.Array (HashMap k v))
-    | Collision !Hash !(HashMap k v)
+    | Collision !Hash !(HashMap k v) -- Only necessary to simplify the code
       deriving (Typeable)
 
 type role HashMap nominal representational

From b46bbb010414a7b947d8bf666826cb4009b3db7a Mon Sep 17 00:00:00 2001
From: Tom Sydney Kerckhove <syd@fpcomplete.com>
Date: Fri, 12 Oct 2018 12:21:55 +0200
Subject: [PATCH 20/69] different hash

---
 Data/HashMap/Base.hs | 6 ++++--
 1 file changed, 4 insertions(+), 2 deletions(-)

diff --git a/Data/HashMap/Base.hs b/Data/HashMap/Base.hs
index 4073e16c..3947d13d 100644
--- a/Data/HashMap/Base.hs
+++ b/Data/HashMap/Base.hs
@@ -636,11 +636,13 @@ collision h0 s0 !(L k1 v1) !(L k2 v2) = go h0 s0
       in Collision h hm
 {-# INLINE collision #-}
 
+-- These are taken from wikipedia:
+-- https://en.wikipedia.org/wiki/Fowler%E2%80%93Noll%E2%80%93Vo_hash_function#FNV_hash_parameters
 defaultSalt :: Int
 #if WORD_SIZE_IN_BITS == 64
-defaultSalt = -2578643520546668380  -- 0xdc36d1615b7400a4
+defaultSalt = 14695981039346656037 -- 0xcbf29ce484222325 in hex
 #else
-defaultSalt = 0x087fc72c
+defaultSalt = 2166136261 -- 0x811c9dc5 in hex
 #endif
 
 nextSalt :: Salt -> Salt

From b883ecb0b5b1b058082a719894b3428c7d3efcc9 Mon Sep 17 00:00:00 2001
From: Tom Sydney Kerckhove <syd@fpcomplete.com>
Date: Fri, 12 Oct 2018 13:57:39 +0200
Subject: [PATCH 21/69] Something that compiles

---
 Data/HashMap/Base.hs        | 227 +++++++++++++++++++++++-------------
 Data/HashMap/Strict/Base.hs |  61 +++++++---
 2 files changed, 188 insertions(+), 100 deletions(-)

diff --git a/Data/HashMap/Base.hs b/Data/HashMap/Base.hs
index 3947d13d..63a3bba1 100644
--- a/Data/HashMap/Base.hs
+++ b/Data/HashMap/Base.hs
@@ -183,17 +183,17 @@ data HashMap k v
     | BitmapIndexed !Bitmap !(A.Array (HashMap k v))
     | Leaf !Hash !(Leaf k v)
     | Full !(A.Array (HashMap k v))
-    | Collision !Hash !(HashMap k v) -- Only necessary to simplify the code
+    | Collision !Hash !(Leaf k v) !(Leaf k v) !(HashMap k v)
       deriving (Typeable)
 
 type role HashMap nominal representational
 
 instance (NFData k, NFData v) => NFData (HashMap k v) where
-    rnf Empty                 = ()
-    rnf (BitmapIndexed _ ary) = rnf ary
-    rnf (Leaf _ l)            = rnf l
-    rnf (Full ary)            = rnf ary
-    rnf (Collision _ ary)     = rnf ary
+    rnf Empty                   = ()
+    rnf (BitmapIndexed _ ary)   = rnf ary
+    rnf (Leaf _ l)              = rnf l
+    rnf (Full ary)              = rnf ary
+    rnf (Collision _ l1 l2 ary) = rnf l1 `seq` rnf l2 `seq` rnf ary
 
 instance Functor (HashMap k) where
     fmap = map
@@ -296,8 +296,8 @@ equal1 eq = go
       = bm1 == bm2 && A.sameArray1 go ary1 ary2
     go (Leaf h1 l1) (Leaf h2 l2) = h1 == h2 && leafEq l1 l2
     go (Full ary1) (Full ary2) = A.sameArray1 go ary1 ary2
-    go (Collision h1 hm1) (Collision h2 hm2)
-      = h1 == h2 && go hm1 hm2
+    go (Collision h1 l11 l12 hm1) (Collision h2 l21 l22 hm2)
+      = h1 == h2 && l11 `leafEq` l21 && l12 `leafEq` l22 && go hm1 hm2
     go _ _ = False
 
     leafEq (L k1 v1) (L k2 v2) = k1 == k2 && eq v1 v2
@@ -314,8 +314,10 @@ equal2 eqk eqv t1 t2 = go (toList' t1 []) (toList' t2 [])
       | k1 == k2 &&
         leafEq l1 l2
       = go tl1 tl2
-    go (Collision h1 hm1 : tl1) (Collision h2 hm2 : tl2)
+    go (Collision h1 l11 l12 hm1 : tl1) (Collision h2 l21 l22 hm2 : tl2)
       | h1 == h2 &&
+        leafEq l11 l21 &&
+        leafEq l12 l22 &&
         go (toList' hm1 []) (toList' hm2 [])
       = go tl1 tl2
     go [] [] = True
@@ -347,12 +349,14 @@ cmp cmpk cmpv t1 t2 = go (toList' t1 []) (toList' t2 [])
       = compare k1 k2 `mappend`
         leafCompare l1 l2 `mappend`
         go tl1 tl2
-    go (Collision h1 hm1 : tl1) (Collision h2 hm2 : tl2)
+    go (Collision h1 l11 l12 hm1 : tl1) (Collision h2 l21 l22 hm2 : tl2)
       = compare h1 h2 `mappend`
+        leafCompare l11 l21 `mappend`
+        leafCompare l12 l22 `mappend`
         go (toList' hm1 []) (toList' hm2 []) `mappend`
         go tl1 tl2
-    go (Leaf _ _ : _) (Collision _ _ : _) = LT
-    go (Collision _ _ : _) (Leaf _ _ : _) = GT
+    go (Leaf _ _ : _) (Collision _ _ _ _ : _) = LT
+    go (Collision _ _ _ _ : _) (Leaf _ _ : _) = GT
     go [] [] = EQ
     go [] _  = LT
     go _  [] = GT
@@ -367,8 +371,10 @@ equalKeys1 eq t1 t2 = go (toList' t1 []) (toList' t2 [])
     go (Leaf k1 l1 : tl1) (Leaf k2 l2 : tl2)
       | k1 == k2 && leafEq l1 l2
       = go tl1 tl2
-    go (Collision h1 hm1 : tl1) (Collision h2 hm2 : tl2)
+    go (Collision h1 l11 l12 hm1 : tl1) (Collision h2 l21 l22 hm2 : tl2)
       | h1 == h2 &&
+        leafEq l11 l21 &&
+        leafEq l12 l22 &&
         go (toList' hm1 []) (toList' hm2 [])
       = go tl1 tl2
     go [] [] = True
@@ -386,8 +392,11 @@ equalKeys = go
       = bm1 == bm2 && A.sameArray1 go ary1 ary2
     go (Leaf h1 l1) (Leaf h2 l2) = h1 == h2 && leafEq l1 l2
     go (Full ary1) (Full ary2) = A.sameArray1 go ary1 ary2
-    go (Collision h1 hm1) (Collision h2 hm2)
-      = h1 == h2 && go hm1 hm2
+    go (Collision h1 l11 l12 hm1) (Collision h2 l21 l22 hm2)
+      = h1 == h2 &&
+        leafEq l11 l21 &&
+        leafEq l12 l22 &&
+        go hm1 hm2
     go _ _ = False
 
     leafEq (L k1 _) (L k2 _) = k1 == k2
@@ -402,8 +411,9 @@ instance H.Hashable2 HashMap where
           = s `hashLeafWithSalt` l `go` tl
         -- For collisions we hashmix hash value
         -- and then array of values' hashes sorted
-        go s (Collision h hm' : tl)
-          = ((s `H.hashWithSalt` h) `go` (toList' hm' [])) `go` tl
+        go s (Collision h l1 l2 hm' : tl)
+          = (((s `H.hashWithSalt` h) `hashLeafWithSalt` l1 `hashLeafWithSalt` l2)
+             `go` (toList' hm' [])) `go` tl
         go s (_ : tl) = s `go` tl
 
         -- hashLeafWithSalt :: Int -> Leaf k v -> Int
@@ -422,8 +432,9 @@ instance (Hashable k, Hashable v) => Hashable (HashMap k v) where
           = s `hashLeafWithSalt` l `go` tl
         -- For collisions we hashmix hash value
         -- and then array of values' hashes sorted
-        go s (Collision h hm' : tl)
-          = ((s `H.hashWithSalt` h) `go` (toList' hm' [])) `go` tl
+        go s (Collision h l1 l2 hm' : tl)
+          = (((s `H.hashWithSalt` h) `hashLeafWithSalt` l1 `hashLeafWithSalt` l2)
+             `go` (toList' hm' [])) `go` tl
         go s (_ : tl) = s `go` tl
 
         hashLeafWithSalt :: Int -> Leaf k v -> Int
@@ -431,17 +442,17 @@ instance (Hashable k, Hashable v) => Hashable (HashMap k v) where
 
   -- Helper to get 'Leaf's as a list.
 toList' :: HashMap k v -> [HashMap k v] -> [HashMap k v]
-toList' (BitmapIndexed _ ary) a = A.foldr toList' a ary
-toList' (Full ary)            a = A.foldr toList' a ary
-toList' l@(Leaf _ _)          a = l : a
-toList' (Collision _ hm)    a = toList' hm a
-toList' Empty                 a = a
+toList' (BitmapIndexed _ ary)   a = A.foldr toList' a ary
+toList' (Full ary)              a = A.foldr toList' a ary
+toList' l@(Leaf _ _)            a = l : a
+toList' (Collision h l1 l2 hm)  a = (Leaf h l1) : (Leaf h l2) : toList' hm a
+toList' Empty                   a = a
 
 -- Helper function to detect 'Leaf's and 'Collision's.
 isLeafOrCollision :: HashMap k v -> Bool
-isLeafOrCollision (Leaf _ _)        = True
-isLeafOrCollision (Collision _ _) = True
-isLeafOrCollision _                 = False
+isLeafOrCollision (Leaf _ _)          = True
+isLeafOrCollision (Collision _ _ _ _) = True
+isLeafOrCollision _                   = False
 
 ------------------------------------------------------------------------
 -- * Construction
@@ -470,7 +481,7 @@ size t = go t 0
     go (Leaf _ _)            n = n + 1
     go (BitmapIndexed _ ary) n = A.foldl' (flip go) n ary
     go (Full ary)            n = A.foldl' (flip go) n ary
-    go (Collision _ hm)      n = go hm n
+    go (Collision _ _ _ hm)  n = go hm n + 2
 
 -- | /O(log n)/ Return 'True' if the specified key is present in the
 -- map, 'False' otherwise.
@@ -596,8 +607,11 @@ lookupCont absent present !h0 !s0 !k0 !m0 = go h0 s0 k0 0 m0
       where m = mask h bs
     go h s k bs (Full v) =
       go h s k (bs+bitsPerSubkey) (A.index v (index h bs))
-    go h s k _ (Collision hx hmx)
-        | h == hx   = go (hashWithSalt (nextSalt s) k) (nextSalt s) k 0 hmx
+    go h s k _ (Collision hx (L k1 v1) (L k2 v2) hmx)
+        | h == hx   = case () of
+          ()    | k == k1   -> present v1 (-1)
+                | k == k2   -> present v2 (-1)
+                | otherwise -> go (hashWithSalt (nextSalt s) k) (nextSalt s) k 0 hmx
         | otherwise = absent (# #)
 {-# INLINE lookupCont #-}
 
@@ -623,17 +637,7 @@ infixl 9 !
 
 -- | Create a 'Collision' value with two 'Leaf' values.
 collision :: (Eq k, Hashable k) => Hash -> Salt -> Leaf k v -> Leaf k v -> HashMap k v
-collision h0 s0 !(L k1 v1) !(L k2 v2) = go h0 s0
-  where
-    go h s =
-      let s' = nextSalt s
-          rehash = hashWithSalt s'
-          h1 = rehash k1
-          h2 = rehash k2
-          hm = if h1 == h2
-            then go h1 s'
-            else runST $ two 0 h1 k1 v1 h2 k2 v2
-      in Collision h hm
+collision h _ l1 l2 = Collision h l1 l2 Empty
 {-# INLINE collision #-}
 
 -- These are taken from wikipedia:
@@ -693,8 +697,13 @@ insert' h0 s0 k0 v0 m0 = go h0 s0 k0 v0 0 m0
             then t
             else Full (update16 ary i st')
       where i = index h bs
-    go h s k x bs t@(Collision hx hmx)
-        | h == hx   = Collision hx $ go (hashWithSalt (nextSalt s) k) (nextSalt s) k x 0 hmx
+    go h s k x bs t@(Collision hx l1@(L k1 v1) l2@(L k2 v2) hmx)
+        | h == hx   =
+          let go'
+                | k == k1   = if x `ptrEq` v1 then t else Collision hx (L k x) l2 hmx
+                | k == k2   = if x `ptrEq` v2 then t else Collision hx l1 (L k x) hmx
+                | otherwise = Collision hx l1 l2 $ go (hashWithSalt (nextSalt s) k) (nextSalt s) k x 0 hmx
+          in go'
         | otherwise = go h s k x bs $ BitmapIndexed (mask hx bs) (A.singleton t)
 {-# INLINABLE insert' #-}
 
@@ -727,8 +736,8 @@ insertNewKey !h0 !s0 !k0 x0 !m0 = go h0 s0 k0 x0 0 m0
             !st' = go h s k x (bs+bitsPerSubkey) st
         in Full (update16 ary i st')
       where i = index h bs
-    go h s k x bs t@(Collision hx hmx)
-        | h == hx   = Collision hx $ go (hashWithSalt (nextSalt s) k) (nextSalt s) k x 0 hmx
+    go h s k x bs t@(Collision hx l1 l2 hmx)
+        | h == hx   = Collision hx l1 l2 $ go (hashWithSalt (nextSalt s) k) (nextSalt s) k x 0 hmx
         | otherwise =
             go h s k x bs $ BitmapIndexed (mask hx bs) (A.singleton t)
 {-# NOINLINE insertNewKey #-}
@@ -737,8 +746,8 @@ insertNewKey !h0 !s0 !k0 x0 !m0 = go h0 s0 k0 x0 0 m0
 -- Insert optimized for the case when we know the key is in the map.
 --
 -- We can skip the key equality check on a Leaf because we know the leaf must be
--- for this key.
-insertKeyExists :: (Hashable k) => Hash -> Salt -> k -> v -> HashMap k v -> HashMap k v
+-- for this key. We still need to do the equality check in case of collisions.
+insertKeyExists :: (Eq k, Hashable k) => Hash -> Salt -> k -> v -> HashMap k v -> HashMap k v
 insertKeyExists !h0 !s0 !k0 x0 !m0 = go h0 s0 k0 x0 0 m0
   where
     go !h _ !k x !_s (Leaf _hy _kx)
@@ -758,8 +767,13 @@ insertKeyExists !h0 !s0 !k0 x0 !m0 = go h0 s0 k0 x0 0 m0
             !st' = go h s k x (bs+bitsPerSubkey) st
         in Full (update16 ary i st')
       where i = index h bs
-    go h s k x bs t@(Collision hx hmx)
-        | h == hx   = Collision hx $ go (hashWithSalt (nextSalt s) k) (nextSalt s) k x 0 hmx
+    go h s k x bs t@(Collision hx l1@(L k1 v1) l2@(L k2 v2) hmx)
+        | h == hx   =
+          let go'
+                | k == k1   = if x `ptrEq` v1 then t else Collision hx (L k x) l2 hmx
+                | k == k2   = if x `ptrEq` v2 then t else Collision hx l1 (L k x) hmx
+                | otherwise = Collision hx l1 l2 $ go (hashWithSalt (nextSalt s) k) (nextSalt s) k x 0 hmx
+          in go'
         | otherwise =
             go h s k x bs $ BitmapIndexed (mask hx bs) (A.singleton t)
     go _ _ _ _ _ Empty = Empty -- error "Internal error: go Empty"
@@ -797,8 +811,13 @@ unsafeInsert k0 v0 m0 = runST (go h0 s0 k0 v0 0 m0)
         A.unsafeUpdateM ary i st'
         return t
       where i = index h bs
-    go h s k x bs t@(Collision hx hmx)
-        | h == hx   = Collision hx <$> go (hashWithSalt (nextSalt s) k) (nextSalt s) k x 0 hmx
+    go h s k x bs t@(Collision hx l1@(L k1 v1) l2@(L k2 v2) hmx)
+        | h == hx   =
+          let go'
+                | k == k1   = return $! if x `ptrEq` v1 then t else Collision hx (L k x) l2 hmx
+                | k == k2   = return $! if x `ptrEq` v2 then t else Collision hx l1 (L k x) hmx
+                | otherwise = Collision hx l1 l2 <$> go (hashWithSalt (nextSalt s) k) (nextSalt s) k x 0 hmx
+          in go'
         | otherwise = go h s k x bs $ BitmapIndexed (mask hx bs) (A.singleton t)
 {-# INLINABLE unsafeInsert #-}
 
@@ -877,9 +896,19 @@ insertModifying x f k0 m0 = go h0 s0 k0 0 m0
            then t
            else Full ary'
       where i = index h bs
-    go h s k bs t@(Collision hx hmx)
+    go h s k bs t@(Collision hx l1@(L k1 v1) l2@(L k2 v2) hmx)
         | h == hx   =
-            Collision hx $ go (hashWithSalt (nextSalt s) k) (nextSalt s) k 0 hmx
+           let go'
+                 | k == k1   =
+                    case f v1 of
+                      (# v' #) | ptrEq v1 v' -> t
+                               | otherwise -> Collision hx (L k v') l2 hmx
+                 | k == k2   =
+                    case f v2 of
+                      (# v' #) | ptrEq v2 v' -> t
+                               | otherwise -> Collision hx l1 (L k v') hmx
+                 | otherwise = Collision hx l1 l2 $ go (hashWithSalt (nextSalt s) k) (nextSalt s) k 0 hmx
+           in go'
         | otherwise = go h s k bs $ BitmapIndexed (mask hx bs) (A.singleton t)
 {-# INLINABLE insertModifying #-}
 
@@ -915,8 +944,13 @@ unsafeInsertWith f k0 v0 m0 = runST (go h0 s0 k0 v0 0 m0)
         A.unsafeUpdateM ary i st'
         return t
       where i = index h bs
-    go h s k x bs t@(Collision hx hmx)
-        | h == hx   = Collision hx <$> go (hashWithSalt (nextSalt s) k) (nextSalt s) k x 0 hmx
+    go h s k x bs t@(Collision hx l1@(L k1 v1) l2@(L k2 v2) hmx)
+        | h == hx   =
+          let go'
+                | k == k1   = return $! Collision hx (L k (f x v1)) l2 hmx
+                | k == k2   = return $! Collision hx l1 (L k (f x v2)) hmx
+                | otherwise = Collision hx l1 l2 <$> go (hashWithSalt (nextSalt s) k) (nextSalt s) k x 0 hmx
+          in go'
         | otherwise = go h s k x bs $ BitmapIndexed (mask hx bs) (A.singleton t)
 {-# INLINABLE unsafeInsertWith #-}
 
@@ -966,8 +1000,13 @@ delete' h0 s0 k0 m0 = go h0 s0 k0 0 m0
                 in BitmapIndexed bm ary'
             _ -> Full (A.update ary i st')
       where i = index h bs
-    go h s k _ t@(Collision hx hmx)
-        | h == hx = Collision hx $ go (hashWithSalt (nextSalt s) k) (nextSalt s) k 0 hmx
+    go h s k _ t@(Collision hx l1@(L k1 v1) l2@(L k2 v2) hmx)
+        | h == hx =
+          let go'
+                | k == k1 = undefined
+                | k == k2 = undefined
+                | otherwise = Collision hx l1 l2 $ go (hashWithSalt (nextSalt s) k) (nextSalt s) k 0 hmx
+          in go'
         | otherwise = t
 {-# INLINABLE delete' #-}
 
@@ -975,10 +1014,12 @@ delete' h0 s0 k0 m0 = go h0 s0 k0 0 m0
 --
 -- We can skip:
 --  - the key equality check on the leaf, if we reach a leaf it must be the key
-deleteKeyExists :: Hashable k => Hash -> Salt -> k -> HashMap k v -> HashMap k v
+--
+-- We still need to do the equality check for collisions.
+deleteKeyExists :: (Eq k, Hashable k) => Hash -> Salt -> k -> HashMap k v -> HashMap k v
 deleteKeyExists !h0 s0 !k0 !m0 = go h0 s0 k0 0 m0
   where
-    go :: Hashable k => Hash -> Salt -> k -> Int -> HashMap k v -> HashMap k v
+    go :: (Eq k, Hashable k) => Hash -> Salt -> k -> Int -> HashMap k v -> HashMap k v
     go !_h !_s !_k !_bs (Leaf _ _) = Empty
     go h s k bs (BitmapIndexed b ary) =
             let !st = A.index ary i
@@ -1007,8 +1048,13 @@ deleteKeyExists !h0 s0 !k0 !m0 = go h0 s0 k0 0 m0
                 in BitmapIndexed bm ary'
             _ -> Full (A.update ary i st')
       where i = index h bs
-    go h s k _ (Collision hx hmx)
-        | h == hx = Collision hx $ go (hashWithSalt (nextSalt s) k) (nextSalt s) k 0 hmx
+    go h s k _ (Collision hx l1@(L k1 v1) l2@(L k2 v2) hmx)
+        | h == hx =
+          let go'
+                | k == k1 = undefined
+                | k == k2 = undefined
+                | otherwise = Collision hx l1 l2 $ go (hashWithSalt (nextSalt s) k) (nextSalt s) k 0 hmx
+          in go'
         | otherwise = Empty -- error "Internal error: unexpected collision"
     go !_ !_ !_ !_ Empty = Empty -- error "Internal error: deleteKeyExists empty"
 {-# NOINLINE deleteKeyExists #-}
@@ -1056,8 +1102,13 @@ adjust# f k0 m0 = go h0 s0 k0 0 m0
         in if ptrEq st st'
            then t
            else Full ary'
-    go h s k _ t@(Collision hx hmx)
-        | h == hx   = Collision hx $ go (hashWithSalt (nextSalt s) k) (nextSalt s) k 0 hmx
+    go h s k _ t@(Collision hx l1@(L k1 v1) l2@(L k2 v2) hmx)
+        | h == hx   =
+          let go'
+                | k == k1 = undefined
+                | k == k2 = undefined
+                | otherwise = Collision hx l1 l2 $ go (hashWithSalt (nextSalt s) k) (nextSalt s) k 0 hmx
+          in go'
         | otherwise = t
 {-# INLINABLE adjust# #-}
 
@@ -1265,14 +1316,26 @@ unionWithKey f = go 0 s0
                       then Leaf h1 (L k1 (f k1 v1 v2))
                       else collision h1 s l1 l2
         | otherwise = goDifferentHash bs s h1 h2 t1 t2
-    go bs s t1@(Leaf h1 l1@(L k1 _)) t2@(Collision h2 hm2)
-        | h1 == h2  = Collision h1 $ go 0 (nextSalt s) (Leaf (hashWithSalt (nextSalt s) k1) l1) hm2
+    go bs s t1@(Leaf h1 l1@(L k1 _)) t2@(Collision h2 l21@(L k21 v21) l22@(L k22 v22) hm2)
+        | h1 == h2  =
+          let go'
+                | True = undefined
+                | otherwise = Collision h1 undefined undefined $ go 0 (nextSalt s) (Leaf (hashWithSalt (nextSalt s) k1) l1) hm2
+          in go'
         | otherwise = goDifferentHash bs s h1 h2 t1 t2
-    go bs s t1@(Collision h1 hm1) t2@(Leaf h2 l2@(L k2 _))
-        | h1 == h2  = Collision h1 $ go 0 (nextSalt s) hm1 (Leaf (hashWithSalt (nextSalt s) k2) l2)
+    go bs s t1@(Collision h1 l11@(L k11 v11) l12@(L k12 v12) hm1) t2@(Leaf h2 l2@(L k2 _))
+        | h1 == h2  =
+          let go'
+                | True = undefined
+                | otherwise = Collision h1 undefined undefined $ go 0 (nextSalt s) hm1 (Leaf (hashWithSalt (nextSalt s) k2) l2)
+          in go'
         | otherwise = goDifferentHash bs s h1 h2 t1 t2
-    go bs s t1@(Collision h1 hm1) t2@(Collision h2 hm2)
-        | h1 == h2  = Collision h1 $ go 0 (nextSalt s) hm1 hm2
+    go bs s t1@(Collision h1 l11@(L k11 v11) l12@(L k12 v12) hm1) t2@(Collision h2 l21@(L k21 v21) l22@(L k22 v22) hm2)
+        | h1 == h2  =
+          let go'
+                | True = undefined
+                | otherwise = Collision h1 undefined undefined $ go 0 (nextSalt s) hm1 hm2
+          in go'
         | otherwise = goDifferentHash bs s h1 h2 t1 t2
     -- branch vs. branch
     go bs s (BitmapIndexed b1 ary1) (BitmapIndexed b2 ary2) =
@@ -1324,7 +1387,7 @@ unionWithKey f = go 0 s0
         in Full ary'
 
     leafHashCode (Leaf h _) = h
-    leafHashCode (Collision h _) = h
+    leafHashCode (Collision h _ _ _) = h
     leafHashCode _ = error "leafHashCode"
 
     goDifferentHash bs s h1 h2 t1 t2
@@ -1386,7 +1449,7 @@ mapWithKey f = go
     go (Full ary) = Full $ A.map go ary
     -- Why map strictly over collision arrays? Because there's no
     -- point suspending the O(1) work this does for each leaf.
-    go (Collision h hm) = Collision h $ go hm
+    go (Collision h (L k1 v1) (L k2 v2) hm) = Collision h (L k1 (f k2 v1)) (L k2 (f k2 v2)) $ go hm
 {-# INLINE mapWithKey #-}
 
 -- | /O(n)/ Transform this map by applying a function to every value.
@@ -1414,8 +1477,8 @@ traverseWithKey f = go
     go (Leaf h (L k v))      = Leaf h . L k <$> f k v
     go (BitmapIndexed b ary) = BitmapIndexed b <$> A.traverse go ary
     go (Full ary)            = Full <$> A.traverse go ary
-    go (Collision h hm)    =
-        Collision h <$> go hm
+    go (Collision h (L k1 v1) (L k2 v2) hm)    =
+        Collision h <$> (L k1 <$> f k1 v1) <*> (L k2 <$> f k2 v2) <*> go hm
 {-# INLINE traverseWithKey #-}
 
 ------------------------------------------------------------------------
@@ -1501,7 +1564,7 @@ foldlWithKey' f = go
     go z (Leaf _ (L k v))      = f z k v
     go z (BitmapIndexed _ ary) = A.foldl' go z ary
     go z (Full ary)            = A.foldl' go z ary
-    go z (Collision _ hm)    = go z hm
+    go z (Collision _ (L k1 v1) (L k2 v2) hm) = go (f (f z k1 v1) k2 v2) hm
 {-# INLINE foldlWithKey' #-}
 
 -- | /O(n)/ Reduce this map by applying a binary operator to all
@@ -1521,7 +1584,7 @@ foldrWithKey f = go
     go z (Leaf _ (L k v))      = f k v z
     go z (BitmapIndexed _ ary) = A.foldr (flip go) z ary
     go z (Full ary)            = A.foldr (flip go) z ary
-    go z (Collision _ hm)    = go z hm
+    go z (Collision _ (L k1 v1) (L k2 v2) hm)    = f k1 v1 (f k2 v2 (go z hm))
 {-# INLINE foldrWithKey #-}
 
 ------------------------------------------------------------------------
@@ -1564,7 +1627,12 @@ filterMapAux onLeaf = go
         | otherwise = Empty
     go (BitmapIndexed b ary) = filterA ary b
     go (Full ary) = filterA ary fullNodeMask
-    go (Collision h hm) = filterC h hm
+    go (Collision h l1 l2 hm) = undefined
+         --  let hm' = go hm
+         --  in case hm' of
+         --    Empty -> Empty
+         --    Leaf _ l -> Leaf h l
+         --    _ -> Collision h hm'
 
     filterA ary0 b0 =
         let !n = A.length ary0
@@ -1594,13 +1662,6 @@ filterMapAux onLeaf = go
                          (bi `unsafeShiftL` 1) n
                 t     -> do A.write mary j t
                             step ary mary b (i+1) (j+1) (bi `unsafeShiftL` 1) n
-
-    filterC h hm =
-      let hm' = go hm
-      in case hm' of
-        Empty -> Empty
-        Leaf _ l -> Leaf h l
-        _ -> Collision h hm'
 {-# INLINE filterMapAux #-}
 
 -- | /O(n)/ Filter this map by retaining only elements which values
diff --git a/Data/HashMap/Strict/Base.hs b/Data/HashMap/Strict/Base.hs
index f15597a5..9c8d5021 100644
--- a/Data/HashMap/Strict/Base.hs
+++ b/Data/HashMap/Strict/Base.hs
@@ -175,8 +175,13 @@ insertWith f k0 v0 m0 = go h0 s0 k0 v0 0 m0
             ary' = update16 ary i $! st'
         in Full ary'
       where i = index h bs
-    go h s k x bs t@(Collision hx hm)
-        | h == hx   = Collision hx $ go (hashWithSalt (nextSalt s) k) (nextSalt s) k x 0 hm
+    go h s k x bs t@(Collision hx l1@(L k1 v1) l2@(L k2 v2) hm)
+        | h == hx   =
+           let go'
+                 | k == k1   = Collision hx (L k (f x v1)) l2 hm
+                 | k == k2   = Collision hx l1 (L k (f x v2)) hm
+                 | otherwise = Collision hx l1 l2 $ go (hashWithSalt (nextSalt s) k) (nextSalt s) k x 0 hm
+           in go'
         | otherwise = go h s k x bs $ BitmapIndexed (mask hx bs) (A.singleton t)
 {-# INLINABLE insertWith #-}
 
@@ -212,8 +217,13 @@ unsafeInsertWith f k0 v0 m0 = runST (go h0 s0 k0 v0 0 m0)
         A.unsafeUpdateM ary i st'
         return t
       where i = index h bs
-    go h s k x bs t@(Collision hx hm)
-        | h == hx   = Collision hx <$> go (hashWithSalt (nextSalt s) k) (nextSalt s) k x 0 hm
+    go h s k x bs t@(Collision hx l1@(L k1 v1) l2@(L k2 v2) hm)
+        | h == hx   =
+          let go'
+                | k == k1   = return $! Collision hx (L k x) l2 hm
+                | k == k2   = return $! Collision hx l1 (L k x) hm
+                | otherwise = Collision hx l1 l2 <$> go (hashWithSalt (nextSalt s) k) (nextSalt s) k x 0 hm
+          in go'
         | otherwise = go h s k x bs $ BitmapIndexed (mask hx bs) (A.singleton t)
 {-# INLINABLE unsafeInsertWith #-}
 
@@ -242,8 +252,13 @@ adjust f k0 m0 = go h0 s0 k0 0 m0
             st'  = go h s k (bs+bitsPerSubkey) st
             ary' = update16 ary i $! st'
         in Full ary'
-    go h s k _ t@(Collision hx hm)
-        | h == hx   = Collision hx $ go (hashWithSalt (nextSalt s) k) (nextSalt s) k 0 hm
+    go h s k _ t@(Collision hx l1@(L k1 v1) l2@(L k2 v2) hm)
+        | h == hx   =
+          let go'
+                | k == k1   = Collision hx (L k (f v1)) l2 hm
+                | k == k2   = Collision hx l1 (L k (f v2)) hm
+                | otherwise = Collision hx l1 l2 $ go (hashWithSalt (nextSalt s) k) (nextSalt s) k 0 hm
+          in go'
         | otherwise = t
 {-# INLINABLE adjust #-}
 
@@ -417,14 +432,26 @@ unionWithKey f = go 0 s0
                       then leaf h1 k1 (f k1 v1 v2)
                       else collision h1 s l1 l2
         | otherwise = goDifferentHash bs s h1 h2 t1 t2
-    go bs s t1@(Leaf h1 l1@(L k1 _)) t2@(Collision h2 hm2)
-        | h1 == h2  = Collision h1 $ go 0 (nextSalt s) (Leaf (hashWithSalt (nextSalt s) k1) l1) hm2
+    go bs s t1@(Leaf h1 l1@(L k1 _)) t2@(Collision h2 l21@(L k21 v21) l22@(L k22 v22) hm2)
+        | h1 == h2  =
+          let go'
+                | True = undefined
+                | otherwise = Collision h1 undefined undefined $ go 0 (nextSalt s) (Leaf (hashWithSalt (nextSalt s) k1) l1) hm2
+          in go'
         | otherwise = goDifferentHash bs s h1 h2 t1 t2
-    go bs s t1@(Collision h1 hm1) t2@(Leaf h2 l2@(L k2 _))
-        | h1 == h2  = Collision h1 $ go 0 (nextSalt s) hm1 (Leaf (hashWithSalt (nextSalt s) k2) l2)
+    go bs s t1@(Collision h1 l11@(L k11 v11) l12@(L k12 v12) hm1) t2@(Leaf h2 l2@(L k2 _))
+        | h1 == h2  =
+          let go'
+                | True = undefined
+                | otherwise = Collision h1 undefined undefined $ go 0 (nextSalt s) hm1 (Leaf (hashWithSalt (nextSalt s) k2) l2)
+          in go'
         | otherwise = goDifferentHash bs s h1 h2 t1 t2
-    go bs s t1@(Collision h1 hm1) t2@(Collision h2 hm2)
-        | h1 == h2  = Collision h1 $ go 0 (nextSalt s) hm1 hm2
+    go bs s t1@(Collision h1 l11@(L k11 v11) l12@(L k12 v12) hm1) t2@(Collision h2 l21@(L k21 v21) l22@(L k22 v22) hm2)
+        | h1 == h2  =
+          let go'
+                | True = undefined
+                | otherwise = Collision h1 undefined undefined $ go 0 (nextSalt s) hm1 hm2
+          in go'
         | otherwise = goDifferentHash bs s h1 h2 t1 t2
     -- branch vs. branch
     go bs s (BitmapIndexed b1 ary1) (BitmapIndexed b2 ary2) =
@@ -476,7 +503,7 @@ unionWithKey f = go 0 s0
         in Full ary'
 
     leafHashCode (Leaf h _) = h
-    leafHashCode (Collision h _) = h
+    leafHashCode (Collision h _ _ _) = h
     leafHashCode _ = error "leafHashCode"
 
     goDifferentHash bs s h1 h2 t1 t2
@@ -499,8 +526,8 @@ mapWithKey f = go
     go (Leaf h (L k v))      = leaf h k (f k v)
     go (BitmapIndexed b ary) = BitmapIndexed b $ A.map' go ary
     go (Full ary)            = Full $ A.map' go ary
-    go (Collision h hm)     =
-        Collision h $ go hm
+    go (Collision h (L k1 v1) (L k2 v2) hm)     =
+        Collision h (v1 `seq` (L k1 (f k1 v1))) (v2 `seq` (L k2 (f k2 v2))) (go hm)
 {-# INLINE mapWithKey #-}
 
 -- | /O(n)/ Transform this map by applying a function to every value.
@@ -548,8 +575,8 @@ traverseWithKey f = go
     go (Leaf h (L k v))      = leaf h k <$> f k v
     go (BitmapIndexed b ary) = BitmapIndexed b <$> A.traverse' go ary
     go (Full ary)            = Full <$> A.traverse' go ary
-    go (Collision h hm)     =
-        Collision h <$> go hm
+    go (Collision h (L k1 v1) (L k2 v2) hm) =
+        Collision h <$> (L k1 <$> f k1 v1) <*> (L k2 <$> f k2 v2) <*> go hm
 {-# INLINE traverseWithKey #-}
 
 ------------------------------------------------------------------------

From 992ca509b204567e6fe1592ff36553958401adbd Mon Sep 17 00:00:00 2001
From: Tom Sydney Kerckhove <syd@fpcomplete.com>
Date: Fri, 12 Oct 2018 14:00:59 +0200
Subject: [PATCH 22/69] added back the always collision test, it does not loop
 infinitely now

---
 tests/HashMapProperties.hs | 36 +++++++++++++++++++++++++++++++-----
 1 file changed, 31 insertions(+), 5 deletions(-)

diff --git a/tests/HashMapProperties.hs b/tests/HashMapProperties.hs
index 1bff4973..d34f0d18 100644
--- a/tests/HashMapProperties.hs
+++ b/tests/HashMapProperties.hs
@@ -128,17 +128,42 @@ pInsert k v = M.insert k v `eq_` HM.insert k v
 pDelete :: Key -> [(Key, Int)] -> Bool
 pDelete k = M.delete k `eq_` HM.delete k
 
-newtype MostlyCollide = AC Int
+newtype AlwaysCollide = AC Int
+    deriving (Arbitrary, Eq, Ord, Show)
+
+instance Hashable AlwaysCollide where
+    hashWithSalt _ _ = 1
+    
+pDeleteAlwaysCollision :: AlwaysCollide -> AlwaysCollide -> AlwaysCollide -> Int -> Property
+pDeleteAlwaysCollision k1 k2 k3 idx = (k1 /= k2) && (k2 /= k3) && (k1 /= k3) ==>
+                                HM.member toKeep $ HM.delete toDelete $
+                                HM.fromList [(k1, 1 :: Int), (k2, 2), (k3, 3)]
+  where
+    which = idx `mod` 3
+    toDelete
+        | which == 0 = k1
+        | which == 1 = k2
+        | which == 2 = k3
+        | otherwise = error "Impossible"
+    toKeep
+        | which == 0 = k2
+        | which == 1 = k3
+        | which == 2 = k1
+        | otherwise = error "Impossible"
+
+
+
+newtype MostlyCollide = MC Int
     deriving (Arbitrary, Eq, Ord, Show)
 
 instance Hashable MostlyCollide where
-    hashWithSalt s (AC i) = (hashWithSalt s i) `mod` 3
+    hashWithSalt s (MC i) = (hashWithSalt s i) `mod` 3
 
 -- White-box test that tests the case of deleting one of two keys from
 -- a map, where the keys' hash values collide.
-pDeleteCollision :: MostlyCollide -> MostlyCollide -> MostlyCollide -> Int
+pDeleteMostlyCollision :: MostlyCollide -> MostlyCollide -> MostlyCollide -> Int
                  -> Property
-pDeleteCollision k1 k2 k3 idx =
+pDeleteMostlyCollision k1 k2 k3 idx =
   (k1 /= k2) && (k2 /= k3) && (k1 /= k3) &&
   (hashWithSalt defaultSalt k1 == hashWithSalt defaultSalt k2) &&
   (hashWithSalt defaultSalt k2 == hashWithSalt defaultSalt k3) &&
@@ -370,7 +395,8 @@ tests =
       , testProperty "lookup" pLookup
       , testProperty "insert" pInsert
       , testProperty "delete" pDelete
-      , testProperty "deleteCollision" pDeleteCollision
+      , testProperty "deleteAlwaysCollision" pDeleteAlwaysCollision
+      , testProperty "deleteMostlyCollision" pDeleteMostlyCollision
       , testProperty "insertWith" pInsertWith
       , testProperty "adjust" pAdjust
       , testProperty "updateAdjust" pUpdateAdjust

From dcec9f1a7232af4bd37e92e0855132b070dab0ef Mon Sep 17 00:00:00 2001
From: Tom Sydney Kerckhove <syd@fpcomplete.com>
Date: Fri, 12 Oct 2018 14:12:45 +0200
Subject: [PATCH 23/69] Fixed the strictness properties

---
 Data/HashMap/Strict/Base.hs | 8 ++++----
 1 file changed, 4 insertions(+), 4 deletions(-)

diff --git a/Data/HashMap/Strict/Base.hs b/Data/HashMap/Strict/Base.hs
index 9c8d5021..3939c484 100644
--- a/Data/HashMap/Strict/Base.hs
+++ b/Data/HashMap/Strict/Base.hs
@@ -178,8 +178,8 @@ insertWith f k0 v0 m0 = go h0 s0 k0 v0 0 m0
     go h s k x bs t@(Collision hx l1@(L k1 v1) l2@(L k2 v2) hm)
         | h == hx   =
            let go'
-                 | k == k1   = Collision hx (L k (f x v1)) l2 hm
-                 | k == k2   = Collision hx l1 (L k (f x v2)) hm
+                 | k == k1   = Collision hx (L k $! f x v1) l2 hm
+                 | k == k2   = Collision hx l1 (L k $! f x v2) hm
                  | otherwise = Collision hx l1 l2 $ go (hashWithSalt (nextSalt s) k) (nextSalt s) k x 0 hm
            in go'
         | otherwise = go h s k x bs $ BitmapIndexed (mask hx bs) (A.singleton t)
@@ -255,8 +255,8 @@ adjust f k0 m0 = go h0 s0 k0 0 m0
     go h s k _ t@(Collision hx l1@(L k1 v1) l2@(L k2 v2) hm)
         | h == hx   =
           let go'
-                | k == k1   = Collision hx (L k (f v1)) l2 hm
-                | k == k2   = Collision hx l1 (L k (f v2)) hm
+                | k == k1   = Collision hx (L k $! f v1) l2 hm
+                | k == k2   = Collision hx l1 (L k $! f v2) hm
                 | otherwise = Collision hx l1 l2 $ go (hashWithSalt (nextSalt s) k) (nextSalt s) k 0 hm
           in go'
         | otherwise = t

From c348ab598a518f5fef3a94a5c8a92203befdd7a8 Mon Sep 17 00:00:00 2001
From: Tom Sydney Kerckhove <syd@fpcomplete.com>
Date: Fri, 12 Oct 2018 15:17:12 +0200
Subject: [PATCH 24/69] Got deletions working, sortof

---
 Data/HashMap/Base.hs | 61 ++++++++++++++++++++++++++++++++++++++++++--
 1 file changed, 59 insertions(+), 2 deletions(-)

diff --git a/Data/HashMap/Base.hs b/Data/HashMap/Base.hs
index 63a3bba1..c59b199c 100644
--- a/Data/HashMap/Base.hs
+++ b/Data/HashMap/Base.hs
@@ -1003,8 +1003,14 @@ delete' h0 s0 k0 m0 = go h0 s0 k0 0 m0
     go h s k _ t@(Collision hx l1@(L k1 v1) l2@(L k2 v2) hmx)
         | h == hx =
           let go'
-                | k == k1 = undefined
-                | k == k2 = undefined
+                | k == k1 = case unConsHM hmx of
+                    WasEmpty -> Leaf hx l2
+                    NowEmpty l3 -> Collision hx l2 l3 Empty
+                    UnConsed l3 hmx' -> Collision hx l2 l3 hmx'
+                | k == k2 = case unConsHM hmx of
+                    WasEmpty -> Leaf hx l1
+                    NowEmpty l3 -> Collision hx l1 l3 Empty
+                    UnConsed l3 hmx' -> Collision hx l1 l3 hmx'
                 | otherwise = Collision hx l1 l2 $ go (hashWithSalt (nextSalt s) k) (nextSalt s) k 0 hmx
           in go'
         | otherwise = t
@@ -1760,6 +1766,57 @@ updateOrConcatWithKey f ary1 ary2 = A.run $ do
     return mary
 {-# INLINABLE updateOrConcatWithKey #-}
 
+-- Helper functions for very rare cases.
+
+-- Remove (any) one element from an array of hashmaps
+unConsA :: A.Array (HashMap k v) -> UnCons k v (A.Array (HashMap k v))
+unConsA ary = case A.length ary of
+  0 -> WasEmpty
+  1 -> case A.index ary 0 of
+    Empty -> WasEmpty -- That would be weird, but fine.
+    Leaf _ l -> NowEmpty l
+    BitmapIndexed bm ary' -> case unConsA ary' of
+      WasEmpty -> WasEmpty -- That would be weird, but fine.
+      NowEmpty l -> NowEmpty l
+      UnConsed l a' -> UnConsed l (A.singleton (BitmapIndexed bm a'))
+    Full ary' -> case unConsA ary' of
+        WasEmpty -> WasEmpty -- That would be weird, but fine.
+        NowEmpty l -> NowEmpty l
+        UnConsed l a' -> UnConsed l (A.singleton (Full a'))
+    Collision h l1 l2 hm -> UnConsed l1 $ A.singleton $ case unConsHM hm of
+      WasEmpty -> Leaf h l2
+      NowEmpty l3 -> Collision h l2 l3 Empty
+      UnConsed l3 hm' -> Collision h l2 l3 hm'
+  _ -> goA 0
+  where
+    goA ix = case unConsHM $ A.index ary ix of
+      WasEmpty -> goA $ ix + 1 -- TODO this is probably problematic when the entire array only houses Empty hashmaps
+      NowEmpty l -> UnConsed l $ A.delete ary ix
+      UnConsed l hm' -> UnConsed l $ A.update ary ix hm'
+
+-- Remove (any) one element from a hashmap
+unConsHM :: HashMap k v -> UnCons k v (HashMap k v)
+unConsHM hm = case hm of
+  Empty -> WasEmpty
+  Leaf _ l -> NowEmpty l
+  BitmapIndexed bm ary' -> case unConsA ary' of
+    WasEmpty -> WasEmpty
+    NowEmpty l -> NowEmpty l
+    UnConsed l a' -> UnConsed l (BitmapIndexed bm a')
+  Full ary' -> case unConsA ary' of
+    WasEmpty -> WasEmpty -- That would be weird, but fine.
+    NowEmpty l -> NowEmpty l
+    UnConsed l a' -> UnConsed l (Full a') -- TODO This 'Full' seems wrong
+  Collision h l1 l2 hm -> UnConsed l1 $ case unConsHM hm of
+    WasEmpty -> Leaf h l2
+    NowEmpty l3 -> Collision h l2 l3 Empty
+    UnConsed l3 hm' -> Collision h l2 l3 hm'
+
+data UnCons k v f
+  = WasEmpty
+  | NowEmpty (Leaf k v)
+  | UnConsed (Leaf k v) f
+
 ------------------------------------------------------------------------
 -- Manually unrolled loops
 

From 07ed2f5e40a0c4e2d785f4358924ba92d7bb824c Mon Sep 17 00:00:00 2001
From: Tom Sydney Kerckhove <syd@fpcomplete.com>
Date: Fri, 12 Oct 2018 15:21:32 +0200
Subject: [PATCH 25/69] Got adjust working, sort-of

---
 Data/HashMap/Base.hs | 8 ++++++--
 1 file changed, 6 insertions(+), 2 deletions(-)

diff --git a/Data/HashMap/Base.hs b/Data/HashMap/Base.hs
index c59b199c..bc100c1d 100644
--- a/Data/HashMap/Base.hs
+++ b/Data/HashMap/Base.hs
@@ -1111,8 +1111,12 @@ adjust# f k0 m0 = go h0 s0 k0 0 m0
     go h s k _ t@(Collision hx l1@(L k1 v1) l2@(L k2 v2) hmx)
         | h == hx   =
           let go'
-                | k == k1 = undefined
-                | k == k2 = undefined
+                | k == k1 = case f v1 of
+                    (# v1' #) | ptrEq v1 v1' -> t
+                              | otherwise -> Collision hx (L k v1') l2 hmx
+                | k == k2 = case f v2 of
+                    (# v2' #) | ptrEq v2 v2' -> t
+                              | otherwise -> Collision hx l1 (L k v2') hmx
                 | otherwise = Collision hx l1 l2 $ go (hashWithSalt (nextSalt s) k) (nextSalt s) k 0 hmx
           in go'
         | otherwise = t

From 3dda7e1f0a7d6af1347eb9c61e0e3800ae11fe00 Mon Sep 17 00:00:00 2001
From: Tom Sydney Kerckhove <syd@fpcomplete.com>
Date: Fri, 12 Oct 2018 15:23:46 +0200
Subject: [PATCH 26/69] fixed deleteKeyExists, sort-of

---
 Data/HashMap/Base.hs | 10 ++++++++--
 1 file changed, 8 insertions(+), 2 deletions(-)

diff --git a/Data/HashMap/Base.hs b/Data/HashMap/Base.hs
index bc100c1d..e14013e0 100644
--- a/Data/HashMap/Base.hs
+++ b/Data/HashMap/Base.hs
@@ -1057,8 +1057,14 @@ deleteKeyExists !h0 s0 !k0 !m0 = go h0 s0 k0 0 m0
     go h s k _ (Collision hx l1@(L k1 v1) l2@(L k2 v2) hmx)
         | h == hx =
           let go'
-                | k == k1 = undefined
-                | k == k2 = undefined
+                | k == k1 = case unConsHM hmx of
+                    WasEmpty -> Leaf hx l2
+                    NowEmpty l3 -> Collision hx l2 l3 Empty
+                    UnConsed l3 hmx' -> Collision hx l2 l3 hmx'
+                | k == k2 = case unConsHM hmx of
+                    WasEmpty -> Leaf hx l1
+                    NowEmpty l3 -> Collision hx l1 l3 Empty
+                    UnConsed l3 hmx' -> Collision hx l1 l3 hmx'
                 | otherwise = Collision hx l1 l2 $ go (hashWithSalt (nextSalt s) k) (nextSalt s) k 0 hmx
           in go'
         | otherwise = Empty -- error "Internal error: unexpected collision"

From d4e09fa7e11f8b9b96cf4b9204ba29d192e13718 Mon Sep 17 00:00:00 2001
From: Tom Sydney Kerckhove <syd@fpcomplete.com>
Date: Mon, 15 Oct 2018 04:54:47 +0200
Subject: [PATCH 27/69] Fixed the lazy union tests

---
 Data/HashMap/Base.hs       | 22 ++++++++++------------
 tests/HashMapProperties.hs |  2 +-
 2 files changed, 11 insertions(+), 13 deletions(-)

diff --git a/Data/HashMap/Base.hs b/Data/HashMap/Base.hs
index e14013e0..1d58ebfb 100644
--- a/Data/HashMap/Base.hs
+++ b/Data/HashMap/Base.hs
@@ -1332,26 +1332,24 @@ unionWithKey f = go 0 s0
                       then Leaf h1 (L k1 (f k1 v1 v2))
                       else collision h1 s l1 l2
         | otherwise = goDifferentHash bs s h1 h2 t1 t2
-    go bs s t1@(Leaf h1 l1@(L k1 _)) t2@(Collision h2 l21@(L k21 v21) l22@(L k22 v22) hm2)
+    go bs s t1@(Leaf h1 l1@(L k1 v1)) t2@(Collision h2 l21@(L k21 v21) l22@(L k22 v22) hm2)
         | h1 == h2  =
           let go'
-                | True = undefined
-                | otherwise = Collision h1 undefined undefined $ go 0 (nextSalt s) (Leaf (hashWithSalt (nextSalt s) k1) l1) hm2
+                | k1 == k21 = Collision h1 (L k1 (f k1 v1 v21)) l22 hm2
+                | k1 == k22 = Collision h1 l21 (L k1 (f k1 v1 v22)) hm2
+                | otherwise = Collision h1 l21 l22 $ go 0 (nextSalt s) (Leaf (hashWithSalt (nextSalt s) k1) l1) hm2
           in go'
         | otherwise = goDifferentHash bs s h1 h2 t1 t2
-    go bs s t1@(Collision h1 l11@(L k11 v11) l12@(L k12 v12) hm1) t2@(Leaf h2 l2@(L k2 _))
+    go bs s t1@(Collision h1 l11@(L k11 v11) l12@(L k12 v12) hm1) t2@(Leaf h2 l2@(L k2 v2))
         | h1 == h2  =
           let go'
-                | True = undefined
-                | otherwise = Collision h1 undefined undefined $ go 0 (nextSalt s) hm1 (Leaf (hashWithSalt (nextSalt s) k2) l2)
+                | k2 == k11 = Collision h1 (L k2 (f k2 v11 v2)) l12 hm1
+                | k2 == k12 = Collision h1 l11 (L k2 (f k2 v12 v2)) hm1
+                | otherwise = Collision h1 l11 l12 $ go 0 (nextSalt s) hm1 (Leaf (hashWithSalt (nextSalt s) k2) l2)
           in go'
         | otherwise = goDifferentHash bs s h1 h2 t1 t2
-    go bs s t1@(Collision h1 l11@(L k11 v11) l12@(L k12 v12) hm1) t2@(Collision h2 l21@(L k21 v21) l22@(L k22 v22) hm2)
-        | h1 == h2  =
-          let go'
-                | True = undefined
-                | otherwise = Collision h1 undefined undefined $ go 0 (nextSalt s) hm1 hm2
-          in go'
+    go bs s t1@(Collision h1 _ _ _) t2@(Collision h2 _ _ _)
+        | h1 == h2  = L.foldl' (\h (k,v) -> go 0 s h (Leaf (hashWithSalt s k) (L k v))) t1 $ toList t2 -- Nothing better we can do, unfortunately.
         | otherwise = goDifferentHash bs s h1 h2 t1 t2
     -- branch vs. branch
     go bs s (BitmapIndexed b1 ary1) (BitmapIndexed b2 ary2) =
diff --git a/tests/HashMapProperties.hs b/tests/HashMapProperties.hs
index d34f0d18..b2b4c422 100644
--- a/tests/HashMapProperties.hs
+++ b/tests/HashMapProperties.hs
@@ -3,7 +3,7 @@
 -- | Tests for the 'Data.HashMap.Lazy' module.  We test functions by
 -- comparing them to a simpler model, an association list.
 
-module Main (main) where
+module Main where
 
 import Control.Monad ( guard )
 import qualified Data.Foldable as Foldable

From 65b6783e939389ea684deeb9bb29a9b5c6c9a0c4 Mon Sep 17 00:00:00 2001
From: Tom Sydney Kerckhove <syd@fpcomplete.com>
Date: Mon, 15 Oct 2018 05:20:19 +0200
Subject: [PATCH 28/69] Fixed the filter functions

---
 Data/HashMap/Base.hs | 25 +++++++++++++++++++------
 1 file changed, 19 insertions(+), 6 deletions(-)

diff --git a/Data/HashMap/Base.hs b/Data/HashMap/Base.hs
index 1d58ebfb..862f4a82 100644
--- a/Data/HashMap/Base.hs
+++ b/Data/HashMap/Base.hs
@@ -1641,12 +1641,25 @@ filterMapAux onLeaf = go
         | otherwise = Empty
     go (BitmapIndexed b ary) = filterA ary b
     go (Full ary) = filterA ary fullNodeMask
-    go (Collision h l1 l2 hm) = undefined
-         --  let hm' = go hm
-         --  in case hm' of
-         --    Empty -> Empty
-         --    Leaf _ l -> Leaf h l
-         --    _ -> Collision h hm'
+    go (Collision h l1 l2 hm) = case (onLeaf (Leaf h l1), onLeaf (Leaf h l2)) of
+      (Just (Leaf _ l1'), Just (Leaf _ l2')) -> Collision h l1' l2' $ go hm
+      (Just (Leaf _ l1'), Nothing) -> case go' hm of
+        Nothing -> Leaf h l1'
+        Just (Leaf _ l3', hm') -> Collision h l1' l3' hm'
+      (Nothing, Just (Leaf _ l2')) -> case go' hm of
+        Nothing -> Leaf h l2'
+        Just (Leaf _ l3', hm') -> Collision h l2' l3' hm'
+      (Nothing, Nothing) -> go hm
+      _ -> error "Should not happen, can be fixed with refactoring I think."
+      where
+        go' hm = case unConsHM hm of
+          WasEmpty -> Nothing
+          NowEmpty l -> case onLeaf (Leaf h l) of
+            Nothing -> Nothing
+            Just l' -> Just (l', Empty)
+          UnConsed l hm' -> case onLeaf (Leaf h l) of
+            Nothing -> go' hm'
+            Just l' -> Just (l', go hm')
 
     filterA ary0 b0 =
         let !n = A.length ary0

From 9c2deeb6feab43f1cfade5e4665ec468166f3afa Mon Sep 17 00:00:00 2001
From: Tom Sydney Kerckhove <syd@fpcomplete.com>
Date: Mon, 15 Oct 2018 05:29:05 +0200
Subject: [PATCH 29/69] Simplified unconsing hashmaps

---
 Data/HashMap/Base.hs | 62 +++++++++++++++++++-------------------------
 1 file changed, 26 insertions(+), 36 deletions(-)

diff --git a/Data/HashMap/Base.hs b/Data/HashMap/Base.hs
index 862f4a82..d464a00b 100644
--- a/Data/HashMap/Base.hs
+++ b/Data/HashMap/Base.hs
@@ -1004,13 +1004,11 @@ delete' h0 s0 k0 m0 = go h0 s0 k0 0 m0
         | h == hx =
           let go'
                 | k == k1 = case unConsHM hmx of
-                    WasEmpty -> Leaf hx l2
-                    NowEmpty l3 -> Collision hx l2 l3 Empty
-                    UnConsed l3 hmx' -> Collision hx l2 l3 hmx'
+                    Nothing -> Leaf hx l2
+                    Just (l3, hmx') -> Collision hx l2 l3 hmx'
                 | k == k2 = case unConsHM hmx of
-                    WasEmpty -> Leaf hx l1
-                    NowEmpty l3 -> Collision hx l1 l3 Empty
-                    UnConsed l3 hmx' -> Collision hx l1 l3 hmx'
+                    Nothing -> Leaf hx l1
+                    Just (l3, hmx') -> Collision hx l1 l3 hmx'
                 | otherwise = Collision hx l1 l2 $ go (hashWithSalt (nextSalt s) k) (nextSalt s) k 0 hmx
           in go'
         | otherwise = t
@@ -1058,13 +1056,11 @@ deleteKeyExists !h0 s0 !k0 !m0 = go h0 s0 k0 0 m0
         | h == hx =
           let go'
                 | k == k1 = case unConsHM hmx of
-                    WasEmpty -> Leaf hx l2
-                    NowEmpty l3 -> Collision hx l2 l3 Empty
-                    UnConsed l3 hmx' -> Collision hx l2 l3 hmx'
+                    Nothing -> Leaf hx l2
+                    Just (l3, hmx') -> Collision hx l2 l3 hmx'
                 | k == k2 = case unConsHM hmx of
-                    WasEmpty -> Leaf hx l1
-                    NowEmpty l3 -> Collision hx l1 l3 Empty
-                    UnConsed l3 hmx' -> Collision hx l1 l3 hmx'
+                    Nothing -> Leaf hx l1
+                    Just (l3, hmx') -> Collision hx l1 l3 hmx'
                 | otherwise = Collision hx l1 l2 $ go (hashWithSalt (nextSalt s) k) (nextSalt s) k 0 hmx
           in go'
         | otherwise = Empty -- error "Internal error: unexpected collision"
@@ -1653,11 +1649,8 @@ filterMapAux onLeaf = go
       _ -> error "Should not happen, can be fixed with refactoring I think."
       where
         go' hm = case unConsHM hm of
-          WasEmpty -> Nothing
-          NowEmpty l -> case onLeaf (Leaf h l) of
-            Nothing -> Nothing
-            Just l' -> Just (l', Empty)
-          UnConsed l hm' -> case onLeaf (Leaf h l) of
+          Nothing -> Nothing
+          Just (l, hm') -> case onLeaf (Leaf h l) of
             Nothing -> go' hm'
             Just l' -> Just (l', go hm')
 
@@ -1805,33 +1798,30 @@ unConsA ary = case A.length ary of
         NowEmpty l -> NowEmpty l
         UnConsed l a' -> UnConsed l (A.singleton (Full a'))
     Collision h l1 l2 hm -> UnConsed l1 $ A.singleton $ case unConsHM hm of
-      WasEmpty -> Leaf h l2
-      NowEmpty l3 -> Collision h l2 l3 Empty
-      UnConsed l3 hm' -> Collision h l2 l3 hm'
+      Nothing -> Leaf h l2
+      Just (l3, hm') -> Collision h l2 l3 hm'
   _ -> goA 0
   where
     goA ix = case unConsHM $ A.index ary ix of
-      WasEmpty -> goA $ ix + 1 -- TODO this is probably problematic when the entire array only houses Empty hashmaps
-      NowEmpty l -> UnConsed l $ A.delete ary ix
-      UnConsed l hm' -> UnConsed l $ A.update ary ix hm'
+      Nothing -> goA $ ix + 1 -- TODO this is probably problematic when the entire array only houses Empty hashmaps
+      Just (l, hm') -> UnConsed l $ A.update ary ix hm'
 
 -- Remove (any) one element from a hashmap
-unConsHM :: HashMap k v -> UnCons k v (HashMap k v)
+unConsHM :: HashMap k v -> Maybe (Leaf k v, HashMap k v)
 unConsHM hm = case hm of
-  Empty -> WasEmpty
-  Leaf _ l -> NowEmpty l
+  Empty -> Nothing
+  Leaf _ l -> Just (l, Empty)
   BitmapIndexed bm ary' -> case unConsA ary' of
-    WasEmpty -> WasEmpty
-    NowEmpty l -> NowEmpty l
-    UnConsed l a' -> UnConsed l (BitmapIndexed bm a')
+    WasEmpty -> Nothing
+    NowEmpty l -> Just (l, Empty)
+    UnConsed l a' -> Just (l, BitmapIndexed bm a')
   Full ary' -> case unConsA ary' of
-    WasEmpty -> WasEmpty -- That would be weird, but fine.
-    NowEmpty l -> NowEmpty l
-    UnConsed l a' -> UnConsed l (Full a') -- TODO This 'Full' seems wrong
-  Collision h l1 l2 hm -> UnConsed l1 $ case unConsHM hm of
-    WasEmpty -> Leaf h l2
-    NowEmpty l3 -> Collision h l2 l3 Empty
-    UnConsed l3 hm' -> Collision h l2 l3 hm'
+    WasEmpty -> Nothing -- That would be weird, but fine.
+    NowEmpty l -> Just (l, Empty)
+    UnConsed l a' -> Just (l, Full a') -- TODO This 'Full' seems wrong
+  Collision h l1 l2 hm -> Just $ (,) l1 $ case unConsHM hm of
+    Nothing -> Leaf h l2
+    Just (l3, hm') -> Collision h l2 l3 hm'
 
 data UnCons k v f
   = WasEmpty

From 2951ae722ae902d0e4e229692d866356670c67c2 Mon Sep 17 00:00:00 2001
From: Tom Sydney Kerckhove <syd@fpcomplete.com>
Date: Mon, 15 Oct 2018 05:29:59 +0200
Subject: [PATCH 30/69] fixed strict unions

---
 Data/HashMap/Strict/Base.hs | 23 ++++++++++-------------
 1 file changed, 10 insertions(+), 13 deletions(-)

diff --git a/Data/HashMap/Strict/Base.hs b/Data/HashMap/Strict/Base.hs
index 3939c484..005c7ae5 100644
--- a/Data/HashMap/Strict/Base.hs
+++ b/Data/HashMap/Strict/Base.hs
@@ -432,28 +432,25 @@ unionWithKey f = go 0 s0
                       then leaf h1 k1 (f k1 v1 v2)
                       else collision h1 s l1 l2
         | otherwise = goDifferentHash bs s h1 h2 t1 t2
-    go bs s t1@(Leaf h1 l1@(L k1 _)) t2@(Collision h2 l21@(L k21 v21) l22@(L k22 v22) hm2)
+    go bs s t1@(Leaf h1 l1@(L k1 v1)) t2@(Collision h2 l21@(L k21 v21) l22@(L k22 v22) hm2)
         | h1 == h2  =
           let go'
-                | True = undefined
-                | otherwise = Collision h1 undefined undefined $ go 0 (nextSalt s) (Leaf (hashWithSalt (nextSalt s) k1) l1) hm2
+                | k1 == k21 = Collision h1 (L k1 (f k1 v1 v21)) l22 hm2
+                | k1 == k22 = Collision h1 l21 (L k1 (f k1 v1 v22)) hm2
+                | otherwise = Collision h1 l21 l22 $ go 0 (nextSalt s) (Leaf (hashWithSalt (nextSalt s) k1) l1) hm2
           in go'
         | otherwise = goDifferentHash bs s h1 h2 t1 t2
-    go bs s t1@(Collision h1 l11@(L k11 v11) l12@(L k12 v12) hm1) t2@(Leaf h2 l2@(L k2 _))
+    go bs s t1@(Collision h1 l11@(L k11 v11) l12@(L k12 v12) hm1) t2@(Leaf h2 l2@(L k2 v2))
         | h1 == h2  =
           let go'
-                | True = undefined
-                | otherwise = Collision h1 undefined undefined $ go 0 (nextSalt s) hm1 (Leaf (hashWithSalt (nextSalt s) k2) l2)
+                | k2 == k11 = Collision h1 (L k2 (f k2 v11 v2)) l12 hm1
+                | k2 == k12 = Collision h1 l11 (L k2 (f k2 v12 v2)) hm1
+                | otherwise = Collision h1 l11 l12 $ go 0 (nextSalt s) hm1 (Leaf (hashWithSalt (nextSalt s) k2) l2)
           in go'
         | otherwise = goDifferentHash bs s h1 h2 t1 t2
-    go bs s t1@(Collision h1 l11@(L k11 v11) l12@(L k12 v12) hm1) t2@(Collision h2 l21@(L k21 v21) l22@(L k22 v22) hm2)
-        | h1 == h2  =
-          let go'
-                | True = undefined
-                | otherwise = Collision h1 undefined undefined $ go 0 (nextSalt s) hm1 hm2
-          in go'
+    go bs s t1@(Collision h1 _ _ _) t2@(Collision h2 _ _ _)
+        | h1 == h2  = L.foldl' (\h (k,v) -> go 0 s h (Leaf (hashWithSalt s k) (L k v))) t1 $ toList t2 -- Nothing better we can do, unfortunately.
         | otherwise = goDifferentHash bs s h1 h2 t1 t2
-    -- branch vs. branch
     go bs s (BitmapIndexed b1 ary1) (BitmapIndexed b2 ary2) =
         let b'   = b1 .|. b2
             ary' = unionArrayBy (go (bs+bitsPerSubkey) s) b1 b2 ary1 ary2

From 1d71c962ae0f3284875da606b1ec9dc5631f086e Mon Sep 17 00:00:00 2001
From: Tom Sydney Kerckhove <syd@fpcomplete.com>
Date: Mon, 15 Oct 2018 06:15:16 +0200
Subject: [PATCH 31/69] little refactorings

---
 Data/HashMap/Base.hs | 32 +++++++++++++++++---------------
 1 file changed, 17 insertions(+), 15 deletions(-)

diff --git a/Data/HashMap/Base.hs b/Data/HashMap/Base.hs
index d464a00b..e7044c8c 100644
--- a/Data/HashMap/Base.hs
+++ b/Data/HashMap/Base.hs
@@ -1000,7 +1000,7 @@ delete' h0 s0 k0 m0 = go h0 s0 k0 0 m0
                 in BitmapIndexed bm ary'
             _ -> Full (A.update ary i st')
       where i = index h bs
-    go h s k _ t@(Collision hx l1@(L k1 v1) l2@(L k2 v2) hmx)
+    go h s k _ t@(Collision hx l1@(L k1 _) l2@(L k2 _) hmx)
         | h == hx =
           let go'
                 | k == k1 = case unConsHM hmx of
@@ -1052,7 +1052,7 @@ deleteKeyExists !h0 s0 !k0 !m0 = go h0 s0 k0 0 m0
                 in BitmapIndexed bm ary'
             _ -> Full (A.update ary i st')
       where i = index h bs
-    go h s k _ (Collision hx l1@(L k1 v1) l2@(L k2 v2) hmx)
+    go h s k _ (Collision hx l1@(L k1 _) l2@(L k2 _) hmx)
         | h == hx =
           let go'
                 | k == k1 = case unConsHM hmx of
@@ -1642,17 +1642,19 @@ filterMapAux onLeaf = go
       (Just (Leaf _ l1'), Nothing) -> case go' hm of
         Nothing -> Leaf h l1'
         Just (Leaf _ l3', hm') -> Collision h l1' l3' hm'
+        _ -> error "Should not happen, can be fixed with refactoring I think."
       (Nothing, Just (Leaf _ l2')) -> case go' hm of
         Nothing -> Leaf h l2'
         Just (Leaf _ l3', hm') -> Collision h l2' l3' hm'
+        _ -> error "Should not happen, can be fixed with refactoring I think."
       (Nothing, Nothing) -> go hm
       _ -> error "Should not happen, can be fixed with refactoring I think."
       where
-        go' hm = case unConsHM hm of
+        go' hm_ = case unConsHM hm_ of
           Nothing -> Nothing
-          Just (l, hm') -> case onLeaf (Leaf h l) of
-            Nothing -> go' hm'
-            Just l' -> Just (l', go hm')
+          Just (l, hm_') -> case onLeaf (Leaf h l) of
+            Nothing -> go' hm_'
+            Just l' -> Just (l', go hm_')
 
     filterA ary0 b0 =
         let !n = A.length ary0
@@ -1783,7 +1785,7 @@ updateOrConcatWithKey f ary1 ary2 = A.run $ do
 -- Helper functions for very rare cases.
 
 -- Remove (any) one element from an array of hashmaps
-unConsA :: A.Array (HashMap k v) -> UnCons k v (A.Array (HashMap k v))
+unConsA :: A.Array (HashMap k v) -> UnCons k v
 unConsA ary = case A.length ary of
   0 -> WasEmpty
   1 -> case A.index ary 0 of
@@ -1796,7 +1798,7 @@ unConsA ary = case A.length ary of
     Full ary' -> case unConsA ary' of
         WasEmpty -> WasEmpty -- That would be weird, but fine.
         NowEmpty l -> NowEmpty l
-        UnConsed l a' -> UnConsed l (A.singleton (Full a'))
+        UnConsed l a' -> UnConsed l (A.singleton (Full a')) -- 'Full' seems wrong
     Collision h l1 l2 hm -> UnConsed l1 $ A.singleton $ case unConsHM hm of
       Nothing -> Leaf h l2
       Just (l3, hm') -> Collision h l2 l3 hm'
@@ -1806,6 +1808,11 @@ unConsA ary = case A.length ary of
       Nothing -> goA $ ix + 1 -- TODO this is probably problematic when the entire array only houses Empty hashmaps
       Just (l, hm') -> UnConsed l $ A.update ary ix hm'
 
+data UnCons k v
+  = WasEmpty
+  | NowEmpty (Leaf k v)
+  | UnConsed (Leaf k v) (A.Array (HashMap k v))
+
 -- Remove (any) one element from a hashmap
 unConsHM :: HashMap k v -> Maybe (Leaf k v, HashMap k v)
 unConsHM hm = case hm of
@@ -1819,14 +1826,9 @@ unConsHM hm = case hm of
     WasEmpty -> Nothing -- That would be weird, but fine.
     NowEmpty l -> Just (l, Empty)
     UnConsed l a' -> Just (l, Full a') -- TODO This 'Full' seems wrong
-  Collision h l1 l2 hm -> Just $ (,) l1 $ case unConsHM hm of
+  Collision h l1 l2 hm' -> Just $ (,) l1 $ case unConsHM hm' of
     Nothing -> Leaf h l2
-    Just (l3, hm') -> Collision h l2 l3 hm'
-
-data UnCons k v f
-  = WasEmpty
-  | NowEmpty (Leaf k v)
-  | UnConsed (Leaf k v) f
+    Just (l3, hm'') -> Collision h l2 l3 hm''
 
 ------------------------------------------------------------------------
 -- Manually unrolled loops

From 822f08d84127ce47bda79d601ea5c183cfa747e5 Mon Sep 17 00:00:00 2001
From: Tom Sydney Kerckhove <syd@fpcomplete.com>
Date: Mon, 15 Oct 2018 06:59:28 +0200
Subject: [PATCH 32/69] Fixed equality, and messed up hashable because we just
 fixed what was be a false positive

---
 Data/HashMap/Base.hs | 48 ++++++++++++++++++++++++++------------------
 1 file changed, 28 insertions(+), 20 deletions(-)

diff --git a/Data/HashMap/Base.hs b/Data/HashMap/Base.hs
index e7044c8c..16a75fa7 100644
--- a/Data/HashMap/Base.hs
+++ b/Data/HashMap/Base.hs
@@ -137,6 +137,7 @@ import qualified Data.Hashable as H
 import Data.Hashable (Hashable)
 import Data.HashMap.Unsafe (runST)
 import Data.HashMap.UnsafeShift (unsafeShiftL, unsafeShiftR)
+import Data.HashMap.List (isPermutationBy, unorderedCompare)
 import Data.Typeable (Typeable)
 
 import GHC.Exts (isTrue#)
@@ -296,8 +297,11 @@ equal1 eq = go
       = bm1 == bm2 && A.sameArray1 go ary1 ary2
     go (Leaf h1 l1) (Leaf h2 l2) = h1 == h2 && leafEq l1 l2
     go (Full ary1) (Full ary2) = A.sameArray1 go ary1 ary2
-    go (Collision h1 l11 l12 hm1) (Collision h2 l21 l22 hm2)
-      = h1 == h2 && l11 `leafEq` l21 && l12 `leafEq` l22 && go hm1 hm2
+    go (Collision h1 (L k11 v11) (L k12 v12) hm1) (Collision h2 (L k21 v21) (L k22 v22) hm2)
+      = h1 == h2
+      && isPermutationBy (\(k1, v1) (k2, v2) -> k1 == k2 && eq v1 v2)
+           ((k11, v11) : (k12, v12) : toList hm1)
+           ((k21, v21) : (k22, v22) : toList hm2)
     go _ _ = False
 
     leafEq (L k1 v1) (L k2 v2) = k1 == k2 && eq v1 v2
@@ -310,15 +314,16 @@ equal2 eqk eqv t1 t2 = go (toList' t1 []) (toList' t2 [])
     -- 'Collision's read from left to right should be the same (modulo the
     -- order of elements in 'Collision').
 
-    go (Leaf k1 l1 : tl1) (Leaf k2 l2 : tl2)
-      | k1 == k2 &&
+    go (Leaf h1 l1 : tl1) (Leaf h2 l2 : tl2)
+      | h1 == h2 &&
         leafEq l1 l2
       = go tl1 tl2
-    go (Collision h1 l11 l12 hm1 : tl1) (Collision h2 l21 l22 hm2 : tl2)
+    go (Collision h1 (L k11 v11) (L k12 v12) hm1 : tl1) (Collision h2 (L k21 v21) (L k22 v22) hm2 : tl2)
       | h1 == h2 &&
-        leafEq l11 l21 &&
-        leafEq l12 l22 &&
-        go (toList' hm1 []) (toList' hm2 [])
+        (length hm1 == length hm2) &&
+        isPermutationBy (\(k1, v1) (k2, v2) -> eqk k1 k2 && eqv v1 v2)
+          ((k11, v11) : (k12, v12) : toList hm1)
+          ((k21, v21) : (k22, v22) : toList hm2)
       = go tl1 tl2
     go [] [] = True
     go _  _  = False
@@ -349,11 +354,12 @@ cmp cmpk cmpv t1 t2 = go (toList' t1 []) (toList' t2 [])
       = compare k1 k2 `mappend`
         leafCompare l1 l2 `mappend`
         go tl1 tl2
-    go (Collision h1 l11 l12 hm1 : tl1) (Collision h2 l21 l22 hm2 : tl2)
+    go (Collision h1 (L k11 v11) (L k12 v12) hm1 : tl1) (Collision h2 (L k21 v21) (L k22 v22) hm2 : tl2)
       = compare h1 h2 `mappend`
-        leafCompare l11 l21 `mappend`
-        leafCompare l12 l22 `mappend`
-        go (toList' hm1 []) (toList' hm2 []) `mappend`
+        compare (length hm1) (length hm2) `mappend`
+        unorderedCompare (\(k1, v1) (k2, v2) -> (k1 `cmpk` k2) `mappend` (v1 `cmpv` v2))
+          ((k11, v11) : (k12, v12) : toList hm1)
+          ((k21, v21) : (k22, v22) : toList hm2) `mappend`
         go tl1 tl2
     go (Leaf _ _ : _) (Collision _ _ _ _ : _) = LT
     go (Collision _ _ _ _ : _) (Leaf _ _ : _) = GT
@@ -371,11 +377,12 @@ equalKeys1 eq t1 t2 = go (toList' t1 []) (toList' t2 [])
     go (Leaf k1 l1 : tl1) (Leaf k2 l2 : tl2)
       | k1 == k2 && leafEq l1 l2
       = go tl1 tl2
-    go (Collision h1 l11 l12 hm1 : tl1) (Collision h2 l21 l22 hm2 : tl2)
+    go (Collision h1 (L k11 _) (L k12 _) hm1 : tl1) (Collision h2 (L k21 _) (L k22 _) hm2 : tl2)
       | h1 == h2 &&
-        leafEq l11 l21 &&
-        leafEq l12 l22 &&
-        go (toList' hm1 []) (toList' hm2 [])
+        (length hm1 == length hm2) &&
+        isPermutationBy eq
+          (k11 : k12 : keys hm1)
+          (k21 : k22 : keys hm2)
       = go tl1 tl2
     go [] [] = True
     go _  _  = False
@@ -392,11 +399,12 @@ equalKeys = go
       = bm1 == bm2 && A.sameArray1 go ary1 ary2
     go (Leaf h1 l1) (Leaf h2 l2) = h1 == h2 && leafEq l1 l2
     go (Full ary1) (Full ary2) = A.sameArray1 go ary1 ary2
-    go (Collision h1 l11 l12 hm1) (Collision h2 l21 l22 hm2)
+    go (Collision h1 (L k11 _) (L k12 _) hm1) (Collision h2 (L k21 _) (L k22 _) hm2)
       = h1 == h2 &&
-        leafEq l11 l21 &&
-        leafEq l12 l22 &&
-        go hm1 hm2
+        (length hm1 == length hm2) &&
+        isPermutationBy (==)
+          (k11 : k12 : keys hm1)
+          (k21 : k22 : keys hm2)
     go _ _ = False
 
     leafEq (L k1 _) (L k2 _) = k1 == k2

From f5bbe44abbca5e31eb4748453a3f02222c51e7a1 Mon Sep 17 00:00:00 2001
From: Tom Sydney Kerckhove <syd@fpcomplete.com>
Date: Mon, 15 Oct 2018 07:22:58 +0200
Subject: [PATCH 33/69] Fixed the hashing

---
 Data/HashMap/Base.hs        | 25 +++++++++++++++++--------
 Data/HashMap/Strict/Base.hs |  2 +-
 2 files changed, 18 insertions(+), 9 deletions(-)

diff --git a/Data/HashMap/Base.hs b/Data/HashMap/Base.hs
index 16a75fa7..fe115927 100644
--- a/Data/HashMap/Base.hs
+++ b/Data/HashMap/Base.hs
@@ -419,11 +419,15 @@ instance H.Hashable2 HashMap where
           = s `hashLeafWithSalt` l `go` tl
         -- For collisions we hashmix hash value
         -- and then array of values' hashes sorted
-        go s (Collision h l1 l2 hm' : tl)
-          = (((s `H.hashWithSalt` h) `hashLeafWithSalt` l1 `hashLeafWithSalt` l2)
-             `go` (toList' hm' [])) `go` tl
+        go s (Collision _ l1 l2 hm' : tl)
+          = collisionHash l1 l2 hm' s `go` tl
         go s (_ : tl) = s `go` tl
 
+        collisionHash (L k1 v1) (L k2 v2) hm' s
+                = L.foldl' H.hashWithSalt s
+                $ L.sort . L.map (\(k, v) -> (s `hk` k) `hv` v)
+                $ (k1, v1) : (k2, v2) : toList hm'
+
         -- hashLeafWithSalt :: Int -> Leaf k v -> Int
         hashLeafWithSalt s (L k v) = (s `hk` k) `hv` v
 
@@ -440,20 +444,25 @@ instance (Hashable k, Hashable v) => Hashable (HashMap k v) where
           = s `hashLeafWithSalt` l `go` tl
         -- For collisions we hashmix hash value
         -- and then array of values' hashes sorted
-        go s (Collision h l1 l2 hm' : tl)
-          = (((s `H.hashWithSalt` h) `hashLeafWithSalt` l1 `hashLeafWithSalt` l2)
-             `go` (toList' hm' [])) `go` tl
+        go s (Collision _ l1 l2 hm' : tl)
+          = collisionHash l1 l2 hm' s `go` tl
         go s (_ : tl) = s `go` tl
 
+        collisionHash :: Leaf k v -> Leaf k v -> HashMap k v -> Int -> Int
+        collisionHash (L k1 v1) (L k2 v2) hm' s
+                = L.foldl' H.hashWithSalt s
+                $ L.sort . L.map (H.hashWithSalt s)
+                $ (k1, v1) : (k2, v2) : toList hm'
+
         hashLeafWithSalt :: Int -> Leaf k v -> Int
         hashLeafWithSalt s (L k v) = s `H.hashWithSalt` k `H.hashWithSalt` v
 
-  -- Helper to get 'Leaf's as a list.
+  -- Helper to get 'Leaf's as a list, leave collisions as-is.
 toList' :: HashMap k v -> [HashMap k v] -> [HashMap k v]
 toList' (BitmapIndexed _ ary)   a = A.foldr toList' a ary
 toList' (Full ary)              a = A.foldr toList' a ary
 toList' l@(Leaf _ _)            a = l : a
-toList' (Collision h l1 l2 hm)  a = (Leaf h l1) : (Leaf h l2) : toList' hm a
+toList' (Collision h l1 l2 hm)  a = Collision h l1 l2 hm : a
 toList' Empty                   a = a
 
 -- Helper function to detect 'Leaf's and 'Collision's.
diff --git a/Data/HashMap/Strict/Base.hs b/Data/HashMap/Strict/Base.hs
index 005c7ae5..aa7c6fab 100644
--- a/Data/HashMap/Strict/Base.hs
+++ b/Data/HashMap/Strict/Base.hs
@@ -217,7 +217,7 @@ unsafeInsertWith f k0 v0 m0 = runST (go h0 s0 k0 v0 0 m0)
         A.unsafeUpdateM ary i st'
         return t
       where i = index h bs
-    go h s k x bs t@(Collision hx l1@(L k1 v1) l2@(L k2 v2) hm)
+    go h s k x bs t@(Collision hx l1@(L k1 _) l2@(L k2 _) hm)
         | h == hx   =
           let go'
                 | k == k1   = return $! Collision hx (L k x) l2 hm

From 0a7b81c0bb4c1695576b4795a343422bb40b9330 Mon Sep 17 00:00:00 2001
From: Tom Sydney Kerckhove <syd@fpcomplete.com>
Date: Mon, 15 Oct 2018 07:42:13 +0200
Subject: [PATCH 34/69] Strictness seems to have been fixed

---
 Data/HashMap/Strict/Base.hs | 25 +++++++++++++------------
 1 file changed, 13 insertions(+), 12 deletions(-)

diff --git a/Data/HashMap/Strict/Base.hs b/Data/HashMap/Strict/Base.hs
index aa7c6fab..40331d00 100644
--- a/Data/HashMap/Strict/Base.hs
+++ b/Data/HashMap/Strict/Base.hs
@@ -153,10 +153,10 @@ insertWith f k0 v0 m0 = go h0 s0 k0 v0 0 m0
     h0 = hashWithSalt s0 k0
     s0 = defaultSalt
     go !h _ !k x !_ Empty = leaf h k x
-    go h s k x bs (Leaf hy l@(L ky y))
+    go h s k x bs (Leaf hy lf@(L ky y))
         | hy == h = if ky == k
                     then leaf h k (f x y)
-                    else x `seq` (collision h s l (L k x))
+                    else collision h s lf (l k x)
         | otherwise = x `seq` runST (two bs h k x hy ky y)
     go h s k x bs (BitmapIndexed b ary)
         | b .&. m == 0 =
@@ -178,8 +178,8 @@ insertWith f k0 v0 m0 = go h0 s0 k0 v0 0 m0
     go h s k x bs t@(Collision hx l1@(L k1 v1) l2@(L k2 v2) hm)
         | h == hx   =
            let go'
-                 | k == k1   = Collision hx (L k $! f x v1) l2 hm
-                 | k == k2   = Collision hx l1 (L k $! f x v2) hm
+                 | k == k1   = Collision hx (l k (f x v1)) l2 hm
+                 | k == k2   = Collision hx l1 (l k (f x v2)) hm
                  | otherwise = Collision hx l1 l2 $ go (hashWithSalt (nextSalt s) k) (nextSalt s) k x 0 hm
            in go'
         | otherwise = go h s k x bs $ BitmapIndexed (mask hx bs) (A.singleton t)
@@ -193,12 +193,10 @@ unsafeInsertWith f k0 v0 m0 = runST (go h0 s0 k0 v0 0 m0)
     h0 = hashWithSalt s0 k0
     s0 = defaultSalt
     go !h !_ !k x !_ Empty = return $! leaf h k x
-    go h s k x bs (Leaf hy l@(L ky y))
+    go h s k x bs (Leaf hy lf@(L ky y))
         | hy == h = if ky == k
                     then return $! leaf h k (f x y)
-                    else do
-                        let l' = x `seq` (L k x)
-                        return $! collision h s l l'
+                    else return $! collision h s lf (l k x)
         | otherwise = x `seq` two bs h k x hy ky y
     go h s k x bs t@(BitmapIndexed b ary)
         | b .&. m == 0 = do
@@ -217,11 +215,11 @@ unsafeInsertWith f k0 v0 m0 = runST (go h0 s0 k0 v0 0 m0)
         A.unsafeUpdateM ary i st'
         return t
       where i = index h bs
-    go h s k x bs t@(Collision hx l1@(L k1 _) l2@(L k2 _) hm)
+    go h s k x bs t@(Collision hx l1@(L k1 v1) l2@(L k2 v2) hm)
         | h == hx   =
           let go'
-                | k == k1   = return $! Collision hx (L k x) l2 hm
-                | k == k2   = return $! Collision hx l1 (L k x) hm
+                | k == k1   = return $! Collision hx (l k (f x v1)) l2 hm
+                | k == k2   = return $! Collision hx l1 (l k (f x v2)) hm
                 | otherwise = Collision hx l1 l2 <$> go (hashWithSalt (nextSalt s) k) (nextSalt s) k x 0 hm
           in go'
         | otherwise = go h s k x bs $ BitmapIndexed (mask hx bs) (A.singleton t)
@@ -649,5 +647,8 @@ fromListWith f = L.foldl' (\ m (k, v) -> unsafeInsertWith f k v m) empty
 -- inserted into the constructor.
 
 leaf :: Hash -> k -> v -> HashMap k v
-leaf h k = \ !v -> Leaf h (L k v)
+leaf h k = \ !v -> Leaf h (l k v)
+
+l :: k -> v -> Leaf k v
+l k = \ !v -> L k v
 {-# INLINE leaf #-}

From 4e6e23d39597537a823037f0220a0f3dbda8f239 Mon Sep 17 00:00:00 2001
From: Tom Sydney Kerckhove <syd@fpcomplete.com>
Date: Mon, 15 Oct 2018 07:48:09 +0200
Subject: [PATCH 35/69] All tests seem to have been fixed now

---
 Data/HashMap/Base.hs | 6 ++++--
 1 file changed, 4 insertions(+), 2 deletions(-)

diff --git a/Data/HashMap/Base.hs b/Data/HashMap/Base.hs
index fe115927..f11ffda9 100644
--- a/Data/HashMap/Base.hs
+++ b/Data/HashMap/Base.hs
@@ -1815,7 +1815,7 @@ unConsA ary = case A.length ary of
     Full ary' -> case unConsA ary' of
         WasEmpty -> WasEmpty -- That would be weird, but fine.
         NowEmpty l -> NowEmpty l
-        UnConsed l a' -> UnConsed l (A.singleton (Full a')) -- 'Full' seems wrong
+        UnConsed l a' -> UnConsed l (A.singleton (Full a')) -- TODO 'Full' seems wrong
     Collision h l1 l2 hm -> UnConsed l1 $ A.singleton $ case unConsHM hm of
       Nothing -> Leaf h l2
       Just (l3, hm') -> Collision h l2 l3 hm'
@@ -1823,7 +1823,9 @@ unConsA ary = case A.length ary of
   where
     goA ix = case unConsHM $ A.index ary ix of
       Nothing -> goA $ ix + 1 -- TODO this is probably problematic when the entire array only houses Empty hashmaps
-      Just (l, hm') -> UnConsed l $ A.update ary ix hm'
+      Just (l, hm') -> case hm' of
+        Empty -> UnConsed l $ A.delete ary ix
+        _ -> UnConsed l $ A.update ary ix hm'
 
 data UnCons k v
   = WasEmpty

From 6810a2972eb31ed9c26d95b87ea2775f83be7ab7 Mon Sep 17 00:00:00 2001
From: Tom Sydney Kerckhove <syd@fpcomplete.com>
Date: Mon, 15 Oct 2018 08:03:16 +0200
Subject: [PATCH 36/69] Refactored lookupRes

---
 Data/HashMap/Base.hs        | 28 ++++++++++++++--------------
 Data/HashMap/Strict/Base.hs |  6 +++---
 2 files changed, 17 insertions(+), 17 deletions(-)

diff --git a/Data/HashMap/Base.hs b/Data/HashMap/Base.hs
index f11ffda9..e6372581 100644
--- a/Data/HashMap/Base.hs
+++ b/Data/HashMap/Base.hs
@@ -152,7 +152,7 @@ import qualified Data.Hashable.Lifted as H
 #endif
 
 #if __GLASGOW_HASKELL__ >= 802
-import GHC.Exts (TYPE, Int (..), Int#)
+import GHC.Exts (TYPE)
 #endif
 
 #if MIN_VERSION_base(4,8,0)
@@ -521,7 +521,7 @@ lookup k m = case lookup# k m of
 {-# INLINE lookup #-}
 
 lookup# :: (Eq k, Hashable k) => k -> HashMap k v -> (# (# #) | v #)
-lookup# k m = lookupCont (\_ -> (# (# #) | #)) (\v _i -> (# | v #)) (hashWithSalt defaultSalt k) defaultSalt k m
+lookup# k m = lookupCont (\_ -> (# (# #) | #)) (\v -> (# | v #)) (hashWithSalt defaultSalt k) defaultSalt k m
 {-# INLINABLE lookup# #-}
 
 #else
@@ -542,7 +542,7 @@ lookup' :: (Eq k, Hashable k) => Hash -> Salt -> k -> HashMap k v -> Maybe v
 -- code.
 lookup' h s k m = case lookupRecordCollision# h s k m of
   (# (# #) | #) -> Nothing
-  (# | (# a, _i #) #) -> Just a
+  (# | a #) -> Just a
 {-# INLINE lookup' #-}
 #else
 lookup' h s k m = lookupCont (\_ -> Nothing) (\v _i -> Just v) h s k m
@@ -551,7 +551,7 @@ lookup' h s k m = lookupCont (\_ -> Nothing) (\v _i -> Just v) h s k m
 
 -- The result of a lookup, keeping track of if a hash collision occured.
 -- If a collision did not occur then it will have the Int value (-1).
-data LookupRes a = Absent | Present a !Int
+data LookupRes a = Absent | Present a
 
 -- Internal helper for lookup. This version takes the precomputed hash so
 -- that functions that make multiple calls to lookup and related functions
@@ -570,7 +570,7 @@ lookupRecordCollision :: (Eq k, Hashable k) => Hash -> Salt -> k -> HashMap k v
 #if __GLASGOW_HASKELL__ >= 802
 lookupRecordCollision h s k m = case lookupRecordCollision# h s k m of
   (# (# #) | #) -> Absent
-  (# | (# a, i #) #) -> Present a (I# i) -- GHC will eliminate the I#
+  (# | a #) -> Present a
 {-# INLINE lookupRecordCollision #-}
 
 -- Why do we produce an Int# instead of an Int? Unfortunately, GHC is not
@@ -578,9 +578,9 @@ lookupRecordCollision h s k m = case lookupRecordCollision# h s k m of
 -- may be changing in GHC 8.6 or so (there is some work in progress), but
 -- for now we use Int# explicitly here. We don't need to push the Int#
 -- into lookupCont because inlining takes care of that.
-lookupRecordCollision# :: (Eq k, Hashable k) => Hash -> Salt -> k -> HashMap k v -> (# (# #) | (# v, Int# #) #)
+lookupRecordCollision# :: (Eq k, Hashable k) => Hash -> Salt -> k -> HashMap k v -> (# (# #) | v #)
 lookupRecordCollision# h s k m =
-    lookupCont (\_ -> (# (# #) | #)) (\v (I# i) -> (# | (# v, i #) #)) h s k m
+    lookupCont (\_ -> (# (# #) | #)) (\v -> (# | v #)) h s k m
 -- INLINABLE to specialize to the Eq instance.
 {-# INLINABLE lookupRecordCollision# #-}
 
@@ -606,7 +606,7 @@ lookupCont ::
 #endif
      (Eq k, Hashable k)
   => ((# #) -> r)    -- Absent continuation
-  -> (v -> Int -> r) -- Present continuation
+  -> (v -> r) -- Present continuation
   -> Hash -- The hash of the key
   -> Salt -- The salt that was used to obtain that hash
   -> k -> HashMap k v -> r
@@ -615,7 +615,7 @@ lookupCont absent present !h0 !s0 !k0 !m0 = go h0 s0 k0 0 m0
     go :: Eq k => Hash -> Salt -> k -> Int -> HashMap k v -> r
     go !_ !_ !_ !_ Empty = absent (# #)
     go h _ k _ (Leaf hx (L kx x))
-        | h == hx && k == kx = present x (-1)
+        | h == hx && k == kx = present x
         | otherwise          = absent (# #)
     go h s k bs (BitmapIndexed b v)
         | b .&. m == 0 = absent (# #)
@@ -626,8 +626,8 @@ lookupCont absent present !h0 !s0 !k0 !m0 = go h0 s0 k0 0 m0
       go h s k (bs+bitsPerSubkey) (A.index v (index h bs))
     go h s k _ (Collision hx (L k1 v1) (L k2 v2) hmx)
         | h == hx   = case () of
-          ()    | k == k1   -> present v1 (-1)
-                | k == k2   -> present v2 (-1)
+          ()    | k == k1   -> present v1
+                | k == k2   -> present v2
                 | otherwise -> go (hashWithSalt (nextSalt s) k) (nextSalt s) k 0 hmx
         | otherwise = absent (# #)
 {-# INLINE lookupCont #-}
@@ -1284,7 +1284,7 @@ alterFEager f !k m = (<$> f mv) $ \fres ->
       Absent -> m
 
       -- Key did exist
-      Present _ _ -> deleteKeyExists h s k m
+      Present _ -> deleteKeyExists h s k m
 
     ------------------------------
     -- Update value
@@ -1294,7 +1294,7 @@ alterFEager f !k m = (<$> f mv) $ \fres ->
       Absent -> insertNewKey h s k v' m
 
       -- Key existed before
-      Present v _ ->
+      Present v ->
         if v `ptrEq` v'
         -- If the value is identical, no-op
         then m
@@ -1306,7 +1306,7 @@ alterFEager f !k m = (<$> f mv) $ \fres ->
         !lookupRes = lookupRecordCollision h s k m
         !mv = case lookupRes of
            Absent -> Nothing
-           Present v _ -> Just v
+           Present v -> Just v
 {-# INLINABLE alterFEager #-}
 #endif
 
diff --git a/Data/HashMap/Strict/Base.hs b/Data/HashMap/Strict/Base.hs
index 40331d00..55efc28c 100644
--- a/Data/HashMap/Strict/Base.hs
+++ b/Data/HashMap/Strict/Base.hs
@@ -378,7 +378,7 @@ alterFEager f !k !m = (<$> f mv) $ \fres ->
       Absent -> m
 
       -- Key did exist, no collision
-      Present _ _ -> deleteKeyExists h s k m
+      Present _ -> deleteKeyExists h s k m
 
     ------------------------------
     -- Update value
@@ -388,7 +388,7 @@ alterFEager f !k !m = (<$> f mv) $ \fres ->
       Absent -> insertNewKey h s k v' m
 
       -- Key existed before, no hash collision
-      Present v _ -> v' `seq`
+      Present v -> v' `seq`
         if v `ptrEq` v'
         -- If the value is identical, no-op
         then m
@@ -400,7 +400,7 @@ alterFEager f !k !m = (<$> f mv) $ \fres ->
         !lookupRes = lookupRecordCollision h s k m
         !mv = case lookupRes of
           Absent -> Nothing
-          Present v _ -> Just v
+          Present v -> Just v
 {-# INLINABLE alterFEager #-}
 #endif
 

From 5dd6dd2066aaebe5e023c7e0446009061f6c643d Mon Sep 17 00:00:00 2001
From: Tom Sydney Kerckhove <syd@fpcomplete.com>
Date: Wed, 17 Oct 2018 09:42:49 +0200
Subject: [PATCH 37/69] Dealth with some review comments

---
 Data/HashMap/Base.hs        | 56 +++++++++++++++++--------------------
 Data/HashMap/Strict/Base.hs |  2 +-
 2 files changed, 26 insertions(+), 32 deletions(-)

diff --git a/Data/HashMap/Base.hs b/Data/HashMap/Base.hs
index e6372581..4a434cf9 100644
--- a/Data/HashMap/Base.hs
+++ b/Data/HashMap/Base.hs
@@ -100,7 +100,7 @@ module Data.HashMap.Base
     , filterMapAux
     , equalKeys
     , equalKeys1
-    , lookupRecordCollision
+    , lookupWithRes
     , LookupRes(..)
     , insert'
     , delete'
@@ -540,7 +540,7 @@ lookup' :: (Eq k, Hashable k) => Hash -> Salt -> k -> HashMap k v -> Maybe v
 -- lookup' would probably prefer to be implemented in terms of its own
 -- lookup'#, but it's not important enough and we don't want too much
 -- code.
-lookup' h s k m = case lookupRecordCollision# h s k m of
+lookup' h s k m = case lookupWithRes# h s k m of
   (# (# #) | #) -> Nothing
   (# | a #) -> Just a
 {-# INLINE lookup' #-}
@@ -564,34 +564,33 @@ data LookupRes a = Absent | Present a
 --
 -- Outcomes:
 --   Key not in map           => Absent
---   Key in map, no collision => Present v (-1)
---   Key in map, collision    => Present v position
-lookupRecordCollision :: (Eq k, Hashable k) => Hash -> Salt -> k -> HashMap k v -> LookupRes v
+--   Key in map               => Present v
+--
+-- TODO(syd): We could add some optimisation here where we optimise for the common case
+-- where a collision is in the first two elements and not in the recursive HashMap.
+-- This could mean turning 'Present a' into 'Present a ColPos' with
+-- 'data ColPos = NoCollision | CollisionFirst | CollisionSecond | CollisionRest'
+lookupWithRes :: (Eq k, Hashable k) => Hash -> Salt -> k -> HashMap k v -> LookupRes v
 #if __GLASGOW_HASKELL__ >= 802
-lookupRecordCollision h s k m = case lookupRecordCollision# h s k m of
+lookupWithRes h s k m = case lookupWithRes# h s k m of
   (# (# #) | #) -> Absent
   (# | a #) -> Present a
-{-# INLINE lookupRecordCollision #-}
-
--- Why do we produce an Int# instead of an Int? Unfortunately, GHC is not
--- yet any good at unboxing things *inside* products, let alone sums. That
--- may be changing in GHC 8.6 or so (there is some work in progress), but
--- for now we use Int# explicitly here. We don't need to push the Int#
--- into lookupCont because inlining takes care of that.
-lookupRecordCollision# :: (Eq k, Hashable k) => Hash -> Salt -> k -> HashMap k v -> (# (# #) | v #)
-lookupRecordCollision# h s k m =
+{-# INLINE lookupWithRes #-}
+
+lookupWithRes# :: (Eq k, Hashable k) => Hash -> Salt -> k -> HashMap k v -> (# (# #) | v #)
+lookupWithRes# h s k m =
     lookupCont (\_ -> (# (# #) | #)) (\v -> (# | v #)) h s k m
 -- INLINABLE to specialize to the Eq instance.
-{-# INLINABLE lookupRecordCollision# #-}
+{-# INLINABLE lookupWithRes# #-}
 
 #else /* GHC < 8.2 so there are no unboxed sums */
 
-lookupRecordCollision h s k m = lookupCont (\_ -> Absent) Present h s k m
-{-# INLINABLE lookupRecordCollision #-}
+lookupWithRes h s k m = lookupCont (\_ -> Absent) Present h s k m
+{-# INLINABLE lookupWithRes #-}
 #endif
 
--- A two-continuation version of lookupRecordCollision. This lets us
--- share source code between lookup and lookupRecordCollision without
+-- A two-continuation version of lookupWithRes. This lets us
+-- share source code between lookup and lookupWithRes without
 -- risking any performance degradation.
 --
 -- The absent continuation has type @((# #) -> r)@ instead of just @r@
@@ -687,7 +686,7 @@ insert' :: (Eq k, Hashable k) => Hash -> Salt -> k -> v -> HashMap k v -> HashMa
 insert' h0 s0 k0 v0 m0 = go h0 s0 k0 v0 0 m0
   where
     go :: (Eq k, Hashable k) => Hash -> Salt -> k -> v -> Int -> HashMap k v -> HashMap k v
-    go !h _ !k x !_ Empty = Leaf h (L k x)
+    go !h !_ !k x !_ Empty = Leaf h (L k x)
     go h s k x bs t@(Leaf hy l@(L ky y))
         | hy == h = if ky == k
                     then if x `ptrEq` y
@@ -784,15 +783,10 @@ insertKeyExists !h0 !s0 !k0 x0 !m0 = go h0 s0 k0 x0 0 m0
             !st' = go h s k x (bs+bitsPerSubkey) st
         in Full (update16 ary i st')
       where i = index h bs
-    go h s k x bs t@(Collision hx l1@(L k1 v1) l2@(L k2 v2) hmx)
-        | h == hx   =
-          let go'
-                | k == k1   = if x `ptrEq` v1 then t else Collision hx (L k x) l2 hmx
-                | k == k2   = if x `ptrEq` v2 then t else Collision hx l1 (L k x) hmx
-                | otherwise = Collision hx l1 l2 $ go (hashWithSalt (nextSalt s) k) (nextSalt s) k x 0 hmx
-          in go'
-        | otherwise =
-            go h s k x bs $ BitmapIndexed (mask hx bs) (A.singleton t)
+    go _ s k x _ t@(Collision hx l1@(L k1 v1) l2@(L k2 v2) hmx)
+        | k == k1   = if x `ptrEq` v1 then t else Collision hx (L k x) l2 hmx
+        | k == k2   = if x `ptrEq` v2 then t else Collision hx l1 (L k x) hmx
+        | otherwise = Collision hx l1 l2 $ go (hashWithSalt (nextSalt s) k) (nextSalt s) k x 0 hmx
     go _ _ _ _ _ Empty = Empty -- error "Internal error: go Empty"
 
 {-# NOINLINE insertKeyExists #-}
@@ -1303,7 +1297,7 @@ alterFEager f !k m = (<$> f mv) $ \fres ->
 
   where !h = hashWithSalt s k
         !s = defaultSalt
-        !lookupRes = lookupRecordCollision h s k m
+        !lookupRes = lookupWithRes h s k m
         !mv = case lookupRes of
            Absent -> Nothing
            Present v -> Just v
diff --git a/Data/HashMap/Strict/Base.hs b/Data/HashMap/Strict/Base.hs
index 55efc28c..f22d7ccc 100644
--- a/Data/HashMap/Strict/Base.hs
+++ b/Data/HashMap/Strict/Base.hs
@@ -397,7 +397,7 @@ alterFEager f !k !m = (<$> f mv) $ \fres ->
 
   where !h = hashWithSalt s k
         !s = defaultSalt
-        !lookupRes = lookupRecordCollision h s k m
+        !lookupRes = lookupWithRes h s k m
         !mv = case lookupRes of
           Absent -> Nothing
           Present v -> Just v

From 87de07591b93dee87f7ce61593abdaf7dbe039fe Mon Sep 17 00:00:00 2001
From: Tom Sydney Kerckhove <syd@fpcomplete.com>
Date: Thu, 18 Oct 2018 11:43:17 +0200
Subject: [PATCH 38/69] Fixed most comments

---
 Data/HashMap/Base.hs | 27 ++++++++++++---------------
 Data/HashSet/Base.hs |  2 +-
 2 files changed, 13 insertions(+), 16 deletions(-)

diff --git a/Data/HashMap/Base.hs b/Data/HashMap/Base.hs
index 4a434cf9..40dec09a 100644
--- a/Data/HashMap/Base.hs
+++ b/Data/HashMap/Base.hs
@@ -277,17 +277,17 @@ instance Traversable (HashMap k) where
 instance Eq2 HashMap where
     liftEq2 = equal2
 
-instance Eq k => Eq1 (HashMap k) where
+instance (Eq k, Hashable k) => Eq1 (HashMap k) where
     liftEq = equal1
 #endif
 
-instance (Eq k, Eq v) => Eq (HashMap k v) where
+instance (Eq k, Hashable k, Eq v) => Eq (HashMap k v) where
     (==) = equal1 (==)
 
 -- We rely on there being no Empty constructors in the tree!
 -- This ensures that two equal HashMaps will have the same
 -- shape, modulo the order of entries in Collisions.
-equal1 :: Eq k
+equal1 :: (Eq k, Hashable k)
        => (v -> v' -> Bool)
        -> HashMap k v -> HashMap k v' -> Bool
 equal1 eq = go
@@ -297,11 +297,9 @@ equal1 eq = go
       = bm1 == bm2 && A.sameArray1 go ary1 ary2
     go (Leaf h1 l1) (Leaf h2 l2) = h1 == h2 && leafEq l1 l2
     go (Full ary1) (Full ary2) = A.sameArray1 go ary1 ary2
-    go (Collision h1 (L k11 v11) (L k12 v12) hm1) (Collision h2 (L k21 v21) (L k22 v22) hm2)
-      = h1 == h2
-      && isPermutationBy (\(k1, v1) (k2, v2) -> k1 == k2 && eq v1 v2)
-           ((k11, v11) : (k12, v12) : toList hm1)
-           ((k21, v21) : (k22, v22) : toList hm2)
+    go t1@(Collision h1 _ _ _) t2@(Collision h2 _ _ _) = h1 == h2 &&
+         size t1 == size t2
+         && foldrWithKey (\k v r -> maybe False (eq v) (lookup k t2) && r) True t1
     go _ _ = False
 
     leafEq (L k1 v1) (L k2 v2) = k1 == k2 && eq v1 v2
@@ -334,7 +332,7 @@ equal2 eqk eqv t1 t2 = go (toList' t1 []) (toList' t2 [])
 instance Ord2 HashMap where
     liftCompare2 = cmp
 
-instance Ord k => Ord1 (HashMap k) where
+instance (Ord k, Hashable k) => Ord1 (HashMap k) where
     liftCompare = cmp compare
 #endif
 
@@ -343,7 +341,7 @@ instance Ord k => Ord1 (HashMap k) where
 -- /Note:/ Because the hash is not guaranteed to be stable across library
 -- versions, OSes, or architectures, neither is an actual order of elements in
 -- 'HashMap' or an result of `compare`.is stable.
-instance (Ord k, Ord v) => Ord (HashMap k v) where
+instance (Ord k, Hashable k, Ord v) => Ord (HashMap k v) where
     compare = cmp compare compare
 
 cmp :: (k -> k' -> Ordering) -> (v -> v' -> Ordering)
@@ -467,9 +465,9 @@ toList' Empty                   a = a
 
 -- Helper function to detect 'Leaf's and 'Collision's.
 isLeafOrCollision :: HashMap k v -> Bool
-isLeafOrCollision (Leaf _ _)          = True
-isLeafOrCollision (Collision _ _ _ _) = True
-isLeafOrCollision _                   = False
+isLeafOrCollision (Leaf {})      = True
+isLeafOrCollision (Collision {}) = True
+isLeafOrCollision _              = False
 
 ------------------------------------------------------------------------
 -- * Construction
@@ -498,7 +496,7 @@ size t = go t 0
     go (Leaf _ _)            n = n + 1
     go (BitmapIndexed _ ary) n = A.foldl' (flip go) n ary
     go (Full ary)            n = A.foldl' (flip go) n ary
-    go (Collision _ _ _ hm)  n = go hm n + 2
+    go (Collision _ _ _ hm)  n = go hm (n + 2)
 
 -- | /O(log n)/ Return 'True' if the specified key is present in the
 -- map, 'False' otherwise.
@@ -1798,7 +1796,6 @@ updateOrConcatWithKey f ary1 ary2 = A.run $ do
 -- Remove (any) one element from an array of hashmaps
 unConsA :: A.Array (HashMap k v) -> UnCons k v
 unConsA ary = case A.length ary of
-  0 -> WasEmpty
   1 -> case A.index ary 0 of
     Empty -> WasEmpty -- That would be weird, but fine.
     Leaf _ l -> NowEmpty l
diff --git a/Data/HashSet/Base.hs b/Data/HashSet/Base.hs
index 09294203..bbc37744 100644
--- a/Data/HashSet/Base.hs
+++ b/Data/HashSet/Base.hs
@@ -128,7 +128,7 @@ instance Eq1 HashSet where
     liftEq eq (HashSet a) (HashSet b) = equalKeys1 eq a b
 #endif
 
-instance (Ord a) => Ord (HashSet a) where
+instance (Ord a, Hashable a) => Ord (HashSet a) where
     compare (HashSet a) (HashSet b) = compare a b
     {-# INLINE compare #-}
 

From 4360a4bc0215f2b5f3a24e38b9f7c98932f4a97e Mon Sep 17 00:00:00 2001
From: Tom Sydney Kerckhove <syd@fpcomplete.com>
Date: Thu, 18 Oct 2018 15:24:31 +0200
Subject: [PATCH 39/69] Sped up equalKeys for collisions

---
 Data/HashMap/Base.hs | 15 +++++++--------
 1 file changed, 7 insertions(+), 8 deletions(-)

diff --git a/Data/HashMap/Base.hs b/Data/HashMap/Base.hs
index 40dec09a..9940949d 100644
--- a/Data/HashMap/Base.hs
+++ b/Data/HashMap/Base.hs
@@ -297,8 +297,9 @@ equal1 eq = go
       = bm1 == bm2 && A.sameArray1 go ary1 ary2
     go (Leaf h1 l1) (Leaf h2 l2) = h1 == h2 && leafEq l1 l2
     go (Full ary1) (Full ary2) = A.sameArray1 go ary1 ary2
-    go t1@(Collision h1 _ _ _) t2@(Collision h2 _ _ _) = h1 == h2 &&
-         size t1 == size t2
+    go t1@(Collision h1 _ _ _) t2@(Collision h2 _ _ _) =
+         h1 == h2
+         && size t1 == size t2
          && foldrWithKey (\k v r -> maybe False (eq v) (lookup k t2) && r) True t1
     go _ _ = False
 
@@ -397,12 +398,10 @@ equalKeys = go
       = bm1 == bm2 && A.sameArray1 go ary1 ary2
     go (Leaf h1 l1) (Leaf h2 l2) = h1 == h2 && leafEq l1 l2
     go (Full ary1) (Full ary2) = A.sameArray1 go ary1 ary2
-    go (Collision h1 (L k11 _) (L k12 _) hm1) (Collision h2 (L k21 _) (L k22 _) hm2)
-      = h1 == h2 &&
-        (length hm1 == length hm2) &&
-        isPermutationBy (==)
-          (k11 : k12 : keys hm1)
-          (k21 : k22 : keys hm2)
+    go t1@(Collision h1 _ _ _) t2@(Collision h2 _ _ _)
+      = h1 == h2
+        && size t1 == size t2
+        && L.foldr (\k r -> (k `elem` (keys t2)) && r) True (keys t1)
     go _ _ = False
 
     leafEq (L k1 _) (L k2 _) = k1 == k2

From 9403284d7cba45d6415dbdd7b7cd25f4188ca42e Mon Sep 17 00:00:00 2001
From: Tom Sydney Kerckhove <syd@fpcomplete.com>
Date: Fri, 19 Oct 2018 10:16:50 +0200
Subject: [PATCH 40/69] First draft of validity-based testing

---
 Data/HashMap/Array.hs      |   4 +
 Data/HashMap/Base.hs       |  62 +++++++-
 tests/Validity.hs          | 302 +++++++++++++++++++++++++++++++++++++
 unordered-containers.cabal |  49 +++++-
 4 files changed, 412 insertions(+), 5 deletions(-)
 create mode 100644 tests/Validity.hs

diff --git a/Data/HashMap/Array.hs b/Data/HashMap/Array.hs
index 0149da4d..7b8fab78 100644
--- a/Data/HashMap/Array.hs
+++ b/Data/HashMap/Array.hs
@@ -85,6 +85,7 @@ import GHC.Exts (Array#, newArray#, readArray#, writeArray#,
 import qualified Prelude
 #endif
 
+import Data.Validity
 import Data.HashMap.Unsafe (runST)
 import Control.Monad ((>=>))
 
@@ -178,6 +179,9 @@ data Array a = Array {
       unArray :: !(Array# a)
     }
 
+instance Validity a => Validity (Array a) where
+    validate a = annotate (toList a) "The array elements"
+
 instance Show a => Show (Array a) where
     show = show . toList
 
diff --git a/Data/HashMap/Base.hs b/Data/HashMap/Base.hs
index 9940949d..bcdd47dc 100644
--- a/Data/HashMap/Base.hs
+++ b/Data/HashMap/Base.hs
@@ -128,6 +128,7 @@ import Data.Bits ((.&.), (.|.), complement, popCount)
 import Data.Data hiding (Typeable)
 import qualified Data.Foldable as Foldable
 import qualified Data.List as L
+import Data.Validity
 import GHC.Exts ((==#), build, reallyUnsafePtrEquality#)
 import Prelude hiding (filter, foldr, lookup, map, null, pred)
 import Text.Read hiding (step)
@@ -169,7 +170,13 @@ hashWithSalt :: H.Hashable a => Salt -> a -> Hash
 hashWithSalt s v = fromIntegral $ H.hashWithSalt s v
 
 data Leaf k v = L !k v
-  deriving (Eq)
+  deriving (Show, Eq)
+
+instance (Validity k, Validity v) => Validity (Leaf k v) where
+    validate (L k v) = mconcat
+        [ annotate k "key"
+        , annotate v "value"
+        ]
 
 instance (NFData k, NFData v) => NFData (Leaf k v) where
     rnf (L k v) = rnf k `seq` rnf v
@@ -189,6 +196,59 @@ data HashMap k v
 
 type role HashMap nominal representational
 
+-- TODO
+-- * The keys do hash to the hash they should
+--   * In Collision
+--   * In Collision's recursive hashmap
+-- * Validate the array structure too
+instance (Hashable k, Validity k, Validity v) => Validity (HashMap k v) where
+    validate = go defaultSalt
+      where
+        go s hm = case hm of
+            Empty -> mempty
+            (Leaf h l@(L k _)) -> mconcat
+                [ annotate h "Hash"
+                , annotate l "Leaf"
+                , check (hashWithSalt s k == h) "The hash is correct."
+                ]
+            (BitmapIndexed bm a) -> mconcat
+                [ annotate bm "Bitmap"
+                , decorate "Array" $ decorateList (A.toList a) $ go s
+                , check (A.length a == popCount bm)
+                  "Within 'BitmapIndexed' are values in the array equal to popCount bm."
+                ]
+            (Full a) -> mconcat
+                [ decorate "Array" $ decorateList (A.toList a) $ go s
+                , check (A.length a == 2 ^ bitsPerSubkey)
+                  "Within 'Full' are 2 ^ bitsPerSubkey values in the array."
+                ]
+            (Collision h l1 l2 hm') -> mconcat
+                [ annotate h "Hash"
+                , annotate l1 "The first collision"
+                , annotate l2 "The second collision"
+                , decorate "The recursive HashMap" $ go (nextSalt s) hm'
+                ]
+
+#if !MIN_VERSION_validity(0,6,0)
+-- | Decorate a validation with a location
+decorate :: String -> Validation -> Validation
+decorate = flip annotateValidation
+
+annotateValidation :: Validation -> String -> Validation
+annotateValidation val s =
+    case val of
+      Validation errs -> Validation $ L.map (Location s) errs
+#endif
+
+#if !MIN_VERSION_validity(0,8,0)
+-- | Decorate a piecewise validation of a list with their location in the list
+decorateList :: [a] -> (a -> Validation) -> Validation
+decorateList as func = mconcat $
+    flip L.map (zip [0..] as) $ \(i, a) ->
+        decorate (unwords ["The element at index", show (i :: Integer), "in the list"]) $
+        func a
+#endif
+
 instance (NFData k, NFData v) => NFData (HashMap k v) where
     rnf Empty                   = ()
     rnf (BitmapIndexed _ ary)   = rnf ary
diff --git a/tests/Validity.hs b/tests/Validity.hs
new file mode 100644
index 00000000..d01d7767
--- /dev/null
+++ b/tests/Validity.hs
@@ -0,0 +1,302 @@
+{-# LANGUAGE CPP #-}
+{-# LANGUAGE DeriveGeneric #-}
+{-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE FlexibleInstances #-}
+{-# LANGUAGE GeneralizedNewtypeDeriving #-}
+{-# OPTIONS_GHC -fno-warn-orphans #-}
+
+module Main (main) where
+
+import GHC.Generics (Generic)
+
+import Data.Bits (popCount)
+import Control.Monad (replicateM)
+import Data.Hashable (Hashable(hashWithSalt))
+#if defined(STRICT)
+import qualified Data.HashMap.Strict as HM
+#else
+import qualified Data.HashMap.Lazy as HM
+import qualified Data.HashMap.Base as HM
+#endif
+import Data.HashMap.Base (HashMap(..), Leaf(..))
+import qualified Data.HashMap.Base as HM (defaultSalt, hashWithSalt, nextSalt)
+import qualified Data.HashMap.Array as A
+
+import Data.Validity (Validity)
+import Data.GenValidity (GenUnchecked(..), GenValid(..), genSplit, genSplit4)
+import Test.Validity (producesValidsOnValids, producesValidsOnValids2, producesValidsOnValids3, genGeneratesValid)
+import Test.QuickCheck (Arbitrary, CoArbitrary, Function, Property, Gen, sized, oneof, resize, scale)
+import Test.Framework(Test, defaultMain, testGroup)
+import Test.Framework.Providers.QuickCheck2 (testProperty)
+import Test.QuickCheck.Function (Fun, apply, applyFun2, applyFun3)
+
+instance (GenUnchecked k, GenUnchecked v) => GenUnchecked (Leaf k v) where
+    genUnchecked = sized $ \n -> do
+      (a, b) <- genSplit n
+      k <- resize a genUnchecked
+      v <- resize b genUnchecked
+      pure $ L k v
+    shrinkUnchecked (L k v) = [L k' v' | (k', v') <- shrinkUnchecked (k, v)]
+
+instance (GenValid k, GenValid v) => GenValid (Leaf k v) where
+    genValid = sized $ \n -> do
+      (a, b) <- genSplit n
+      k <- resize a genValid
+      v <- resize b genValid
+      pure $ L k v
+
+instance GenUnchecked a => GenUnchecked (A.Array a) where
+    genUnchecked = do
+      l <- genUnchecked
+      pure $ A.fromList (length l) l
+    shrinkUnchecked _ = [] -- TODO: whrite shrinking
+
+instance GenValid a => GenValid (A.Array a) where
+    genValid = do
+      l <- genValid
+      pure $ A.fromList (length l) l
+
+instance (GenUnchecked k, GenUnchecked v) => GenUnchecked (HashMap k v) where
+    genUnchecked = sized $ \n -> case n of
+      0 -> pure Empty
+      _ -> oneof
+        [ do
+            (a, b) <- genSplit n
+            BitmapIndexed
+              <$> resize a genUnchecked
+              <*> resize b genUnchecked
+        , do
+            (a, b) <- genSplit n
+            Leaf
+              <$> resize a genUnchecked
+              <*> resize b genUnchecked
+        , Full <$> genUnchecked
+        , do
+            (a,b,c,d) <- genSplit4 n
+            Collision
+              <$> resize a genUnchecked
+              <*> resize b genUnchecked
+              <*> resize c genUnchecked
+              <*> resize d genUnchecked
+        ]
+    shrinkUnchecked _ = [] -- TODO: write shrinking
+
+instance (Hashable k, GenValid k, GenValid v) => GenValid (HashMap k v) where
+    genValid = go HM.defaultSalt
+      where
+        go s = sized $ \n -> case n of
+          0 -> pure Empty
+          _ -> oneof
+            [ do
+                (a, b) <- genSplit n
+                k <- resize a genValid
+                v <- resize b genValid
+                pure $ Leaf (HM.hashWithSalt s k) (L k v)
+            , do
+                bm <- genValid
+                let pc = popCount bm
+                values <- replicateM pc $ scale (`div` pc) $ go s -- TODO Redistribute size better.
+                pure $ BitmapIndexed bm $ A.fromList pc values
+            , do
+                let l = 2 ^ (4 :: Int) -- 4 == bitsPerSubkey
+                values <- replicateM l $ scale (`div` l) $ go s -- TODO Redistribute size better.
+                pure $ Full $ A.fromList l values
+            , do
+                (a,b,c,d) <- genSplit4 n
+                hm' <- resize d $ go (HM.nextSalt s)
+                Collision
+                  <$> resize a genValid
+                  <*> resize b genValid
+                  <*> resize c genValid
+                  <*> pure hm'
+            ]
+
+-- Key type that generates more hash collisions.
+newtype Key = K
+    { unK :: Int }
+    deriving (Arbitrary, CoArbitrary, Validity, GenUnchecked, GenValid, Eq, Ord, Read, Show, Generic)
+
+instance Hashable Key where
+    hashWithSalt salt k = hashWithSalt salt (unK k) `mod` 20
+
+instance Function Key
+
+pSingleton :: Property
+pSingleton = producesValidsOnValids2 (HM.singleton :: Key -> Int -> HM.HashMap Key Int)
+
+pNull :: Property
+pNull = producesValidsOnValids (HM.null :: HM.HashMap Key Int -> Bool)
+
+pSize :: Property
+pSize = producesValidsOnValids (HM.size :: HM.HashMap Key Int -> Int)
+
+pMember :: Property
+pMember = producesValidsOnValids2 (HM.member :: Key -> HM.HashMap Key Int -> Bool)
+
+pLookup :: Property
+pLookup = producesValidsOnValids2 (HM.lookup :: Key -> HM.HashMap Key Int -> Maybe Int)
+
+pLookupDefault :: Property
+pLookupDefault = producesValidsOnValids3 (HM.lookupDefault :: Int -> Key -> HM.HashMap Key Int -> Int)
+
+pInsert :: Property
+pInsert = producesValidsOnValids3 (HM.insert :: Key -> Int -> HM.HashMap Key Int -> HM.HashMap Key Int)
+
+pInsertWith :: Property
+pInsertWith = producesValidsOnValids3 (HM.insertWith (+) :: Key -> Int -> HM.HashMap Key Int -> HM.HashMap Key Int)
+
+pDelete :: Property
+pDelete = producesValidsOnValids2 (HM.delete :: Key -> HM.HashMap Key Int -> HM.HashMap Key Int)
+
+pAdjust :: Fun Int Int -> Property
+pAdjust f = producesValidsOnValids2 (HM.adjust (apply f) :: Key -> HM.HashMap Key Int -> HM.HashMap Key Int)
+
+pUpdate :: (Fun Int (Maybe Int)) -> Property
+pUpdate f = producesValidsOnValids2 (HM.update (apply f) :: Key -> HM.HashMap Key Int -> HM.HashMap Key Int)
+
+pAlter :: Property
+pAlter = producesValidsOnValids2 (HM.alter (fmap succ) :: Key -> HM.HashMap Key Int -> HM.HashMap Key Int)
+
+pAlterF :: Fun (Maybe Int) [Maybe Int] -> Property
+pAlterF f = producesValidsOnValids2 (HM.alterF (apply f) :: Key -> HM.HashMap Key Int -> [HM.HashMap Key Int])
+
+pUnion :: Property
+pUnion = producesValidsOnValids2 (HM.union :: HashMap Key Int -> HashMap Key Int -> HashMap Key Int)
+
+pUnionWith :: Fun (Int, Int) Int -> Property
+pUnionWith f = producesValidsOnValids2 (HM.unionWith (applyFun2 f) :: HashMap Key Int -> HashMap Key Int -> HashMap Key Int)
+
+pUnionWithKey :: Fun (Key, Int, Int) Int -> Property
+pUnionWithKey f = producesValidsOnValids2 (HM.unionWithKey (applyFun3 f) :: HashMap Key Int -> HashMap Key Int -> HashMap Key Int)
+
+pUnions :: Property
+pUnions = producesValidsOnValids (HM.unions :: [HashMap Key Int] -> HashMap Key Int)
+
+pMap :: Fun Int Int -> Property
+pMap f = producesValidsOnValids (HM.map (apply f) :: HashMap Key Int -> HashMap Key Int)
+
+pMapWithKey :: Fun (Key, Int) Int -> Property
+pMapWithKey f = producesValidsOnValids (HM.mapWithKey (applyFun2 f) :: HashMap Key Int -> HashMap Key Int)
+
+pTraverseWithKey :: Fun (Key, Int) (Maybe Int) -> Property
+pTraverseWithKey f = producesValidsOnValids (HM.traverseWithKey (applyFun2 f) :: HashMap Key Int -> Maybe (HashMap Key Int))
+
+pDifference :: Property
+pDifference = producesValidsOnValids2 (HM.difference :: HashMap Key Int -> HashMap Key Int -> HashMap Key Int)
+
+pDifferenceWith :: Fun (Int, Int) (Maybe Int) -> Property
+pDifferenceWith f = producesValidsOnValids2 (HM.differenceWith (applyFun2 f) :: HashMap Key Int -> HashMap Key Int -> HashMap Key Int)
+
+pIntersection :: Property
+pIntersection = producesValidsOnValids2 (HM.intersection :: HashMap Key Int -> HashMap Key Int -> HashMap Key Int)
+
+pIntersectionWith :: Fun (Int, Int) Int -> Property
+pIntersectionWith f = producesValidsOnValids2 (HM.intersectionWith (applyFun2 f) :: HashMap Key Int -> HashMap \
+  Key Int -> HashMap Key Int)
+
+pIntersectionWithKey :: Fun (Key, Int, Int) Int -> Property
+pIntersectionWithKey f = producesValidsOnValids2 (HM.intersectionWithKey (applyFun3 f) :: HashMap Key Int -> HashMap Key Int -> HashMap Key Int)
+
+pFoldl' :: Fun (Word, Int) Word -> Property
+pFoldl' f = producesValidsOnValids2 (HM.foldl' (applyFun2 f) :: Word -> HashMap Key Int -> Word)
+
+pFoldlWithKey' :: Fun (Word, Key, Int) Word -> Property
+pFoldlWithKey' f = producesValidsOnValids2 (HM.foldlWithKey' (applyFun3 f) :: Word -> HashMap Key Int -> Word)
+
+pFoldr :: Fun (Int, Word) Word -> Property
+pFoldr f = producesValidsOnValids2 (HM.foldr (applyFun2 f) :: Word -> HashMap Key Int -> Word)
+
+pFoldrWithKey :: Fun (Key, Int, Word) Word -> Property
+pFoldrWithKey f = producesValidsOnValids2 (HM.foldrWithKey (applyFun3 f) :: Word -> HashMap Key Int -> Word)
+
+pFilter :: Fun Int Bool -> Property
+pFilter f = producesValidsOnValids (HM.filter (apply f) :: HashMap Key Int -> HashMap Key Int)
+
+pFilterWithKey :: Fun (Key, Int) Bool -> Property
+pFilterWithKey f = producesValidsOnValids (HM.filterWithKey (applyFun2 f) :: HashMap Key Int -> HashMap Key Int)
+
+pMapMaybe :: Fun Int (Maybe Int) -> Property
+pMapMaybe f = producesValidsOnValids (HM.mapMaybe (apply f) :: HashMap Key Int -> HashMap Key Int)
+
+pMapMaybeWithKey :: Fun (Key, Int) (Maybe Int) -> Property
+pMapMaybeWithKey f = producesValidsOnValids (HM.mapMaybeWithKey (applyFun2 f) :: HashMap Key Int -> HashMap Key Int)
+
+pKeys :: Property
+pKeys = producesValidsOnValids (HM.keys :: HashMap Key Int -> [Key])
+
+pElems :: Property
+pElems = producesValidsOnValids (HM.elems :: HashMap Key Int -> [Int])
+
+pToList :: Property
+pToList = producesValidsOnValids (HM.toList :: HashMap Key Int -> [(Key, Int)])
+
+pFromList :: Property
+pFromList = producesValidsOnValids (HM.fromList :: [(Key, Int)] -> HashMap Key Int)
+
+pFromListWith :: Fun (Int, Int) Int -> Property
+pFromListWith f = producesValidsOnValids (HM.fromListWith (applyFun2 f) :: [(Key, Int)] -> HashMap Key Int)
+
+
+------------------------------------------------------------------------
+-- * Test list
+
+tests :: [Test]
+tests =
+    [
+    -- Basic interface
+      testGroup "HashMap"
+      [ testProperty "genValid generates valid values for Leaf" $
+        genGeneratesValid (genValid :: Gen (Leaf Key Int)) shrinkValid
+      , testProperty "genValid generates valid values for Array" $
+        genGeneratesValid (genValid :: Gen (A.Array Key)) shrinkValid
+      , testProperty "genValid generates valid values for HashMap" $
+        genGeneratesValid (genValid :: Gen (HashMap Key Int)) shrinkValid
+      ]
+    , testGroup "HashMap"
+      [ testProperty "singleton produces valid HashMaps" pSingleton
+      , testProperty "null produces valid Bools" pNull
+      , testProperty "size produces valid HashMaps" pSize
+      , testProperty "member produces valid HashMaps" pMember
+      , testProperty "lookup produces valid HashMaps" pLookup
+      , testProperty "lookupDefault produces valid HashMaps" pLookupDefault
+      , testProperty "insert produces valid HashMaps" pInsert
+      , testProperty "insertWith produces valid HashMaps" pInsertWith
+      , testProperty "delete produces valid HashMaps" pDelete
+      , testProperty "adjust produces valid HashMaps" pAdjust
+      , testProperty "update produces valid HashMaps" pUpdate
+      , testProperty "alter produces valid HashMaps" pAlter
+      , testProperty "alterF produces valid HashMaps" pAlterF
+      , testProperty "union produces valid HashMaps" pUnion
+      , testProperty "unionWith produces valid HashMaps" pUnionWith
+      , testProperty "unionWithKey produces valid HashMaps" pUnionWithKey
+      , testProperty "unions produces valid HashMaps" pUnions
+      , testProperty "map produces valid HashMaps" pMap
+      , testProperty "mapWithKey produces valid HashMaps" pMapWithKey
+      , testProperty "traverseWithKey produces valid HashMaps" pTraverseWithKey
+      , testProperty "difference produces valid HashMaps" pDifference
+      , testProperty "differenceWith produces valid HashMaps" pDifferenceWith
+      , testProperty "intersection produces valid HashMaps" pIntersection
+      , testProperty "intersectionWith produces valid HashMaps" pIntersectionWith
+      , testProperty "intersectionWithKey produces valid HashMaps" pIntersectionWithKey
+      , testProperty "foldl' produces valid HashMaps" pFoldl'
+      , testProperty "foldlWithKey' produces valid HashMaps" pFoldlWithKey'
+      , testProperty "foldr produces valid HashMaps" pFoldr
+      , testProperty "foldrWithKey produces valid HashMaps" pFoldrWithKey
+      , testProperty "filter produces valid HashMaps" pFilter
+      , testProperty "filterWithKey produces valid HashMaps" pFilterWithKey
+      , testProperty "mapMaybe produces valid HashMaps" pMapMaybe
+      , testProperty "mapMaybeWithKey produces valid HashMaps" pMapMaybeWithKey
+      , testProperty "keys produces valid lists" pKeys
+      , testProperty "elems produces valid lists" pElems
+      , testProperty "toList produces valid lists" pToList
+      , testProperty "fromList produces valid HashMaps" pFromList
+      , testProperty "fromListWith produces valid HashMaps" pFromListWith
+      ]
+    ]
+-- TODO keysSet
+
+------------------------------------------------------------------------
+-- * Test harness
+
+main :: IO ()
+main = defaultMain tests
diff --git a/unordered-containers.cabal b/unordered-containers.cabal
index 95f84581..7c36f1b6 100644
--- a/unordered-containers.cabal
+++ b/unordered-containers.cabal
@@ -28,13 +28,13 @@ flag debug
 
 library
   exposed-modules:
+    Data.HashMap.Array
+    Data.HashMap.Base
     Data.HashMap.Lazy
     Data.HashMap.Strict
+    Data.HashMap.Strict.Base
     Data.HashSet
   other-modules:
-    Data.HashMap.Array
-    Data.HashMap.Base
-    Data.HashMap.Strict.Base
     Data.HashMap.List
     Data.HashMap.Unsafe
     Data.HashMap.UnsafeShift
@@ -43,7 +43,8 @@ library
   build-depends:
     base >= 4.7 && < 5,
     deepseq >= 1.1,
-    hashable >= 1.0.1.1 && < 1.3
+    hashable >= 1.0.1.1 && < 1.3,
+    validity >= 0.4
 
   default-language: Haskell2010
 
@@ -64,6 +65,46 @@ library
   if flag(debug)
     cpp-options: -DASSERTS
 
+test-suite validity-lazy
+  hs-source-dirs: tests
+  main-is: Validity.hs
+  type: exitcode-stdio-1.0
+
+  build-depends:
+    base,
+    hashable >= 1.0.1.1,
+    QuickCheck >= 2.4.0.1,
+    test-framework >= 0.3.3,
+    test-framework-quickcheck2 >= 0.2.9,
+    validity,
+    genvalidity,
+    genvalidity-hspec,
+    unordered-containers
+
+  default-language: Haskell2010
+  ghc-options: -Wall
+  cpp-options: -DASSERTS
+
+test-suite validity-strict
+  hs-source-dirs: tests
+  main-is: Validity.hs
+  type: exitcode-stdio-1.0
+
+  build-depends:
+    base,
+    hashable >= 1.0.1.1,
+    QuickCheck >= 2.4.0.1,
+    test-framework >= 0.3.3,
+    test-framework-quickcheck2 >= 0.2.9,
+    validity,
+    genvalidity,
+    genvalidity-hspec,
+    unordered-containers
+
+  default-language: Haskell2010
+  ghc-options: -Wall
+  cpp-options: -DASSERTS -DSTRICT
+
 test-suite hashmap-lazy-properties
   hs-source-dirs: tests
   main-is: HashMapProperties.hs

From 6d16ceb47ef5ebc505128d4b7e1fd650806de140 Mon Sep 17 00:00:00 2001
From: Tom Sydney Kerckhove <syd@fpcomplete.com>
Date: Fri, 19 Oct 2018 10:21:09 +0200
Subject: [PATCH 41/69] Moved the validity dependency out of the library

---
 Data/HashMap/Array.hs      |  4 ---
 Data/HashMap/Base.hs       | 60 --------------------------------------
 tests/Validity.hs          | 60 +++++++++++++++++++++++++++++++++++++-
 unordered-containers.cabal |  3 +-
 4 files changed, 60 insertions(+), 67 deletions(-)

diff --git a/Data/HashMap/Array.hs b/Data/HashMap/Array.hs
index 7b8fab78..0149da4d 100644
--- a/Data/HashMap/Array.hs
+++ b/Data/HashMap/Array.hs
@@ -85,7 +85,6 @@ import GHC.Exts (Array#, newArray#, readArray#, writeArray#,
 import qualified Prelude
 #endif
 
-import Data.Validity
 import Data.HashMap.Unsafe (runST)
 import Control.Monad ((>=>))
 
@@ -179,9 +178,6 @@ data Array a = Array {
       unArray :: !(Array# a)
     }
 
-instance Validity a => Validity (Array a) where
-    validate a = annotate (toList a) "The array elements"
-
 instance Show a => Show (Array a) where
     show = show . toList
 
diff --git a/Data/HashMap/Base.hs b/Data/HashMap/Base.hs
index bcdd47dc..d4142097 100644
--- a/Data/HashMap/Base.hs
+++ b/Data/HashMap/Base.hs
@@ -128,7 +128,6 @@ import Data.Bits ((.&.), (.|.), complement, popCount)
 import Data.Data hiding (Typeable)
 import qualified Data.Foldable as Foldable
 import qualified Data.List as L
-import Data.Validity
 import GHC.Exts ((==#), build, reallyUnsafePtrEquality#)
 import Prelude hiding (filter, foldr, lookup, map, null, pred)
 import Text.Read hiding (step)
@@ -172,12 +171,6 @@ hashWithSalt s v = fromIntegral $ H.hashWithSalt s v
 data Leaf k v = L !k v
   deriving (Show, Eq)
 
-instance (Validity k, Validity v) => Validity (Leaf k v) where
-    validate (L k v) = mconcat
-        [ annotate k "key"
-        , annotate v "value"
-        ]
-
 instance (NFData k, NFData v) => NFData (Leaf k v) where
     rnf (L k v) = rnf k `seq` rnf v
 
@@ -196,59 +189,6 @@ data HashMap k v
 
 type role HashMap nominal representational
 
--- TODO
--- * The keys do hash to the hash they should
---   * In Collision
---   * In Collision's recursive hashmap
--- * Validate the array structure too
-instance (Hashable k, Validity k, Validity v) => Validity (HashMap k v) where
-    validate = go defaultSalt
-      where
-        go s hm = case hm of
-            Empty -> mempty
-            (Leaf h l@(L k _)) -> mconcat
-                [ annotate h "Hash"
-                , annotate l "Leaf"
-                , check (hashWithSalt s k == h) "The hash is correct."
-                ]
-            (BitmapIndexed bm a) -> mconcat
-                [ annotate bm "Bitmap"
-                , decorate "Array" $ decorateList (A.toList a) $ go s
-                , check (A.length a == popCount bm)
-                  "Within 'BitmapIndexed' are values in the array equal to popCount bm."
-                ]
-            (Full a) -> mconcat
-                [ decorate "Array" $ decorateList (A.toList a) $ go s
-                , check (A.length a == 2 ^ bitsPerSubkey)
-                  "Within 'Full' are 2 ^ bitsPerSubkey values in the array."
-                ]
-            (Collision h l1 l2 hm') -> mconcat
-                [ annotate h "Hash"
-                , annotate l1 "The first collision"
-                , annotate l2 "The second collision"
-                , decorate "The recursive HashMap" $ go (nextSalt s) hm'
-                ]
-
-#if !MIN_VERSION_validity(0,6,0)
--- | Decorate a validation with a location
-decorate :: String -> Validation -> Validation
-decorate = flip annotateValidation
-
-annotateValidation :: Validation -> String -> Validation
-annotateValidation val s =
-    case val of
-      Validation errs -> Validation $ L.map (Location s) errs
-#endif
-
-#if !MIN_VERSION_validity(0,8,0)
--- | Decorate a piecewise validation of a list with their location in the list
-decorateList :: [a] -> (a -> Validation) -> Validation
-decorateList as func = mconcat $
-    flip L.map (zip [0..] as) $ \(i, a) ->
-        decorate (unwords ["The element at index", show (i :: Integer), "in the list"]) $
-        func a
-#endif
-
 instance (NFData k, NFData v) => NFData (HashMap k v) where
     rnf Empty                   = ()
     rnf (BitmapIndexed _ ary)   = rnf ary
diff --git a/tests/Validity.hs b/tests/Validity.hs
index d01d7767..9c1c8b85 100644
--- a/tests/Validity.hs
+++ b/tests/Validity.hs
@@ -9,6 +9,7 @@ module Main (main) where
 
 import GHC.Generics (Generic)
 
+import Data.Validity
 import Data.Bits (popCount)
 import Control.Monad (replicateM)
 import Data.Hashable (Hashable(hashWithSalt))
@@ -19,7 +20,7 @@ import qualified Data.HashMap.Lazy as HM
 import qualified Data.HashMap.Base as HM
 #endif
 import Data.HashMap.Base (HashMap(..), Leaf(..))
-import qualified Data.HashMap.Base as HM (defaultSalt, hashWithSalt, nextSalt)
+import qualified Data.HashMap.Base as HM (defaultSalt, hashWithSalt, nextSalt, bitsPerSubkey)
 import qualified Data.HashMap.Array as A
 
 import Data.Validity (Validity)
@@ -30,6 +31,63 @@ import Test.Framework(Test, defaultMain, testGroup)
 import Test.Framework.Providers.QuickCheck2 (testProperty)
 import Test.QuickCheck.Function (Fun, apply, applyFun2, applyFun3)
 
+instance (Validity k, Validity v) => Validity (Leaf k v) where
+    validate (L k v) = mconcat
+        [ annotate k "key"
+        , annotate v "value"
+        ]
+
+instance Validity a => Validity (A.Array a) where
+    validate a = annotate (A.toList a) "The array elements"
+
+instance (Hashable k, Validity k, Validity v) => Validity (HashMap k v) where
+    validate = go HM.defaultSalt
+      where
+        go s hm = case hm of
+            Empty -> mempty
+            (Leaf h l@(L k _)) -> mconcat
+                [ annotate h "Hash"
+                , annotate l "Leaf"
+                , check (HM.hashWithSalt s k == h) "The hash is correct."
+                ]
+            (BitmapIndexed bm a) -> mconcat
+                [ annotate bm "Bitmap"
+                , decorate "Array" $ decorateList (A.toList a) $ go s
+                , check (A.length a == popCount bm)
+                  "Within 'BitmapIndexed' are values in the array equal to popCount bm."
+                ]
+            (Full a) -> mconcat
+                [ decorate "Array" $ decorateList (A.toList a) $ go s
+                , check (A.length a == 2 ^ HM.bitsPerSubkey)
+                  "Within 'Full' are 2 ^ bitsPerSubkey values in the array."
+                ]
+            (Collision h l1 l2 hm') -> mconcat
+                [ annotate h "Hash"
+                , annotate l1 "The first collision"
+                , annotate l2 "The second collision"
+                , decorate "The recursive HashMap" $ go (HM.nextSalt s) hm'
+                ]
+
+#if !MIN_VERSION_validity(0,6,0)
+-- | Decorate a validation with a location
+decorate :: String -> Validation -> Validation
+decorate = flip annotateValidation
+
+annotateValidation :: Validation -> String -> Validation
+annotateValidation val s =
+    case val of
+      Validation errs -> Validation $ map (Location s) errs
+#endif
+
+#if !MIN_VERSION_validity(0,8,0)
+-- | Decorate a piecewise validation of a list with their location in the list
+decorateList :: [a] -> (a -> Validation) -> Validation
+decorateList as func = mconcat $
+    flip map (zip [0..] as) $ \(i, a) ->
+        decorate (unwords ["The element at index", show (i :: Integer), "in the list"]) $
+        func a
+#endif
+
 instance (GenUnchecked k, GenUnchecked v) => GenUnchecked (Leaf k v) where
     genUnchecked = sized $ \n -> do
       (a, b) <- genSplit n
diff --git a/unordered-containers.cabal b/unordered-containers.cabal
index 7c36f1b6..b5d8eae8 100644
--- a/unordered-containers.cabal
+++ b/unordered-containers.cabal
@@ -43,8 +43,7 @@ library
   build-depends:
     base >= 4.7 && < 5,
     deepseq >= 1.1,
-    hashable >= 1.0.1.1 && < 1.3,
-    validity >= 0.4
+    hashable >= 1.0.1.1 && < 1.3
 
   default-language: Haskell2010
 

From 4e9d582829ca634b3c3694b9f201f11bbde6c762 Mon Sep 17 00:00:00 2001
From: Tom Sydney Kerckhove <syd@fpcomplete.com>
Date: Fri, 19 Oct 2018 12:44:50 +0200
Subject: [PATCH 42/69] More accurate validity

---
 Data/HashMap/Base.hs |   8 ++--
 newer-stack.yaml     |   3 ++
 tests/Validity.hs    | 108 ++++++++++++++++++++++++++++---------------
 3 files changed, 79 insertions(+), 40 deletions(-)
 create mode 100644 newer-stack.yaml

diff --git a/Data/HashMap/Base.hs b/Data/HashMap/Base.hs
index d4142097..100ef07b 100644
--- a/Data/HashMap/Base.hs
+++ b/Data/HashMap/Base.hs
@@ -185,7 +185,7 @@ data HashMap k v
     | Leaf !Hash !(Leaf k v)
     | Full !(A.Array (HashMap k v))
     | Collision !Hash !(Leaf k v) !(Leaf k v) !(HashMap k v)
-      deriving (Typeable)
+      deriving (Typeable, Show)
 
 type role HashMap nominal representational
 
@@ -265,9 +265,9 @@ instance (Eq k, Hashable k, Read k, Read e) => Read (HashMap k e) where
 
     readListPrec = readListPrecDefault
 
-instance (Show k, Show v) => Show (HashMap k v) where
-    showsPrec d m = showParen (d > 10) $
-      showString "fromList " . shows (toList m)
+-- instance (Show k, Show v) => Show (HashMap k v) where
+--     showsPrec d m = showParen (d > 10) $
+--       showString "fromList " . shows (toList m)
 
 instance Traversable (HashMap k) where
     traverse f = traverseWithKey (const f)
diff --git a/newer-stack.yaml b/newer-stack.yaml
new file mode 100644
index 00000000..26f10a32
--- /dev/null
+++ b/newer-stack.yaml
@@ -0,0 +1,3 @@
+resolver: lts-12.12
+packages:
+- .
diff --git a/tests/Validity.hs b/tests/Validity.hs
index 9c1c8b85..5ebd100e 100644
--- a/tests/Validity.hs
+++ b/tests/Validity.hs
@@ -3,6 +3,7 @@
 {-# LANGUAGE FlexibleContexts #-}
 {-# LANGUAGE FlexibleInstances #-}
 {-# LANGUAGE GeneralizedNewtypeDeriving #-}
+{-# LANGUAGE ScopedTypeVariables #-}
 {-# OPTIONS_GHC -fno-warn-orphans #-}
 
 module Main (main) where
@@ -11,13 +12,13 @@ import GHC.Generics (Generic)
 
 import Data.Validity
 import Data.Bits (popCount)
-import Control.Monad (replicateM)
+import Data.List (nub)
+import Control.Monad (foldM)
 import Data.Hashable (Hashable(hashWithSalt))
 #if defined(STRICT)
 import qualified Data.HashMap.Strict as HM
 #else
 import qualified Data.HashMap.Lazy as HM
-import qualified Data.HashMap.Base as HM
 #endif
 import Data.HashMap.Base (HashMap(..), Leaf(..))
 import qualified Data.HashMap.Base as HM (defaultSalt, hashWithSalt, nextSalt, bitsPerSubkey)
@@ -25,8 +26,8 @@ import qualified Data.HashMap.Array as A
 
 import Data.Validity (Validity)
 import Data.GenValidity (GenUnchecked(..), GenValid(..), genSplit, genSplit4)
-import Test.Validity (producesValidsOnValids, producesValidsOnValids2, producesValidsOnValids3, genGeneratesValid)
-import Test.QuickCheck (Arbitrary, CoArbitrary, Function, Property, Gen, sized, oneof, resize, scale)
+import Test.Validity (producesValidsOnValids, producesValidsOnValids2, producesValidsOnValids3, shouldBeValid)
+import Test.QuickCheck (Arbitrary, CoArbitrary, Function, Property, Gen, sized, oneof, resize, scale, suchThat, forAll)
 import Test.Framework(Test, defaultMain, testGroup)
 import Test.Framework.Providers.QuickCheck2 (testProperty)
 import Test.QuickCheck.Function (Fun, apply, applyFun2, applyFun3)
@@ -40,34 +41,44 @@ instance (Validity k, Validity v) => Validity (Leaf k v) where
 instance Validity a => Validity (A.Array a) where
     validate a = annotate (A.toList a) "The array elements"
 
-instance (Hashable k, Validity k, Validity v) => Validity (HashMap k v) where
+instance (Eq k, Hashable k, Validity k, Validity v) => Validity (HashMap k v) where
     validate = go HM.defaultSalt
       where
         go s hm = case hm of
             Empty -> mempty
-            (Leaf h l@(L k _)) -> mconcat
+            (Leaf h l@(L k _)) -> decorate "Leaf" $ mconcat
                 [ annotate h "Hash"
                 , annotate l "Leaf"
                 , check (HM.hashWithSalt s k == h) "The hash is correct."
                 ]
-            (BitmapIndexed bm a) -> mconcat
+            (BitmapIndexed bm a) -> decorate "BitmapIndexed" $ mconcat
                 [ annotate bm "Bitmap"
                 , decorate "Array" $ decorateList (A.toList a) $ go s
                 , check (A.length a == popCount bm)
-                  "Within 'BitmapIndexed' are values in the array equal to popCount bm."
+                  "There are values in the array equal to popCount bm."
+                , check (uniques $ concatMap HM.keys $ A.toList a) "The keys are unique."
                 ]
-            (Full a) -> mconcat
+            (Full a) -> decorate "Full" $ mconcat
                 [ decorate "Array" $ decorateList (A.toList a) $ go s
                 , check (A.length a == 2 ^ HM.bitsPerSubkey)
-                  "Within 'Full' are 2 ^ bitsPerSubkey values in the array."
+                  "There are 2 ^ bitsPerSubkey values in the array."
+                , check (uniques $ concatMap HM.keys $ A.toList a) "The keys are unique."
                 ]
-            (Collision h l1 l2 hm') -> mconcat
+            (Collision h l1@(L k1 _) l2@(L k2 _) hm') -> decorate "Collision" $ mconcat
                 [ annotate h "Hash"
                 , annotate l1 "The first collision"
                 , annotate l2 "The second collision"
+                , check (HM.hashWithSalt s k1 == h) "The hash of the first collision is correct."
+                , check (HM.hashWithSalt s k2 == h) "The hash of the second collision is correct."
+                , check (k1 /= k2) "The keys within the collision are not equal."
+                , check (uniques (k1 : k2 : HM.keys hm')) "The keys are unique."
                 , decorate "The recursive HashMap" $ go (HM.nextSalt s) hm'
+                -- TODO the recursive hashmap has to collide on the current hash too
                 ]
 
+uniques :: Eq a => [a] -> Bool
+uniques l = length (nub l) == length l
+
 #if !MIN_VERSION_validity(0,6,0)
 -- | Decorate a validation with a location
 decorate :: String -> Validation -> Validation
@@ -139,35 +150,58 @@ instance (GenUnchecked k, GenUnchecked v) => GenUnchecked (HashMap k v) where
         ]
     shrinkUnchecked _ = [] -- TODO: write shrinking
 
-instance (Hashable k, GenValid k, GenValid v) => GenValid (HashMap k v) where
-    genValid = go HM.defaultSalt
+instance (Eq k, Hashable k, GenValid k, GenValid v) => GenValid (HashMap k v) where
+    genValid = go [] HM.defaultSalt
       where
-        go s = sized $ \n -> case n of
-          0 -> pure Empty
+        genKey :: [k] -> Gen k
+        genKey keys = genValid `suchThat` (`notElem` keys)
+        genL :: [k] -> Gen (Leaf k v)
+        genL keys = sized $ \n -> do
+          (a, b) <- genSplit n
+          k <- resize a $ genKey keys
+          v <- resize b genValid
+          pure $ L k v
+        genFixedNbOfHms :: Int -> [k] -> Int -> Gen ([k], [HashMap k v])
+        genFixedNbOfHms nb keys s = do
+            let go' :: ([k], [HashMap k v]) -> Int -> Gen ([k], [HashMap k v])
+                go' (ks, hms) _ = do
+                  (ks', hm') <- scale (`div` nb) $ genAndRecordKeys ks s
+                  pure (ks' ++ ks, hm': hms)
+            (keys', values) <- foldM go' (keys, []) [1 .. nb]
+            pure (keys', values)
+        genAndRecordKeys :: [k] -> Int -> Gen ([k], HashMap k v)
+        genAndRecordKeys keys s = sized $ \n -> case n of
+          0 -> pure (keys, Empty)
           _ -> oneof
             [ do
-                (a, b) <- genSplit n
-                k <- resize a genValid
-                v <- resize b genValid
-                pure $ Leaf (HM.hashWithSalt s k) (L k v)
+                l@(L k _) <- genL keys
+                let hm' = Leaf (HM.hashWithSalt s k) l :: HashMap k v
+                pure $ (k : keys, hm')
             , do
-                bm <- genValid
-                let pc = popCount bm
-                values <- replicateM pc $ scale (`div` pc) $ go s -- TODO Redistribute size better.
-                pure $ BitmapIndexed bm $ A.fromList pc values
+                bm <- genValid :: Gen Word
+                let pc = popCount bm :: Int
+                (keys', hms) <- genFixedNbOfHms pc keys s :: Gen ([k], [HashMap k v])
+                let hm' = BitmapIndexed bm $ A.fromList pc hms :: HashMap k v
+                pure (keys', hm')
             , do
                 let l = 2 ^ (4 :: Int) -- 4 == bitsPerSubkey
-                values <- replicateM l $ scale (`div` l) $ go s -- TODO Redistribute size better.
-                pure $ Full $ A.fromList l values
+                (keys', hms) <- genFixedNbOfHms l keys s
+                let hm' = Full $ A.fromList l hms :: HashMap k v
+                pure (keys', hm') :: Gen ([k], HashMap k v)
             , do
-                (a,b,c,d) <- genSplit4 n
-                hm' <- resize d $ go (HM.nextSalt s)
-                Collision
-                  <$> resize a genValid
-                  <*> resize b genValid
-                  <*> resize c genValid
-                  <*> pure hm'
+                (a,b) <- genSplit n
+                (l1@(L k1 _), l2@(L k2 _)) <- resize a $
+                  ((,) <$> genL keys <*> genL keys)
+                  `suchThat`
+                  (\((L k1 _), (L k2 _)) -> HM.hashWithSalt s k1 == HM.hashWithSalt s k2 && k1 /= k2)
+                  -- Note: this can take long for keys that don't have a lot of collisions, so best
+                  -- to only use it with the 'Key' in this module.
+                (keys', hm') <- resize b $ genAndRecordKeys (k1 : k2 : keys) (HM.nextSalt s)
+                pure (keys', Collision (HM.hashWithSalt s k1) l1 l2 hm') :: Gen ([k], HashMap k v)
             ]
+        -- Carry the keys that have already been used, and the salt on the current level.
+        go :: [k] -> Int -> Gen (HashMap k v)
+        go keys s = snd <$> genAndRecordKeys keys s
 
 -- Key type that generates more hash collisions.
 newtype Key = K
@@ -175,7 +209,7 @@ newtype Key = K
     deriving (Arbitrary, CoArbitrary, Validity, GenUnchecked, GenValid, Eq, Ord, Read, Show, Generic)
 
 instance Hashable Key where
-    hashWithSalt salt k = hashWithSalt salt (unK k) `mod` 20
+    hashWithSalt salt k = hashWithSalt salt (unK k) `mod` 10
 
 instance Function Key
 
@@ -300,15 +334,17 @@ pFromListWith f = producesValidsOnValids (HM.fromListWith (applyFun2 f) :: [(Key
 
 tests :: [Test]
 tests =
+  let genValidHelper gen = forAll gen shouldBeValid
+  in
     [
     -- Basic interface
       testGroup "HashMap"
       [ testProperty "genValid generates valid values for Leaf" $
-        genGeneratesValid (genValid :: Gen (Leaf Key Int)) shrinkValid
+        genValidHelper (genValid :: Gen (Leaf Key Int))
       , testProperty "genValid generates valid values for Array" $
-        genGeneratesValid (genValid :: Gen (A.Array Key)) shrinkValid
+        genValidHelper (genValid :: Gen (A.Array Key))
       , testProperty "genValid generates valid values for HashMap" $
-        genGeneratesValid (genValid :: Gen (HashMap Key Int)) shrinkValid
+        genValidHelper (genValid :: Gen (HashMap Key Int))
       ]
     , testGroup "HashMap"
       [ testProperty "singleton produces valid HashMaps" pSingleton

From b190874de01d3fa4c406fcfaf385bcb499660d10 Mon Sep 17 00:00:00 2001
From: Tom Sydney Kerckhove <syd@fpcomplete.com>
Date: Fri, 19 Oct 2018 12:57:56 +0200
Subject: [PATCH 43/69] more accurate validity

---
 tests/Validity.hs | 58 +++++++++++++++++++++++++++--------------------
 1 file changed, 33 insertions(+), 25 deletions(-)

diff --git a/tests/Validity.hs b/tests/Validity.hs
index 5ebd100e..8435aa7c 100644
--- a/tests/Validity.hs
+++ b/tests/Validity.hs
@@ -10,9 +10,10 @@ module Main (main) where
 
 import GHC.Generics (Generic)
 
-import Data.Validity
 import Data.Bits (popCount)
+import Data.Foldable (foldl')
 import Data.List (nub)
+import Data.Validity
 import Control.Monad (foldM)
 import Data.Hashable (Hashable(hashWithSalt))
 #if defined(STRICT)
@@ -20,7 +21,7 @@ import qualified Data.HashMap.Strict as HM
 #else
 import qualified Data.HashMap.Lazy as HM
 #endif
-import Data.HashMap.Base (HashMap(..), Leaf(..))
+import Data.HashMap.Base (HashMap(..), Leaf(..), Salt, Hash)
 import qualified Data.HashMap.Base as HM (defaultSalt, hashWithSalt, nextSalt, bitsPerSubkey)
 import qualified Data.HashMap.Array as A
 
@@ -73,7 +74,8 @@ instance (Eq k, Hashable k, Validity k, Validity v) => Validity (HashMap k v) wh
                 , check (k1 /= k2) "The keys within the collision are not equal."
                 , check (uniques (k1 : k2 : HM.keys hm')) "The keys are unique."
                 , decorate "The recursive HashMap" $ go (HM.nextSalt s) hm'
-                -- TODO the recursive hashmap has to collide on the current hash too
+                , check (all (\k -> HM.hashWithSalt s k == h) (HM.keys hm'))
+                  "All recursive keys hash to the hash within the collision."
                 ]
 
 uniques :: Eq a => [a] -> Bool
@@ -150,58 +152,64 @@ instance (GenUnchecked k, GenUnchecked v) => GenUnchecked (HashMap k v) where
         ]
     shrinkUnchecked _ = [] -- TODO: write shrinking
 
+-- Note: This instance has to generate collisions.
+-- this can take long for keys that don't have a lot of collisions, so best
+-- to only use it with the 'Key' in this module.
 instance (Eq k, Hashable k, GenValid k, GenValid v) => GenValid (HashMap k v) where
-    genValid = go [] HM.defaultSalt
+    genValid = snd <$> genAndRecordKeys [] [] HM.defaultSalt
       where
-        genKey :: [k] -> Gen k
-        genKey keys = genValid `suchThat` (`notElem` keys)
-        genL :: [k] -> Gen (Leaf k v)
-        genL keys = sized $ \n -> do
+        genKey :: [(Salt, Hash)] -> [k] -> Gen k
+        genKey hs keys =
+          foldl'
+            (\g (s,h) -> modGenWith s h g) 
+            (genValid `suchThat` (`notElem` keys))
+            hs
+          where
+            modGenWith :: Salt -> Hash -> Gen k -> Gen k
+            modGenWith s h g = g `suchThat` (\k -> HM.hashWithSalt s k == h)
+        genL :: [(Salt, Hash)] -> [k] -> Gen (Leaf k v)
+        genL hs keys = sized $ \n -> do
           (a, b) <- genSplit n
-          k <- resize a $ genKey keys
+          k <- resize a $ genKey hs keys
           v <- resize b genValid
           pure $ L k v
-        genFixedNbOfHms :: Int -> [k] -> Int -> Gen ([k], [HashMap k v])
-        genFixedNbOfHms nb keys s = do
+        genFixedNbOfHms :: Int -> [(Salt, Hash)] -> [k] -> Salt -> Gen ([k], [HashMap k v])
+        genFixedNbOfHms nb hs keys s = do
             let go' :: ([k], [HashMap k v]) -> Int -> Gen ([k], [HashMap k v])
                 go' (ks, hms) _ = do
-                  (ks', hm') <- scale (`div` nb) $ genAndRecordKeys ks s
+                  (ks', hm') <- scale (`div` nb) $ genAndRecordKeys hs ks s
                   pure (ks' ++ ks, hm': hms)
             (keys', values) <- foldM go' (keys, []) [1 .. nb]
             pure (keys', values)
-        genAndRecordKeys :: [k] -> Int -> Gen ([k], HashMap k v)
-        genAndRecordKeys keys s = sized $ \n -> case n of
+        genAndRecordKeys :: [(Salt, Hash)] -> [k] -> Salt -> Gen ([k], HashMap k v)
+        genAndRecordKeys hs keys s = sized $ \n -> case n of
           0 -> pure (keys, Empty)
           _ -> oneof
             [ do
-                l@(L k _) <- genL keys
+                l@(L k _) <- genL hs keys
                 let hm' = Leaf (HM.hashWithSalt s k) l :: HashMap k v
                 pure $ (k : keys, hm')
             , do
                 bm <- genValid :: Gen Word
                 let pc = popCount bm :: Int
-                (keys', hms) <- genFixedNbOfHms pc keys s :: Gen ([k], [HashMap k v])
+                (keys', hms) <- genFixedNbOfHms pc hs keys s :: Gen ([k], [HashMap k v])
                 let hm' = BitmapIndexed bm $ A.fromList pc hms :: HashMap k v
                 pure (keys', hm')
             , do
                 let l = 2 ^ (4 :: Int) -- 4 == bitsPerSubkey
-                (keys', hms) <- genFixedNbOfHms l keys s
+                (keys', hms) <- genFixedNbOfHms l hs keys s
                 let hm' = Full $ A.fromList l hms :: HashMap k v
                 pure (keys', hm') :: Gen ([k], HashMap k v)
             , do
                 (a,b) <- genSplit n
                 (l1@(L k1 _), l2@(L k2 _)) <- resize a $
-                  ((,) <$> genL keys <*> genL keys)
+                  ((,) <$> genL hs keys <*> genL hs keys)
                   `suchThat`
                   (\((L k1 _), (L k2 _)) -> HM.hashWithSalt s k1 == HM.hashWithSalt s k2 && k1 /= k2)
-                  -- Note: this can take long for keys that don't have a lot of collisions, so best
-                  -- to only use it with the 'Key' in this module.
-                (keys', hm') <- resize b $ genAndRecordKeys (k1 : k2 : keys) (HM.nextSalt s)
-                pure (keys', Collision (HM.hashWithSalt s k1) l1 l2 hm') :: Gen ([k], HashMap k v)
+                let h = HM.hashWithSalt s k1
+                (keys', hm') <- resize b $ genAndRecordKeys ((s, h) : hs) (k1 : k2 : keys) (HM.nextSalt s)
+                pure (keys', Collision h l1 l2 hm') :: Gen ([k], HashMap k v)
             ]
-        -- Carry the keys that have already been used, and the salt on the current level.
-        go :: [k] -> Int -> Gen (HashMap k v)
-        go keys s = snd <$> genAndRecordKeys keys s
 
 -- Key type that generates more hash collisions.
 newtype Key = K

From 04b5ec56965ffcac1ebad1057f2f486b20eee727 Mon Sep 17 00:00:00 2001
From: Tom Sydney Kerckhove <syd@fpcomplete.com>
Date: Fri, 19 Oct 2018 13:13:04 +0200
Subject: [PATCH 44/69] Gave up on trying to write a principled genValid

---
 Data/HashMap/Base.hs |  1 +
 tests/Validity.hs    | 78 ++++++++------------------------------------
 2 files changed, 15 insertions(+), 64 deletions(-)

diff --git a/Data/HashMap/Base.hs b/Data/HashMap/Base.hs
index 100ef07b..3efacfc2 100644
--- a/Data/HashMap/Base.hs
+++ b/Data/HashMap/Base.hs
@@ -179,6 +179,7 @@ instance (NFData k, NFData v) => NFData (Leaf k v) where
 
 -- | A map from keys to values.  A map cannot contain duplicate keys;
 -- each key can map to at most one value.
+-- TODO document all invariants
 data HashMap k v
     = Empty
     | BitmapIndexed !Bitmap !(A.Array (HashMap k v))
diff --git a/tests/Validity.hs b/tests/Validity.hs
index 8435aa7c..63c7eca8 100644
--- a/tests/Validity.hs
+++ b/tests/Validity.hs
@@ -11,24 +11,22 @@ module Main (main) where
 import GHC.Generics (Generic)
 
 import Data.Bits (popCount)
-import Data.Foldable (foldl')
 import Data.List (nub)
 import Data.Validity
-import Control.Monad (foldM)
 import Data.Hashable (Hashable(hashWithSalt))
 #if defined(STRICT)
 import qualified Data.HashMap.Strict as HM
 #else
 import qualified Data.HashMap.Lazy as HM
 #endif
-import Data.HashMap.Base (HashMap(..), Leaf(..), Salt, Hash)
+import Data.HashMap.Base (HashMap(..), Leaf(..))
 import qualified Data.HashMap.Base as HM (defaultSalt, hashWithSalt, nextSalt, bitsPerSubkey)
 import qualified Data.HashMap.Array as A
 
 import Data.Validity (Validity)
 import Data.GenValidity (GenUnchecked(..), GenValid(..), genSplit, genSplit4)
 import Test.Validity (producesValidsOnValids, producesValidsOnValids2, producesValidsOnValids3, shouldBeValid)
-import Test.QuickCheck (Arbitrary, CoArbitrary, Function, Property, Gen, sized, oneof, resize, scale, suchThat, forAll)
+import Test.QuickCheck (Arbitrary, CoArbitrary, Function, Property, Gen, sized, oneof, resize, forAll)
 import Test.Framework(Test, defaultMain, testGroup)
 import Test.Framework.Providers.QuickCheck2 (testProperty)
 import Test.QuickCheck.Function (Fun, apply, applyFun2, applyFun3)
@@ -54,13 +52,19 @@ instance (Eq k, Hashable k, Validity k, Validity v) => Validity (HashMap k v) wh
                 ]
             (BitmapIndexed bm a) -> decorate "BitmapIndexed" $ mconcat
                 [ annotate bm "Bitmap"
-                , decorate "Array" $ decorateList (A.toList a) $ go s
+                , decorate "Array" $ decorateList (A.toList a) $ \hm_ -> mconcat
+                    [ go s hm_
+                    , check (not $ HM.null hm_) "The sub HashMap is not empty"
+                    ]
                 , check (A.length a == popCount bm)
                   "There are values in the array equal to popCount bm."
                 , check (uniques $ concatMap HM.keys $ A.toList a) "The keys are unique."
                 ]
             (Full a) -> decorate "Full" $ mconcat
-                [ decorate "Array" $ decorateList (A.toList a) $ go s
+                [ decorate "Array" $ decorateList (A.toList a) $ \hm_ -> mconcat
+                    [ go s hm_
+                    , check (not $ HM.null hm_) "The sub HashMap is not empty"
+                    ]
                 , check (A.length a == 2 ^ HM.bitsPerSubkey)
                   "There are 2 ^ bitsPerSubkey values in the array."
                 , check (uniques $ concatMap HM.keys $ A.toList a) "The keys are unique."
@@ -152,64 +156,10 @@ instance (GenUnchecked k, GenUnchecked v) => GenUnchecked (HashMap k v) where
         ]
     shrinkUnchecked _ = [] -- TODO: write shrinking
 
--- Note: This instance has to generate collisions.
--- this can take long for keys that don't have a lot of collisions, so best
--- to only use it with the 'Key' in this module.
+-- It turns out it's almost impossible to write this instance without using internals.
+-- This is good-enough for now.
 instance (Eq k, Hashable k, GenValid k, GenValid v) => GenValid (HashMap k v) where
-    genValid = snd <$> genAndRecordKeys [] [] HM.defaultSalt
-      where
-        genKey :: [(Salt, Hash)] -> [k] -> Gen k
-        genKey hs keys =
-          foldl'
-            (\g (s,h) -> modGenWith s h g) 
-            (genValid `suchThat` (`notElem` keys))
-            hs
-          where
-            modGenWith :: Salt -> Hash -> Gen k -> Gen k
-            modGenWith s h g = g `suchThat` (\k -> HM.hashWithSalt s k == h)
-        genL :: [(Salt, Hash)] -> [k] -> Gen (Leaf k v)
-        genL hs keys = sized $ \n -> do
-          (a, b) <- genSplit n
-          k <- resize a $ genKey hs keys
-          v <- resize b genValid
-          pure $ L k v
-        genFixedNbOfHms :: Int -> [(Salt, Hash)] -> [k] -> Salt -> Gen ([k], [HashMap k v])
-        genFixedNbOfHms nb hs keys s = do
-            let go' :: ([k], [HashMap k v]) -> Int -> Gen ([k], [HashMap k v])
-                go' (ks, hms) _ = do
-                  (ks', hm') <- scale (`div` nb) $ genAndRecordKeys hs ks s
-                  pure (ks' ++ ks, hm': hms)
-            (keys', values) <- foldM go' (keys, []) [1 .. nb]
-            pure (keys', values)
-        genAndRecordKeys :: [(Salt, Hash)] -> [k] -> Salt -> Gen ([k], HashMap k v)
-        genAndRecordKeys hs keys s = sized $ \n -> case n of
-          0 -> pure (keys, Empty)
-          _ -> oneof
-            [ do
-                l@(L k _) <- genL hs keys
-                let hm' = Leaf (HM.hashWithSalt s k) l :: HashMap k v
-                pure $ (k : keys, hm')
-            , do
-                bm <- genValid :: Gen Word
-                let pc = popCount bm :: Int
-                (keys', hms) <- genFixedNbOfHms pc hs keys s :: Gen ([k], [HashMap k v])
-                let hm' = BitmapIndexed bm $ A.fromList pc hms :: HashMap k v
-                pure (keys', hm')
-            , do
-                let l = 2 ^ (4 :: Int) -- 4 == bitsPerSubkey
-                (keys', hms) <- genFixedNbOfHms l hs keys s
-                let hm' = Full $ A.fromList l hms :: HashMap k v
-                pure (keys', hm') :: Gen ([k], HashMap k v)
-            , do
-                (a,b) <- genSplit n
-                (l1@(L k1 _), l2@(L k2 _)) <- resize a $
-                  ((,) <$> genL hs keys <*> genL hs keys)
-                  `suchThat`
-                  (\((L k1 _), (L k2 _)) -> HM.hashWithSalt s k1 == HM.hashWithSalt s k2 && k1 /= k2)
-                let h = HM.hashWithSalt s k1
-                (keys', hm') <- resize b $ genAndRecordKeys ((s, h) : hs) (k1 : k2 : keys) (HM.nextSalt s)
-                pure (keys', Collision h l1 l2 hm') :: Gen ([k], HashMap k v)
-            ]
+    genValid = HM.fromList <$> genValid
 
 -- Key type that generates more hash collisions.
 newtype Key = K
@@ -217,7 +167,7 @@ newtype Key = K
     deriving (Arbitrary, CoArbitrary, Validity, GenUnchecked, GenValid, Eq, Ord, Read, Show, Generic)
 
 instance Hashable Key where
-    hashWithSalt salt k = hashWithSalt salt (unK k) `mod` 10
+    hashWithSalt salt k = hashWithSalt salt (unK k) `mod` 4
 
 instance Function Key
 

From d90dc838c7c3a18d90fc4abc58c5f6a994d4967b Mon Sep 17 00:00:00 2001
From: Tom Sydney Kerckhove <syd@fpcomplete.com>
Date: Fri, 19 Oct 2018 13:31:31 +0200
Subject: [PATCH 45/69] Improved shrinking

---
 tests/Validity.hs | 14 ++++++++++++--
 1 file changed, 12 insertions(+), 2 deletions(-)

diff --git a/tests/Validity.hs b/tests/Validity.hs
index 63c7eca8..435cf809 100644
--- a/tests/Validity.hs
+++ b/tests/Validity.hs
@@ -124,7 +124,7 @@ instance GenUnchecked a => GenUnchecked (A.Array a) where
     genUnchecked = do
       l <- genUnchecked
       pure $ A.fromList (length l) l
-    shrinkUnchecked _ = [] -- TODO: whrite shrinking
+    shrinkUnchecked _ = [] -- TODO: write shrinking
 
 instance GenValid a => GenValid (A.Array a) where
     genValid = do
@@ -154,12 +154,22 @@ instance (GenUnchecked k, GenUnchecked v) => GenUnchecked (HashMap k v) where
               <*> resize c genUnchecked
               <*> resize d genUnchecked
         ]
-    shrinkUnchecked _ = [] -- TODO: write shrinking
+    shrinkUnchecked hm = case hm of
+      Empty -> []
+      Leaf h l -> [Leaf h' l' | (h', l') <- shrinkUnchecked (h, l)]
+      BitmapIndexed bm a -> [BitmapIndexed bm' a' | (bm', a') <- shrinkUnchecked (bm, a)]
+      Full a -> Full <$> shrinkUnchecked a
+      Collision h l1 l2 hm_ ->
+        [ Collision h' l1' l2' hm_'
+        | (h', l1', l2', hm_') <- shrinkUnchecked (h, l1, l2, hm_)
+        ]
 
 -- It turns out it's almost impossible to write this instance without using internals.
 -- This is good-enough for now.
 instance (Eq k, Hashable k, GenValid k, GenValid v) => GenValid (HashMap k v) where
     genValid = HM.fromList <$> genValid
+    shrinkValid hm = HM.fromList <$> shrinkValid (HM.toList hm)
+      -- TODO improve the shrinking
 
 -- Key type that generates more hash collisions.
 newtype Key = K

From 64c1a0ac14c4444b5c31eed20feaed7ccbc89082 Mon Sep 17 00:00:00 2001
From: Tom Sydney Kerckhove <syd@fpcomplete.com>
Date: Fri, 19 Oct 2018 13:41:57 +0200
Subject: [PATCH 46/69] sick and tired of hashes for a moment

---
 Data/HashMap/Base.hs | 3 ++-
 1 file changed, 2 insertions(+), 1 deletion(-)

diff --git a/Data/HashMap/Base.hs b/Data/HashMap/Base.hs
index 3efacfc2..85cbaa1b 100644
--- a/Data/HashMap/Base.hs
+++ b/Data/HashMap/Base.hs
@@ -1656,7 +1656,7 @@ filterMapAux onLeaf = go
         Nothing -> Leaf h l2'
         Just (Leaf _ l3', hm') -> Collision h l2' l3' hm'
         _ -> error "Should not happen, can be fixed with refactoring I think."
-      (Nothing, Nothing) -> go hm
+      (Nothing, Nothing) -> rehash h $ go hm
       _ -> error "Should not happen, can be fixed with refactoring I think."
       where
         go' hm_ = case unConsHM hm_ of
@@ -1664,6 +1664,7 @@ filterMapAux onLeaf = go
           Just (l, hm_') -> case onLeaf (Leaf h l) of
             Nothing -> go' hm_'
             Just l' -> Just (l', go hm_')
+    rehash = undefined
 
     filterA ary0 b0 =
         let !n = A.length ary0

From b076445d317eed997aea55c7275ae30e0affc0c6 Mon Sep 17 00:00:00 2001
From: Tom Sydney Kerckhove <syd@cs-syd.eu>
Date: Fri, 26 Oct 2018 13:09:07 +0300
Subject: [PATCH 47/69] Failing test case

---
 Data/HashMap/Base.hs |  15 +-
 tests/Validity.hs    | 554 ++++++++++++++++++++++++++++---------------
 2 files changed, 370 insertions(+), 199 deletions(-)

diff --git a/Data/HashMap/Base.hs b/Data/HashMap/Base.hs
index 85cbaa1b..3f515dce 100644
--- a/Data/HashMap/Base.hs
+++ b/Data/HashMap/Base.hs
@@ -109,6 +109,9 @@ module Data.HashMap.Base
     , insertKeyExists
     , deleteKeyExists
     , insertModifying
+    , unConsA
+    , UnCons(..)
+    , unConsHM
     , ptrEq
     , adjust#
     ) where
@@ -1565,7 +1568,7 @@ intersectionWithKey f a b = foldlWithKey' go empty a
 -- | /O(n)/ Reduce this map by applying a binary operator to all
 -- elements, using the given starting value (typically the
 -- left-identity of the operator).  Each application of the operator
--- is evaluated before using the result in the next application. 
+-- is evaluated before using the result in the next application.
 -- This function is strict in the starting value.
 foldl' :: (a -> v -> a) -> a -> HashMap k v -> a
 foldl' f = foldlWithKey' (\ z _ v -> f z v)
@@ -1574,7 +1577,7 @@ foldl' f = foldlWithKey' (\ z _ v -> f z v)
 -- | /O(n)/ Reduce this map by applying a binary operator to all
 -- elements, using the given starting value (typically the
 -- left-identity of the operator).  Each application of the operator
--- is evaluated before using the result in the next application.  
+-- is evaluated before using the result in the next application.
 -- This function is strict in the starting value.
 foldlWithKey' :: (a -> k -> v -> a) -> a -> HashMap k v -> a
 foldlWithKey' f = go
@@ -1664,7 +1667,12 @@ filterMapAux onLeaf = go
           Just (l, hm_') -> case onLeaf (Leaf h l) of
             Nothing -> go' hm_'
             Just l' -> Just (l', go hm_')
-    rehash = undefined
+    rehash h hm = case hm of
+      Empty -> Empty
+      Leaf _ l -> Leaf h l
+      BitmapIndexed b ary -> undefined -- filterA ary b
+      Full ary -> undefined -- filterA ary fullNodeMask
+      Collision h' l1 l2 hm' -> Collision h l1 l2 $ rehash h' hm'
 
     filterA ary0 b0 =
         let !n = A.length ary0
@@ -1823,6 +1831,7 @@ data UnCons k v
   = WasEmpty
   | NowEmpty (Leaf k v)
   | UnConsed (Leaf k v) (A.Array (HashMap k v))
+  deriving (Show)
 
 -- Remove (any) one element from a hashmap
 unConsHM :: HashMap k v -> Maybe (Leaf k v, HashMap k v)
diff --git a/tests/Validity.hs b/tests/Validity.hs
index 435cf809..cff9d4e0 100644
--- a/tests/Validity.hs
+++ b/tests/Validity.hs
@@ -6,85 +6,147 @@
 {-# LANGUAGE ScopedTypeVariables #-}
 {-# OPTIONS_GHC -fno-warn-orphans #-}
 
-module Main (main) where
+module Main
+    ( main
+    ) where
 
 import GHC.Generics (Generic)
 
 import Data.Bits (popCount)
+import Data.Hashable (Hashable(hashWithSalt))
 import Data.List (nub)
 import Data.Validity
-import Data.Hashable (Hashable(hashWithSalt))
 #if defined(STRICT)
 import qualified Data.HashMap.Strict as HM
 #else
 import qualified Data.HashMap.Lazy as HM
 #endif
-import Data.HashMap.Base (HashMap(..), Leaf(..))
-import qualified Data.HashMap.Base as HM (defaultSalt, hashWithSalt, nextSalt, bitsPerSubkey)
 import qualified Data.HashMap.Array as A
+import Data.HashMap.Base (HashMap(..), Leaf(..), UnCons(..))
+import qualified Data.HashMap.Base as HM
+       (bitsPerSubkey, defaultSalt, hashWithSalt, index, mask, nextSalt,
+        sparseIndex, unConsA, unConsHM)
 
+import Data.GenValidity
+       (GenUnchecked(..), GenValid(..), genSplit, genSplit4)
 import Data.Validity (Validity)
-import Data.GenValidity (GenUnchecked(..), GenValid(..), genSplit, genSplit4)
-import Test.Validity (producesValidsOnValids, producesValidsOnValids2, producesValidsOnValids3, shouldBeValid)
-import Test.QuickCheck (Arbitrary, CoArbitrary, Function, Property, Gen, sized, oneof, resize, forAll)
-import Test.Framework(Test, defaultMain, testGroup)
+import Test.Framework (Test, defaultMain, testGroup)
 import Test.Framework.Providers.QuickCheck2 (testProperty)
+import Test.QuickCheck
+       (Arbitrary, CoArbitrary, Function, Gen, Property, forAll, oneof,
+        resize, sized)
 import Test.QuickCheck.Function (Fun, apply, applyFun2, applyFun3)
+import Test.Validity
+       (producesValidsOnValids, producesValidsOnValids2,
+        producesValidsOnValids3, shouldBeValid)
 
 instance (Validity k, Validity v) => Validity (Leaf k v) where
-    validate (L k v) = mconcat
-        [ annotate k "key"
-        , annotate v "value"
-        ]
+    validate (L k v) = mconcat [annotate k "key", annotate v "value"]
 
 instance Validity a => Validity (A.Array a) where
     validate a = annotate (A.toList a) "The array elements"
 
-instance (Eq k, Hashable k, Validity k, Validity v) => Validity (HashMap k v) where
-    validate = go HM.defaultSalt
+instance (Eq k, Hashable k, Validity k, Validity v) => Validity (UnCons k v) where
+    validate WasEmpty = mempty
+    validate (NowEmpty l) = decorate "NowEmpty" $ validate l
+    validate (UnConsed l a) =
+        decorate "UnConsed" $
+        mconcat [decorate "Leaf" $ validate l, decorate "Array" $ validate a]
+
+instance (Eq k, Hashable k, Validity k, Validity v) =>
+         Validity (HashMap k v) where
+    validate = go HM.defaultSalt 0
       where
-        go s hm = case hm of
-            Empty -> mempty
-            (Leaf h l@(L k _)) -> decorate "Leaf" $ mconcat
-                [ annotate h "Hash"
-                , annotate l "Leaf"
-                , check (HM.hashWithSalt s k == h) "The hash is correct."
-                ]
-            (BitmapIndexed bm a) -> decorate "BitmapIndexed" $ mconcat
-                [ annotate bm "Bitmap"
-                , decorate "Array" $ decorateList (A.toList a) $ \hm_ -> mconcat
-                    [ go s hm_
-                    , check (not $ HM.null hm_) "The sub HashMap is not empty"
-                    ]
-                , check (A.length a == popCount bm)
-                  "There are values in the array equal to popCount bm."
-                , check (uniques $ concatMap HM.keys $ A.toList a) "The keys are unique."
-                ]
-            (Full a) -> decorate "Full" $ mconcat
-                [ decorate "Array" $ decorateList (A.toList a) $ \hm_ -> mconcat
-                    [ go s hm_
-                    , check (not $ HM.null hm_) "The sub HashMap is not empty"
-                    ]
-                , check (A.length a == 2 ^ HM.bitsPerSubkey)
-                  "There are 2 ^ bitsPerSubkey values in the array."
-                , check (uniques $ concatMap HM.keys $ A.toList a) "The keys are unique."
-                ]
-            (Collision h l1@(L k1 _) l2@(L k2 _) hm') -> decorate "Collision" $ mconcat
-                [ annotate h "Hash"
-                , annotate l1 "The first collision"
-                , annotate l2 "The second collision"
-                , check (HM.hashWithSalt s k1 == h) "The hash of the first collision is correct."
-                , check (HM.hashWithSalt s k2 == h) "The hash of the second collision is correct."
-                , check (k1 /= k2) "The keys within the collision are not equal."
-                , check (uniques (k1 : k2 : HM.keys hm')) "The keys are unique."
-                , decorate "The recursive HashMap" $ go (HM.nextSalt s) hm'
-                , check (all (\k -> HM.hashWithSalt s k == h) (HM.keys hm'))
-                  "All recursive keys hash to the hash within the collision."
-                ]
+        go s bs hm =
+            case hm of
+                Empty -> mempty
+                (Leaf h l@(L k _)) ->
+                    decorate "Leaf" $
+                    mconcat
+                        [ annotate h "Hash"
+                        , annotate l "Leaf"
+                        , check
+                              (HM.hashWithSalt s k == h)
+                              "The hash is correct."
+                        ]
+                (BitmapIndexed bm a) ->
+                    decorate "BitmapIndexed" $
+                    mconcat
+                        [ annotate bm "Bitmap"
+                        , decorate "Array" $
+                          decorateList (zip [0 ..] $ A.toList a) $ \(ix, hm_) ->
+                              mconcat
+                                  [ go s (bs + HM.bitsPerSubkey) hm_
+                                  , check
+                                        (not $ HM.null hm_)
+                                        "The sub HashMap is not empty"
+                                  , decorateList (HM.keys hm_) $ \k ->
+                                        flip
+                                            check
+                                            "The hash, when masked with the current bitmask, of the key, produces the index in the array where the hashmap is found" $
+                                        let h = HM.hashWithSalt s k
+                                        in HM.sparseIndex bm (HM.mask h bs) ==
+                                           ix
+                                  ]
+                        , check
+                              (A.length a == popCount bm)
+                              "There are values in the array equal to popCount bm."
+                        , check
+                              (uniques $ concatMap HM.keys $ A.toList a)
+                              "The keys are unique."
+                        ]
+                (Full a) ->
+                    decorate "Full" $
+                    mconcat
+                        [ decorate "Array" $
+                          decorateList (zip [0 ..] $ A.toList a) $ \(ix, hm_) ->
+                              mconcat
+                                  [ go s (bs + HM.bitsPerSubkey) hm_
+                                  , check
+                                        (not $ HM.null hm_)
+                                        "The sub HashMap is not empty"
+                                  , decorateList (HM.keys hm_) $ \k ->
+                                        flip
+                                            check
+                                            "The hash, when masked with the current bitmask, of the key, produces the index in the array where the hashmap is found" $
+                                        let h = HM.hashWithSalt s k
+                                        in HM.index h bs == ix
+                                  ]
+                        , check
+                              (A.length a == 2 ^ HM.bitsPerSubkey)
+                              "There are 2 ^ bitsPerSubkey values in the array."
+                        , check
+                              (uniques $ concatMap HM.keys $ A.toList a)
+                              "The keys are unique."
+                        ]
+                (Collision h l1@(L k1 _) l2@(L k2 _) hm') ->
+                    decorate "Collision" $
+                    mconcat
+                        [ annotate h "Hash"
+                        , annotate l1 "The first collision"
+                        , annotate l2 "The second collision"
+                        , check
+                              (HM.hashWithSalt s k1 == h)
+                              "The hash of the first collision is correct."
+                        , check
+                              (HM.hashWithSalt s k2 == h)
+                              "The hash of the second collision is correct."
+                        , check
+                              (k1 /= k2)
+                              "The keys within the collision are not equal."
+                        , check
+                              (uniques (k1 : k2 : HM.keys hm'))
+                              "The keys are unique."
+                        , decorate "The recursive HashMap" $
+                          go (HM.nextSalt s) 0 hm'
+                        , check
+                              (all (\k -> HM.hashWithSalt s k == h)
+                                   (HM.keys hm'))
+                              "All recursive keys hash to the hash within the collision, using the salt at this level."
+                        ]
 
 uniques :: Eq a => [a] -> Bool
 uniques l = length (nub l) == length l
-
 #if !MIN_VERSION_validity(0,6,0)
 -- | Decorate a validation with a location
 decorate :: String -> Validation -> Validation
@@ -93,96 +155,111 @@ decorate = flip annotateValidation
 annotateValidation :: Validation -> String -> Validation
 annotateValidation val s =
     case val of
-      Validation errs -> Validation $ map (Location s) errs
+        Validation errs -> Validation $ map (Location s) errs
 #endif
 
 #if !MIN_VERSION_validity(0,8,0)
 -- | Decorate a piecewise validation of a list with their location in the list
 decorateList :: [a] -> (a -> Validation) -> Validation
-decorateList as func = mconcat $
-    flip map (zip [0..] as) $ \(i, a) ->
-        decorate (unwords ["The element at index", show (i :: Integer), "in the list"]) $
+decorateList as func =
+    mconcat $
+    flip map (zip [0 ..] as) $ \(i, a) ->
+        decorate
+            (unwords
+                 ["The element at index", show (i :: Integer), "in the list"]) $
         func a
 #endif
-
 instance (GenUnchecked k, GenUnchecked v) => GenUnchecked (Leaf k v) where
-    genUnchecked = sized $ \n -> do
-      (a, b) <- genSplit n
-      k <- resize a genUnchecked
-      v <- resize b genUnchecked
-      pure $ L k v
+    genUnchecked =
+        sized $ \n -> do
+            (a, b) <- genSplit n
+            k <- resize a genUnchecked
+            v <- resize b genUnchecked
+            pure $ L k v
     shrinkUnchecked (L k v) = [L k' v' | (k', v') <- shrinkUnchecked (k, v)]
 
 instance (GenValid k, GenValid v) => GenValid (Leaf k v) where
-    genValid = sized $ \n -> do
-      (a, b) <- genSplit n
-      k <- resize a genValid
-      v <- resize b genValid
-      pure $ L k v
+    genValid =
+        sized $ \n -> do
+            (a, b) <- genSplit n
+            k <- resize a genValid
+            v <- resize b genValid
+            pure $ L k v
 
 instance GenUnchecked a => GenUnchecked (A.Array a) where
     genUnchecked = do
-      l <- genUnchecked
-      pure $ A.fromList (length l) l
+        l <- genUnchecked
+        pure $ A.fromList (length l) l
     shrinkUnchecked _ = [] -- TODO: write shrinking
 
 instance GenValid a => GenValid (A.Array a) where
     genValid = do
-      l <- genValid
-      pure $ A.fromList (length l) l
+        l <- genValid
+        pure $ A.fromList (length l) l
 
 instance (GenUnchecked k, GenUnchecked v) => GenUnchecked (HashMap k v) where
-    genUnchecked = sized $ \n -> case n of
-      0 -> pure Empty
-      _ -> oneof
-        [ do
-            (a, b) <- genSplit n
-            BitmapIndexed
-              <$> resize a genUnchecked
-              <*> resize b genUnchecked
-        , do
-            (a, b) <- genSplit n
-            Leaf
-              <$> resize a genUnchecked
-              <*> resize b genUnchecked
-        , Full <$> genUnchecked
-        , do
-            (a,b,c,d) <- genSplit4 n
-            Collision
-              <$> resize a genUnchecked
-              <*> resize b genUnchecked
-              <*> resize c genUnchecked
-              <*> resize d genUnchecked
-        ]
-    shrinkUnchecked hm = case hm of
-      Empty -> []
-      Leaf h l -> [Leaf h' l' | (h', l') <- shrinkUnchecked (h, l)]
-      BitmapIndexed bm a -> [BitmapIndexed bm' a' | (bm', a') <- shrinkUnchecked (bm, a)]
-      Full a -> Full <$> shrinkUnchecked a
-      Collision h l1 l2 hm_ ->
-        [ Collision h' l1' l2' hm_'
-        | (h', l1', l2', hm_') <- shrinkUnchecked (h, l1, l2, hm_)
-        ]
+    genUnchecked =
+        sized $ \n ->
+            case n of
+                0 -> pure Empty
+                _ ->
+                    oneof
+                        [ do (a, b) <- genSplit n
+                             BitmapIndexed <$> resize a genUnchecked <*>
+                                 resize b genUnchecked
+                        , do (a, b) <- genSplit n
+                             Leaf <$> resize a genUnchecked <*>
+                                 resize b genUnchecked
+                        , Full <$> genUnchecked
+                        , do (a, b, c, d) <- genSplit4 n
+                             Collision <$> resize a genUnchecked <*>
+                                 resize b genUnchecked <*>
+                                 resize c genUnchecked <*>
+                                 resize d genUnchecked
+                        ]
+    shrinkUnchecked hm =
+        case hm of
+            Empty -> []
+            Leaf h l -> [Leaf h' l' | (h', l') <- shrinkUnchecked (h, l)]
+            BitmapIndexed bm a ->
+                [BitmapIndexed bm' a' | (bm', a') <- shrinkUnchecked (bm, a)]
+            Full a -> Full <$> shrinkUnchecked a
+            Collision h l1 l2 hm_ ->
+                [ Collision h' l1' l2' hm_'
+                | (h', l1', l2', hm_') <- shrinkUnchecked (h, l1, l2, hm_)
+                ]
 
 -- It turns out it's almost impossible to write this instance without using internals.
 -- This is good-enough for now.
-instance (Eq k, Hashable k, GenValid k, GenValid v) => GenValid (HashMap k v) where
+instance (Eq k, Hashable k, GenValid k, GenValid v) =>
+         GenValid (HashMap k v) where
     genValid = HM.fromList <$> genValid
     shrinkValid hm = HM.fromList <$> shrinkValid (HM.toList hm)
       -- TODO improve the shrinking
 
 -- Key type that generates more hash collisions.
 newtype Key = K
-    { unK :: Int }
-    deriving (Arbitrary, CoArbitrary, Validity, GenUnchecked, GenValid, Eq, Ord, Read, Show, Generic)
+    { unK :: Int
+    } deriving ( Arbitrary
+               , CoArbitrary
+               , Validity
+               , GenUnchecked
+               , GenValid
+               , Eq
+               , Ord
+               , Read
+               , Show
+               , Generic
+               )
 
 instance Hashable Key where
-    hashWithSalt salt k = hashWithSalt salt (unK k) `mod` 4
+    hashWithSalt salt k = hashWithSalt salt (unK k) `mod` 20
 
 instance Function Key
 
 pSingleton :: Property
-pSingleton = producesValidsOnValids2 (HM.singleton :: Key -> Int -> HM.HashMap Key Int)
+pSingleton =
+    producesValidsOnValids2 (HM.singleton :: Key -> Int -> HM.HashMap Key Int)
 
 pNull :: Property
 pNull = producesValidsOnValids (HM.null :: HM.HashMap Key Int -> Bool)
@@ -191,95 +268,152 @@ pSize :: Property
 pSize = producesValidsOnValids (HM.size :: HM.HashMap Key Int -> Int)
 
 pMember :: Property
-pMember = producesValidsOnValids2 (HM.member :: Key -> HM.HashMap Key Int -> Bool)
+pMember =
+    producesValidsOnValids2 (HM.member :: Key -> HM.HashMap Key Int -> Bool)
 
 pLookup :: Property
-pLookup = producesValidsOnValids2 (HM.lookup :: Key -> HM.HashMap Key Int -> Maybe Int)
+pLookup =
+    producesValidsOnValids2
+        (HM.lookup :: Key -> HM.HashMap Key Int -> Maybe Int)
 
 pLookupDefault :: Property
-pLookupDefault = producesValidsOnValids3 (HM.lookupDefault :: Int -> Key -> HM.HashMap Key Int -> Int)
+pLookupDefault =
+    producesValidsOnValids3
+        (HM.lookupDefault :: Int -> Key -> HM.HashMap Key Int -> Int)
 
 pInsert :: Property
-pInsert = producesValidsOnValids3 (HM.insert :: Key -> Int -> HM.HashMap Key Int -> HM.HashMap Key Int)
+pInsert =
+    producesValidsOnValids3
+        (HM.insert :: Key -> Int -> HM.HashMap Key Int -> HM.HashMap Key Int)
 
 pInsertWith :: Property
-pInsertWith = producesValidsOnValids3 (HM.insertWith (+) :: Key -> Int -> HM.HashMap Key Int -> HM.HashMap Key Int)
+pInsertWith =
+    producesValidsOnValids3
+        (HM.insertWith (+) :: Key -> Int -> HM.HashMap Key Int -> HM.HashMap Key Int)
 
 pDelete :: Property
-pDelete = producesValidsOnValids2 (HM.delete :: Key -> HM.HashMap Key Int -> HM.HashMap Key Int)
+pDelete =
+    producesValidsOnValids2
+        (HM.delete :: Key -> HM.HashMap Key Int -> HM.HashMap Key Int)
 
 pAdjust :: Fun Int Int -> Property
-pAdjust f = producesValidsOnValids2 (HM.adjust (apply f) :: Key -> HM.HashMap Key Int -> HM.HashMap Key Int)
+pAdjust f =
+    producesValidsOnValids2
+        (HM.adjust (apply f) :: Key -> HM.HashMap Key Int -> HM.HashMap Key Int)
 
 pUpdate :: (Fun Int (Maybe Int)) -> Property
-pUpdate f = producesValidsOnValids2 (HM.update (apply f) :: Key -> HM.HashMap Key Int -> HM.HashMap Key Int)
+pUpdate f =
+    producesValidsOnValids2
+        (HM.update (apply f) :: Key -> HM.HashMap Key Int -> HM.HashMap Key Int)
 
 pAlter :: Property
-pAlter = producesValidsOnValids2 (HM.alter (fmap succ) :: Key -> HM.HashMap Key Int -> HM.HashMap Key Int)
+pAlter =
+    producesValidsOnValids2
+        (HM.alter (fmap succ) :: Key -> HM.HashMap Key Int -> HM.HashMap Key Int)
 
 pAlterF :: Fun (Maybe Int) [Maybe Int] -> Property
-pAlterF f = producesValidsOnValids2 (HM.alterF (apply f) :: Key -> HM.HashMap Key Int -> [HM.HashMap Key Int])
+pAlterF f =
+    producesValidsOnValids2
+        (HM.alterF (apply f) :: Key -> HM.HashMap Key Int -> [HM.HashMap Key Int])
 
 pUnion :: Property
-pUnion = producesValidsOnValids2 (HM.union :: HashMap Key Int -> HashMap Key Int -> HashMap Key Int)
+pUnion =
+    producesValidsOnValids2
+        (HM.union :: HashMap Key Int -> HashMap Key Int -> HashMap Key Int)
 
 pUnionWith :: Fun (Int, Int) Int -> Property
-pUnionWith f = producesValidsOnValids2 (HM.unionWith (applyFun2 f) :: HashMap Key Int -> HashMap Key Int -> HashMap Key Int)
+pUnionWith f =
+    producesValidsOnValids2
+        (HM.unionWith (applyFun2 f) :: HashMap Key Int -> HashMap Key Int -> HashMap Key Int)
 
 pUnionWithKey :: Fun (Key, Int, Int) Int -> Property
-pUnionWithKey f = producesValidsOnValids2 (HM.unionWithKey (applyFun3 f) :: HashMap Key Int -> HashMap Key Int -> HashMap Key Int)
+pUnionWithKey f =
+    producesValidsOnValids2
+        (HM.unionWithKey (applyFun3 f) :: HashMap Key Int -> HashMap Key Int -> HashMap Key Int)
 
 pUnions :: Property
-pUnions = producesValidsOnValids (HM.unions :: [HashMap Key Int] -> HashMap Key Int)
+pUnions =
+    producesValidsOnValids (HM.unions :: [HashMap Key Int] -> HashMap Key Int)
 
 pMap :: Fun Int Int -> Property
-pMap f = producesValidsOnValids (HM.map (apply f) :: HashMap Key Int -> HashMap Key Int)
+pMap f =
+    producesValidsOnValids
+        (HM.map (apply f) :: HashMap Key Int -> HashMap Key Int)
 
 pMapWithKey :: Fun (Key, Int) Int -> Property
-pMapWithKey f = producesValidsOnValids (HM.mapWithKey (applyFun2 f) :: HashMap Key Int -> HashMap Key Int)
+pMapWithKey f =
+    producesValidsOnValids
+        (HM.mapWithKey (applyFun2 f) :: HashMap Key Int -> HashMap Key Int)
 
 pTraverseWithKey :: Fun (Key, Int) (Maybe Int) -> Property
-pTraverseWithKey f = producesValidsOnValids (HM.traverseWithKey (applyFun2 f) :: HashMap Key Int -> Maybe (HashMap Key Int))
+pTraverseWithKey f =
+    producesValidsOnValids
+        (HM.traverseWithKey (applyFun2 f) :: HashMap Key Int -> Maybe (HashMap Key Int))
 
 pDifference :: Property
-pDifference = producesValidsOnValids2 (HM.difference :: HashMap Key Int -> HashMap Key Int -> HashMap Key Int)
+pDifference =
+    producesValidsOnValids2
+        (HM.difference :: HashMap Key Int -> HashMap Key Int -> HashMap Key Int)
 
 pDifferenceWith :: Fun (Int, Int) (Maybe Int) -> Property
-pDifferenceWith f = producesValidsOnValids2 (HM.differenceWith (applyFun2 f) :: HashMap Key Int -> HashMap Key Int -> HashMap Key Int)
+pDifferenceWith f =
+    producesValidsOnValids2
+        (HM.differenceWith (applyFun2 f) :: HashMap Key Int -> HashMap Key Int -> HashMap Key Int)
 
 pIntersection :: Property
-pIntersection = producesValidsOnValids2 (HM.intersection :: HashMap Key Int -> HashMap Key Int -> HashMap Key Int)
+pIntersection =
+    producesValidsOnValids2
+        (HM.intersection :: HashMap Key Int -> HashMap Key Int -> HashMap Key Int)
 
 pIntersectionWith :: Fun (Int, Int) Int -> Property
-pIntersectionWith f = producesValidsOnValids2 (HM.intersectionWith (applyFun2 f) :: HashMap Key Int -> HashMap \
-  Key Int -> HashMap Key Int)
+pIntersectionWith f =
+    producesValidsOnValids2
+        (HM.intersectionWith (applyFun2 f) :: HashMap Key Int -> HashMap Key Int -> HashMap Key Int)
 
 pIntersectionWithKey :: Fun (Key, Int, Int) Int -> Property
-pIntersectionWithKey f = producesValidsOnValids2 (HM.intersectionWithKey (applyFun3 f) :: HashMap Key Int -> HashMap Key Int -> HashMap Key Int)
+pIntersectionWithKey f =
+    producesValidsOnValids2
+        (HM.intersectionWithKey (applyFun3 f) :: HashMap Key Int -> HashMap Key Int -> HashMap Key Int)
 
 pFoldl' :: Fun (Word, Int) Word -> Property
-pFoldl' f = producesValidsOnValids2 (HM.foldl' (applyFun2 f) :: Word -> HashMap Key Int -> Word)
+pFoldl' f =
+    producesValidsOnValids2
+        (HM.foldl' (applyFun2 f) :: Word -> HashMap Key Int -> Word)
 
 pFoldlWithKey' :: Fun (Word, Key, Int) Word -> Property
-pFoldlWithKey' f = producesValidsOnValids2 (HM.foldlWithKey' (applyFun3 f) :: Word -> HashMap Key Int -> Word)
+pFoldlWithKey' f =
+    producesValidsOnValids2
+        (HM.foldlWithKey' (applyFun3 f) :: Word -> HashMap Key Int -> Word)
 
 pFoldr :: Fun (Int, Word) Word -> Property
-pFoldr f = producesValidsOnValids2 (HM.foldr (applyFun2 f) :: Word -> HashMap Key Int -> Word)
+pFoldr f =
+    producesValidsOnValids2
+        (HM.foldr (applyFun2 f) :: Word -> HashMap Key Int -> Word)
 
 pFoldrWithKey :: Fun (Key, Int, Word) Word -> Property
-pFoldrWithKey f = producesValidsOnValids2 (HM.foldrWithKey (applyFun3 f) :: Word -> HashMap Key Int -> Word)
+pFoldrWithKey f =
+    producesValidsOnValids2
+        (HM.foldrWithKey (applyFun3 f) :: Word -> HashMap Key Int -> Word)
 
 pFilter :: Fun Int Bool -> Property
-pFilter f = producesValidsOnValids (HM.filter (apply f) :: HashMap Key Int -> HashMap Key Int)
+pFilter f =
+    producesValidsOnValids
+        (HM.filter (apply f) :: HashMap Key Int -> HashMap Key Int)
 
 pFilterWithKey :: Fun (Key, Int) Bool -> Property
-pFilterWithKey f = producesValidsOnValids (HM.filterWithKey (applyFun2 f) :: HashMap Key Int -> HashMap Key Int)
+pFilterWithKey f =
+    producesValidsOnValids
+        (HM.filterWithKey (applyFun2 f) :: HashMap Key Int -> HashMap Key Int)
 
 pMapMaybe :: Fun Int (Maybe Int) -> Property
-pMapMaybe f = producesValidsOnValids (HM.mapMaybe (apply f) :: HashMap Key Int -> HashMap Key Int)
+pMapMaybe f =
+    producesValidsOnValids
+        (HM.mapMaybe (apply f) :: HashMap Key Int -> HashMap Key Int)
 
 pMapMaybeWithKey :: Fun (Key, Int) (Maybe Int) -> Property
-pMapMaybeWithKey f = producesValidsOnValids (HM.mapMaybeWithKey (applyFun2 f) :: HashMap Key Int -> HashMap Key Int)
+pMapMaybeWithKey f =
+    producesValidsOnValids
+        (HM.mapMaybeWithKey (applyFun2 f) :: HashMap Key Int -> HashMap Key Int)
 
 pKeys :: Property
 pKeys = producesValidsOnValids (HM.keys :: HashMap Key Int -> [Key])
@@ -291,74 +425,102 @@ pToList :: Property
 pToList = producesValidsOnValids (HM.toList :: HashMap Key Int -> [(Key, Int)])
 
 pFromList :: Property
-pFromList = producesValidsOnValids (HM.fromList :: [(Key, Int)] -> HashMap Key Int)
+pFromList =
+    producesValidsOnValids (HM.fromList :: [(Key, Int)] -> HashMap Key Int)
 
 pFromListWith :: Fun (Int, Int) Int -> Property
-pFromListWith f = producesValidsOnValids (HM.fromListWith (applyFun2 f) :: [(Key, Int)] -> HashMap Key Int)
+pFromListWith f =
+    producesValidsOnValids
+        (HM.fromListWith (applyFun2 f) :: [(Key, Int)] -> HashMap Key Int)
+
+pUnConsA :: Property
+pUnConsA =
+    producesValidsOnValids
+        (HM.unConsA :: A.Array (HashMap Key Int) -> UnCons Key Int)
 
+pUnConsHM :: Property
+pUnConsHM =
+    producesValidsOnValids
+        (HM.unConsHM :: HashMap Key Int -> Maybe (Leaf Key Int, HashMap Key Int))
 
 ------------------------------------------------------------------------
 -- * Test list
-
 tests :: [Test]
 tests =
-  let genValidHelper gen = forAll gen shouldBeValid
-  in
-    [
+    let genValidHelper gen = forAll gen shouldBeValid
     -- Basic interface
-      testGroup "HashMap"
-      [ testProperty "genValid generates valid values for Leaf" $
-        genValidHelper (genValid :: Gen (Leaf Key Int))
-      , testProperty "genValid generates valid values for Array" $
-        genValidHelper (genValid :: Gen (A.Array Key))
-      , testProperty "genValid generates valid values for HashMap" $
-        genValidHelper (genValid :: Gen (HashMap Key Int))
-      ]
-    , testGroup "HashMap"
-      [ testProperty "singleton produces valid HashMaps" pSingleton
-      , testProperty "null produces valid Bools" pNull
-      , testProperty "size produces valid HashMaps" pSize
-      , testProperty "member produces valid HashMaps" pMember
-      , testProperty "lookup produces valid HashMaps" pLookup
-      , testProperty "lookupDefault produces valid HashMaps" pLookupDefault
-      , testProperty "insert produces valid HashMaps" pInsert
-      , testProperty "insertWith produces valid HashMaps" pInsertWith
-      , testProperty "delete produces valid HashMaps" pDelete
-      , testProperty "adjust produces valid HashMaps" pAdjust
-      , testProperty "update produces valid HashMaps" pUpdate
-      , testProperty "alter produces valid HashMaps" pAlter
-      , testProperty "alterF produces valid HashMaps" pAlterF
-      , testProperty "union produces valid HashMaps" pUnion
-      , testProperty "unionWith produces valid HashMaps" pUnionWith
-      , testProperty "unionWithKey produces valid HashMaps" pUnionWithKey
-      , testProperty "unions produces valid HashMaps" pUnions
-      , testProperty "map produces valid HashMaps" pMap
-      , testProperty "mapWithKey produces valid HashMaps" pMapWithKey
-      , testProperty "traverseWithKey produces valid HashMaps" pTraverseWithKey
-      , testProperty "difference produces valid HashMaps" pDifference
-      , testProperty "differenceWith produces valid HashMaps" pDifferenceWith
-      , testProperty "intersection produces valid HashMaps" pIntersection
-      , testProperty "intersectionWith produces valid HashMaps" pIntersectionWith
-      , testProperty "intersectionWithKey produces valid HashMaps" pIntersectionWithKey
-      , testProperty "foldl' produces valid HashMaps" pFoldl'
-      , testProperty "foldlWithKey' produces valid HashMaps" pFoldlWithKey'
-      , testProperty "foldr produces valid HashMaps" pFoldr
-      , testProperty "foldrWithKey produces valid HashMaps" pFoldrWithKey
-      , testProperty "filter produces valid HashMaps" pFilter
-      , testProperty "filterWithKey produces valid HashMaps" pFilterWithKey
-      , testProperty "mapMaybe produces valid HashMaps" pMapMaybe
-      , testProperty "mapMaybeWithKey produces valid HashMaps" pMapMaybeWithKey
-      , testProperty "keys produces valid lists" pKeys
-      , testProperty "elems produces valid lists" pElems
-      , testProperty "toList produces valid lists" pToList
-      , testProperty "fromList produces valid HashMaps" pFromList
-      , testProperty "fromListWith produces valid HashMaps" pFromListWith
-      ]
-    ]
--- TODO keysSet
+    in [ testGroup
+             "HashMap"
+             [ testProperty "genValid generates valid values for Leaf" $
+               genValidHelper (genValid :: Gen (Leaf Key Int))
+             , testProperty "genValid generates valid values for Array" $
+               genValidHelper (genValid :: Gen (A.Array Key))
+             , testProperty "genValid generates valid values for HashMap" $
+               genValidHelper (genValid :: Gen (HashMap Key Int))
+             ]
+       , testGroup
+             "HashMap"
+             [ testProperty "singleton produces valid HashMaps" pSingleton
+             , testProperty "null produces valid Bools" pNull
+             , testProperty "size produces valid HashMaps" pSize
+             , testProperty "member produces valid HashMaps" pMember
+             , testProperty "lookup produces valid HashMaps" pLookup
+             , testProperty
+                   "lookupDefault produces valid HashMaps"
+                   pLookupDefault
+             , testProperty "insert produces valid HashMaps" pInsert
+             , testProperty "insertWith produces valid HashMaps" pInsertWith
+             , testProperty "delete produces valid HashMaps" pDelete
+             , testProperty "adjust produces valid HashMaps" pAdjust
+             , testProperty "update produces valid HashMaps" pUpdate
+             , testProperty "alter produces valid HashMaps" pAlter
+             , testProperty "alterF produces valid HashMaps" pAlterF
+             , testProperty "union produces valid HashMaps" pUnion
+             , testProperty "unionWith produces valid HashMaps" pUnionWith
+             , testProperty "unionWithKey produces valid HashMaps" pUnionWithKey
+             , testProperty "unions produces valid HashMaps" pUnions
+             , testProperty "map produces valid HashMaps" pMap
+             , testProperty "mapWithKey produces valid HashMaps" pMapWithKey
+             , testProperty
+                   "traverseWithKey produces valid HashMaps"
+                   pTraverseWithKey
+             , testProperty "difference produces valid HashMaps" pDifference
+             , testProperty
+                   "differenceWith produces valid HashMaps"
+                   pDifferenceWith
+             , testProperty "intersection produces valid HashMaps" pIntersection
+             , testProperty
+                   "intersectionWith produces valid HashMaps"
+                   pIntersectionWith
+             , testProperty
+                   "intersectionWithKey produces valid HashMaps"
+                   pIntersectionWithKey
+             , testProperty "foldl' produces valid HashMaps" pFoldl'
+             , testProperty
+                   "foldlWithKey' produces valid HashMaps"
+                   pFoldlWithKey'
+             , testProperty "foldr produces valid HashMaps" pFoldr
+             , testProperty "foldrWithKey produces valid HashMaps" pFoldrWithKey
+             , testProperty "filter produces valid HashMaps" pFilter
+             , testProperty
+                   "filterWithKey produces valid HashMaps"
+                   pFilterWithKey
+             , testProperty "mapMaybe produces valid HashMaps" pMapMaybe
+             , testProperty
+                   "mapMaybeWithKey produces valid HashMaps"
+                   pMapMaybeWithKey
+             , testProperty "keys produces valid lists" pKeys
+             , testProperty "elems produces valid lists" pElems
+             , testProperty "toList produces valid lists" pToList
+             , testProperty "fromList produces valid HashMaps" pFromList
+             , testProperty "fromListWith produces valid HashMaps" pFromListWith
+             , testProperty "unConsA produces valid results" pUnConsA
+             , testProperty "unConsHM produces valid HashMaps" pUnConsHM
+             ]
+       ]
 
+-- TODO keysSet
 ------------------------------------------------------------------------
 -- * Test harness
-
 main :: IO ()
 main = defaultMain tests

From b5169e1a05f7682d0ff06a98f92a3c362b5e206d Mon Sep 17 00:00:00 2001
From: Tom Sydney Kerckhove <syd@cs-syd.eu>
Date: Fri, 26 Oct 2018 13:18:58 +0300
Subject: [PATCH 48/69] Used some invariants to simplify code

---
 Data/HashMap/Base.hs | 15 ++++++---------
 tests/Validity.hs    | 16 ++++++++--------
 2 files changed, 14 insertions(+), 17 deletions(-)

diff --git a/Data/HashMap/Base.hs b/Data/HashMap/Base.hs
index 3f515dce..0520331c 100644
--- a/Data/HashMap/Base.hs
+++ b/Data/HashMap/Base.hs
@@ -1806,30 +1806,29 @@ updateOrConcatWithKey f ary1 ary2 = A.run $ do
 unConsA :: A.Array (HashMap k v) -> UnCons k v
 unConsA ary = case A.length ary of
   1 -> case A.index ary 0 of
-    Empty -> WasEmpty -- That would be weird, but fine.
+    Empty -> error "Invariant violated: Empty hashmap in array."
     Leaf _ l -> NowEmpty l
     BitmapIndexed bm ary' -> case unConsA ary' of
-      WasEmpty -> WasEmpty -- That would be weird, but fine.
       NowEmpty l -> NowEmpty l
       UnConsed l a' -> UnConsed l (A.singleton (BitmapIndexed bm a'))
     Full ary' -> case unConsA ary' of
-        WasEmpty -> WasEmpty -- That would be weird, but fine.
         NowEmpty l -> NowEmpty l
-        UnConsed l a' -> UnConsed l (A.singleton (Full a')) -- TODO 'Full' seems wrong
+        UnConsed l a' ->
+          let bm = undefined
+          in UnConsed l (A.singleton (BitmapIndexed bm a')) -- TODO 'Full' seems wrong
     Collision h l1 l2 hm -> UnConsed l1 $ A.singleton $ case unConsHM hm of
       Nothing -> Leaf h l2
       Just (l3, hm') -> Collision h l2 l3 hm'
   _ -> goA 0
   where
     goA ix = case unConsHM $ A.index ary ix of
-      Nothing -> goA $ ix + 1 -- TODO this is probably problematic when the entire array only houses Empty hashmaps
+      Nothing -> goA $ ix + 1 -- this is fine because the array only houses nonempty hashmaps
       Just (l, hm') -> case hm' of
         Empty -> UnConsed l $ A.delete ary ix
         _ -> UnConsed l $ A.update ary ix hm'
 
 data UnCons k v
-  = WasEmpty
-  | NowEmpty (Leaf k v)
+  = NowEmpty (Leaf k v)
   | UnConsed (Leaf k v) (A.Array (HashMap k v))
   deriving (Show)
 
@@ -1839,11 +1838,9 @@ unConsHM hm = case hm of
   Empty -> Nothing
   Leaf _ l -> Just (l, Empty)
   BitmapIndexed bm ary' -> case unConsA ary' of
-    WasEmpty -> Nothing
     NowEmpty l -> Just (l, Empty)
     UnConsed l a' -> Just (l, BitmapIndexed bm a')
   Full ary' -> case unConsA ary' of
-    WasEmpty -> Nothing -- That would be weird, but fine.
     NowEmpty l -> Just (l, Empty)
     UnConsed l a' -> Just (l, Full a') -- TODO This 'Full' seems wrong
   Collision h l1 l2 hm' -> Just $ (,) l1 $ case unConsHM hm' of
diff --git a/tests/Validity.hs b/tests/Validity.hs
index cff9d4e0..a663bae9 100644
--- a/tests/Validity.hs
+++ b/tests/Validity.hs
@@ -46,8 +46,8 @@ instance (Validity k, Validity v) => Validity (Leaf k v) where
 instance Validity a => Validity (A.Array a) where
     validate a = annotate (A.toList a) "The array elements"
 
-instance (Eq k, Hashable k, Validity k, Validity v) => Validity (UnCons k v) where
-    validate WasEmpty = mempty
+instance (Eq k, Hashable k, Validity k, Validity v) =>
+         Validity (UnCons k v) where
     validate (NowEmpty l) = decorate "NowEmpty" $ validate l
     validate (UnConsed l a) =
         decorate "UnConsed" $
@@ -433,16 +433,16 @@ pFromListWith f =
     producesValidsOnValids
         (HM.fromListWith (applyFun2 f) :: [(Key, Int)] -> HashMap Key Int)
 
-pUnConsA :: Property
-pUnConsA =
-    producesValidsOnValids
-        (HM.unConsA :: A.Array (HashMap Key Int) -> UnCons Key Int)
-
 pUnConsHM :: Property
 pUnConsHM =
     producesValidsOnValids
         (HM.unConsHM :: HashMap Key Int -> Maybe (Leaf Key Int, HashMap Key Int))
 
+pUnConsA :: Property
+pUnConsA =
+    producesValidsOnValids
+        (HM.unConsA :: A.Array (HashMap Key Int) -> UnCons Key Int)
+
 ------------------------------------------------------------------------
 -- * Test list
 tests :: [Test]
@@ -514,8 +514,8 @@ tests =
              , testProperty "toList produces valid lists" pToList
              , testProperty "fromList produces valid HashMaps" pFromList
              , testProperty "fromListWith produces valid HashMaps" pFromListWith
-             , testProperty "unConsA produces valid results" pUnConsA
              , testProperty "unConsHM produces valid HashMaps" pUnConsHM
+             , testProperty "unConsA produces valid results" pUnConsA
              ]
        ]
 

From dc908551ee4f69c248e9d4e51a2257043a6f244d Mon Sep 17 00:00:00 2001
From: Tom Sydney Kerckhove <syd@cs-syd.eu>
Date: Fri, 26 Oct 2018 16:56:59 +0300
Subject: [PATCH 49/69] More specific unconsing

---
 Data/HashMap/Base.hs | 27 ++++++++++++++++-----------
 tests/Validity.hs    |  8 ++++++--
 2 files changed, 22 insertions(+), 13 deletions(-)

diff --git a/Data/HashMap/Base.hs b/Data/HashMap/Base.hs
index 0520331c..2fafa5f6 100644
--- a/Data/HashMap/Base.hs
+++ b/Data/HashMap/Base.hs
@@ -1810,26 +1810,29 @@ unConsA ary = case A.length ary of
     Leaf _ l -> NowEmpty l
     BitmapIndexed bm ary' -> case unConsA ary' of
       NowEmpty l -> NowEmpty l
-      UnConsed l a' -> UnConsed l (A.singleton (BitmapIndexed bm a'))
+      UnConsed _ l a' -> UnConsed 0 l (A.singleton (BitmapIndexed bm a'))
     Full ary' -> case unConsA ary' of
         NowEmpty l -> NowEmpty l
-        UnConsed l a' ->
-          let bm = undefined
-          in UnConsed l (A.singleton (BitmapIndexed bm a')) -- TODO 'Full' seems wrong
-    Collision h l1 l2 hm -> UnConsed l1 $ A.singleton $ case unConsHM hm of
+        UnConsed i l a' ->
+          let bm = fullNodeMask .&. complement (1 `unsafeShiftL` i)
+          in UnConsed 0 l (A.singleton (BitmapIndexed bm a'))
+    Collision h l1 l2 hm -> UnConsed 0 l1 $ A.singleton $ case unConsHM hm of
       Nothing -> Leaf h l2
       Just (l3, hm') -> Collision h l2 l3 hm'
   _ -> goA 0
   where
     goA ix = case unConsHM $ A.index ary ix of
-      Nothing -> goA $ ix + 1 -- this is fine because the array only houses nonempty hashmaps
+      Nothing -> goA $ ix + 1 -- This is fine because the array only houses nonempty hashmaps.
       Just (l, hm') -> case hm' of
-        Empty -> UnConsed l $ A.delete ary ix
-        _ -> UnConsed l $ A.update ary ix hm'
+        Empty -> UnConsed ix l $ A.delete ary ix -- This is fine because the array cannot become empty.
+        _ -> UnConsed ix l $ A.update ary ix hm'
 
 data UnCons k v
   = NowEmpty (Leaf k v)
-  | UnConsed (Leaf k v) (A.Array (HashMap k v))
+  | UnConsed
+    Int -- The indexed of the array that was un-consed from
+    (Leaf k v) -- The leaf that was un-consed
+    (A.Array (HashMap k v)) -- The leftover array
   deriving (Show)
 
 -- Remove (any) one element from a hashmap
@@ -1839,10 +1842,12 @@ unConsHM hm = case hm of
   Leaf _ l -> Just (l, Empty)
   BitmapIndexed bm ary' -> case unConsA ary' of
     NowEmpty l -> Just (l, Empty)
-    UnConsed l a' -> Just (l, BitmapIndexed bm a')
+    UnConsed _ l a' -> Just (l, BitmapIndexed bm a') -- TODO ignore the index?
   Full ary' -> case unConsA ary' of
     NowEmpty l -> Just (l, Empty)
-    UnConsed l a' -> Just (l, Full a') -- TODO This 'Full' seems wrong
+    UnConsed i l a' ->
+      let bm = fullNodeMask .&. complement (1 `unsafeShiftL` i)
+      in Just (l, BitmapIndexed bm a')
   Collision h l1 l2 hm' -> Just $ (,) l1 $ case unConsHM hm' of
     Nothing -> Leaf h l2
     Just (l3, hm'') -> Collision h l2 l3 hm''
diff --git a/tests/Validity.hs b/tests/Validity.hs
index a663bae9..29353170 100644
--- a/tests/Validity.hs
+++ b/tests/Validity.hs
@@ -49,9 +49,13 @@ instance Validity a => Validity (A.Array a) where
 instance (Eq k, Hashable k, Validity k, Validity v) =>
          Validity (UnCons k v) where
     validate (NowEmpty l) = decorate "NowEmpty" $ validate l
-    validate (UnConsed l a) =
+    validate (UnConsed ix l a) =
         decorate "UnConsed" $
-        mconcat [decorate "Leaf" $ validate l, decorate "Array" $ validate a]
+        mconcat
+            [ decorate "Int" $ validate ix
+            , decorate "Leaf" $ validate l
+            , decorate "Array" $ validate a
+            ]
 
 instance (Eq k, Hashable k, Validity k, Validity v) =>
          Validity (HashMap k v) where

From 136374a43112f515c46a383b0cb1a803423d9c47 Mon Sep 17 00:00:00 2001
From: David Feuer <David.Feuer@gmail.com>
Date: Sat, 27 Oct 2018 17:30:22 -0400
Subject: [PATCH 50/69] Fix unconsing and filtering

---
 Data/HashMap/Base.hs | 154 ++++++++++++++++++++-----------------------
 tests/Validity.hs    |  33 +++++-----
 2 files changed, 87 insertions(+), 100 deletions(-)

diff --git a/Data/HashMap/Base.hs b/Data/HashMap/Base.hs
index 2fafa5f6..f9d2924d 100644
--- a/Data/HashMap/Base.hs
+++ b/Data/HashMap/Base.hs
@@ -109,9 +109,10 @@ module Data.HashMap.Base
     , insertKeyExists
     , deleteKeyExists
     , insertModifying
-    , unConsA
-    , UnCons(..)
-    , unConsHM
+    , unconsA
+    , UnconsA(..)
+    , UnconsHM(..)
+    , unconsHM
     , ptrEq
     , adjust#
     ) where
@@ -1015,12 +1016,12 @@ delete' h0 s0 k0 m0 = go h0 s0 k0 0 m0
     go h s k _ t@(Collision hx l1@(L k1 _) l2@(L k2 _) hmx)
         | h == hx =
           let go'
-                | k == k1 = case unConsHM hmx of
-                    Nothing -> Leaf hx l2
-                    Just (l3, hmx') -> Collision hx l2 l3 hmx'
-                | k == k2 = case unConsHM hmx of
-                    Nothing -> Leaf hx l1
-                    Just (l3, hmx') -> Collision hx l1 l3 hmx'
+                | k == k1 = case unconsHM hmx of
+                    UnconsEmptyHM -> Leaf hx l2
+                    UnconsedHM l3 hmx' -> Collision hx l2 l3 hmx'
+                | k == k2 = case unconsHM hmx of
+                    UnconsEmptyHM -> Leaf hx l1
+                    UnconsedHM l3 hmx' -> Collision hx l1 l3 hmx'
                 | otherwise = Collision hx l1 l2 $ go (hashWithSalt (nextSalt s) k) (nextSalt s) k 0 hmx
           in go'
         | otherwise = t
@@ -1067,12 +1068,12 @@ deleteKeyExists !h0 s0 !k0 !m0 = go h0 s0 k0 0 m0
     go h s k _ (Collision hx l1@(L k1 _) l2@(L k2 _) hmx)
         | h == hx =
           let go'
-                | k == k1 = case unConsHM hmx of
-                    Nothing -> Leaf hx l2
-                    Just (l3, hmx') -> Collision hx l2 l3 hmx'
-                | k == k2 = case unConsHM hmx of
-                    Nothing -> Leaf hx l1
-                    Just (l3, hmx') -> Collision hx l1 l3 hmx'
+                | k == k1 = case unconsHM hmx of
+                    UnconsEmptyHM -> Leaf hx l2
+                    UnconsedHM l3 hmx' -> Collision hx l2 l3 hmx'
+                | k == k2 = case unconsHM hmx of
+                    UnconsEmptyHM -> Leaf hx l1
+                    UnconsedHM l3 hmx' -> Collision hx l1 l3 hmx'
                 | otherwise = Collision hx l1 l2 $ go (hashWithSalt (nextSalt s) k) (nextSalt s) k 0 hmx
           in go'
         | otherwise = Empty -- error "Internal error: unexpected collision"
@@ -1651,28 +1652,18 @@ filterMapAux onLeaf = go
     go (Full ary) = filterA ary fullNodeMask
     go (Collision h l1 l2 hm) = case (onLeaf (Leaf h l1), onLeaf (Leaf h l2)) of
       (Just (Leaf _ l1'), Just (Leaf _ l2')) -> Collision h l1' l2' $ go hm
-      (Just (Leaf _ l1'), Nothing) -> case go' hm of
-        Nothing -> Leaf h l1'
-        Just (Leaf _ l3', hm') -> Collision h l1' l3' hm'
-        _ -> error "Should not happen, can be fixed with refactoring I think."
-      (Nothing, Just (Leaf _ l2')) -> case go' hm of
-        Nothing -> Leaf h l2'
-        Just (Leaf _ l3', hm') -> Collision h l2' l3' hm'
-        _ -> error "Should not happen, can be fixed with refactoring I think."
-      (Nothing, Nothing) -> rehash h $ go hm
+      (Just (Leaf _ l1'), Nothing) -> go1 l1'
+      (Nothing, Just (Leaf _ l2')) -> go1 l2'
+      (Nothing, Nothing) -> case unconsHM (go hm) of
+        UnconsEmptyHM -> Empty
+        UnconsedHM l1' hm' -> case unconsHM hm' of
+          UnconsEmptyHM -> Leaf h l1'
+          UnconsedHM l2' hm'' -> Collision h l1' l2' hm''
       _ -> error "Should not happen, can be fixed with refactoring I think."
       where
-        go' hm_ = case unConsHM hm_ of
-          Nothing -> Nothing
-          Just (l, hm_') -> case onLeaf (Leaf h l) of
-            Nothing -> go' hm_'
-            Just l' -> Just (l', go hm_')
-    rehash h hm = case hm of
-      Empty -> Empty
-      Leaf _ l -> Leaf h l
-      BitmapIndexed b ary -> undefined -- filterA ary b
-      Full ary -> undefined -- filterA ary fullNodeMask
-      Collision h' l1 l2 hm' -> Collision h l1 l2 $ rehash h' hm'
+        go1 l1' = case unconsHM (go hm) of
+          UnconsEmptyHM -> Leaf h l1'
+          UnconsedHM l2' hm' -> Collision h l1' l2' hm'
 
     filterA ary0 b0 =
         let !n = A.length ary0
@@ -1802,55 +1793,54 @@ updateOrConcatWithKey f ary1 ary2 = A.run $ do
 
 -- Helper functions for very rare cases.
 
--- Remove (any) one element from an array of hashmaps
-unConsA :: A.Array (HashMap k v) -> UnCons k v
-unConsA ary = case A.length ary of
-  1 -> case A.index ary 0 of
-    Empty -> error "Invariant violated: Empty hashmap in array."
-    Leaf _ l -> NowEmpty l
-    BitmapIndexed bm ary' -> case unConsA ary' of
-      NowEmpty l -> NowEmpty l
-      UnConsed _ l a' -> UnConsed 0 l (A.singleton (BitmapIndexed bm a'))
-    Full ary' -> case unConsA ary' of
-        NowEmpty l -> NowEmpty l
-        UnConsed i l a' ->
-          let bm = fullNodeMask .&. complement (1 `unsafeShiftL` i)
-          in UnConsed 0 l (A.singleton (BitmapIndexed bm a'))
-    Collision h l1 l2 hm -> UnConsed 0 l1 $ A.singleton $ case unConsHM hm of
-      Nothing -> Leaf h l2
-      Just (l3, hm') -> Collision h l2 l3 hm'
-  _ -> goA 0
-  where
-    goA ix = case unConsHM $ A.index ary ix of
-      Nothing -> goA $ ix + 1 -- This is fine because the array only houses nonempty hashmaps.
-      Just (l, hm') -> case hm' of
-        Empty -> UnConsed ix l $ A.delete ary ix -- This is fine because the array cannot become empty.
-        _ -> UnConsed ix l $ A.update ary ix hm'
-
-data UnCons k v
-  = NowEmpty (Leaf k v)
-  | UnConsed
-    Int -- The indexed of the array that was un-consed from
-    (Leaf k v) -- The leaf that was un-consed
-    (A.Array (HashMap k v)) -- The leftover array
-  deriving (Show)
+-- Remove (any) one element from a non-empty array
+-- of non-empty hashmaps.
+unconsA :: A.Array (HashMap k v) -> UnconsA k v
+unconsA ary =
+  case unconsHM  (A.index ary 0) of
+    UnconsEmptyHM ->
+      error "Data.HashMap internal error: empty hashmap in array."
+    UnconsedHM lf Empty
+      | A.length ary == 1 -> NowEmptyA lf
+      | otherwise -> RemovedFirstA lf (A.delete ary 0)
+    UnconsedHM lf hm' -> UnconsedFromFirstA lf (A.update ary 0 hm')
+
+data UnconsA k v
+  = NowEmptyA !(Leaf k v)
+  | UnconsedFromFirstA
+    !(Leaf k v) -- The leaf that was un-consed
+    !(A.Array (HashMap k v)) -- The leftover array
+  | RemovedFirstA
+    !(Leaf k v) -- The leaf that was un-consed
+    !(A.Array (HashMap k v)) -- The leftover array
+  deriving Show
+
+data UnconsHM k v
+  = UnconsEmptyHM
+  | UnconsedHM !(Leaf k v) !(HashMap k v)
+  deriving Show
 
 -- Remove (any) one element from a hashmap
-unConsHM :: HashMap k v -> Maybe (Leaf k v, HashMap k v)
-unConsHM hm = case hm of
-  Empty -> Nothing
-  Leaf _ l -> Just (l, Empty)
-  BitmapIndexed bm ary' -> case unConsA ary' of
-    NowEmpty l -> Just (l, Empty)
-    UnConsed _ l a' -> Just (l, BitmapIndexed bm a') -- TODO ignore the index?
-  Full ary' -> case unConsA ary' of
-    NowEmpty l -> Just (l, Empty)
-    UnConsed i l a' ->
-      let bm = fullNodeMask .&. complement (1 `unsafeShiftL` i)
-      in Just (l, BitmapIndexed bm a')
-  Collision h l1 l2 hm' -> Just $ (,) l1 $ case unConsHM hm' of
-    Nothing -> Leaf h l2
-    Just (l3, hm'') -> Collision h l2 l3 hm''
+unconsHM :: HashMap k v -> UnconsHM k v
+unconsHM hm = case hm of
+  Empty -> UnconsEmptyHM
+  Leaf _ l -> UnconsedHM l Empty
+  BitmapIndexed bm ary' -> case unconsA ary' of
+    NowEmptyA l -> UnconsedHM l Empty
+    UnconsedFromFirstA l a' -> UnconsedHM l (BitmapIndexed bm a')
+    RemovedFirstA l a' -> shortened l bm a'
+  Full ary' -> case unconsA ary' of
+    NowEmptyA l -> UnconsedHM l Empty
+    UnconsedFromFirstA l a' -> UnconsedHM l (Full a')
+    RemovedFirstA l a' -> shortened l fullNodeMask a'
+  Collision h l1 l2 hm' -> UnconsedHM l1 $ case unconsHM hm' of
+    UnconsEmptyHM -> Leaf h l2
+    UnconsedHM l3 hm'' -> Collision h l2 l3 hm''
+  where
+    -- The array was shortened, so we need to remove the first
+    -- element from the bitmap.
+    shortened l bm ar =
+      UnconsedHM l $ BitmapIndexed (bm .&. (bm - 1)) ar
 
 ------------------------------------------------------------------------
 -- Manually unrolled loops
diff --git a/tests/Validity.hs b/tests/Validity.hs
index 29353170..fc4eeee5 100644
--- a/tests/Validity.hs
+++ b/tests/Validity.hs
@@ -22,10 +22,10 @@ import qualified Data.HashMap.Strict as HM
 import qualified Data.HashMap.Lazy as HM
 #endif
 import qualified Data.HashMap.Array as A
-import Data.HashMap.Base (HashMap(..), Leaf(..), UnCons(..))
+import Data.HashMap.Base (HashMap(..), Leaf(..), UnconsHM(..))
 import qualified Data.HashMap.Base as HM
        (bitsPerSubkey, defaultSalt, hashWithSalt, index, mask, nextSalt,
-        sparseIndex, unConsA, unConsHM)
+        sparseIndex, unconsHM)
 
 import Data.GenValidity
        (GenUnchecked(..), GenValid(..), genSplit, genSplit4)
@@ -47,14 +47,13 @@ instance Validity a => Validity (A.Array a) where
     validate a = annotate (A.toList a) "The array elements"
 
 instance (Eq k, Hashable k, Validity k, Validity v) =>
-         Validity (UnCons k v) where
-    validate (NowEmpty l) = decorate "NowEmpty" $ validate l
-    validate (UnConsed ix l a) =
-        decorate "UnConsed" $
+         Validity (UnconsHM k v) where
+    validate UnconsEmptyHM = decorate "UnconsEmptyHM" valid
+    validate (UnconsedHM l hm) =
+        decorate "UnconsedHM" $
         mconcat
-            [ decorate "Int" $ validate ix
-            , decorate "Leaf" $ validate l
-            , decorate "Array" $ validate a
+            [ decorate "Leaf" $ validate l
+            , decorate "Map" $ validate hm
             ]
 
 instance (Eq k, Hashable k, Validity k, Validity v) =>
@@ -437,15 +436,14 @@ pFromListWith f =
     producesValidsOnValids
         (HM.fromListWith (applyFun2 f) :: [(Key, Int)] -> HashMap Key Int)
 
-pUnConsHM :: Property
-pUnConsHM =
+pUnconsHM :: Property
+pUnconsHM =
     producesValidsOnValids
-        (HM.unConsHM :: HashMap Key Int -> Maybe (Leaf Key Int, HashMap Key Int))
+        (HM.unconsHM :: HashMap Key Int -> UnconsHM Key Int)
 
-pUnConsA :: Property
-pUnConsA =
-    producesValidsOnValids
-        (HM.unConsA :: A.Array (HashMap Key Int) -> UnCons Key Int)
+-- There isn't currently a pUnconsA because I (David Feuer) don't know
+-- the right way to tell genvalidity-hspec that we only want cases
+-- where the array is non-empty and all of its elements are non-empty.
 
 ------------------------------------------------------------------------
 -- * Test list
@@ -518,8 +516,7 @@ tests =
              , testProperty "toList produces valid lists" pToList
              , testProperty "fromList produces valid HashMaps" pFromList
              , testProperty "fromListWith produces valid HashMaps" pFromListWith
-             , testProperty "unConsHM produces valid HashMaps" pUnConsHM
-             , testProperty "unConsA produces valid results" pUnConsA
+             , testProperty "unconsHM produces valid HashMaps" pUnconsHM
              ]
        ]
 

From eadac29809f38f671bcf82d04ad04cd7fe43d2da Mon Sep 17 00:00:00 2001
From: David Feuer <David.Feuer@gmail.com>
Date: Sat, 27 Oct 2018 19:56:01 -0400
Subject: [PATCH 51/69] Improve the Ord and Ord 1 implementations

Also add more tests to deal with the fact that we now
have more equality and comparison implementations.
---
 Data/HashMap/Base.hs       | 48 +++++++++++++++++++++++++++++++++-----
 tests/HashMapProperties.hs | 20 ++++++++++++++++
 tests/HashSetProperties.hs | 32 ++++++++++++++++++++-----
 3 files changed, 88 insertions(+), 12 deletions(-)

diff --git a/Data/HashMap/Base.hs b/Data/HashMap/Base.hs
index 2fafa5f6..d9f12946 100644
--- a/Data/HashMap/Base.hs
+++ b/Data/HashMap/Base.hs
@@ -163,6 +163,7 @@ import Data.Functor.Identity (Identity (..))
 #endif
 import Control.Applicative (Const (..))
 import Data.Coerce (coerce)
+import Data.Function (on)
 
 -- | A set of values.  A set cannot contain duplicate values.
 ------------------------------------------------------------------------
@@ -335,10 +336,10 @@ equal2 eqk eqv t1 t2 = go (toList' t1 []) (toList' t2 [])
 
 #if MIN_VERSION_base(4,9,0)
 instance Ord2 HashMap where
-    liftCompare2 = cmp
+    liftCompare2 = cmp2
 
 instance (Ord k, Hashable k) => Ord1 (HashMap k) where
-    liftCompare = cmp compare
+    liftCompare = cmp1
 #endif
 
 -- | The order is total.
@@ -347,11 +348,46 @@ instance (Ord k, Hashable k) => Ord1 (HashMap k) where
 -- versions, OSes, or architectures, neither is an actual order of elements in
 -- 'HashMap' or an result of `compare`.is stable.
 instance (Ord k, Hashable k, Ord v) => Ord (HashMap k v) where
-    compare = cmp compare compare
+    compare = cmp1 compare
 
-cmp :: (k -> k' -> Ordering) -> (v -> v' -> Ordering)
+cmp1 :: (Ord k, Hashable k) => (v -> v' -> Ordering)
+    -> HashMap k v -> HashMap k v' -> Ordering
+cmp1 cmpv t1 t2 = go (toList' t1 []) (toList' t2 [])
+  where
+    go (Leaf k1 l1 : tl1) (Leaf k2 l2 : tl2)
+      = compare k1 k2 `mappend`
+        leafCompare l1 l2 `mappend`
+        go tl1 tl2
+    go (Collision h1 (L k11 v11) (L k12 v12) hm1 : tl1) (Collision h2 (L k21 v21) (L k22 v22) hm2 : tl2)
+      = compare h1 h2 `mappend`
+        compare (length hm1) (length hm2) `mappend`
+        liftCompareList pairCompare
+          -- We don't use sortOn because fst is cheap.
+          (L.sortBy (compare `on` fst) $
+            (k11, v11) : (k12, v12) : toList hm1)
+          (L.sortBy (compare `on` fst) $
+            (k21, v21) : (k22, v22) : toList hm2) `mappend`
+        go tl1 tl2
+    go (Leaf _ _ : _) (Collision _ _ _ _ : _) = LT
+    go (Collision _ _ _ _ : _) (Leaf _ _ : _) = GT
+    go [] [] = EQ
+    go [] _  = LT
+    go _  [] = GT
+    go _ _ = error "cmp2: Should never happen, toList' includes non Leaf / Collision"
+
+    leafCompare (L k v) (L k' v') = compare k k' `mappend` cmpv v v'
+    pairCompare (k1, v1) (k2, v2) = (k1 `compare` k2) `mappend` (v1 `cmpv` v2)
+
+-- Our own copy of liftCompare for lists.
+liftCompareList :: (a -> b -> Ordering) -> [a] -> [b] -> Ordering
+liftCompareList _ [] [] = EQ
+liftCompareList _ [] _ = LT
+liftCompareList _ _ [] = GT
+liftCompareList cmp (x : xs) (y : ys) = cmp x y `mappend` liftCompareList cmp xs ys
+
+cmp2 :: (k -> k' -> Ordering) -> (v -> v' -> Ordering)
     -> HashMap k v -> HashMap k' v' -> Ordering
-cmp cmpk cmpv t1 t2 = go (toList' t1 []) (toList' t2 [])
+cmp2 cmpk cmpv t1 t2 = go (toList' t1 []) (toList' t2 [])
   where
     go (Leaf k1 l1 : tl1) (Leaf k2 l2 : tl2)
       = compare k1 k2 `mappend`
@@ -369,7 +405,7 @@ cmp cmpk cmpv t1 t2 = go (toList' t1 []) (toList' t2 [])
     go [] [] = EQ
     go [] _  = LT
     go _  [] = GT
-    go _ _ = error "cmp: Should never happend, toList' includes non Leaf / Collision"
+    go _ _ = error "cmp2: Should never happen, toList' includes non Leaf / Collision"
 
     leafCompare (L k v) (L k' v') = cmpk k k' `mappend` cmpv v v'
 
diff --git a/tests/HashMapProperties.hs b/tests/HashMapProperties.hs
index b2b4c422..8f1833ae 100644
--- a/tests/HashMapProperties.hs
+++ b/tests/HashMapProperties.hs
@@ -27,6 +27,9 @@ import Data.Functor.Identity (Identity (..))
 import Control.Applicative (Const (..))
 import Test.QuickCheck.Function (Fun, apply)
 import Test.QuickCheck.Poly (A, B)
+#if MIN_VERSION_base(4,9,0)
+import Data.Functor.Classes (eq2, compare2)
+#endif
 
 -- Key type that generates more hash collisions.
 newtype Key = K { unK :: Int }
@@ -44,6 +47,15 @@ instance Hashable Key where
 pEq :: [(Key, Int)] -> [(Key, Int)] -> Bool
 pEq xs = (M.fromList xs ==) `eq` (HM.fromList xs ==)
 
+-- Caution: this is a rather weak test. Fortunately, the "Permutation"
+-- properties in the HashSet test suite should catch most of what this
+-- doesn't.
+pEq2 :: [(Key, Int)] -> [(Key, Int)] -> Property
+pEq2 xs ys = (x == y) === (x `eq2` y)
+  where
+    x = HM.fromList xs
+    y = HM.fromList ys
+
 pNeq :: [(Key, Int)] -> [(Key, Int)] -> Bool
 pNeq xs = (M.fromList xs /=) `eq` (HM.fromList xs /=)
 
@@ -76,6 +88,12 @@ pOrd3 xs ys = case (compare x y, compare y x) of
     x = HM.fromList xs
     y = HM.fromList ys
 
+pOrd4 :: [(Key, Int)] -> [(Key, Int)] -> Property
+pOrd4 xs ys = compare2 x y === compare x y
+  where
+    x = HM.fromList xs
+    y = HM.fromList ys
+
 pOrdEq :: [(Key, Int)] -> [(Key, Int)] -> Bool
 pOrdEq xs ys = case (compare x y, x == y) of
     (EQ, True)  -> True
@@ -379,9 +397,11 @@ tests =
       testGroup "instances"
       [ testProperty "==" pEq
       , testProperty "/=" pNeq
+      , testProperty "eq2 = (==)" pEq2
       , testProperty "compare reflexive" pOrd1
       , testProperty "compare transitive" pOrd2
       , testProperty "compare antisymmetric" pOrd3
+      , testProperty "compare2 = compare" pOrd4
       , testProperty "Ord => Eq" pOrdEq
       , testProperty "Read/Show" pReadShow
       , testProperty "Functor" pFunctor
diff --git a/tests/HashSetProperties.hs b/tests/HashSetProperties.hs
index 130c1dc4..fd65bf9e 100644
--- a/tests/HashSetProperties.hs
+++ b/tests/HashSetProperties.hs
@@ -14,6 +14,7 @@ import Data.Ord (comparing)
 import Test.QuickCheck (Arbitrary, Property, (==>), (===))
 import Test.Framework (Test, defaultMain, testGroup)
 import Test.Framework.Providers.QuickCheck2 (testProperty)
+import Data.Functor.Classes (eq1, compare1)
 
 -- Key type that generates more hash collisions.
 newtype Key = K { unK :: Int }
@@ -80,13 +81,29 @@ pFoldable :: [Int] -> Bool
 pFoldable = (L.sort . Foldable.foldr (:) []) `eq`
             (L.sort . Foldable.foldr (:) [])
 
-pPermutationEq :: [Key] -> [Int] -> Bool
-pPermutationEq xs is = S.fromList xs == S.fromList ys
+pPermutationEq :: [(Key, Int)] -> Bool
+pPermutationEq xs = S.fromList x == S.fromList y
   where
-    ys = shuffle is xs
-    shuffle idxs = L.map snd
-                 . L.sortBy (comparing fst)
-                 . L.zip (idxs ++ [L.maximum (0:is) + 1 ..])
+    x = L.map fst xs
+    y = L.map fst . L.sortBy (comparing snd) $ xs
+
+pPermutationEq1 :: [(Key, Int)] -> Bool
+pPermutationEq1 xs = S.fromList x `eq1` S.fromList y
+  where
+    x = L.map fst xs
+    y = L.map fst . L.sortBy (comparing snd) $ xs
+
+pPermutationOrd :: [(Key, Int)] -> Bool
+pPermutationOrd xs = (S.fromList x `compare` S.fromList y) == EQ
+  where
+    x = L.map fst xs
+    y = L.map fst . L.sortBy (comparing snd) $ xs
+
+pPermutationOrd1 :: [(Key, Int)] -> Bool
+pPermutationOrd1 xs = (S.fromList x `compare1` S.fromList y) == EQ
+  where
+    x = L.map fst xs
+    y = L.map fst . L.sortBy (comparing snd) $ xs
 
 pHashable :: [Key] -> [Int] -> Int -> Property
 pHashable xs is salt =
@@ -174,6 +191,9 @@ tests =
       testGroup "instances"
       [ testProperty "==" pEq
       , testProperty "Permutation ==" pPermutationEq
+      , testProperty "Permutation eq1" pPermutationEq1
+      , testProperty "Permutation compare" pPermutationOrd
+      , testProperty "Permutation compare1" pPermutationOrd1
       , testProperty "/=" pNeq
       , testProperty "compare reflexive" pOrd1
       , testProperty "compare transitive" pOrd2

From 6ec3979eda9555bc3ac7af55343727401d647268 Mon Sep 17 00:00:00 2001
From: Tom Sydney Kerckhove <syd@cs-syd.eu>
Date: Sat, 27 Oct 2018 12:11:11 +0300
Subject: [PATCH 52/69] equal1 and comp1

---
 Data/HashMap/Base.hs |  4 ++++
 tests/Validity.hs    | 29 +++++++++++++++++++++++++++--
 2 files changed, 31 insertions(+), 2 deletions(-)

diff --git a/Data/HashMap/Base.hs b/Data/HashMap/Base.hs
index cb3d784c..daf18c47 100644
--- a/Data/HashMap/Base.hs
+++ b/Data/HashMap/Base.hs
@@ -23,6 +23,10 @@ module Data.HashMap.Base
       -- * Basic interface
     , null
     , size
+    , equal1
+    , equal2
+    , cmp1
+    , cmp2
     , member
     , lookup
     , lookupDefault
diff --git a/tests/Validity.hs b/tests/Validity.hs
index fc4eeee5..566c0220 100644
--- a/tests/Validity.hs
+++ b/tests/Validity.hs
@@ -24,8 +24,9 @@ import qualified Data.HashMap.Lazy as HM
 import qualified Data.HashMap.Array as A
 import Data.HashMap.Base (HashMap(..), Leaf(..), UnconsHM(..))
 import qualified Data.HashMap.Base as HM
-       (bitsPerSubkey, defaultSalt, hashWithSalt, index, mask, nextSalt,
-        sparseIndex, unconsHM)
+       (bitsPerSubkey, cmp1, cmp2, defaultSalt, equal1, equal2,
+        hashWithSalt, index, mask, nextSalt, sparseIndex, unConsA,
+        unConsHM)
 
 import Data.GenValidity
        (GenUnchecked(..), GenValid(..), genSplit, genSplit4)
@@ -270,6 +271,26 @@ pNull = producesValidsOnValids (HM.null :: HM.HashMap Key Int -> Bool)
 pSize :: Property
 pSize = producesValidsOnValids (HM.size :: HM.HashMap Key Int -> Int)
 
+pEqual1 :: Fun (Int, Int) Bool -> Property
+pEqual1 f =
+    producesValidsOnValids2
+        (HM.equal1 (applyFun2 f) :: HM.HashMap Key Int -> HM.HashMap Key Int -> Bool)
+
+pEqual2 :: Fun (Key, Key) Bool -> Fun (Int, Int) Bool -> Property
+pEqual2 f g =
+    producesValidsOnValids2
+        (HM.equal2 (applyFun2 f) (applyFun2 g) :: HM.HashMap Key Int -> HM.HashMap Key Int -> Bool)
+
+pCmp1 :: Fun (Int, Int) Ordering -> Property
+pCmp1 f =
+    producesValidsOnValids2
+        (HM.cmp1 (applyFun2 f) :: HM.HashMap Key Int -> HM.HashMap Key Int -> Ordering)
+
+pCmp2 :: Fun (Key, Key) Ordering -> Fun (Int, Int) Ordering -> Property
+pCmp2 f g =
+    producesValidsOnValids2
+        (HM.cmp2 (applyFun2 f) (applyFun2 g) :: HM.HashMap Key Int -> HM.HashMap Key Int -> Ordering)
+
 pMember :: Property
 pMember =
     producesValidsOnValids2 (HM.member :: Key -> HM.HashMap Key Int -> Bool)
@@ -465,6 +486,10 @@ tests =
              [ testProperty "singleton produces valid HashMaps" pSingleton
              , testProperty "null produces valid Bools" pNull
              , testProperty "size produces valid HashMaps" pSize
+             , testProperty "equal1 produce valid Bools" pEqual1
+             , testProperty "equal2 produce valid Bools" pEqual2
+             , testProperty "cmp1 produce valid Orderings" pCmp1
+             , testProperty "cmp2 produce valid Orderings" pCmp2
              , testProperty "member produces valid HashMaps" pMember
              , testProperty "lookup produces valid HashMaps" pLookup
              , testProperty

From 5ac7859d9ef401ab5902bd22d339c19cfabcca98 Mon Sep 17 00:00:00 2001
From: Tom Sydney Kerckhove <syd@fpcomplete.com>
Date: Mon, 29 Oct 2018 11:47:59 +0100
Subject: [PATCH 53/69] done for now?

---
 tests/Validity.hs | 221 ++++++++++++++++++++++++++--------------------
 1 file changed, 125 insertions(+), 96 deletions(-)

diff --git a/tests/Validity.hs b/tests/Validity.hs
index 566c0220..5b176031 100644
--- a/tests/Validity.hs
+++ b/tests/Validity.hs
@@ -24,22 +24,44 @@ import qualified Data.HashMap.Lazy as HM
 import qualified Data.HashMap.Array as A
 import Data.HashMap.Base (HashMap(..), Leaf(..), UnconsHM(..))
 import qualified Data.HashMap.Base as HM
-       (bitsPerSubkey, cmp1, cmp2, defaultSalt, equal1, equal2,
-        hashWithSalt, index, mask, nextSalt, sparseIndex, unConsA,
-        unConsHM)
-
-import Data.GenValidity
-       (GenUnchecked(..), GenValid(..), genSplit, genSplit4)
+    ( bitsPerSubkey
+    , cmp1
+    , cmp2
+    , defaultSalt
+    , equal1
+    , equal2
+    , hashWithSalt
+    , index
+    , mask
+    , nextSalt
+    , sparseIndex
+    , unconsHM
+    )
+import qualified Data.HashSet as HS
+import Data.HashSet (HashSet)
+
+import Data.GenValidity (GenUnchecked(..), GenValid(..), genSplit, genSplit4)
 import Data.Validity (Validity)
 import Test.Framework (Test, defaultMain, testGroup)
 import Test.Framework.Providers.QuickCheck2 (testProperty)
 import Test.QuickCheck
-       (Arbitrary, CoArbitrary, Function, Gen, Property, forAll, oneof,
-        resize, sized)
+    ( Arbitrary
+    , CoArbitrary
+    , Function
+    , Gen
+    , Property
+    , forAll
+    , oneof
+    , resize
+    , sized
+    )
 import Test.QuickCheck.Function (Fun, apply, applyFun2, applyFun3)
 import Test.Validity
-       (producesValidsOnValids, producesValidsOnValids2,
-        producesValidsOnValids3, shouldBeValid)
+    ( producesValidsOnValids
+    , producesValidsOnValids2
+    , producesValidsOnValids3
+    , shouldBeValid
+    )
 
 instance (Validity k, Validity v) => Validity (Leaf k v) where
     validate (L k v) = mconcat [annotate k "key", annotate v "value"]
@@ -52,10 +74,7 @@ instance (Eq k, Hashable k, Validity k, Validity v) =>
     validate UnconsEmptyHM = decorate "UnconsEmptyHM" valid
     validate (UnconsedHM l hm) =
         decorate "UnconsedHM" $
-        mconcat
-            [ decorate "Leaf" $ validate l
-            , decorate "Map" $ validate hm
-            ]
+        mconcat [decorate "Leaf" $ validate l, decorate "Map" $ validate hm]
 
 instance (Eq k, Hashable k, Validity k, Validity v) =>
          Validity (HashMap k v) where
@@ -89,8 +108,8 @@ instance (Eq k, Hashable k, Validity k, Validity v) =>
                                             check
                                             "The hash, when masked with the current bitmask, of the key, produces the index in the array where the hashmap is found" $
                                         let h = HM.hashWithSalt s k
-                                        in HM.sparseIndex bm (HM.mask h bs) ==
-                                           ix
+                                         in HM.sparseIndex bm (HM.mask h bs) ==
+                                            ix
                                   ]
                         , check
                               (A.length a == popCount bm)
@@ -114,7 +133,7 @@ instance (Eq k, Hashable k, Validity k, Validity v) =>
                                             check
                                             "The hash, when masked with the current bitmask, of the key, produces the index in the array where the hashmap is found" $
                                         let h = HM.hashWithSalt s k
-                                        in HM.index h bs == ix
+                                         in HM.index h bs == ix
                                   ]
                         , check
                               (A.length a == 2 ^ HM.bitsPerSubkey)
@@ -149,6 +168,9 @@ instance (Eq k, Hashable k, Validity k, Validity v) =>
                               "All recursive keys hash to the hash within the collision, using the salt at this level."
                         ]
 
+instance (Eq v, Hashable v, Validity v) => Validity (HashSet v) where
+    validate hs = decorate "asMap" $ validate $ HS.toMap hs
+
 uniques :: Eq a => [a] -> Bool
 uniques l = length (nub l) == length l
 #if !MIN_VERSION_validity(0,6,0)
@@ -457,96 +479,103 @@ pFromListWith f =
     producesValidsOnValids
         (HM.fromListWith (applyFun2 f) :: [(Key, Int)] -> HashMap Key Int)
 
+pKeysSet :: Property
+pKeysSet = producesValidsOnValids (HM.keysSet :: HashMap Key Int -> HashSet Key)
+
 pUnconsHM :: Property
 pUnconsHM =
-    producesValidsOnValids
-        (HM.unconsHM :: HashMap Key Int -> UnconsHM Key Int)
+    producesValidsOnValids (HM.unconsHM :: HashMap Key Int -> UnconsHM Key Int)
 
 -- There isn't currently a pUnconsA because I (David Feuer) don't know
 -- the right way to tell genvalidity-hspec that we only want cases
 -- where the array is non-empty and all of its elements are non-empty.
-
 ------------------------------------------------------------------------
 -- * Test list
 tests :: [Test]
 tests =
     let genValidHelper gen = forAll gen shouldBeValid
     -- Basic interface
-    in [ testGroup
-             "HashMap"
-             [ testProperty "genValid generates valid values for Leaf" $
-               genValidHelper (genValid :: Gen (Leaf Key Int))
-             , testProperty "genValid generates valid values for Array" $
-               genValidHelper (genValid :: Gen (A.Array Key))
-             , testProperty "genValid generates valid values for HashMap" $
-               genValidHelper (genValid :: Gen (HashMap Key Int))
-             ]
-       , testGroup
-             "HashMap"
-             [ testProperty "singleton produces valid HashMaps" pSingleton
-             , testProperty "null produces valid Bools" pNull
-             , testProperty "size produces valid HashMaps" pSize
-             , testProperty "equal1 produce valid Bools" pEqual1
-             , testProperty "equal2 produce valid Bools" pEqual2
-             , testProperty "cmp1 produce valid Orderings" pCmp1
-             , testProperty "cmp2 produce valid Orderings" pCmp2
-             , testProperty "member produces valid HashMaps" pMember
-             , testProperty "lookup produces valid HashMaps" pLookup
-             , testProperty
-                   "lookupDefault produces valid HashMaps"
-                   pLookupDefault
-             , testProperty "insert produces valid HashMaps" pInsert
-             , testProperty "insertWith produces valid HashMaps" pInsertWith
-             , testProperty "delete produces valid HashMaps" pDelete
-             , testProperty "adjust produces valid HashMaps" pAdjust
-             , testProperty "update produces valid HashMaps" pUpdate
-             , testProperty "alter produces valid HashMaps" pAlter
-             , testProperty "alterF produces valid HashMaps" pAlterF
-             , testProperty "union produces valid HashMaps" pUnion
-             , testProperty "unionWith produces valid HashMaps" pUnionWith
-             , testProperty "unionWithKey produces valid HashMaps" pUnionWithKey
-             , testProperty "unions produces valid HashMaps" pUnions
-             , testProperty "map produces valid HashMaps" pMap
-             , testProperty "mapWithKey produces valid HashMaps" pMapWithKey
-             , testProperty
-                   "traverseWithKey produces valid HashMaps"
-                   pTraverseWithKey
-             , testProperty "difference produces valid HashMaps" pDifference
-             , testProperty
-                   "differenceWith produces valid HashMaps"
-                   pDifferenceWith
-             , testProperty "intersection produces valid HashMaps" pIntersection
-             , testProperty
-                   "intersectionWith produces valid HashMaps"
-                   pIntersectionWith
-             , testProperty
-                   "intersectionWithKey produces valid HashMaps"
-                   pIntersectionWithKey
-             , testProperty "foldl' produces valid HashMaps" pFoldl'
-             , testProperty
-                   "foldlWithKey' produces valid HashMaps"
-                   pFoldlWithKey'
-             , testProperty "foldr produces valid HashMaps" pFoldr
-             , testProperty "foldrWithKey produces valid HashMaps" pFoldrWithKey
-             , testProperty "filter produces valid HashMaps" pFilter
-             , testProperty
-                   "filterWithKey produces valid HashMaps"
-                   pFilterWithKey
-             , testProperty "mapMaybe produces valid HashMaps" pMapMaybe
-             , testProperty
-                   "mapMaybeWithKey produces valid HashMaps"
-                   pMapMaybeWithKey
-             , testProperty "keys produces valid lists" pKeys
-             , testProperty "elems produces valid lists" pElems
-             , testProperty "toList produces valid lists" pToList
-             , testProperty "fromList produces valid HashMaps" pFromList
-             , testProperty "fromListWith produces valid HashMaps" pFromListWith
-             , testProperty "unconsHM produces valid HashMaps" pUnconsHM
-             ]
-       ]
-
--- TODO keysSet
-------------------------------------------------------------------------
--- * Test harness
+     in [ testGroup
+              "HashMap"
+              [ testProperty "genValid generates valid values for Leaf" $
+                genValidHelper (genValid :: Gen (Leaf Key Int))
+              , testProperty "genValid generates valid values for Array" $
+                genValidHelper (genValid :: Gen (A.Array Key))
+              , testProperty "genValid generates valid values for HashMap" $
+                genValidHelper (genValid :: Gen (HashMap Key Int))
+              ]
+        , testGroup
+              "HashMap"
+              [ testProperty "singleton produces valid HashMaps" pSingleton
+              , testProperty "null produces valid Bools" pNull
+              , testProperty "size produces valid HashMaps" pSize
+              , testProperty "equal1 produce valid Bools" pEqual1
+              , testProperty "equal2 produce valid Bools" pEqual2
+              , testProperty "cmp1 produce valid Orderings" pCmp1
+              , testProperty "cmp2 produce valid Orderings" pCmp2
+              , testProperty "member produces valid HashMaps" pMember
+              , testProperty "lookup produces valid HashMaps" pLookup
+              , testProperty
+                    "lookupDefault produces valid HashMaps"
+                    pLookupDefault
+              , testProperty "insert produces valid HashMaps" pInsert
+              , testProperty "insertWith produces valid HashMaps" pInsertWith
+              , testProperty "delete produces valid HashMaps" pDelete
+              , testProperty "adjust produces valid HashMaps" pAdjust
+              , testProperty "update produces valid HashMaps" pUpdate
+              , testProperty "alter produces valid HashMaps" pAlter
+              , testProperty "alterF produces valid HashMaps" pAlterF
+              , testProperty "union produces valid HashMaps" pUnion
+              , testProperty "unionWith produces valid HashMaps" pUnionWith
+              , testProperty
+                    "unionWithKey produces valid HashMaps"
+                    pUnionWithKey
+              , testProperty "unions produces valid HashMaps" pUnions
+              , testProperty "map produces valid HashMaps" pMap
+              , testProperty "mapWithKey produces valid HashMaps" pMapWithKey
+              , testProperty
+                    "traverseWithKey produces valid HashMaps"
+                    pTraverseWithKey
+              , testProperty "difference produces valid HashMaps" pDifference
+              , testProperty
+                    "differenceWith produces valid HashMaps"
+                    pDifferenceWith
+              , testProperty
+                    "intersection produces valid HashMaps"
+                    pIntersection
+              , testProperty
+                    "intersectionWith produces valid HashMaps"
+                    pIntersectionWith
+              , testProperty
+                    "intersectionWithKey produces valid HashMaps"
+                    pIntersectionWithKey
+              , testProperty "foldl' produces valid HashMaps" pFoldl'
+              , testProperty
+                    "foldlWithKey' produces valid HashMaps"
+                    pFoldlWithKey'
+              , testProperty "foldr produces valid HashMaps" pFoldr
+              , testProperty
+                    "foldrWithKey produces valid HashMaps"
+                    pFoldrWithKey
+              , testProperty "filter produces valid HashMaps" pFilter
+              , testProperty
+                    "filterWithKey produces valid HashMaps"
+                    pFilterWithKey
+              , testProperty "mapMaybe produces valid HashMaps" pMapMaybe
+              , testProperty
+                    "mapMaybeWithKey produces valid HashMaps"
+                    pMapMaybeWithKey
+              , testProperty "keys produces valid lists" pKeys
+              , testProperty "elems produces valid lists" pElems
+              , testProperty "toList produces valid lists" pToList
+              , testProperty "fromList produces valid HashMaps" pFromList
+              , testProperty
+                    "fromListWith produces valid HashMaps"
+                    pFromListWith
+              , testProperty "unconsHM produces valid HashMaps" pUnconsHM
+              , testProperty "keysSet produces valid HashSets" pKeysSet
+              ]
+        ]
+
 main :: IO ()
 main = defaultMain tests

From cbf034b2ca0e25ed3d928d8a9e66a3760d40704d Mon Sep 17 00:00:00 2001
From: Tom Sydney Kerckhove <syd@fpcomplete.com>
Date: Mon, 29 Oct 2018 12:04:47 +0100
Subject: [PATCH 54/69] Tried to fix the ghc-8.0.2 part of the CI

---
 Data/HashMap/Base.hs |  9 ++++-----
 newer-stack.yaml     |  3 ---
 other.yaml           | 42 ++++++++++++++++++++++++++++++++++++++++++
 tests/Validity.hs    |  4 ++--
 4 files changed, 48 insertions(+), 10 deletions(-)
 delete mode 100644 newer-stack.yaml
 create mode 100644 other.yaml

diff --git a/Data/HashMap/Base.hs b/Data/HashMap/Base.hs
index daf18c47..81426d3e 100644
--- a/Data/HashMap/Base.hs
+++ b/Data/HashMap/Base.hs
@@ -188,7 +188,6 @@ instance (NFData k, NFData v) => NFData (Leaf k v) where
 
 -- | A map from keys to values.  A map cannot contain duplicate keys;
 -- each key can map to at most one value.
--- TODO document all invariants
 data HashMap k v
     = Empty
     | BitmapIndexed !Bitmap !(A.Array (HashMap k v))
@@ -568,7 +567,7 @@ lookup# k m = lookupCont (\_ -> (# (# #) | #)) (\v -> (# | v #)) (hashWithSalt d
 
 #else
 
-lookup k m = lookupCont (\_ -> Nothing) (\v _i -> Just v) (hashWithSalt s k) defaultSalt k m
+lookup k m = lookupCont (\_ -> Nothing) (\v -> Just v) (hashWithSalt defaultSalt k) defaultSalt k m
 {-# INLINABLE lookup #-}
 #endif
 
@@ -587,7 +586,7 @@ lookup' h s k m = case lookupWithRes# h s k m of
   (# | a #) -> Just a
 {-# INLINE lookup' #-}
 #else
-lookup' h s k m = lookupCont (\_ -> Nothing) (\v _i -> Just v) h s k m
+lookup' h s k m = lookupCont (\_ -> Nothing) (\v -> Just v) h s k m
 {-# INLINABLE lookup' #-}
 #endif
 
@@ -1847,10 +1846,10 @@ unconsA ary =
 
 data UnconsA k v
   = NowEmptyA !(Leaf k v)
-  | UnconsedFromFirstA
+  | UnconsedFromFirstA -- Got an element out of the array, but leave the array.
     !(Leaf k v) -- The leaf that was un-consed
     !(A.Array (HashMap k v)) -- The leftover array
-  | RemovedFirstA
+  | RemovedFirstA -- Got an element out of the array, and removed the array because it became empty.
     !(Leaf k v) -- The leaf that was un-consed
     !(A.Array (HashMap k v)) -- The leftover array
   deriving Show
diff --git a/newer-stack.yaml b/newer-stack.yaml
deleted file mode 100644
index 26f10a32..00000000
--- a/newer-stack.yaml
+++ /dev/null
@@ -1,3 +0,0 @@
-resolver: lts-12.12
-packages:
-- .
diff --git a/other.yaml b/other.yaml
new file mode 100644
index 00000000..b1d9d75f
--- /dev/null
+++ b/other.yaml
@@ -0,0 +1,42 @@
+resolver: ghc-8.0.2
+packages:
+- .
+extra-deps:
+- hashable-1.2.7.0@sha256:03b6836ca9cd3ad0e5a2f3cce989b001dd0e05f306a873db3196037adb30e0a4
+- text-1.2.3.1@sha256:fc9719142e5cdd6f254b3f4831b133d3fad697ae9b54fe26424f0e023c8cc87d
+- ChasingBottoms-1.3.1.5@sha256:22fcd1eb29164e5b298904ad3d5b81c082bb9ffb15ebbd134bbfa743ee70ff97
+- HUnit-1.6.0.0@sha256:8014b27c884becd8041214a1ab263fa92244ca62700a911aff604a1047869298
+- QuickCheck-2.12.6.1@sha256:95b4e3b01033bf7d2ad21d0085266dba378477ac88e3d11ff238fc9db2575e6d
+- containers-0.6.0.1@sha256:50024f330653c702a339f7743522b3c2a4fff9c6bf5a7071affe270da2ee649a
+- genvalidity-0.6.1.0@sha256:bac6bae7671c2c8198eec4f27d92310de0d6b88aca4c4f56dae3ab2a987f54c1
+- genvalidity-hspec-0.6.2.0@sha256:d74da398f241b2877613c471f3b4e02801430f0647f0fb2817f2779a636341ad
+- test-framework-0.8.2.0@sha256:8ce5620cddac0deb0b29d46ceaaf6810b4ac5b2b8a620687de336fe1ec0dc6a9
+- test-framework-hunit-0.3.0.2@sha256:7fd007e9cb082cd64a2213a6d36acf057f7d6df6b5343a088e81b2b3a9a23545
+- test-framework-quickcheck2-0.3.0.5@sha256:7e306ac4802fcdc294298335a13335db3ee75face72f1cf6f3bff6590c7d9b5c
+- validity-0.8.0.0@sha256:3712b48461dc58f0e1aecb7ae016c6702299a875282bb7b51e75eca2a65e8b69
+- ansi-terminal-0.8.1@sha256:4cebbd2034dcd9029369c0a49c72666be8dacd11a2827d33bcfa539f2933614a
+- ansi-wl-pprint-0.6.8.2@sha256:8cb4b04401948c08feafa49e7ee0982b8492d599163107b6934093f1a912f54e
+- call-stack-0.1.0@sha256:3453a0c5ed3a7a7de0cc0703907e05bd251c766cce8a38efe41b7188d228e3fa
+- erf-2.0.0.0@sha256:11c5d3747d17b589009cbe9656ca792e4b5b2560d4aa44f6f1e80044794b1a8b
+- extensible-exceptions-0.1.1.4@sha256:eb5fe684a7ffe8d1ed2ed6cdaec7dfb29efc780811ea7158a64edc2abc516f47
+- genvalidity-property-0.2.1.1@sha256:3ee8a594ce8b10b4624c7c8fe5aeabf573728a6ca36a92e227fdb6a9d22e862b
+- hostname-1.0@sha256:8203b6ecd14ca1ef12f73a471b0a6a4be3ad4568d8b84f2bc4bc9e0abb8c4153
+- hspec-2.5.8@sha256:7fae2ebfe990f726e12980980b8c1af32755048a68e51e814095c89342634441
+- hspec-core-2.5.8@sha256:94e5259328977b867d73eba1bd667e34cfbc2c68b46009cbdc54589b483a87e3
+- mtl-2.2.2@sha256:1050fb71acd9f5d67da7d992583f5bd0eb14407b9dc7acc122af1b738b706ca3
+- old-locale-1.0.0.7@sha256:fa998be2c7e00cd26a6e9075bea790caaf3932caa3e9497ad69bc20380dd6911
+- random-1.1@sha256:7b67624fd76ddf97c206de0801dc7e888097e9d572974be9b9ea6551d76965df
+- regex-posix-0.95.2@sha256:4fba55cdae7fb6c11ee2f5e823e56cc5fc30d7041edeef4c81f7f26b9235d624
+- syb-0.7@sha256:9c559edeef6b9eb1362d7e16fbb15e786be871050cf085a46fcead282bb86e89
+- tf-random-0.5@sha256:14012837d0f0e18fdbbe3d56e67da8622ee5e20b180abce952dd50bd9f36b326
+- xml-1.3.14@sha256:e52f778760b7def64ced0f39ad2022d839baca1e3d730cdc33ef89f66145b26d
+- clock-0.7.2@sha256:c5c2514aead260101c7528d10bf0f41d9d1d7b919136e2dff77a57ec16740bd2
+- colour-2.3.4@sha256:90257dac3d9149b2b384184638b610bf95d7d180e1e4d3a329e038f18c6b7859
+- hspec-discover-2.5.8@sha256:573e0b4be3511d302bdfd532dff5bb8a1f85aca8359c2949fbfe6dd07bd1ecb7
+- hspec-expectations-0.8.2@sha256:e2db24881baadc2d9d23b03cb629e80dcbda89a6b04ace9adb5f4d02ef8b31aa
+- primitive-0.6.4.0@sha256:5b6a2c3cc70a35aabd4565fcb9bb1dd78fe2814a36e62428a9a1aae8c32441a1
+- quickcheck-io-0.2.0@sha256:7bf0b68fb90873825eb2e5e958c1b76126dcf984debb998e81673e6d837e0b2d
+- regex-base-0.93.2@sha256:eb820674e31c6b8c87a45d09115ba518c7cd0844cffc5437291289592681070e
+- setenv-0.1.1.3@sha256:c5916ac0d2a828473cd171261328a290afe0abd799db1ac8c310682fe778c45b
+- stm-2.5.0.0@sha256:1fb8bd117550d560d1b33a6404e27fdb090e70921e0f6434722cdbbce20d8256
+
diff --git a/tests/Validity.hs b/tests/Validity.hs
index 5b176031..9b309202 100644
--- a/tests/Validity.hs
+++ b/tests/Validity.hs
@@ -71,7 +71,7 @@ instance Validity a => Validity (A.Array a) where
 
 instance (Eq k, Hashable k, Validity k, Validity v) =>
          Validity (UnconsHM k v) where
-    validate UnconsEmptyHM = decorate "UnconsEmptyHM" valid
+    validate UnconsEmptyHM = decorate "UnconsEmptyHM" mempty
     validate (UnconsedHM l hm) =
         decorate "UnconsedHM" $
         mconcat [decorate "Leaf" $ validate l, decorate "Map" $ validate hm]
@@ -216,7 +216,7 @@ instance GenUnchecked a => GenUnchecked (A.Array a) where
     genUnchecked = do
         l <- genUnchecked
         pure $ A.fromList (length l) l
-    shrinkUnchecked _ = [] -- TODO: write shrinking
+    shrinkUnchecked = fmap (\l -> A.fromList (length l) l) . shrinkUnchecked . A.toList
 
 instance GenValid a => GenValid (A.Array a) where
     genValid = do

From b804e5c625ca2748cd426ec3e10d07e80f44cb61 Mon Sep 17 00:00:00 2001
From: Tom Sydney Kerckhove <syd@fpcomplete.com>
Date: Mon, 29 Oct 2018 12:10:46 +0100
Subject: [PATCH 55/69] Woops

---
 other.yaml | 42 ------------------------------------------
 1 file changed, 42 deletions(-)
 delete mode 100644 other.yaml

diff --git a/other.yaml b/other.yaml
deleted file mode 100644
index b1d9d75f..00000000
--- a/other.yaml
+++ /dev/null
@@ -1,42 +0,0 @@
-resolver: ghc-8.0.2
-packages:
-- .
-extra-deps:
-- hashable-1.2.7.0@sha256:03b6836ca9cd3ad0e5a2f3cce989b001dd0e05f306a873db3196037adb30e0a4
-- text-1.2.3.1@sha256:fc9719142e5cdd6f254b3f4831b133d3fad697ae9b54fe26424f0e023c8cc87d
-- ChasingBottoms-1.3.1.5@sha256:22fcd1eb29164e5b298904ad3d5b81c082bb9ffb15ebbd134bbfa743ee70ff97
-- HUnit-1.6.0.0@sha256:8014b27c884becd8041214a1ab263fa92244ca62700a911aff604a1047869298
-- QuickCheck-2.12.6.1@sha256:95b4e3b01033bf7d2ad21d0085266dba378477ac88e3d11ff238fc9db2575e6d
-- containers-0.6.0.1@sha256:50024f330653c702a339f7743522b3c2a4fff9c6bf5a7071affe270da2ee649a
-- genvalidity-0.6.1.0@sha256:bac6bae7671c2c8198eec4f27d92310de0d6b88aca4c4f56dae3ab2a987f54c1
-- genvalidity-hspec-0.6.2.0@sha256:d74da398f241b2877613c471f3b4e02801430f0647f0fb2817f2779a636341ad
-- test-framework-0.8.2.0@sha256:8ce5620cddac0deb0b29d46ceaaf6810b4ac5b2b8a620687de336fe1ec0dc6a9
-- test-framework-hunit-0.3.0.2@sha256:7fd007e9cb082cd64a2213a6d36acf057f7d6df6b5343a088e81b2b3a9a23545
-- test-framework-quickcheck2-0.3.0.5@sha256:7e306ac4802fcdc294298335a13335db3ee75face72f1cf6f3bff6590c7d9b5c
-- validity-0.8.0.0@sha256:3712b48461dc58f0e1aecb7ae016c6702299a875282bb7b51e75eca2a65e8b69
-- ansi-terminal-0.8.1@sha256:4cebbd2034dcd9029369c0a49c72666be8dacd11a2827d33bcfa539f2933614a
-- ansi-wl-pprint-0.6.8.2@sha256:8cb4b04401948c08feafa49e7ee0982b8492d599163107b6934093f1a912f54e
-- call-stack-0.1.0@sha256:3453a0c5ed3a7a7de0cc0703907e05bd251c766cce8a38efe41b7188d228e3fa
-- erf-2.0.0.0@sha256:11c5d3747d17b589009cbe9656ca792e4b5b2560d4aa44f6f1e80044794b1a8b
-- extensible-exceptions-0.1.1.4@sha256:eb5fe684a7ffe8d1ed2ed6cdaec7dfb29efc780811ea7158a64edc2abc516f47
-- genvalidity-property-0.2.1.1@sha256:3ee8a594ce8b10b4624c7c8fe5aeabf573728a6ca36a92e227fdb6a9d22e862b
-- hostname-1.0@sha256:8203b6ecd14ca1ef12f73a471b0a6a4be3ad4568d8b84f2bc4bc9e0abb8c4153
-- hspec-2.5.8@sha256:7fae2ebfe990f726e12980980b8c1af32755048a68e51e814095c89342634441
-- hspec-core-2.5.8@sha256:94e5259328977b867d73eba1bd667e34cfbc2c68b46009cbdc54589b483a87e3
-- mtl-2.2.2@sha256:1050fb71acd9f5d67da7d992583f5bd0eb14407b9dc7acc122af1b738b706ca3
-- old-locale-1.0.0.7@sha256:fa998be2c7e00cd26a6e9075bea790caaf3932caa3e9497ad69bc20380dd6911
-- random-1.1@sha256:7b67624fd76ddf97c206de0801dc7e888097e9d572974be9b9ea6551d76965df
-- regex-posix-0.95.2@sha256:4fba55cdae7fb6c11ee2f5e823e56cc5fc30d7041edeef4c81f7f26b9235d624
-- syb-0.7@sha256:9c559edeef6b9eb1362d7e16fbb15e786be871050cf085a46fcead282bb86e89
-- tf-random-0.5@sha256:14012837d0f0e18fdbbe3d56e67da8622ee5e20b180abce952dd50bd9f36b326
-- xml-1.3.14@sha256:e52f778760b7def64ced0f39ad2022d839baca1e3d730cdc33ef89f66145b26d
-- clock-0.7.2@sha256:c5c2514aead260101c7528d10bf0f41d9d1d7b919136e2dff77a57ec16740bd2
-- colour-2.3.4@sha256:90257dac3d9149b2b384184638b610bf95d7d180e1e4d3a329e038f18c6b7859
-- hspec-discover-2.5.8@sha256:573e0b4be3511d302bdfd532dff5bb8a1f85aca8359c2949fbfe6dd07bd1ecb7
-- hspec-expectations-0.8.2@sha256:e2db24881baadc2d9d23b03cb629e80dcbda89a6b04ace9adb5f4d02ef8b31aa
-- primitive-0.6.4.0@sha256:5b6a2c3cc70a35aabd4565fcb9bb1dd78fe2814a36e62428a9a1aae8c32441a1
-- quickcheck-io-0.2.0@sha256:7bf0b68fb90873825eb2e5e958c1b76126dcf984debb998e81673e6d837e0b2d
-- regex-base-0.93.2@sha256:eb820674e31c6b8c87a45d09115ba518c7cd0844cffc5437291289592681070e
-- setenv-0.1.1.3@sha256:c5916ac0d2a828473cd171261328a290afe0abd799db1ac8c310682fe778c45b
-- stm-2.5.0.0@sha256:1fb8bd117550d560d1b33a6404e27fdb090e70921e0f6434722cdbbce20d8256
-

From 35bd6794945d6cb93a6b18680dd7aaa3ba2e9cdd Mon Sep 17 00:00:00 2001
From: Tom Sydney Kerckhove <syd@fpcomplete.com>
Date: Mon, 29 Oct 2018 15:21:09 +0100
Subject: [PATCH 56/69] Added a check to the validity instance which exposes
 another problem

---
 tests/Validity.hs | 20 ++++++++++++++------
 1 file changed, 14 insertions(+), 6 deletions(-)

diff --git a/tests/Validity.hs b/tests/Validity.hs
index 9b309202..06f9f70e 100644
--- a/tests/Validity.hs
+++ b/tests/Validity.hs
@@ -13,6 +13,7 @@ module Main
 import GHC.Generics (Generic)
 
 import Data.Bits (popCount)
+import Data.Functor
 import Data.Hashable (Hashable(hashWithSalt))
 import Data.List (nub)
 import Data.Validity
@@ -69,7 +70,7 @@ instance (Validity k, Validity v) => Validity (Leaf k v) where
 instance Validity a => Validity (A.Array a) where
     validate a = annotate (A.toList a) "The array elements"
 
-instance (Eq k, Hashable k, Validity k, Validity v) =>
+instance (Eq k, Hashable k, Validity k, Eq v, Validity v) =>
          Validity (UnconsHM k v) where
     validate UnconsEmptyHM = decorate "UnconsEmptyHM" mempty
     validate (UnconsedHM l hm) =
@@ -78,10 +79,16 @@ instance (Eq k, Hashable k, Validity k, Validity v) =>
 
 instance (Eq k, Hashable k, Validity k, Validity v) =>
          Validity (HashMap k v) where
-    validate = go HM.defaultSalt 0
+    validate hm =
+        mconcat
+            [ go HM.defaultSalt 0 hm
+            , check
+                  (HM.fromList (HM.toList (hm $> ())) == (hm $> ()))
+                  "fromList and toList are inverses for this hashmap."
+            ]
       where
-        go s bs hm =
-            case hm of
+        go s bs hm_ =
+            case hm_ of
                 Empty -> mempty
                 (Leaf h l@(L k _)) ->
                     decorate "Leaf" $
@@ -216,7 +223,8 @@ instance GenUnchecked a => GenUnchecked (A.Array a) where
     genUnchecked = do
         l <- genUnchecked
         pure $ A.fromList (length l) l
-    shrinkUnchecked = fmap (\l -> A.fromList (length l) l) . shrinkUnchecked . A.toList
+    shrinkUnchecked =
+        fmap (\l -> A.fromList (length l) l) . shrinkUnchecked . A.toList
 
 instance GenValid a => GenValid (A.Array a) where
     genValid = do
@@ -257,7 +265,7 @@ instance (GenUnchecked k, GenUnchecked v) => GenUnchecked (HashMap k v) where
 
 -- It turns out it's almost impossible to write this instance without using internals.
 -- This is good-enough for now.
-instance (Eq k, Hashable k, GenValid k, GenValid v) =>
+instance (Eq k, Hashable k, GenValid k, Eq v, GenValid v) =>
          GenValid (HashMap k v) where
     genValid = HM.fromList <$> genValid
     shrinkValid hm = HM.fromList <$> shrinkValid (HM.toList hm)

From 886856b1915b72cabf053047131294c7e52d6076 Mon Sep 17 00:00:00 2001
From: Tom Sydney Kerckhove <syd@fpcomplete.com>
Date: Mon, 29 Oct 2018 15:24:04 +0100
Subject: [PATCH 57/69] got rid of compiler warnings

---
 tests/Validity.hs | 16 ++++++++--------
 1 file changed, 8 insertions(+), 8 deletions(-)

diff --git a/tests/Validity.hs b/tests/Validity.hs
index 06f9f70e..fa4bbaed 100644
--- a/tests/Validity.hs
+++ b/tests/Validity.hs
@@ -104,13 +104,13 @@ instance (Eq k, Hashable k, Validity k, Validity v) =>
                     mconcat
                         [ annotate bm "Bitmap"
                         , decorate "Array" $
-                          decorateList (zip [0 ..] $ A.toList a) $ \(ix, hm_) ->
+                          decorateList (zip [0 ..] $ A.toList a) $ \(ix, hm__) ->
                               mconcat
-                                  [ go s (bs + HM.bitsPerSubkey) hm_
+                                  [ go s (bs + HM.bitsPerSubkey) hm__
                                   , check
-                                        (not $ HM.null hm_)
+                                        (not $ HM.null hm__)
                                         "The sub HashMap is not empty"
-                                  , decorateList (HM.keys hm_) $ \k ->
+                                  , decorateList (HM.keys hm__) $ \k ->
                                         flip
                                             check
                                             "The hash, when masked with the current bitmask, of the key, produces the index in the array where the hashmap is found" $
@@ -129,13 +129,13 @@ instance (Eq k, Hashable k, Validity k, Validity v) =>
                     decorate "Full" $
                     mconcat
                         [ decorate "Array" $
-                          decorateList (zip [0 ..] $ A.toList a) $ \(ix, hm_) ->
+                          decorateList (zip [0 ..] $ A.toList a) $ \(ix, hm__) ->
                               mconcat
-                                  [ go s (bs + HM.bitsPerSubkey) hm_
+                                  [ go s (bs + HM.bitsPerSubkey) hm__
                                   , check
-                                        (not $ HM.null hm_)
+                                        (not $ HM.null hm__)
                                         "The sub HashMap is not empty"
-                                  , decorateList (HM.keys hm_) $ \k ->
+                                  , decorateList (HM.keys hm__) $ \k ->
                                         flip
                                             check
                                             "The hash, when masked with the current bitmask, of the key, produces the index in the array where the hashmap is found" $

From cf55ac474b1e171436e2984d13e72c1eb4f3f665 Mon Sep 17 00:00:00 2001
From: David Feuer <David.Feuer@gmail.com>
Date: Mon, 29 Oct 2018 12:45:39 -0400
Subject: [PATCH 58/69] Collapse nodes properly in unconsHM

When a `BitmapIndexed` has an array with exactly one element,
that element must not be a leaf or a collision. I missed that
invariant in the definition of `unconsHM`. Fix that, and extend
the validity check to verify the invariant.
---
 Data/HashMap/Base.hs |  48 ++++++---
 tests/Validity.hs    | 228 +++++++++++++++++++++----------------------
 2 files changed, 147 insertions(+), 129 deletions(-)

diff --git a/Data/HashMap/Base.hs b/Data/HashMap/Base.hs
index 81426d3e..45972643 100644
--- a/Data/HashMap/Base.hs
+++ b/Data/HashMap/Base.hs
@@ -80,7 +80,7 @@ module Data.HashMap.Base
     , fromList
     , fromListWith
 
-      -- Internals used by the strict version
+      -- Internals used by the strict version or tests
     , Hash
     , Salt
     , Bitmap
@@ -119,6 +119,7 @@ module Data.HashMap.Base
     , unconsHM
     , ptrEq
     , adjust#
+    , isLeafOrCollision
     ) where
 
 #if __GLASGOW_HASKELL__ < 710
@@ -1846,10 +1847,12 @@ unconsA ary =
 
 data UnconsA k v
   = NowEmptyA !(Leaf k v)
-  | UnconsedFromFirstA -- Got an element out of the array, but leave the array.
+    -- Got an entry from the array without changing its length
+  | UnconsedFromFirstA
     !(Leaf k v) -- The leaf that was un-consed
     !(A.Array (HashMap k v)) -- The leftover array
-  | RemovedFirstA -- Got an element out of the array, and removed the array because it became empty.
+    -- Got an entry from the array, shortening it by one element.
+  | RemovedFirstA
     !(Leaf k v) -- The leaf that was un-consed
     !(A.Array (HashMap k v)) -- The leftover array
   deriving Show
@@ -1866,20 +1869,41 @@ unconsHM hm = case hm of
   Leaf _ l -> UnconsedHM l Empty
   BitmapIndexed bm ary' -> case unconsA ary' of
     NowEmptyA l -> UnconsedHM l Empty
-    UnconsedFromFirstA l a' -> UnconsedHM l (BitmapIndexed bm a')
-    RemovedFirstA l a' -> shortened l bm a'
+    UnconsedFromFirstA l a' -> UnconsedHM l (collapse_maybe bm a')
+    RemovedFirstA l a' -> UnconsedHM l (collapse_maybe (shorten_bm bm) a')
   Full ary' -> case unconsA ary' of
-    NowEmptyA l -> UnconsedHM l Empty
-    UnconsedFromFirstA l a' -> UnconsedHM l (Full a')
-    RemovedFirstA l a' -> shortened l fullNodeMask a'
+    NowEmptyA l ->
+       UnconsedHM l Empty
+    UnconsedFromFirstA l a' ->
+       UnconsedHM l (Full a')
+    RemovedFirstA l a' ->
+       UnconsedHM l $ BitmapIndexed (shorten_bm fullNodeMask) a'
   Collision h l1 l2 hm' -> UnconsedHM l1 $ case unconsHM hm' of
     UnconsEmptyHM -> Leaf h l2
     UnconsedHM l3 hm'' -> Collision h l2 l3 hm''
   where
-    -- The array was shortened, so we need to remove the first
-    -- element from the bitmap.
-    shortened l bm ar =
-      UnconsedHM l $ BitmapIndexed (bm .&. (bm - 1)) ar
+    -- When the array is shortened, we need to delete the
+    -- first element (the lowest set bit) from the bitmap.
+    shorten_bm bm = bm .&. (bm - 1)
+
+    -- We must never create a BitmapIndexed with exactly
+    -- one element whose sole element is a leaf or collision.
+    -- In such cases, we instead collapse a level, removing
+    -- the BitmapIndexed. This "smart constructor" takes care
+    -- of potential collapse.
+    --
+    -- Note: we *could* arrange to catch this condition earlier,
+    -- as delete' does, preventing the allocation of an unnecessary
+    -- one-element array. But to reach this code we must be dealing with a
+    -- collision bucket that has at least four elements. That puts us
+    -- well off the fast path already.
+    collapse_maybe bm ar
+      | popCount bm == 1  -- The array has exactly one element.
+      , let the_elem = A.index ar 0
+      , isLeafOrCollision the_elem
+      = the_elem
+      | otherwise
+      = BitmapIndexed bm ar
 
 ------------------------------------------------------------------------
 -- Manually unrolled loops
diff --git a/tests/Validity.hs b/tests/Validity.hs
index fa4bbaed..6abfc4fd 100644
--- a/tests/Validity.hs
+++ b/tests/Validity.hs
@@ -24,20 +24,7 @@ import qualified Data.HashMap.Lazy as HM
 #endif
 import qualified Data.HashMap.Array as A
 import Data.HashMap.Base (HashMap(..), Leaf(..), UnconsHM(..))
-import qualified Data.HashMap.Base as HM
-    ( bitsPerSubkey
-    , cmp1
-    , cmp2
-    , defaultSalt
-    , equal1
-    , equal2
-    , hashWithSalt
-    , index
-    , mask
-    , nextSalt
-    , sparseIndex
-    , unconsHM
-    )
+import qualified Data.HashMap.Base as HMB
 import qualified Data.HashSet as HS
 import Data.HashSet (HashSet)
 
@@ -70,7 +57,7 @@ instance (Validity k, Validity v) => Validity (Leaf k v) where
 instance Validity a => Validity (A.Array a) where
     validate a = annotate (A.toList a) "The array elements"
 
-instance (Eq k, Hashable k, Validity k, Eq v, Validity v) =>
+instance (Eq k, Hashable k, Validity k, Validity v) =>
          Validity (UnconsHM k v) where
     validate UnconsEmptyHM = decorate "UnconsEmptyHM" mempty
     validate (UnconsedHM l hm) =
@@ -81,7 +68,7 @@ instance (Eq k, Hashable k, Validity k, Validity v) =>
          Validity (HashMap k v) where
     validate hm =
         mconcat
-            [ go HM.defaultSalt 0 hm
+            [ go HMB.defaultSalt 0 hm
             , check
                   (HM.fromList (HM.toList (hm $> ())) == (hm $> ()))
                   "fromList and toList are inverses for this hashmap."
@@ -96,7 +83,7 @@ instance (Eq k, Hashable k, Validity k, Validity v) =>
                         [ annotate h "Hash"
                         , annotate l "Leaf"
                         , check
-                              (HM.hashWithSalt s k == h)
+                              (HMB.hashWithSalt s k == h)
                               "The hash is correct."
                         ]
                 (BitmapIndexed bm a) ->
@@ -106,7 +93,7 @@ instance (Eq k, Hashable k, Validity k, Validity v) =>
                         , decorate "Array" $
                           decorateList (zip [0 ..] $ A.toList a) $ \(ix, hm__) ->
                               mconcat
-                                  [ go s (bs + HM.bitsPerSubkey) hm__
+                                  [ go s (bs + HMB.bitsPerSubkey) hm__
                                   , check
                                         (not $ HM.null hm__)
                                         "The sub HashMap is not empty"
@@ -114,8 +101,8 @@ instance (Eq k, Hashable k, Validity k, Validity v) =>
                                         flip
                                             check
                                             "The hash, when masked with the current bitmask, of the key, produces the index in the array where the hashmap is found" $
-                                        let h = HM.hashWithSalt s k
-                                         in HM.sparseIndex bm (HM.mask h bs) ==
+                                         let h = HMB.hashWithSalt s k
+                                         in HMB.sparseIndex bm (HMB.mask h bs) ==
                                             ix
                                   ]
                         , check
@@ -124,6 +111,13 @@ instance (Eq k, Hashable k, Validity k, Validity v) =>
                         , check
                               (uniques $ concatMap HM.keys $ A.toList a)
                               "The keys are unique."
+                        , check
+                              (A.length a >= 1)
+                              "The array has at least one element."
+                        , check
+                              (A.length a > 1 || not (HMB.isLeafOrCollision (A.index a 0))) $
+                              "If the array has only one element, then that element is" ++
+                              "not a leaf or collision."
                         ]
                 (Full a) ->
                     decorate "Full" $
@@ -131,7 +125,7 @@ instance (Eq k, Hashable k, Validity k, Validity v) =>
                         [ decorate "Array" $
                           decorateList (zip [0 ..] $ A.toList a) $ \(ix, hm__) ->
                               mconcat
-                                  [ go s (bs + HM.bitsPerSubkey) hm__
+                                  [ go s (bs + HMB.bitsPerSubkey) hm__
                                   , check
                                         (not $ HM.null hm__)
                                         "The sub HashMap is not empty"
@@ -139,11 +133,11 @@ instance (Eq k, Hashable k, Validity k, Validity v) =>
                                         flip
                                             check
                                             "The hash, when masked with the current bitmask, of the key, produces the index in the array where the hashmap is found" $
-                                        let h = HM.hashWithSalt s k
-                                         in HM.index h bs == ix
+                                         let h = HMB.hashWithSalt s k
+                                         in HMB.index h bs == ix
                                   ]
                         , check
-                              (A.length a == 2 ^ HM.bitsPerSubkey)
+                              (A.length a == 2 ^ HMB.bitsPerSubkey)
                               "There are 2 ^ bitsPerSubkey values in the array."
                         , check
                               (uniques $ concatMap HM.keys $ A.toList a)
@@ -156,10 +150,10 @@ instance (Eq k, Hashable k, Validity k, Validity v) =>
                         , annotate l1 "The first collision"
                         , annotate l2 "The second collision"
                         , check
-                              (HM.hashWithSalt s k1 == h)
+                              (HMB.hashWithSalt s k1 == h)
                               "The hash of the first collision is correct."
                         , check
-                              (HM.hashWithSalt s k2 == h)
+                              (HMB.hashWithSalt s k2 == h)
                               "The hash of the second collision is correct."
                         , check
                               (k1 /= k2)
@@ -168,14 +162,14 @@ instance (Eq k, Hashable k, Validity k, Validity v) =>
                               (uniques (k1 : k2 : HM.keys hm'))
                               "The keys are unique."
                         , decorate "The recursive HashMap" $
-                          go (HM.nextSalt s) 0 hm'
+                          go (HMB.nextSalt s) 0 hm'
                         , check
-                              (all (\k -> HM.hashWithSalt s k == h)
+                              (all (\k -> HMB.hashWithSalt s k == h)
                                    (HM.keys hm'))
                               "All recursive keys hash to the hash within the collision, using the salt at this level."
                         ]
 
-instance (Eq v, Hashable v, Validity v) => Validity (HashSet v) where
+instance (Eq k, Hashable k, Validity k) => Validity (HashSet k) where
     validate hs = decorate "asMap" $ validate $ HS.toMap hs
 
 uniques :: Eq a => [a] -> Bool
@@ -265,11 +259,11 @@ instance (GenUnchecked k, GenUnchecked v) => GenUnchecked (HashMap k v) where
 
 -- It turns out it's almost impossible to write this instance without using internals.
 -- This is good-enough for now.
-instance (Eq k, Hashable k, GenValid k, Eq v, GenValid v) =>
+instance (Eq k, Hashable k, GenValid k, GenValid v) =>
          GenValid (HashMap k v) where
     genValid = HM.fromList <$> genValid
     shrinkValid hm = HM.fromList <$> shrinkValid (HM.toList hm)
-      -- TODO improve the shrinking
+      -- TODO improve the shrinking, maybe.
 
 -- Key type that generates more hash collisions.
 newtype Key = K
@@ -304,22 +298,22 @@ pSize = producesValidsOnValids (HM.size :: HM.HashMap Key Int -> Int)
 pEqual1 :: Fun (Int, Int) Bool -> Property
 pEqual1 f =
     producesValidsOnValids2
-        (HM.equal1 (applyFun2 f) :: HM.HashMap Key Int -> HM.HashMap Key Int -> Bool)
+        (HMB.equal1 (applyFun2 f) :: HM.HashMap Key Int -> HM.HashMap Key Int -> Bool)
 
 pEqual2 :: Fun (Key, Key) Bool -> Fun (Int, Int) Bool -> Property
 pEqual2 f g =
     producesValidsOnValids2
-        (HM.equal2 (applyFun2 f) (applyFun2 g) :: HM.HashMap Key Int -> HM.HashMap Key Int -> Bool)
+        (HMB.equal2 (applyFun2 f) (applyFun2 g) :: HM.HashMap Key Int -> HM.HashMap Key Int -> Bool)
 
 pCmp1 :: Fun (Int, Int) Ordering -> Property
 pCmp1 f =
     producesValidsOnValids2
-        (HM.cmp1 (applyFun2 f) :: HM.HashMap Key Int -> HM.HashMap Key Int -> Ordering)
+        (HMB.cmp1 (applyFun2 f) :: HM.HashMap Key Int -> HM.HashMap Key Int -> Ordering)
 
 pCmp2 :: Fun (Key, Key) Ordering -> Fun (Int, Int) Ordering -> Property
 pCmp2 f g =
     producesValidsOnValids2
-        (HM.cmp2 (applyFun2 f) (applyFun2 g) :: HM.HashMap Key Int -> HM.HashMap Key Int -> Ordering)
+        (HMB.cmp2 (applyFun2 f) (applyFun2 g) :: HM.HashMap Key Int -> HM.HashMap Key Int -> Ordering)
 
 pMember :: Property
 pMember =
@@ -492,7 +486,7 @@ pKeysSet = producesValidsOnValids (HM.keysSet :: HashMap Key Int -> HashSet Key)
 
 pUnconsHM :: Property
 pUnconsHM =
-    producesValidsOnValids (HM.unconsHM :: HashMap Key Int -> UnconsHM Key Int)
+    producesValidsOnValids (HMB.unconsHM :: HashMap Key Int -> UnconsHM Key Int)
 
 -- There isn't currently a pUnconsA because I (David Feuer) don't know
 -- the right way to tell genvalidity-hspec that we only want cases
@@ -503,87 +497,87 @@ tests :: [Test]
 tests =
     let genValidHelper gen = forAll gen shouldBeValid
     -- Basic interface
-     in [ testGroup
-              "HashMap"
-              [ testProperty "genValid generates valid values for Leaf" $
-                genValidHelper (genValid :: Gen (Leaf Key Int))
-              , testProperty "genValid generates valid values for Array" $
-                genValidHelper (genValid :: Gen (A.Array Key))
-              , testProperty "genValid generates valid values for HashMap" $
-                genValidHelper (genValid :: Gen (HashMap Key Int))
-              ]
-        , testGroup
-              "HashMap"
-              [ testProperty "singleton produces valid HashMaps" pSingleton
-              , testProperty "null produces valid Bools" pNull
-              , testProperty "size produces valid HashMaps" pSize
-              , testProperty "equal1 produce valid Bools" pEqual1
-              , testProperty "equal2 produce valid Bools" pEqual2
-              , testProperty "cmp1 produce valid Orderings" pCmp1
-              , testProperty "cmp2 produce valid Orderings" pCmp2
-              , testProperty "member produces valid HashMaps" pMember
-              , testProperty "lookup produces valid HashMaps" pLookup
-              , testProperty
-                    "lookupDefault produces valid HashMaps"
-                    pLookupDefault
-              , testProperty "insert produces valid HashMaps" pInsert
-              , testProperty "insertWith produces valid HashMaps" pInsertWith
-              , testProperty "delete produces valid HashMaps" pDelete
-              , testProperty "adjust produces valid HashMaps" pAdjust
-              , testProperty "update produces valid HashMaps" pUpdate
-              , testProperty "alter produces valid HashMaps" pAlter
-              , testProperty "alterF produces valid HashMaps" pAlterF
-              , testProperty "union produces valid HashMaps" pUnion
-              , testProperty "unionWith produces valid HashMaps" pUnionWith
-              , testProperty
-                    "unionWithKey produces valid HashMaps"
-                    pUnionWithKey
-              , testProperty "unions produces valid HashMaps" pUnions
-              , testProperty "map produces valid HashMaps" pMap
-              , testProperty "mapWithKey produces valid HashMaps" pMapWithKey
-              , testProperty
-                    "traverseWithKey produces valid HashMaps"
-                    pTraverseWithKey
-              , testProperty "difference produces valid HashMaps" pDifference
-              , testProperty
-                    "differenceWith produces valid HashMaps"
-                    pDifferenceWith
-              , testProperty
-                    "intersection produces valid HashMaps"
-                    pIntersection
-              , testProperty
-                    "intersectionWith produces valid HashMaps"
-                    pIntersectionWith
-              , testProperty
-                    "intersectionWithKey produces valid HashMaps"
-                    pIntersectionWithKey
-              , testProperty "foldl' produces valid HashMaps" pFoldl'
-              , testProperty
-                    "foldlWithKey' produces valid HashMaps"
-                    pFoldlWithKey'
-              , testProperty "foldr produces valid HashMaps" pFoldr
-              , testProperty
-                    "foldrWithKey produces valid HashMaps"
-                    pFoldrWithKey
-              , testProperty "filter produces valid HashMaps" pFilter
-              , testProperty
-                    "filterWithKey produces valid HashMaps"
-                    pFilterWithKey
-              , testProperty "mapMaybe produces valid HashMaps" pMapMaybe
-              , testProperty
-                    "mapMaybeWithKey produces valid HashMaps"
-                    pMapMaybeWithKey
-              , testProperty "keys produces valid lists" pKeys
-              , testProperty "elems produces valid lists" pElems
-              , testProperty "toList produces valid lists" pToList
-              , testProperty "fromList produces valid HashMaps" pFromList
-              , testProperty
-                    "fromListWith produces valid HashMaps"
-                    pFromListWith
-              , testProperty "unconsHM produces valid HashMaps" pUnconsHM
-              , testProperty "keysSet produces valid HashSets" pKeysSet
-              ]
-        ]
+    in [ testGroup
+             "HashMap"
+             [ testProperty "genValid generates valid values for Leaf" $
+               genValidHelper (genValid :: Gen (Leaf Key Int))
+             , testProperty "genValid generates valid values for Array" $
+               genValidHelper (genValid :: Gen (A.Array Key))
+             , testProperty "genValid generates valid values for HashMap" $
+               genValidHelper (genValid :: Gen (HashMap Key Int))
+             ]
+       , testGroup
+             "HashMap"
+             [ testProperty "singleton produces valid HashMaps" pSingleton
+             , testProperty "null produces valid Bools" pNull
+             , testProperty "size produces valid HashMaps" pSize
+             , testProperty "equal1 produce valid Bools" pEqual1
+             , testProperty "equal2 produce valid Bools" pEqual2
+             , testProperty "cmp1 produce valid Orderings" pCmp1
+             , testProperty "cmp2 produce valid Orderings" pCmp2
+             , testProperty "member produces valid HashMaps" pMember
+             , testProperty "lookup produces valid HashMaps" pLookup
+             , testProperty
+                   "lookupDefault produces valid HashMaps"
+                   pLookupDefault
+             , testProperty "insert produces valid HashMaps" pInsert
+             , testProperty "insertWith produces valid HashMaps" pInsertWith
+             , testProperty "delete produces valid HashMaps" pDelete
+             , testProperty "adjust produces valid HashMaps" pAdjust
+             , testProperty "update produces valid HashMaps" pUpdate
+             , testProperty "alter produces valid HashMaps" pAlter
+             , testProperty "alterF produces valid HashMaps" pAlterF
+             , testProperty "union produces valid HashMaps" pUnion
+             , testProperty "unionWith produces valid HashMaps" pUnionWith
+             , testProperty
+                   "unionWithKey produces valid HashMaps"
+                   pUnionWithKey
+             , testProperty "unions produces valid HashMaps" pUnions
+             , testProperty "map produces valid HashMaps" pMap
+             , testProperty "mapWithKey produces valid HashMaps" pMapWithKey
+             , testProperty
+                   "traverseWithKey produces valid HashMaps"
+                   pTraverseWithKey
+             , testProperty "difference produces valid HashMaps" pDifference
+             , testProperty
+                   "differenceWith produces valid HashMaps"
+                   pDifferenceWith
+             , testProperty
+                   "intersection produces valid HashMaps"
+                   pIntersection
+             , testProperty
+                   "intersectionWith produces valid HashMaps"
+                   pIntersectionWith
+             , testProperty
+                   "intersectionWithKey produces valid HashMaps"
+                   pIntersectionWithKey
+             , testProperty "foldl' produces valid HashMaps" pFoldl'
+             , testProperty
+                   "foldlWithKey' produces valid HashMaps"
+                   pFoldlWithKey'
+             , testProperty "foldr produces valid HashMaps" pFoldr
+             , testProperty
+                   "foldrWithKey produces valid HashMaps"
+                   pFoldrWithKey
+             , testProperty "filter produces valid HashMaps" pFilter
+             , testProperty
+                   "filterWithKey produces valid HashMaps"
+                   pFilterWithKey
+             , testProperty "mapMaybe produces valid HashMaps" pMapMaybe
+             , testProperty
+                   "mapMaybeWithKey produces valid HashMaps"
+                   pMapMaybeWithKey
+             , testProperty "keys produces valid lists" pKeys
+             , testProperty "elems produces valid lists" pElems
+             , testProperty "toList produces valid lists" pToList
+             , testProperty "fromList produces valid HashMaps" pFromList
+             , testProperty
+                   "fromListWith produces valid HashMaps"
+                   pFromListWith
+             , testProperty "unconsHM produces valid HashMaps" pUnconsHM
+             , testProperty "keysSet produces valid HashSets" pKeysSet
+             ]
+       ]
 
 main :: IO ()
 main = defaultMain tests

From 364a3cb58aa4ccf284bf1f291fe726e373831576 Mon Sep 17 00:00:00 2001
From: Tom Sydney Kerckhove <syd@fpcomplete.com>
Date: Tue, 30 Oct 2018 07:29:20 +0100
Subject: [PATCH 59/69] tried to fix travis

---
 .travis.yml | 8 ++++----
 1 file changed, 4 insertions(+), 4 deletions(-)

diff --git a/.travis.yml b/.travis.yml
index 040ea2fc..8440c99a 100644
--- a/.travis.yml
+++ b/.travis.yml
@@ -30,16 +30,16 @@ matrix:
   include:
     - compiler: "ghc-7.8.4"
     # env: TEST=--disable-tests BENCH=--disable-benchmarks
-      addons: {apt: {packages: [ghc-ppa-tools,cabal-install-2.0,ghc-7.8.4], sources: [hvr-ghc]}}
+      addons: {apt: {packages: [ghc-ppa-tools,cabal-install-2.4,ghc-7.8.4], sources: [hvr-ghc]}}
     - compiler: "ghc-7.10.3"
     # env: TEST=--disable-tests BENCH=--disable-benchmarks
-      addons: {apt: {packages: [ghc-ppa-tools,cabal-install-2.0,ghc-7.10.3], sources: [hvr-ghc]}}
+      addons: {apt: {packages: [ghc-ppa-tools,cabal-install-2.4,ghc-7.10.3], sources: [hvr-ghc]}}
     - compiler: "ghc-8.0.2"
     # env: TEST=--disable-tests BENCH=--disable-benchmarks
-      addons: {apt: {packages: [ghc-ppa-tools,cabal-install-2.0,ghc-8.0.2], sources: [hvr-ghc]}}
+      addons: {apt: {packages: [ghc-ppa-tools,cabal-install-2.4,ghc-8.0.2], sources: [hvr-ghc]}}
     - compiler: "ghc-8.2.2"
     # env: TEST=--disable-tests BENCH=--disable-benchmarks
-      addons: {apt: {packages: [ghc-ppa-tools,cabal-install-2.0,ghc-8.2.2], sources: [hvr-ghc]}}
+      addons: {apt: {packages: [ghc-ppa-tools,cabal-install-2.4,ghc-8.2.2], sources: [hvr-ghc]}}
     - compiler: "ghc-8.4.1"
       env: GHCHEAD=true
       addons: {apt: {packages: [ghc-ppa-tools,cabal-install-head,ghc-8.4.1], sources: [hvr-ghc]}}

From 853f978925ed5af65f09ad1fc40bfe9358e78d37 Mon Sep 17 00:00:00 2001
From: Tom Sydney Kerckhove <syd@fpcomplete.com>
Date: Tue, 30 Oct 2018 07:37:04 +0100
Subject: [PATCH 60/69] again

---
 .travis.yml | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/.travis.yml b/.travis.yml
index 8440c99a..9b834c9a 100644
--- a/.travis.yml
+++ b/.travis.yml
@@ -87,7 +87,7 @@ install:
       (cd "."; autoreconf -i);
     fi
   - rm -f cabal.project.freeze
-  - cabal new-build -w ${HC} ${TEST} ${BENCH} --project-file="cabal.project" --dep -j2 all
+  - cabal new-build -w ${HC} ${TEST} ${BENCH} --project-file="cabal.project" --dep -j2 all --max-backjumps=-1
   - cabal new-build -w ${HC} --disable-tests --disable-benchmarks --project-file="cabal.project" --dep -j2 all
   - rm -rf "."/.ghc.environment.* "."/dist
   - DISTDIR=$(mktemp -d /tmp/dist-test.XXXX)

From bddfabfe7e94fb60d31aaeb002c0ade0532ea196 Mon Sep 17 00:00:00 2001
From: Tom Sydney Kerckhove <syd@fpcomplete.com>
Date: Tue, 30 Oct 2018 07:37:55 +0100
Subject: [PATCH 61/69] also reorder goals

---
 .travis.yml | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/.travis.yml b/.travis.yml
index 9b834c9a..b8048c6f 100644
--- a/.travis.yml
+++ b/.travis.yml
@@ -87,7 +87,7 @@ install:
       (cd "."; autoreconf -i);
     fi
   - rm -f cabal.project.freeze
-  - cabal new-build -w ${HC} ${TEST} ${BENCH} --project-file="cabal.project" --dep -j2 all --max-backjumps=-1
+  - cabal new-build -w ${HC} ${TEST} ${BENCH} --project-file="cabal.project" --dep -j2 all --reorder-goals --max-backjumps=-1
   - cabal new-build -w ${HC} --disable-tests --disable-benchmarks --project-file="cabal.project" --dep -j2 all
   - rm -rf "."/.ghc.environment.* "."/dist
   - DISTDIR=$(mktemp -d /tmp/dist-test.XXXX)

From 3c81c624d71595dfb9e29ea3907fc17e086addb3 Mon Sep 17 00:00:00 2001
From: Tom Sydney Kerckhove <syd@fpcomplete.com>
Date: Tue, 30 Oct 2018 07:45:53 +0100
Subject: [PATCH 62/69] Lower bounds to make cabal fall in line

---
 unordered-containers.cabal | 12 ++++++------
 1 file changed, 6 insertions(+), 6 deletions(-)

diff --git a/unordered-containers.cabal b/unordered-containers.cabal
index b5d8eae8..dffcf81e 100644
--- a/unordered-containers.cabal
+++ b/unordered-containers.cabal
@@ -75,9 +75,9 @@ test-suite validity-lazy
     QuickCheck >= 2.4.0.1,
     test-framework >= 0.3.3,
     test-framework-quickcheck2 >= 0.2.9,
-    validity,
-    genvalidity,
-    genvalidity-hspec,
+    validity >= 0.4.0.4,
+    genvalidity >= 0.4.0.4,
+    genvalidity-hspec >= 0.5.0.0,
     unordered-containers
 
   default-language: Haskell2010
@@ -95,9 +95,9 @@ test-suite validity-strict
     QuickCheck >= 2.4.0.1,
     test-framework >= 0.3.3,
     test-framework-quickcheck2 >= 0.2.9,
-    validity,
-    genvalidity,
-    genvalidity-hspec,
+    validity >= 0.4.0.4,
+    genvalidity >= 0.4.0.4,
+    genvalidity-hspec >= 0.5.0.0,
     unordered-containers
 
   default-language: Haskell2010

From 13a40c0e8ddc550ebb5fd8c54828cc93dcf8449d Mon Sep 17 00:00:00 2001
From: Tom Sydney Kerckhove <syd@fpcomplete.com>
Date: Tue, 30 Oct 2018 07:56:30 +0100
Subject: [PATCH 63/69] Trying again

---
 tests/Validity.hs          | 180 ++++++++++++++++++-------------------
 unordered-containers.cabal |   4 +-
 2 files changed, 92 insertions(+), 92 deletions(-)

diff --git a/tests/Validity.hs b/tests/Validity.hs
index 6abfc4fd..f8815a85 100644
--- a/tests/Validity.hs
+++ b/tests/Validity.hs
@@ -38,18 +38,17 @@ import Test.QuickCheck
     , Function
     , Gen
     , Property
-    , forAll
     , oneof
     , resize
     , sized
     )
 import Test.QuickCheck.Function (Fun, apply, applyFun2, applyFun3)
-import Test.Validity
+import Test.Validity.Functions
     ( producesValidsOnValids
     , producesValidsOnValids2
     , producesValidsOnValids3
-    , shouldBeValid
     )
+import Test.Validity.GenValidity.Property (genGeneratesValid)
 
 instance (Validity k, Validity v) => Validity (Leaf k v) where
     validate (L k v) = mconcat [annotate k "key", annotate v "value"]
@@ -101,7 +100,7 @@ instance (Eq k, Hashable k, Validity k, Validity v) =>
                                         flip
                                             check
                                             "The hash, when masked with the current bitmask, of the key, produces the index in the array where the hashmap is found" $
-                                         let h = HMB.hashWithSalt s k
+                                        let h = HMB.hashWithSalt s k
                                          in HMB.sparseIndex bm (HMB.mask h bs) ==
                                             ix
                                   ]
@@ -115,9 +114,10 @@ instance (Eq k, Hashable k, Validity k, Validity v) =>
                               (A.length a >= 1)
                               "The array has at least one element."
                         , check
-                              (A.length a > 1 || not (HMB.isLeafOrCollision (A.index a 0))) $
-                              "If the array has only one element, then that element is" ++
-                              "not a leaf or collision."
+                              (A.length a > 1 ||
+                               not (HMB.isLeafOrCollision (A.index a 0))) $
+                          "If the array has only one element, then that element is" ++
+                          "not a leaf or collision."
                         ]
                 (Full a) ->
                     decorate "Full" $
@@ -133,7 +133,7 @@ instance (Eq k, Hashable k, Validity k, Validity v) =>
                                         flip
                                             check
                                             "The hash, when masked with the current bitmask, of the key, produces the index in the array where the hashmap is found" $
-                                         let h = HMB.hashWithSalt s k
+                                        let h = HMB.hashWithSalt s k
                                          in HMB.index h bs == ix
                                   ]
                         , check
@@ -495,89 +495,89 @@ pUnconsHM =
 -- * Test list
 tests :: [Test]
 tests =
-    let genValidHelper gen = forAll gen shouldBeValid
+    let genValidHelper gen = genGeneratesValid gen (const [])
     -- Basic interface
-    in [ testGroup
-             "HashMap"
-             [ testProperty "genValid generates valid values for Leaf" $
-               genValidHelper (genValid :: Gen (Leaf Key Int))
-             , testProperty "genValid generates valid values for Array" $
-               genValidHelper (genValid :: Gen (A.Array Key))
-             , testProperty "genValid generates valid values for HashMap" $
-               genValidHelper (genValid :: Gen (HashMap Key Int))
-             ]
-       , testGroup
-             "HashMap"
-             [ testProperty "singleton produces valid HashMaps" pSingleton
-             , testProperty "null produces valid Bools" pNull
-             , testProperty "size produces valid HashMaps" pSize
-             , testProperty "equal1 produce valid Bools" pEqual1
-             , testProperty "equal2 produce valid Bools" pEqual2
-             , testProperty "cmp1 produce valid Orderings" pCmp1
-             , testProperty "cmp2 produce valid Orderings" pCmp2
-             , testProperty "member produces valid HashMaps" pMember
-             , testProperty "lookup produces valid HashMaps" pLookup
-             , testProperty
-                   "lookupDefault produces valid HashMaps"
-                   pLookupDefault
-             , testProperty "insert produces valid HashMaps" pInsert
-             , testProperty "insertWith produces valid HashMaps" pInsertWith
-             , testProperty "delete produces valid HashMaps" pDelete
-             , testProperty "adjust produces valid HashMaps" pAdjust
-             , testProperty "update produces valid HashMaps" pUpdate
-             , testProperty "alter produces valid HashMaps" pAlter
-             , testProperty "alterF produces valid HashMaps" pAlterF
-             , testProperty "union produces valid HashMaps" pUnion
-             , testProperty "unionWith produces valid HashMaps" pUnionWith
-             , testProperty
-                   "unionWithKey produces valid HashMaps"
-                   pUnionWithKey
-             , testProperty "unions produces valid HashMaps" pUnions
-             , testProperty "map produces valid HashMaps" pMap
-             , testProperty "mapWithKey produces valid HashMaps" pMapWithKey
-             , testProperty
-                   "traverseWithKey produces valid HashMaps"
-                   pTraverseWithKey
-             , testProperty "difference produces valid HashMaps" pDifference
-             , testProperty
-                   "differenceWith produces valid HashMaps"
-                   pDifferenceWith
-             , testProperty
-                   "intersection produces valid HashMaps"
-                   pIntersection
-             , testProperty
-                   "intersectionWith produces valid HashMaps"
-                   pIntersectionWith
-             , testProperty
-                   "intersectionWithKey produces valid HashMaps"
-                   pIntersectionWithKey
-             , testProperty "foldl' produces valid HashMaps" pFoldl'
-             , testProperty
-                   "foldlWithKey' produces valid HashMaps"
-                   pFoldlWithKey'
-             , testProperty "foldr produces valid HashMaps" pFoldr
-             , testProperty
-                   "foldrWithKey produces valid HashMaps"
-                   pFoldrWithKey
-             , testProperty "filter produces valid HashMaps" pFilter
-             , testProperty
-                   "filterWithKey produces valid HashMaps"
-                   pFilterWithKey
-             , testProperty "mapMaybe produces valid HashMaps" pMapMaybe
-             , testProperty
-                   "mapMaybeWithKey produces valid HashMaps"
-                   pMapMaybeWithKey
-             , testProperty "keys produces valid lists" pKeys
-             , testProperty "elems produces valid lists" pElems
-             , testProperty "toList produces valid lists" pToList
-             , testProperty "fromList produces valid HashMaps" pFromList
-             , testProperty
-                   "fromListWith produces valid HashMaps"
-                   pFromListWith
-             , testProperty "unconsHM produces valid HashMaps" pUnconsHM
-             , testProperty "keysSet produces valid HashSets" pKeysSet
-             ]
-       ]
+     in [ testGroup
+              "HashMap"
+              [ testProperty "genValid generates valid values for Leaf" $
+                genValidHelper (genValid :: Gen (Leaf Key Int))
+              , testProperty "genValid generates valid values for Array" $
+                genValidHelper (genValid :: Gen (A.Array Key))
+              , testProperty "genValid generates valid values for HashMap" $
+                genValidHelper (genValid :: Gen (HashMap Key Int))
+              ]
+        , testGroup
+              "HashMap"
+              [ testProperty "singleton produces valid HashMaps" pSingleton
+              , testProperty "null produces valid Bools" pNull
+              , testProperty "size produces valid HashMaps" pSize
+              , testProperty "equal1 produce valid Bools" pEqual1
+              , testProperty "equal2 produce valid Bools" pEqual2
+              , testProperty "cmp1 produce valid Orderings" pCmp1
+              , testProperty "cmp2 produce valid Orderings" pCmp2
+              , testProperty "member produces valid HashMaps" pMember
+              , testProperty "lookup produces valid HashMaps" pLookup
+              , testProperty
+                    "lookupDefault produces valid HashMaps"
+                    pLookupDefault
+              , testProperty "insert produces valid HashMaps" pInsert
+              , testProperty "insertWith produces valid HashMaps" pInsertWith
+              , testProperty "delete produces valid HashMaps" pDelete
+              , testProperty "adjust produces valid HashMaps" pAdjust
+              , testProperty "update produces valid HashMaps" pUpdate
+              , testProperty "alter produces valid HashMaps" pAlter
+              , testProperty "alterF produces valid HashMaps" pAlterF
+              , testProperty "union produces valid HashMaps" pUnion
+              , testProperty "unionWith produces valid HashMaps" pUnionWith
+              , testProperty
+                    "unionWithKey produces valid HashMaps"
+                    pUnionWithKey
+              , testProperty "unions produces valid HashMaps" pUnions
+              , testProperty "map produces valid HashMaps" pMap
+              , testProperty "mapWithKey produces valid HashMaps" pMapWithKey
+              , testProperty
+                    "traverseWithKey produces valid HashMaps"
+                    pTraverseWithKey
+              , testProperty "difference produces valid HashMaps" pDifference
+              , testProperty
+                    "differenceWith produces valid HashMaps"
+                    pDifferenceWith
+              , testProperty
+                    "intersection produces valid HashMaps"
+                    pIntersection
+              , testProperty
+                    "intersectionWith produces valid HashMaps"
+                    pIntersectionWith
+              , testProperty
+                    "intersectionWithKey produces valid HashMaps"
+                    pIntersectionWithKey
+              , testProperty "foldl' produces valid HashMaps" pFoldl'
+              , testProperty
+                    "foldlWithKey' produces valid HashMaps"
+                    pFoldlWithKey'
+              , testProperty "foldr produces valid HashMaps" pFoldr
+              , testProperty
+                    "foldrWithKey produces valid HashMaps"
+                    pFoldrWithKey
+              , testProperty "filter produces valid HashMaps" pFilter
+              , testProperty
+                    "filterWithKey produces valid HashMaps"
+                    pFilterWithKey
+              , testProperty "mapMaybe produces valid HashMaps" pMapMaybe
+              , testProperty
+                    "mapMaybeWithKey produces valid HashMaps"
+                    pMapMaybeWithKey
+              , testProperty "keys produces valid lists" pKeys
+              , testProperty "elems produces valid lists" pElems
+              , testProperty "toList produces valid lists" pToList
+              , testProperty "fromList produces valid HashMaps" pFromList
+              , testProperty
+                    "fromListWith produces valid HashMaps"
+                    pFromListWith
+              , testProperty "unconsHM produces valid HashMaps" pUnconsHM
+              , testProperty "keysSet produces valid HashSets" pKeysSet
+              ]
+        ]
 
 main :: IO ()
 main = defaultMain tests
diff --git a/unordered-containers.cabal b/unordered-containers.cabal
index dffcf81e..c0b9138b 100644
--- a/unordered-containers.cabal
+++ b/unordered-containers.cabal
@@ -77,7 +77,7 @@ test-suite validity-lazy
     test-framework-quickcheck2 >= 0.2.9,
     validity >= 0.4.0.4,
     genvalidity >= 0.4.0.4,
-    genvalidity-hspec >= 0.5.0.0,
+    genvalidity-property >= 0.1.0.0,
     unordered-containers
 
   default-language: Haskell2010
@@ -97,7 +97,7 @@ test-suite validity-strict
     test-framework-quickcheck2 >= 0.2.9,
     validity >= 0.4.0.4,
     genvalidity >= 0.4.0.4,
-    genvalidity-hspec >= 0.5.0.0,
+    genvalidity-property >= 0.1.0.0,
     unordered-containers
 
   default-language: Haskell2010

From 07ec38d74e9a783b508d00dd7a56a44c4efc4d58 Mon Sep 17 00:00:00 2001
From: Tom Sydney Kerckhove <syd@fpcomplete.com>
Date: Tue, 30 Oct 2018 08:28:59 +0100
Subject: [PATCH 64/69] Compatibility with old versions of quickcheck

---
 Data/HashMap/Base.hs | 10 ++++-----
 tests/Validity.hs    | 48 +++++++++++++++++++++++++++++++++++++++-----
 2 files changed, 48 insertions(+), 10 deletions(-)

diff --git a/Data/HashMap/Base.hs b/Data/HashMap/Base.hs
index 45972643..55e5767f 100644
--- a/Data/HashMap/Base.hs
+++ b/Data/HashMap/Base.hs
@@ -123,7 +123,7 @@ module Data.HashMap.Base
     ) where
 
 #if __GLASGOW_HASKELL__ < 710
-import Control.Applicative ((<$>), Applicative(pure))
+import Control.Applicative ((<$>), (<*>), Applicative(pure))
 import Data.Monoid (Monoid(mempty, mappend))
 import Data.Traversable (Traversable(..))
 import Data.Word (Word)
@@ -329,7 +329,7 @@ equal2 eqk eqv t1 t2 = go (toList' t1 []) (toList' t2 [])
       = go tl1 tl2
     go (Collision h1 (L k11 v11) (L k12 v12) hm1 : tl1) (Collision h2 (L k21 v21) (L k22 v22) hm2 : tl2)
       | h1 == h2 &&
-        (length hm1 == length hm2) &&
+        (size hm1 == size hm2) &&
         isPermutationBy (\(k1, v1) (k2, v2) -> eqk k1 k2 && eqv v1 v2)
           ((k11, v11) : (k12, v12) : toList hm1)
           ((k21, v21) : (k22, v22) : toList hm2)
@@ -365,7 +365,7 @@ cmp1 cmpv t1 t2 = go (toList' t1 []) (toList' t2 [])
         go tl1 tl2
     go (Collision h1 (L k11 v11) (L k12 v12) hm1 : tl1) (Collision h2 (L k21 v21) (L k22 v22) hm2 : tl2)
       = compare h1 h2 `mappend`
-        compare (length hm1) (length hm2) `mappend`
+        compare (size hm1) (size hm2) `mappend`
         liftCompareList pairCompare
           -- We don't use sortOn because fst is cheap.
           (L.sortBy (compare `on` fst) $
@@ -400,7 +400,7 @@ cmp2 cmpk cmpv t1 t2 = go (toList' t1 []) (toList' t2 [])
         go tl1 tl2
     go (Collision h1 (L k11 v11) (L k12 v12) hm1 : tl1) (Collision h2 (L k21 v21) (L k22 v22) hm2 : tl2)
       = compare h1 h2 `mappend`
-        compare (length hm1) (length hm2) `mappend`
+        compare (size hm1) (size hm2) `mappend`
         unorderedCompare (\(k1, v1) (k2, v2) -> (k1 `cmpk` k2) `mappend` (v1 `cmpv` v2))
           ((k11, v11) : (k12, v12) : toList hm1)
           ((k21, v21) : (k22, v22) : toList hm2) `mappend`
@@ -423,7 +423,7 @@ equalKeys1 eq t1 t2 = go (toList' t1 []) (toList' t2 [])
       = go tl1 tl2
     go (Collision h1 (L k11 _) (L k12 _) hm1 : tl1) (Collision h2 (L k21 _) (L k22 _) hm2 : tl2)
       | h1 == h2 &&
-        (length hm1 == length hm2) &&
+        (size hm1 == size hm2) &&
         isPermutationBy eq
           (k11 : k12 : keys hm1)
           (k21 : k22 : keys hm2)
diff --git a/tests/Validity.hs b/tests/Validity.hs
index f8815a85..dc1ab2c0 100644
--- a/tests/Validity.hs
+++ b/tests/Validity.hs
@@ -1,4 +1,5 @@
 {-# LANGUAGE CPP #-}
+{-# LANGUAGE TypeOperators #-}
 {-# LANGUAGE DeriveGeneric #-}
 {-# LANGUAGE FlexibleContexts #-}
 {-# LANGUAGE FlexibleInstances #-}
@@ -11,7 +12,12 @@ module Main
     ) where
 
 import GHC.Generics (Generic)
-
+#if __GLASGOW_HASKELL__ < 710
+import Control.Applicative (Applicative(pure), (<$>), (<*>))
+import Data.Monoid (Monoid(mappend, mempty))
+import Data.Traversable (Traversable(..))
+import Data.Word (Word)
+#endif
 import Data.Bits (popCount)
 import Data.Functor
 import Data.Hashable (Hashable(hashWithSalt))
@@ -35,21 +41,48 @@ import Test.Framework.Providers.QuickCheck2 (testProperty)
 import Test.QuickCheck
     ( Arbitrary
     , CoArbitrary
-    , Function
     , Gen
     , Property
     , oneof
     , resize
     , sized
     )
-import Test.QuickCheck.Function (Fun, apply, applyFun2, applyFun3)
+import Test.QuickCheck.Function
+    ( (:->)
+    , Fun(..)
+    , Function(..)
+    , apply
+    , functionMap
+    )
 import Test.Validity.Functions
     ( producesValidsOnValids
     , producesValidsOnValids2
     , producesValidsOnValids3
     )
 import Test.Validity.GenValidity.Property (genGeneratesValid)
-
+#if !MIN_VERSION_QuickCheck(2,10,0)
+-- | Extracts the value of a binary function.
+--
+-- 'Fn2' is the pattern equivalent of this function.
+--
+--  > prop_zipWith :: Fun (Int, Bool) Char -> [Int] -> [Bool] -> Bool
+--  > prop_zipWith f xs ys = zipWith (applyFun2 f) xs ys == [ applyFun2 f x y | (x, y) <- zip xs ys]
+--
+applyFun2 :: Fun (a, b) c -> (a -> b -> c)
+applyFun2 (Fun _ f) a b = f (a, b)
+
+-- | Extracts the value of a ternary function. 'Fn3' is the
+-- pattern equivalent of this function.
+applyFun3 :: Fun (a, b, c) d -> (a -> b -> c -> d)
+applyFun3 (Fun _ f) a b c = f (a, b, c)
+
+-- | Provides a 'Function' instance for types with 'Integral'.
+functionIntegral :: Integral a => (a -> b) -> (a :-> b)
+functionIntegral = functionMap fromIntegral fromInteger
+
+instance Function Word where
+    function = functionIntegral
+#endif
 instance (Validity k, Validity v) => Validity (Leaf k v) where
     validate (L k v) = mconcat [annotate k "key", annotate v "value"]
 
@@ -277,13 +310,18 @@ newtype Key = K
                , Ord
                , Read
                , Show
+               , Integral
+               , Real
+               , Num
+               , Enum
                , Generic
                )
 
 instance Hashable Key where
     hashWithSalt salt k = hashWithSalt salt (unK k) `mod` 20
 
-instance Function Key
+instance Function Key where
+    function = functionIntegral
 
 pSingleton :: Property
 pSingleton =

From 918cfda8573899b1f234f35ebeee95f33df2d001 Mon Sep 17 00:00:00 2001
From: Tom Sydney Kerckhove <syd@fpcomplete.com>
Date: Tue, 30 Oct 2018 08:38:56 +0100
Subject: [PATCH 65/69] and again

---
 tests/Validity.hs | 2 ++
 1 file changed, 2 insertions(+)

diff --git a/tests/Validity.hs b/tests/Validity.hs
index dc1ab2c0..03be8099 100644
--- a/tests/Validity.hs
+++ b/tests/Validity.hs
@@ -82,6 +82,8 @@ functionIntegral = functionMap fromIntegral fromInteger
 
 instance Function Word where
     function = functionIntegral
+#else
+import Test.QuickCheck.Function (applyFun2, applyFun3, functionIntegral)
 #endif
 instance (Validity k, Validity v) => Validity (Leaf k v) where
     validate (L k v) = mconcat [annotate k "key", annotate v "value"]

From eb46c82db66ced9f47358cb8d5405d114b7d438b Mon Sep 17 00:00:00 2001
From: Tom Sydney Kerckhove <syd@fpcomplete.com>
Date: Tue, 30 Oct 2018 09:05:36 +0100
Subject: [PATCH 66/69] Not sure if this will help, but we'll see

---
 tests/HashSetProperties.hs | 4 +++-
 1 file changed, 3 insertions(+), 1 deletion(-)

diff --git a/tests/HashSetProperties.hs b/tests/HashSetProperties.hs
index fd65bf9e..7ff3b82c 100644
--- a/tests/HashSetProperties.hs
+++ b/tests/HashSetProperties.hs
@@ -14,7 +14,9 @@ import Data.Ord (comparing)
 import Test.QuickCheck (Arbitrary, Property, (==>), (===))
 import Test.Framework (Test, defaultMain, testGroup)
 import Test.Framework.Providers.QuickCheck2 (testProperty)
-import Data.Functor.Classes (eq1, compare1)
+#if MIN_VERSION_base(4,9,0)
+import Data.Functor.Classes (eq1, compare1, eq2, compare2)
+#endif
 
 -- Key type that generates more hash collisions.
 newtype Key = K { unK :: Int }

From b5fb685a882b38b475cfc72b390ed68ad8e2e102 Mon Sep 17 00:00:00 2001
From: Tom Sydney Kerckhove <syd@fpcomplete.com>
Date: Tue, 30 Oct 2018 09:26:45 +0100
Subject: [PATCH 67/69] CPP for some tests

---
 tests/HashMapProperties.hs |  8 ++++++++
 tests/HashSetProperties.hs | 10 +++++++++-
 tests/Validity.hs          |  2 ++
 3 files changed, 19 insertions(+), 1 deletion(-)

diff --git a/tests/HashMapProperties.hs b/tests/HashMapProperties.hs
index 8f1833ae..ec96b841 100644
--- a/tests/HashMapProperties.hs
+++ b/tests/HashMapProperties.hs
@@ -47,6 +47,7 @@ instance Hashable Key where
 pEq :: [(Key, Int)] -> [(Key, Int)] -> Bool
 pEq xs = (M.fromList xs ==) `eq` (HM.fromList xs ==)
 
+#if MIN_VERSION_base(4,9,0)
 -- Caution: this is a rather weak test. Fortunately, the "Permutation"
 -- properties in the HashSet test suite should catch most of what this
 -- doesn't.
@@ -55,6 +56,7 @@ pEq2 xs ys = (x == y) === (x `eq2` y)
   where
     x = HM.fromList xs
     y = HM.fromList ys
+#endif
 
 pNeq :: [(Key, Int)] -> [(Key, Int)] -> Bool
 pNeq xs = (M.fromList xs /=) `eq` (HM.fromList xs /=)
@@ -88,11 +90,13 @@ pOrd3 xs ys = case (compare x y, compare y x) of
     x = HM.fromList xs
     y = HM.fromList ys
 
+#if MIN_VERSION_base(4,9,0)
 pOrd4 :: [(Key, Int)] -> [(Key, Int)] -> Property
 pOrd4 xs ys = compare2 x y === compare x y
   where
     x = HM.fromList xs
     y = HM.fromList ys
+#endif
 
 pOrdEq :: [(Key, Int)] -> [(Key, Int)] -> Bool
 pOrdEq xs ys = case (compare x y, x == y) of
@@ -397,11 +401,15 @@ tests =
       testGroup "instances"
       [ testProperty "==" pEq
       , testProperty "/=" pNeq
+#if MIN_VERSION_base(4,9,0)
       , testProperty "eq2 = (==)" pEq2
+#endif
       , testProperty "compare reflexive" pOrd1
       , testProperty "compare transitive" pOrd2
       , testProperty "compare antisymmetric" pOrd3
+#if MIN_VERSION_base(4,9,0)
       , testProperty "compare2 = compare" pOrd4
+#endif
       , testProperty "Ord => Eq" pOrdEq
       , testProperty "Read/Show" pReadShow
       , testProperty "Functor" pFunctor
diff --git a/tests/HashSetProperties.hs b/tests/HashSetProperties.hs
index 7ff3b82c..abdf8d5e 100644
--- a/tests/HashSetProperties.hs
+++ b/tests/HashSetProperties.hs
@@ -15,7 +15,7 @@ import Test.QuickCheck (Arbitrary, Property, (==>), (===))
 import Test.Framework (Test, defaultMain, testGroup)
 import Test.Framework.Providers.QuickCheck2 (testProperty)
 #if MIN_VERSION_base(4,9,0)
-import Data.Functor.Classes (eq1, compare1, eq2, compare2)
+import Data.Functor.Classes (eq1, compare1)
 #endif
 
 -- Key type that generates more hash collisions.
@@ -89,11 +89,13 @@ pPermutationEq xs = S.fromList x == S.fromList y
     x = L.map fst xs
     y = L.map fst . L.sortBy (comparing snd) $ xs
 
+#if MIN_VERSION_base(4,9,0)
 pPermutationEq1 :: [(Key, Int)] -> Bool
 pPermutationEq1 xs = S.fromList x `eq1` S.fromList y
   where
     x = L.map fst xs
     y = L.map fst . L.sortBy (comparing snd) $ xs
+#endif
 
 pPermutationOrd :: [(Key, Int)] -> Bool
 pPermutationOrd xs = (S.fromList x `compare` S.fromList y) == EQ
@@ -101,11 +103,13 @@ pPermutationOrd xs = (S.fromList x `compare` S.fromList y) == EQ
     x = L.map fst xs
     y = L.map fst . L.sortBy (comparing snd) $ xs
 
+#if MIN_VERSION_base(4,9,0)
 pPermutationOrd1 :: [(Key, Int)] -> Bool
 pPermutationOrd1 xs = (S.fromList x `compare1` S.fromList y) == EQ
   where
     x = L.map fst xs
     y = L.map fst . L.sortBy (comparing snd) $ xs
+#endif
 
 pHashable :: [Key] -> [Int] -> Int -> Property
 pHashable xs is salt =
@@ -193,9 +197,13 @@ tests =
       testGroup "instances"
       [ testProperty "==" pEq
       , testProperty "Permutation ==" pPermutationEq
+#if MIN_VERSION_base(4,9,0)
       , testProperty "Permutation eq1" pPermutationEq1
+#endif
       , testProperty "Permutation compare" pPermutationOrd
+#if MIN_VERSION_base(4,9,0)
       , testProperty "Permutation compare1" pPermutationOrd1
+#endif
       , testProperty "/=" pNeq
       , testProperty "compare reflexive" pOrd1
       , testProperty "compare transitive" pOrd2
diff --git a/tests/Validity.hs b/tests/Validity.hs
index 03be8099..dc3870f7 100644
--- a/tests/Validity.hs
+++ b/tests/Validity.hs
@@ -335,6 +335,8 @@ pNull = producesValidsOnValids (HM.null :: HM.HashMap Key Int -> Bool)
 pSize :: Property
 pSize = producesValidsOnValids (HM.size :: HM.HashMap Key Int -> Int)
 
+-- These four tests will ensure that `equal1`, etc do not segfault and succesfully
+-- evaluate to a `Bool` (or `Ordering`, respectively)
 pEqual1 :: Fun (Int, Int) Bool -> Property
 pEqual1 f =
     producesValidsOnValids2

From 6838fff2ec28c9551140fed5056cdd9c0a304b6a Mon Sep 17 00:00:00 2001
From: Tom Sydney Kerckhove <syd@cs-syd.eu>
Date: Wed, 31 Oct 2018 09:10:37 +0100
Subject: [PATCH 68/69] put back the show instance

---
 Data/HashMap/Base.hs | 8 ++++----
 1 file changed, 4 insertions(+), 4 deletions(-)

diff --git a/Data/HashMap/Base.hs b/Data/HashMap/Base.hs
index 55e5767f..3753f05a 100644
--- a/Data/HashMap/Base.hs
+++ b/Data/HashMap/Base.hs
@@ -195,7 +195,7 @@ data HashMap k v
     | Leaf !Hash !(Leaf k v)
     | Full !(A.Array (HashMap k v))
     | Collision !Hash !(Leaf k v) !(Leaf k v) !(HashMap k v)
-      deriving (Typeable, Show)
+      deriving (Typeable)
 
 type role HashMap nominal representational
 
@@ -275,9 +275,9 @@ instance (Eq k, Hashable k, Read k, Read e) => Read (HashMap k e) where
 
     readListPrec = readListPrecDefault
 
--- instance (Show k, Show v) => Show (HashMap k v) where
---     showsPrec d m = showParen (d > 10) $
---       showString "fromList " . shows (toList m)
+instance (Show k, Show v) => Show (HashMap k v) where
+    showsPrec d m = showParen (d > 10) $
+      showString "fromList " . shows (toList m)
 
 instance Traversable (HashMap k) where
     traverse f = traverseWithKey (const f)

From 58af4519ace34c5f7d3c1359907ff75e27b9cdb8 Mon Sep 17 00:00:00 2001
From: Tom Sydney Kerckhove <syd@cs-syd.eu>
Date: Wed, 31 Oct 2018 09:37:01 +0100
Subject: [PATCH 69/69] some docs

---
 docs/developer-guide.md | 21 +++++++++++++++++----
 1 file changed, 17 insertions(+), 4 deletions(-)

diff --git a/docs/developer-guide.md b/docs/developer-guide.md
index 75f688c1..3d04a148 100644
--- a/docs/developer-guide.md
+++ b/docs/developer-guide.md
@@ -21,7 +21,7 @@ motivate its existance.
 
 ## A note on hash functions
 
-While the [hashable](http://hackage.haskell.org/package/containers) package is a
+While the [hashable](http://hackage.haskell.org/package/hashable) package is a
 separate package, it was co-designed with this package. Its main role is to
 support this package and not to provide good general purpose hash functions
 (e.g. to use when fingerprinting a text file).
@@ -84,15 +84,13 @@ data HashMap k v
     | BitmapIndexed !Bitmap !(A.Array (HashMap k v))
     | Leaf !Hash !(Leaf k v)
     | Full !(A.Array (HashMap k v))
-    | Collision !Hash !(A.Array (Leaf k v))
+    | Collision !Hash !(Leaf k v) !(Leaf k v) !(HashMap k v)
 ```
 
 Here's a quick overview in order of simplicty:
 
  * `Empty` -- The empty map.
  * `Leaf` -- A key-value pair.
- * `Collision` -- An array of key-value pairs where the keys have identical hash
-   values. Element order doesn't matter.
  * `Full` -- An array of *2^B* children. Given a key you can find the child it
    is part of by taking *B* bits of the hash value for the key and indexing into
    the key. Which bits to use depends on the tree level.
@@ -101,6 +99,8 @@ Here's a quick overview in order of simplicty:
    used to convert from the index taken from the hash value, just like above, to
    the actual index in the array. This node gets upgraded to a `Full` node when
    it contains *2^B* elements.
+ * `Collision` -- Twe key-value pairs that collide on the given hash, and a
+   recursive hashmap where keys are hashed with a different salt.
 
 The number of bits of the hash value to use at each level of the tree, *B*, is a
 compiled time constant (i.e. 4). In general a larger *B* improves lookup
@@ -111,6 +111,19 @@ updating the spine of the tree).
 indexing, faster copying on modification (given that its size is statically
 know), and lower memory use.
 
+`Collision` is a special case. The previous version used `Collision !Hash
+!(A.Array (HashMap k v))` instead of `Collision !Hash !(Leaf k v) !(Leaf k v)
+!(HashMap k v)`. As a result, hash-collisions would cause `O(number of
+collisions)` insertion time. Because the currently used hash function is not
+collision-resistant, it is cheap to make enough collisions to have this cause a
+denial of service exploit. However, we can use the fact that `hashable` supports
+salted hashing by default to alleviate at least some of this problem.  In the
+current version, insertion time is not `O(number of collisions)` but `O(number
+of consequtive levels of collision)`.  While this is not better in case all the
+collisions also collide on all subsequent salts, it is likely that a collision
+using one salt will not collide again on the next salt, so this approach is
+faster in the common case of collisions.
+
 ## Why things are fast
 
 Performance is largely dominated by memory layout and allocation. The code has