packages feed

unordered-containers 0.2.8.0 → 0.2.9.0

raw patch · 15 files changed

+445/−443 lines, 15 filesdep ~basedep ~containersdep ~criterionnew-uploader

Dependency ranges changed: base, containers, criterion, hashable, test-framework-quickcheck2

Files

CHANGES.md view
@@ -1,3 +1,29 @@+## 0.2.9.0++ * Add `Ord/Ord1/Ord2` instances. (Thanks, Oleg Grenrus)++ * Use `SmallArray#` instead of `Array#` for GHC versions 7.10 and above.+   (Thanks, Dmitry Ivanov)++ * Adjust for `Semigroup => Monoid` proposal implementation.+   (Thanks, Ryan Scott)++### Bug fixes++ * Fix a strictness bug in `fromListWith`.++ * Enable eager blackholing for pre-8.2 GHC versions to work around+   a runtime system bug. (Thanks, Ben Gamari)++ * Avoid sketchy reimplementation of `ST` when compiling with recent+   GHC.++### Other changes++ * Remove support for GHC versions before 7.8. (Thanks, Dmitry Ivanov)++ * Add internal documentaton. (Thanks, Johan Tibell)+ ## 0.2.8.0   * Add `Eq1/2`, `Show1/2`, `Read1` instances with `base-4.9`
Data/HashMap/Array.hs view
@@ -53,12 +53,7 @@ import Control.Applicative (Applicative) #endif import Control.DeepSeq--- GHC 7.7 exports toList/fromList from GHC.Exts--- In order to avoid warnings on previous GHC versions, we provide--- an explicit import list instead of only hiding the offending symbols-import GHC.Exts (Array#, Int(..), newArray#, readArray#, writeArray#,-                 indexArray#, unsafeFreezeArray#, unsafeThawArray#,-                 MutableArray#)+import GHC.Exts(Int(..)) import GHC.ST (ST(..))  #if __GLASGOW_HASKELL__ >= 709@@ -67,9 +62,17 @@ import Prelude hiding (filter, foldr, length, map, read) #endif -#if __GLASGOW_HASKELL__ >= 702-import GHC.Exts (sizeofArray#, copyArray#, thawArray#, sizeofMutableArray#,-                 copyMutableArray#)+#if __GLASGOW_HASKELL__ >= 710+import GHC.Exts (SmallArray#, newSmallArray#, readSmallArray#, writeSmallArray#,+                 indexSmallArray#, unsafeFreezeSmallArray#, unsafeThawSmallArray#,+                 SmallMutableArray#, sizeofSmallArray#, copySmallArray#, thawSmallArray#,+                 sizeofSmallMutableArray#, copySmallMutableArray#)++#else+import GHC.Exts (Array#, newArray#, readArray#, writeArray#,+                 indexArray#, unsafeFreezeArray#, unsafeThawArray#,+                 MutableArray#, sizeofArray#, copyArray#, thawArray#,+                 sizeofMutableArray#, copyMutableArray#) #endif  #if defined(ASSERTS)@@ -78,6 +81,24 @@  import Data.HashMap.Unsafe (runST) ++#if __GLASGOW_HASKELL__ >= 710+type Array# a = SmallArray# a+type MutableArray# a = SmallMutableArray# a++newArray# = newSmallArray#+readArray# = readSmallArray#+writeArray# = writeSmallArray#+indexArray# = indexSmallArray#+unsafeFreezeArray# = unsafeFreezeSmallArray#+unsafeThawArray# = unsafeThawSmallArray#+sizeofArray# = sizeofSmallArray#+copyArray# = copySmallArray#+thawArray# = thawSmallArray#+sizeofMutableArray# = sizeofSmallMutableArray#+copyMutableArray# = copySmallMutableArray#+#endif+ ------------------------------------------------------------------------  #if defined(ASSERTS)@@ -100,49 +121,31 @@  data Array a = Array {       unArray :: !(Array# a)-#if __GLASGOW_HASKELL__ < 702-    , length :: !Int-#endif     }  instance Show a => Show (Array a) where     show = show . toList -#if __GLASGOW_HASKELL__ >= 702 length :: Array a -> Int length ary = I# (sizeofArray# (unArray ary)) {-# INLINE length #-}-#endif  -- | Smart constructor array :: Array# a -> Int -> Array a-#if __GLASGOW_HASKELL__ >= 702 array ary _n = Array ary-#else-array = Array-#endif {-# INLINE array #-}  data MArray s a = MArray {       unMArray :: !(MutableArray# s a)-#if __GLASGOW_HASKELL__ < 702-    , lengthM :: !Int-#endif     } -#if __GLASGOW_HASKELL__ >= 702 lengthM :: MArray s a -> Int lengthM mary = I# (sizeofMutableArray# (unMArray mary)) {-# INLINE lengthM #-}-#endif  -- | Smart constructor marray :: MutableArray# s a -> Int -> MArray s a-#if __GLASGOW_HASKELL__ >= 702 marray mary _n = MArray mary-#else-marray = MArray-#endif {-# INLINE marray #-}  ------------------------------------------------------------------------@@ -237,47 +240,21 @@  -- | Unsafely copy the elements of an array. Array bounds are not checked. copy :: Array e -> Int -> MArray s e -> Int -> Int -> ST s ()-#if __GLASGOW_HASKELL__ >= 702 copy !src !_sidx@(I# sidx#) !dst !_didx@(I# didx#) _n@(I# n#) =     CHECK_LE("copy", _sidx + _n, length src)     CHECK_LE("copy", _didx + _n, lengthM dst)         ST $ \ s# ->         case copyArray# (unArray src) sidx# (unMArray dst) didx# n# s# of             s2 -> (# s2, () #)-#else-copy !src !sidx !dst !didx n =-    CHECK_LE("copy", sidx + n, length src)-    CHECK_LE("copy", didx + n, lengthM dst)-        copy_loop sidx didx 0-  where-    copy_loop !i !j !c-        | c >= n = return ()-        | otherwise = do b <- indexM src i-                         write dst j b-                         copy_loop (i+1) (j+1) (c+1)-#endif  -- | Unsafely copy the elements of an array. Array bounds are not checked. copyM :: MArray s e -> Int -> MArray s e -> Int -> Int -> ST s ()-#if __GLASGOW_HASKELL__ >= 702 copyM !src !_sidx@(I# sidx#) !dst !_didx@(I# didx#) _n@(I# n#) =     CHECK_BOUNDS("copyM: src", lengthM src, _sidx + _n - 1)     CHECK_BOUNDS("copyM: dst", lengthM dst, _didx + _n - 1)     ST $ \ s# ->     case copyMutableArray# (unMArray src) sidx# (unMArray dst) didx# n# s# of         s2 -> (# s2, () #)-#else-copyM !src !sidx !dst !didx n =-    CHECK_BOUNDS("copyM: src", lengthM src, sidx + n - 1)-    CHECK_BOUNDS("copyM: dst", lengthM dst, didx + n - 1)-    copy_loop sidx didx 0-  where-    copy_loop !i !j !c-        | c >= n = return ()-        | otherwise = do b <- read src i-                         write dst j b-                         copy_loop (i+1) (j+1) (c+1)-#endif  -- | /O(n)/ Insert an element at the given position in this array, -- increasing its size by one.@@ -352,18 +329,10 @@ {-# NOINLINE undefinedElem #-}  thaw :: Array e -> Int -> Int -> ST s (MArray s e)-#if __GLASGOW_HASKELL__ >= 702 thaw !ary !_o@(I# o#) !n@(I# n#) =     CHECK_LE("thaw", _o + n, length ary)         ST $ \ s -> case thawArray# (unArray ary) o# n# s of             (# s2, mary# #) -> (# s2, marray mary# n #)-#else-thaw !ary !o !n =-    CHECK_LE("thaw", o + n, length ary)-        do mary <- new_ n-           copy ary o mary 0 n-           return mary-#endif {-# INLINE thaw #-}  -- | /O(n)/ Delete an element at the given position in this array,
Data/HashMap/Base.hs view
@@ -1,10 +1,8 @@ {-# LANGUAGE BangPatterns, CPP, DeriveDataTypeable, MagicHash #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE PatternGuards #-}-#if __GLASGOW_HASKELL__ >= 708 {-# LANGUAGE RoleAnnotations #-} {-# LANGUAGE TypeFamilies #-}-#endif {-# OPTIONS_GHC -fno-full-laziness -funbox-strict-fields #-}  module Data.HashMap.Base@@ -104,7 +102,7 @@ #endif import Control.DeepSeq (NFData(rnf)) import Control.Monad.ST (ST)-import Data.Bits ((.&.), (.|.), complement)+import Data.Bits ((.&.), (.|.), complement, popCount) import Data.Data hiding (Typeable) import qualified Data.Foldable as Foldable import qualified Data.List as L@@ -115,17 +113,13 @@ import qualified Data.HashMap.Array as A import qualified Data.Hashable as H import Data.Hashable (Hashable)-import Data.HashMap.PopCount (popCount) import Data.HashMap.Unsafe (runST) import Data.HashMap.UnsafeShift (unsafeShiftL, unsafeShiftR)+import Data.HashMap.List (isPermutationBy, unorderedCompare) import Data.Typeable (Typeable) -#if __GLASGOW_HASKELL__ >= 707 import GHC.Exts (isTrue#)-#endif-#if __GLASGOW_HASKELL__ >= 708 import qualified GHC.Exts as Exts-#endif  #if MIN_VERSION_base(4,9,0) import Data.Functor.Classes@@ -161,9 +155,7 @@     | Collision !Hash !(A.Array (Leaf k v))       deriving (Typeable) -#if __GLASGOW_HASKELL__ >= 708 type role HashMap nominal representational-#endif  instance (NFData k, NFData v) => NFData (HashMap k v) where     rnf Empty                 = ()@@ -267,10 +259,12 @@     -- order of elements in 'Collision').      go (Leaf k1 l1 : tl1) (Leaf k2 l2 : tl2)-      | k1 == k2 && leafEq l1 l2+      | 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 &&+      | k1 == k2 &&+        A.length ary1 == A.length ary2 &&         isPermutationBy leafEq (A.toList ary1) (A.toList ary2)       = go tl1 tl2     go [] [] = True@@ -278,26 +272,43 @@      leafEq (L k v) (L k' v') = eqk k k' && eqv v v' --- Note: previous implemenation isPermutation = null (as // bs)--- was O(n^2) too.+#if MIN_VERSION_base(4,9,0)+instance Ord2 HashMap where+    liftCompare2 = cmp++instance Ord k => Ord1 (HashMap k) where+    liftCompare = cmp compare+#endif++-- | The order is total. ----- This assumes lists are of equal length-isPermutationBy :: (a -> b -> Bool) -> [a] -> [b] -> Bool-isPermutationBy f = go-  where-    f' = flip f+-- /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+    compare = cmp compare compare -    go [] [] = True-    go (x : xs) (y : ys)-        | f x y     = go xs ys-        | otherwise = go (deleteBy f' y xs) (deleteBy f x ys)-    go [] (_ : _) = False-    go (_ : _) [] = False+cmp :: (k -> k' -> Ordering) -> (v -> v' -> Ordering)+    -> HashMap k v -> HashMap k' v' -> Ordering+cmp cmpk 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 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 tl1 tl2+    go (Leaf _ _ : _) (Collision _ _ : _) = LT+    go (Collision _ _ : _) (Leaf _ _ : _) = GT+    go [] [] = EQ+    go [] _  = LT+    go _  [] = GT+    go _ _ = error "cmp: Should never happend, toList' includes non Leaf / Collision" --- Data.List.deleteBy :: (a -> a -> Bool) -> a -> [a] -> [a]-deleteBy                :: (a -> b -> Bool) -> a -> [b] -> [b]-deleteBy _  _ []        = []-deleteBy eq x (y:ys)    = if x `eq` y then ys else y : deleteBy eq x ys+    leafCompare (L k v) (L k' v') = cmpk k k' `mappend` cmpv v v'  -- Same as 'equal' but doesn't compare the values. equalKeys :: (k -> k' -> Bool) -> HashMap k v -> HashMap k' v' -> Bool@@ -1299,28 +1310,7 @@ -- array is not checked. clone16 :: A.Array e -> ST s (A.MArray s e) clone16 ary =-#if __GLASGOW_HASKELL__ >= 702     A.thaw ary 0 16-#else-    do mary <- A.new_ 16-       A.indexM ary 0 >>= A.write mary 0-       A.indexM ary 1 >>= A.write mary 1-       A.indexM ary 2 >>= A.write mary 2-       A.indexM ary 3 >>= A.write mary 3-       A.indexM ary 4 >>= A.write mary 4-       A.indexM ary 5 >>= A.write mary 5-       A.indexM ary 6 >>= A.write mary 6-       A.indexM ary 7 >>= A.write mary 7-       A.indexM ary 8 >>= A.write mary 8-       A.indexM ary 9 >>= A.write mary 9-       A.indexM ary 10 >>= A.write mary 10-       A.indexM ary 11 >>= A.write mary 11-       A.indexM ary 12 >>= A.write mary 12-       A.indexM ary 13 >>= A.write mary 13-       A.indexM ary 14 >>= A.write mary 14-       A.indexM ary 15 >>= A.write mary 15-       return mary-#endif  ------------------------------------------------------------------------ -- Bit twiddling@@ -1355,18 +1345,12 @@ -- | Check if two the two arguments are the same value.  N.B. This -- function might give false negatives (due to GC moving objects.) ptrEq :: a -> a -> Bool-#if __GLASGOW_HASKELL__ < 707-ptrEq x y = reallyUnsafePtrEquality# x y ==# 1#-#else ptrEq x y = isTrue# (reallyUnsafePtrEquality# x y ==# 1#)-#endif {-# INLINE ptrEq #-} -#if __GLASGOW_HASKELL__ >= 708 ------------------------------------------------------------------------ -- IsList instance instance (Eq k, Hashable k) => Exts.IsList (HashMap k v) where     type Item (HashMap k v) = (k, v)     fromList = fromList     toList   = toList-#endif
Data/HashMap/Lazy.hs view
@@ -1,8 +1,5 @@ {-# LANGUAGE CPP #-}--#if __GLASGOW_HASKELL__ >= 702 {-# LANGUAGE Trustworthy #-}-#endif  ------------------------------------------------------------------------ -- |
+ Data/HashMap/List.hs view
@@ -0,0 +1,66 @@+{-# LANGUAGE ScopedTypeVariables #-}+{-# OPTIONS_GHC -fno-full-laziness -funbox-strict-fields #-}+-- | Extra list functions+--+-- In separate module to aid testing.+module Data.HashMap.List+    ( isPermutationBy+    , deleteBy+    , unorderedCompare+    ) where++import Data.Maybe (fromMaybe)+import Data.List (sortBy)+import Data.Monoid+import Prelude++-- Note: previous implemenation isPermutation = null (as // bs)+-- was O(n^2) too.+--+-- This assumes lists are of equal length+isPermutationBy :: (a -> b -> Bool) -> [a] -> [b] -> Bool+isPermutationBy f = go+  where+    f' = flip f++    go [] [] = True+    go (x : xs) (y : ys)+        | f x y         = go xs ys+        | otherwise     = fromMaybe False $ do+            xs' <- deleteBy f' y xs+            ys' <- deleteBy f x ys+            return (go xs' ys')+    go [] (_ : _) = False+    go (_ : _) [] = False++-- The idea:+--+-- Homogeonous version+--+-- uc :: (a -> a -> Ordering) -> [a] -> [a] -> Ordering+-- uc c as bs = compare (sortBy c as) (sortBy c bs)+--+-- But as we have only (a -> b -> Ordering), we cannot directly compare+-- elements from the same list.+--+-- So when comparing elements from the list, we count how many elements are+-- "less and greater" in the other list, and use the count as a metric.+--+unorderedCompare :: (a -> b -> Ordering) -> [a] -> [b] -> Ordering+unorderedCompare c as bs = go (sortBy cmpA as) (sortBy cmpB bs)+  where+    go [] [] = EQ+    go [] (_ : _) = LT+    go (_ : _) [] = GT+    go (x : xs) (y : ys) = c x y `mappend` go xs ys++    cmpA a a' = compare (inB a) (inB a')+    cmpB b b' = compare (inA b) (inA b')++    inB a = (length $ filter (\b -> c a b == GT) bs, negate $ length $ filter (\b -> c a b == LT) bs)+    inA b = (length $ filter (\a -> c a b == LT) as, negate $ length $ filter (\a -> c a b == GT) as)++-- Returns Nothing is nothing deleted+deleteBy              :: (a -> b -> Bool) -> a -> [b] -> Maybe [b]+deleteBy _  _ []      = Nothing+deleteBy eq x (y:ys)  = if x `eq` y then Just ys else fmap (y :) (deleteBy eq x ys)
− Data/HashMap/PopCount.hs 
@@ -1,19 +0,0 @@-{-# LANGUAGE CPP, ForeignFunctionInterface #-}--module Data.HashMap.PopCount-    ( popCount-    ) where--#if __GLASGOW_HASKELL__ >= 704-import Data.Bits (popCount)-#else-import Data.Word (Word)-import Foreign.C (CUInt)-#endif--#if __GLASGOW_HASKELL__ < 704-foreign import ccall unsafe "popc.h popcount" c_popcount :: CUInt -> CUInt--popCount :: Word -> Int-popCount w = fromIntegral (c_popcount (fromIntegral w))-#endif
Data/HashMap/Strict.hs view
@@ -1,8 +1,5 @@ {-# LANGUAGE BangPatterns, CPP, PatternGuards #-}--#if __GLASGOW_HASKELL__ >= 702 {-# LANGUAGE Trustworthy #-}-#endif  ------------------------------------------------------------------------ -- |@@ -183,7 +180,7 @@                     else do                         let l' = x `seq` (L k x)                         return $! collision h l l'-        | otherwise = two s h k x hy ky y+        | otherwise = x `seq` two s h k x hy ky y     go h k x s t@(BitmapIndexed b ary)         | b .&. m == 0 = do             ary' <- A.insertM ary i $! leaf h k x
Data/HashMap/Unsafe.hs view
@@ -1,4 +1,8 @@+{-# LANGUAGE CPP #-}++#if !MIN_VERSION_base(4,9,0) {-# LANGUAGE MagicHash, Rank2Types, UnboxedTuples #-}+#endif  -- | This module exports a workaround for this bug: --@@ -12,6 +16,12 @@     ( runST     ) where +#if MIN_VERSION_base(4,9,0)+-- The GHC issue was fixed in GHC 8.0/base 4.9+import Control.Monad.ST++#else+ import GHC.Base (realWorld#) import qualified GHC.ST as ST @@ -26,3 +36,4 @@ runSTRep st_rep = case st_rep realWorld# of                         (# _, r #) -> r {-# INLINE [0] runSTRep #-}+#endif
Data/HashSet.hs view
@@ -77,7 +77,7 @@ import Data.HashMap.Base (HashMap, foldrWithKey, equalKeys) import Data.Hashable (Hashable(hashWithSalt)) #if __GLASGOW_HASKELL__ >= 711-import Data.Semigroup (Semigroup(..), Monoid(..))+import Data.Semigroup (Semigroup(..)) #elif __GLASGOW_HASKELL__ < 709 import Data.Monoid (Monoid(..)) #endif@@ -121,6 +121,15 @@ #if MIN_VERSION_base(4,9,0) instance Eq1 HashSet where     liftEq eq (HashSet a) (HashSet b) = equalKeys eq a b+#endif++instance (Ord a) => Ord (HashSet a) where+    compare (HashSet a) (HashSet b) = compare a b+    {-# INLINE compare #-}++#if MIN_VERSION_base(4,9,0)+instance Ord1 HashSet where+    liftCompare c (HashSet a) (HashSet b) = liftCompare2 c compare a b #endif  instance Foldable.Foldable HashSet where
− cbits/popc.c 
@@ -1,273 +0,0 @@-#include <inttypes.h>--/* Cribbed from http://wiki.cs.pdx.edu/forge/popcount.html */-static char popcount_table_8[256] = {-  /*0*/ 0,-  /*1*/ 1,-  /*2*/ 1,-  /*3*/ 2,-  /*4*/ 1,-  /*5*/ 2,-  /*6*/ 2,-  /*7*/ 3,-  /*8*/ 1,-  /*9*/ 2,-  /*10*/ 2,-  /*11*/ 3,-  /*12*/ 2,-  /*13*/ 3,-  /*14*/ 3,-  /*15*/ 4,-  /*16*/ 1,-  /*17*/ 2,-  /*18*/ 2,-  /*19*/ 3,-  /*20*/ 2,-  /*21*/ 3,-  /*22*/ 3,-  /*23*/ 4,-  /*24*/ 2,-  /*25*/ 3,-  /*26*/ 3,-  /*27*/ 4,-  /*28*/ 3,-  /*29*/ 4,-  /*30*/ 4,-  /*31*/ 5,-  /*32*/ 1,-  /*33*/ 2,-  /*34*/ 2,-  /*35*/ 3,-  /*36*/ 2,-  /*37*/ 3,-  /*38*/ 3,-  /*39*/ 4,-  /*40*/ 2,-  /*41*/ 3,-  /*42*/ 3,-  /*43*/ 4,-  /*44*/ 3,-  /*45*/ 4,-  /*46*/ 4,-  /*47*/ 5,-  /*48*/ 2,-  /*49*/ 3,-  /*50*/ 3,-  /*51*/ 4,-  /*52*/ 3,-  /*53*/ 4,-  /*54*/ 4,-  /*55*/ 5,-  /*56*/ 3,-  /*57*/ 4,-  /*58*/ 4,-  /*59*/ 5,-  /*60*/ 4,-  /*61*/ 5,-  /*62*/ 5,-  /*63*/ 6,-  /*64*/ 1,-  /*65*/ 2,-  /*66*/ 2,-  /*67*/ 3,-  /*68*/ 2,-  /*69*/ 3,-  /*70*/ 3,-  /*71*/ 4,-  /*72*/ 2,-  /*73*/ 3,-  /*74*/ 3,-  /*75*/ 4,-  /*76*/ 3,-  /*77*/ 4,-  /*78*/ 4,-  /*79*/ 5,-  /*80*/ 2,-  /*81*/ 3,-  /*82*/ 3,-  /*83*/ 4,-  /*84*/ 3,-  /*85*/ 4,-  /*86*/ 4,-  /*87*/ 5,-  /*88*/ 3,-  /*89*/ 4,-  /*90*/ 4,-  /*91*/ 5,-  /*92*/ 4,-  /*93*/ 5,-  /*94*/ 5,-  /*95*/ 6,-  /*96*/ 2,-  /*97*/ 3,-  /*98*/ 3,-  /*99*/ 4,-  /*100*/ 3,-  /*101*/ 4,-  /*102*/ 4,-  /*103*/ 5,-  /*104*/ 3,-  /*105*/ 4,-  /*106*/ 4,-  /*107*/ 5,-  /*108*/ 4,-  /*109*/ 5,-  /*110*/ 5,-  /*111*/ 6,-  /*112*/ 3,-  /*113*/ 4,-  /*114*/ 4,-  /*115*/ 5,-  /*116*/ 4,-  /*117*/ 5,-  /*118*/ 5,-  /*119*/ 6,-  /*120*/ 4,-  /*121*/ 5,-  /*122*/ 5,-  /*123*/ 6,-  /*124*/ 5,-  /*125*/ 6,-  /*126*/ 6,-  /*127*/ 7,-  /*128*/ 1,-  /*129*/ 2,-  /*130*/ 2,-  /*131*/ 3,-  /*132*/ 2,-  /*133*/ 3,-  /*134*/ 3,-  /*135*/ 4,-  /*136*/ 2,-  /*137*/ 3,-  /*138*/ 3,-  /*139*/ 4,-  /*140*/ 3,-  /*141*/ 4,-  /*142*/ 4,-  /*143*/ 5,-  /*144*/ 2,-  /*145*/ 3,-  /*146*/ 3,-  /*147*/ 4,-  /*148*/ 3,-  /*149*/ 4,-  /*150*/ 4,-  /*151*/ 5,-  /*152*/ 3,-  /*153*/ 4,-  /*154*/ 4,-  /*155*/ 5,-  /*156*/ 4,-  /*157*/ 5,-  /*158*/ 5,-  /*159*/ 6,-  /*160*/ 2,-  /*161*/ 3,-  /*162*/ 3,-  /*163*/ 4,-  /*164*/ 3,-  /*165*/ 4,-  /*166*/ 4,-  /*167*/ 5,-  /*168*/ 3,-  /*169*/ 4,-  /*170*/ 4,-  /*171*/ 5,-  /*172*/ 4,-  /*173*/ 5,-  /*174*/ 5,-  /*175*/ 6,-  /*176*/ 3,-  /*177*/ 4,-  /*178*/ 4,-  /*179*/ 5,-  /*180*/ 4,-  /*181*/ 5,-  /*182*/ 5,-  /*183*/ 6,-  /*184*/ 4,-  /*185*/ 5,-  /*186*/ 5,-  /*187*/ 6,-  /*188*/ 5,-  /*189*/ 6,-  /*190*/ 6,-  /*191*/ 7,-  /*192*/ 2,-  /*193*/ 3,-  /*194*/ 3,-  /*195*/ 4,-  /*196*/ 3,-  /*197*/ 4,-  /*198*/ 4,-  /*199*/ 5,-  /*200*/ 3,-  /*201*/ 4,-  /*202*/ 4,-  /*203*/ 5,-  /*204*/ 4,-  /*205*/ 5,-  /*206*/ 5,-  /*207*/ 6,-  /*208*/ 3,-  /*209*/ 4,-  /*210*/ 4,-  /*211*/ 5,-  /*212*/ 4,-  /*213*/ 5,-  /*214*/ 5,-  /*215*/ 6,-  /*216*/ 4,-  /*217*/ 5,-  /*218*/ 5,-  /*219*/ 6,-  /*220*/ 5,-  /*221*/ 6,-  /*222*/ 6,-  /*223*/ 7,-  /*224*/ 3,-  /*225*/ 4,-  /*226*/ 4,-  /*227*/ 5,-  /*228*/ 4,-  /*229*/ 5,-  /*230*/ 5,-  /*231*/ 6,-  /*232*/ 4,-  /*233*/ 5,-  /*234*/ 5,-  /*235*/ 6,-  /*236*/ 5,-  /*237*/ 6,-  /*238*/ 6,-  /*239*/ 7,-  /*240*/ 4,-  /*241*/ 5,-  /*242*/ 5,-  /*243*/ 6,-  /*244*/ 5,-  /*245*/ 6,-  /*246*/ 6,-  /*247*/ 7,-  /*248*/ 5,-  /*249*/ 6,-  /*250*/ 6,-  /*251*/ 7,-  /*252*/ 6,-  /*253*/ 7,-  /*254*/ 7,-  /*255*/ 8,-};-/* Table-driven popcount, with 8-bit tables */-/* 6 ops plus 4 casts and 4 lookups, 0 long immediates, 4 stages */-uint32_t-popcount(uint32_t x)-{-    return popcount_table_8[(uint8_t)x] +-       popcount_table_8[(uint8_t)(x >> 8)] +-       popcount_table_8[(uint8_t)(x >> 16)] +-       popcount_table_8[(uint8_t)(x >> 24)];-}--/* TODO: Add a 16-bit variant */
tests/HashMapProperties.hs view
@@ -40,6 +40,45 @@ pNeq :: [(Key, Int)] -> [(Key, Int)] -> Bool pNeq xs = (M.fromList xs /=) `eq` (HM.fromList xs /=) +-- We cannot compare to `Data.Map` as ordering is different.+pOrd1 :: [(Key, Int)] -> Bool+pOrd1 xs = compare x x == EQ+  where+    x = HM.fromList xs++pOrd2 :: [(Key, Int)] -> [(Key, Int)] -> [(Key, Int)] -> Bool+pOrd2 xs ys zs = case (compare x y, compare y z) of+    (EQ, o)  -> compare x z == o+    (o,  EQ) -> compare x z == o+    (LT, LT) -> compare x z == LT+    (GT, GT) -> compare x z == GT+    (LT, GT) -> True -- ys greater than xs and zs.+    (GT, LT) -> True+  where+    x = HM.fromList xs+    y = HM.fromList ys+    z = HM.fromList zs++pOrd3 :: [(Key, Int)] -> [(Key, Int)] -> Bool+pOrd3 xs ys = case (compare x y, compare y x) of+    (EQ, EQ) -> True+    (LT, GT) -> True+    (GT, LT) -> True+    _        -> False+  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+    (LT, False) -> True+    (GT, False) -> True+    _           -> False+  where+    x = HM.fromList xs+    y = HM.fromList ys+ pReadShow :: [(Key, Int)] -> Bool pReadShow xs = M.fromList xs == read (show (M.fromList xs)) @@ -254,6 +293,10 @@       testGroup "instances"       [ testProperty "==" pEq       , testProperty "/=" pNeq+      , testProperty "compare reflexive" pOrd1+      , testProperty "compare transitive" pOrd2+      , testProperty "compare antisymmetric" pOrd3+      , testProperty "Ord => Eq" pOrdEq       , testProperty "Read/Show" pReadShow       , testProperty "Functor" pFunctor       , testProperty "Foldable" pFoldable
tests/HashSetProperties.hs view
@@ -34,6 +34,45 @@ pNeq :: [Key] -> [Key] -> Bool pNeq xs = (Set.fromList xs /=) `eq` (S.fromList xs /=) +-- We cannot compare to `Data.Map` as ordering is different.+pOrd1 :: [Key] -> Bool+pOrd1 xs = compare x x == EQ+  where+    x = S.fromList xs++pOrd2 :: [Key] -> [Key] -> [Key] -> Bool+pOrd2 xs ys zs = case (compare x y, compare y z) of+    (EQ, o)  -> compare x z == o+    (o,  EQ) -> compare x z == o+    (LT, LT) -> compare x z == LT+    (GT, GT) -> compare x z == GT+    (LT, GT) -> True -- ys greater than xs and zs.+    (GT, LT) -> True+  where+    x = S.fromList xs+    y = S.fromList ys+    z = S.fromList zs++pOrd3 :: [Key] -> [Key] -> Bool+pOrd3 xs ys = case (compare x y, compare y x) of+    (EQ, EQ) -> True+    (LT, GT) -> True+    (GT, LT) -> True+    _        -> False+  where+    x = S.fromList xs+    y = S.fromList ys++pOrdEq :: [Key] -> [Key] -> Bool+pOrdEq xs ys = case (compare x y, x == y) of+    (EQ, True)  -> True+    (LT, False) -> True+    (GT, False) -> True+    _           -> False+  where+    x = S.fromList xs+    y = S.fromList ys+ pReadShow :: [Key] -> Bool pReadShow xs = Set.fromList xs == read (show (Set.fromList xs)) @@ -136,6 +175,10 @@       [ testProperty "==" pEq       , testProperty "Permutation ==" pPermutationEq       , testProperty "/=" pNeq+      , testProperty "compare reflexive" pOrd1+      , testProperty "compare transitive" pOrd2+      , testProperty "compare antisymmetric" pOrd3+      , testProperty "Ord => Eq" pOrdEq       , testProperty "Read/Show" pReadShow       , testProperty "Foldable" pFoldable       , testProperty "Hashable" pHashable
+ tests/List.hs view
@@ -0,0 +1,68 @@+module Main (main) where++import Data.HashMap.List+import Data.List (nub, sort, sortBy)+import Data.Ord (comparing)++import Test.Framework (Test, defaultMain, testGroup)+import Test.Framework.Providers.QuickCheck2 (testProperty)+import Test.QuickCheck ((==>), (===), property, Property)++tests :: Test+tests = testGroup "Data.HashMap.List"+    [ testProperty "isPermutationBy" pIsPermutation+    , testProperty "isPermutationBy of different length" pIsPermutationDiffLength+    , testProperty "pUnorderedCompare" pUnorderedCompare+    , testGroup "modelUnorderedCompare"+        [ testProperty "reflexive" modelUnorderedCompareRefl+        , testProperty "anti-symmetric" modelUnorderedCompareAntiSymm+        , testProperty "transitive" modelUnorderedCompareTrans+        ]+    ]++pIsPermutation :: [Char] -> [Int] -> Bool+pIsPermutation xs is = isPermutationBy (==) xs xs'+  where+    is' = nub is ++ [maximum (0:is) + 1 ..]+    xs' = map fst . sortBy (comparing snd) $ zip xs is'++pIsPermutationDiffLength :: [Int] -> [Int] -> Property+pIsPermutationDiffLength xs ys =+    length xs /= length ys ==> isPermutationBy (==) xs ys === False++-- | Homogenous version of 'unorderedCompare'+--+-- *Compare smallest non-equal elements of the two lists*.+modelUnorderedCompare :: Ord a => [a] -> [a] -> Ordering+modelUnorderedCompare as bs = compare (sort as) (sort bs)++modelUnorderedCompareRefl :: [Int] -> Property+modelUnorderedCompareRefl xs = modelUnorderedCompare xs xs === EQ++modelUnorderedCompareAntiSymm :: [Int] -> [Int] -> Property+modelUnorderedCompareAntiSymm xs ys = case a of+    EQ -> b === EQ+    LT -> b === GT+    GT -> b === LT+  where+    a = modelUnorderedCompare xs ys+    b = modelUnorderedCompare ys xs++modelUnorderedCompareTrans :: [Int] -> [Int] -> [Int] -> Property+modelUnorderedCompareTrans xs ys zs =+    case (modelUnorderedCompare xs ys, modelUnorderedCompare ys zs) of+        (EQ, yz) -> xz === yz+        (xy, EQ) -> xz === xy+        (LT, LT) -> xz === LT+        (GT, GT) -> xz === GT+        (LT, GT) -> property True+        (GT, LT) -> property True+  where+    xz = modelUnorderedCompare xs zs++pUnorderedCompare :: [Int] -> [Int] -> Property+pUnorderedCompare xs ys =+    unorderedCompare compare xs ys === modelUnorderedCompare xs ys++main :: IO ()+main = defaultMain [tests]
tests/Strictness.hs view
@@ -1,4 +1,4 @@-{-# LANGUAGE FlexibleInstances, GeneralizedNewtypeDeriving #-}+{-# LANGUAGE CPP, FlexibleInstances, GeneralizedNewtypeDeriving #-} {-# OPTIONS_GHC -fno-warn-orphans #-}  module Main (main) where@@ -7,7 +7,18 @@ import Test.ChasingBottoms.IsBottom import Test.Framework (Test, defaultMain, testGroup) import Test.Framework.Providers.QuickCheck2 (testProperty)-import Test.QuickCheck (Arbitrary(arbitrary))+import Test.QuickCheck (Arbitrary(arbitrary), Property, (===), (.&&.))+import Test.QuickCheck.Function+import Test.QuickCheck.Poly (A)+import Data.Maybe (fromMaybe, isJust)+import Control.Arrow (second)+import Control.Monad (guard)+import Data.Foldable (foldl')+#if !MIN_VERSION_base(4,8,0)+import Data.Functor ((<$))+import Data.Foldable (all)+import Prelude hiding (all)+#endif  import Data.HashMap.Strict (HashMap) import qualified Data.HashMap.Strict as HM@@ -79,11 +90,64 @@ pFromListWithKeyStrict f =     isBottom $ HM.fromListWith f [(undefined :: Key, 1 :: Int)] -pFromListWithValueStrict :: [(Key, Int)] -> Bool-pFromListWithValueStrict xs = case xs of-    [] -> True-    (x:_) -> isBottom $ HM.fromListWith (\ _ _ -> undefined) (x:xs)+-- The strictness properties of 'fromListWith' are not entirely+-- trivial.+-- fromListWith f kvs is strict in the first value seen for each+-- key, but potentially lazy in the rest: the combining function+-- could be lazy in the "new" value. fromListWith must, however,+-- be strict in whatever value is actually inserted into the map.+-- Getting all these properties specified efficiently seems tricky.+-- Since it's not hard, we verify that the converted HashMap has+-- no unforced values. Rather than trying to go into detail for the+-- rest, this test compares the strictness behavior of fromListWith+-- to that of insertWith. The latter should be easier to specify+-- and (if we choose to do so) test thoroughly.+--+-- We'll fake up a representation of things that are possibly+-- bottom by using Nothing to represent bottom. The combining+-- (partial) function is represented by a "lazy total" function+-- Maybe a -> Maybe a -> Maybe a, along with a function determining+-- whether the result should be non-bottom, Maybe a -> Maybe a -> Bool,+-- indicating how the combining function should behave if neither+-- argument, just the first argument, just the second argument,+-- or both arguments are bottom. It would be quite tempting to+-- just use Maybe A -> Maybe A -> Maybe A, but that would not+-- necessarily be continous.+pFromListWithValueResultStrict :: [(Key, Maybe A)]+                               -> Fun (Maybe A, Maybe A) A+                               -> Fun (Maybe A, Maybe A) Bool+                               -> Property+pFromListWithValueResultStrict lst comb_lazy calc_good_raw+         = all (all isJust) recovered .&&. (recovered === recover (fmap recover fake_map))+  where+    recovered :: Maybe (HashMap Key (Maybe A))+    recovered = recover (fmap recover real_map)+    -- What we get out of the conversion using insertWith+    fake_map = foldl' (\m (k,v) -> HM.insertWith real_comb k v m) HM.empty real_list +    -- A continuous version of calc_good_raw+    calc_good Nothing Nothing = cgr Nothing Nothing+    calc_good Nothing y@(Just _) = cgr Nothing Nothing || cgr Nothing y+    calc_good x@(Just _) Nothing = cgr Nothing Nothing || cgr x Nothing+    calc_good x y = cgr Nothing Nothing || cgr Nothing y || cgr x Nothing || cgr x y+    cgr = curry $ apply calc_good_raw++    -- The Maybe A -> Maybe A -> Maybe A that we're after, representing a+    -- potentially less total function than comb_lazy+    comb x y = apply comb_lazy (x, y) <$ guard (calc_good x y)++    -- What we get out of the conversion using fromListWith+    real_map = HM.fromListWith real_comb real_list++    -- A list that may have actual bottom values in it.+    real_list = map (second (fromMaybe bottom)) lst++    -- A genuinely partial function mirroring comb+    real_comb x y = fromMaybe bottom $ comb (recover x) (recover y)++    recover :: a -> Maybe a+    recover a = a <$ guard (not $ isBottom a)+ ------------------------------------------------------------------------ -- * Test list @@ -108,7 +172,7 @@       , testProperty "fromList is key-strict" pFromListKeyStrict       , testProperty "fromList is value-strict" pFromListValueStrict       , testProperty "fromListWith is key-strict" pFromListWithKeyStrict-      , testProperty "fromListWith is value-strict" pFromListWithValueStrict+      , testProperty "fromListWith is value-strict" pFromListWithValueResultStrict       ]     ]
unordered-containers.cabal view
@@ -1,5 +1,5 @@ name:           unordered-containers-version:        0.2.8.0+version:        0.2.9.0 synopsis:       Efficient hashing-based container types description:   Efficient hashing-based container types.  The containers have been@@ -20,7 +20,7 @@ build-type:     Simple cabal-version:  >=1.8 extra-source-files: CHANGES.md-tested-with:    GHC==8.0.1, GHC==7.10.3, GHC==7.8.4, GHC==7.6.3, GHC==7.4.2+tested-with:    GHC==8.4.1, GHC==8.2.2, GHC==8.0.2, GHC==7.10.3, GHC==7.8.4  flag debug   description:  Enable debug support@@ -34,21 +34,29 @@   other-modules:     Data.HashMap.Array     Data.HashMap.Base-    Data.HashMap.PopCount+    Data.HashMap.List     Data.HashMap.Unsafe     Data.HashMap.UnsafeShift    build-depends:-    base >= 4 && < 5,+    base >= 4.7 && < 5,     deepseq >= 1.1,     hashable >= 1.0.1.1 && < 1.3 -  if impl(ghc < 7.4)-    c-sources: cbits/popc.c+  other-extensions:+    RoleAnnotations,+    UnboxedTuples,+    ScopedTypeVariables,+    MagicHash,+    BangPatterns -  ghc-options: -Wall -O2-  if impl(ghc >= 6.8)-    ghc-options: -fwarn-tabs+  ghc-options: -Wall -O2 -fwarn-tabs -ferror-spans++  if impl (ghc < 8.2)+    -- This is absolutely necessary (but not sufficient) for correctness due to+    -- the referential-transparency-breaking mutability in unsafeInsertWith. See+    -- #147 and GHC #13615 for details. The bug was fixed in GHC 8.2.+    ghc-options: -feager-blackholing   if flag(debug)     cpp-options: -DASSERTS @@ -103,6 +111,23 @@   ghc-options: -Wall   cpp-options: -DASSERTS +test-suite list-tests+  hs-source-dirs: tests .+  main-is: List.hs+  other-modules:+    Data.HashMap.List+  type: exitcode-stdio-1.0++  build-depends:+    base,+    containers >= 0.4,+    QuickCheck >= 2.4.0.1,+    test-framework >= 0.3.3,+    test-framework-quickcheck2 >= 0.2.9++  ghc-options: -Wall+  cpp-options: -DASSERTS+ test-suite regressions   hs-source-dirs: tests   main-is: Regressions.hs@@ -151,7 +176,6 @@     Data.HashMap.Array     Data.HashMap.Base     Data.HashMap.Lazy-    Data.HashMap.PopCount     Data.HashMap.Strict     Data.HashMap.Unsafe     Data.HashMap.UnsafeShift@@ -164,7 +188,7 @@     base,     bytestring,     containers,-    criterion >= 1.0 && < 1.2,+    criterion >= 1.0 && < 1.3,     deepseq >= 1.1,     deepseq-generics,     hashable >= 1.0.1.1,@@ -172,14 +196,7 @@     mtl,     random -  if impl(ghc < 7.4)-    c-sources: cbits/popc.c--  ghc-options: -Wall -O2 -rtsopts-  if impl(ghc >= 6.8)-    ghc-options: -fwarn-tabs-  if impl(ghc > 6.10)-    ghc-options: -fregs-graph+  ghc-options: -Wall -O2 -rtsopts -fwarn-tabs -ferror-spans   if flag(debug)     cpp-options: -DASSERTS