@@ -6,10 +6,8 @@
66
77module Streamly.Internal.Data.Unboxed
88 ( Unbox(..)
9− , alignment
109 , peekWith
1110 , pokeWith
12− , sizeOf
1311 , MutableByteArray(..)
1412 , castContents
1513 , touch
@@ -17,6 +15,7 @@ module Streamly.Internal.Data.Unboxed
1715 , pin
1816 , unpin
1917 , newUnpinnedBytes
18+ , newPinnedBytes
2019 , newAlignedPinnedBytes
2120 , nil
2221
@@ -40,7 +39,6 @@ module Streamly.Internal.Data.Unboxed
4039 ) where
4140
4241#include "MachDeps.h"
43−
4442#include "ArrayMacros.h"
4543
4644import Control.Monad (void, when)
@@ -51,7 +49,6 @@ import Data.Functor.Identity (Identity(..))
5149import Data.Kind (Type)
5250import Data.Proxy (Proxy (..))
5351import Foreign.Ptr (IntPtr(..), WordPtr(..))
54−import Foreign.Storable (Storable(..))
5552import GHC.Base (IO(..))
5653import GHC.Fingerprint.Type (Fingerprint(..))
5754import GHC.Int (Int16(..), Int32(..), Int64(..), Int8(..))
@@ -115,6 +112,16 @@ newUnpinnedBytes (I# nbytes) = IO $ \s ->
115112 let c = MutableByteArray mbarr#
116113 in (# s', c #)
117114
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+
118125{-# INLINE newAlignedPinnedBytes #-}
119126newAlignedPinnedBytes :: Int -> Int -> IO (MutableByteArray a)
120127newAlignedPinnedBytes nbytes _align | nbytes < 0 =
@@ -175,7 +182,6 @@ unpin arr@(MutableByteArray marr#) =
175182-- The Unbox type class
176183--------------------------------------------------------------------------------
177184
178−-- XXX Remove dependency on Storable
179185-- XXX Use Proxy type in sizeOf method.
180186-- XXX generate error if the size is < 1
181187-- XXX Remove the phantom parameter from MutableByteArray?
@@ -208,9 +214,6 @@ unpin arr@(MutableByteArray marr#) =
208214-- anymore, see
209215-- https://lemire.me/blog/2012/05/31/data-alignment-for-speed-myth-or-reality/
210216--
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.
214217
215218-- The main goal of the Unbox type class is to be used in arrays. Invariants
216219-- for the sizeOf value required for use in arrays:
@@ -230,16 +233,6 @@ unpin arr@(MutableByteArray marr#) =
230233-- boxed type from the mutable byte array. The write operation 'pokeByteIndex'
231234-- writes the boxed type to the mutable byte array.
232235--
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−--
243236-- Here is an example, to write an instance for this type class.
244237--
245238-- >>> :{
@@ -249,30 +242,11 @@ unpin arr@(MutableByteArray marr#) =
249242-- }
250243-- :}
251244--
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−--
272245-- >>> import Streamly.Data.Array (Unbox(..))
273246-- >>> import Streamly.Internal.Data.Unboxed (castContents)
274247-- >>> :{
275248-- instance Unbox Object where
249+-- sizeOf _ = 16
276250-- peekByteIndex arr i = do
277251-- let p = castContents arr
278252-- x0 <- peekByteIndex p i
@@ -284,7 +258,9 @@ unpin arr@(MutableByteArray marr#) =
284258-- pokeByteIndex p (i + 8) x1
285259-- :}
286260--
287−class Storable a => Unbox a where
261+class Unbox a where
262+ -- | Get the size.
263+ sizeOf :: a -> Int
288264 -- | Read an element of type "a" from a MutableByteArray given the byte
289265 -- index.
290266 --
@@ -298,7 +274,7 @@ class Storable a => Unbox a where
298274 -- of the array, the caller must not assume that.
299275 pokeByteIndex :: MutableByteArray a -> Int -> a -> IO ()
300276
301−#define DERIVE_UNBOXED(_type, _constructor, _readArray, _writeArray) \
277+#define DERIVE_UNBOXED(_type, _constructor, _readArray, _writeArray, _sizeOf) \
302278instance Unbox _type where { \
303279; {-# INLINE peekByteIndex #-} \
304280; peekByteIndex (MutableByteArray mbarr) (I# n) = IO $ \s -> \
@@ -307,14 +283,18 @@ instance Unbox _type where { \
307283; {-# INLINE pokeByteIndex #-} \
308284; pokeByteIndex (MutableByteArray mbarr) (I# n) (_constructor val) = \
309285 IO $ \s -> (# _writeArray mbarr n val s, () #) \
286+; {-# INLINE sizeOf #-} \
287+; sizeOf _ = _sizeOf \
310288}
311289
312−#define DERIVE_WRAPPED_UNBOX(_constraint, _type, _constructor) \
313−instance _constraint Unbox _type where \
314−; {-# INLINE peekByteIndex #-} \
315−; peekByteIndex arr i = _constructor <$> peekByteIndex (castContents arr) i \
316−; {-# INLINE pokeByteIndex #-} \
317−; pokeByteIndex arr i (_constructor a) = pokeByteIndex (castContents arr) i a
290+#define DERIVE_WRAPPED_UNBOX(_constraint, _type, _constructor, _innerType) \
291+instance _constraint Unbox _type where \
292+; {-# INLINE peekByteIndex #-} \
293+; peekByteIndex arr i = _constructor <$> peekByteIndex (castContents arr) i \
294+; {-# INLINE pokeByteIndex #-} \
295+; pokeByteIndex arr i (_constructor a) = pokeByteIndex (castContents arr) i a \
296+; {-# INLINE sizeOf #-} \
297+; sizeOf _ = SIZE_OF(_innerType)
318298
319299#define DERIVE_BINARY_UNBOX(_constraint, _type, _constructor, _innerType) \
320300instance _constraint Unbox _type where { \
@@ -329,100 +309,117 @@ instance _constraint Unbox _type where { \
329309 let contents = castContents arr :: MutableByteArray _innerType \
330310 in pokeByteIndex contents i p1 >> \
331311 pokeByteIndex contents (i + SIZE_OF(_innerType)) p2 \
312+; {-# INLINE sizeOf #-} \
313+; sizeOf _ = 2 * SIZE_OF(_innerType) \
332314}
333315
334316DERIVE_UNBOXED( Char
335317 , C#
336318 , readWord8ArrayAsWideChar#
337− , writeWord8ArrayAsWideChar#)
319+ , writeWord8ArrayAsWideChar#
320+ , SIZEOF_HSCHAR)
338321
339322DERIVE_UNBOXED( Int8
340323 , I8#
341324 , readInt8Array#
342− , writeInt8Array#)
325+ , writeInt8Array#
326+ , 1)
343327
344328DERIVE_UNBOXED( Int16
345329 , I16#
346330 , readWord8ArrayAsInt16#
347− , writeWord8ArrayAsInt16#)
331+ , writeWord8ArrayAsInt16#
332+ , 2)
348333
349334DERIVE_UNBOXED( Int32
350335 , I32#
351336 , readWord8ArrayAsInt32#
352− , writeWord8ArrayAsInt32#)
337+ , writeWord8ArrayAsInt32#
338+ , 4)
353339
354340DERIVE_UNBOXED( Int
355341 , I#
356342 , readWord8ArrayAsInt#
357− , writeWord8ArrayAsInt#)
343+ , writeWord8ArrayAsInt#
344+ , SIZEOF_HSINT)
358345
359346DERIVE_UNBOXED( Int64
360347 , I64#
361348 , readWord8ArrayAsInt64#
362− , writeWord8ArrayAsInt64#)
349+ , writeWord8ArrayAsInt64#
350+ , 8)
363351
364352DERIVE_UNBOXED( Word
365353 , W#
366354 , readWord8ArrayAsWord#
367− , writeWord8ArrayAsWord#)
355+ , writeWord8ArrayAsWord#
356+ , SIZEOF_HSWORD)
368357
369358DERIVE_UNBOXED( Word8
370359 , W8#
371360 , readWord8Array#
372− , writeWord8Array#)
361+ , writeWord8Array#
362+ , 1)
373363
374364DERIVE_UNBOXED( Word16
375365 , W16#
376366 , readWord8ArrayAsWord16#
377− , writeWord8ArrayAsWord16#)
367+ , writeWord8ArrayAsWord16#
368+ , 2)
378369
379370DERIVE_UNBOXED( Word32
380371 , W32#
381372 , readWord8ArrayAsWord32#
382− , writeWord8ArrayAsWord32#)
373+ , writeWord8ArrayAsWord32#
374+ , 4)
383375
384376DERIVE_UNBOXED( Word64
385377 , W64#
386378 , readWord8ArrayAsWord64#
387− , writeWord8ArrayAsWord64#)
379+ , writeWord8ArrayAsWord64#
380+ , 8)
388381
389382DERIVE_UNBOXED( Double
390383 , D#
391384 , readWord8ArrayAsDouble#
392− , writeWord8ArrayAsDouble#)
385+ , writeWord8ArrayAsDouble#
386+ , SIZEOF_HSDOUBLE)
393387
394388DERIVE_UNBOXED( Float
395389 , F#
396390 , readWord8ArrayAsFloat#
397− , writeWord8ArrayAsFloat#)
391+ , writeWord8ArrayAsFloat#
392+ , SIZEOF_HSFLOAT)
398393
399394DERIVE_UNBOXED( (StablePtr a)
400395 , StablePtr
401396 , readWord8ArrayAsStablePtr#
402− , writeWord8ArrayAsStablePtr#)
397+ , writeWord8ArrayAsStablePtr#
398+ , SIZEOF_HSSTABLEPTR)
403399
404400DERIVE_UNBOXED( (Ptr a)
405401 , Ptr
406402 , readWord8ArrayAsAddr#
407− , writeWord8ArrayAsAddr#)
403+ , writeWord8ArrayAsAddr#
404+ , SIZEOF_HSPTR)
408405
409406DERIVE_UNBOXED( (FunPtr a)
410407 , FunPtr
411408 , readWord8ArrayAsAddr#
412− , writeWord8ArrayAsAddr#)
409+ , writeWord8ArrayAsAddr#
410+ , SIZEOF_HSFUNPTR)
413411
414−DERIVE_WRAPPED_UNBOX(,IntPtr,IntPtr)
415−DERIVE_WRAPPED_UNBOX(,WordPtr,WordPtr)
416−DERIVE_WRAPPED_UNBOX(Unbox a =>,(Identity a),Identity)
412+DERIVE_WRAPPED_UNBOX(,IntPtr,IntPtr,Int)
413+DERIVE_WRAPPED_UNBOX(,WordPtr,WordPtr,Word)
414+DERIVE_WRAPPED_UNBOX(Unbox a =>,(Identity a),Identity,a)
417415#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)
419417#endif
420−DERIVE_WRAPPED_UNBOX(Unbox a =>,(Const a b),Const)
418+DERIVE_WRAPPED_UNBOX(Unbox a =>,(Const a b),Const,a)
421419DERIVE_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)
423421DERIVE_BINARY_UNBOX(,Fingerprint,Fingerprint,Word64)
424422
425−-- XXX This should have a size 1.
426423instance Unbox () where
427424
428425 {-# INLINE peekByteIndex #-}
@@ -431,6 +428,9 @@ instance Unbox () where
431428 {-# INLINE pokeByteIndex #-}
432429 pokeByteIndex _ _ _ = return ()
433430
431+ {-# INLINE sizeOf #-}
432+ sizeOf _ = 1
433+
434434#if MIN_VERSION_base(4,15,0)
435435instance Unbox IoSubSystem where
436436
@@ -439,6 +439,9 @@ instance Unbox IoSubSystem where
439439
440440 {-# INLINE pokeByteIndex #-}
441441 pokeByteIndex arr i a = pokeByteIndex (castContents arr) i (fromEnum a)
442+
443+ {-# INLINE sizeOf #-}
444+ sizeOf = sizeOf . fromEnum
442445#endif
443446
444447instance Unbox Bool where
@@ -446,13 +449,16 @@ instance Unbox Bool where
446449 {-# INLINE peekByteIndex #-}
447450 peekByteIndex arr i = do
448451 res <- peekByteIndex (castContents arr) i
449− return $ res /= (0 :: Int32)
452+ return $ res /= (0 :: Int8)
450453
451454 {-# INLINE pokeByteIndex #-}
452455 pokeByteIndex arr i a =
453456 if a
454− then pokeByteIndex (castContents arr) i (1 :: Int32)
455− else pokeByteIndex (castContents arr) i (0 :: Int32)
457+ then pokeByteIndex (castContents arr) i (1 :: Int8)
458+ else pokeByteIndex (castContents arr) i (0 :: Int8)
459+
460+ {-# INLINE sizeOf #-}
461+ sizeOf _ = 1
456462
457463--------------------------------------------------------------------------------
458464-- Functions