03bfd3f · streamly · git.iko.soy

git.iko.soy/streamly

on master help sign in

Add genericPeekByteIndex and genericPokeByteIndex

03bfd3fHarendra Kumar4 years ago

core/src/Streamly/Internal/Data/Builder.hsnew file+80

compare with master

unifiedsplit

@@ -0,0 +1,80 @@

1+-- |

2+-- Module : Streamly.Internal.Data.Builder

4+-- License : BSD3

5+-- Maintainer : streamly@composewell.com

6+-- Stability : experimental

7+-- Portability : GHC

8+--

9+module Streamly.Internal.Data.Builder

10+ (

11+ -- * Imports

12+ -- $setup

13+

14+ -- * Types

15+ Builder (..)

16+ )

17+where

18+

19+import Control.Applicative (liftA2)

20+

21+------------------------------------------------------------------------------

22+-- The Builder type

23+------------------------------------------------------------------------------

24+

25+-- | A simple stateful function composing monad that chains state passing

26+-- functions. This can be considered as a simplified version of the State monad

27+-- or even a Fold. Unlike fold the step function is one-shot and not called in

28+-- a loop.

29+newtype Builder s m a =

30+ Builder (s -> m (s, a))

31+

32+-- | Maps a function on the output of the fold (the type @b@).

33+instance Functor m => Functor (Builder s m) where

34+ {-# INLINE fmap #-}

35+ fmap f (Builder step1) = Builder (fmap (fmap f) . step1)

36+

37+{-# INLINE fromPure #-}

38+fromPure :: Applicative m => b -> Builder s m b

39+fromPure b = Builder (\s -> pure (s, b))

40+

41+-- | Chain the actions and zip the outputs.

42+{-# INLINE sequenceWith #-}

43+sequenceWith :: Monad m =>

44+ (a -> b -> c) -> Builder x m a -> Builder x m b -> Builder x m c

45+sequenceWith func (Builder stepL) (Builder stepR) = Builder step

46+

47+ where

48+

49+ step s = do

50+ (s1, x) <- stepL s

51+ (s2, y) <- stepR s1

52+ pure (s2, func x y)

53+

54+instance Monad m => Applicative (Builder a m) where

55+ {-# INLINE pure #-}

56+ pure = fromPure

57+

58+ {-# INLINE (<*>) #-}

59+ (<*>) = sequenceWith id

60+

61+ {-# INLINE (*>) #-}

62+ (*>) = sequenceWith (const id)

63+

64+ {-# INLINE liftA2 #-}

65+ liftA2 f x = (<*>) (fmap f x)

66+

67+instance Monad m => Monad (Builder a m) where

68+ {-# INLINE return #-}

69+ return = pure

70+

71+ {-# INLINE (>>=) #-}

72+ (Builder stepL) >>= f = Builder step

73+

74+ where

75+

76+ step s = do

77+ (s1, x) <- stepL s

78+ let Builder stepR = f x

79+ (s2, y) <- stepR s1

80+ pure (s2, y)

core/src/Streamly/Internal/Data/Unboxed.hs+420−1

@@ -1,4 +1,8 @@

1+{-# LANGUAGE DataKinds #-}

1{-# LANGUAGE UnboxedTuples #-}

2{-# LANGUAGE UnboxedTuples #-}

3+{-# LANGUAGE UndecidableInstances #-}

5+-- | TODO: Implement TH based instance derivation for better performance.

3module Streamly.Internal.Data.Unboxed

7module Streamly.Internal.Data.Unboxed

4 ( Unbox(..)

8 ( Unbox(..)

@@ -15,16 +19,37 @@ module Streamly.Internal.Data.Unboxed

15 , newUnpinnedBytes

19 , newUnpinnedBytes

16 , newAlignedPinnedBytes

20 , newAlignedPinnedBytes

17 , nil

21 , nil

22+

23+ -- * Type Parser and Builder

24+ , BoundedPtr (..)

25+

26+ , Peeker (..)

27+ , read

28+ , readUnsafe

29+ , skipByte

30+ , runPeeker

31+

32+ , pokeBoundedPtrUnsafe

33+ , pokeBoundedPtr

34+

35+ -- * Generic Unbox instances

36+ , genericSizeOf

37+ , genericPeekByteIndex

38+ , genericPokeByteIndex

39+

18 ) where

40 ) where

20#include "MachDeps.h"

42#include "MachDeps.h"

22#include "ArrayMacros.h"

44#include "ArrayMacros.h"

46+import Control.Monad (void, when)

24import Data.Complex (Complex((:+)))

47import Data.Complex (Complex((:+)))

25−import Data.Functor ((<&>))

48+import Data.Functor ((<&>), ($>))

26import Data.Functor.Const (Const(..))

49import Data.Functor.Const (Const(..))

27import Data.Functor.Identity (Identity(..))

50import Data.Functor.Identity (Identity(..))

51+import Data.Kind (Type)

52+import Data.Proxy (Proxy (..))

28import Foreign.Ptr (IntPtr(..), WordPtr(..))

53import Foreign.Ptr (IntPtr(..), WordPtr(..))

29import Foreign.Storable (Storable(..))

54import Foreign.Storable (Storable(..))

30import GHC.Base (IO(..))

55import GHC.Base (IO(..))

@@ -36,9 +61,13 @@ import GHC.Word (Word16(..), Word32(..), Word64(..), Word8(..))

36#if MIN_VERSION_base(4,15,0)

61#if MIN_VERSION_base(4,15,0)

37import GHC.RTS.Flags (IoSubSystem(..))

62import GHC.RTS.Flags (IoSubSystem(..))

38#endif

63#endif

64+import Streamly.Internal.Data.Builder (Builder (..))

39import System.IO.Unsafe (unsafePerformIO)

65import System.IO.Unsafe (unsafePerformIO)

67+import GHC.Generics

41import GHC.Exts

68import GHC.Exts

69+import GHC.TypeLits

70+import Prelude hiding (read)

43--------------------------------------------------------------------------------

72--------------------------------------------------------------------------------

44-- The ArrayContents type

73-- The ArrayContents type

@@ -60,6 +89,14 @@ touch :: MutableByteArray a -> IO ()

60touch (MutableByteArray contents) =

89touch (MutableByteArray contents) =

61 IO $ \s -> case touch# contents s of s' -> (# s', () #)

90 IO $ \s -> case touch# contents s of s' -> (# s', () #)

92+-- | Return the size of the array in bytes.

93+{-# INLINE sizeOfMutableByteArray #-}

94+sizeOfMutableByteArray :: MutableByteArray a -> IO Int

95+sizeOfMutableByteArray (MutableByteArray arr) =

96+ IO $ \s ->

97+ case getSizeofMutableByteArray# arr s of

98+ (# s1, i #) -> (# s1, I# i #)

99+

63--------------------------------------------------------------------------------

100--------------------------------------------------------------------------------

64-- Creation

101-- Creation

65--------------------------------------------------------------------------------

102--------------------------------------------------------------------------------

@@ -138,6 +175,12 @@ unpin arr@(MutableByteArray marr#) =

138-- The Unbox type class

175-- The Unbox type class

139--------------------------------------------------------------------------------

176--------------------------------------------------------------------------------

140

177

178+-- XXX Remove dependency on Storable

179+-- XXX Use Proxy type in sizeOf method.

180+-- XXX generate error if the size is < 1

181+-- XXX Remove the phantom parameter from MutableByteArray?

182+-- XXX Rename/remove castContents

183+

141-- In theory we could convert a type to and from a byte stream and use that

184-- In theory we could convert a type to and from a byte stream and use that

142-- to implement boxing, unboxing. But that would be inefficient. This type

185-- to implement boxing, unboxing. But that would be inefficient. This type

143-- class allows each primitive type to have its own specific efficient

186-- class allows each primitive type to have its own specific efficient

@@ -169,6 +212,18 @@ unpin arr@(MutableByteArray marr#) =

169-- size and alignment. We can possibly write tests for checking compatibility

212-- size and alignment. We can possibly write tests for checking compatibility

170-- with Storable.

213-- with Storable.

171

214

215+-- 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:

217+--

218+-- * size is independent of the value, it is determined by the type only. So

219+-- that we can store values of the same type in fixed length array cells.

220+-- * size cannot be zero. So that the length of an array storing the element

221+-- and the number of elements can be related.

222+--

223+-- Note, for general serializable types the size cannot be fixed e.g. we may

224+-- want to serialize a list. This type class can be considered a special case

225+-- of a more general serialization type class.

226+

172-- | A type implementing the 'Unbox' interface supplies operations for reading

227-- | A type implementing the 'Unbox' interface supplies operations for reading

173-- and writing the type from and to a mutable byte array (an unboxed

228-- and writing the type from and to a mutable byte array (an unboxed

174-- representation) in memory. The read operation 'peekByteIndex' constructs the

229-- representation) in memory. The read operation 'peekByteIndex' constructs the

@@ -232,9 +287,15 @@ unpin arr@(MutableByteArray marr#) =

232class Storable a => Unbox a where

287class Storable a => Unbox a where

233 -- | Read an element of type "a" from a MutableByteArray given the byte

288 -- | Read an element of type "a" from a MutableByteArray given the byte

234 -- index.

289 -- index.

290+ --

291+ -- IMPORTANT: The implementation of this interface may not check the bounds

292+ -- of the array, the caller must not assume that.

235 peekByteIndex :: MutableByteArray a -> Int -> IO a

293 peekByteIndex :: MutableByteArray a -> Int -> IO a

236 -- | Write an element of type "a" to a MutableByteArray given the byte

294 -- | Write an element of type "a" to a MutableByteArray given the byte

237 -- index.

295 -- index.

296+ --

297+ -- IMPORTANT: The implementation of this interface may not check the bounds

298+ -- of the array, the caller must not assume that.

238 pokeByteIndex :: MutableByteArray a -> Int -> a -> IO ()

299 pokeByteIndex :: MutableByteArray a -> Int -> a -> IO ()

239

300

240#define DERIVE_UNBOXED(_type, _constructor, _readArray, _writeArray) \

301#define DERIVE_UNBOXED(_type, _constructor, _readArray, _writeArray) \

@@ -361,6 +422,7 @@ DERIVE_BINARY_UNBOX(forall a. Unbox a =>,(Complex a),(:+),a)

361DERIVE_BINARY_UNBOX(forall a. (Integral a, Unbox a) =>,(Ratio a),(:%),a)

422DERIVE_BINARY_UNBOX(forall a. (Integral a, Unbox a) =>,(Ratio a),(:%),a)

362DERIVE_BINARY_UNBOX(,Fingerprint,Fingerprint,Word64)

423DERIVE_BINARY_UNBOX(,Fingerprint,Fingerprint,Word64)

363

424

425+-- XXX This should have a size 1.

364instance Unbox () where

426instance Unbox () where

365

427

366 {-# INLINE peekByteIndex #-}

428 {-# INLINE peekByteIndex #-}

@@ -403,3 +465,360 @@ peekWith = peekByteIndex

403{-# INLINE pokeWith #-}

465{-# INLINE pokeWith #-}

404pokeWith :: Unbox a => MutableByteArray a -> Int -> a -> IO ()

466pokeWith :: Unbox a => MutableByteArray a -> Int -> a -> IO ()

405pokeWith = pokeByteIndex

467pokeWith = pokeByteIndex

468+

469+--------------------------------------------------------------------------------

470+-- Generic deriving

471+--------------------------------------------------------------------------------

472+

473+-- Utilities to build or parse a type safely and easily.

474+

475+-- | A location inside a mutable byte array with the bound of the array. Is it

476+-- cheaper to just get the bound using the size of the array whenever needed?

477+data BoundedPtr =

478+ BoundedPtr

479+ (MutableByteArray Word8) -- byte array

480+ Int -- current pos

481+ Int -- position after end

482+

483+--------------------------------------------------------------------------------

484+-- Peeker monad

485+--------------------------------------------------------------------------------

486+

487+-- | Chains peek functions that pass the current position to the next function

488+newtype Peeker a = Peeker (Builder BoundedPtr IO a)

489+ deriving (Functor, Applicative, Monad)

490+

491+{-# INLINE readUnsafe #-}

492+readUnsafe :: Unbox a => Peeker a

493+readUnsafe = Peeker (Builder step)

494+

495+ where

496+

497+ {-# INLINE step #-}

498+ step :: forall a. Unbox a => BoundedPtr -> IO (BoundedPtr, a)

499+ step (BoundedPtr arr pos end) = do

500+ let next = pos + sizeOf (undefined :: a)

501+ r <- peekByteIndex (castContents arr) pos

502+ return (BoundedPtr arr next end, r)

503+

504+{-# INLINE read #-}

505+read :: Unbox a => Peeker a

506+read = Peeker (Builder step)

507+

508+ where

509+

510+ {-# INLINE step #-}

511+ step :: forall a. Unbox a => BoundedPtr -> IO (BoundedPtr, a)

512+ step (BoundedPtr arr pos end) = do

513+ let next = pos + sizeOf (undefined :: a)

514+ when (next > end) $ error "peekObject reading beyond limit"

515+ r <- peekByteIndex (castContents arr) pos

516+ return (BoundedPtr arr next end, r)

517+

518+{-# INLINE skipByte #-}

519+skipByte :: Peeker ()

520+skipByte = Peeker (Builder step)

521+

522+ where

523+

524+ {-# INLINE step #-}

525+ step :: BoundedPtr -> IO (BoundedPtr, ())

526+ step (BoundedPtr arr pos end) = do

527+ let next = pos + 1

528+ when (next > end) $ error "skipByte: reading beyond limit"

529+ return (BoundedPtr arr next end, ())

530+

531+{-# INLINE runPeeker #-}

532+runPeeker :: Peeker a -> BoundedPtr -> IO a

533+runPeeker (Peeker (Builder f)) ptr = fmap snd (f ptr)

534+

535+--------------------------------------------------------------------------------

536+-- Poke utilities

537+--------------------------------------------------------------------------------

538+

539+-- XXX Using a Poker monad may be useful when we have to compute the size to be

540+-- poked as we go and then poke the size at a previous location. For variable

541+-- sized object serialization we may also want to reallocate the array and

542+-- return the newly allocated array in the output.

543+

544+-- Does not check writing beyond bound.

545+{-# INLINE pokeBoundedPtrUnsafe #-}

546+pokeBoundedPtrUnsafe :: Unbox a => a -> BoundedPtr -> IO BoundedPtr

547+pokeBoundedPtrUnsafe a (BoundedPtr arr pos end) = do

548+ let next = pos + sizeOf a

549+ pokeByteIndex (castContents arr) pos a

550+ return (BoundedPtr arr next end)

551+

552+{-# INLINE pokeBoundedPtr #-}

553+pokeBoundedPtr :: Unbox a => a -> BoundedPtr -> IO BoundedPtr

554+pokeBoundedPtr a (BoundedPtr arr pos end) = do

555+ let next = pos + sizeOf a

556+ when (next > end) $ error "pokeBoundedPtr writing beyond limit"

557+ pokeByteIndex (castContents arr) pos a

558+ return (BoundedPtr arr next end)

559+

560+--------------------------------------------------------------------------------

561+-- Check the number of constructors in a sum type

562+--------------------------------------------------------------------------------

563+

564+-- Count the constructors of a sum type.

565+type family SumArity (a :: Type -> Type) :: Nat where

566+ SumArity (C1 _ _) = 1

567+ -- Requires UndecidableInstances

568+ SumArity (f :+: g) = SumArity f + SumArity g

569+

570+type family TypeErrorMessage (a :: Symbol) :: Constraint where

571+ TypeErrorMessage a = TypeError ('Text a)

572+

573+type family ArityCheck (b :: Bool) :: Constraint where

574+ ArityCheck 'True = ()

575+ ArityCheck 'False = TypeErrorMessage

576+ "Generic Unbox deriving does not support > 256 constructors."

577+

578+-- Type constraint to restrict the sum type arity so that the constructor tag

579+-- can fit in a single byte.

580+type MaxArity256 n = ArityCheck (n <=? 255)

581+

582+--------------------------------------------------------------------------------

583+-- Generic Deriving of Unbox instance

584+--------------------------------------------------------------------------------

585+

586+-- Unbox uses fixed size encoding, therefore, when a (sum) type has multiple

587+-- constructors, the size of the type is computed as the maximum required by

588+-- any constructor. Therefore, size is independent of the value, it can be

589+-- determined solely by the type.

590+

591+-- | Implementation of sizeOf that works on the generic representation of an

592+-- ADT.

593+class SizeOfRep (f :: Type -> Type) where

594+ sizeOfRep :: f x -> Int

595+

596+-- Meta information wrapper, go inside

597+instance SizeOfRep f => SizeOfRep (M1 i c f) where

598+ {-# INLINE sizeOfRep #-}

599+ sizeOfRep _ = sizeOfRep (undefined :: f x)

600+

601+-- Primitive type "a".

602+instance Unbox a => SizeOfRep (K1 i a) where

603+ {-# INLINE sizeOfRep #-}

604+ sizeOfRep _ = sizeOf (undefined :: a)

605+

606+-- Void: data type without constructors. Values of this type cannot exist,

607+-- therefore the size is undefined. We should never be serializing structures

608+-- with elements of this type.

609+instance SizeOfRep V1 where

610+ {-# INLINE sizeOfRep #-}

611+ sizeOfRep = error "sizeOfRep: a value of a Void type must not exist"

612+

613+-- Unit: constructors without arguments.

614+-- Theoretically the size can be 0, but we use 1 to simplify the implementation

615+-- of an array of unit type elements. With a non-zero size we can count the number

616+-- of elements in the array based on the size of the array. Otherwise we will

617+-- have to store a virtual length in the array, but keep the physical size of

618+-- the array as 0. Or we will have to make a special handling for zero sized

619+-- elements to make the size as 1. Or we can disallow arrays with elements

620+-- having size 0.

621+--

622+-- Note that when a sum type has many unit constructors only a single byte is

623+-- required to encode the type as only the constructor tag is stored.

624+instance SizeOfRep U1 where

625+ {-# INLINE sizeOfRep #-}

626+ sizeOfRep _ = 1

627+

628+-- Product type

629+instance (SizeOfRep f, SizeOfRep g) => SizeOfRep (f :*: g) where

630+ {-# INLINE sizeOfRep #-}

631+ sizeOfRep _ = sizeOfRep (undefined :: f x) + sizeOfRep (undefined :: g x)

632+

633+-------------------------------------------------------------------------------

634+

635+class SizeOfRepSum (f :: Type -> Type) where

636+ sizeOfRepSum :: f x -> Int

637+

638+-- Constructor

639+instance SizeOfRep a => SizeOfRepSum (C1 c a) where

640+ {-# INLINE sizeOfRepSum #-}

641+ sizeOfRepSum = sizeOfRep

642+

643+instance (SizeOfRepSum f, SizeOfRepSum g) => SizeOfRepSum (f :+: g) where

644+ {-# INLINE sizeOfRepSum #-}

645+ sizeOfRepSum _ =

646+ max (sizeOfRepSum (undefined :: f x)) (sizeOfRepSum (undefined :: g x))

647+

648+-------------------------------------------------------------------------------

649+

650+instance (MaxArity256 (SumArity (f :+: g)), SizeOfRepSum f, SizeOfRepSum g) =>

651+ SizeOfRep (f :+: g) where

652+

653+ -- The size of a sum type is the max of any of the constructor size.

654+ -- sizeOfRepSum type class operation is used here instead of sizeOfRep so

655+ -- that we add the constructor index byte only for the first time and avoid

656+ -- including it for the subsequent sum constructors.

657+ {-# INLINE sizeOfRep #-}

658+ sizeOfRep _ =

659+ -- One byte for the constructor id and then the constructor value.

660+ sizeOf (undefined :: Word8) +

661+ max (sizeOfRepSum (undefined :: f x))

662+ (sizeOfRepSum (undefined :: g x))

663+

664+{-# INLINE genericSizeOf #-}

665+genericSizeOf :: forall a. (SizeOfRep (Rep a)) => Proxy a -> Int

666+genericSizeOf _ = sizeOfRep (undefined :: Rep a x)

667+

668+--------------------------------------------------------------------------------

669+-- Generic poke

670+--------------------------------------------------------------------------------

671+

672+class PokeRep (f :: Type -> Type) where

673+ pokeRep :: f a -> BoundedPtr -> IO BoundedPtr

674+

675+instance PokeRep f => PokeRep (M1 i c f) where

676+ {-# INLINE pokeRep #-}

677+ pokeRep f = pokeRep (unM1 f)

678+

679+instance Unbox a => PokeRep (K1 i a) where

680+ {-# INLINE pokeRep #-}

681+ pokeRep a = pokeBoundedPtr (unK1 a)

682+

683+instance PokeRep V1 where

684+ {-# INLINE pokeRep #-}

685+ pokeRep = error "pokeRep: a value of a Void type should not exist"

686+

687+instance PokeRep U1 where

688+ {-# INLINE pokeRep #-}

689+ -- XXX Can we use sizeof U1 to determine the size?

690+ pokeRep _ (BoundedPtr arr pos end) =

691+ return (BoundedPtr arr (pos + 1) end)

692+

693+instance (PokeRep f, PokeRep g) => PokeRep (f :*: g) where

694+ {-# INLINE pokeRep #-}

695+ pokeRep (f :*: g) ptr = pokeRep f ptr >>= pokeRep g

696+

697+-------------------------------------------------------------------------------

698+

699+class KnownNat n => PokeRepSum (n :: Nat) (f :: Type -> Type) where

700+ -- "n" is the constructor tag to be poked.

701+ pokeRepSum :: Proxy n -> f a -> BoundedPtr -> IO BoundedPtr

702+

703+instance (KnownNat n, PokeRep a) => PokeRepSum n (C1 c a) where

704+ {-# INLINE pokeRepSum #-}

705+ pokeRepSum _ x ptr = do

706+ pokeBoundedPtr (fromInteger (natVal (Proxy :: Proxy n)) :: Word8) ptr

707+ >>= pokeRep x

708+

709+instance (KnownNat n, PokeRepSum n f, PokeRepSum (n + SumArity f) g)

710+ => PokeRepSum n (f :+: g) where

711+ {-# INLINE pokeRepSum #-}

712+ pokeRepSum _ (L1 x) ptr =

713+ pokeRepSum (Proxy :: Proxy n) x ptr

714+ pokeRepSum _ (R1 x) ptr =

715+ pokeRepSum (Proxy :: Proxy (n + SumArity f)) x ptr

716+

717+-------------------------------------------------------------------------------

718+

719+instance (MaxArity256 (SumArity (f :+: g)), PokeRepSum 0 (f :+: g)) =>

720+ PokeRep (f :+: g) where

721+

722+ {-# INLINE pokeRep #-}

723+ pokeRep = pokeRepSum (Proxy :: Proxy 0)

724+

725+{-# INLINE genericPokeObject #-}

726+genericPokeObject :: (Generic a, PokeRep (Rep a)) =>

727+ a -> BoundedPtr -> IO BoundedPtr

728+genericPokeObject a = pokeRep (from a)

729+

730+genericPokeObj :: (Generic a, PokeRep (Rep a)) => a -> BoundedPtr -> IO ()

731+genericPokeObj a ptr = void $ genericPokeObject a ptr

732+

733+{-# INLINE genericPokeByteIndex #-}

734+genericPokeByteIndex :: (Generic a, PokeRep (Rep a)) =>

735+ MutableByteArray a -> Int -> a -> IO ()

736+genericPokeByteIndex arr index x = do

737+ -- XXX Should we use unsafe poke?

738+ end <- sizeOfMutableByteArray arr

739+ genericPokeObj x (BoundedPtr (castContents arr) index end)

740+

741+--------------------------------------------------------------------------------

742+-- Generic peek

743+--------------------------------------------------------------------------------

744+

745+class PeekRep (f :: Type -> Type) where

746+ peekRep :: Peeker (f x)

747+

748+instance PeekRep f => PeekRep (M1 i c f) where

749+ {-# INLINE peekRep #-}

750+ peekRep = fmap M1 peekRep

751+

752+instance Unbox a => PeekRep (K1 i a) where

753+ {-# INLINE peekRep #-}

754+ peekRep = fmap K1 read

755+

756+instance PeekRep V1 where

757+ {-# INLINE peekRep #-}

758+ peekRep = error "peekRep: a value of a Void type should not exist"

759+

760+instance PeekRep U1 where

761+ {-# INLINE peekRep #-}

762+ peekRep = skipByte $> U1

763+

764+instance (PeekRep f, PeekRep g) => PeekRep (f :*: g) where

765+ {-# INLINE peekRep #-}

766+ peekRep = (:*:) <$> peekRep <*> peekRep

767+

768+-------------------------------------------------------------------------------

769+

770+class KnownNat n => PeekRepSum (n :: Nat) (f :: Type -> Type) where

771+ -- "n" is the constructor tag to be matched.

772+ peekRepSum :: Proxy n -> Word8 -> Peeker (f a)

773+

774+instance (KnownNat n, PeekRep a) => PeekRepSum n (C1 c a) where

775+ {-# INLINE peekRepSum #-}

776+ peekRepSum _ tag

777+ | tag == curTag = peekRep

778+ | tag > curTag =

779+ error $ "Unbox instance peek: Constructor tag index "

780+ ++ show tag ++ " out of range, max tag index is "

781+ ++ show curTag

782+ | otherwise = error "peekRepSum: bug"

783+

784+ where

785+

786+ curTag = fromInteger (natVal (Proxy :: Proxy n))

787+

788+instance (KnownNat n, PeekRepSum n f, PeekRepSum (n + SumArity f) g)

789+ => PeekRepSum n (f :+: g) where

790+ {-# INLINE peekRepSum #-}

791+ peekRepSum curProxy tag

792+ | tag < firstRightTag =

793+ L1 <$> peekRepSum curProxy tag

794+ | otherwise =

795+ R1 <$> peekRepSum (Proxy :: Proxy (n + SumArity f)) tag

796+

797+ where

798+

799+ firstRightTag = fromInteger (natVal (Proxy :: Proxy (n + SumArity f)))

800+

801+-------------------------------------------------------------------------------

802+

803+instance (MaxArity256 (SumArity (f :+: g)), PeekRepSum 0 (f :+: g))

804+ => PeekRep (f :+: g) where

805+ {-# INLINE peekRep #-}

806+ peekRep = do

807+ tag <- read

808+ peekRepSum (Proxy :: Proxy 0) tag

809+

810+{-# INLINE genericPeeker #-}

811+genericPeeker :: (Generic a, PeekRep (Rep a)) => Peeker a

812+genericPeeker = to <$> peekRep

813+

814+{-# INLINE genericPeekBoundedPtr #-}

815+genericPeekBoundedPtr :: (Generic a, PeekRep (Rep a)) => BoundedPtr -> IO a

816+genericPeekBoundedPtr = runPeeker genericPeeker

817+

818+{-# INLINE genericPeekByteIndex #-}

819+genericPeekByteIndex :: (Generic a, PeekRep (Rep a)) =>

820+ MutableByteArray a -> Int -> IO a

821+genericPeekByteIndex arr index = do

822+ -- XXX Should we use unsafe peek?

823+ end <- sizeOfMutableByteArray arr

824+ genericPeekBoundedPtr (BoundedPtr (castContents arr) index end)

core/streamly-core.cabal+1

@@ -301,6 +301,7 @@ library

301 , Streamly.Internal.Data.Parser.ParserD

302

303 -- streamly-core-data

304+ , Streamly.Internal.Data.Builder

304 , Streamly.Internal.Data.Unfold

305 , Streamly.Internal.Data.Unfold

305 , Streamly.Internal.Data.Unfold.Enumeration

306 , Streamly.Internal.Data.Unfold.Enumeration

306 , Streamly.Internal.Data.Fold.Tee

307 , Streamly.Internal.Data.Fold.Tee