Hello community,
here is the log from the commit of package ghc-unordered-containers for
openSUSE:Factory checked in at 2018-05-30 12:15:43
++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
Comparing /work/SRC/openSUSE:Factory/ghc-unordered-containers (Old)
and /work/SRC/openSUSE:Factory/.ghc-unordered-containers.new (New)
++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
Package is "ghc-unordered-containers"
Wed May 30 12:15:43 2018 rev:12 rq:607918 version:0.2.9.0
Changes:
--------
---
/work/SRC/openSUSE:Factory/ghc-unordered-containers/ghc-unordered-containers.changes
2017-09-15 22:22:09.312858270 +0200
+++
/work/SRC/openSUSE:Factory/.ghc-unordered-containers.new/ghc-unordered-containers.changes
2018-05-30 12:27:47.213272088 +0200
@@ -1,0 +2,21 @@
+Mon May 14 17:02:11 UTC 2018 - [email protected]
+
+- Update unordered-containers to version 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)
+
+ * 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.
+
+-------------------------------------------------------------------
Old:
----
unordered-containers-0.2.8.0.tar.gz
New:
----
unordered-containers-0.2.9.0.tar.gz
++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
Other differences:
------------------
++++++ ghc-unordered-containers.spec ++++++
--- /var/tmp/diff_new_pack.ZIHK2u/_old 2018-05-30 12:27:47.909247647 +0200
+++ /var/tmp/diff_new_pack.ZIHK2u/_new 2018-05-30 12:27:47.913247507 +0200
@@ -1,7 +1,7 @@
#
# spec file for package ghc-unordered-containers
#
-# Copyright (c) 2017 SUSE LINUX GmbH, Nuernberg, Germany.
+# Copyright (c) 2018 SUSE LINUX GmbH, Nuernberg, Germany.
#
# All modifications and additions to the file contributed by third parties
# remain the property of their copyright owners, unless otherwise agreed
@@ -19,7 +19,7 @@
%global pkg_name unordered-containers
%bcond_with tests
Name: ghc-%{pkg_name}
-Version: 0.2.8.0
+Version: 0.2.9.0
Release: 0
Summary: Efficient hashing-based container types
License: BSD-3-Clause
@@ -79,7 +79,7 @@
%ghc_pkg_recache
%files -f %{name}.files
-%doc LICENSE
+%license LICENSE
%files devel -f %{name}-devel.files
%doc CHANGES.md
++++++ unordered-containers-0.2.8.0.tar.gz ->
unordered-containers-0.2.9.0.tar.gz ++++++
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore' old/unordered-containers-0.2.8.0/CHANGES.md
new/unordered-containers-0.2.9.0/CHANGES.md
--- old/unordered-containers-0.2.8.0/CHANGES.md 2017-03-18 00:38:19.000000000
+0100
+++ new/unordered-containers-0.2.9.0/CHANGES.md 2018-02-05 18:10:45.000000000
+0100
@@ -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`
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore' old/unordered-containers-0.2.8.0/Data/HashMap/Array.hs
new/unordered-containers-0.2.9.0/Data/HashMap/Array.hs
--- old/unordered-containers-0.2.8.0/Data/HashMap/Array.hs 2017-03-18
00:38:19.000000000 +0100
+++ new/unordered-containers-0.2.9.0/Data/HashMap/Array.hs 2018-02-05
18:10:45.000000000 +0100
@@ -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,
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore' old/unordered-containers-0.2.8.0/Data/HashMap/Base.hs
new/unordered-containers-0.2.9.0/Data/HashMap/Base.hs
--- old/unordered-containers-0.2.8.0/Data/HashMap/Base.hs 2017-03-18
00:38:19.000000000 +0100
+++ new/unordered-containers-0.2.9.0/Data/HashMap/Base.hs 2018-02-05
18:10:45.000000000 +0100
@@ -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
+-- /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
+
+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
- f' = flip f
+ 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"
- 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
-
--- 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
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore' old/unordered-containers-0.2.8.0/Data/HashMap/Lazy.hs
new/unordered-containers-0.2.9.0/Data/HashMap/Lazy.hs
--- old/unordered-containers-0.2.8.0/Data/HashMap/Lazy.hs 2017-03-18
00:38:19.000000000 +0100
+++ new/unordered-containers-0.2.9.0/Data/HashMap/Lazy.hs 2018-02-05
18:10:45.000000000 +0100
@@ -1,8 +1,5 @@
{-# LANGUAGE CPP #-}
-
-#if __GLASGOW_HASKELL__ >= 702
{-# LANGUAGE Trustworthy #-}
-#endif
------------------------------------------------------------------------
-- |
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore' old/unordered-containers-0.2.8.0/Data/HashMap/List.hs
new/unordered-containers-0.2.9.0/Data/HashMap/List.hs
--- old/unordered-containers-0.2.8.0/Data/HashMap/List.hs 1970-01-01
01:00:00.000000000 +0100
+++ new/unordered-containers-0.2.9.0/Data/HashMap/List.hs 2018-02-05
18:10:45.000000000 +0100
@@ -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)
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore'
old/unordered-containers-0.2.8.0/Data/HashMap/PopCount.hs
new/unordered-containers-0.2.9.0/Data/HashMap/PopCount.hs
--- old/unordered-containers-0.2.8.0/Data/HashMap/PopCount.hs 2017-03-18
00:38:19.000000000 +0100
+++ new/unordered-containers-0.2.9.0/Data/HashMap/PopCount.hs 1970-01-01
01:00:00.000000000 +0100
@@ -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
\ No newline at end of file
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore' old/unordered-containers-0.2.8.0/Data/HashMap/Strict.hs
new/unordered-containers-0.2.9.0/Data/HashMap/Strict.hs
--- old/unordered-containers-0.2.8.0/Data/HashMap/Strict.hs 2017-03-18
00:38:19.000000000 +0100
+++ new/unordered-containers-0.2.9.0/Data/HashMap/Strict.hs 2018-02-05
18:10:45.000000000 +0100
@@ -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
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore' old/unordered-containers-0.2.8.0/Data/HashMap/Unsafe.hs
new/unordered-containers-0.2.9.0/Data/HashMap/Unsafe.hs
--- old/unordered-containers-0.2.8.0/Data/HashMap/Unsafe.hs 2017-03-18
00:38:19.000000000 +0100
+++ new/unordered-containers-0.2.9.0/Data/HashMap/Unsafe.hs 2018-02-05
18:10:45.000000000 +0100
@@ -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
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore' old/unordered-containers-0.2.8.0/Data/HashSet.hs
new/unordered-containers-0.2.9.0/Data/HashSet.hs
--- old/unordered-containers-0.2.8.0/Data/HashSet.hs 2017-03-18
00:38:19.000000000 +0100
+++ new/unordered-containers-0.2.9.0/Data/HashSet.hs 2018-02-05
18:10:45.000000000 +0100
@@ -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
@@ -123,6 +123,15 @@
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
foldr = Data.HashSet.foldr
{-# INLINE foldr #-}
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore' old/unordered-containers-0.2.8.0/cbits/popc.c
new/unordered-containers-0.2.9.0/cbits/popc.c
--- old/unordered-containers-0.2.8.0/cbits/popc.c 2017-03-18
00:38:19.000000000 +0100
+++ new/unordered-containers-0.2.9.0/cbits/popc.c 1970-01-01
01:00:00.000000000 +0100
@@ -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 */
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore'
old/unordered-containers-0.2.8.0/tests/HashMapProperties.hs
new/unordered-containers-0.2.9.0/tests/HashMapProperties.hs
--- old/unordered-containers-0.2.8.0/tests/HashMapProperties.hs 2017-03-18
00:38:19.000000000 +0100
+++ new/unordered-containers-0.2.9.0/tests/HashMapProperties.hs 2018-02-05
18:10:45.000000000 +0100
@@ -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
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore'
old/unordered-containers-0.2.8.0/tests/HashSetProperties.hs
new/unordered-containers-0.2.9.0/tests/HashSetProperties.hs
--- old/unordered-containers-0.2.8.0/tests/HashSetProperties.hs 2017-03-18
00:38:19.000000000 +0100
+++ new/unordered-containers-0.2.9.0/tests/HashSetProperties.hs 2018-02-05
18:10:45.000000000 +0100
@@ -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
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore' old/unordered-containers-0.2.8.0/tests/List.hs
new/unordered-containers-0.2.9.0/tests/List.hs
--- old/unordered-containers-0.2.8.0/tests/List.hs 1970-01-01
01:00:00.000000000 +0100
+++ new/unordered-containers-0.2.9.0/tests/List.hs 2018-02-05
18:10:45.000000000 +0100
@@ -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]
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore' old/unordered-containers-0.2.8.0/tests/Strictness.hs
new/unordered-containers-0.2.9.0/tests/Strictness.hs
--- old/unordered-containers-0.2.8.0/tests/Strictness.hs 2017-03-18
00:38:19.000000000 +0100
+++ new/unordered-containers-0.2.9.0/tests/Strictness.hs 2018-02-05
18:10:45.000000000 +0100
@@ -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,10 +90,63 @@
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
]
]
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore'
old/unordered-containers-0.2.8.0/unordered-containers.cabal
new/unordered-containers-0.2.9.0/unordered-containers.cabal
--- old/unordered-containers-0.2.8.0/unordered-containers.cabal 2017-03-18
00:38:19.000000000 +0100
+++ new/unordered-containers-0.2.9.0/unordered-containers.cabal 2018-02-05
18:10:45.000000000 +0100
@@ -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
-
- ghc-options: -Wall -O2
- if impl(ghc >= 6.8)
- ghc-options: -fwarn-tabs
+ other-extensions:
+ RoleAnnotations,
+ UnboxedTuples,
+ ScopedTypeVariables,
+ MagicHash,
+ BangPatterns
+
+ 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
