{-# language DataKinds #-}
{-# language MagicHash #-}
{-# language UnboxedTuples #-}

-- This can be used with vex-indef as either the element module
-- or the array module.
module Basics.ByteArray
  ( -- Types
    A
  , M
  , R
  , A#
  , M#
    -- Element Types
  , T
  , T# 
    -- Lifting
  , lift
  , unlift
  , liftMutable
  , unliftMutable
    -- Array
  , unsafeFreeze#
    -- Array Element
  , read#
  , write#
  , index#
  , set#
  ) where

import GHC.Exts hiding (setByteArray#)
import Data.Primitive (ByteArray(..),MutableByteArray(..))

import qualified GHC.Exts as Exts

type A = ByteArray
type A# = ByteArray#
type M = MutableByteArray
type M# = MutableByteArray#
type R = 'BoxedRep 'Unlifted

type T = ByteArray
type T# = ByteArray#

lift :: A# -> A
{-# inline lift #-}
lift :: A# -> A
lift = A# -> A
ByteArray

unlift :: A -> A#
{-# inline unlift #-}
unlift :: A -> A#
unlift (ByteArray A#
i) = A#
i

liftMutable :: M# s -> M s
{-# inline liftMutable #-}
liftMutable :: forall s. M# s -> M s
liftMutable = forall s. M# s -> M s
MutableByteArray

unliftMutable :: M s -> M# s
{-# inline unliftMutable #-}
unliftMutable :: forall s. M s -> M# s
unliftMutable (MutableByteArray MutableByteArray# s
i) = MutableByteArray# s
i

unsafeFreeze# :: M# s -> State# s -> (# State# s, A# #)
{-# inline unsafeFreeze# #-}
unsafeFreeze# :: forall s. M# s -> State# s -> (# State# s, A# #)
unsafeFreeze# = forall s. M# s -> State# s -> (# State# s, A# #)
unsafeFreezeByteArray#

index# :: ArrayArray# -> Int# -> T#
{-# inline index# #-}
index# :: ArrayArray# -> Int# -> A#
index# = ArrayArray# -> Int# -> A#
Exts.indexByteArrayArray#

read# :: MutableArrayArray# s -> Int# -> State# s -> (# State# s, T# #)
{-# inline read# #-}
read# :: forall s.
MutableArrayArray# s -> Int# -> State# s -> (# State# s, A# #)
read# = forall s.
MutableArrayArray# s -> Int# -> State# s -> (# State# s, A# #)
Exts.readByteArrayArray#

write# :: MutableArrayArray# s -> Int# -> T# -> State# s -> State# s
{-# inline write# #-}
write# :: forall s.
MutableArrayArray# s -> Int# -> A# -> State# s -> State# s
write# = forall s.
MutableArrayArray# s -> Int# -> A# -> State# s -> State# s
Exts.writeByteArrayArray#

set# :: MutableArrayArray# s -> Int# -> Int# -> T# -> State# s -> State# s
{-# inline set# #-}
set# :: forall s.
MutableArrayArray# s -> Int# -> Int# -> A# -> State# s -> State# s
set# MutableArrayArray# s
marr Int#
off Int#
len A#
x State# s
s = case Int#
len of
  Int#
0# -> State# s
s
  Int#
_ -> forall s.
MutableArrayArray# s -> Int# -> Int# -> A# -> State# s -> State# s
set# MutableArrayArray# s
marr (Int#
off Int# -> Int# -> Int#
+# Int#
1# ) (Int#
len Int# -> Int# -> Int#
-# Int#
1# ) A#
x (forall s.
MutableArrayArray# s -> Int# -> A# -> State# s -> State# s
write# MutableArrayArray# s
marr Int#
off A#
x State# s
s)