99846a8 · streamly · git.iko.soy

git.iko.soy/streamly

on master help sign in

Remove the primitive dependency from streamly-core

99846a8Adithya Kumar4 years ago

benchmark/Streamly/Benchmark/Data/Array.hs+3−3

compare with master

unifiedsplit

@@ -27,7 +27,6 @@ benchIOSrc name src = benchIO name src id

27sourceIntFromToFromList :: MonadIO m => Int -> Int -> m (Stream Int)

28sourceIntFromToFromList value n = P.return $ A.fromListN value [n..n + value]

30−

31{-# INLINE readInstance #-}

30{-# INLINE readInstance #-}

32readInstance :: P.String -> Stream Int

31readInstance :: P.String -> Stream Int

33readInstance str =

32readInstance str =

@@ -50,7 +49,8 @@ foldableSum = P.sum

51{-# INLINE sourceIntFromToFromStream #-}

50{-# INLINE sourceIntFromToFromStream #-}

52sourceIntFromToFromStream :: MonadIO m => Int -> Int -> m (Stream Int)

51sourceIntFromToFromStream :: MonadIO m => Int -> Int -> m (Stream Int)

52+sourceIntFromToFromStream value n =

53−sourceIntFromToFromStream value n = S.fold A.write $ S.enumerateFromTo n (n + value)

53+ S.fold A.write $ S.enumerateFromTo n (n + value)

55-------------------------------------------------------------------------------

56-- Bench groups

@@ -61,7 +61,7 @@ o_1_space_generation value =

61 [ bgroup

62 "generation"

63 [ benchIOSrc "write . intFromTo" (sourceIntFromToFromStream value)

64− , let testStr = mkListString value

64+ , let testStr = "fromList " ++ mkListString value

65 in testStr `deepseq` bench "read" (nf readInstance testStr)

66 ]

67 ]

core/src/Streamly/Internal/Data/Array.hs+139−97

@@ -1,6 +1,5 @@

1{-# OPTIONS_GHC -fno-warn-orphans #-}

3−{-# LANGUAGE UnboxedTuples #-}

4#include "inline.hs"

3#include "inline.hs"

6-- |

5-- |

@@ -33,6 +32,7 @@ module Streamly.Internal.Data.Array

33 , length

32 , length

34 , read

33 , read

35+ , toList

36 , toStreamD

37 , toStreamDRev

38 , toStream

@@ -50,40 +50,56 @@ module Streamly.Internal.Data.Array

50 )

51where

53−#if !MIN_VERSION_primitive(0,7,1)

54import Control.DeepSeq (NFData(..))

53import Control.DeepSeq (NFData(..))

55−#endif

56−import Control.Monad (when)

54+import Control.Monad (when, replicateM)

57import Control.Monad.IO.Class (liftIO, MonadIO)

55import Control.Monad.IO.Class (liftIO, MonadIO)

58−import Control.Monad.Primitive (PrimMonad)

56+import GHC.Base (MutableArray#, RealWorld)

59−import Data.Functor.Identity (runIdentity)

60−import Data.IORef

61−import GHC.Base (Int(..))

62import GHC.IO (unsafePerformIO)

57import GHC.IO (unsafePerformIO)

58+import Text.Read (readPrec)

64import Streamly.Internal.Data.Fold.Type (Fold(..))

60import Streamly.Internal.Data.Fold.Type (Fold(..))

65import Streamly.Internal.Data.Stream.Type (Stream)

61import Streamly.Internal.Data.Stream.Type (Stream)

66import Streamly.Internal.Data.Tuple.Strict (Tuple'(..), Tuple3'(..))

62import Streamly.Internal.Data.Tuple.Strict (Tuple'(..), Tuple3'(..))

67import Streamly.Internal.Data.Unfold.Type (Unfold(..))

63import Streamly.Internal.Data.Unfold.Type (Unfold(..))

69−import qualified GHC.Exts as Exts

65+import qualified Streamly.Internal.Data.Array.Mut.Type as MArray

70import qualified Streamly.Internal.Data.Fold.Type as FL

66import qualified Streamly.Internal.Data.Fold.Type as FL

71import qualified Streamly.Internal.Data.Ring as RB

67import qualified Streamly.Internal.Data.Ring as RB

72import qualified Streamly.Internal.Data.Stream.StreamD as D

68import qualified Streamly.Internal.Data.Stream.StreamD as D

73import qualified Streamly.Internal.Data.Stream.Type as Stream

69import qualified Streamly.Internal.Data.Stream.Type as Stream

70+import qualified Streamly.Internal.Data.Unfold as Unfold

71+import qualified Text.ParserCombinators.ReadPrec as ReadPrec

75−import Data.Primitive.Array hiding (fromList, fromListN)

73+import Data.IORef

76import Prelude hiding (foldr, length, read)

74import Prelude hiding (foldr, length, read)

78−{-# NOINLINE bottomElement #-}

76+-------------------------------------------------------------------------------

79−bottomElement :: a

77+-- Array Data Type

80−bottomElement = undefined

78+-------------------------------------------------------------------------------

79+

80+data Array a =

81+ Array

82+ { arrContents# :: MutableArray# RealWorld a

83+ -- ^ The internal contents of the array representing the entire array.

84+

85+ , arrStart :: {-# UNPACK #-}!Int

86+ -- ^ The starting index of this slice.

87+

88+ , arrLen :: {-# UNPACK #-}!Int

89+ -- ^ The length of this slice.

90+ }

91+

92+unsafeFreeze :: MArray.Array a -> Array a

93+unsafeFreeze (MArray.Array cont# arrS arrL _) = Array cont# arrS arrL

94+

95+unsafeThaw :: Array a -> MArray.Array a

96+unsafeThaw (Array cont# arrS arrL) = MArray.Array cont# arrS arrL arrL

82{-# NOINLINE nil #-}

98{-# NOINLINE nil #-}

83nil :: Array a

99nil :: Array a

84nil = unsafePerformIO $ do

100nil = unsafePerformIO $ do

85− marr <- liftIO $ newArray 0 bottomElement

101+ marr <- MArray.newArray 0

86− liftIO $ freezeArray marr 0 0

102+ return $ unsafeFreeze marr

103

88-------------------------------------------------------------------------------

104-------------------------------------------------------------------------------

89-- Construction - Folds

105-- Construction - Folds

@@ -91,46 +107,26 @@ nil = unsafePerformIO $ do

107

92{-# INLINE_NORMAL writeN #-}

108{-# INLINE_NORMAL writeN #-}

93writeN :: MonadIO m => Int -> Fold m a (Array a)

109writeN :: MonadIO m => Int -> Fold m a (Array a)

94−writeN len = Fold step initial extract

110+writeN = fmap unsafeFreeze <$> MArray.writeN

95−

96− where

97−

98− {-# INLINE next #-}

99− next marr i = do

100− let i1 = i + 1

101− st = Tuple' marr i1

102− if len > i1

103− then return $ FL.Partial st

104− else fmap FL.Done $ extract st

105−

106− initial = do

107− marr <- liftIO $ newArray len bottomElement

108− next marr (-1)

109−

110− step (Tuple' marr i) x = do

111− liftIO $ writeArray marr i x

112− next marr i

113−

114− extract (Tuple' marr l) = liftIO $ freezeArray marr 0 l

115

111

116{-# INLINE_NORMAL write #-}

112{-# INLINE_NORMAL write #-}

117write :: MonadIO m => Fold m a (Array a)

113write :: MonadIO m => Fold m a (Array a)

118write = Fold step initial extract

114write = Fold step initial extract

119 where

115 where

120 initial = do

116 initial = do

121− marr <- liftIO $ newArray 0 bottomElement

117+ marr <- liftIO $ MArray.newArray 0

122 return $ FL.Partial (Tuple3' marr 0 0)

118 return $ FL.Partial (Tuple3' marr 0 0)

123 step (Tuple3' marr i capacity) x

119 step (Tuple3' marr i capacity) x

124 | i == capacity =

120 | i == capacity =

125 let newCapacity = max (capacity * 2) 1

121 let newCapacity = max (capacity * 2) 1

126− in do newMarr <- liftIO $ newArray newCapacity bottomElement

122+ in do newMarr <- liftIO $ MArray.realloc newCapacity marr

127− liftIO $ copyMutableArray newMarr 0 marr 0 i

128− liftIO $ writeArray newMarr i x

123+ marr1 <- liftIO $ MArray.snocUnsafe newMarr x

129− return $ FL.Partial $ Tuple3' newMarr (i + 1) newCapacity

124+ return $ FL.Partial $ Tuple3' marr1 (i + 1) newCapacity

130 | otherwise = do

125 | otherwise = do

131− liftIO $ writeArray marr i x

126+ marr1 <- liftIO $ MArray.snocUnsafe marr x

132− return $ FL.Partial $ Tuple3' marr (i + 1) capacity

127+ return $ FL.Partial $ Tuple3' marr1 (i + 1) capacity

133− extract (Tuple3' marr len _) = liftIO $ freezeArray marr 0 len

128+ extract (Tuple3' marr _ _) =

129+ return $ unsafeFreeze marr

134

130

135-------------------------------------------------------------------------------

131-------------------------------------------------------------------------------

136-- Construction - from streams

132-- Construction - from streams

@@ -139,13 +135,13 @@ write = Fold step initial extract

139{-# INLINE_NORMAL fromStreamDN #-}

135{-# INLINE_NORMAL fromStreamDN #-}

140fromStreamDN :: MonadIO m => Int -> D.Stream m a -> m (Array a)

136fromStreamDN :: MonadIO m => Int -> D.Stream m a -> m (Array a)

141fromStreamDN limit str = do

137fromStreamDN limit str = do

142− marr <- liftIO $ newArray (max limit 0) bottomElement

138+ marr <- liftIO $ MArray.newArray (max limit 0)

143 i <-

139 i <-

144 D.foldlM'

140 D.foldlM'

145− (\i x -> i `seq` liftIO $ writeArray marr i x >> return (i + 1))

141+ (\i x -> i `seq` liftIO $ MArray.putIndexUnsafe marr i x >> return (i + 1))

146 (return 0) $

142 (return 0) $

147 D.take limit str

143 D.take limit str

148− liftIO $ freezeArray marr 0 i

144+ return $ unsafeFreeze $ marr { MArray.arrLen = i }

149

145

150{-# INLINE fromStreamD #-}

146{-# INLINE fromStreamD #-}

151fromStreamD :: MonadIO m => D.Stream m a -> m (Array a)

147fromStreamD :: MonadIO m => D.Stream m a -> m (Array a)

@@ -175,50 +171,38 @@ fromList xs = unsafePerformIO $ fromStreamD $ D.fromList xs

175

171

176{-# INLINE length #-}

172{-# INLINE length #-}

177length :: Array a -> Int

173length :: Array a -> Int

178−length = sizeofArray

174+length = arrLen

179

175

180{-# INLINE_NORMAL read #-}

176{-# INLINE_NORMAL read #-}

181−read :: Monad m => Unfold m (Array a) a

177+read :: MonadIO m => Unfold m (Array a) a

182−read = Unfold step inject

178+read = Unfold.lmap unsafeThaw MArray.read

183− where

184− inject arr = return (arr, 0)

185− step (arr, i)

186− | i == length arr = return D.Stop

187− step (arr, I# i) =

188− return $

189− case Exts.indexArray# (array# arr) i of

190− (# x #) -> D.Yield x (arr, I# i + 1)

191

179

192-------------------------------------------------------------------------------

180-------------------------------------------------------------------------------

193-- Elimination - to streams

181-- Elimination - to streams

194-------------------------------------------------------------------------------

182-------------------------------------------------------------------------------

195

183

184+{-# INLINE_NORMAL toList #-}

185+toList :: Array a -> [a]

186+toList arr = loop 0

187+

188+ where

189+

190+ len = length arr

191+ loop i | i == len = []

192+ loop i = getIndexUnsafe arr i : loop (i + 1)

193+

196{-# INLINE_NORMAL toStreamD #-}

194{-# INLINE_NORMAL toStreamD #-}

197−toStreamD :: Monad m => Array a -> D.Stream m a

195+toStreamD :: MonadIO m => Array a -> D.Stream m a

198−toStreamD arr = D.Stream step 0

196+toStreamD = MArray.toStreamD . unsafeThaw

199− where

200− {-# INLINE_LATE step #-}

201− step _ i

202− | i == length arr = return D.Stop

203− step _ (I# i) =

204− return $

205− case Exts.indexArray# (array# arr) i of

206− (# x #) -> D.Yield x (I# i + 1)

207

197

208{-# INLINE_NORMAL toStreamDRev #-}

198{-# INLINE_NORMAL toStreamDRev #-}

209toStreamDRev :: Monad m => Array a -> D.Stream m a

199toStreamDRev :: Monad m => Array a -> D.Stream m a

210−toStreamDRev arr = D.Stream step (length arr - 1)

200+toStreamDRev arr@Array{..} =

211− where

201+ D.map (getIndexUnsafe arr)

212− {-# INLINE_LATE step #-}

202+ $ D.enumerateFromThenToIntegral (arrLen - 1) (arrLen - 2) 0

213− step _ i

214− | i < 0 = return D.Stop

215− step _ (I# i) =

216− return $

217− case Exts.indexArray# (array# arr) i of

218− (# x #) -> D.Yield x (I# i - 1)

219

203

220{-# INLINE_EARLY toStream #-}

204{-# INLINE_EARLY toStream #-}

221−toStream :: Monad m => Array a -> Stream m a

205+toStream :: MonadIO m => Array a -> Stream m a

222toStream = Stream.fromStreamD . toStreamD

206toStream = Stream.fromStreamD . toStreamD

223

207

224{-# INLINE_EARLY toStreamRev #-}

208{-# INLINE_EARLY toStreamRev #-}

@@ -231,24 +215,22 @@ toStreamRev = Stream.fromStreamD . toStreamDRev

231

215

232{-# INLINE_NORMAL foldl' #-}

216{-# INLINE_NORMAL foldl' #-}

233foldl' :: (b -> a -> b) -> b -> Array a -> b

217foldl' :: (b -> a -> b) -> b -> Array a -> b

234−foldl' f z arr = runIdentity $ D.foldl' f z $ toStreamD arr

218+foldl' f z arr = unsafePerformIO $ D.foldl' f z $ toStreamD arr

235

219

236{-# INLINE_NORMAL foldr #-}

220{-# INLINE_NORMAL foldr #-}

237foldr :: (a -> b -> b) -> b -> Array a -> b

221foldr :: (a -> b -> b) -> b -> Array a -> b

238−foldr f z arr = runIdentity $ D.foldr f z $ toStreamD arr

222+foldr f z arr = unsafePerformIO $ D.foldr f z $ toStreamD arr

239

223

240−#if !MIN_VERSION_primitive(0,7,1)

241instance NFData a => NFData (Array a) where

224instance NFData a => NFData (Array a) where

242 {-# INLINE rnf #-}

225 {-# INLINE rnf #-}

243 rnf = foldl' (\_ x -> rnf x) ()

226 rnf = foldl' (\_ x -> rnf x) ()

244−#endif

245

227

246{-# INLINE fold #-}

228{-# INLINE fold #-}

247−fold :: Monad m => Fold m a b -> Array a -> m b

229+fold :: MonadIO m => Fold m a b -> Array a -> m b

248fold f arr = D.fold f (toStreamD arr)

230fold f arr = D.fold f (toStreamD arr)

249

231

250{-# INLINE streamFold #-}

232{-# INLINE streamFold #-}

251−streamFold :: Monad m => (Stream m a -> m b) -> Array a -> m b

233+streamFold :: MonadIO m => (Stream m a -> m b) -> Array a -> m b

252streamFold f arr = f (toStream arr)

234streamFold f arr = f (toStream arr)

253

235

254-------------------------------------------------------------------------------

236-------------------------------------------------------------------------------

@@ -261,12 +243,13 @@ streamFold f arr = f (toStream arr)

261-- @since 0.8.0

243-- @since 0.8.0

262{-# INLINE getIndexUnsafe #-}

244{-# INLINE getIndexUnsafe #-}

263getIndexUnsafe :: Array a -> Int -> a

245getIndexUnsafe :: Array a -> Int -> a

264−getIndexUnsafe = indexArray

246+getIndexUnsafe arr i =

247+ unsafePerformIO $ MArray.getIndexUnsafe (unsafeThaw arr) i

265

248

266{-# INLINE writeLastN #-}

249{-# INLINE writeLastN #-}

267writeLastN :: MonadIO m => Int -> Fold m a (Array a)

250writeLastN :: MonadIO m => Int -> Fold m a (Array a)

268writeLastN n

251writeLastN n

269− | n <= 0 = fmap (const mempty) FL.drain

252+ | n <= 0 = fmap (const nil) FL.drain

270 | otherwise = Fold step initial done

253 | otherwise = Fold step initial done

271

254

272 where

255 where

@@ -280,15 +263,18 @@ writeLastN n

280 return $ FL.Partial $ Tuple' rb (rh + 1)

263 return $ FL.Partial $ Tuple' rb (rh + 1)

281

264

282 done (Tuple' rb rh) = do

265 done (Tuple' rb rh) = do

283− arr' <- liftIO $ newArray (min rh n) (undefined :: a)

266+ arr' <- liftIO $ MArray.newArray (min rh n)

284 ref <- liftIO $ readIORef $ RB.ringHead rb

267 ref <- liftIO $ readIORef $ RB.ringHead rb

285 if rh < n

268 if rh < n

286 then

269 then

287− liftIO $ copyMutableArray arr' 0 (RB.arr rb) 0 ref

270+ MArray.putSliceUnsafe (RB.arr rb) 0 arr' 0 ref

288 else do

271 else do

289− liftIO $ copyMutableArray arr' 0 (RB.arr rb) ref (n - ref)

272+ MArray.putSliceUnsafe (RB.arr rb) ref arr' 0 (n - ref)

290− liftIO $ copyMutableArray arr' (n - ref) (RB.arr rb) 0 ref

273+ MArray.putSliceUnsafe (RB.arr rb) 0 arr' (n - ref) ref

291− liftIO $ unsafeFreezeArray arr'

274+ return $ unsafeFreeze arr'

275+

276+sliceUnsafe :: Int -> Int -> Array a -> Array a

277+sliceUnsafe offset len (Array cont off1 _) = Array cont (off1 + offset) len

292

278

293-- XXX This is not efficient as it copies the array. We should support array

279-- XXX This is not efficient as it copies the array. We should support array

294-- slicing so that we can just refer to the underlying array memory instead of

280-- slicing so that we can just refer to the underlying array memory instead of

@@ -306,30 +292,86 @@ strip p arr =

306 let indexL = getIndexL 0 -- first predicate failing index

292 let indexL = getIndexL 0 -- first predicate failing index

307 in if indexL == 0 && indexR == lastIndex

293 in if indexL == 0 && indexR == lastIndex

308 then arr

294 then arr

295+ else unsafeFreeze $ unsafePerformIO $ do

309− else cloneArray arr indexL (indexR - indexL + 1)

296+ let newLen = indexR - indexL + 1

297+ arrThawed = unsafeThaw (sliceUnsafe indexL newLen arr)

298+ MArray.clone arrThawed

310

299

311 where

300 where

312

301

313 getIndexR idx

302 getIndexR idx

314 | idx < 0 = idx

303 | idx < 0 = idx

315 | otherwise =

304 | otherwise =

316− if p (indexArray arr idx) then getIndexR (idx - 1) else idx

305+ if p (getIndexUnsafe arr idx) then getIndexR (idx - 1) else idx

317

306

307+ getIndexL idx = if p (getIndexUnsafe arr idx)

318− getIndexL idx = if p (indexArray arr idx) then getIndexL (idx + 1) else idx

308+ then getIndexL (idx + 1)

309+ else idx

319

310

320-- | Write an input stream of (index, value) pairs to an array. Throws an

311-- | Write an input stream of (index, value) pairs to an array. Throws an

321-- error if any index is out of bounds.

312-- error if any index is out of bounds.

322--

313--

323-- /Pre-release/

314-- /Pre-release/

324{-# INLINE putIndices #-}

315{-# INLINE putIndices #-}

325−putIndices :: PrimMonad m

316+putIndices :: MonadIO m

326 => Array a -> Fold m (Int, a) ()

317 => Array a -> Fold m (Int, a) ()

327putIndices arr = FL.rmapM (\ _ -> return ()) (FL.foldlM' step initial)

318putIndices arr = FL.rmapM (\ _ -> return ()) (FL.foldlM' step initial)

328

319

329 where

320 where

330

321

331− initial = unsafeThawArray arr

322+ initial = return $ unsafeThaw arr

332

323

333 step marr (i, x) = do

324 step marr (i, x) = do

334− writeArray marr i x

325+ MArray.putIndexUnsafe marr i x

335 return marr

326 return marr

327+

328+-------------------------------------------------------------------------------

329+-- Instances

330+-------------------------------------------------------------------------------

331+

332+instance Eq a => Eq (Array a) where

333+ a1 == a2 = lenA1 == lenA2 && loop (lenA1 - 1)

334+

335+ where

336+

337+ lenA1 = length a1

338+ lenA2 = length a2

339+

340+ loop i

341+ | i < 0 = True

342+ | otherwise =

343+ let v1 = getIndexUnsafe a1 i

344+ v2 = getIndexUnsafe a2 i

345+ in v1 == v2 && loop (i - 1)

346+

347+instance Ord a => Ord (Array a) where

348+ compare a1 a2 =

349+ case compare lenA1 lenA2 of

350+ LT -> LT

351+ GT -> GT

352+ EQ -> loop 0

353+

354+ where

355+

356+ lenA1 = length a1

357+ lenA2 = length a2

358+

359+ loop i

360+ | i >= lenA1 = EQ

361+ | otherwise =

362+ let v1 = getIndexUnsafe a1 i

363+ v2 = getIndexUnsafe a2 i

364+ in case compare v1 v2 of

365+ LT -> LT

366+ GT -> GT

367+ EQ -> loop (i + 1)

368+

369+instance Show a => Show (Array a) where

370+ show arr = "fromList " ++ show (toList arr)

371+

372+instance Read a => Read (Array a) where

373+ readPrec = do

374+ fromListWord <- replicateM 9 ReadPrec.get

375+ if fromListWord == "fromList "

376+ then fromList <$> readPrec

377+ else ReadPrec.pfail

core/src/Streamly/Internal/Data/Array/Mut/Type.hs+35−2

@@ -59,6 +59,9 @@ module Streamly.Internal.Data.Array.Mut.Type

59 -- and therefore have a cons as well as snoc. But that will require two

60 -- bounds in the array representation.

62+ -- ** Reallocation

63+ , realloc

64+

62 -- ** Appending elements

65 -- ** Appending elements

63 , snocWith

66 , snocWith

64 , snoc

67 , snoc

@@ -146,15 +149,17 @@ module Streamly.Internal.Data.Array.Mut.Type

146 -- , spliceWith

149 -- , spliceWith

147 -- , splice

150 -- , splice

148 -- , spliceExp

151 -- , spliceExp

149− -- , putSlice

152+ , putSliceUnsafe

150 -- , appendSlice

153 -- , appendSlice

151 -- , appendSliceFrom

154 -- , appendSliceFrom

155+

156+ , clone

152 )

157 )

153where

158where

154

159

155#include "inline.hs"

160#include "inline.hs"

161+#include "assert.hs"

156

162

157−import Control.Exception (assert)

158import Control.Monad.IO.Class (MonadIO(..))

163import Control.Monad.IO.Class (MonadIO(..))

159import GHC.Base

164import GHC.Base

160 ( MutableArray#

165 ( MutableArray#

@@ -568,3 +573,31 @@ producer = Producer step inject extract

568{-# INLINE_NORMAL read #-}

573{-# INLINE_NORMAL read #-}

569read :: MonadIO m => Unfold m (Array a) a

574read :: MonadIO m => Unfold m (Array a) a

570read = Producer.simplify producer

575read = Producer.simplify producer

576+

577+--------------------------------------------------------------------------------

578+-- Appending arrays

579+--------------------------------------------------------------------------------

580+

581+-- | Put a sub range of a source array into a subrange of a destination array.

582+-- This is not safe as it does not check the bounds.

583+{-# INLINE putSliceUnsafe #-}

584+putSliceUnsafe :: MonadIO m => Array a -> Int -> Array a -> Int -> Int -> m ()

585+putSliceUnsafe src srcStart dst dstStart len = liftIO $ do

586+ assertM(len <= arrLen dst)

587+ assertM(len <= arrLen src)

588+ let !(I# srcStart#) = srcStart + arrStart src

589+ !(I# dstStart#) = dstStart + arrStart dst

590+ !(I# len#) = len

591+ let arrS# = arrContents# src

592+ arrD# = arrContents# dst

593+ IO $ \s# -> (# copyMutableArray#

594+ arrS# srcStart# arrD# dstStart# len# s#

595+ , () #)

596+

597+{-# INLINE clone #-}

598+clone :: MonadIO m => Array a -> m (Array a)

599+clone src = liftIO $ do

600+ let len = arrLen src

601+ dst <- newArray len

602+ putSliceUnsafe src 0 dst 0 len

603+ return dst

core/src/Streamly/Internal/Data/Ring.hs+8−5

@@ -13,12 +13,15 @@ module Streamly.Internal.Data.Ring

13 , unsafeInsertRing

14 ) where

16−import Control.Monad.Primitive (PrimMonad(PrimState))

17import Data.IORef (modifyIORef', newIORef, readIORef, writeIORef, IORef)

16import Data.IORef (modifyIORef', newIORef, readIORef, writeIORef, IORef)

18−import Data.Primitive.Array (newArray, writeArray, MutableArray)

17+import Streamly.Internal.Data.Array.Mut.Type

18+ ( Array(..)

19+ , newArray

20+ , putIndexUnsafe

21+ )

20data Ring a = Ring

23data Ring a = Ring

21− { arr :: MutableArray (PrimState IO) a

24+ { arr :: Array a

22 , ringHead :: IORef Int -- current index to be over-written

25 , ringHead :: IORef Int -- current index to be over-written

23 , ringMax :: !Int -- first index beyond allocated memory

26 , ringMax :: !Int -- first index beyond allocated memory

24 }

27 }

@@ -26,7 +29,7 @@ data Ring a = Ring

26{-# INLINE createRing #-}

29{-# INLINE createRing #-}

27createRing :: Int -> IO (Ring a)

30createRing :: Int -> IO (Ring a)

28createRing count = do

31createRing count = do

29− arr' <- newArray count (undefined :: a)

32+ arr' <- newArray count

30 head' <- newIORef 0

33 head' <- newIORef 0

31 return (Ring

34 return (Ring

32 { arr = arr'

35 { arr = arr'

@@ -37,7 +40,7 @@ createRing count = do

37{-# INLINE unsafeInsertRing #-}

40{-# INLINE unsafeInsertRing #-}

38unsafeInsertRing :: Ring a -> Int -> a -> IO ()

41unsafeInsertRing :: Ring a -> Int -> a -> IO ()

39unsafeInsertRing Ring{..} idx x = do

42unsafeInsertRing Ring{..} idx x = do

40− writeArray arr (mod idx ringMax) x

43+ putIndexUnsafe arr (mod idx ringMax) x

41 ref <- readIORef ringHead

44 ref <- readIORef ringHead

42 if (ref+1) < ringMax

45 if (ref+1) < ringMax

43 then modifyIORef' ringHead ( + 1)

46 then modifyIORef' ringHead ( + 1)

core/src/Streamly/Internal/Data/Stream/Top.hs+1−1

@@ -366,7 +366,7 @@ joinOuter :: MonadIO m =>

366joinOuter eq s1 s =

367 Stream.concatM $ do

368 inputArr <- Array.fromStream s

369− let len = length inputArr

369+ let len = Array.length inputArr

370 foundArr <-

371 Stream.fold

372 (MA.writeN len)

core/streamly-core.cabal−3

@@ -320,7 +320,6 @@ library

320 , Streamly.Internal.Data.List

321

322 -- streamly-core-data-arrays

323− -- XXX Depends on primitive

324 , Streamly.Internal.Data.Array

323 , Streamly.Internal.Data.Array

325 , Streamly.Internal.Data.Array.Unboxed

324 , Streamly.Internal.Data.Array.Unboxed

326 , Streamly.Internal.Data.Array.Stream.Mut.Foreign

325 , Streamly.Internal.Data.Array.Stream.Mut.Foreign

@@ -328,7 +327,6 @@ library

328

327

329 -- Ring Arrays

328 -- Ring Arrays

330 , Streamly.Internal.Data.Ring.Foreign

329 , Streamly.Internal.Data.Ring.Foreign

331− -- XXX Depends on primitive

332 , Streamly.Internal.Data.Ring

330 , Streamly.Internal.Data.Ring

333

331

334 -- Only used for benchmarks

332 -- Only used for benchmarks

@@ -368,7 +366,6 @@ library

368

366

369 -- XXX to be removed

367 -- XXX to be removed

370 , transformers-base >= 0.4 && < 0.5

368 , transformers-base >= 0.4 && < 0.5

371− , primitive >= 0.5.4 && < 0.8

372 , heaps >= 0.3 && < 0.5

369 , heaps >= 0.3 && < 0.5

373 if flag(use-unliftio)

370 if flag(use-unliftio)

374 build-depends: unliftio-core >= 0.2 && < 0.3

371 build-depends: unliftio-core >= 0.2 && < 0.3

src/Streamly/Internal/Data/Stream/IsStream/Top.hs+3−2

@@ -67,7 +67,8 @@ import Streamly.Internal.Data.Time.Units (NanoSecond64(..), toRelTime64)

68import qualified Data.List as List

69import qualified Data.Map.Strict as Map

70−import qualified Streamly.Internal.Data.Array as Array (fromStream, toStream)

70+import qualified Streamly.Internal.Data.Array as Array

71+ (fromStream, length, toStream)

71import qualified Streamly.Data.Array.Unboxed.Mut as MA

72import qualified Streamly.Data.Array.Unboxed.Mut as MA

72import qualified Streamly.Internal.Data.Fold as Fold

73import qualified Streamly.Internal.Data.Fold as Fold

73 (head, last, toStream, toStreamRev)

74 (head, last, toStream, toStreamRev)

@@ -487,7 +488,7 @@ joinOuter :: MonadIO m =>

487joinOuter eq s1 s =

488joinOuter eq s1 s =

488 Stream.concatM $ do

489 Stream.concatM $ do

489 inputArr <- Array.fromStream s

490 inputArr <- Array.fromStream s

490− let len = length inputArr

491+ let len = Array.length inputArr

491 foundArr <-

492 foundArr <-

492 Stream.fold

493 Stream.fold

493 (MA.writeN len)

494 (MA.writeN len)

test/Streamly/Test/Data/Array.hs+10

@@ -37,6 +37,15 @@ testFromList =

37testLengthFromStream :: Property

38testLengthFromStream = genericTestFrom (const A.fromStream)

40+testReadShowInstance :: Property

41+testReadShowInstance =

42+ forAll (choose (0, maxArrLen)) $ \len ->

43+ forAll (vectorOf len (arbitrary :: Gen Int)) $ \list ->

44+ monadicIO $ do

45+ let arr = A.fromList list

46+ assert (A.toList (read (show arr)) == list)

47+

48+

40main :: IO ()

49main :: IO ()

41main =

50main =

42 hspec $

51 hspec $

@@ -49,3 +58,4 @@ main =

49 prop "toStream . fromStream === id" testFromStreamToStream

58 prop "toStream . fromStream === id" testFromStreamToStream

50 prop "read . write === id" testFoldUnfold

59 prop "read . write === id" testFoldUnfold

51 prop "fromList" testFromList

60 prop "fromList" testFromList

61+ prop "testReadShowInstance" testReadShowInstance