{-# language MagicHash #-}
{-# language UnboxedTuples #-}
{-# language TypeFamilies #-}
{-# language ScopedTypeVariables #-}
{-# language CPP #-}
{-# language DataKinds #-}

module Data.Primitive.Unlifted.Class
  ( PrimUnlifted(..)
  ) where

import Data.ByteString.Short.Internal (ShortByteString(SBS))
import Data.Text.Short (ShortText,toShortByteString)
import Data.Text.Short.Unsafe (fromShortByteStringUnsafe)
import Data.Primitive.PrimArray (PrimArray(..),MutablePrimArray(..))
import Data.Primitive.ByteArray (ByteArray(..),MutableByteArray(..))
import GHC.MVar (MVar(..))
import GHC.IORef (IORef(..))
import GHC.STRef (STRef(..))
import GHC.Exts (State#,MutableByteArray#,ByteArray#,Int#)
import GHC.Exts (ArrayArray#,MutableArrayArray#)
import GHC.Exts (MVar#,MutVar#,RealWorld)
import GHC.Exts (TYPE,unsafeCoerce#)

import qualified Data.Primitive.MVar as PM
import qualified GHC.Exts as Exts

-- In GHC 9.2 the UnliftedRep constructor of RuntimeRep was removed
-- and replaced with a type synonym
#if __GLASGOW_HASKELL__  >= 902
import GHC.Exts (UnliftedRep)
#else
import GHC.Exts (RuntimeRep(UnliftedRep))
type UnliftedRep = 'UnliftedRep
#endif

class PrimUnlifted a where
  type Unlifted a :: TYPE UnliftedRep
  toUnlifted# :: a -> Unlifted a
  fromUnlifted# :: Unlifted a -> a
  writeUnliftedArray# ::
       MutableArrayArray# s
    -> Int#
    -> a
    -> State# s
    -> State# s
  readUnliftedArray# ::
       MutableArrayArray# s
    -> Int#
    -> State# s
    -> (# State# s, a #)
  indexUnliftedArray# ::
       ArrayArray#
    -> Int#
    -> a

instance PrimUnlifted (PrimArray a) where
  {-# inline writeUnliftedArray# #-}
  {-# inline readUnliftedArray# #-}
  {-# inline indexUnliftedArray# #-}
  type Unlifted (PrimArray a) = ByteArray#
  toUnlifted# :: PrimArray a -> Unlifted (PrimArray a)
toUnlifted# (PrimArray ByteArray#
x) = ByteArray#
Unlifted (PrimArray a)
x
  fromUnlifted# :: Unlifted (PrimArray a) -> PrimArray a
fromUnlifted# Unlifted (PrimArray a)
x = ByteArray# -> PrimArray a
forall a. ByteArray# -> PrimArray a
PrimArray ByteArray#
Unlifted (PrimArray a)
x
  writeUnliftedArray# :: MutableArrayArray# s -> Int# -> PrimArray a -> State# s -> State# s
writeUnliftedArray# MutableArrayArray# s
a Int#
i (PrimArray ByteArray#
x) = MutableArrayArray# s -> Int# -> ByteArray# -> State# s -> State# s
forall d.
MutableArrayArray# d -> Int# -> ByteArray# -> State# d -> State# d
Exts.writeByteArrayArray# MutableArrayArray# s
a Int#
i ByteArray#
x
  readUnliftedArray# :: MutableArrayArray# s
-> Int# -> State# s -> (# State# s, PrimArray a #)
readUnliftedArray# MutableArrayArray# s
a Int#
i State# s
s0 = case MutableArrayArray# s
-> Int# -> State# s -> (# State# s, ByteArray# #)
forall d.
MutableArrayArray# d
-> Int# -> State# d -> (# State# d, ByteArray# #)
Exts.readByteArrayArray# MutableArrayArray# s
a Int#
i State# s
s0 of
    (# State# s
s1, ByteArray#
x #) -> (# State# s
s1, ByteArray# -> PrimArray a
forall a. ByteArray# -> PrimArray a
PrimArray ByteArray#
x #)
  indexUnliftedArray# :: ArrayArray# -> Int# -> PrimArray a
indexUnliftedArray# ArrayArray#
a Int#
i = ByteArray# -> PrimArray a
forall a. ByteArray# -> PrimArray a
PrimArray (ArrayArray# -> Int# -> ByteArray#
Exts.indexByteArrayArray# ArrayArray#
a Int#
i)

instance PrimUnlifted ByteArray where
  {-# inline writeUnliftedArray# #-}
  {-# inline readUnliftedArray# #-}
  {-# inline indexUnliftedArray# #-}
  type Unlifted ByteArray = ByteArray#
  toUnlifted# :: ByteArray -> Unlifted ByteArray
toUnlifted# (ByteArray ByteArray#
x) = ByteArray#
Unlifted ByteArray
x
  fromUnlifted# :: Unlifted ByteArray -> ByteArray
fromUnlifted# Unlifted ByteArray
x = ByteArray# -> ByteArray
ByteArray ByteArray#
Unlifted ByteArray
x
  writeUnliftedArray# :: MutableArrayArray# s -> Int# -> ByteArray -> State# s -> State# s
writeUnliftedArray# MutableArrayArray# s
a Int#
i (ByteArray ByteArray#
x) = MutableArrayArray# s -> Int# -> ByteArray# -> State# s -> State# s
forall d.
MutableArrayArray# d -> Int# -> ByteArray# -> State# d -> State# d
Exts.writeByteArrayArray# MutableArrayArray# s
a Int#
i ByteArray#
x
  readUnliftedArray# :: MutableArrayArray# s
-> Int# -> State# s -> (# State# s, ByteArray #)
readUnliftedArray# MutableArrayArray# s
a Int#
i State# s
s0 = case MutableArrayArray# s
-> Int# -> State# s -> (# State# s, ByteArray# #)
forall d.
MutableArrayArray# d
-> Int# -> State# d -> (# State# d, ByteArray# #)
Exts.readByteArrayArray# MutableArrayArray# s
a Int#
i State# s
s0 of
    (# State# s
s1, ByteArray#
x #) -> (# State# s
s1, ByteArray# -> ByteArray
ByteArray ByteArray#
x #)
  indexUnliftedArray# :: ArrayArray# -> Int# -> ByteArray
indexUnliftedArray# ArrayArray#
a Int#
i = ByteArray# -> ByteArray
ByteArray (ArrayArray# -> Int# -> ByteArray#
Exts.indexByteArrayArray# ArrayArray#
a Int#
i)

instance PrimUnlifted ShortByteString where
  {-# inline writeUnliftedArray# #-}
  {-# inline readUnliftedArray# #-}
  {-# inline indexUnliftedArray# #-}
  type Unlifted ShortByteString = ByteArray#
  toUnlifted# :: ShortByteString -> Unlifted ShortByteString
toUnlifted# (SBS ByteArray#
x) = ByteArray#
Unlifted ShortByteString
x
  fromUnlifted# :: Unlifted ShortByteString -> ShortByteString
fromUnlifted# Unlifted ShortByteString
x = ByteArray# -> ShortByteString
SBS ByteArray#
Unlifted ShortByteString
x
  writeUnliftedArray# :: MutableArrayArray# s
-> Int# -> ShortByteString -> State# s -> State# s
writeUnliftedArray# MutableArrayArray# s
a Int#
i (SBS ByteArray#
x) = MutableArrayArray# s -> Int# -> ByteArray# -> State# s -> State# s
forall d.
MutableArrayArray# d -> Int# -> ByteArray# -> State# d -> State# d
Exts.writeByteArrayArray# MutableArrayArray# s
a Int#
i ByteArray#
x
  readUnliftedArray# :: MutableArrayArray# s
-> Int# -> State# s -> (# State# s, ShortByteString #)
readUnliftedArray# MutableArrayArray# s
a Int#
i State# s
s0 = case MutableArrayArray# s
-> Int# -> State# s -> (# State# s, ByteArray# #)
forall d.
MutableArrayArray# d
-> Int# -> State# d -> (# State# d, ByteArray# #)
Exts.readByteArrayArray# MutableArrayArray# s
a Int#
i State# s
s0 of
    (# State# s
s1, ByteArray#
x #) -> (# State# s
s1, ByteArray# -> ShortByteString
SBS ByteArray#
x #)
  indexUnliftedArray# :: ArrayArray# -> Int# -> ShortByteString
indexUnliftedArray# ArrayArray#
a Int#
i = ByteArray# -> ShortByteString
SBS (ArrayArray# -> Int# -> ByteArray#
Exts.indexByteArrayArray# ArrayArray#
a Int#
i)

instance PrimUnlifted ShortText where
  {-# inline writeUnliftedArray# #-}
  {-# inline readUnliftedArray# #-}
  {-# inline indexUnliftedArray# #-}
  type Unlifted ShortText = ByteArray#
  toUnlifted# :: ShortText -> Unlifted ShortText
toUnlifted# ShortText
t = case ShortText -> ShortByteString
toShortByteString ShortText
t of { SBS ByteArray#
x -> ByteArray#
Unlifted ShortText
x }
  fromUnlifted# :: Unlifted ShortText -> ShortText
fromUnlifted# Unlifted ShortText
x = ShortByteString -> ShortText
fromShortByteStringUnsafe (ByteArray# -> ShortByteString
SBS ByteArray#
Unlifted ShortText
x)
  writeUnliftedArray# :: MutableArrayArray# s -> Int# -> ShortText -> State# s -> State# s
writeUnliftedArray# MutableArrayArray# s
a Int#
i ShortText
t = case ShortText -> ShortByteString
toShortByteString ShortText
t of
    SBS ByteArray#
x -> MutableArrayArray# s -> Int# -> ByteArray# -> State# s -> State# s
forall d.
MutableArrayArray# d -> Int# -> ByteArray# -> State# d -> State# d
Exts.writeByteArrayArray# MutableArrayArray# s
a Int#
i ByteArray#
x
  readUnliftedArray# :: MutableArrayArray# s
-> Int# -> State# s -> (# State# s, ShortText #)
readUnliftedArray# MutableArrayArray# s
a Int#
i State# s
s0 = case MutableArrayArray# s
-> Int# -> State# s -> (# State# s, ByteArray# #)
forall d.
MutableArrayArray# d
-> Int# -> State# d -> (# State# d, ByteArray# #)
Exts.readByteArrayArray# MutableArrayArray# s
a Int#
i State# s
s0 of
    (# State# s
s1, ByteArray#
x #) -> (# State# s
s1, ShortByteString -> ShortText
fromShortByteStringUnsafe (ByteArray# -> ShortByteString
SBS ByteArray#
x) #)
  indexUnliftedArray# :: ArrayArray# -> Int# -> ShortText
indexUnliftedArray# ArrayArray#
a Int#
i = ShortByteString -> ShortText
fromShortByteStringUnsafe (ByteArray# -> ShortByteString
SBS (ArrayArray# -> Int# -> ByteArray#
Exts.indexByteArrayArray# ArrayArray#
a Int#
i))

-- This uses unsafeCoerce# in the implementation of
-- indexUnliftedArray#. This does not lead to corruption FFI codegen
-- since ByteArray# and MutableByteArray# have the same FFI offset
-- applied by add_shim.
-- This also uses unsafeCoerce# to relax the constraints on the
-- state token. The primitives in GHC.Prim are too restrictive.
instance PrimUnlifted (MutableByteArray s) where
  {-# inline writeUnliftedArray# #-}
  {-# inline readUnliftedArray# #-}
  {-# inline indexUnliftedArray# #-}
  type Unlifted (MutableByteArray s) = MutableByteArray# s
  toUnlifted# :: MutableByteArray s -> Unlifted (MutableByteArray s)
toUnlifted# (MutableByteArray MutableByteArray# s
x) = MutableByteArray# s
Unlifted (MutableByteArray s)
x
  fromUnlifted# :: Unlifted (MutableByteArray s) -> MutableByteArray s
fromUnlifted# Unlifted (MutableByteArray s)
x = MutableByteArray# s -> MutableByteArray s
forall s. MutableByteArray# s -> MutableByteArray s
MutableByteArray MutableByteArray# s
Unlifted (MutableByteArray s)
x
  writeUnliftedArray# :: MutableArrayArray# s
-> Int# -> MutableByteArray s -> State# s -> State# s
writeUnliftedArray# MutableArrayArray# s
a Int#
i (MutableByteArray MutableByteArray# s
x) =
    MutableArrayArray# s
-> Int# -> MutableByteArray# s -> State# s -> State# s
forall d.
MutableArrayArray# d
-> Int# -> MutableByteArray# d -> State# d -> State# d
Exts.writeMutableByteArrayArray# MutableArrayArray# s
a Int#
i (MutableByteArray# s -> MutableByteArray# s
forall s r. MutableByteArray# s -> MutableByteArray# r
retoken MutableByteArray# s
x)
  readUnliftedArray# :: MutableArrayArray# s
-> Int# -> State# s -> (# State# s, MutableByteArray s #)
readUnliftedArray# MutableArrayArray# s
a Int#
i State# s
s0 = case MutableArrayArray# s
-> Int# -> State# s -> (# State# s, MutableByteArray# s #)
forall d.
MutableArrayArray# d
-> Int# -> State# d -> (# State# d, MutableByteArray# d #)
Exts.readMutableByteArrayArray# MutableArrayArray# s
a Int#
i State# s
s0 of
    (# State# s
s1, MutableByteArray# s
x #) -> (# State# s
s1, MutableByteArray# s -> MutableByteArray s
forall s. MutableByteArray# s -> MutableByteArray s
MutableByteArray (MutableByteArray# s -> MutableByteArray# s
forall s r. MutableByteArray# s -> MutableByteArray# r
retoken MutableByteArray# s
x) #)
  indexUnliftedArray# :: ArrayArray# -> Int# -> MutableByteArray s
indexUnliftedArray# ArrayArray#
a Int#
i = MutableByteArray# s -> MutableByteArray s
forall s. MutableByteArray# s -> MutableByteArray s
MutableByteArray (ByteArray# -> MutableByteArray# s
forall s. ByteArray# -> MutableByteArray# s
baToMba (ArrayArray# -> Int# -> ByteArray#
Exts.indexByteArrayArray# ArrayArray#
a Int#
i))

-- See the note on the PrimUnlifted instance for MutableByteArray.
-- The same uses of unsafeCoerce# happen here.
instance PrimUnlifted (MutablePrimArray s a) where
  {-# inline writeUnliftedArray# #-}
  {-# inline readUnliftedArray# #-}
  {-# inline indexUnliftedArray# #-}
  type Unlifted (MutablePrimArray s a) = MutableByteArray# s
  toUnlifted# :: MutablePrimArray s a -> Unlifted (MutablePrimArray s a)
toUnlifted# (MutablePrimArray MutableByteArray# s
x) = MutableByteArray# s
Unlifted (MutablePrimArray s a)
x
  fromUnlifted# :: Unlifted (MutablePrimArray s a) -> MutablePrimArray s a
fromUnlifted# Unlifted (MutablePrimArray s a)
x = MutableByteArray# s -> MutablePrimArray s a
forall s a. MutableByteArray# s -> MutablePrimArray s a
MutablePrimArray MutableByteArray# s
Unlifted (MutablePrimArray s a)
x
  writeUnliftedArray# :: MutableArrayArray# s
-> Int# -> MutablePrimArray s a -> State# s -> State# s
writeUnliftedArray# MutableArrayArray# s
a Int#
i (MutablePrimArray MutableByteArray# s
x) =
    MutableArrayArray# s
-> Int# -> MutableByteArray# s -> State# s -> State# s
forall d.
MutableArrayArray# d
-> Int# -> MutableByteArray# d -> State# d -> State# d
Exts.writeMutableByteArrayArray# MutableArrayArray# s
a Int#
i (MutableByteArray# s -> MutableByteArray# s
forall s r. MutableByteArray# s -> MutableByteArray# r
retoken MutableByteArray# s
x)
  readUnliftedArray# :: MutableArrayArray# s
-> Int# -> State# s -> (# State# s, MutablePrimArray s a #)
readUnliftedArray# MutableArrayArray# s
a Int#
i State# s
s0 = case MutableArrayArray# s
-> Int# -> State# s -> (# State# s, MutableByteArray# s #)
forall d.
MutableArrayArray# d
-> Int# -> State# d -> (# State# d, MutableByteArray# d #)
Exts.readMutableByteArrayArray# MutableArrayArray# s
a Int#
i State# s
s0 of
    (# State# s
s1, MutableByteArray# s
x #) -> (# State# s
s1, MutableByteArray# s -> MutablePrimArray s a
forall s a. MutableByteArray# s -> MutablePrimArray s a
MutablePrimArray (MutableByteArray# s -> MutableByteArray# s
forall s r. MutableByteArray# s -> MutableByteArray# r
retoken MutableByteArray# s
x) #)
  indexUnliftedArray# :: ArrayArray# -> Int# -> MutablePrimArray s a
indexUnliftedArray# ArrayArray#
a Int#
i = MutableByteArray# s -> MutablePrimArray s a
forall s a. MutableByteArray# s -> MutablePrimArray s a
MutablePrimArray (ByteArray# -> MutableByteArray# s
forall s. ByteArray# -> MutableByteArray# s
baToMba (ArrayArray# -> Int# -> ByteArray#
Exts.indexByteArrayArray# ArrayArray#
a Int#
i))

-- This uses unsafeCoerce# in the implementation of all of its
-- methods. This does not lead to corruption FFI codegen since ArrayArray#
-- and MVar# have the same FFI offset applied by add_shim. However, in
-- GHC 8.10, the offset of ArrayArray# changes. Consequently, this library
-- cannot build with GHC 8.10.
instance PrimUnlifted (PM.MVar s a) where
  {-# inline writeUnliftedArray# #-}
  {-# inline readUnliftedArray# #-}
  {-# inline indexUnliftedArray# #-}
  type Unlifted (PM.MVar s a) = MVar# s a
  toUnlifted# :: MVar s a -> Unlifted (MVar s a)
toUnlifted# (PM.MVar MVar# s a
x) = MVar# s a
Unlifted (MVar s a)
x
  fromUnlifted# :: Unlifted (MVar s a) -> MVar s a
fromUnlifted# Unlifted (MVar s a)
x = MVar# s a -> MVar s a
forall s a. MVar# s a -> MVar s a
PM.MVar MVar# s a
Unlifted (MVar s a)
x
  writeUnliftedArray# :: MutableArrayArray# s -> Int# -> MVar s a -> State# s -> State# s
writeUnliftedArray# MutableArrayArray# s
a Int#
i (PM.MVar MVar# s a
x) =
    MutableArrayArray# s -> Int# -> ArrayArray# -> State# s -> State# s
forall d.
MutableArrayArray# d -> Int# -> ArrayArray# -> State# d -> State# d
Exts.writeArrayArrayArray# MutableArrayArray# s
a Int#
i (MVar# s a -> ArrayArray#
forall s a. MVar# s a -> ArrayArray#
mvarToArrArr MVar# s a
x)
  readUnliftedArray# :: MutableArrayArray# s
-> Int# -> State# s -> (# State# s, MVar s a #)
readUnliftedArray# MutableArrayArray# s
a Int#
i State# s
s0 = case MutableArrayArray# s
-> Int# -> State# s -> (# State# s, ArrayArray# #)
forall d.
MutableArrayArray# d
-> Int# -> State# d -> (# State# d, ArrayArray# #)
Exts.readArrayArrayArray# MutableArrayArray# s
a Int#
i State# s
s0 of
    (# State# s
s1, ArrayArray#
x #) -> (# State# s
s1, MVar# s a -> MVar s a
forall s a. MVar# s a -> MVar s a
PM.MVar (ArrayArray# -> MVar# s a
forall s a. ArrayArray# -> MVar# s a
arrArrToMVar ArrayArray#
x) #)
  indexUnliftedArray# :: ArrayArray# -> Int# -> MVar s a
indexUnliftedArray# ArrayArray#
a Int#
i = MVar# s a -> MVar s a
forall s a. MVar# s a -> MVar s a
PM.MVar (ArrayArray# -> MVar# s a
forall s a. ArrayArray# -> MVar# s a
arrArrToMVar (ArrayArray# -> Int# -> ArrayArray#
Exts.indexArrayArrayArray# ArrayArray#
a Int#
i))

-- This uses unsafeCoerce# in the implementation of all of its
-- methods. See the note for the PrimUnlifted instance of
-- Data.Primitive.MVar.MVar.
instance PrimUnlifted (MVar a) where
  {-# inline writeUnliftedArray# #-}
  {-# inline readUnliftedArray# #-}
  {-# inline indexUnliftedArray# #-}
  type Unlifted (MVar a) = MVar# RealWorld a
  toUnlifted# :: MVar a -> Unlifted (MVar a)
toUnlifted# (MVar MVar# RealWorld a
x) = MVar# RealWorld a
Unlifted (MVar a)
x
  fromUnlifted# :: Unlifted (MVar a) -> MVar a
fromUnlifted# Unlifted (MVar a)
x = MVar# RealWorld a -> MVar a
forall a. MVar# RealWorld a -> MVar a
MVar MVar# RealWorld a
Unlifted (MVar a)
x
  writeUnliftedArray# :: MutableArrayArray# s -> Int# -> MVar a -> State# s -> State# s
writeUnliftedArray# MutableArrayArray# s
a Int#
i (MVar MVar# RealWorld a
x) =
    MutableArrayArray# s -> Int# -> ArrayArray# -> State# s -> State# s
forall d.
MutableArrayArray# d -> Int# -> ArrayArray# -> State# d -> State# d
Exts.writeArrayArrayArray# MutableArrayArray# s
a Int#
i (MVar# RealWorld a -> ArrayArray#
forall s a. MVar# s a -> ArrayArray#
mvarToArrArr MVar# RealWorld a
x)
  readUnliftedArray# :: MutableArrayArray# s -> Int# -> State# s -> (# State# s, MVar a #)
readUnliftedArray# MutableArrayArray# s
a Int#
i State# s
s0 = case MutableArrayArray# s
-> Int# -> State# s -> (# State# s, ArrayArray# #)
forall d.
MutableArrayArray# d
-> Int# -> State# d -> (# State# d, ArrayArray# #)
Exts.readArrayArrayArray# MutableArrayArray# s
a Int#
i State# s
s0 of
    (# State# s
s1, ArrayArray#
x #) -> (# State# s
s1, MVar# RealWorld a -> MVar a
forall a. MVar# RealWorld a -> MVar a
MVar (ArrayArray# -> MVar# RealWorld a
forall s a. ArrayArray# -> MVar# s a
arrArrToMVar ArrayArray#
x) #)
  indexUnliftedArray# :: ArrayArray# -> Int# -> MVar a
indexUnliftedArray# ArrayArray#
a Int#
i = MVar# RealWorld a -> MVar a
forall a. MVar# RealWorld a -> MVar a
MVar (ArrayArray# -> MVar# RealWorld a
forall s a. ArrayArray# -> MVar# s a
arrArrToMVar (ArrayArray# -> Int# -> ArrayArray#
Exts.indexArrayArrayArray# ArrayArray#
a Int#
i))

-- This uses unsafeCoerce# in the implementation of all of its
-- methods. This does not lead to corruption FFI codegen since ArrayArray#
-- and MutVar# have the same FFI offset applied by add_shim.
instance PrimUnlifted (STRef s a) where
  {-# inline writeUnliftedArray# #-}
  {-# inline readUnliftedArray# #-}
  {-# inline indexUnliftedArray# #-}
  type Unlifted (STRef s a) = MutVar# s a
  toUnlifted# :: STRef s a -> Unlifted (STRef s a)
toUnlifted# (STRef MutVar# s a
x) = MutVar# s a
Unlifted (STRef s a)
x
  fromUnlifted# :: Unlifted (STRef s a) -> STRef s a
fromUnlifted# Unlifted (STRef s a)
x = MutVar# s a -> STRef s a
forall s a. MutVar# s a -> STRef s a
STRef MutVar# s a
Unlifted (STRef s a)
x
  writeUnliftedArray# :: MutableArrayArray# s -> Int# -> STRef s a -> State# s -> State# s
writeUnliftedArray# MutableArrayArray# s
a Int#
i (STRef MutVar# s a
x) =
    MutableArrayArray# s -> Int# -> ArrayArray# -> State# s -> State# s
forall d.
MutableArrayArray# d -> Int# -> ArrayArray# -> State# d -> State# d
Exts.writeArrayArrayArray# MutableArrayArray# s
a Int#
i (MutVar# s a -> ArrayArray#
forall s a. MutVar# s a -> ArrayArray#
mutVarToArrArr MutVar# s a
x)
  readUnliftedArray# :: MutableArrayArray# s
-> Int# -> State# s -> (# State# s, STRef s a #)
readUnliftedArray# MutableArrayArray# s
a Int#
i State# s
s0 = case MutableArrayArray# s
-> Int# -> State# s -> (# State# s, ArrayArray# #)
forall d.
MutableArrayArray# d
-> Int# -> State# d -> (# State# d, ArrayArray# #)
Exts.readArrayArrayArray# MutableArrayArray# s
a Int#
i State# s
s0 of
    (# State# s
s1, ArrayArray#
x #) -> (# State# s
s1, MutVar# s a -> STRef s a
forall s a. MutVar# s a -> STRef s a
STRef (ArrayArray# -> MutVar# s a
forall s a. ArrayArray# -> MutVar# s a
arrArrToMutVar ArrayArray#
x) #)
  indexUnliftedArray# :: ArrayArray# -> Int# -> STRef s a
indexUnliftedArray# ArrayArray#
a Int#
i =
    MutVar# s a -> STRef s a
forall s a. MutVar# s a -> STRef s a
STRef (ArrayArray# -> MutVar# s a
forall s a. ArrayArray# -> MutVar# s a
arrArrToMutVar (ArrayArray# -> Int# -> ArrayArray#
Exts.indexArrayArrayArray# ArrayArray#
a Int#
i))

instance PrimUnlifted (IORef a) where
  {-# inline writeUnliftedArray# #-}
  {-# inline readUnliftedArray# #-}
  {-# inline indexUnliftedArray# #-}
  type Unlifted (IORef a) = MutVar# RealWorld a
  toUnlifted# :: IORef a -> Unlifted (IORef a)
toUnlifted# (IORef (STRef MutVar# RealWorld a
x)) = MutVar# RealWorld a
Unlifted (IORef a)
x
  fromUnlifted# :: Unlifted (IORef a) -> IORef a
fromUnlifted# Unlifted (IORef a)
x = STRef RealWorld a -> IORef a
forall a. STRef RealWorld a -> IORef a
IORef (MutVar# RealWorld a -> STRef RealWorld a
forall s a. MutVar# s a -> STRef s a
STRef MutVar# RealWorld a
Unlifted (IORef a)
x)
  writeUnliftedArray# :: MutableArrayArray# s -> Int# -> IORef a -> State# s -> State# s
writeUnliftedArray# MutableArrayArray# s
a Int#
i (IORef STRef RealWorld a
v) = MutableArrayArray# s
-> Int# -> STRef RealWorld a -> State# s -> State# s
forall a s.
PrimUnlifted a =>
MutableArrayArray# s -> Int# -> a -> State# s -> State# s
writeUnliftedArray# MutableArrayArray# s
a Int#
i STRef RealWorld a
v
  readUnliftedArray# :: MutableArrayArray# s -> Int# -> State# s -> (# State# s, IORef a #)
readUnliftedArray# MutableArrayArray# s
a Int#
i State# s
s0 = case MutableArrayArray# s
-> Int# -> State# s -> (# State# s, STRef RealWorld a #)
forall a s.
PrimUnlifted a =>
MutableArrayArray# s -> Int# -> State# s -> (# State# s, a #)
readUnliftedArray# MutableArrayArray# s
a Int#
i State# s
s0 of
    (# State# s
s1, STRef RealWorld a
v #) -> (# State# s
s1, STRef RealWorld a -> IORef a
forall a. STRef RealWorld a -> IORef a
IORef STRef RealWorld a
v #)
  indexUnliftedArray# :: ArrayArray# -> Int# -> IORef a
indexUnliftedArray# ArrayArray#
a Int#
i = STRef RealWorld a -> IORef a
forall a. STRef RealWorld a -> IORef a
IORef (ArrayArray# -> Int# -> STRef RealWorld a
forall a. PrimUnlifted a => ArrayArray# -> Int# -> a
indexUnliftedArray# ArrayArray#
a Int#
i)

arrArrToMutVar :: ArrayArray# -> MutVar# s a
{-# inline arrArrToMutVar #-}
arrArrToMutVar :: ArrayArray# -> MutVar# s a
arrArrToMutVar = ArrayArray# -> MutVar# s a
unsafeCoerce#

mutVarToArrArr :: MutVar# s a -> ArrayArray#
{-# inline mutVarToArrArr #-}
mutVarToArrArr :: MutVar# s a -> ArrayArray#
mutVarToArrArr = MutVar# s a -> ArrayArray#
unsafeCoerce#

arrArrToMVar :: ArrayArray# -> MVar# s a
{-# inline arrArrToMVar #-}
arrArrToMVar :: ArrayArray# -> MVar# s a
arrArrToMVar = ArrayArray# -> MVar# s a
unsafeCoerce#

mvarToArrArr :: MVar# s a -> ArrayArray#
{-# inline mvarToArrArr #-}
mvarToArrArr :: MVar# s a -> ArrayArray#
mvarToArrArr = MVar# s a -> ArrayArray#
unsafeCoerce#

baToMba :: ByteArray# -> MutableByteArray# s
{-# inline baToMba #-}
baToMba :: ByteArray# -> MutableByteArray# s
baToMba = ByteArray# -> MutableByteArray# s
unsafeCoerce#

retoken :: MutableByteArray# s -> MutableByteArray# r
{-# inline retoken #-}
retoken :: MutableByteArray# s -> MutableByteArray# r
retoken = MutableByteArray# s -> MutableByteArray# r
unsafeCoerce#