@@ -13,7 +13,7 @@
1313-- Copyright: (c) 2015 Dan Doel
1414-- License: BSD3
1515--
16−-- Maintainer: libraries@haskell.org
16+-- Maintainer : streamly@composewell.com
1717-- Portability: non-portable
1818--
1919-- Small arrays are boxed (im)mutable arrays.
@@ -36,7 +36,7 @@
3636-- The underlying type, 'SmallArray#', was introduced in GHC 7.10, so prior to
3737-- that version, this module simply implements small arrays as 'Array'.
3838
39−module Data.Primitive.SmallArray
39+module Streamly.Internal.Data.SmallArray.Types
4040 ( SmallArray(..)
4141 , SmallMutableArray(..)
4242 , newSmallArray
@@ -62,19 +62,14 @@ module Data.Primitive.SmallArray
6262 , traverseSmallArrayP
6363 ) where
6464
65−
66−#if (__GLASGOW_HASKELL__ >= 710)
67−#define HAVE_SMALL_ARRAY 1
68−#endif
69−
70−#if MIN_VERSION_base(4,7,0)
7165import GHC.Exts hiding (toList)
7266import qualified GHC.Exts
73−#endif
7467
7568import Control.Applicative
7669import Control.Monad
70+#if MIN_VERSION_base(4,9,0)
7771import qualified Control.Monad.Fail as Fail
72+#endif
7873import Control.Monad.Fix
7974import Control.Monad.Primitive
8075import Control.Monad.ST
@@ -90,66 +85,20 @@ import qualified GHC.ST as GHCST
9085import qualified Data.Semigroup as Sem
9186#endif
9287import Text.ParserCombinators.ReadP
93−#if MIN_VERSION_base(4,10,0)
94−import GHC.Exts (runRW#)
95−#elif MIN_VERSION_base(4,9,0)
96−import GHC.Base (runRW#)
97−#endif
9888
99−#if !(HAVE_SMALL_ARRAY)
100−import Data.Primitive.Array
101−import Data.Traversable
102−import qualified Data.Primitive.Array as Array
89+#if MIN_VERSION_base(4,9,0) && !MIN_VERSION_base(4,10,0)
90+import GHC.Base (runRW#)
10391#endif
10492
10593#if MIN_VERSION_base(4,9,0) || MIN_VERSION_transformers(0,4,0)
10694import Data.Functor.Classes (Eq1(..),Ord1(..),Show1(..),Read1(..))
10795#endif
10896
109−#if HAVE_SMALL_ARRAY
11097data SmallArray a = SmallArray (SmallArray# a)
11198 deriving Typeable
112−#else
113−newtype SmallArray a = SmallArray (Array a) deriving
114− ( Eq
115− , Ord
116− , Show
117− , Read
118− , Foldable
119− , Traversable
120− , Functor
121− , Applicative
122− , Alternative
123− , Monad
124− , MonadPlus
125− , MonadZip
126− , MonadFix
127− , Monoid
128− , Typeable
129−#if MIN_VERSION_base(4,9,0) || MIN_VERSION_transformers(0,4,0)
130− , Eq1
131− , Ord1
132− , Show1
133− , Read1
134−#endif
135− )
136−
137−#if MIN_VERSION_base(4,7,0)
138−instance IsList (SmallArray a) where
139− type Item (SmallArray a) = a
140− fromListN n l = SmallArray (fromListN n l)
141− fromList l = SmallArray (fromList l)
142− toList a = Foldable.toList a
143−#endif
144−#endif
14599
146−#if HAVE_SMALL_ARRAY
147100data SmallMutableArray s a = SmallMutableArray (SmallMutableArray# s a)
148101 deriving Typeable
149−#else
150−newtype SmallMutableArray s a = SmallMutableArray (MutableArray s a)
151− deriving (Eq, Typeable)
152−#endif
153102
154103-- | Create a new small mutable array.
155104newSmallArray
@@ -157,13 +106,9 @@ newSmallArray
157106 => Int -- ^ size
158107 -> a -- ^ initial contents
159108 -> m (SmallMutableArray (PrimState m) a)
160−#if HAVE_SMALL_ARRAY
161109newSmallArray (I# i#) x = primitive $ \s ->
162110 case newSmallArray# i# x s of
163111 (# s', sma# #) -> (# s', SmallMutableArray sma# #)
164−#else
165−newSmallArray n e = SmallMutableArray `liftM` newArray n e
166−#endif
167112{-# INLINE newSmallArray #-}
168113
169114-- | Read the element at a given index in a mutable array.
@@ -172,12 +117,8 @@ readSmallArray
172117 => SmallMutableArray (PrimState m) a -- ^ array
173118 -> Int -- ^ index
174119 -> m a
175−#if HAVE_SMALL_ARRAY
176120readSmallArray (SmallMutableArray sma#) (I# i#) =
177121 primitive $ readSmallArray# sma# i#
178−#else
179−readSmallArray (SmallMutableArray a) = readArray a
180−#endif
181122{-# INLINE readSmallArray #-}
182123
183124-- | Write an element at the given idex in a mutable array.
@@ -187,12 +128,8 @@ writeSmallArray
187128 -> Int -- ^ index
188129 -> a -- ^ new element
189130 -> m ()
190−#if HAVE_SMALL_ARRAY
191131writeSmallArray (SmallMutableArray sma#) (I# i#) x =
192132 primitive_ $ writeSmallArray# sma# i# x
193−#else
194−writeSmallArray (SmallMutableArray a) = writeArray a
195−#endif
196133{-# INLINE writeSmallArray #-}
197134
198135-- | Look up an element in an immutable array.
@@ -223,13 +160,9 @@ indexSmallArrayM
223160 => SmallArray a -- ^ array
224161 -> Int -- ^ index
225162 -> m a
226−#if HAVE_SMALL_ARRAY
227163indexSmallArrayM (SmallArray sa#) (I# i#) =
228164 case indexSmallArray# sa# i# of
229165 (# x #) -> pure x
230−#else
231−indexSmallArrayM (SmallArray a) = indexArrayM a
232−#endif
233166{-# INLINE indexSmallArrayM #-}
234167
235168-- | Look up an element in an immutable array.
@@ -237,22 +170,14 @@ indexSmallArray
237170 :: SmallArray a -- ^ array
238171 -> Int -- ^ index
239172 -> a
240−#if HAVE_SMALL_ARRAY
241173indexSmallArray sa i = runIdentity $ indexSmallArrayM sa i
242−#else
243−indexSmallArray (SmallArray a) = indexArray a
244−#endif
245174{-# INLINE indexSmallArray #-}
246175
247176-- | Read a value from the immutable array at the given index, returning
248177-- the result in an unboxed unary tuple. This is currently used to implement
249178-- folds.
250179indexSmallArray## :: SmallArray a -> Int -> (# a #)
251−#if HAVE_SMALL_ARRAY
252180indexSmallArray## (SmallArray ary) (I# i) = indexSmallArray# ary i
253−#else
254−indexSmallArray## (SmallArray a) = indexArray## a
255−#endif
256181{-# INLINE indexSmallArray## #-}
257182
258183-- | Create a copy of a slice of an immutable array.
@@ -261,12 +186,8 @@ cloneSmallArray
261186 -> Int -- ^ offset
262187 -> Int -- ^ length
263188 -> SmallArray a
264−#if HAVE_SMALL_ARRAY
265189cloneSmallArray (SmallArray sa#) (I# i#) (I# j#) =
266190 SmallArray (cloneSmallArray# sa# i# j#)
267−#else
268−cloneSmallArray (SmallArray a) i j = SmallArray $ cloneArray a i j
269−#endif
270191{-# INLINE cloneSmallArray #-}
271192
272193-- | Create a copy of a slice of a mutable array.
@@ -276,14 +197,9 @@ cloneSmallMutableArray
276197 -> Int -- ^ offset
277198 -> Int -- ^ length
278199 -> m (SmallMutableArray (PrimState m) a)
279−#if HAVE_SMALL_ARRAY
280200cloneSmallMutableArray (SmallMutableArray sma#) (I# o#) (I# l#) =
281201 primitive $ \s -> case cloneSmallMutableArray# sma# o# l# s of
282202 (# s', smb# #) -> (# s', SmallMutableArray smb# #)
283−#else
284−cloneSmallMutableArray (SmallMutableArray ma) i j =
285− SmallMutableArray `liftM` cloneMutableArray ma i j
286−#endif
287203{-# INLINE cloneSmallMutableArray #-}
288204
289205-- | Create an immutable array corresponding to a slice of a mutable array.
@@ -295,14 +211,9 @@ freezeSmallArray
295211 -> Int -- ^ offset
296212 -> Int -- ^ length
297213 -> m (SmallArray a)
298−#if HAVE_SMALL_ARRAY
299214freezeSmallArray (SmallMutableArray sma#) (I# i#) (I# j#) =
300215 primitive $ \s -> case freezeSmallArray# sma# i# j# s of
301216 (# s', sa# #) -> (# s', SmallArray sa# #)
302−#else
303−freezeSmallArray (SmallMutableArray ma) i j =
304− SmallArray `liftM` freezeArray ma i j
305−#endif
306217{-# INLINE freezeSmallArray #-}
307218
308219-- | Render a mutable array immutable.
@@ -311,14 +222,9 @@ freezeSmallArray (SmallMutableArray ma) i j =
311222-- input array after freezing.
312223unsafeFreezeSmallArray
313224 :: PrimMonad m => SmallMutableArray (PrimState m) a -> m (SmallArray a)
314−#if HAVE_SMALL_ARRAY
315225unsafeFreezeSmallArray (SmallMutableArray sma#) =
316226 primitive $ \s -> case unsafeFreezeSmallArray# sma# s of
317227 (# s', sa# #) -> (# s', SmallArray sa# #)
318−#else
319−unsafeFreezeSmallArray (SmallMutableArray ma) =
320− SmallArray `liftM` unsafeFreezeArray ma
321−#endif
322228{-# INLINE unsafeFreezeSmallArray #-}
323229
324230-- | Create a mutable array corresponding to a slice of an immutable array.
@@ -330,14 +236,9 @@ thawSmallArray
330236 -> Int -- ^ offset
331237 -> Int -- ^ length
332238 -> m (SmallMutableArray (PrimState m) a)
333−#if HAVE_SMALL_ARRAY
334239thawSmallArray (SmallArray sa#) (I# o#) (I# l#) =
335240 primitive $ \s -> case thawSmallArray# sa# o# l# s of
336241 (# s', sma# #) -> (# s', SmallMutableArray sma# #)
337−#else
338−thawSmallArray (SmallArray a) off len =
339− SmallMutableArray `liftM` thawArray a off len
340−#endif
341242{-# INLINE thawSmallArray #-}
342243
343244-- | Render an immutable array mutable.
@@ -345,13 +246,9 @@ thawSmallArray (SmallArray a) off len =
345246-- This operation performs no copying, so care must be taken with its use.
346247unsafeThawSmallArray
347248 :: PrimMonad m => SmallArray a -> m (SmallMutableArray (PrimState m) a)
348−#if HAVE_SMALL_ARRAY
349249unsafeThawSmallArray (SmallArray sa#) =
350250 primitive $ \s -> case unsafeThawSmallArray# sa# s of
351251 (# s', sma# #) -> (# s', SmallMutableArray sma# #)
352−#else
353−unsafeThawSmallArray (SmallArray a) = SmallMutableArray `liftM` unsafeThawArray a
354−#endif
355252{-# INLINE unsafeThawSmallArray #-}
356253
357254-- | Copy a slice of an immutable array into a mutable array.
@@ -363,13 +260,9 @@ copySmallArray
363260 -> Int -- ^ source offset
364261 -> Int -- ^ length
365262 -> m ()
366−#if HAVE_SMALL_ARRAY
367263copySmallArray
368264 (SmallMutableArray dst#) (I# do#) (SmallArray src#) (I# so#) (I# l#) =
369265 primitive_ $ copySmallArray# src# so# dst# do# l#
370−#else
371−copySmallArray (SmallMutableArray dst) i (SmallArray src) = copyArray dst i src
372−#endif
373266{-# INLINE copySmallArray #-}
374267
375268-- | Copy a slice of one mutable array into another.
@@ -381,33 +274,20 @@ copySmallMutableArray
381274 -> Int -- ^ source offset
382275 -> Int -- ^ length
383276 -> m ()
384−#if HAVE_SMALL_ARRAY
385277copySmallMutableArray
386278 (SmallMutableArray dst#) (I# do#)
387279 (SmallMutableArray src#) (I# so#)
388280 (I# l#) =
389281 primitive_ $ copySmallMutableArray# src# so# dst# do# l#
390−#else
391−copySmallMutableArray (SmallMutableArray dst) i (SmallMutableArray src) =
392− copyMutableArray dst i src
393−#endif
394282{-# INLINE copySmallMutableArray #-}
395283
396284sizeofSmallArray :: SmallArray a -> Int
397−#if HAVE_SMALL_ARRAY
398285sizeofSmallArray (SmallArray sa#) = I# (sizeofSmallArray# sa#)
399−#else
400−sizeofSmallArray (SmallArray a) = sizeofArray a
401−#endif
402286{-# INLINE sizeofSmallArray #-}
403287
404288sizeofSmallMutableArray :: SmallMutableArray s a -> Int
405−#if HAVE_SMALL_ARRAY
406289sizeofSmallMutableArray (SmallMutableArray sa#) =
407290 I# (sizeofSmallMutableArray# sa#)
408−#else
409−sizeofSmallMutableArray (SmallMutableArray ma) = sizeofMutableArray ma
410−#endif
411291{-# INLINE sizeofSmallMutableArray #-}
412292
413293-- | This is the fastest, most straightforward way to traverse
@@ -420,7 +300,6 @@ traverseSmallArrayP
420300 => (a -> m b)
421301 -> SmallArray a
422302 -> m (SmallArray b)
423−#if HAVE_SMALL_ARRAY
424303traverseSmallArrayP f = \ !ary ->
425304 let
426305 !sz = sizeofSmallArray ary
@@ -436,33 +315,19 @@ traverseSmallArrayP f = \ !ary ->
436315 in do
437316 mary <- newSmallArray sz badTraverseValue
438317 go 0 mary
439−#else
440−traverseSmallArrayP f (SmallArray ar) = SmallArray `liftM` traverseArrayP f ar
441−#endif
442318{-# INLINE traverseSmallArrayP #-}
443319
444320-- | Strict map over the elements of the array.
445321mapSmallArray' :: (a -> b) -> SmallArray a -> SmallArray b
446−#if HAVE_SMALL_ARRAY
447322mapSmallArray' f sa = createSmallArray (length sa) (die "mapSmallArray'" "impossible") $ \smb ->
448323 fix ? 0 $ \go i ->
449324 when (i < length sa) $ do
450325 x <- indexSmallArrayM sa i
451326 let !y = f x
452327 writeSmallArray smb i y *> go (i+1)
453−#else
454−mapSmallArray' f (SmallArray ar) = SmallArray (mapArray' f ar)
455−#endif
456328{-# INLINE mapSmallArray' #-}
457329
458−#ifndef HAVE_SMALL_ARRAY
459−runSmallArray
460− :: (forall s. ST s (SmallMutableArray s a))
461− -> SmallArray a
462−runSmallArray m = SmallArray $ runArray $
463− m >>= \(SmallMutableArray mary) -> return mary
464−
465−#elif !MIN_VERSION_base(4,9,0)
330+#if !MIN_VERSION_base(4,9,0)
466331runSmallArray
467332 :: (forall s. ST s (SmallMutableArray s a))
468333 -> SmallArray a
@@ -493,7 +358,6 @@ unST (GHCST.ST f) = f
493358
494359#endif
495360
496−#if HAVE_SMALL_ARRAY
497361-- See the comment on runSmallArray for why we use emptySmallArray#.
498362createSmallArray
499363 :: Int
@@ -809,12 +673,14 @@ instance Monad SmallArray where
809673 copySmallArray smb off sb 0 (length sb)
810674 *> fill (off + length sb) sbs smb
811675
812−#if !(MIN_VERSION_base(4,13,0))
676+#if !(MIN_VERSION_base(4,13,0)) && MIN_VERSION_base(4,9,0)
813677 fail = Fail.fail
814678#endif
815679
680+#if MIN_VERSION_base(4,9,0)
816681instance Fail.MonadFail SmallArray where
817682 fail _ = emptySmallArray
683+#endif
818684
819685instance MonadPlus SmallArray where
820686 mzero = empty
@@ -946,12 +812,10 @@ instance (Typeable s, Typeable a) => Data (SmallMutableArray s a) where
946812 toConstr _ = die "toConstr" "SmallMutableArray"
947813 gunfold _ _ = die "gunfold" "SmallMutableArray"
948814 dataTypeOf _ = mkNoRepType "Data.Primitive.SmallArray.SmallMutableArray"
949−#endif
950815
951816-- | Create a 'SmallArray' from a list of a known length. If the length
952817-- of the list does not match the given length, this throws an exception.
953818smallArrayFromListN :: Int -> [a] -> SmallArray a
954−#if HAVE_SMALL_ARRAY
955819smallArrayFromListN n l =
956820 createSmallArray n
957821 (die "smallArrayFromListN" "uninitialized element") $ \sma ->
@@ -964,9 +828,6 @@ smallArrayFromListN n l =
964828 go (ix+1) xs
965829 else die "smallArrayFromListN" "list length greater than specified size"
966830 in go 0 l
967−#else
968−smallArrayFromListN n l = SmallArray (Array.fromListN n l)
969−#endif
970831
971832-- | Create a 'SmallArray' from a list.
972833smallArrayFromList :: [a] -> SmallArray a