f961715 · streamly · git.iko.soy

254-- >>> :{

255-- instance Unbox Object where

256-- sizeOf _ = 16

257−-- peekByteIndex arr i = do

257+-- peekByteIndex i arr = do

258-- let p = castContents arr

259−-- x0 <- peekByteIndex p i

259+-- x0 <- peekByteIndex i p

260−-- x1 <- peekByteIndex p (i + 8)

260+-- x1 <- peekByteIndex (i + 8) p

261-- return $ Object x0 x1

262−-- pokeByteIndex arr i (Object x0 x1) = do

262+-- pokeByteIndex i arr (Object x0 x1) = do

263-- let p = castContents arr

264−-- pokeByteIndex p i x0

264+-- pokeByteIndex i p x0

265−-- pokeByteIndex p (i + 8) x1

265+-- pokeByteIndex (i + 8) p x1

266-- :}

267--

268class Unbox a where

277 --

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

279 -- of the array, the caller must not assume that.

280− peekByteIndex :: MutableByteArray a -> Int -> IO a

280+ peekByteIndex :: Int -> MutableByteArray a -> IO a

281

282 default peekByteIndex :: (Generic a, PeekRep (Rep a)) =>

283− MutableByteArray a -> Int -> IO a

283+ Int -> MutableByteArray a -> IO a

284− peekByteIndex = genericPeekByteIndex

284+ peekByteIndex i arr = genericPeekByteIndex arr i

285

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

287 -- index.

288 --

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

290 -- of the array, the caller must not assume that.

291− pokeByteIndex :: MutableByteArray a -> Int -> a -> IO ()

291+ pokeByteIndex :: Int -> MutableByteArray a -> a -> IO ()

292

293 default pokeByteIndex :: (Generic a, PokeRep (Rep a)) =>

294− MutableByteArray a -> Int -> a -> IO ()

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

295− pokeByteIndex = genericPokeByteIndex

295+ pokeByteIndex i arr = genericPokeByteIndex arr i

296

297#define DERIVE_UNBOXED(_type, _constructor, _readArray, _writeArray, _sizeOf) \

298instance Unbox _type where { \

299; {-# INLINE peekByteIndex #-} \

300−; peekByteIndex (MutableByteArray mbarr) (I# n) = IO $ \s -> \

300+; peekByteIndex (I# n) (MutableByteArray mbarr) = IO $ \s -> \

301 case _readArray mbarr n s of \

302 { (# s1, i #) -> (# s1, _constructor i #) } \

303; {-# INLINE pokeByteIndex #-} \

304−; pokeByteIndex (MutableByteArray mbarr) (I# n) (_constructor val) = \

304+; pokeByteIndex (I# n) (MutableByteArray mbarr) (_constructor val) = \

305 IO $ \s -> (# _writeArray mbarr n val s, () #) \

306; {-# INLINE sizeOf #-} \

307; sizeOf _ = _sizeOf \

310#define DERIVE_WRAPPED_UNBOX(_constraint, _type, _constructor, _innerType) \

311instance _constraint Unbox _type where \

312; {-# INLINE peekByteIndex #-} \

313−; peekByteIndex arr i = _constructor <$> peekByteIndex (castContents arr) i \

313+; peekByteIndex i arr = _constructor <$> peekByteIndex i (castContents arr) \

314; {-# INLINE pokeByteIndex #-} \

315−; pokeByteIndex arr i (_constructor a) = pokeByteIndex (castContents arr) i a \

315+; pokeByteIndex i arr (_constructor a) = pokeByteIndex i (castContents arr) a \

316; {-# INLINE sizeOf #-} \

317; sizeOf _ = SIZE_OF(_innerType)

318

319#define DERIVE_BINARY_UNBOX(_constraint, _type, _constructor, _innerType) \

320instance _constraint Unbox _type where { \

321; {-# INLINE peekByteIndex #-} \

322−; peekByteIndex arr i = \

322+; peekByteIndex i arr = \

323 let contents = castContents arr :: MutableByteArray _innerType \

324− in peekByteIndex contents i >>= \

324+ in peekByteIndex i contents >>= \

325− (\p1 -> peekByteIndex contents (i + SIZE_OF(_innerType)) \

325+ (\p1 -> peekByteIndex (i + SIZE_OF(_innerType)) contents \

326 <&> _constructor p1) \

327; {-# INLINE pokeByteIndex #-} \

328−; pokeByteIndex arr i (_constructor p1 p2) = \

328+; pokeByteIndex i arr (_constructor p1 p2) = \

329 let contents = castContents arr :: MutableByteArray _innerType \

330− in pokeByteIndex contents i p1 >> \

330+ in pokeByteIndex i contents p1 >> \

331− pokeByteIndex contents (i + SIZE_OF(_innerType)) p2 \

331+ pokeByteIndex (i + SIZE_OF(_innerType)) contents p2 \

332; {-# INLINE sizeOf #-} \

333; sizeOf _ = 2 * SIZE_OF(_innerType) \

334}

455instance Unbox IoSubSystem where

456

457 {-# INLINE peekByteIndex #-}

458− peekByteIndex arr i = toEnum <$> peekByteIndex (castContents arr) i

458+ peekByteIndex i arr = toEnum <$> peekByteIndex i (castContents arr)

459

460 {-# INLINE pokeByteIndex #-}

461− pokeByteIndex arr i a = pokeByteIndex (castContents arr) i (fromEnum a)

461+ pokeByteIndex i arr a = pokeByteIndex i (castContents arr) (fromEnum a)

462

463 {-# INLINE sizeOf #-}

464 sizeOf = sizeOf . fromEnum

467instance Unbox Bool where

468

469 {-# INLINE peekByteIndex #-}

470− peekByteIndex arr i = do

470+ peekByteIndex i arr = do

471− res <- peekByteIndex (castContents arr) i

471+ res <- peekByteIndex i (castContents arr)

472 return $ res /= (0 :: Int8)

473

474 {-# INLINE pokeByteIndex #-}

475− pokeByteIndex arr i a =

475+ pokeByteIndex i arr a =

476 if a

477− then pokeByteIndex (castContents arr) i (1 :: Int8)

477+ then pokeByteIndex i (castContents arr) (1 :: Int8)

478− else pokeByteIndex (castContents arr) i (0 :: Int8)

478+ else pokeByteIndex i (castContents arr) (0 :: Int8)

479

480 {-# INLINE sizeOf #-}

481 sizeOf _ = 1

486

487{-# INLINE peekWith #-}

488peekWith :: Unbox a => MutableByteArray a -> Int -> IO a

489−peekWith = peekByteIndex

489+peekWith arr i = peekByteIndex i arr

490

491{-# INLINE pokeWith #-}

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

493−pokeWith = pokeByteIndex

493+pokeWith arr i = pokeByteIndex i arr

494

495--------------------------------------------------------------------------------

496-- Generic deriving

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

525 step (BoundedPtr arr pos end) = do

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

527− r <- peekByteIndex (castContents arr) pos

527+ r <- peekByteIndex pos (castContents arr)

528 return (BoundedPtr arr next end, r)

529

530{-# INLINE read #-}

538 step (BoundedPtr arr pos end) = do

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

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

541− r <- peekByteIndex (castContents arr) pos

541+ r <- peekByteIndex pos (castContents arr)

542 return (BoundedPtr arr next end, r)

543

544{-# INLINE skipByte #-}

572pokeBoundedPtrUnsafe :: Unbox a => a -> BoundedPtr -> IO BoundedPtr

573pokeBoundedPtrUnsafe a (BoundedPtr arr pos end) = do

574 let next = pos + sizeOf a

575− pokeByteIndex (castContents arr) pos a

575+ pokeByteIndex pos (castContents arr) a

576 return (BoundedPtr arr next end)

577

578{-# INLINE pokeBoundedPtr #-}

580pokeBoundedPtr a (BoundedPtr arr pos end) = do

581 let next = pos + sizeOf a

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

583− pokeByteIndex (castContents arr) pos a

583+ pokeByteIndex pos (castContents arr) a

584 return (BoundedPtr arr next end)

585

586--------------------------------------------------------------------------------