diff --git a/Data/Graph.hs b/Data/Graph.hs --- a/Data/Graph.hs +++ b/Data/Graph.hs @@ -21,7 +21,6 @@ -- License : BSD-style (see the file libraries/base/LICENSE) -- -- Maintainer : libraries@haskell.org --- Stability : experimental -- Portability : portable -- -- A version of the graph algorithms described in: diff --git a/Data/IntMap.hs b/Data/IntMap.hs --- a/Data/IntMap.hs +++ b/Data/IntMap.hs @@ -12,7 +12,6 @@ -- (c) Andriy Palamarchuk 2008 -- License : BSD-style -- Maintainer : libraries@haskell.org --- Stability : provisional -- Portability : portable -- -- An efficient implementation of maps from integer keys to values diff --git a/Data/IntMap/Internal.hs b/Data/IntMap/Internal.hs --- a/Data/IntMap/Internal.hs +++ b/Data/IntMap/Internal.hs @@ -21,7 +21,6 @@ -- (c) wren romano 2016 -- License : BSD-style -- Maintainer : libraries@haskell.org --- Stability : provisional -- Portability : portable -- -- = WARNING @@ -425,7 +424,7 @@ go x (Bin _ _ l r) = go x l || go x r {-# INLINABLE elem #-} maximum = start - where start Nil = error "IntMap.Foldable.maximum: called with empty map" + where start Nil = error "Data.Foldable.maximum (for Data.IntMap): empty map" start (Tip _ y) = y start (Bin _ _ l r) = go (start l) r @@ -434,7 +433,7 @@ go m (Bin _ _ l r) = go (go m l) r {-# INLINABLE maximum #-} minimum = start - where start Nil = error "IntMap.Foldable.minimum: called with empty map" + where start Nil = error "Data.Foldable.minimum (for Data.IntMap): empty map" start (Tip _ y) = y start (Bin _ _ l r) = go (start l) r diff --git a/Data/IntMap/Lazy.hs b/Data/IntMap/Lazy.hs --- a/Data/IntMap/Lazy.hs +++ b/Data/IntMap/Lazy.hs @@ -12,7 +12,6 @@ -- (c) Andriy Palamarchuk 2008 -- License : BSD-style -- Maintainer : libraries@haskell.org --- Stability : provisional -- Portability : portable -- -- An efficient implementation of maps from integer keys to values diff --git a/Data/IntMap/Merge/Lazy.hs b/Data/IntMap/Merge/Lazy.hs --- a/Data/IntMap/Merge/Lazy.hs +++ b/Data/IntMap/Merge/Lazy.hs @@ -24,7 +24,6 @@ -- Copyright : (c) wren romano 2016 -- License : BSD-style -- Maintainer : libraries@haskell.org --- Stability : provisional -- Portability : portable -- -- This module defines an API for writing functions that merge two diff --git a/Data/IntMap/Merge/Strict.hs b/Data/IntMap/Merge/Strict.hs --- a/Data/IntMap/Merge/Strict.hs +++ b/Data/IntMap/Merge/Strict.hs @@ -24,7 +24,6 @@ -- Copyright : (c) wren romano 2016 -- License : BSD-style -- Maintainer : libraries@haskell.org --- Stability : provisional -- Portability : portable -- -- This module defines an API for writing functions that merge two diff --git a/Data/IntMap/Strict.hs b/Data/IntMap/Strict.hs --- a/Data/IntMap/Strict.hs +++ b/Data/IntMap/Strict.hs @@ -13,7 +13,6 @@ -- (c) Andriy Palamarchuk 2008 -- License : BSD-style -- Maintainer : libraries@haskell.org --- Stability : provisional -- Portability : portable -- -- An efficient implementation of maps from integer keys to values diff --git a/Data/IntSet.hs b/Data/IntSet.hs --- a/Data/IntSet.hs +++ b/Data/IntSet.hs @@ -12,7 +12,6 @@ -- (c) Joachim Breitner 2011 -- License : BSD-style -- Maintainer : libraries@haskell.org --- Stability : provisional -- Portability : portable -- -- An efficient implementation of integer sets. diff --git a/Data/IntSet/Internal.hs b/Data/IntSet/Internal.hs --- a/Data/IntSet/Internal.hs +++ b/Data/IntSet/Internal.hs @@ -19,7 +19,6 @@ -- (c) Joachim Breitner 2011 -- License : BSD-style -- Maintainer : libraries@haskell.org --- Stability : provisional -- Portability : portable -- -- = WARNING diff --git a/Data/Map.hs b/Data/Map.hs --- a/Data/Map.hs +++ b/Data/Map.hs @@ -12,7 +12,6 @@ -- (c) Andriy Palamarchuk 2008 -- License : BSD-style -- Maintainer : libraries@haskell.org --- Stability : provisional -- Portability : portable -- -- /Note:/ You should use "Data.Map.Strict" instead of this module if: diff --git a/Data/Map/Internal.hs b/Data/Map/Internal.hs --- a/Data/Map/Internal.hs +++ b/Data/Map/Internal.hs @@ -30,7 +30,6 @@ -- (c) Andriy Palamarchuk 2008 -- License : BSD-style -- Maintainer : libraries@haskell.org --- Stability : provisional -- Portability : portable -- -- = WARNING @@ -4030,14 +4029,14 @@ go x (Bin _ _ v l r) = x == v || go x l || go x r {-# INLINABLE elem #-} maximum = start - where start Tip = error "Map.Foldable.maximum: called with empty map" + where start Tip = error "Data.Foldable.maximum (for Data.Map): empty map" start (Bin _ _ v l r) = go (go v l) r go !m Tip = m go m (Bin _ _ v l r) = go (go (max m v) l) r {-# INLINABLE maximum #-} minimum = start - where start Tip = error "Map.Foldable.minumum: called with empty map" + where start Tip = error "Data.Foldable.minimum (for Data.Map): empty map" start (Bin _ _ v l r) = go (go v l) r go !m Tip = m diff --git a/Data/Map/Lazy.hs b/Data/Map/Lazy.hs --- a/Data/Map/Lazy.hs +++ b/Data/Map/Lazy.hs @@ -12,7 +12,6 @@ -- (c) Andriy Palamarchuk 2008 -- License : BSD-style -- Maintainer : libraries@haskell.org --- Stability : provisional -- Portability : portable -- -- An efficient implementation of ordered maps from keys to values diff --git a/Data/Map/Lazy/Merge.hs b/Data/Map/Lazy/Merge.hs --- a/Data/Map/Lazy/Merge.hs +++ b/Data/Map/Lazy/Merge.hs @@ -13,7 +13,6 @@ -- Copyright : (c) David Feuer 2016 -- License : BSD-style -- Maintainer : libraries@haskell.org --- Stability : provisional -- Portability : portable -- -- This module defines an API for writing functions that merge two diff --git a/Data/Map/Merge/Lazy.hs b/Data/Map/Merge/Lazy.hs --- a/Data/Map/Merge/Lazy.hs +++ b/Data/Map/Merge/Lazy.hs @@ -24,7 +24,6 @@ -- Copyright : (c) David Feuer 2016 -- License : BSD-style -- Maintainer : libraries@haskell.org --- Stability : provisional -- Portability : portable -- -- This module defines an API for writing functions that merge two diff --git a/Data/Map/Merge/Strict.hs b/Data/Map/Merge/Strict.hs --- a/Data/Map/Merge/Strict.hs +++ b/Data/Map/Merge/Strict.hs @@ -24,7 +24,6 @@ -- Copyright : (c) David Feuer 2016 -- License : BSD-style -- Maintainer : libraries@haskell.org --- Stability : provisional -- Portability : portable -- -- This module defines an API for writing functions that merge two diff --git a/Data/Map/Strict.hs b/Data/Map/Strict.hs --- a/Data/Map/Strict.hs +++ b/Data/Map/Strict.hs @@ -13,7 +13,6 @@ -- (c) Andriy Palamarchuk 2008 -- License : BSD-style -- Maintainer : libraries@haskell.org --- Stability : provisional -- Portability : portable -- -- An efficient implementation of ordered maps from keys to values diff --git a/Data/Map/Strict/Internal.hs b/Data/Map/Strict/Internal.hs --- a/Data/Map/Strict/Internal.hs +++ b/Data/Map/Strict/Internal.hs @@ -13,7 +13,6 @@ -- (c) Andriy Palamarchuk 2008 -- License : BSD-style -- Maintainer : libraries@haskell.org --- Stability : provisional -- Portability : portable -- -- = WARNING diff --git a/Data/Map/Strict/Merge.hs b/Data/Map/Strict/Merge.hs --- a/Data/Map/Strict/Merge.hs +++ b/Data/Map/Strict/Merge.hs @@ -13,7 +13,6 @@ -- Copyright : (c) David Feuer 2016 -- License : BSD-style -- Maintainer : libraries@haskell.org --- Stability : provisional -- Portability : portable -- -- This module defines an API for writing functions that merge two diff --git a/Data/Sequence.hs b/Data/Sequence.hs --- a/Data/Sequence.hs +++ b/Data/Sequence.hs @@ -11,7 +11,6 @@ -- Milan Straka 2014 -- License : BSD-style -- Maintainer : libraries@haskell.org --- Stability : experimental -- Portability : portable -- -- General purpose finite sequences. diff --git a/Data/Sequence/Internal.hs b/Data/Sequence/Internal.hs --- a/Data/Sequence/Internal.hs +++ b/Data/Sequence/Internal.hs @@ -30,7 +30,6 @@ -- Milan Straka 2014 -- License : BSD-style -- Maintainer : libraries@haskell.org --- Stability : experimental -- Portability : portable -- -- @@ -256,6 +255,9 @@ #endif import Utils.Containers.Internal.StrictPair (StrictPair (..), toPair) +#if MIN_VERSION_base(4,4,0) +import Control.Monad.Zip (MonadZip (..)) +#endif default () @@ -4072,14 +4074,113 @@ (second, third) = splt (size b) r #endif -getSingleton :: Seq a -> a -getSingleton (Seq (Single (Elem a))) = a -getSingleton _ = error "getSingleton: Not a singleton." - ------------------------------------------------------------------------ -- Zipping ------------------------------------------------------------------------ +-- MonadZip appeared in base 4.4.0 +#if MIN_VERSION_base(4,4,0) +-- We use a custom definition of munzip to *try* to avoid retaining +-- memory longer than necessary. Using the default definition, if +-- we write +-- +-- let (xs,ys) = munzip zs +-- in xs `deepseq` (... ys ...) +-- +-- then ys will retain the entire zs sequence until ys itself is fully +-- forced. This implementation attempts to use the selector thunk +-- optimization to prevent that. Unfortunately, that optimization is +-- fragile, so we can't actually guarantee anything. If someone finds +-- a leak, we can try to throw explicit bindings and NOINLINE pragmas +-- around and see if that fixes it. +instance MonadZip Seq where + mzipWith = zipWith + munzip = unzipWith id + +class UnzipWith f where + unzipWith :: (x -> (a, b)) -> f x -> (f a, f b) + +instance UnzipWith Elem where +#if __GLASGOW_HASKELL__ >= 708 + unzipWith = coerce +#else + unzipWith f (Elem a) = case f a of (x, y) -> (Elem x, Elem y) +#endif + +-- We're super-lazy here for the sake of efficiency. We want to be able to +-- reach any element of either result in logarithmic time. If we pattern +-- match strictly, we'll end up building entire 2-3 trees at once, which +-- would take linear time. +instance UnzipWith Node where + unzipWith f (Node2 s x y) = + case (f x, f y) of + (~(x1, x2), ~(y1, y2)) -> (Node2 s x1 y1, Node2 s x2 y2) + unzipWith f (Node3 s x y z) = + case (f x, f y, f z) of + (~(x1, x2), ~(y1, y2), ~(z1, z2)) -> (Node3 s x1 y1 z1, Node3 s x2 y2 z2) + +-- We're strict here for the sake of efficiency. The Node instance +-- is lazy, so we don't particularly need to add an extra thunk on top +-- of each node. See the note at the Seq instance for an explanation +-- of why the Digit (Elem a) case is handled specially. +instance UnzipWith Digit where + unzipWith f (One x) = + case f x of + (x1, x2) -> (One x1, One x2) + unzipWith f (Two x y) = + case (f x, f y) of + ((x1, x2), (y1, y2)) -> (Two x1 y1, Two x2 y2) + unzipWith f (Three x y z) = + case (f x, f y, f z) of + ((x1, x2), (y1, y2), (z1, z2)) -> (Three x1 y1 z1, Three x2 y2 z2) + unzipWith f (Four x y z w) = + case (f x, f y, f z, f w) of + ((x1, x2), (y1, y2), (z1, z2), (w1, w2)) -> (Four x1 y1 z1 w1, Four x2 y2 z2 w2) + +instance UnzipWith FingerTree where + unzipWith _ EmptyT = (EmptyT, EmptyT) + unzipWith f (Single x) = case f x of + (x1, x2) -> (Single x1, Single x2) + unzipWith f (Deep s pr m sf) = + case unzipWith f pr of { (pr1, pr2) -> + case unzipWith f sf of { (sf1, sf2) -> + case unzipWith (unzipWith f) m of { ~(m1, m2) -> + (Deep s pr1 m1 sf1, Deep s pr2 m2 sf2)}}} + +-- We need to handle the top level of the sequence specially, to make unzipping behave +-- well in the presence of undefined elements. For example, what do we want from +-- +-- munzip [(1,2), undefined, (5,6)]? +-- +-- The argument could be represented as +-- +-- Seq $ Deep 3 (One (Elem (1,2))) EmptyT (Two undefined (Elem (5,6))) +-- +-- or as +-- +-- Seq $ Deep 3 (Two (Elem (1,2)) undefined) EmptyT (One (Elem (5,6))) +-- +-- We don't want the tree balance to determine whether we get +-- +-- ([1, undefined, undefined], [2, undefined, undefined]) +-- +-- or +-- +-- ([undefined, undefined, 5], [undefined, undefined, 6]) +-- +-- so we pretty much have to be completely lazy in the elements. We could +-- do this by adding extra laziness to the Digit instance or to the Elem instance, +-- but either of those would give unnecessary extra laziness lower in the tree. +instance UnzipWith Seq where + unzipWith _f (Seq EmptyT) = (empty, empty) + unzipWith f (Seq (Single (Elem x))) = case f x of ~(a, b) -> (singleton a, singleton b) + unzipWith f (Seq (Deep s pr m sf)) = + case unzipWith (\(Elem x) -> case f x of ~(a, b) -> (Elem a, Elem b)) pr of { (pr1, pr2) -> + case unzipWith (\(Elem x) -> case f x of ~(a, b) -> (Elem a, Elem b)) sf of { (sf1, sf2) -> + case unzipWith (unzipWith (unzipWith f)) m of { ~(m1, m2) -> + (Seq (Deep s pr1 m1 sf1), Seq (Deep s pr2 m2 sf2))}}} +#endif + -- | /O(min(n1,n2))/. 'zip' takes two sequences and returns a sequence -- of corresponding pairs. If one input is short, excess elements are -- discarded from the right end of the longer sequence. @@ -4099,7 +4200,10 @@ -- | A version of zipWith that assumes the sequences have the same length. zipWith' :: (a -> b -> c) -> Seq a -> Seq b -> Seq c -zipWith' f s1 s2 = splitMap uncheckedSplitAt (\s a -> f a (getSingleton s)) s2 s1 +zipWith' f s1 s2 = splitMap uncheckedSplitAt goLeaf s2 s1 + where + goLeaf (Seq (Single (Elem b))) a = f a b + goLeaf _ _ = error "Data.Sequence.zipWith'.goLeaf internal error: not a singleton" -- | /O(min(n1,n2,n3))/. 'zip3' takes three sequences and returns a -- sequence of triples, analogous to 'zip'. diff --git a/Data/Set.hs b/Data/Set.hs --- a/Data/Set.hs +++ b/Data/Set.hs @@ -11,7 +11,6 @@ -- Copyright : (c) Daan Leijen 2002 -- License : BSD-style -- Maintainer : libraries@haskell.org --- Stability : provisional -- Portability : portable -- -- An efficient implementation of sets. diff --git a/Data/Set/Internal.hs b/Data/Set/Internal.hs --- a/Data/Set/Internal.hs +++ b/Data/Set/Internal.hs @@ -20,7 +20,6 @@ -- Copyright : (c) Daan Leijen 2002 -- License : BSD-style -- Maintainer : libraries@haskell.org --- Stability : provisional -- Portability : portable -- -- = WARNING diff --git a/Data/Tree.hs b/Data/Tree.hs --- a/Data/Tree.hs +++ b/Data/Tree.hs @@ -18,7 +18,6 @@ -- License : BSD-style (see the file libraries/base/LICENSE) -- -- Maintainer : libraries@haskell.org --- Stability : experimental -- Portability : portable -- -- Multi-way trees (/aka/ rose trees) and forests. @@ -61,6 +60,10 @@ import GHC.Generics (Generic) #endif +#if MIN_VERSION_base(4,4,0) +import Control.Monad.Zip (MonadZip (..)) +#endif + #if MIN_VERSION_base(4,8,0) import Data.Coerce #endif @@ -162,6 +165,15 @@ instance NFData a => NFData (Tree a) where rnf (Node x ts) = rnf x `seq` rnf ts + +#if MIN_VERSION_base(4,4,0) +instance MonadZip Tree where + mzipWith f (Node a as) (Node b bs) + = Node (f a b) (mzipWith (mzipWith f) as bs) + + munzip (Node (a, b) ts) = (Node a as, Node b bs) + where (as, bs) = munzip (map munzip ts) +#endif -- | Neat 2-dimensional drawing of a tree. drawTree :: Tree String -> String diff --git a/Utils/Containers/Internal/BitQueue.hs b/Utils/Containers/Internal/BitQueue.hs --- a/Utils/Containers/Internal/BitQueue.hs +++ b/Utils/Containers/Internal/BitQueue.hs @@ -9,7 +9,6 @@ -- Copyright : (c) David Feuer 2016 -- License : BSD-style -- Maintainer : libraries@haskell.org --- Stability : provisional -- Portability : portable -- -- = WARNING diff --git a/Utils/Containers/Internal/BitUtil.hs b/Utils/Containers/Internal/BitUtil.hs --- a/Utils/Containers/Internal/BitUtil.hs +++ b/Utils/Containers/Internal/BitUtil.hs @@ -15,7 +15,6 @@ -- (c) Johan Tibel 2012 -- License : BSD-style -- Maintainer : libraries@haskell.org --- Stability : provisional -- Portability : portable ----------------------------------------------------------------------------- -- diff --git a/changelog.md b/changelog.md --- a/changelog.md +++ b/changelog.md @@ -1,13 +1,19 @@ # Changelog for [`containers` package](http://github.com/haskell/containers) -## 0.5.9.2 +## 0.5.10.1 -* Fix completely broken implementations of `restrictKeys` and `withoutKeys` -in `Data.IntMap`. +* Planned for GHC 8.2. -* Fix minor bug in `Show1` instance for `Data.Tree`. +* Fix completely incorrect implementations of `Data.IntMap.restrictKeys` and + `Data.IntMap.withoutKeys`. Make the tests for these actually run. (Thanks + to Tom Smalley for reporting this.) + +* Fix a minor bug in the `Show1` instance of `Data.Tree`. This produced valid + output, but with fewer parentheses than `Show`. (Thanks, Ryan Scott.) -* Fix broken documentation links. +* Add `MonadZip` instance for `Data.Sequence`. + +* Remove meaningless stability annotations (Thanks, Simon Jakobi.) ## 0.5.9.1 diff --git a/containers.cabal b/containers.cabal --- a/containers.cabal +++ b/containers.cabal @@ -1,5 +1,5 @@ name: containers -version: 0.5.9.2 +version: 0.5.10.1 license: BSD3 license-file: LICENSE maintainer: libraries@haskell.org diff --git a/tests/seq-properties.hs b/tests/seq-properties.hs --- a/tests/seq-properties.hs +++ b/tests/seq-properties.hs @@ -1,6 +1,8 @@ {-# LANGUAGE CPP #-} {-# LANGUAGE PatternGuards #-} +#include "containers.h" + import Data.Sequence.Internal ( Sized (..) , Seq (Seq) @@ -38,6 +40,10 @@ import Test.QuickCheck.Function import Test.Framework import Test.Framework.Providers.QuickCheck2 +#if MIN_VERSION_base(4,4,0) +import Control.Monad.Zip (MonadZip (..)) +#endif +import Control.DeepSeq (deepseq) main :: IO () @@ -121,6 +127,11 @@ , testProperty "zipWith3" prop_zipWith3 , testProperty "zip4" prop_zip4 , testProperty "zipWith4" prop_zipWith4 +#if MIN_VERSION_base(4,4,0) + , testProperty "mzip-naturality" prop_mzipNaturality + , testProperty "mzip-preservation" prop_mzipPreservation + , testProperty "munzip-lazy" prop_munzipLazy +#endif , testProperty "<*>" prop_ap , testProperty "*>" prop_then , testProperty "cycleTaking" prop_cycleTaking @@ -249,6 +260,20 @@ toListPair' :: (Seq a, Seq b) -> Maybe ([a], [b]) toListPair' (xs, ys) = (,) <$> toList' xs <*> toList' ys +-- Extra "polymorphic" test type +newtype D = D{ unD :: Integer } + deriving ( Eq ) + +instance Show D where + showsPrec n (D x) = showsPrec n x + +instance Arbitrary D where + arbitrary = (D . (+1) . abs) `fmap` arbitrary + shrink (D x) = [ D x' | x' <- shrink x, x' > 0 ] + +instance CoArbitrary D where + coarbitrary = coarbitrary . unD + -- instances prop_fmap :: Seq Int -> Bool @@ -685,6 +710,35 @@ prop_zipWith4 xs ys zs ts = toList' (zipWith4 f xs ys zs ts) ~= Data.List.zipWith4 f (toList xs) (toList ys) (toList zs) (toList ts) where f = (,,,) + +#if MIN_VERSION_base(4,4,0) +-- This comes straight from the MonadZip documentation +prop_mzipNaturality :: Fun A C -> Fun B D -> Seq A -> Seq B -> Property +prop_mzipNaturality f g sa sb = + fmap (apply f *** apply g) (mzip sa sb) === + mzip (apply f <$> sa) (apply g <$> sb) + +-- This is a slight optimization of the MonadZip preservation +-- law that works because sequences don't have any decorations. +prop_mzipPreservation :: Fun A B -> Seq A -> Property +prop_mzipPreservation f sa = + let sb = fmap (apply f) sa + in munzip (mzip sa sb) === (sa, sb) + +-- We want to ensure that +-- +-- munzip xs = xs `seq` (fmap fst x, fmap snd x) +-- +-- even in the presence of bottoms (alternatives are all balance- +-- fragile). +prop_munzipLazy :: Seq (Integer, B) -> Bool +prop_munzipLazy pairs = deepseq ((`seq` ()) <$> repaired) True + where + partialpairs = mapWithIndex (\i a -> update i err pairs) pairs + firstPieces = fmap (fst . munzip) partialpairs + repaired = mapWithIndex (\i s -> update i 10000 s) firstPieces + err = error "munzip isn't lazy enough" +#endif -- Applicative operations