git.iko.soy/streamly
on master help sign in
Remove Storable constraint from Unbox typeclass
f7f264fAdithya Kumar
core/src/Streamly/Internal/Data/Array.hs+2−1
compare with master
unifiedsplit
@@ -125,6 +125,7 @@ import Data.Functor.Identity (Identity)
125import Data.Word (Word8)
125import Data.Word (Word8)
126import Foreign.C.String (CString)
126import Foreign.C.String (CString)
127import Foreign.Ptr (castPtr)
127import Foreign.Ptr (castPtr)
128+import Foreign.Storable (Storable)
128import Streamly.Internal.Data.Unboxed
129import Streamly.Internal.Data.Unboxed
129 ( Unbox
130 ( Unbox
130 , castContents
131 , castContents
@@ -273,7 +274,7 @@ last = getIndexRev 0
273--
274--
274{-# INLINE writeLastN #-}
275{-# INLINE writeLastN #-}
275writeLastN ::
276writeLastN ::
276− (Unbox a, MonadIO m) => Int -> Fold m a (Array a)
277+ (Storable a, Unbox a, MonadIO m) => Int -> Fold m a (Array a)
277writeLastN n
278writeLastN n
278 | n <= 0 = fmap (const mempty) FL.drain
279 | n <= 0 = fmap (const mempty) FL.drain
279 | otherwise = A.unsafeFreeze <$> Fold step initial done
280 | otherwise = A.unsafeFreeze <$> Fold step initial done
core/src/Streamly/Internal/Data/Array/Mut/Type.hs+15−26
@@ -223,7 +223,6 @@ import Foreign.Ptr (plusPtr, minusPtr, nullPtr)
223import Streamly.Internal.Data.Unboxed
223import Streamly.Internal.Data.Unboxed
224 ( MutableByteArray(..)
224 ( MutableByteArray(..)
225 , Unbox
225 , Unbox
226− , alignment
227 , castContents
226 , castContents
228 , getMutableByteArray#
227 , getMutableByteArray#
229 , peekWith
228 , peekWith
@@ -414,11 +413,9 @@ nil = Array Unboxed.nil 0 0 0
414--
413--
415-- /Pre-release/
414-- /Pre-release/
416{-# INLINE newPinnedBytes #-}
415{-# INLINE newPinnedBytes #-}
417−newPinnedBytes :: forall m a. (MonadIO m, Unbox a) => Int -> m (Array a)
416+newPinnedBytes :: MonadIO m => Int -> m (Array a)
418newPinnedBytes bytes = do
417newPinnedBytes bytes = do
419− contents <-
418+ contents <- liftIO $ Unboxed.newPinnedBytes bytes
420− liftIO
421− $ Unboxed.newAlignedPinnedBytes bytes (alignment (undefined :: a))
422 return $ Array
419 return $ Array
423 { arrContents = contents
420 { arrContents = contents
424 , arrStart = 0
421 , arrStart = 0
@@ -443,7 +440,10 @@ newAlignedPinned =
443--
440--
444{-# INLINE newPinned #-}
441{-# INLINE newPinned #-}
445newPinned :: forall m a. (MonadIO m, Unbox a) => Int -> m (Array a)
442newPinned :: forall m a. (MonadIO m, Unbox a) => Int -> m (Array a)
446−newPinned = newAlignedPinned (alignment (undefined :: a))
443+newPinned =
444+ newArrayWith
445+ (\s _ -> liftIO $ Unboxed.newPinnedBytes s)
446+ (error "newPinned: alignSize is not used")
447
447
448-- | Allocates an empty unpinned array that can hold 'count' items. The memory
448-- | Allocates an empty unpinned array that can hold 'count' items. The memory
449-- of the array is uninitialized.
449-- of the array is uninitialized.
@@ -705,14 +705,14 @@ roundDownTo elemSize size = size - (size `mod` elemSize)
705-- Since this is not inlined Unboxed consrraint leads to dictionary passing
705-- Since this is not inlined Unboxed consrraint leads to dictionary passing
706-- which complicates some inspection tests.
706-- which complicates some inspection tests.
707--
707--
708−{-# NOINLINE reallocAligned #-}
708+{-# NOINLINE reallocExplicit #-}
709−reallocAligned :: Int -> Int -> Int -> Array a -> IO (Array a)
709+reallocExplicit :: Int -> Int -> Array a -> IO (Array a)
710−reallocAligned elemSize alignSize newCapacityInBytes Array{..} = do
710+reallocExplicit elemSize newCapacityInBytes Array{..} = do
711 assertM(arrEnd <= arrBound)
711 assertM(arrEnd <= arrBound)
712
712
713 -- Allocate new array
713 -- Allocate new array
714 let newCapMaxInBytes = roundUpLargeArray newCapacityInBytes
714 let newCapMaxInBytes = roundUpLargeArray newCapacityInBytes
715− contents <- Unboxed.newAlignedPinnedBytes newCapMaxInBytes alignSize
715+ contents <- Unboxed.newPinnedBytes newCapMaxInBytes
716 let !(MutableByteArray mbarrFrom#) = arrContents
716 let !(MutableByteArray mbarrFrom#) = arrContents
717 !(MutableByteArray mbarrTo#) = contents
717 !(MutableByteArray mbarrTo#) = contents
718
718
@@ -745,8 +745,7 @@ reallocAligned elemSize alignSize newCapacityInBytes Array{..} = do
745--
745--
746{-# INLINABLE realloc #-}
746{-# INLINABLE realloc #-}
747realloc :: forall m a. (MonadIO m, Unbox a) => Int -> Array a -> m (Array a)
747realloc :: forall m a. (MonadIO m, Unbox a) => Int -> Array a -> m (Array a)
748−realloc bytes arr =
748+realloc bytes arr = liftIO $ reallocExplicit (SIZE_OF(a)) bytes arr
749− liftIO $ reallocAligned (SIZE_OF(a)) (alignment (undefined :: a)) bytes arr
750
749
751-- | @reallocWith label capSizer minIncrBytes array@. The label is used
750-- | @reallocWith label capSizer minIncrBytes array@. The label is used
752-- in error messages and the capSizer is used to determine the capacity of the
751-- in error messages and the capSizer is used to determine the capacity of the
@@ -1872,18 +1871,12 @@ writeWith elemCount =
1872
1871
1873 initial = do
1872 initial = do
1874 when (elemCount < 0) $ error "writeWith: elemCount is negative"
1873 when (elemCount < 0) $ error "writeWith: elemCount is negative"
1875− liftIO $ newAlignedPinned (alignment (undefined :: a)) elemCount
1874+ liftIO $ newPinned elemCount
1876 step arr@(Array _ start end bound) x
1875 step arr@(Array _ start end bound) x
1877 | INDEX_NEXT(end,a) > bound = do
1876 | INDEX_NEXT(end,a) > bound = do
1878 let oldSize = end - start
1877 let oldSize = end - start
1879 newSize = max (oldSize * 2) 1
1878 newSize = max (oldSize * 2) 1
1880− arr1 <-
1879+ arr1 <- liftIO $ reallocExplicit (SIZE_OF(a)) newSize arr
1881− liftIO
1882− $ reallocAligned
1883− (SIZE_OF(a))
1884− (alignment (undefined :: a))
1885− newSize
1886− arr
1887 insertElem arr1 x
1880 insertElem arr1 x
1888 step arr x = insertElem arr x
1881 step arr x = insertElem arr x
1889 extract = liftIO . rightSize
1882 extract = liftIO . rightSize
@@ -2008,18 +2001,14 @@ putSliceUnsafe src srcStartBytes dst dstStartBytes lenBytes = liftIO $ do
2008
2001
2009-- | Copy two arrays into a newly allocated array.
2002-- | Copy two arrays into a newly allocated array.
2010{-# INLINE spliceCopy #-}
2003{-# INLINE spliceCopy #-}
2011−spliceCopy :: forall m a. (MonadIO m, Unbox a) =>
2004+spliceCopy :: forall m a. MonadIO m =>
2012 Array a -> Array a -> m (Array a)
2005 Array a -> Array a -> m (Array a)
2013spliceCopy arr1 arr2 = liftIO $ do
2006spliceCopy arr1 arr2 = liftIO $ do
2014 let start1 = arrStart arr1
2007 let start1 = arrStart arr1
2015 start2 = arrStart arr2
2008 start2 = arrStart arr2
2016 len1 = arrEnd arr1 - start1
2009 len1 = arrEnd arr1 - start1
2017 len2 = arrEnd arr2 - start2
2010 len2 = arrEnd arr2 - start2
2018− newArrContents <-
2011+ newArrContents <- liftIO $ Unboxed.newPinnedBytes (len1 + len2)
2019− liftIO
2020− $ Unboxed.newAlignedPinnedBytes
2021− (len1 + len2)
2022− (alignment (undefined :: a))
2023 let len = len1 + len2
2012 let len = len1 + len2
2024 newArr = Array newArrContents 0 len len
2013 newArr = Array newArrContents 0 len len
2025 putSliceUnsafe arr1 start1 newArr 0 len1
2014 putSliceUnsafe arr1 start1 newArr 0 len1
core/src/Streamly/Internal/Data/Fold.hs+4−4
@@ -310,10 +310,10 @@ import Data.Bits (shiftL, shiftR, (.|.), (.&.))
310import Data.Either (isLeft, isRight, fromLeft, fromRight)
310import Data.Either (isLeft, isRight, fromLeft, fromRight)
311import Data.Int (Int64)
311import Data.Int (Int64)
312import Data.Word (Word32)
312import Data.Word (Word32)
313−import Foreign.Storable (peek, sizeOf)
313+import Foreign.Storable (Storable, peek)
314import Streamly.Internal.Data.Maybe.Strict (Maybe'(..), toMaybe)
314import Streamly.Internal.Data.Maybe.Strict (Maybe'(..), toMaybe)
315import Streamly.Internal.Data.Pipe.Type (Pipe (..), PipeState(..))
315import Streamly.Internal.Data.Pipe.Type (Pipe (..), PipeState(..))
316−import Streamly.Internal.Data.Unboxed (Unbox)
316+import Streamly.Internal.Data.Unboxed (Unbox, sizeOf)
317import Streamly.Internal.Data.Unfold.Type (Unfold(..))
317import Streamly.Internal.Data.Unfold.Type (Unfold(..))
318import Streamly.Internal.Data.Tuple.Strict (Tuple'(..), Tuple3'(..))
318import Streamly.Internal.Data.Tuple.Strict (Tuple'(..), Tuple3'(..))
319import Streamly.Internal.Data.Stream.Type (Stream)
319import Streamly.Internal.Data.Stream.Type (Stream)
@@ -1684,7 +1684,7 @@ data SplitOnSeqState acc a rb rh w ck =
1684--
1684--
1685-- /Pre-release/
1685-- /Pre-release/
1686{-# INLINE takeEndBySeq #-}
1686{-# INLINE takeEndBySeq #-}
1687−takeEndBySeq :: forall m a b. (MonadIO m, Unbox a, Enum a, Eq a) =>
1687+takeEndBySeq :: forall m a b. (MonadIO m, Storable a, Unbox a, Enum a, Eq a) =>
1688 Array.Array a
1688 Array.Array a
1689 -> Fold m a b
1689 -> Fold m a b
1690 -> Fold m a b
1690 -> Fold m a b
@@ -1820,7 +1820,7 @@ takeEndBySeq patArr (Fold fstep finitial fextract) =
1820-- /Pre-release/
1820-- /Pre-release/
1821--
1821--
1822{-# INLINE takeEndBySeq_ #-}
1822{-# INLINE takeEndBySeq_ #-}
1823−takeEndBySeq_ :: forall m a b. (MonadIO m, Unbox a, Enum a, Eq a) =>
1823+takeEndBySeq_ :: forall m a b. (MonadIO m, Storable a, Unbox a, Enum a, Eq a) =>
1824 Array.Array a
1824 Array.Array a
1825 -> Fold m a b
1825 -> Fold m a b
1826 -> Fold m a b
1826 -> Fold m a b
core/src/Streamly/Internal/Data/Ring/Unboxed.hs+2−2
@@ -561,7 +561,7 @@ data Tuple4' a b c d = Tuple4' !a !b !c !d deriving Show
561-- a))@ action depends on when it is executed. It does not capture the sanpshot
561-- a))@ action depends on when it is executed. It does not capture the sanpshot
562-- of the ring at a particular time.
562-- of the ring at a particular time.
563{-# INLINE slidingWindowWith #-}
563{-# INLINE slidingWindowWith #-}
564−slidingWindowWith :: forall m a b. (MonadIO m, Unbox a)
564+slidingWindowWith :: forall m a b. (MonadIO m, Storable a, Unbox a)
565 => Int -> Fold m ((a, Maybe a), m (Array a)) b -> Fold m a b
565 => Int -> Fold m ((a, Maybe a), m (Array a)) b -> Fold m a b
566slidingWindowWith n (Fold step1 initial1 extract1) = Fold step initial extract
566slidingWindowWith n (Fold step1 initial1 extract1) = Fold step initial extract
567
567
@@ -615,6 +615,6 @@ slidingWindowWith n (Fold step1 initial1 extract1) = Fold step initial extract
615-- there is no old element.
615-- there is no old element.
616--
616--
617{-# INLINE slidingWindow #-}
617{-# INLINE slidingWindow #-}
618−slidingWindow :: forall m a b. (MonadIO m, Unbox a)
618+slidingWindow :: forall m a b. (MonadIO m, Storable a, Unbox a)
619 => Int -> Fold m (a, Maybe a) b -> Fold m a b
619 => Int -> Fold m (a, Maybe a) b -> Fold m a b
620slidingWindow n f = slidingWindowWith n (lmap fst f)
620slidingWindow n f = slidingWindowWith n (lmap fst f)
core/src/Streamly/Internal/Data/Stream/Eliminate.hs+2−1
@@ -78,6 +78,7 @@ where
78#include "inline.hs"
78#include "inline.hs"
79
79
80import Control.Monad.IO.Class (MonadIO(..))
80import Control.Monad.IO.Class (MonadIO(..))
81+import Foreign.Storable (Storable)
81import Streamly.Internal.Data.Parser (Parser (..), ParseError (..))
82import Streamly.Internal.Data.Parser (Parser (..), ParseError (..))
82import Streamly.Internal.Data.Unboxed (Unbox)
83import Streamly.Internal.Data.Unboxed (Unbox)
83
84
@@ -290,7 +291,7 @@ isPrefixOf m1 m2 = D.isPrefixOf (toStreamD m1) (toStreamD m2)
290-- /Requires 'Storable' constraint/
291-- /Requires 'Storable' constraint/
291--
292--
292{-# INLINE isInfixOf #-}
293{-# INLINE isInfixOf #-}
293−isInfixOf :: (MonadIO m, Eq a, Enum a, Unbox a)
294+isInfixOf :: (MonadIO m, Eq a, Enum a, Storable a, Unbox a)
294 => Stream m a -> Stream m a -> m Bool
295 => Stream m a -> Stream m a -> m Bool
295isInfixOf infx stream = do
296isInfixOf infx stream = do
296 arr <- fold Array.write infx
297 arr <- fold Array.write infx
core/src/Streamly/Internal/Data/Stream/StreamD/Nesting.hs+4−4
@@ -154,7 +154,7 @@ import Control.Monad.IO.Class (MonadIO(..))
154import Data.Bits (shiftR, shiftL, (.|.), (.&.))
154import Data.Bits (shiftR, shiftL, (.|.), (.&.))
155import Data.Functor.Identity ( Identity )
155import Data.Functor.Identity ( Identity )
156import Data.Word (Word32)
156import Data.Word (Word32)
157−import Foreign.Storable (peek, sizeOf)
157+import Foreign.Storable (Storable, peek)
158import Fusion.Plugin.Types (Fuse(..))
158import Fusion.Plugin.Types (Fuse(..))
159import GHC.Types (SPEC(..))
159import GHC.Types (SPEC(..))
160
160
@@ -165,7 +165,7 @@ import Streamly.Internal.Data.Parser (ParseError(..))
165import Streamly.Internal.Data.Refold.Type (Refold(..))
165import Streamly.Internal.Data.Refold.Type (Refold(..))
166import Streamly.Internal.Data.SVar.Type (adaptState)
166import Streamly.Internal.Data.SVar.Type (adaptState)
167import Streamly.Internal.Data.Tuple.Strict (Tuple'(..))
167import Streamly.Internal.Data.Tuple.Strict (Tuple'(..))
168−import Streamly.Internal.Data.Unboxed (Unbox)
168+import Streamly.Internal.Data.Unboxed (Unbox, sizeOf)
169import Streamly.Internal.Data.Unfold.Type (Unfold(..))
169import Streamly.Internal.Data.Unfold.Type (Unfold(..))
170
170
171import qualified Streamly.Internal.Data.Array.Type as A
171import qualified Streamly.Internal.Data.Array.Type as A
@@ -1900,7 +1900,7 @@ data SplitOnSeqState rb rh ck w fs s b x =
1900
1900
1901{-# INLINE_NORMAL splitOnSeq #-}
1901{-# INLINE_NORMAL splitOnSeq #-}
1902splitOnSeq
1902splitOnSeq
1903− :: forall m a b. (MonadIO m, Unbox a, Enum a, Eq a)
1903+ :: forall m a b. (MonadIO m, Storable a, Unbox a, Enum a, Eq a)
1904 => Array a
1904 => Array a
1905 -> Fold m a b
1905 -> Fold m a b
1906 -> Stream m a
1906 -> Stream m a
@@ -2213,7 +2213,7 @@ data SplitOnSuffixSeqState rb rh ck w fs s b x =
2213
2213
2214{-# INLINE_NORMAL splitOnSuffixSeq #-}
2214{-# INLINE_NORMAL splitOnSuffixSeq #-}
2215splitOnSuffixSeq
2215splitOnSuffixSeq
2216− :: forall m a b. (MonadIO m, Unbox a, Enum a, Eq a)
2216+ :: forall m a b. (MonadIO m, Storable a, Unbox a, Enum a, Eq a)
2217 => Bool
2217 => Bool
2218 -> Array a
2218 -> Array a
2219 -> Fold m a b
2219 -> Fold m a b
core/src/Streamly/Internal/Data/Unboxed.hs+78−72
@@ -6,10 +6,8 @@
6
6
7module Streamly.Internal.Data.Unboxed
7module Streamly.Internal.Data.Unboxed
8 ( Unbox(..)
8 ( Unbox(..)
9− , alignment
10 , peekWith
9 , peekWith
11 , pokeWith
10 , pokeWith
12− , sizeOf
13 , MutableByteArray(..)
11 , MutableByteArray(..)
14 , castContents
12 , castContents
15 , touch
13 , touch
@@ -17,6 +15,7 @@ module Streamly.Internal.Data.Unboxed
17 , pin
15 , pin
18 , unpin
16 , unpin
19 , newUnpinnedBytes
17 , newUnpinnedBytes
18+ , newPinnedBytes
20 , newAlignedPinnedBytes
19 , newAlignedPinnedBytes
21 , nil
20 , nil
22
21
@@ -40,7 +39,6 @@ module Streamly.Internal.Data.Unboxed
40 ) where
39 ) where
41
40
42#include "MachDeps.h"
41#include "MachDeps.h"
43−
44#include "ArrayMacros.h"
42#include "ArrayMacros.h"
45
43
46import Control.Monad (void, when)
44import Control.Monad (void, when)
@@ -51,7 +49,6 @@ import Data.Functor.Identity (Identity(..))
51import Data.Kind (Type)
49import Data.Kind (Type)
52import Data.Proxy (Proxy (..))
50import Data.Proxy (Proxy (..))
53import Foreign.Ptr (IntPtr(..), WordPtr(..))
51import Foreign.Ptr (IntPtr(..), WordPtr(..))
54−import Foreign.Storable (Storable(..))
55import GHC.Base (IO(..))
52import GHC.Base (IO(..))
56import GHC.Fingerprint.Type (Fingerprint(..))
53import GHC.Fingerprint.Type (Fingerprint(..))
57import GHC.Int (Int16(..), Int32(..), Int64(..), Int8(..))
54import GHC.Int (Int16(..), Int32(..), Int64(..), Int8(..))
@@ -115,6 +112,16 @@ newUnpinnedBytes (I# nbytes) = IO $ \s ->
115 let c = MutableByteArray mbarr#
112 let c = MutableByteArray mbarr#
116 in (# s', c #)
113 in (# s', c #)
117
114
115+{-# INLINE newPinnedBytes #-}
116+newPinnedBytes :: Int -> IO (MutableByteArray a)
117+newPinnedBytes nbytes | nbytes < 0 =
118+ errorWithoutStackTrace "newPinnedBytes: size must be >= 0"
119+newPinnedBytes (I# nbytes) = IO $ \s ->
120+ case newPinnedByteArray# nbytes s of
121+ (# s', mbarr# #) ->
122+ let c = MutableByteArray mbarr#
123+ in (# s', c #)
124+
118{-# INLINE newAlignedPinnedBytes #-}
125{-# INLINE newAlignedPinnedBytes #-}
119newAlignedPinnedBytes :: Int -> Int -> IO (MutableByteArray a)
126newAlignedPinnedBytes :: Int -> Int -> IO (MutableByteArray a)
120newAlignedPinnedBytes nbytes _align | nbytes < 0 =
127newAlignedPinnedBytes nbytes _align | nbytes < 0 =
@@ -175,7 +182,6 @@ unpin arr@(MutableByteArray marr#) =
175-- The Unbox type class
182-- The Unbox type class
176--------------------------------------------------------------------------------
183--------------------------------------------------------------------------------
177
184
178−-- XXX Remove dependency on Storable
179-- XXX Use Proxy type in sizeOf method.
185-- XXX Use Proxy type in sizeOf method.
180-- XXX generate error if the size is < 1
186-- XXX generate error if the size is < 1
181-- XXX Remove the phantom parameter from MutableByteArray?
187-- XXX Remove the phantom parameter from MutableByteArray?
@@ -208,9 +214,6 @@ unpin arr@(MutableByteArray marr#) =
208-- anymore, see
214-- anymore, see
209-- https://lemire.me/blog/2012/05/31/data-alignment-for-speed-myth-or-reality/
215-- https://lemire.me/blog/2012/05/31/data-alignment-for-speed-myth-or-reality/
210--
216--
211−-- We have to keep the instances compatible with Storable as we depend on it for
212−-- size and alignment. We can possibly write tests for checking compatibility
213−-- with Storable.
214
217
215-- The main goal of the Unbox type class is to be used in arrays. Invariants
218-- The main goal of the Unbox type class is to be used in arrays. Invariants
216-- for the sizeOf value required for use in arrays:
219-- for the sizeOf value required for use in arrays:
@@ -230,16 +233,6 @@ unpin arr@(MutableByteArray marr#) =
230-- boxed type from the mutable byte array. The write operation 'pokeByteIndex'
233-- boxed type from the mutable byte array. The write operation 'pokeByteIndex'
231-- writes the boxed type to the mutable byte array.
234-- writes the boxed type to the mutable byte array.
232--
235--
233−-- This type class depends on the 'Storable' for 'sizeOf' and 'alignment'
234−-- operations. While 'Storable' supplies the ability to serialize a type to a
235−-- 'Ptr' type, 'Unbox' augments it by supplying the ability to serialize to a
236−-- mutable byte array. The advantage of 'Unbox' over 'Storable' is that we can
237−-- use unpinned memory with 'Unbox'.
238−--
239−-- Note: Use the @QuantifiedConstraints@ language extension so that you can
240−-- just use a single 'Unbox' constraint in your code rather than using both
241−-- 'Storable' and 'Unbox'.
242−--
243-- Here is an example, to write an instance for this type class.
236-- Here is an example, to write an instance for this type class.
244--
237--
245-- >>> :{
238-- >>> :{
@@ -249,30 +242,11 @@ unpin arr@(MutableByteArray marr#) =
249-- }
242-- }
250-- :}
243-- :}
251--
244--
252−-- Note you can leave peek and poke undefined in 'Storable' if you are not
253−-- using the Storable instance, Unbox does not need these operations.
254−--
255−-- >>> import Foreign.Ptr (plusPtr, castPtr)
256−-- >>> import Foreign.Storable (Storable(..))
257−-- >>> :{
258−-- instance Storable Object where
259−-- sizeOf _ = 16
260−-- alignment _ = 8
261−-- peek ptr = do
262−-- let p = castPtr ptr
263−-- x0 <- peek p
264−-- x1 <- peek (p `plusPtr` 8)
265−-- return $ Object x0 x1
266−-- poke ptr (Object x0 x1) = do
267−-- let p = castPtr ptr
268−-- poke p x0
269−-- poke (p `plusPtr` 8) x1
270−-- :}
271−--
272-- >>> import Streamly.Data.Array (Unbox(..))
245-- >>> import Streamly.Data.Array (Unbox(..))
273-- >>> import Streamly.Internal.Data.Unboxed (castContents)
246-- >>> import Streamly.Internal.Data.Unboxed (castContents)
274-- >>> :{
247-- >>> :{
275-- instance Unbox Object where
248-- instance Unbox Object where
249+-- sizeOf _ = 16
276-- peekByteIndex arr i = do
250-- peekByteIndex arr i = do
277-- let p = castContents arr
251-- let p = castContents arr
278-- x0 <- peekByteIndex p i
252-- x0 <- peekByteIndex p i
@@ -284,7 +258,9 @@ unpin arr@(MutableByteArray marr#) =
284-- pokeByteIndex p (i + 8) x1
258-- pokeByteIndex p (i + 8) x1
285-- :}
259-- :}
286--
260--
287−class Storable a => Unbox a where
261+class Unbox a where
262+ -- | Get the size.
263+ sizeOf :: a -> Int
288 -- | Read an element of type "a" from a MutableByteArray given the byte
264 -- | Read an element of type "a" from a MutableByteArray given the byte
289 -- index.
265 -- index.
290 --
266 --
@@ -298,7 +274,7 @@ class Storable a => Unbox a where
298 -- of the array, the caller must not assume that.
274 -- of the array, the caller must not assume that.
299 pokeByteIndex :: MutableByteArray a -> Int -> a -> IO ()
275 pokeByteIndex :: MutableByteArray a -> Int -> a -> IO ()
300
276
301−#define DERIVE_UNBOXED(_type, _constructor, _readArray, _writeArray) \
277+#define DERIVE_UNBOXED(_type, _constructor, _readArray, _writeArray, _sizeOf) \
302instance Unbox _type where { \
278instance Unbox _type where { \
303; {-# INLINE peekByteIndex #-} \
279; {-# INLINE peekByteIndex #-} \
304; peekByteIndex (MutableByteArray mbarr) (I# n) = IO $ \s -> \
280; peekByteIndex (MutableByteArray mbarr) (I# n) = IO $ \s -> \
@@ -307,14 +283,18 @@ instance Unbox _type where { \
307; {-# INLINE pokeByteIndex #-} \
283; {-# INLINE pokeByteIndex #-} \
308; pokeByteIndex (MutableByteArray mbarr) (I# n) (_constructor val) = \
284; pokeByteIndex (MutableByteArray mbarr) (I# n) (_constructor val) = \
309 IO $ \s -> (# _writeArray mbarr n val s, () #) \
285 IO $ \s -> (# _writeArray mbarr n val s, () #) \
286+; {-# INLINE sizeOf #-} \
287+; sizeOf _ = _sizeOf \
310}
288}
311
289
312−#define DERIVE_WRAPPED_UNBOX(_constraint, _type, _constructor) \
290+#define DERIVE_WRAPPED_UNBOX(_constraint, _type, _constructor, _innerType) \
313−instance _constraint Unbox _type where \
291+instance _constraint Unbox _type where \
314−; {-# INLINE peekByteIndex #-} \
292+; {-# INLINE peekByteIndex #-} \
315−; peekByteIndex arr i = _constructor <$> peekByteIndex (castContents arr) i \
293+; peekByteIndex arr i = _constructor <$> peekByteIndex (castContents arr) i \
316−; {-# INLINE pokeByteIndex #-} \
294+; {-# INLINE pokeByteIndex #-} \
317−; pokeByteIndex arr i (_constructor a) = pokeByteIndex (castContents arr) i a
295+; pokeByteIndex arr i (_constructor a) = pokeByteIndex (castContents arr) i a \
296+; {-# INLINE sizeOf #-} \
297+; sizeOf _ = SIZE_OF(_innerType)
318
298
319#define DERIVE_BINARY_UNBOX(_constraint, _type, _constructor, _innerType) \
299#define DERIVE_BINARY_UNBOX(_constraint, _type, _constructor, _innerType) \
320instance _constraint Unbox _type where { \
300instance _constraint Unbox _type where { \
@@ -329,100 +309,117 @@ instance _constraint Unbox _type where { \
329 let contents = castContents arr :: MutableByteArray _innerType \
309 let contents = castContents arr :: MutableByteArray _innerType \
330 in pokeByteIndex contents i p1 >> \
310 in pokeByteIndex contents i p1 >> \
331 pokeByteIndex contents (i + SIZE_OF(_innerType)) p2 \
311 pokeByteIndex contents (i + SIZE_OF(_innerType)) p2 \
312+; {-# INLINE sizeOf #-} \
313+; sizeOf _ = 2 * SIZE_OF(_innerType) \
332}
314}
333
315
334DERIVE_UNBOXED( Char
316DERIVE_UNBOXED( Char
335 , C#
317 , C#
336 , readWord8ArrayAsWideChar#
318 , readWord8ArrayAsWideChar#
337− , writeWord8ArrayAsWideChar#)
319+ , writeWord8ArrayAsWideChar#
320+ , SIZEOF_HSCHAR)
338
321
339DERIVE_UNBOXED( Int8
322DERIVE_UNBOXED( Int8
340 , I8#
323 , I8#
341 , readInt8Array#
324 , readInt8Array#
342− , writeInt8Array#)
325+ , writeInt8Array#
326+ , 1)
343
327
344DERIVE_UNBOXED( Int16
328DERIVE_UNBOXED( Int16
345 , I16#
329 , I16#
346 , readWord8ArrayAsInt16#
330 , readWord8ArrayAsInt16#
347− , writeWord8ArrayAsInt16#)
331+ , writeWord8ArrayAsInt16#
332+ , 2)
348
333
349DERIVE_UNBOXED( Int32
334DERIVE_UNBOXED( Int32
350 , I32#
335 , I32#
351 , readWord8ArrayAsInt32#
336 , readWord8ArrayAsInt32#
352− , writeWord8ArrayAsInt32#)
337+ , writeWord8ArrayAsInt32#
338+ , 4)
353
339
354DERIVE_UNBOXED( Int
340DERIVE_UNBOXED( Int
355 , I#
341 , I#
356 , readWord8ArrayAsInt#
342 , readWord8ArrayAsInt#
357− , writeWord8ArrayAsInt#)
343+ , writeWord8ArrayAsInt#
344+ , SIZEOF_HSINT)
358
345
359DERIVE_UNBOXED( Int64
346DERIVE_UNBOXED( Int64
360 , I64#
347 , I64#
361 , readWord8ArrayAsInt64#
348 , readWord8ArrayAsInt64#
362− , writeWord8ArrayAsInt64#)
349+ , writeWord8ArrayAsInt64#
350+ , 8)
363
351
364DERIVE_UNBOXED( Word
352DERIVE_UNBOXED( Word
365 , W#
353 , W#
366 , readWord8ArrayAsWord#
354 , readWord8ArrayAsWord#
367− , writeWord8ArrayAsWord#)
355+ , writeWord8ArrayAsWord#
356+ , SIZEOF_HSWORD)
368
357
369DERIVE_UNBOXED( Word8
358DERIVE_UNBOXED( Word8
370 , W8#
359 , W8#
371 , readWord8Array#
360 , readWord8Array#
372− , writeWord8Array#)
361+ , writeWord8Array#
362+ , 1)
373
363
374DERIVE_UNBOXED( Word16
364DERIVE_UNBOXED( Word16
375 , W16#
365 , W16#
376 , readWord8ArrayAsWord16#
366 , readWord8ArrayAsWord16#
377− , writeWord8ArrayAsWord16#)
367+ , writeWord8ArrayAsWord16#
368+ , 2)
378
369
379DERIVE_UNBOXED( Word32
370DERIVE_UNBOXED( Word32
380 , W32#
371 , W32#
381 , readWord8ArrayAsWord32#
372 , readWord8ArrayAsWord32#
382− , writeWord8ArrayAsWord32#)
373+ , writeWord8ArrayAsWord32#
374+ , 4)
383
375
384DERIVE_UNBOXED( Word64
376DERIVE_UNBOXED( Word64
385 , W64#
377 , W64#
386 , readWord8ArrayAsWord64#
378 , readWord8ArrayAsWord64#
387− , writeWord8ArrayAsWord64#)
379+ , writeWord8ArrayAsWord64#
380+ , 8)
388
381
389DERIVE_UNBOXED( Double
382DERIVE_UNBOXED( Double
390 , D#
383 , D#
391 , readWord8ArrayAsDouble#
384 , readWord8ArrayAsDouble#
392− , writeWord8ArrayAsDouble#)
385+ , writeWord8ArrayAsDouble#
386+ , SIZEOF_HSDOUBLE)
393
387
394DERIVE_UNBOXED( Float
388DERIVE_UNBOXED( Float
395 , F#
389 , F#
396 , readWord8ArrayAsFloat#
390 , readWord8ArrayAsFloat#
397− , writeWord8ArrayAsFloat#)
391+ , writeWord8ArrayAsFloat#
392+ , SIZEOF_HSFLOAT)
398
393
399DERIVE_UNBOXED( (StablePtr a)
394DERIVE_UNBOXED( (StablePtr a)
400 , StablePtr
395 , StablePtr
401 , readWord8ArrayAsStablePtr#
396 , readWord8ArrayAsStablePtr#
402− , writeWord8ArrayAsStablePtr#)
397+ , writeWord8ArrayAsStablePtr#
398+ , SIZEOF_HSSTABLEPTR)
403
399
404DERIVE_UNBOXED( (Ptr a)
400DERIVE_UNBOXED( (Ptr a)
405 , Ptr
401 , Ptr
406 , readWord8ArrayAsAddr#
402 , readWord8ArrayAsAddr#
407− , writeWord8ArrayAsAddr#)
403+ , writeWord8ArrayAsAddr#
404+ , SIZEOF_HSPTR)
408
405
409DERIVE_UNBOXED( (FunPtr a)
406DERIVE_UNBOXED( (FunPtr a)
410 , FunPtr
407 , FunPtr
411 , readWord8ArrayAsAddr#
408 , readWord8ArrayAsAddr#
412− , writeWord8ArrayAsAddr#)
409+ , writeWord8ArrayAsAddr#
410+ , SIZEOF_HSFUNPTR)
413
411
414−DERIVE_WRAPPED_UNBOX(,IntPtr,IntPtr)
412+DERIVE_WRAPPED_UNBOX(,IntPtr,IntPtr,Int)
415−DERIVE_WRAPPED_UNBOX(,WordPtr,WordPtr)
413+DERIVE_WRAPPED_UNBOX(,WordPtr,WordPtr,Word)
416−DERIVE_WRAPPED_UNBOX(Unbox a =>,(Identity a),Identity)
414+DERIVE_WRAPPED_UNBOX(Unbox a =>,(Identity a),Identity,a)
417#if MIN_VERSION_base(4,14,0)
415#if MIN_VERSION_base(4,14,0)
418−DERIVE_WRAPPED_UNBOX(Unbox a =>,(Down a),Down)
416+DERIVE_WRAPPED_UNBOX(Unbox a =>,(Down a),Down,a)
419#endif
417#endif
420−DERIVE_WRAPPED_UNBOX(Unbox a =>,(Const a b),Const)
418+DERIVE_WRAPPED_UNBOX(Unbox a =>,(Const a b),Const,a)
421DERIVE_BINARY_UNBOX(forall a. Unbox a =>,(Complex a),(:+),a)
419DERIVE_BINARY_UNBOX(forall a. Unbox a =>,(Complex a),(:+),a)
422−DERIVE_BINARY_UNBOX(forall a. (Integral a, Unbox a) =>,(Ratio a),(:%),a)
420+DERIVE_BINARY_UNBOX(forall a. Unbox a =>,(Ratio a),(:%),a)
423DERIVE_BINARY_UNBOX(,Fingerprint,Fingerprint,Word64)
421DERIVE_BINARY_UNBOX(,Fingerprint,Fingerprint,Word64)
424
422
425−-- XXX This should have a size 1.
426instance Unbox () where
423instance Unbox () where
427
424
428 {-# INLINE peekByteIndex #-}
425 {-# INLINE peekByteIndex #-}
@@ -431,6 +428,9 @@ instance Unbox () where
431 {-# INLINE pokeByteIndex #-}
428 {-# INLINE pokeByteIndex #-}
432 pokeByteIndex _ _ _ = return ()
429 pokeByteIndex _ _ _ = return ()
433
430
431+ {-# INLINE sizeOf #-}
432+ sizeOf _ = 1
433+
434#if MIN_VERSION_base(4,15,0)
434#if MIN_VERSION_base(4,15,0)
435instance Unbox IoSubSystem where
435instance Unbox IoSubSystem where
436
436
@@ -439,6 +439,9 @@ instance Unbox IoSubSystem where
439
439
440 {-# INLINE pokeByteIndex #-}
440 {-# INLINE pokeByteIndex #-}
441 pokeByteIndex arr i a = pokeByteIndex (castContents arr) i (fromEnum a)
441 pokeByteIndex arr i a = pokeByteIndex (castContents arr) i (fromEnum a)
442+
443+ {-# INLINE sizeOf #-}
444+ sizeOf = sizeOf . fromEnum
442#endif
445#endif
443
446
444instance Unbox Bool where
447instance Unbox Bool where
@@ -446,13 +449,16 @@ instance Unbox Bool where
446 {-# INLINE peekByteIndex #-}
449 {-# INLINE peekByteIndex #-}
447 peekByteIndex arr i = do
450 peekByteIndex arr i = do
448 res <- peekByteIndex (castContents arr) i
451 res <- peekByteIndex (castContents arr) i
449− return $ res /= (0 :: Int32)
452+ return $ res /= (0 :: Int8)
450
453
451 {-# INLINE pokeByteIndex #-}
454 {-# INLINE pokeByteIndex #-}
452 pokeByteIndex arr i a =
455 pokeByteIndex arr i a =
453 if a
456 if a
454− then pokeByteIndex (castContents arr) i (1 :: Int32)
457+ then pokeByteIndex (castContents arr) i (1 :: Int8)
455− else pokeByteIndex (castContents arr) i (0 :: Int32)
458+ else pokeByteIndex (castContents arr) i (0 :: Int8)
459+
460+ {-# INLINE sizeOf #-}
461+ sizeOf _ = 1
456
462
457--------------------------------------------------------------------------------
463--------------------------------------------------------------------------------
458-- Functions
464-- Functions
src/Streamly/Internal/Data/Stream/IsStream/Common.hs+2−1
@@ -70,6 +70,7 @@ where
70
70
71import Control.Concurrent (threadDelay)
71import Control.Concurrent (threadDelay)
72import Control.Monad.IO.Class (MonadIO(..))
72import Control.Monad.IO.Class (MonadIO(..))
73+import Foreign.Storable (Storable)
73import Streamly.Internal.Control.Concurrent (MonadAsync)
74import Streamly.Internal.Control.Concurrent (MonadAsync)
74import Streamly.Internal.Data.Array.Type (Array)
75import Streamly.Internal.Data.Array.Type (Array)
75import Streamly.Internal.Data.Fold.Type (Fold (..))
76import Streamly.Internal.Data.Fold.Type (Fold (..))
@@ -679,7 +680,7 @@ foldManyPost f m = fromStreamD $ D.foldManyPost f (toStreamD m)
679-- that we can search files in files for example.
680-- that we can search files in files for example.
680{-# INLINE splitOnSeq #-}
681{-# INLINE splitOnSeq #-}
681splitOnSeq
682splitOnSeq
682− :: (IsStream t, MonadIO m, Unbox a, Enum a, Eq a)
683+ :: (IsStream t, MonadIO m, Storable a, Unbox a, Enum a, Eq a)
683 => Array a -> Fold m a b -> t m a -> t m b
684 => Array a -> Fold m a b -> t m a -> t m b
684splitOnSeq patt f m =
685splitOnSeq patt f m =
685 IsStream.fromStreamD $ D.splitOnSeq patt f (IsStream.toStreamD m)
686 IsStream.fromStreamD $ D.splitOnSeq patt f (IsStream.toStreamD m)
src/Streamly/Internal/Data/Stream/IsStream/Eliminate.hs+2−1
@@ -158,6 +158,7 @@ where
158
158
159import Control.Monad.IO.Class (MonadIO(..))
159import Control.Monad.IO.Class (MonadIO(..))
160import Control.Monad.Trans.Class (MonadTrans(..))
160import Control.Monad.Trans.Class (MonadTrans(..))
161+import Foreign.Storable (Storable)
161import Streamly.Internal.Control.Concurrent (MonadAsync)
162import Streamly.Internal.Control.Concurrent (MonadAsync)
162import Streamly.Internal.Data.SVar (defState)
163import Streamly.Internal.Data.SVar (defState)
163import Streamly.Internal.Data.Stream.IsStream.Common
164import Streamly.Internal.Data.Stream.IsStream.Common
@@ -849,7 +850,7 @@ isPrefixOf m1 m2 = D.isPrefixOf (toStreamD m1) (toStreamD m2)
849-- /Requires 'Storable' constraint/
850-- /Requires 'Storable' constraint/
850--
851--
851{-# INLINE isInfixOf #-}
852{-# INLINE isInfixOf #-}
852−isInfixOf :: (MonadIO m, Eq a, Enum a, Unbox a)
853+isInfixOf :: (MonadIO m, Eq a, Enum a, Storable a, Unbox a)
853 => SerialT m a -> SerialT m a -> m Bool
854 => SerialT m a -> SerialT m a -> m Bool
854isInfixOf infx stream = do
855isInfixOf infx stream = do
855 arr <- fold A.write infx
856 arr <- fold A.write infx
src/Streamly/Internal/Data/Stream/IsStream/Reduce.hs+4−3
@@ -158,6 +158,7 @@ import Data.Kind (Type)
158import Data.Map (Map)
158import Data.Map (Map)
159import Data.Maybe (isNothing)
159import Data.Maybe (isNothing)
160import Data.Proxy (Proxy(..))
160import Data.Proxy (Proxy(..))
161+import Foreign.Storable (Storable)
161import Streamly.Internal.Control.Concurrent (MonadAsync)
162import Streamly.Internal.Control.Concurrent (MonadAsync)
162import Streamly.Internal.Data.Fold.Type (Fold (..))
163import Streamly.Internal.Data.Fold.Type (Fold (..))
163import Streamly.Internal.Data.IsMap (IsMap(..))
164import Streamly.Internal.Data.IsMap (IsMap(..))
@@ -842,7 +843,7 @@ splitOnAny _subseq _f _m =
842-- /Pre-release/
843-- /Pre-release/
843{-# INLINE splitBySeq #-}
844{-# INLINE splitBySeq #-}
844splitBySeq
845splitBySeq
845− :: (IsStream t, MonadAsync m, Unbox a, Enum a, Eq a)
846+ :: (IsStream t, MonadAsync m, Storable a, Unbox a, Enum a, Eq a)
846 => Array a -> Fold m a b -> t m a -> t m b
847 => Array a -> Fold m a b -> t m a -> t m b
847splitBySeq patt f m =
848splitBySeq patt f m =
848 intersperseM (fold f (A.read patt)) $ splitOnSeq patt f m
849 intersperseM (fold f (A.read patt)) $ splitOnSeq patt f m
@@ -893,7 +894,7 @@ splitBySeq patt f m =
893-- /Pre-release/
894-- /Pre-release/
894{-# INLINE splitOnSuffixSeq #-}
895{-# INLINE splitOnSuffixSeq #-}
895splitOnSuffixSeq
896splitOnSuffixSeq
896− :: (IsStream t, MonadIO m, Unbox a, Enum a, Eq a)
897+ :: (IsStream t, MonadIO m, Storable a, Unbox a, Enum a, Eq a)
897 => Array a -> Fold m a b -> t m a -> t m b
898 => Array a -> Fold m a b -> t m a -> t m b
898splitOnSuffixSeq patt f m =
899splitOnSuffixSeq patt f m =
899 fromStreamD $ D.splitOnSuffixSeq False patt f (toStreamD m)
900 fromStreamD $ D.splitOnSuffixSeq False patt f (toStreamD m)
@@ -945,7 +946,7 @@ wordsOn _subseq _f _m =
945-- /Pre-release/
946-- /Pre-release/
946{-# INLINE splitWithSuffixSeq #-}
947{-# INLINE splitWithSuffixSeq #-}
947splitWithSuffixSeq
948splitWithSuffixSeq
948− :: (IsStream t, MonadIO m, Unbox a, Enum a, Eq a)
949+ :: (IsStream t, MonadIO m, Storable a, Unbox a, Enum a, Eq a)
949 => Array a -> Fold m a b -> t m a -> t m b
950 => Array a -> Fold m a b -> t m a -> t m b
950splitWithSuffixSeq patt f m =
951splitWithSuffixSeq patt f m =
951 fromStreamD $ D.splitOnSuffixSeq True patt f (toStreamD m)
952 fromStreamD $ D.splitOnSuffixSeq True patt f (toStreamD m)
test/Streamly/Test/Prelude/Serial.hs+2−1
@@ -20,6 +20,7 @@ import Data.List (sort, group, intercalate)
20import Data.Maybe ( isJust, fromJust )
20import Data.Maybe ( isJust, fromJust )
21import Data.Word (Word8)
21import Data.Word (Word8)
22import Data.Semigroup (Sum(..), getSum)
22import Data.Semigroup (Sum(..), getSum)
23+import Foreign.Storable (Storable)
23import Streamly.Internal.Data.Unboxed (Unbox)
24import Streamly.Internal.Data.Unboxed (Unbox)
24import Test.Hspec.QuickCheck
25import Test.Hspec.QuickCheck
25import Test.QuickCheck
26import Test.QuickCheck
@@ -111,7 +112,7 @@ splitOnSuffixSeq = do
111 $ IS.splitOnSuffixSeq (A.fromList pat) FL.toList (S.fromList xs)
112 $ IS.splitOnSuffixSeq (A.fromList pat) FL.toList (S.fromList xs)
112
113
113splitterProperties ::
114splitterProperties ::
114− forall a. (Arbitrary a, Eq a, Show a, Unbox a, Enum a)
115+ forall a. (Arbitrary a, Eq a, Show a, Storable a, Unbox a, Enum a)
115 => a
116 => a
116 -> String
117 -> String
117 -> Spec
118 -> Spec