Add MonadFix instance for boxed vectors

Data/Vector.hs

@@ -177,11 +177,12 @@ 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 qualified Control.Monad.Fail as Fail
-
+import Control.Monad.Fix ( MonadFix (mfix) )
 import Control.Monad.Zip
+import Data.Function ( fix )
 
 import Prelude hiding ( length, null,
  replicate, (++), concat,
@@ -382,6 +383,29 @@ instance MonadZip Vector where
  {-# INLINE munzip #-}
  munzip = unzip
 
+-- | Instance has same semantics 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).
+ --
+ -- 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
+ -- 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
 
 instance Applicative.Applicative Vector where
  {-# INLINE pure #-}

changelog.md

@@ -1,5 +1,6 @@
 # Changes in NEXT_VERSION
 
+ * Added `MonadFix` instance for boxed vectors
  * New functions: `unfoldrExactN` and `unfoldrExactNM`
  * `mkType` from `Data.Vector.Generic` is deprecated in favor of
  `Data.Data.mkNoRepType`

tests/Tests/Vector/UnitTests.hs

@@ -6,6 +6,8 @@ module Tests.Vector.UnitTests (tests) where
 import Control.Applicative as Applicative
 import Control.Exception
 import Control.Monad.Primitive
+import Control.Monad.Fix (mfix)
+import qualified Data.Vector as Vector
 import Data.Int
 import Data.Word
 import Data.Typeable
@@ -80,6 +82,9 @@ tests =
  , testCase "Unboxed" $ testTakeOutOfMemory Unboxed.take
  ]
  ]
+ , testGroup "Data.Vector"
+ [ testCase "MonadFix" checkMonadFix
+ ]
  ]
 
 testsSliceOutOfBounds ::
@@ -157,3 +162,15 @@ _f :: (Generic.Vector v a, Generic.Vector w a, PrimMonad f)
  => Generic.Mutable v (PrimState f) a -> f (w a)
 _f v = Generic.convert `fmap` Generic.unsafeFreeze v
 #endif
+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)