{-# language MagicHash #-}
{-# language UnboxedTuples #-}
{-# language RoleAnnotations #-}
{-# language UnliftedNewtypes #-}
{-# language KindSignatures #-}
{-# language StandaloneKindSignatures #-}
{-# language ScopedTypeVariables #-}
{-# language DataKinds #-}
{-# language UnliftedDatatypes #-}

-- Oh what a mess this is! See UnsafeCoercions.md for an explanation
-- of the hodgepodge in this module.

-- |
-- Primitive types representing unlifted arrays and the
-- primops for manipulating them.
module Data.Primitive.Unlifted.Array.Primops
  ( -- * Types
    UnliftedArray#(..)
  , MutableUnliftedArray#(..)

    -- * Operations
  , newUnliftedArray#
  , unsafeNewUnliftedArray#
  , emptyUnliftedArray#
  , sameMutableUnliftedArray#
  , readUnliftedArray#
  , writeUnliftedArray#
  , sizeofUnliftedArray#
  , sizeofMutableUnliftedArray#
  , indexUnliftedArray#
  , unsafeFreezeUnliftedArray#
  , unsafeThawUnliftedArray#
  , copyUnliftedArray#
  , copyMutableUnliftedArray#
  , cloneUnliftedArray#
  , cloneMutableUnliftedArray#
  , freezeUnliftedArray#
  , thawUnliftedArray#
  , casUnliftedArray#
  ) where

import Data.Coerce (coerce)
import GHC.Exts ( Int#, State#, Array#, MutableArray# )
import qualified GHC.Exts as Exts

import Data.Primitive.Unlifted.Type
import Unsafe.Coerce (unsafeCoerceUnlifted)

newtype UnliftedArray# (a :: UnliftedType) = UnliftedArray# (Array# a)
type role UnliftedArray# representational

newtype MutableUnliftedArray# s (a :: UnliftedType) = MutableUnliftedArray# (MutableArray# s a)
type role MutableUnliftedArray# nominal representational

newUnliftedArray# :: Int# -> a -> State# s -> (# State# s, MutableUnliftedArray# s a #)
newUnliftedArray# :: forall (a :: UnliftedType) s.
Int# -> a -> State# s -> (# State# s, MutableUnliftedArray# s a #)
newUnliftedArray# Int#
sz a
a State# s
s = (# State# s, MutableArray# s a #)
-> (# State# s, MutableUnliftedArray# s a #)
forall a b. Coercible a b => a -> b
coerce (Int# -> a -> State# s -> (# State# s, MutableArray# s a #)
forall a d.
Int# -> a -> State# d -> (# State# d, MutableArray# d a #)
Exts.newArray# Int#
sz a
a State# s
s)
{-# INLINE newUnliftedArray# #-}

-- | Create a 'MutableUnliftedArray#' whose entries contain some unspecified
-- static value. This may be more convenient than 'newUnliftedArray#' if there
-- is no value on hand with which to initialize the array. Each entry must be
-- initialized before being read and used. This condition is not checked.
unsafeNewUnliftedArray# :: Int# -> State# s -> (# State# s, MutableUnliftedArray# s a #)
unsafeNewUnliftedArray# :: forall s (a :: UnliftedType).
Int# -> State# s -> (# State# s, MutableUnliftedArray# s a #)
unsafeNewUnliftedArray# Int#
sz State# s
s
  | (# State# s
s', MutableArray# s a
mary #) <- Int# -> a -> State# s -> (# State# s, MutableArray# s a #)
forall a d.
Int# -> a -> State# d -> (# State# d, MutableArray# d a #)
Exts.newArray# Int#
sz (Nonsense -> a
forall (a :: UnliftedType) (b :: UnliftedType). a -> b
unsafeCoerceUnlifted Nonsense
Nonsense) State# s
s
  = (# State# s
s', MutableArray# s a -> MutableUnliftedArray# s a
forall s (a :: UnliftedType).
MutableArray# s a -> MutableUnliftedArray# s a
MutableUnliftedArray# MutableArray# s a
mary #)
{-# INLINE unsafeNewUnliftedArray# #-}

type Nonsense :: UnliftedType
data Nonsense = Nonsense

-- This represents a *statically allocated* value, preferably in a *read-only*
-- segment of memory.
--
-- Why do we bother to noDuplicate#? It generally doesn't much *matter* if
-- different threads have different global empty arrays. However, for
-- performance testing purposes, a user may well want to check whether the
-- empty arrays they expect to be the global ones really are. Such a test
-- is only possible if there's just *one* array to test against. The overhead
-- of the once-ever noDuplicate# call is sure to be trivial anyway.
empty_unlifted_array :: ULA a
empty_unlifted_array :: forall (a :: UnliftedType). ULA a
empty_unlifted_array = UnliftedArray# a -> ULA a
forall (a :: UnliftedType). UnliftedArray# a -> ULA a
ULA
  ((State# RealWorld -> UnliftedArray# a) -> UnliftedArray# a
forall o. (State# RealWorld -> o) -> o
Exts.runRW# ((State# RealWorld -> UnliftedArray# a) -> UnliftedArray# a)
-> (State# RealWorld -> UnliftedArray# a) -> UnliftedArray# a
forall a b. (a -> b) -> a -> b
$ \State# RealWorld
s ->
    case State# RealWorld -> State# RealWorld
forall d. State# d -> State# d
Exts.noDuplicate# State# RealWorld
s of { State# RealWorld
s' ->
    case Int#
-> State# RealWorld
-> (# State# RealWorld, MutableUnliftedArray# RealWorld a #)
forall s (a :: UnliftedType).
Int# -> State# s -> (# State# s, MutableUnliftedArray# s a #)
unsafeNewUnliftedArray# Int#
0# State# RealWorld
s' of { (# State# RealWorld
s'', MutableUnliftedArray# RealWorld a
mary #) ->
    case MutableUnliftedArray# RealWorld a
-> State# RealWorld -> (# State# RealWorld, UnliftedArray# a #)
forall s (a :: UnliftedType).
MutableUnliftedArray# s a
-> State# s -> (# State# s, UnliftedArray# a #)
unsafeFreezeUnliftedArray# MutableUnliftedArray# RealWorld a
mary State# RealWorld
s'' of { (# State# RealWorld
_, UnliftedArray# a
ary #) ->
      UnliftedArray# a
ary }}})
{-# NOINLINE empty_unlifted_array #-}

data ULA a = ULA (UnliftedArray# a)

-- | Warning: Applying 'unsafeThawUnliftedArray#' to the array produced by
-- this function will make demons come out of your nose.
emptyUnliftedArray# :: (##) -> UnliftedArray# a
-- We make this primitive because it's the easiest way to get a
-- *shared* primitive unlifted array.
--
-- Why the stern warning above? GHC does not currently support resizing 'Array#',
-- and does not really meaningfully support *growing* arrays of any type. If,
-- however, that ever changes, growing the globally shared empty array would be
-- pretty disastrous.
emptyUnliftedArray# :: forall (a :: UnliftedType). (# #) -> UnliftedArray# a
emptyUnliftedArray# (##) = case ULA a
forall (a :: UnliftedType). ULA a
empty_unlifted_array of
  ULA UnliftedArray# a
ary -> UnliftedArray# a
ary
{-# INLINE emptyUnliftedArray# #-}

sameMutableUnliftedArray# :: MutableUnliftedArray# s a -> MutableUnliftedArray# s a -> Int#
sameMutableUnliftedArray# :: forall s (a :: UnliftedType).
MutableUnliftedArray# s a -> MutableUnliftedArray# s a -> Int#
sameMutableUnliftedArray# (MutableUnliftedArray# MutableArray# s a
ar1) (MutableUnliftedArray# MutableArray# s a
ar2)
  = MutableArray# s a -> MutableArray# s a -> Int#
forall a b. a -> b -> Int#
Exts.reallyUnsafePtrEquality# MutableArray# s a
ar1 MutableArray# s a
ar2
{-# INLINE sameMutableUnliftedArray# #-}

readUnliftedArray# :: MutableUnliftedArray# s a -> Int# -> State# s -> (# State# s, a #)
readUnliftedArray# :: forall s (a :: UnliftedType).
MutableUnliftedArray# s a -> Int# -> State# s -> (# State# s, a #)
readUnliftedArray# (MutableUnliftedArray# MutableArray# s a
mary) Int#
i State# s
s
  = (# State# s, a #) -> (# State# s, a #)
forall a b. Coercible a b => a -> b
coerce (MutableArray# s a -> Int# -> State# s -> (# State# s, a #)
forall d a.
MutableArray# d a -> Int# -> State# d -> (# State# d, a #)
Exts.readArray# MutableArray# s a
mary Int#
i State# s
s)
{-# INLINE readUnliftedArray# #-}

writeUnliftedArray# :: MutableUnliftedArray# s a -> Int# -> a -> State# s -> State# s
writeUnliftedArray# :: forall s (a :: UnliftedType).
MutableUnliftedArray# s a -> Int# -> a -> State# s -> State# s
writeUnliftedArray# (MutableUnliftedArray# MutableArray# s a
mary) Int#
i a
a State# s
s
  = MutableArray# s a -> Int# -> a -> State# s -> State# s
forall d a. MutableArray# d a -> Int# -> a -> State# d -> State# d
Exts.writeArray# MutableArray# s a
mary Int#
i a
a State# s
s
{-# INLINE writeUnliftedArray# #-}

sizeofUnliftedArray# :: UnliftedArray# a -> Int#
sizeofUnliftedArray# :: forall (a :: UnliftedType). UnliftedArray# a -> Int#
sizeofUnliftedArray# (UnliftedArray# Array# a
ary) = Array# a -> Int#
forall a. Array# a -> Int#
Exts.sizeofArray# Array# a
ary
{-# INLINE sizeofUnliftedArray# #-}

sizeofMutableUnliftedArray# :: MutableUnliftedArray# s a -> Int#
sizeofMutableUnliftedArray# :: forall s (a :: UnliftedType). MutableUnliftedArray# s a -> Int#
sizeofMutableUnliftedArray# (MutableUnliftedArray# MutableArray# s a
mary)
  = MutableArray# s a -> Int#
forall d a. MutableArray# d a -> Int#
Exts.sizeofMutableArray# MutableArray# s a
mary
{-# INLINE sizeofMutableUnliftedArray# #-}

indexUnliftedArray# :: UnliftedArray# a -> Int# -> a
indexUnliftedArray# :: forall (a :: UnliftedType). UnliftedArray# a -> Int# -> a
indexUnliftedArray# (UnliftedArray# Array# a
ary) Int#
i
  = case Array# a -> Int# -> (# a #)
forall a. Array# a -> Int# -> (# a #)
Exts.indexArray# Array# a
ary Int#
i of (# a
a #) -> a
a
{-# INLINE indexUnliftedArray# #-}

unsafeFreezeUnliftedArray# :: MutableUnliftedArray# s a -> State# s -> (# State# s, UnliftedArray# a #)
unsafeFreezeUnliftedArray# :: forall s (a :: UnliftedType).
MutableUnliftedArray# s a
-> State# s -> (# State# s, UnliftedArray# a #)
unsafeFreezeUnliftedArray# (MutableUnliftedArray# MutableArray# s a
mary) State# s
s
  = case MutableArray# s a -> State# s -> (# State# s, Array# a #)
forall d a.
MutableArray# d a -> State# d -> (# State# d, Array# a #)
Exts.unsafeFreezeArray# MutableArray# s a
mary State# s
s of
      (# State# s
s', Array# a
ary #) -> (# State# s
s', Array# a -> UnliftedArray# a
forall (a :: UnliftedType). Array# a -> UnliftedArray# a
UnliftedArray# Array# a
ary #)
{-# INLINE unsafeFreezeUnliftedArray# #-}

unsafeThawUnliftedArray# :: UnliftedArray# a -> State# s -> (# State# s, MutableUnliftedArray# s a #)
unsafeThawUnliftedArray# :: forall (a :: UnliftedType) s.
UnliftedArray# a
-> State# s -> (# State# s, MutableUnliftedArray# s a #)
unsafeThawUnliftedArray# (UnliftedArray# Array# a
ary) State# s
s
  = case Array# a -> State# s -> (# State# s, MutableArray# s a #)
forall a d.
Array# a -> State# d -> (# State# d, MutableArray# d a #)
Exts.unsafeThawArray# Array# a
ary State# s
s of
     (# State# s
s', MutableArray# s a
mary #) -> (# State# s
s', MutableArray# s a -> MutableUnliftedArray# s a
forall s (a :: UnliftedType).
MutableArray# s a -> MutableUnliftedArray# s a
MutableUnliftedArray# MutableArray# s a
mary #)
{-# INLINE unsafeThawUnliftedArray# #-}

copyUnliftedArray# :: UnliftedArray# a -> Int# -> MutableUnliftedArray# s a -> Int# -> Int# -> State# s -> State# s
copyUnliftedArray# :: forall (a :: UnliftedType) s.
UnliftedArray# a
-> Int#
-> MutableUnliftedArray# s a
-> Int#
-> Int#
-> State# s
-> State# s
copyUnliftedArray# (UnliftedArray# Array# a
ary) Int#
i1 (MutableUnliftedArray# MutableArray# s a
mary) Int#
i2 Int#
n State# s
s
  = Array# a
-> Int#
-> MutableArray# s a
-> Int#
-> Int#
-> State# s
-> State# s
forall a d.
Array# a
-> Int#
-> MutableArray# d a
-> Int#
-> Int#
-> State# d
-> State# d
Exts.copyArray# Array# a
ary Int#
i1 MutableArray# s a
mary Int#
i2 Int#
n State# s
s
{-# INLINE copyUnliftedArray# #-}

copyMutableUnliftedArray# :: MutableUnliftedArray# s a -> Int# -> MutableUnliftedArray# s a -> Int# -> Int# -> State# s -> State# s
copyMutableUnliftedArray# :: forall s (a :: UnliftedType).
MutableUnliftedArray# s a
-> Int#
-> MutableUnliftedArray# s a
-> Int#
-> Int#
-> State# s
-> State# s
copyMutableUnliftedArray# (MutableUnliftedArray# MutableArray# s a
mary1) Int#
i1 (MutableUnliftedArray# MutableArray# s a
mary2) Int#
i2 Int#
n State# s
s
  = MutableArray# s a
-> Int#
-> MutableArray# s a
-> Int#
-> Int#
-> State# s
-> State# s
forall d a.
MutableArray# d a
-> Int#
-> MutableArray# d a
-> Int#
-> Int#
-> State# d
-> State# d
Exts.copyMutableArray# MutableArray# s a
mary1 Int#
i1 MutableArray# s a
mary2 Int#
i2 Int#
n State# s
s
{-# INLINE copyMutableUnliftedArray# #-}

cloneUnliftedArray# :: UnliftedArray# a -> Int# -> Int# -> UnliftedArray# a
cloneUnliftedArray# :: forall (a :: UnliftedType).
UnliftedArray# a -> Int# -> Int# -> UnliftedArray# a
cloneUnliftedArray# (UnliftedArray# Array# a
ary) Int#
i Int#
n
  = Array# a -> UnliftedArray# a
forall (a :: UnliftedType). Array# a -> UnliftedArray# a
UnliftedArray# (Array# a -> Int# -> Int# -> Array# a
forall a. Array# a -> Int# -> Int# -> Array# a
Exts.cloneArray# Array# a
ary Int#
i Int#
n)
{-# INLINE cloneUnliftedArray# #-}

cloneMutableUnliftedArray# :: MutableUnliftedArray# s a -> Int# -> Int# -> State# s
  -> (# State# s, MutableUnliftedArray# s a #)
cloneMutableUnliftedArray# :: forall s (a :: UnliftedType).
MutableUnliftedArray# s a
-> Int#
-> Int#
-> State# s
-> (# State# s, MutableUnliftedArray# s a #)
cloneMutableUnliftedArray# (MutableUnliftedArray# MutableArray# s a
mary) Int#
i Int#
n State# s
s
  = case MutableArray# s a
-> Int# -> Int# -> State# s -> (# State# s, MutableArray# s a #)
forall d a.
MutableArray# d a
-> Int# -> Int# -> State# d -> (# State# d, MutableArray# d a #)
Exts.cloneMutableArray# MutableArray# s a
mary Int#
i Int#
n State# s
s of
      (# State# s
s', MutableArray# s a
mary' #) -> (# State# s
s', MutableArray# s a -> MutableUnliftedArray# s a
forall s (a :: UnliftedType).
MutableArray# s a -> MutableUnliftedArray# s a
MutableUnliftedArray# MutableArray# s a
mary' #)
{-# INLINE cloneMutableUnliftedArray# #-}

freezeUnliftedArray# :: MutableUnliftedArray# s a -> Int# -> Int# -> State# s -> (# State# s, UnliftedArray# a #)
freezeUnliftedArray# :: forall s (a :: UnliftedType).
MutableUnliftedArray# s a
-> Int# -> Int# -> State# s -> (# State# s, UnliftedArray# a #)
freezeUnliftedArray# (MutableUnliftedArray# MutableArray# s a
mary) Int#
i Int#
n State# s
s
  = case MutableArray# s a
-> Int# -> Int# -> State# s -> (# State# s, Array# a #)
forall d a.
MutableArray# d a
-> Int# -> Int# -> State# d -> (# State# d, Array# a #)
Exts.freezeArray# MutableArray# s a
mary Int#
i Int#
n State# s
s of
      (# State# s
s', Array# a
ary #) -> (# State# s
s', Array# a -> UnliftedArray# a
forall (a :: UnliftedType). Array# a -> UnliftedArray# a
UnliftedArray# Array# a
ary #)
{-# INLINE freezeUnliftedArray# #-}

thawUnliftedArray# :: UnliftedArray# a -> Int# -> Int# -> State# s -> (# State# s, MutableUnliftedArray# s a #)
thawUnliftedArray# :: forall (a :: UnliftedType) s.
UnliftedArray# a
-> Int#
-> Int#
-> State# s
-> (# State# s, MutableUnliftedArray# s a #)
thawUnliftedArray# (UnliftedArray# Array# a
ary) Int#
i Int#
n State# s
s
  = case Array# a
-> Int# -> Int# -> State# s -> (# State# s, MutableArray# s a #)
forall a d.
Array# a
-> Int# -> Int# -> State# d -> (# State# d, MutableArray# d a #)
Exts.thawArray# Array# a
ary Int#
i Int#
n State# s
s of
      (# State# s
s', MutableArray# s a
mary #) -> (# State# s
s', MutableArray# s a -> MutableUnliftedArray# s a
forall s (a :: UnliftedType).
MutableArray# s a -> MutableUnliftedArray# s a
MutableUnliftedArray# MutableArray# s a
mary #)
{-# INLINE thawUnliftedArray# #-}

casUnliftedArray# :: MutableUnliftedArray# s a -> Int# -> a -> a -> State# s -> (# State# s, Int#, a #)
casUnliftedArray# :: forall s (a :: UnliftedType).
MutableUnliftedArray# s a
-> Int# -> a -> a -> State# s -> (# State# s, Int#, a #)
casUnliftedArray# (MutableUnliftedArray# MutableArray# s a
mary) Int#
i a
x a
y State# s
s
  = (# State# s, Int#, a #) -> (# State# s, Int#, a #)
forall a b. Coercible a b => a -> b
coerce (MutableArray# s a
-> Int# -> a -> a -> State# s -> (# State# s, Int#, a #)
forall d a.
MutableArray# d a
-> Int# -> a -> a -> State# d -> (# State# d, Int#, a #)
Exts.casArray# MutableArray# s a
mary Int#
i a
x a
y State# s
s)
{-# INLINE casUnliftedArray# #-}