{- |
Module      : Z.Data.Array.UnliftedArray
Description : unlifted primitve arrays
Copyright   : (c) Dong Han, 2017-2020
License     : BSD
Maintainer  : winterland1989@gmail.com
Stability   : experimental
Portability : non-portable

GHC contains three general classes of value types:

  1. Unboxed types: values are machine values made up of fixed numbers of bytes
  2. Unlifted types: values are pointers, but strictly evaluated
  3. Lifted types: values are pointers, lazily evaluated

The first category can be stored in a 'ByteArray', and this allows types in
category 3 that are simple wrappers around category 1 types to be stored
more efficiently using a 'ByteArray'. This module provides the same facility
for category 2 types.

GHC has two primitive types, 'ArrayArray#' and 'MutableArrayArray#'. These
are arrays of pointers, but of category 2 values, so they are known to not
be bottom. This allows types that are wrappers around such types to be stored
in an array without an extra level of indirection.

The way that the 'ArrayArray#' API works is that one can read and write
'ArrayArray#' values to the positions. This works because all category 2
types share a uniform representation, unlike unboxed values which are
represented by varying (by type) numbers of bytes. However, using the
this makes the internal API very unsafe to use, as one has to coerce values
to and from 'ArrayArray#'.

The API presented by this module is more type safe. 'UnliftedArray' and
'MutableUnliftedArray' are parameterized by the type of arrays they contain, and
the coercions necessary are abstracted into a class, 'PrimUnlifted', of things
that are eligible to be stored.
-}
module Z.Data.Array.UnliftedArray where

import Control.Exception              (ArrayException (..), throw)
import Control.Monad.Primitive
import Data.Primitive.Array
import Data.Primitive.ByteArray
import Data.Primitive.PrimArray
import Data.Primitive.SmallArray
import GHC.MVar (MVar(..))
import GHC.IORef (IORef(..))
import GHC.ST
import GHC.STRef (STRef(..))
import GHC.Conc (TVar(..))
import GHC.Exts
import GHC.IO.Unsafe

-- | Types with 'GHC.Exts.TYPE' 'GHC.Exts.UnliftedRep', which can be stored \/ retrieved in 'ArrayArray#'.
class PrimUnlifted a where
    writeUnliftedArray# :: MutableArrayArray# s -> Int# -> a -> State# s -> State# s
    readUnliftedArray# :: MutableArrayArray# s -> Int# -> State# s -> (# State# s, a #)
    indexUnliftedArray# :: ArrayArray# -> Int# -> a

instance PrimUnlifted (UnliftedArray a) where
    {-# INLINE writeUnliftedArray# #-}
    {-# INLINE readUnliftedArray# #-}
    {-# INLINE indexUnliftedArray# #-}
    writeUnliftedArray# :: forall s.
MutableArrayArray# s
-> Int# -> UnliftedArray a -> State# s -> State# s
writeUnliftedArray# MutableArrayArray# s
a Int#
i (UnliftedArray ArrayArray#
x) = forall d.
MutableArrayArray# d -> Int# -> ArrayArray# -> State# d -> State# d
writeArrayArrayArray# MutableArrayArray# s
a Int#
i ArrayArray#
x
    readUnliftedArray# :: forall s.
MutableArrayArray# s
-> Int# -> State# s -> (# State# s, UnliftedArray a #)
readUnliftedArray# MutableArrayArray# s
a Int#
i State# s
s0 = case forall d.
MutableArrayArray# d
-> Int# -> State# d -> (# State# d, ArrayArray# #)
readArrayArrayArray# MutableArrayArray# s
a Int#
i State# s
s0 of
        (# State# s
s1, ArrayArray#
x #) -> (# State# s
s1, forall {k} (a :: k). ArrayArray# -> UnliftedArray a
UnliftedArray ArrayArray#
x #)
    indexUnliftedArray# :: ArrayArray# -> Int# -> UnliftedArray a
indexUnliftedArray# ArrayArray#
a Int#
i = forall {k} (a :: k). ArrayArray# -> UnliftedArray a
UnliftedArray (ArrayArray# -> Int# -> ArrayArray#
indexArrayArrayArray# ArrayArray#
a Int#
i)

instance PrimUnlifted (MutableUnliftedArray s a) where
    {-# INLINE writeUnliftedArray# #-}
    {-# INLINE readUnliftedArray# #-}
    {-# INLINE indexUnliftedArray# #-}
    writeUnliftedArray# :: forall s.
MutableArrayArray# s
-> Int# -> MutableUnliftedArray s a -> State# s -> State# s
writeUnliftedArray# MutableArrayArray# s
a Int#
i (MutableUnliftedArray MutableArrayArray# s
x) =
        forall d.
MutableArrayArray# d
-> Int# -> MutableArrayArray# d -> State# d -> State# d
writeMutableArrayArrayArray# MutableArrayArray# s
a Int#
i (unsafeCoerce# :: forall a b. a -> b
unsafeCoerce# MutableArrayArray# s
x)
    readUnliftedArray# :: forall s.
MutableArrayArray# s
-> Int# -> State# s -> (# State# s, MutableUnliftedArray s a #)
readUnliftedArray# MutableArrayArray# s
a Int#
i State# s
s0 = case forall d.
MutableArrayArray# d
-> Int# -> State# d -> (# State# d, MutableArrayArray# d #)
readMutableArrayArrayArray# MutableArrayArray# s
a Int#
i State# s
s0 of
        (# State# s
s1, MutableArrayArray# s
x #) -> (# State# s
s1, forall {k} s (a :: k).
MutableArrayArray# s -> MutableUnliftedArray s a
MutableUnliftedArray (unsafeCoerce# :: forall a b. a -> b
unsafeCoerce# MutableArrayArray# s
x) #)
    indexUnliftedArray# :: ArrayArray# -> Int# -> MutableUnliftedArray s a
indexUnliftedArray# ArrayArray#
a Int#
i = forall {k} s (a :: k).
MutableArrayArray# s -> MutableUnliftedArray s a
MutableUnliftedArray (unsafeCoerce# :: forall a b. a -> b
unsafeCoerce# (ArrayArray# -> Int# -> ArrayArray#
indexArrayArrayArray# ArrayArray#
a Int#
i))

instance PrimUnlifted (Array a) where
    {-# INLINE writeUnliftedArray# #-}
    {-# INLINE readUnliftedArray# #-}
    {-# INLINE indexUnliftedArray# #-}
    writeUnliftedArray# :: forall s.
MutableArrayArray# s -> Int# -> Array a -> State# s -> State# s
writeUnliftedArray# MutableArrayArray# s
a Int#
i (Array Array# a
x) =
        forall d.
MutableArrayArray# d -> Int# -> ArrayArray# -> State# d -> State# d
writeArrayArrayArray# MutableArrayArray# s
a Int#
i (unsafeCoerce# :: forall a b. a -> b
unsafeCoerce# Array# a
x)
    readUnliftedArray# :: forall s.
MutableArrayArray# s -> Int# -> State# s -> (# State# s, Array a #)
readUnliftedArray# MutableArrayArray# s
a Int#
i State# s
s0 = case forall d.
MutableArrayArray# d
-> Int# -> State# d -> (# State# d, ArrayArray# #)
readArrayArrayArray# MutableArrayArray# s
a Int#
i State# s
s0 of
        (# State# s
s1, ArrayArray#
x #) -> (# State# s
s1, forall a. Array# a -> Array a
Array (unsafeCoerce# :: forall a b. a -> b
unsafeCoerce# ArrayArray#
x) #)
    indexUnliftedArray# :: ArrayArray# -> Int# -> Array a
indexUnliftedArray# ArrayArray#
a Int#
i = forall a. Array# a -> Array a
Array (unsafeCoerce# :: forall a b. a -> b
unsafeCoerce# (ArrayArray# -> Int# -> ArrayArray#
indexArrayArrayArray# ArrayArray#
a Int#
i))

instance PrimUnlifted (MutableArray s a) where
    {-# INLINE writeUnliftedArray# #-}
    {-# INLINE readUnliftedArray# #-}
    {-# INLINE indexUnliftedArray# #-}
    writeUnliftedArray# :: forall s.
MutableArrayArray# s
-> Int# -> MutableArray s a -> State# s -> State# s
writeUnliftedArray# MutableArrayArray# s
a Int#
i (MutableArray MutableArray# s a
x) =
        forall d.
MutableArrayArray# d
-> Int# -> MutableArrayArray# d -> State# d -> State# d
writeMutableArrayArrayArray# MutableArrayArray# s
a Int#
i (unsafeCoerce# :: forall a b. a -> b
unsafeCoerce# MutableArray# s a
x)
    readUnliftedArray# :: forall s.
MutableArrayArray# s
-> Int# -> State# s -> (# State# s, MutableArray s a #)
readUnliftedArray# MutableArrayArray# s
a Int#
i State# s
s0 = case forall d.
MutableArrayArray# d
-> Int# -> State# d -> (# State# d, MutableArrayArray# d #)
readMutableArrayArrayArray# MutableArrayArray# s
a Int#
i State# s
s0 of
        (# State# s
s1, MutableArrayArray# s
x #) -> (# State# s
s1, forall s a. MutableArray# s a -> MutableArray s a
MutableArray (unsafeCoerce# :: forall a b. a -> b
unsafeCoerce# MutableArrayArray# s
x) #)
    indexUnliftedArray# :: ArrayArray# -> Int# -> MutableArray s a
indexUnliftedArray# ArrayArray#
a Int#
i = forall s a. MutableArray# s a -> MutableArray s a
MutableArray (unsafeCoerce# :: forall a b. a -> b
unsafeCoerce# (ArrayArray# -> Int# -> ArrayArray#
indexArrayArrayArray# ArrayArray#
a Int#
i))

instance PrimUnlifted (SmallArray a) where
    {-# INLINE writeUnliftedArray# #-}
    {-# INLINE readUnliftedArray# #-}
    {-# INLINE indexUnliftedArray# #-}
    writeUnliftedArray# :: forall s.
MutableArrayArray# s
-> Int# -> SmallArray a -> State# s -> State# s
writeUnliftedArray# MutableArrayArray# s
a Int#
i (SmallArray SmallArray# a
x) =
        forall d.
MutableArrayArray# d -> Int# -> ArrayArray# -> State# d -> State# d
writeArrayArrayArray# MutableArrayArray# s
a Int#
i (unsafeCoerce# :: forall a b. a -> b
unsafeCoerce# SmallArray# a
x)
    readUnliftedArray# :: forall s.
MutableArrayArray# s
-> Int# -> State# s -> (# State# s, SmallArray a #)
readUnliftedArray# MutableArrayArray# s
a Int#
i State# s
s0 = case forall d.
MutableArrayArray# d
-> Int# -> State# d -> (# State# d, ArrayArray# #)
readArrayArrayArray# MutableArrayArray# s
a Int#
i State# s
s0 of
        (# State# s
s1, ArrayArray#
x #) -> (# State# s
s1, forall a. SmallArray# a -> SmallArray a
SmallArray (unsafeCoerce# :: forall a b. a -> b
unsafeCoerce# ArrayArray#
x) #)
    indexUnliftedArray# :: ArrayArray# -> Int# -> SmallArray a
indexUnliftedArray# ArrayArray#
a Int#
i = forall a. SmallArray# a -> SmallArray a
SmallArray (unsafeCoerce# :: forall a b. a -> b
unsafeCoerce# (ArrayArray# -> Int# -> ArrayArray#
indexArrayArrayArray# ArrayArray#
a Int#
i))

instance PrimUnlifted (SmallMutableArray s a) where
    {-# INLINE writeUnliftedArray# #-}
    {-# INLINE readUnliftedArray# #-}
    {-# INLINE indexUnliftedArray# #-}
    writeUnliftedArray# :: forall s.
MutableArrayArray# s
-> Int# -> SmallMutableArray s a -> State# s -> State# s
writeUnliftedArray# MutableArrayArray# s
a Int#
i (SmallMutableArray SmallMutableArray# s a
x) =
        forall d.
MutableArrayArray# d
-> Int# -> MutableArrayArray# d -> State# d -> State# d
writeMutableArrayArrayArray# MutableArrayArray# s
a Int#
i (unsafeCoerce# :: forall a b. a -> b
unsafeCoerce# SmallMutableArray# s a
x)
    readUnliftedArray# :: forall s.
MutableArrayArray# s
-> Int# -> State# s -> (# State# s, SmallMutableArray s a #)
readUnliftedArray# MutableArrayArray# s
a Int#
i State# s
s0 = case forall d.
MutableArrayArray# d
-> Int# -> State# d -> (# State# d, MutableArrayArray# d #)
readMutableArrayArrayArray# MutableArrayArray# s
a Int#
i State# s
s0 of
        (# State# s
s1, MutableArrayArray# s
x #) -> (# State# s
s1, forall s a. SmallMutableArray# s a -> SmallMutableArray s a
SmallMutableArray (unsafeCoerce# :: forall a b. a -> b
unsafeCoerce# MutableArrayArray# s
x) #)
    indexUnliftedArray# :: ArrayArray# -> Int# -> SmallMutableArray s a
indexUnliftedArray# ArrayArray#
a Int#
i = forall s a. SmallMutableArray# s a -> SmallMutableArray s a
SmallMutableArray (unsafeCoerce# :: forall a b. a -> b
unsafeCoerce# (ArrayArray# -> Int# -> ArrayArray#
indexArrayArrayArray# ArrayArray#
a Int#
i))

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

instance PrimUnlifted ByteArray where
    {-# INLINE writeUnliftedArray# #-}
    {-# INLINE readUnliftedArray# #-}
    {-# INLINE indexUnliftedArray# #-}
    writeUnliftedArray# :: forall s.
MutableArrayArray# s -> Int# -> ByteArray -> State# s -> State# s
writeUnliftedArray# MutableArrayArray# s
a Int#
i (ByteArray ByteArray#
x) = forall d.
MutableArrayArray# d -> Int# -> ByteArray# -> State# d -> State# d
writeByteArrayArray# MutableArrayArray# s
a Int#
i ByteArray#
x
    readUnliftedArray# :: forall s.
MutableArrayArray# s
-> Int# -> State# s -> (# State# s, ByteArray #)
readUnliftedArray# MutableArrayArray# s
a Int#
i State# s
s0 = case forall d.
MutableArrayArray# d
-> Int# -> State# d -> (# State# d, ByteArray# #)
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#
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# #-}
    writeUnliftedArray# :: forall s.
MutableArrayArray# s
-> Int# -> MutableByteArray s -> State# s -> State# s
writeUnliftedArray# MutableArrayArray# s
a Int#
i (MutableByteArray MutableByteArray# s
x) =
        forall d.
MutableArrayArray# d
-> Int# -> MutableByteArray# d -> State# d -> State# d
writeMutableByteArrayArray# MutableArrayArray# s
a Int#
i (unsafeCoerce# :: forall a b. a -> b
unsafeCoerce# MutableByteArray# s
x)
    readUnliftedArray# :: forall s.
MutableArrayArray# s
-> Int# -> State# s -> (# State# s, MutableByteArray s #)
readUnliftedArray# MutableArrayArray# s
a Int#
i State# s
s0 = case forall d.
MutableArrayArray# d
-> Int# -> State# d -> (# State# d, MutableByteArray# d #)
readMutableByteArrayArray# MutableArrayArray# s
a Int#
i State# s
s0 of
        (# State# s
s1, MutableByteArray# s
x #) -> (# State# s
s1, forall s. MutableByteArray# s -> MutableByteArray s
MutableByteArray (unsafeCoerce# :: forall a b. a -> b
unsafeCoerce# MutableByteArray# s
x) #)
    indexUnliftedArray# :: ArrayArray# -> Int# -> MutableByteArray s
indexUnliftedArray# ArrayArray#
a Int#
i = forall s. MutableByteArray# s -> MutableByteArray s
MutableByteArray (unsafeCoerce# :: forall a b. a -> b
unsafeCoerce# (ArrayArray# -> Int# -> ByteArray#
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# #-}
    writeUnliftedArray# :: forall s.
MutableArrayArray# s
-> Int# -> MutablePrimArray s a -> State# s -> State# s
writeUnliftedArray# MutableArrayArray# s
a Int#
i (MutablePrimArray MutableByteArray# s
x) =
        forall d.
MutableArrayArray# d
-> Int# -> MutableByteArray# d -> State# d -> State# d
writeMutableByteArrayArray# MutableArrayArray# s
a Int#
i (unsafeCoerce# :: forall a b. a -> b
unsafeCoerce# MutableByteArray# s
x)
    readUnliftedArray# :: forall s.
MutableArrayArray# s
-> Int# -> State# s -> (# State# s, MutablePrimArray s a #)
readUnliftedArray# MutableArrayArray# s
a Int#
i State# s
s0 = case forall d.
MutableArrayArray# d
-> Int# -> State# d -> (# State# d, MutableByteArray# d #)
readMutableByteArrayArray# MutableArrayArray# s
a Int#
i State# s
s0 of
        (# State# s
s1, MutableByteArray# s
x #) -> (# State# s
s1, forall s a. MutableByteArray# s -> MutablePrimArray s a
MutablePrimArray (unsafeCoerce# :: forall a b. a -> b
unsafeCoerce# MutableByteArray# s
x) #)
    indexUnliftedArray# :: ArrayArray# -> Int# -> MutablePrimArray s a
indexUnliftedArray# ArrayArray#
a Int#
i = forall s a. MutableByteArray# s -> MutablePrimArray s a
MutablePrimArray (unsafeCoerce# :: forall a b. a -> b
unsafeCoerce# (ArrayArray# -> Int# -> ByteArray#
indexByteArrayArray# ArrayArray#
a Int#
i))

instance PrimUnlifted (MVar a) where
    {-# INLINE writeUnliftedArray# #-}
    {-# INLINE readUnliftedArray# #-}
    {-# INLINE indexUnliftedArray# #-}
    writeUnliftedArray# :: forall s.
MutableArrayArray# s -> Int# -> MVar a -> State# s -> State# s
writeUnliftedArray# MutableArrayArray# s
a Int#
i (MVar MVar# RealWorld a
x) =
        forall d.
MutableArrayArray# d -> Int# -> ArrayArray# -> State# d -> State# d
writeArrayArrayArray# MutableArrayArray# s
a Int#
i (unsafeCoerce# :: forall a b. a -> b
unsafeCoerce# MVar# RealWorld a
x)
    readUnliftedArray# :: forall s.
MutableArrayArray# s -> Int# -> State# s -> (# State# s, MVar a #)
readUnliftedArray# MutableArrayArray# s
a Int#
i State# s
s0 = case forall d.
MutableArrayArray# d
-> Int# -> State# d -> (# State# d, ArrayArray# #)
readArrayArrayArray# MutableArrayArray# s
a Int#
i State# s
s0 of
        (# State# s
s1, ArrayArray#
x #) -> (# State# s
s1, forall a. MVar# RealWorld a -> MVar a
MVar (unsafeCoerce# :: forall a b. a -> b
unsafeCoerce# ArrayArray#
x) #)
    indexUnliftedArray# :: ArrayArray# -> Int# -> MVar a
indexUnliftedArray# ArrayArray#
a Int#
i = forall a. MVar# RealWorld a -> MVar a
MVar (unsafeCoerce# :: forall a b. a -> b
unsafeCoerce# (ArrayArray# -> Int# -> ArrayArray#
indexArrayArrayArray# ArrayArray#
a Int#
i))

instance PrimUnlifted (TVar a) where
    {-# INLINE writeUnliftedArray# #-}
    {-# INLINE readUnliftedArray# #-}
    {-# INLINE indexUnliftedArray# #-}
    writeUnliftedArray# :: forall s.
MutableArrayArray# s -> Int# -> TVar a -> State# s -> State# s
writeUnliftedArray# MutableArrayArray# s
a Int#
i (TVar TVar# RealWorld a
x) =
        forall d.
MutableArrayArray# d -> Int# -> ArrayArray# -> State# d -> State# d
writeArrayArrayArray# MutableArrayArray# s
a Int#
i (unsafeCoerce# :: forall a b. a -> b
unsafeCoerce# TVar# RealWorld a
x)
    readUnliftedArray# :: forall s.
MutableArrayArray# s -> Int# -> State# s -> (# State# s, TVar a #)
readUnliftedArray# MutableArrayArray# s
a Int#
i State# s
s0 = case forall d.
MutableArrayArray# d
-> Int# -> State# d -> (# State# d, ArrayArray# #)
readArrayArrayArray# MutableArrayArray# s
a Int#
i State# s
s0 of
        (# State# s
s1, ArrayArray#
x #) -> (# State# s
s1, forall a. TVar# RealWorld a -> TVar a
TVar (unsafeCoerce# :: forall a b. a -> b
unsafeCoerce# ArrayArray#
x) #)
    indexUnliftedArray# :: ArrayArray# -> Int# -> TVar a
indexUnliftedArray# ArrayArray#
a Int#
i = forall a. TVar# RealWorld a -> TVar a
TVar (unsafeCoerce# :: forall a b. a -> b
unsafeCoerce# (ArrayArray# -> Int# -> ArrayArray#
indexArrayArrayArray# ArrayArray#
a Int#
i))

instance PrimUnlifted (STRef s a) where
    {-# INLINE writeUnliftedArray# #-}
    {-# INLINE readUnliftedArray# #-}
    {-# INLINE indexUnliftedArray# #-}
    writeUnliftedArray# :: forall s.
MutableArrayArray# s -> Int# -> STRef s a -> State# s -> State# s
writeUnliftedArray# MutableArrayArray# s
a Int#
i (STRef MutVar# s a
x) =
        forall d.
MutableArrayArray# d -> Int# -> ArrayArray# -> State# d -> State# d
writeArrayArrayArray# MutableArrayArray# s
a Int#
i (unsafeCoerce# :: forall a b. a -> b
unsafeCoerce# MutVar# s a
x)
    readUnliftedArray# :: forall s.
MutableArrayArray# s
-> Int# -> State# s -> (# State# s, STRef s a #)
readUnliftedArray# MutableArrayArray# s
a Int#
i State# s
s0 = case forall d.
MutableArrayArray# d
-> Int# -> State# d -> (# State# d, ArrayArray# #)
readArrayArrayArray# MutableArrayArray# s
a Int#
i State# s
s0 of
        (# State# s
s1, ArrayArray#
x #) -> (# State# s
s1, forall s a. MutVar# s a -> STRef s a
STRef (unsafeCoerce# :: forall a b. a -> b
unsafeCoerce# ArrayArray#
x) #)
    indexUnliftedArray# :: ArrayArray# -> Int# -> STRef s a
indexUnliftedArray# ArrayArray#
a Int#
i =
        forall s a. MutVar# s a -> STRef s a
STRef (unsafeCoerce# :: forall a b. a -> b
unsafeCoerce# (ArrayArray# -> Int# -> ArrayArray#
indexArrayArrayArray# ArrayArray#
a Int#
i))

instance PrimUnlifted (IORef a) where
    {-# INLINE writeUnliftedArray# #-}
    {-# INLINE readUnliftedArray# #-}
    {-# INLINE indexUnliftedArray# #-}
    writeUnliftedArray# :: forall s.
MutableArrayArray# s -> Int# -> IORef a -> State# s -> State# s
writeUnliftedArray# MutableArrayArray# s
a Int#
i (IORef STRef RealWorld a
v) = forall a s.
PrimUnlifted a =>
MutableArrayArray# s -> Int# -> a -> State# s -> State# s
writeUnliftedArray# MutableArrayArray# s
a Int#
i STRef RealWorld a
v
    readUnliftedArray# :: forall s.
MutableArrayArray# s -> Int# -> State# s -> (# State# s, IORef a #)
readUnliftedArray# MutableArrayArray# s
a Int#
i State# s
s0 = case 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, forall a. STRef RealWorld a -> IORef a
IORef STRef RealWorld a
v #)
    indexUnliftedArray# :: ArrayArray# -> Int# -> IORef a
indexUnliftedArray# ArrayArray#
a Int#
i = forall a. STRef RealWorld a -> IORef a
IORef (forall a. PrimUnlifted a => ArrayArray# -> Int# -> a
indexUnliftedArray# ArrayArray#
a Int#
i)

--------------------------------------------------------------------------------

-- | Mutable array holding 'PrimUnlifted' values.
data MutableUnliftedArray s a
    = MutableUnliftedArray (MutableArrayArray# s)

-- | Array holding 'PrimUnlifted' values.
data UnliftedArray a
    = UnliftedArray ArrayArray#

-- | Creates a new 'MutableUnliftedArray'. This function is unsafe because it
-- initializes all elements of the array as pointers to the array itself. Attempting
-- to read one of these elements before writing to it is in effect an unsafe
-- coercion from the @'MutableUnliftedArray' s a@ to the element type.
unsafeNewUnliftedArray
    :: (PrimMonad m)
    => Int -- ^ size
    -> m (MutableUnliftedArray (PrimState m) a)
{-# INLINE unsafeNewUnliftedArray #-}
unsafeNewUnliftedArray :: forall {k} (m :: * -> *) (a :: k).
PrimMonad m =>
Int -> m (MutableUnliftedArray (PrimState m) a)
unsafeNewUnliftedArray Int
0 = forall (m :: * -> *) a.
PrimMonad m =>
(State# (PrimState m) -> (# State# (PrimState m), a #)) -> m a
primitive forall a b. (a -> b) -> a -> b
$ \State# (PrimState m)
s ->
    -- GHC 9.2 has a bug: call newArrayArray# with 0# length will hang
    -- so we unsafeCoerce# empty Array# into ArrayArray# here
    case forall a d.
Int# -> a -> State# d -> (# State# d, MutableArray# d a #)
newArray# Int#
0# (forall a e. Exception e => e -> a
throw (String -> ArrayException
UndefinedElement String
"Data.Array.UnliftedArray.uninitialized")) State# (PrimState m)
s of
        (# State# (PrimState m)
s', MutableArray# (PrimState m) Any
maa# #) -> (# State# (PrimState m)
s', forall {k} s (a :: k).
MutableArrayArray# s -> MutableUnliftedArray s a
MutableUnliftedArray (unsafeCoerce# :: forall a b. a -> b
unsafeCoerce# MutableArray# (PrimState m) Any
maa#) #)
unsafeNewUnliftedArray (I# Int#
i#) = forall (m :: * -> *) a.
PrimMonad m =>
(State# (PrimState m) -> (# State# (PrimState m), a #)) -> m a
primitive forall a b. (a -> b) -> a -> b
$ \State# (PrimState m)
s -> case forall d. Int# -> State# d -> (# State# d, MutableArrayArray# d #)
newArrayArray# Int#
i# State# (PrimState m)
s of
    (# State# (PrimState m)
s', MutableArrayArray# (PrimState m)
maa# #) -> (# State# (PrimState m)
s', forall {k} s (a :: k).
MutableArrayArray# s -> MutableUnliftedArray s a
MutableUnliftedArray MutableArrayArray# (PrimState m)
maa# #)

emptyUnliftedArray :: PrimUnlifted a => UnliftedArray a
{-# NOINLINE emptyUnliftedArray #-}
emptyUnliftedArray :: forall a. PrimUnlifted a => UnliftedArray a
emptyUnliftedArray = forall a. (forall s. ST s a) -> a
runST (do
    MutableUnliftedArray s a
mua <- forall {k} (m :: * -> *) (a :: k).
PrimMonad m =>
Int -> m (MutableUnliftedArray (PrimState m) a)
unsafeNewUnliftedArray Int
0
    forall {k} (m :: * -> *) (a :: k).
PrimMonad m =>
MutableUnliftedArray (PrimState m) a -> m (UnliftedArray a)
unsafeFreezeUnliftedArray MutableUnliftedArray s a
mua)

-- | Creates a new 'MutableUnliftedArray' with the specified value as initial
-- contents. This is slower than 'unsafeNewUnliftedArray', but safer.
newUnliftedArray
    :: (PrimMonad m, PrimUnlifted a)
    => Int -- ^ size
    -> a -- ^ initial value
    -> m (MutableUnliftedArray (PrimState m) a)
newUnliftedArray :: forall (m :: * -> *) a.
(PrimMonad m, PrimUnlifted a) =>
Int -> a -> m (MutableUnliftedArray (PrimState m) a)
newUnliftedArray Int
len a
v = do
    MutableUnliftedArray (PrimState m) a
mua <- forall {k} (m :: * -> *) (a :: k).
PrimMonad m =>
Int -> m (MutableUnliftedArray (PrimState m) a)
unsafeNewUnliftedArray Int
len
    forall (m :: * -> *) a.
(PrimMonad m, PrimUnlifted a) =>
MutableUnliftedArray (PrimState m) a -> Int -> Int -> a -> m ()
setUnliftedArray MutableUnliftedArray (PrimState m) a
mua Int
0 Int
len a
v
    forall (f :: * -> *) a. Applicative f => a -> f a
pure MutableUnliftedArray (PrimState m) a
mua
{-# INLINE newUnliftedArray #-}

setUnliftedArray
    :: (PrimMonad m, PrimUnlifted a)
    => MutableUnliftedArray (PrimState m) a -- ^ destination
    -> Int -- ^ offset
    -> Int -- ^ length
    -> a -- ^ value to fill with
    -> m ()
{-# INLINE setUnliftedArray #-}
setUnliftedArray :: forall (m :: * -> *) a.
(PrimMonad m, PrimUnlifted a) =>
MutableUnliftedArray (PrimState m) a -> Int -> Int -> a -> m ()
setUnliftedArray MutableUnliftedArray (PrimState m) a
mua Int
off Int
len a
v = Int -> m ()
loop (Int
len forall a. Num a => a -> a -> a
+ Int
off forall a. Num a => a -> a -> a
- Int
1)
  where
    loop :: Int -> m ()
loop Int
i
        | Int
i forall a. Ord a => a -> a -> Bool
< Int
off = forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
        | Bool
otherwise = forall (m :: * -> *) a.
(PrimMonad m, PrimUnlifted a) =>
MutableUnliftedArray (PrimState m) a -> Int -> a -> m ()
writeUnliftedArray MutableUnliftedArray (PrimState m) a
mua Int
i a
v forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Int -> m ()
loop (Int
iforall a. Num a => a -> a -> a
-Int
1)

-- | Yields the length of an 'UnliftedArray'.
sizeofUnliftedArray :: UnliftedArray e -> Int
{-# INLINE sizeofUnliftedArray #-}
sizeofUnliftedArray :: forall {k} (e :: k). UnliftedArray e -> Int
sizeofUnliftedArray (UnliftedArray ArrayArray#
aa#) = Int# -> Int
I# (ArrayArray# -> Int#
sizeofArrayArray# ArrayArray#
aa#)

-- | Yields the length of a 'MutableUnliftedArray'.
sizeofMutableUnliftedArray :: MutableUnliftedArray s e -> Int
{-# INLINE sizeofMutableUnliftedArray #-}
sizeofMutableUnliftedArray :: forall {k} s (e :: k). MutableUnliftedArray s e -> Int
sizeofMutableUnliftedArray (MutableUnliftedArray MutableArrayArray# s
maa#)
    = Int# -> Int
I# (forall d. MutableArrayArray# d -> Int#
sizeofMutableArrayArray# MutableArrayArray# s
maa#)

writeUnliftedArray :: (PrimMonad m, PrimUnlifted a)
    => MutableUnliftedArray (PrimState m) a
    -> Int
    -> a
    -> m ()
{-# INLINE writeUnliftedArray #-}
writeUnliftedArray :: forall (m :: * -> *) a.
(PrimMonad m, PrimUnlifted a) =>
MutableUnliftedArray (PrimState m) a -> Int -> a -> m ()
writeUnliftedArray (MutableUnliftedArray MutableArrayArray# (PrimState m)
arr) (I# Int#
ix) a
a =
    forall (m :: * -> *).
PrimMonad m =>
(State# (PrimState m) -> State# (PrimState m)) -> m ()
primitive_ (forall a s.
PrimUnlifted a =>
MutableArrayArray# s -> Int# -> a -> State# s -> State# s
writeUnliftedArray# MutableArrayArray# (PrimState m)
arr Int#
ix a
a)

readUnliftedArray :: (PrimMonad m, PrimUnlifted a)
    => MutableUnliftedArray (PrimState m) a
    -> Int
    -> m a
{-# INLINE readUnliftedArray #-}
readUnliftedArray :: forall (m :: * -> *) a.
(PrimMonad m, PrimUnlifted a) =>
MutableUnliftedArray (PrimState m) a -> Int -> m a
readUnliftedArray (MutableUnliftedArray MutableArrayArray# (PrimState m)
arr) (I# Int#
ix) =
    forall (m :: * -> *) a.
PrimMonad m =>
(State# (PrimState m) -> (# State# (PrimState m), a #)) -> m a
primitive (forall a s.
PrimUnlifted a =>
MutableArrayArray# s -> Int# -> State# s -> (# State# s, a #)
readUnliftedArray# MutableArrayArray# (PrimState m)
arr Int#
ix)

indexUnliftedArray :: PrimUnlifted a
    => UnliftedArray a
    -> Int
    -> a
{-# INLINE indexUnliftedArray #-}
indexUnliftedArray :: forall a. PrimUnlifted a => UnliftedArray a -> Int -> a
indexUnliftedArray (UnliftedArray ArrayArray#
arr) (I# Int#
ix) =
    forall a. PrimUnlifted a => ArrayArray# -> Int# -> a
indexUnliftedArray# ArrayArray#
arr Int#
ix

-- | Freezes a 'MutableUnliftedArray', yielding an 'UnliftedArray'. This simply
-- marks the array as frozen in place, so it should only be used when no further
-- modifications to the mutable array will be performed.
unsafeFreezeUnliftedArray
    :: (PrimMonad m)
    => MutableUnliftedArray (PrimState m) a
    -> m (UnliftedArray a)
unsafeFreezeUnliftedArray :: forall {k} (m :: * -> *) (a :: k).
PrimMonad m =>
MutableUnliftedArray (PrimState m) a -> m (UnliftedArray a)
unsafeFreezeUnliftedArray (MutableUnliftedArray MutableArrayArray# (PrimState m)
maa#)
    = forall (m :: * -> *) a.
PrimMonad m =>
(State# (PrimState m) -> (# State# (PrimState m), a #)) -> m a
primitive forall a b. (a -> b) -> a -> b
$ \State# (PrimState m)
s -> case forall d.
MutableArrayArray# d -> State# d -> (# State# d, ArrayArray# #)
unsafeFreezeArrayArray# MutableArrayArray# (PrimState m)
maa# State# (PrimState m)
s of
        (# State# (PrimState m)
s', ArrayArray#
aa# #) -> (# State# (PrimState m)
s', forall {k} (a :: k). ArrayArray# -> UnliftedArray a
UnliftedArray ArrayArray#
aa# #)
{-# INLINE unsafeFreezeUnliftedArray #-}

-- | Determines whether two 'MutableUnliftedArray' values are the same. This is
-- object/pointer identity, not based on the contents.
sameMutableUnliftedArray
    :: MutableUnliftedArray s a
    -> MutableUnliftedArray s a
    -> Bool
sameMutableUnliftedArray :: forall {k} s (a :: k).
MutableUnliftedArray s a -> MutableUnliftedArray s a -> Bool
sameMutableUnliftedArray (MutableUnliftedArray MutableArrayArray# s
maa1#) (MutableUnliftedArray MutableArrayArray# s
maa2#)
    = Int# -> Bool
isTrue# (forall d. MutableArrayArray# d -> MutableArrayArray# d -> Int#
sameMutableArrayArray# MutableArrayArray# s
maa1# MutableArrayArray# s
maa2#)
{-# INLINE sameMutableUnliftedArray #-}

-- | Copies the contents of an immutable array into a mutable array.
copyUnliftedArray
    :: (PrimMonad m)
    => MutableUnliftedArray (PrimState m) a -- ^ destination
    -> Int -- ^ offset into destination
    -> UnliftedArray a -- ^ source
    -> Int -- ^ offset into source
    -> Int -- ^ number of elements to copy
    -> m ()
{-# INLINE copyUnliftedArray #-}
copyUnliftedArray :: forall {k} (m :: * -> *) (a :: k).
PrimMonad m =>
MutableUnliftedArray (PrimState m) a
-> Int -> UnliftedArray a -> Int -> Int -> m ()
copyUnliftedArray
    (MutableUnliftedArray MutableArrayArray# (PrimState m)
dst) (I# Int#
doff)
    (UnliftedArray ArrayArray#
src) (I# Int#
soff) (I# Int#
ln) =
      forall (m :: * -> *).
PrimMonad m =>
(State# (PrimState m) -> State# (PrimState m)) -> m ()
primitive_ forall a b. (a -> b) -> a -> b
$ forall d.
ArrayArray#
-> Int#
-> MutableArrayArray# d
-> Int#
-> Int#
-> State# d
-> State# d
copyArrayArray# ArrayArray#
src Int#
soff MutableArrayArray# (PrimState m)
dst Int#
doff Int#
ln


-- | Copies the contents of one mutable array into another.
copyMutableUnliftedArray
    :: (PrimMonad m)
    => MutableUnliftedArray (PrimState m) a -- ^ destination
    -> Int -- ^ offset into destination
    -> MutableUnliftedArray (PrimState m) a -- ^ source
    -> Int -- ^ offset into source
    -> Int -- ^ number of elements to copy
    -> m ()
{-# INLINE copyMutableUnliftedArray #-}
copyMutableUnliftedArray :: forall {k} (m :: * -> *) (a :: k).
PrimMonad m =>
MutableUnliftedArray (PrimState m) a
-> Int
-> MutableUnliftedArray (PrimState m) a
-> Int
-> Int
-> m ()
copyMutableUnliftedArray
    (MutableUnliftedArray MutableArrayArray# (PrimState m)
dst) (I# Int#
doff)
    (MutableUnliftedArray MutableArrayArray# (PrimState m)
src) (I# Int#
soff) (I# Int#
ln) =
      forall (m :: * -> *).
PrimMonad m =>
(State# (PrimState m) -> State# (PrimState m)) -> m ()
primitive_ forall a b. (a -> b) -> a -> b
$ forall d.
MutableArrayArray# d
-> Int#
-> MutableArrayArray# d
-> Int#
-> Int#
-> State# d
-> State# d
copyMutableArrayArray# MutableArrayArray# (PrimState m)
src Int#
soff MutableArrayArray# (PrimState m)
dst Int#
doff Int#
ln


-- | Freezes a portion of a 'MutableUnliftedArray', yielding an 'UnliftedArray'.
-- This operation is safe, in that it copies the frozen portion, and the
-- existing mutable array may still be used afterward.
freezeUnliftedArray
    :: (PrimMonad m)
    => MutableUnliftedArray (PrimState m) a -- ^ source
    -> Int -- ^ offset
    -> Int -- ^ length
    -> m (UnliftedArray a)
freezeUnliftedArray :: forall {k} (m :: * -> *) (a :: k).
PrimMonad m =>
MutableUnliftedArray (PrimState m) a
-> Int -> Int -> m (UnliftedArray a)
freezeUnliftedArray MutableUnliftedArray (PrimState m) a
src Int
off Int
len = do
    MutableUnliftedArray (PrimState m) a
dst <- forall {k} (m :: * -> *) (a :: k).
PrimMonad m =>
Int -> m (MutableUnliftedArray (PrimState m) a)
unsafeNewUnliftedArray Int
len
    forall {k} (m :: * -> *) (a :: k).
PrimMonad m =>
MutableUnliftedArray (PrimState m) a
-> Int
-> MutableUnliftedArray (PrimState m) a
-> Int
-> Int
-> m ()
copyMutableUnliftedArray MutableUnliftedArray (PrimState m) a
dst Int
0 MutableUnliftedArray (PrimState m) a
src Int
off Int
len
    forall {k} (m :: * -> *) (a :: k).
PrimMonad m =>
MutableUnliftedArray (PrimState m) a -> m (UnliftedArray a)
unsafeFreezeUnliftedArray MutableUnliftedArray (PrimState m) a
dst
{-# INLINE freezeUnliftedArray #-}


-- | Thaws a portion of an 'UnliftedArray', yielding a 'MutableUnliftedArray'.
-- This copies the thawed portion, so mutations will not affect the original
-- array.
thawUnliftedArray
    :: (PrimMonad m)
    => UnliftedArray a -- ^ source
    -> Int -- ^ offset
    -> Int -- ^ length
    -> m (MutableUnliftedArray (PrimState m) a)
{-# INLINE thawUnliftedArray #-}
thawUnliftedArray :: forall {k} (m :: * -> *) (a :: k).
PrimMonad m =>
UnliftedArray a
-> Int -> Int -> m (MutableUnliftedArray (PrimState m) a)
thawUnliftedArray UnliftedArray a
src Int
off Int
len = do
    MutableUnliftedArray (PrimState m) a
dst <- forall {k} (m :: * -> *) (a :: k).
PrimMonad m =>
Int -> m (MutableUnliftedArray (PrimState m) a)
unsafeNewUnliftedArray Int
len
    forall {k} (m :: * -> *) (a :: k).
PrimMonad m =>
MutableUnliftedArray (PrimState m) a
-> Int -> UnliftedArray a -> Int -> Int -> m ()
copyUnliftedArray MutableUnliftedArray (PrimState m) a
dst Int
0 UnliftedArray a
src Int
off Int
len
    forall (m :: * -> *) a. Monad m => a -> m a
return MutableUnliftedArray (PrimState m) a
dst

-- | Creates a copy of a portion of an 'UnliftedArray'
cloneUnliftedArray
    :: UnliftedArray a -- ^ source
    -> Int -- ^ offset
    -> Int -- ^ length
    -> UnliftedArray a
{-# INLINE cloneUnliftedArray #-}
cloneUnliftedArray :: forall {k} (a :: k).
UnliftedArray a -> Int -> Int -> UnliftedArray a
cloneUnliftedArray UnliftedArray a
src Int
off Int
len = forall a. IO a -> a
unsafeDupablePerformIO forall a b. (a -> b) -> a -> b
$ do
    MutableUnliftedArray RealWorld a
dst <- forall {k} (m :: * -> *) (a :: k).
PrimMonad m =>
Int -> m (MutableUnliftedArray (PrimState m) a)
unsafeNewUnliftedArray Int
len
    forall {k} (m :: * -> *) (a :: k).
PrimMonad m =>
MutableUnliftedArray (PrimState m) a
-> Int -> UnliftedArray a -> Int -> Int -> m ()
copyUnliftedArray MutableUnliftedArray RealWorld a
dst Int
0 UnliftedArray a
src Int
off Int
len
    forall {k} (m :: * -> *) (a :: k).
PrimMonad m =>
MutableUnliftedArray (PrimState m) a -> m (UnliftedArray a)
unsafeFreezeUnliftedArray MutableUnliftedArray RealWorld a
dst

-- | Creates a new 'MutableUnliftedArray' containing a copy of a portion of
-- another mutable array.
cloneMutableUnliftedArray
    :: (PrimMonad m)
    => MutableUnliftedArray (PrimState m) a -- ^ source
    -> Int -- ^ offset
    -> Int -- ^ length
    -> m (MutableUnliftedArray (PrimState m) a)
{-# INLINE cloneMutableUnliftedArray #-}
cloneMutableUnliftedArray :: forall {k} (m :: * -> *) (a :: k).
PrimMonad m =>
MutableUnliftedArray (PrimState m) a
-> Int -> Int -> m (MutableUnliftedArray (PrimState m) a)
cloneMutableUnliftedArray MutableUnliftedArray (PrimState m) a
src Int
off Int
len = do
    MutableUnliftedArray (PrimState m) a
dst <- forall {k} (m :: * -> *) (a :: k).
PrimMonad m =>
Int -> m (MutableUnliftedArray (PrimState m) a)
unsafeNewUnliftedArray Int
len
    forall {k} (m :: * -> *) (a :: k).
PrimMonad m =>
MutableUnliftedArray (PrimState m) a
-> Int
-> MutableUnliftedArray (PrimState m) a
-> Int
-> Int
-> m ()
copyMutableUnliftedArray MutableUnliftedArray (PrimState m) a
dst Int
0 MutableUnliftedArray (PrimState m) a
src Int
off Int
len
    forall (m :: * -> *) a. Monad m => a -> m a
return MutableUnliftedArray (PrimState m) a
dst