{-# language MagicHash #-}
{-# language UnboxedTuples #-}
{-# language RoleAnnotations #-}
{-# language UnliftedNewtypes #-}
{-# language KindSignatures #-}
{-# language ScopedTypeVariables #-}

-- 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#
    -- We don't export the newtype constructors because they're bogus and
    -- because there's basically no reason they'd ever be used. This module
    -- contains a wrapped version of every Array# primop.  Eventually, all this
    -- stuff will be supported by GHC.Prim using BoxedRep.

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

import GHC.Exts ( Int#, State#, ArrayArray#, MutableArrayArray#
                , TYPE, RuntimeRep (UnliftedRep), unsafeCoerce#)
import qualified GHC.Exts as Exts

unsafeCoerceUnlifted :: forall (a :: TYPE 'UnliftedRep) (b :: TYPE 'UnliftedRep). a -> b
{-# INLINE unsafeCoerceUnlifted #-}
unsafeCoerceUnlifted :: a -> b
unsafeCoerceUnlifted a
a = a -> b
unsafeCoerce# a
a

unsafeCoerceUnliftedST :: forall s (a :: TYPE 'UnliftedRep) (b :: TYPE 'UnliftedRep). (# State# s, a #) -> (# State# s, b #)
{-# INLINE unsafeCoerceUnliftedST #-}
unsafeCoerceUnliftedST :: (# State# s, a #) -> (# State# s, b #)
unsafeCoerceUnliftedST (# State# s, a #)
a = (# State# s, a #) -> (# State# s, b #)
unsafeCoerce# (# State# s, a #)
a

newtype UnliftedArray# (a :: TYPE 'UnliftedRep) = UnliftedArray# ArrayArray#
type role UnliftedArray# representational

newtype MutableUnliftedArray# s (a :: TYPE 'UnliftedRep) = MutableUnliftedArray# (MutableArrayArray# s)
type role MutableUnliftedArray# nominal representational

newUnliftedArray# :: Int# -> a -> State# s -> (# State# s, MutableUnliftedArray# s a #)
newUnliftedArray# :: Int# -> a -> State# s -> (# State# s, MutableUnliftedArray# s a #)
newUnliftedArray# Int#
sz a
a State# s
s = (# State# s, MutableArray# s Any #)
-> (# State# s, MutableUnliftedArray# s a #)
forall s (a :: TYPE 'UnliftedRep) (b :: TYPE 'UnliftedRep).
(# State# s, a #) -> (# State# s, b #)
unsafeCoerceUnliftedST (Int# -> Any -> State# s -> (# State# s, MutableArray# s Any #)
forall k1 d.
Int# -> k1 -> State# d -> (# State# d, MutableArray# d k1 #)
Exts.newArray# Int#
sz (a -> Any
unsafeCoerce# a
a) State# s
s)
{-# NOINLINE 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# :: Int# -> State# s -> (# State# s, MutableUnliftedArray# s a #)
unsafeNewUnliftedArray# Int#
sz State# s
s = case Int# -> State# s -> (# State# s, MutableArrayArray# s #)
forall d. Int# -> State# d -> (# State# d, MutableArrayArray# d #)
Exts.newArrayArray# Int#
sz State# s
s of
  (# State# s
s', MutableArrayArray# s
mary #) -> (# State# s
s', MutableArrayArray# s -> MutableUnliftedArray# s a
forall s (a :: TYPE 'UnliftedRep).
MutableArrayArray# s -> MutableUnliftedArray# s a
MutableUnliftedArray# MutableArrayArray# s
mary #)
{-# INLINE unsafeNewUnliftedArray# #-}

-- 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 :: ULA a
empty_unlifted_array = UnliftedArray# a -> ULA a
forall (a :: TYPE 'UnliftedRep). 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 :: TYPE 'UnliftedRep).
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 :: TYPE 'UnliftedRep).
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# :: (# #) -> UnliftedArray# a
emptyUnliftedArray# (##) = case ULA a
forall (a :: TYPE 'UnliftedRep). ULA a
empty_unlifted_array of
  ULA UnliftedArray# a
ary -> UnliftedArray# a
ary
{-# INLINE emptyUnliftedArray# #-}

sameMutableUnliftedArray# :: MutableUnliftedArray# s a -> MutableUnliftedArray# s a -> Int#
sameMutableUnliftedArray# :: MutableUnliftedArray# s a -> MutableUnliftedArray# s a -> Int#
sameMutableUnliftedArray# (MutableUnliftedArray# MutableArrayArray# s
ar1) (MutableUnliftedArray# MutableArrayArray# s
ar2)
  = MutableArrayArray# s -> MutableArrayArray# s -> Int#
forall d. MutableArrayArray# d -> MutableArrayArray# d -> Int#
Exts.sameMutableArrayArray# MutableArrayArray# s
ar1 MutableArrayArray# s
ar2
{-# INLINE sameMutableUnliftedArray# #-}

readUnliftedArray# :: MutableUnliftedArray# s a -> Int# -> State# s -> (# State# s, a #)
readUnliftedArray# :: MutableUnliftedArray# s a -> Int# -> State# s -> (# State# s, a #)
readUnliftedArray# (MutableUnliftedArray# MutableArrayArray# s
mary) Int#
i State# s
s
  = (# State# s, ArrayArray# #) -> (# State# s, a #)
forall s (a :: TYPE 'UnliftedRep) (b :: TYPE 'UnliftedRep).
(# State# s, a #) -> (# State# s, b #)
unsafeCoerceUnliftedST (MutableArrayArray# s
-> Int# -> State# s -> (# State# s, ArrayArray# #)
forall d.
MutableArrayArray# d
-> Int# -> State# d -> (# State# d, ArrayArray# #)
Exts.readArrayArrayArray# MutableArrayArray# s
mary Int#
i State# s
s)
{-# INLINE readUnliftedArray# #-}

writeUnliftedArray# :: MutableUnliftedArray# s a -> Int# -> a -> State# s -> State# s
writeUnliftedArray# :: MutableUnliftedArray# s a -> Int# -> a -> State# s -> State# s
writeUnliftedArray# (MutableUnliftedArray# MutableArrayArray# s
mary) Int#
i a
a State# s
s
  = MutableArrayArray# s -> Int# -> ArrayArray# -> State# s -> State# s
forall d.
MutableArrayArray# d -> Int# -> ArrayArray# -> State# d -> State# d
Exts.writeArrayArrayArray# MutableArrayArray# s
mary Int#
i (a -> ArrayArray#
forall (a :: TYPE 'UnliftedRep) (b :: TYPE 'UnliftedRep). a -> b
unsafeCoerceUnlifted a
a) State# s
s
{-# INLINE writeUnliftedArray# #-}

sizeofUnliftedArray# :: UnliftedArray# a -> Int#
sizeofUnliftedArray# :: UnliftedArray# a -> Int#
sizeofUnliftedArray# (UnliftedArray# ArrayArray#
ary) = ArrayArray# -> Int#
Exts.sizeofArrayArray# ArrayArray#
ary
{-# INLINE sizeofUnliftedArray# #-}

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

indexUnliftedArray# :: UnliftedArray# a -> Int# -> a
indexUnliftedArray# :: UnliftedArray# a -> Int# -> a
indexUnliftedArray# (UnliftedArray# ArrayArray#
ary) Int#
i
  = ArrayArray# -> a
forall (a :: TYPE 'UnliftedRep) (b :: TYPE 'UnliftedRep). a -> b
unsafeCoerceUnlifted (ArrayArray# -> Int# -> ArrayArray#
Exts.indexArrayArrayArray# ArrayArray#
ary Int#
i)
{-# INLINE indexUnliftedArray# #-}

unsafeFreezeUnliftedArray# :: MutableUnliftedArray# s a -> State# s -> (# State# s, UnliftedArray# a #)
unsafeFreezeUnliftedArray# :: MutableUnliftedArray# s a
-> State# s -> (# State# s, UnliftedArray# a #)
unsafeFreezeUnliftedArray# (MutableUnliftedArray# MutableArrayArray# s
mary) State# s
s
  = case MutableArrayArray# s -> State# s -> (# State# s, ArrayArray# #)
forall d.
MutableArrayArray# d -> State# d -> (# State# d, ArrayArray# #)
Exts.unsafeFreezeArrayArray# MutableArrayArray# s
mary State# s
s of
      (# State# s
s', ArrayArray#
ary #) -> (# State# s
s', ArrayArray# -> UnliftedArray# a
forall (a :: TYPE 'UnliftedRep). ArrayArray# -> UnliftedArray# a
UnliftedArray# ArrayArray#
ary #)
{-# INLINE unsafeFreezeUnliftedArray# #-}

unsafeThawUnliftedArray# :: UnliftedArray# a -> State# s -> (# State# s, MutableUnliftedArray# s a #)
unsafeThawUnliftedArray# :: UnliftedArray# a
-> State# s -> (# State# s, MutableUnliftedArray# s a #)
unsafeThawUnliftedArray# (UnliftedArray# ArrayArray#
ary) State# s
s
  = case Array# Any -> State# s -> (# State# s, MutableArray# s Any #)
forall k1 d.
Array# k1 -> State# d -> (# State# d, MutableArray# d k1 #)
Exts.unsafeThawArray# (ArrayArray# -> Array# Any
forall (a :: TYPE 'UnliftedRep) (b :: TYPE 'UnliftedRep). a -> b
unsafeCoerceUnlifted ArrayArray#
ary) State# s
s of
     (# State# s
s', MutableArray# s Any
mary #) -> (# State# s
s', MutableArrayArray# s -> MutableUnliftedArray# s a
forall s (a :: TYPE 'UnliftedRep).
MutableArrayArray# s -> MutableUnliftedArray# s a
MutableUnliftedArray# (MutableArray# s Any -> MutableArrayArray# s
forall (a :: TYPE 'UnliftedRep) (b :: TYPE 'UnliftedRep). a -> b
unsafeCoerceUnlifted MutableArray# s Any
mary) #)
{-# INLINE unsafeThawUnliftedArray# #-}

copyUnliftedArray# :: UnliftedArray# a -> Int# -> MutableUnliftedArray# s a -> Int# -> Int# -> State# s -> State# s
copyUnliftedArray# :: UnliftedArray# a
-> Int#
-> MutableUnliftedArray# s a
-> Int#
-> Int#
-> State# s
-> State# s
copyUnliftedArray# (UnliftedArray# ArrayArray#
ary) Int#
i1 (MutableUnliftedArray# MutableArrayArray# s
mary) Int#
i2 Int#
n State# s
s
  = ArrayArray#
-> Int#
-> MutableArrayArray# s
-> Int#
-> Int#
-> State# s
-> State# s
forall d.
ArrayArray#
-> Int#
-> MutableArrayArray# d
-> Int#
-> Int#
-> State# d
-> State# d
Exts.copyArrayArray# ArrayArray#
ary Int#
i1 MutableArrayArray# s
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# :: MutableUnliftedArray# s a
-> Int#
-> MutableUnliftedArray# s a
-> Int#
-> Int#
-> State# s
-> State# s
copyMutableUnliftedArray# (MutableUnliftedArray# MutableArrayArray# s
mary1) Int#
i1 (MutableUnliftedArray# MutableArrayArray# s
mary2) Int#
i2 Int#
n State# s
s
  = MutableArrayArray# s
-> Int#
-> MutableArrayArray# s
-> Int#
-> Int#
-> State# s
-> State# s
forall d.
MutableArrayArray# d
-> Int#
-> MutableArrayArray# d
-> Int#
-> Int#
-> State# d
-> State# d
Exts.copyMutableArrayArray# MutableArrayArray# s
mary1 Int#
i1 MutableArrayArray# s
mary2 Int#
i2 Int#
n State# s
s
{-# INLINE copyMutableUnliftedArray# #-}

cloneUnliftedArray# :: UnliftedArray# a -> Int# -> Int# -> UnliftedArray# a
cloneUnliftedArray# :: UnliftedArray# a -> Int# -> Int# -> UnliftedArray# a
cloneUnliftedArray# (UnliftedArray# ArrayArray#
ary) Int#
i Int#
n
  = ArrayArray# -> UnliftedArray# a
forall (a :: TYPE 'UnliftedRep). ArrayArray# -> UnliftedArray# a
UnliftedArray# (Array# Any -> ArrayArray#
forall (a :: TYPE 'UnliftedRep) (b :: TYPE 'UnliftedRep). a -> b
unsafeCoerceUnlifted (Array# Any -> Int# -> Int# -> Array# Any
forall k1. Array# k1 -> Int# -> Int# -> Array# k1
Exts.cloneArray# (ArrayArray# -> Array# Any
forall (a :: TYPE 'UnliftedRep) (b :: TYPE 'UnliftedRep). a -> b
unsafeCoerceUnlifted ArrayArray#
ary) Int#
i Int#
n))
{-# INLINE cloneUnliftedArray# #-}

cloneMutableUnliftedArray# :: MutableUnliftedArray# s a -> Int# -> Int# -> State# s
  -> (# State# s, MutableUnliftedArray# s a #)
cloneMutableUnliftedArray# :: MutableUnliftedArray# s a
-> Int#
-> Int#
-> State# s
-> (# State# s, MutableUnliftedArray# s a #)
cloneMutableUnliftedArray# (MutableUnliftedArray# MutableArrayArray# s
mary) Int#
i Int#
n State# s
s
  = case MutableArray# s Any
-> Int# -> Int# -> State# s -> (# State# s, MutableArray# s Any #)
forall d k1.
MutableArray# d k1
-> Int# -> Int# -> State# d -> (# State# d, MutableArray# d k1 #)
Exts.cloneMutableArray# (MutableArrayArray# s -> MutableArray# s Any
forall (a :: TYPE 'UnliftedRep) (b :: TYPE 'UnliftedRep). a -> b
unsafeCoerceUnlifted MutableArrayArray# s
mary) Int#
i Int#
n State# s
s of
      (# State# s
s', MutableArray# s Any
mary' #) -> (# State# s
s', MutableArrayArray# s -> MutableUnliftedArray# s a
forall s (a :: TYPE 'UnliftedRep).
MutableArrayArray# s -> MutableUnliftedArray# s a
MutableUnliftedArray# (MutableArray# s Any -> MutableArrayArray# s
forall (a :: TYPE 'UnliftedRep) (b :: TYPE 'UnliftedRep). a -> b
unsafeCoerceUnlifted MutableArray# s Any
mary') #)
{-# INLINE cloneMutableUnliftedArray# #-}

freezeUnliftedArray# :: MutableUnliftedArray# s a -> Int# -> Int# -> State# s -> (# State# s, UnliftedArray# a #)
freezeUnliftedArray# :: MutableUnliftedArray# s a
-> Int# -> Int# -> State# s -> (# State# s, UnliftedArray# a #)
freezeUnliftedArray# (MutableUnliftedArray# MutableArrayArray# s
mary) Int#
i Int#
n State# s
s
  = case MutableArray# s Any
-> Int# -> Int# -> State# s -> (# State# s, Array# Any #)
forall d k1.
MutableArray# d k1
-> Int# -> Int# -> State# d -> (# State# d, Array# k1 #)
Exts.freezeArray# (MutableArrayArray# s -> MutableArray# s Any
forall (a :: TYPE 'UnliftedRep) (b :: TYPE 'UnliftedRep). a -> b
unsafeCoerceUnlifted MutableArrayArray# s
mary) Int#
i Int#
n State# s
s of
      (# State# s
s', Array# Any
ary #) -> (# State# s
s', ArrayArray# -> UnliftedArray# a
forall (a :: TYPE 'UnliftedRep). ArrayArray# -> UnliftedArray# a
UnliftedArray# (Array# Any -> ArrayArray#
forall (a :: TYPE 'UnliftedRep) (b :: TYPE 'UnliftedRep). a -> b
unsafeCoerceUnlifted Array# Any
ary) #)
{-# INLINE freezeUnliftedArray# #-}

thawUnliftedArray# :: UnliftedArray# a -> Int# -> Int# -> State# s -> (# State# s, MutableUnliftedArray# s a #)
thawUnliftedArray# :: UnliftedArray# a
-> Int#
-> Int#
-> State# s
-> (# State# s, MutableUnliftedArray# s a #)
thawUnliftedArray# (UnliftedArray# ArrayArray#
ary) Int#
i Int#
n State# s
s
  = case Array# Any
-> Int# -> Int# -> State# s -> (# State# s, MutableArray# s Any #)
forall k1 d.
Array# k1
-> Int# -> Int# -> State# d -> (# State# d, MutableArray# d k1 #)
Exts.thawArray# (ArrayArray# -> Array# Any
forall (a :: TYPE 'UnliftedRep) (b :: TYPE 'UnliftedRep). a -> b
unsafeCoerceUnlifted ArrayArray#
ary) Int#
i Int#
n State# s
s of
      (# State# s
s', MutableArray# s Any
mary #) -> (# State# s
s', MutableArrayArray# s -> MutableUnliftedArray# s a
forall s (a :: TYPE 'UnliftedRep).
MutableArrayArray# s -> MutableUnliftedArray# s a
MutableUnliftedArray# (MutableArray# s Any -> MutableArrayArray# s
forall (a :: TYPE 'UnliftedRep) (b :: TYPE 'UnliftedRep). a -> b
unsafeCoerceUnlifted MutableArray# s Any
mary) #)
{-# INLINE thawUnliftedArray# #-}

casUnliftedArray# :: MutableUnliftedArray# s a -> Int# -> a -> a -> State# s -> (# State# s, Int#, a #)
casUnliftedArray# :: MutableUnliftedArray# s a
-> Int# -> a -> a -> State# s -> (# State# s, Int#, a #)
casUnliftedArray# (MutableUnliftedArray# MutableArrayArray# s
mary) Int#
i a
x a
y State# s
s
  = (# State# s, Int#, Any #) -> (# State# s, Int#, a #)
unsafeCoerce# (MutableArray# s Any
-> Int# -> Any -> Any -> State# s -> (# State# s, Int#, Any #)
forall d k1.
MutableArray# d k1
-> Int# -> k1 -> k1 -> State# d -> (# State# d, Int#, k1 #)
Exts.casArray# (MutableArrayArray# s -> MutableArray# s Any
forall (a :: TYPE 'UnliftedRep) (b :: TYPE 'UnliftedRep). a -> b
unsafeCoerceUnlifted MutableArrayArray# s
mary) Int#
i (a -> Any
unsafeCoerce# a
x) (a -> Any
unsafeCoerce# a
y) State# s
s)
{-# NOINLINE casUnliftedArray# #-}