From 915a5bb4a07175206a56ae3eb0495c3379fa18fa Mon Sep 17 00:00:00 2001 From: David Feuer Date: Wed, 5 Jul 2017 16:42:24 -0400 Subject: [PATCH 1/7] Add MonadFix instance I *believe* this is equivalent to the instance for `[]`. Writing QuickCheck properties for `mfix` seems pretty tricky, so I just added a small unit test. Fixes #178 --- Data/Vector.hs | 23 +++++++++++++++++-- tests/Tests/Vector/UnitTests.hs | 39 ++++++++++++++++++++++++--------- 2 files changed, 50 insertions(+), 12 deletions(-) diff --git a/Data/Vector.hs b/Data/Vector.hs index 5c04b412..4deb4de9 100644 --- a/Data/Vector.hs +++ b/Data/Vector.hs @@ -171,11 +171,12 @@ import qualified Data.Vector.Fusion.Bundle as Bundle import Control.DeepSeq ( NFData, rnf ) import Control.Monad ( MonadPlus(..), liftM, ap ) -import Control.Monad.ST ( ST ) +import Control.Monad.ST ( ST, runST ) import Control.Monad.Primitive - +import Control.Monad.Fix ( MonadFix (mfix) ) import Control.Monad.Zip +import Data.Function ( fix ) import Prelude hiding ( length, null, replicate, (++), concat, @@ -361,6 +362,24 @@ instance MonadZip Vector where {-# INLINE munzip #-} munzip = unzip +instance MonadFix Vector where + -- We take care to dispose of v0 as soon as possible. + -- We also avoid setting up the result vector to refer to + -- itself. These measures should prevent memory leaks. + -- It's perfectly safe to use non-monadic indexing within + -- each element, as the result of indexing will be demanded + -- as soon as the vector is produced. + {-# INLINE mfix #-} + mfix f + | null v0 = empty + | otherwise = runST $ do + h <- headM v0 + return $ cons h $ + generate (lv0 - 1) $ + \i -> fix (\a -> f a ! (i + 1)) + where + v0 = fix (f . head) + !lv0 = length v0 instance Applicative.Applicative Vector where {-# INLINE pure #-} diff --git a/tests/Tests/Vector/UnitTests.hs b/tests/Tests/Vector/UnitTests.hs index 5827640d..34ec3e95 100644 --- a/tests/Tests/Vector/UnitTests.hs +++ b/tests/Tests/Vector/UnitTests.hs @@ -3,6 +3,8 @@ module Tests.Vector.UnitTests (tests) where import Control.Applicative as Applicative +import Control.Monad.Fix (mfix) +import qualified Data.Vector as Vector import qualified Data.Vector.Storable as Storable import Foreign.Ptr import Foreign.Storable @@ -20,6 +22,19 @@ instance (Storable a) => Storable (Aligned a) where peek ptr = Aligned Applicative.<$> peek (castPtr ptr) poke ptr = poke (castPtr ptr) . getAligned +tests :: [Test] +tests = + [ testGroup "Data.Vector.Storable.Vector" + [ testCase "Aligned Double" $ + checkAddressAlignment alignedDoubleVec + , testCase "Aligned Int" $ + checkAddressAlignment alignedIntVec + ] + , testGroup "Data.Vector" + [ testCase "MonadFix" checkMonadFix + ] + ] + checkAddressAlignment :: forall a. (Storable a) => Storable.Vector a -> Assertion checkAddressAlignment xs = Storable.unsafeWith xs $ \ptr -> do let ptr' = ptrToWordPtr ptr @@ -31,18 +46,22 @@ checkAddressAlignment xs = Storable.unsafeWith xs $ \ptr -> do dummy :: a dummy = undefined -tests :: [Test] -tests = - [ testGroup "Data.Vector.Storable.Vector Alignment" - [ testCase "Aligned Double" $ - checkAddressAlignment alignedDoubleVec - , testCase "Aligned Int" $ - checkAddressAlignment alignedIntVec - ] - ] - alignedDoubleVec :: Storable.Vector (Aligned Double) alignedDoubleVec = Storable.fromList $ map Aligned [1, 2, 3, 4, 5] alignedIntVec :: Storable.Vector (Aligned Int) alignedIntVec = Storable.fromList $ map Aligned [1, 2, 3, 4, 5] + +checkMonadFix :: Assertion +checkMonadFix = assertBool "checkMonadFix" $ + Vector.toList fewV == fewL && + Vector.toList none == [] + where + facty _ 0 = 1; facty f n = n * f (n - 1) + fewV :: Vector.Vector Int + fewV = fmap ($ 12) $ mfix (\i -> Vector.fromList [facty i, facty (+1), facty (+2)]) + fewL :: [Int] + fewL = fmap ($ 12) $ mfix (\i -> [facty i, facty (+1), facty (+2)]) + + none :: Vector.Vector Int + none = mfix (const Vector.empty) From 746d7140aa78d2b251312fb70dedba93c87524ed Mon Sep 17 00:00:00 2001 From: Alexey Khudyakov Date: Tue, 9 Jun 2020 21:30:34 +0300 Subject: [PATCH 2/7] Attempt to make documentation somewhat clearer --- Data/Vector.hs | 9 +++++---- 1 file changed, 5 insertions(+), 4 deletions(-) diff --git a/Data/Vector.hs b/Data/Vector.hs index 2415a31c..6a6fbcfa 100644 --- a/Data/Vector.hs +++ b/Data/Vector.hs @@ -383,12 +383,13 @@ instance MonadZip Vector where munzip = unzip instance MonadFix Vector where - -- We take care to dispose of v0 as soon as possible. + -- We take care to dispose of v0 as soon as possible (see headM docs). -- We also avoid setting up the result vector to refer to -- itself. These measures should prevent memory leaks. - -- It's perfectly safe to use non-monadic indexing within - -- each element, as the result of indexing will be demanded - -- as soon as the vector is produced. + -- + -- It's perfectly safe to use non-monadic indexing within generate + -- call since intermediate vector won't be created until result's + -- value is demanded. {-# INLINE mfix #-} mfix f | null v0 = empty From 4f01752d9add7c8dd21d52d5de23799185dd092e Mon Sep 17 00:00:00 2001 From: Alexey Khudyakov Date: Tue, 9 Jun 2020 21:32:17 +0300 Subject: [PATCH 3/7] Add changelog entry --- changelog.md | 1 + 1 file changed, 1 insertion(+) diff --git a/changelog.md b/changelog.md index 0342fc6f..e2ccae30 100644 --- a/changelog.md +++ b/changelog.md @@ -1,5 +1,6 @@ # Changes in NEXT_VERSION + * `MonadFix` instance for boxed vectors added * `mkType` from `Data.Vector.Generic` is deprecated in favor of `Data.Data.mkNoRepType` * `maximumBy` now behaves like its counterpart in `Data.List` in that if From c7bb6d258878771592084066dde3a82ad66ad76b Mon Sep 17 00:00:00 2001 From: Alexey Khudyakov Date: Tue, 9 Jun 2020 21:32:43 +0300 Subject: [PATCH 4/7] Add since aanotation --- Data/Vector.hs | 1 + 1 file changed, 1 insertion(+) diff --git a/Data/Vector.hs b/Data/Vector.hs index 6a6fbcfa..b2a963ec 100644 --- a/Data/Vector.hs +++ b/Data/Vector.hs @@ -382,6 +382,7 @@ instance MonadZip Vector where {-# INLINE munzip #-} munzip = unzip +-- | @since 0.13.0.0 instance MonadFix Vector where -- We take care to dispose of v0 as soon as possible (see headM docs). -- We also avoid setting up the result vector to refer to From 9a27eb6eae6337b7378326cbb2d33d344d750802 Mon Sep 17 00:00:00 2001 From: Alexey Khudyakov Date: Tue, 9 Jun 2020 23:39:12 +0300 Subject: [PATCH 5/7] Update comments --- Data/Vector.hs | 7 ++++++- 1 file changed, 6 insertions(+), 1 deletion(-) diff --git a/Data/Vector.hs b/Data/Vector.hs index 53691e8d..fdbf8fd9 100644 --- a/Data/Vector.hs +++ b/Data/Vector.hs @@ -383,7 +383,9 @@ instance MonadZip Vector where {-# INLINE munzip #-} munzip = unzip --- | @since 0.13.0.0 +-- | Instance has same semantic as one for lists +-- +-- @since 0.13.0.0 instance MonadFix Vector where -- We take care to dispose of v0 as soon as possible (see headM docs). -- We also avoid setting up the result vector to refer to @@ -395,12 +397,15 @@ instance MonadFix Vector where {-# INLINE mfix #-} mfix f | null v0 = empty + -- We take first element of resulting vector from v0 and create + -- rest using generate. Note that cons should fuse with generate | otherwise = runST $ do h <- headM v0 return $ cons h $ generate (lv0 - 1) $ \i -> fix (\a -> f a ! (i + 1)) where + -- Used to calculate size of resulting vector v0 = fix (f . head) !lv0 = length v0 From da92174c4e5fbe9c49bc4b3fa327a371435705fb Mon Sep 17 00:00:00 2001 From: Alexey Khudyakov Date: Wed, 10 Jun 2020 21:37:59 +0300 Subject: [PATCH 6/7] Documentation tweaks --- Data/Vector.hs | 2 +- changelog.md | 2 +- 2 files changed, 2 insertions(+), 2 deletions(-) diff --git a/Data/Vector.hs b/Data/Vector.hs index fdbf8fd9..e3a746f0 100644 --- a/Data/Vector.hs +++ b/Data/Vector.hs @@ -383,7 +383,7 @@ instance MonadZip Vector where {-# INLINE munzip #-} munzip = unzip --- | Instance has same semantic as one for lists +-- | Instance has same semantics as one for lists -- -- @since 0.13.0.0 instance MonadFix Vector where diff --git a/changelog.md b/changelog.md index f3d2cb7f..80cb4222 100644 --- a/changelog.md +++ b/changelog.md @@ -1,6 +1,6 @@ # Changes in NEXT_VERSION - * `MonadFix` instance for boxed vectors added + * Added `MonadFix` instance for boxed vectors * New functions: `unfoldrExactN` and `unfoldrExactNM` * `mkType` from `Data.Vector.Generic` is deprecated in favor of `Data.Data.mkNoRepType` From 6dd926c8f2a0a8369259d533f7c8af64cc2015ee Mon Sep 17 00:00:00 2001 From: Alexey Khudyakov Date: Wed, 10 Jun 2020 22:29:45 +0300 Subject: [PATCH 7/7] Incorporate @treeowl's comment --- Data/Vector.hs | 2 -- 1 file changed, 2 deletions(-) diff --git a/Data/Vector.hs b/Data/Vector.hs index e3a746f0..097ed489 100644 --- a/Data/Vector.hs +++ b/Data/Vector.hs @@ -388,8 +388,6 @@ instance MonadZip Vector where -- @since 0.13.0.0 instance MonadFix Vector where -- We take care to dispose of v0 as soon as possible (see headM docs). - -- We also avoid setting up the result vector to refer to - -- itself. These measures should prevent memory leaks. -- -- It's perfectly safe to use non-monadic indexing within generate -- call since intermediate vector won't be created until result's