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

-- |
-- Primitive types representing unlifted arrays and the
-- primops for manipulating them.
module Data.Primitive.Unlifted.SmallArray.Primops
  ( -- * Types
    SmallUnliftedArray#
  , SmallMutableUnliftedArray#
    -- 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 in GHC.Prim, possibly with other names.

    -- * Operations
  , newSmallUnliftedArray#
  , unsafeNewSmallUnliftedArray#
  , emptySmallUnliftedArray#
  , sameSmallMutableUnliftedArray#
  , shrinkSmallMutableUnliftedArray#
  , readSmallUnliftedArray#
  , writeSmallUnliftedArray#
  , sizeofSmallUnliftedArray#
  , getSizeofSmallMutableUnliftedArray#
  , indexSmallUnliftedArray#
  , unsafeFreezeSmallUnliftedArray#
  , unsafeThawSmallUnliftedArray#
  , copySmallUnliftedArray#
  , copySmallMutableUnliftedArray#
  , cloneSmallUnliftedArray#
  , cloneSmallMutableUnliftedArray#
  , freezeSmallUnliftedArray#
  , thawSmallUnliftedArray#
  , casSmallUnliftedArray#
  ) where

import Data.Coerce (coerce)
import GHC.Exts (Int#,State#,SmallArray#,SmallMutableArray#)
import qualified GHC.Exts as Exts

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

newtype SmallUnliftedArray# (a :: UnliftedType) = SmallUnliftedArray# (SmallArray# a)
type role SmallUnliftedArray# representational

newtype SmallMutableUnliftedArray# s (a :: UnliftedType) = SmallMutableUnliftedArray# (SmallMutableArray# s a)
type role SmallMutableUnliftedArray# nominal representational

newSmallUnliftedArray# :: forall a s. Int# -> a -> State# s -> (# State# s, SmallMutableUnliftedArray# s a #)
newSmallUnliftedArray# :: forall (a :: UnliftedType) s.
Int#
-> a -> State# s -> (# State# s, SmallMutableUnliftedArray# s a #)
newSmallUnliftedArray# Int#
sz a
a State# s
s = (# State# s, SmallMutableArray# s a #)
-> (# State# s, SmallMutableUnliftedArray# s a #)
forall a b. Coercible a b => a -> b
coerce (Int# -> a -> State# s -> (# State# s, SmallMutableArray# s a #)
forall a d.
Int# -> a -> State# d -> (# State# d, SmallMutableArray# d a #)
Exts.newSmallArray# Int#
sz a
a State# s
s)
{-# INLINE newSmallUnliftedArray# #-}

-- | Create a 'SmallMutableUnliftedArray#' 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.
unsafeNewSmallUnliftedArray# :: Int# -> State# s -> (# State# s, SmallMutableUnliftedArray# s a #)
-- We fill the array with the Nonsense data constructor. It doesn't much matter
-- *what* we stick in there, as long as it's a pointer the garbage collector
-- can understand and isn't something that might otherwise be released as garbage.
-- There's no point trying to stick an `error` in there, because there's no
-- code anywhere to force the error thunk.
unsafeNewSmallUnliftedArray# :: forall s (a :: UnliftedType).
Int# -> State# s -> (# State# s, SmallMutableUnliftedArray# s a #)
unsafeNewSmallUnliftedArray# Int#
sz State# s
s = case Int# -> a -> State# s -> (# State# s, SmallMutableArray# s a #)
forall a d.
Int# -> a -> State# d -> (# State# d, SmallMutableArray# d a #)
Exts.newSmallArray# Int#
sz (Nonsense -> a
forall (a :: UnliftedType) (b :: UnliftedType). a -> b
unsafeCoerceUnlifted Nonsense
Nonsense) State# s
s of
  (# State# s
s', SmallMutableArray# s a
mary #) -> (# State# s
s', SmallMutableArray# s a -> SmallMutableUnliftedArray# s a
forall s (a :: UnliftedType).
SmallMutableArray# s a -> SmallMutableUnliftedArray# s a
SmallMutableUnliftedArray# SmallMutableArray# s a
mary #)
{-# INLINE unsafeNewSmallUnliftedArray# #-}

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_small_unlifted_array :: SULA a
empty_small_unlifted_array :: forall (a :: UnliftedType). SULA a
empty_small_unlifted_array = SmallUnliftedArray# a -> SULA a
forall (a :: UnliftedType). SmallUnliftedArray# a -> SULA a
SULA
  ((State# RealWorld -> SmallUnliftedArray# a)
-> SmallUnliftedArray# a
forall o. (State# RealWorld -> o) -> o
Exts.runRW# ((State# RealWorld -> SmallUnliftedArray# a)
 -> SmallUnliftedArray# a)
-> (State# RealWorld -> SmallUnliftedArray# a)
-> SmallUnliftedArray# 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#
-> a
-> State# RealWorld
-> (# State# RealWorld, SmallMutableArray# RealWorld a #)
forall a d.
Int# -> a -> State# d -> (# State# d, SmallMutableArray# d a #)
Exts.newSmallArray# Int#
0# (Nonsense -> a
forall (a :: UnliftedType) (b :: UnliftedType). a -> b
unsafeCoerceUnlifted Nonsense
Nonsense) State# RealWorld
s' of { (# State# RealWorld
s'', SmallMutableArray# RealWorld a
mary #) ->
    case SmallMutableArray# RealWorld a
-> State# RealWorld -> (# State# RealWorld, SmallArray# a #)
forall d a.
SmallMutableArray# d a -> State# d -> (# State# d, SmallArray# a #)
Exts.unsafeFreezeSmallArray# SmallMutableArray# RealWorld a
mary State# RealWorld
s'' of { (# State# RealWorld
_, SmallArray# a
ary #) ->
      SmallArray# a -> SmallUnliftedArray# a
forall (a :: UnliftedType). SmallArray# a -> SmallUnliftedArray# a
SmallUnliftedArray# SmallArray# a
ary }}})
{-# NOINLINE empty_small_unlifted_array #-}

data SULA a = SULA (SmallUnliftedArray# a)

-- | Warning: Applying 'unsafeThawUnliftedArray#' to the array produced by
-- this function will make demons come out of your nose.
emptySmallUnliftedArray# :: (##) -> SmallUnliftedArray# 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.
emptySmallUnliftedArray# :: forall (a :: UnliftedType). (# #) -> SmallUnliftedArray# a
emptySmallUnliftedArray# (##) = case SULA a
forall (a :: UnliftedType). SULA a
empty_small_unlifted_array of
  SULA SmallUnliftedArray# a
ary -> SmallUnliftedArray# a
ary
{-# INLINE emptySmallUnliftedArray# #-}

sameSmallMutableUnliftedArray# :: SmallMutableUnliftedArray# s a -> SmallMutableUnliftedArray# s a -> Int#
sameSmallMutableUnliftedArray# :: forall s (a :: UnliftedType).
SmallMutableUnliftedArray# s a
-> SmallMutableUnliftedArray# s a -> Int#
sameSmallMutableUnliftedArray# (SmallMutableUnliftedArray# SmallMutableArray# s a
ar1) (SmallMutableUnliftedArray# SmallMutableArray# s a
ar2)
  = SmallMutableArray# s a -> SmallMutableArray# s a -> Int#
forall a b. a -> b -> Int#
Exts.reallyUnsafePtrEquality# SmallMutableArray# s a
ar1 SmallMutableArray# s a
ar2
{-# INLINE sameSmallMutableUnliftedArray# #-}

shrinkSmallMutableUnliftedArray# :: SmallMutableUnliftedArray# s a -> Int# -> State# s -> State# s
shrinkSmallMutableUnliftedArray# :: forall s (a :: UnliftedType).
SmallMutableUnliftedArray# s a -> Int# -> State# s -> State# s
shrinkSmallMutableUnliftedArray# (SmallMutableUnliftedArray# SmallMutableArray# s a
ar) Int#
sz State# s
s
  = SmallMutableArray# s a -> Int# -> State# s -> State# s
forall d a. SmallMutableArray# d a -> Int# -> State# d -> State# d
Exts.shrinkSmallMutableArray# SmallMutableArray# s a
ar Int#
sz State# s
s
{-# INLINE shrinkSmallMutableUnliftedArray# #-}

readSmallUnliftedArray# :: SmallMutableUnliftedArray# s a -> Int# -> State# s -> (# State# s, a #)
readSmallUnliftedArray# :: forall s (a :: UnliftedType).
SmallMutableUnliftedArray# s a
-> Int# -> State# s -> (# State# s, a #)
readSmallUnliftedArray# (SmallMutableUnliftedArray# SmallMutableArray# s a
mary) Int#
i State# s
s
  = SmallMutableArray# s a -> Int# -> State# s -> (# State# s, a #)
forall d a.
SmallMutableArray# d a -> Int# -> State# d -> (# State# d, a #)
Exts.readSmallArray# SmallMutableArray# s a
mary Int#
i State# s
s
{-# INLINE readSmallUnliftedArray# #-}

writeSmallUnliftedArray# :: SmallMutableUnliftedArray# s a -> Int# -> a -> State# s -> State# s
writeSmallUnliftedArray# :: forall s (a :: UnliftedType).
SmallMutableUnliftedArray# s a -> Int# -> a -> State# s -> State# s
writeSmallUnliftedArray# (SmallMutableUnliftedArray# SmallMutableArray# s a
mary) Int#
i a
a State# s
s
  = SmallMutableArray# s a -> Int# -> a -> State# s -> State# s
forall d a.
SmallMutableArray# d a -> Int# -> a -> State# d -> State# d
Exts.writeSmallArray# SmallMutableArray# s a
mary Int#
i a
a State# s
s
{-# INLINE writeSmallUnliftedArray# #-}

sizeofSmallUnliftedArray# :: SmallUnliftedArray# a -> Int#
sizeofSmallUnliftedArray# :: forall (a :: UnliftedType). SmallUnliftedArray# a -> Int#
sizeofSmallUnliftedArray# (SmallUnliftedArray# SmallArray# a
ary) = SmallArray# a -> Int#
forall a. SmallArray# a -> Int#
Exts.sizeofSmallArray# SmallArray# a
ary
{-# INLINE sizeofSmallUnliftedArray# #-}

getSizeofSmallMutableUnliftedArray# :: SmallMutableUnliftedArray# s a -> State# s -> (# State# s, Int# #)
getSizeofSmallMutableUnliftedArray# :: forall s (a :: UnliftedType).
SmallMutableUnliftedArray# s a -> State# s -> (# State# s, Int# #)
getSizeofSmallMutableUnliftedArray# (SmallMutableUnliftedArray# SmallMutableArray# s a
mary) State# s
s
  = SmallMutableArray# s a -> State# s -> (# State# s, Int# #)
forall d a.
SmallMutableArray# d a -> State# d -> (# State# d, Int# #)
Exts.getSizeofSmallMutableArray# SmallMutableArray# s a
mary State# s
s
{-# INLINE getSizeofSmallMutableUnliftedArray# #-}

{-
--The underlying primop is deprecated in GHC.Prim, so let's not do this.
sizeofSmallMutableUnliftedArray# :: SmallMutableUnliftedArray# s a -> Int#
sizeofSmallMutableUnliftedArray# (SmallMutableUnliftedArray# mary)
  = Exts.sizeofSmallMutableArray# mary
{-# INLINE sizeofSmallMutableUnliftedArray# #-}
-}

indexSmallUnliftedArray# :: SmallUnliftedArray# a -> Int# -> a
indexSmallUnliftedArray# :: forall (a :: UnliftedType). SmallUnliftedArray# a -> Int# -> a
indexSmallUnliftedArray# (SmallUnliftedArray# SmallArray# a
ary) Int#
i
  | (# a
a #) <- SmallArray# a -> Int# -> (# a #)
forall a. SmallArray# a -> Int# -> (# a #)
Exts.indexSmallArray# SmallArray# a
ary Int#
i
  = a
a
{-# INLINE indexSmallUnliftedArray# #-}

unsafeFreezeSmallUnliftedArray# :: SmallMutableUnliftedArray# s a -> State# s -> (# State# s, SmallUnliftedArray# a #)
unsafeFreezeSmallUnliftedArray# :: forall s (a :: UnliftedType).
SmallMutableUnliftedArray# s a
-> State# s -> (# State# s, SmallUnliftedArray# a #)
unsafeFreezeSmallUnliftedArray# (SmallMutableUnliftedArray# SmallMutableArray# s a
mary) State# s
s
  = (# State# s, SmallArray# a #)
-> (# State# s, SmallUnliftedArray# a #)
forall a b. Coercible a b => a -> b
coerce (SmallMutableArray# s a -> State# s -> (# State# s, SmallArray# a #)
forall d a.
SmallMutableArray# d a -> State# d -> (# State# d, SmallArray# a #)
Exts.unsafeFreezeSmallArray# SmallMutableArray# s a
mary State# s
s)
{-# INLINE unsafeFreezeSmallUnliftedArray# #-}

unsafeThawSmallUnliftedArray# :: SmallUnliftedArray# a -> State# s -> (# State# s, SmallMutableUnliftedArray# s a #)
unsafeThawSmallUnliftedArray# :: forall (a :: UnliftedType) s.
SmallUnliftedArray# a
-> State# s -> (# State# s, SmallMutableUnliftedArray# s a #)
unsafeThawSmallUnliftedArray# (SmallUnliftedArray# SmallArray# a
ary) State# s
s
  = (# State# s, SmallMutableArray# s a #)
-> (# State# s, SmallMutableUnliftedArray# s a #)
forall a b. Coercible a b => a -> b
coerce (SmallArray# a -> State# s -> (# State# s, SmallMutableArray# s a #)
forall a d.
SmallArray# a -> State# d -> (# State# d, SmallMutableArray# d a #)
Exts.unsafeThawSmallArray# SmallArray# a
ary State# s
s)
{-# INLINE unsafeThawSmallUnliftedArray# #-}

copySmallUnliftedArray# :: SmallUnliftedArray# a -> Int# -> SmallMutableUnliftedArray# s a -> Int# -> Int# -> State# s -> State# s
copySmallUnliftedArray# :: forall (a :: UnliftedType) s.
SmallUnliftedArray# a
-> Int#
-> SmallMutableUnliftedArray# s a
-> Int#
-> Int#
-> State# s
-> State# s
copySmallUnliftedArray# (SmallUnliftedArray# SmallArray# a
ary) Int#
i1 (SmallMutableUnliftedArray# SmallMutableArray# s a
mary) Int#
i2 Int#
n State# s
s
  = SmallArray# a
-> Int#
-> SmallMutableArray# s a
-> Int#
-> Int#
-> State# s
-> State# s
forall a d.
SmallArray# a
-> Int#
-> SmallMutableArray# d a
-> Int#
-> Int#
-> State# d
-> State# d
Exts.copySmallArray# SmallArray# a
ary Int#
i1 SmallMutableArray# s a
mary Int#
i2 Int#
n State# s
s
{-# INLINE copySmallUnliftedArray# #-}

copySmallMutableUnliftedArray# :: SmallMutableUnliftedArray# s a -> Int# -> SmallMutableUnliftedArray# s a -> Int# -> Int# -> State# s -> State# s
copySmallMutableUnliftedArray# :: forall s (a :: UnliftedType).
SmallMutableUnliftedArray# s a
-> Int#
-> SmallMutableUnliftedArray# s a
-> Int#
-> Int#
-> State# s
-> State# s
copySmallMutableUnliftedArray# (SmallMutableUnliftedArray# SmallMutableArray# s a
mary1) Int#
i1 (SmallMutableUnliftedArray# SmallMutableArray# s a
mary2) Int#
i2 Int#
n State# s
s
  = SmallMutableArray# s a
-> Int#
-> SmallMutableArray# s a
-> Int#
-> Int#
-> State# s
-> State# s
forall d a.
SmallMutableArray# d a
-> Int#
-> SmallMutableArray# d a
-> Int#
-> Int#
-> State# d
-> State# d
Exts.copySmallMutableArray# SmallMutableArray# s a
mary1 Int#
i1 SmallMutableArray# s a
mary2 Int#
i2 Int#
n State# s
s
{-# INLINE copySmallMutableUnliftedArray# #-}

cloneSmallUnliftedArray# :: SmallUnliftedArray# a -> Int# -> Int# -> SmallUnliftedArray# a
cloneSmallUnliftedArray# :: forall (a :: UnliftedType).
SmallUnliftedArray# a -> Int# -> Int# -> SmallUnliftedArray# a
cloneSmallUnliftedArray# (SmallUnliftedArray# SmallArray# a
ary) Int#
i Int#
n
  = SmallArray# a -> SmallUnliftedArray# a
forall (a :: UnliftedType). SmallArray# a -> SmallUnliftedArray# a
SmallUnliftedArray# (SmallArray# a -> Int# -> Int# -> SmallArray# a
forall a. SmallArray# a -> Int# -> Int# -> SmallArray# a
Exts.cloneSmallArray# SmallArray# a
ary Int#
i Int#
n)
{-# INLINE cloneSmallUnliftedArray# #-}

cloneSmallMutableUnliftedArray# :: SmallMutableUnliftedArray# s a -> Int# -> Int# -> State# s
  -> (# State# s, SmallMutableUnliftedArray# s a #)
cloneSmallMutableUnliftedArray# :: forall s (a :: UnliftedType).
SmallMutableUnliftedArray# s a
-> Int#
-> Int#
-> State# s
-> (# State# s, SmallMutableUnliftedArray# s a #)
cloneSmallMutableUnliftedArray# (SmallMutableUnliftedArray# SmallMutableArray# s a
mary) Int#
i Int#
n State# s
s
  = (# State# s, SmallMutableArray# s a #)
-> (# State# s, SmallMutableUnliftedArray# s a #)
forall a b. Coercible a b => a -> b
coerce (SmallMutableArray# s a
-> Int#
-> Int#
-> State# s
-> (# State# s, SmallMutableArray# s a #)
forall d a.
SmallMutableArray# d a
-> Int#
-> Int#
-> State# d
-> (# State# d, SmallMutableArray# d a #)
Exts.cloneSmallMutableArray# SmallMutableArray# s a
mary Int#
i Int#
n State# s
s)
{-# INLINE cloneSmallMutableUnliftedArray# #-}

freezeSmallUnliftedArray# :: SmallMutableUnliftedArray# s a -> Int# -> Int# -> State# s -> (# State# s, SmallUnliftedArray# a #)
freezeSmallUnliftedArray# :: forall s (a :: UnliftedType).
SmallMutableUnliftedArray# s a
-> Int#
-> Int#
-> State# s
-> (# State# s, SmallUnliftedArray# a #)
freezeSmallUnliftedArray# (SmallMutableUnliftedArray# SmallMutableArray# s a
mary) Int#
i Int#
n State# s
s
  = (# State# s, SmallArray# a #)
-> (# State# s, SmallUnliftedArray# a #)
forall a b. Coercible a b => a -> b
coerce (SmallMutableArray# s a
-> Int# -> Int# -> State# s -> (# State# s, SmallArray# a #)
forall d a.
SmallMutableArray# d a
-> Int# -> Int# -> State# d -> (# State# d, SmallArray# a #)
Exts.freezeSmallArray# SmallMutableArray# s a
mary Int#
i Int#
n State# s
s)
{-# INLINE freezeSmallUnliftedArray# #-}

thawSmallUnliftedArray# :: SmallUnliftedArray# a -> Int# -> Int# -> State# s -> (# State# s, SmallMutableUnliftedArray# s a #)
thawSmallUnliftedArray# :: forall (a :: UnliftedType) s.
SmallUnliftedArray# a
-> Int#
-> Int#
-> State# s
-> (# State# s, SmallMutableUnliftedArray# s a #)
thawSmallUnliftedArray# (SmallUnliftedArray# SmallArray# a
ary) Int#
i Int#
n State# s
s
  = (# State# s, SmallMutableArray# s a #)
-> (# State# s, SmallMutableUnliftedArray# s a #)
forall a b. Coercible a b => a -> b
coerce (SmallArray# a
-> Int#
-> Int#
-> State# s
-> (# State# s, SmallMutableArray# s a #)
forall a d.
SmallArray# a
-> Int#
-> Int#
-> State# d
-> (# State# d, SmallMutableArray# d a #)
Exts.thawSmallArray# SmallArray# a
ary Int#
i Int#
n State# s
s)
{-# INLINE thawSmallUnliftedArray# #-}

casSmallUnliftedArray# :: SmallMutableUnliftedArray# s a -> Int# -> a -> a -> State# s -> (# State# s, Int#, a #)
casSmallUnliftedArray# :: forall s (a :: UnliftedType).
SmallMutableUnliftedArray# s a
-> Int# -> a -> a -> State# s -> (# State# s, Int#, a #)
casSmallUnliftedArray# (SmallMutableUnliftedArray# SmallMutableArray# s a
mary) Int#
i a
x a
y State# s
s
  = SmallMutableArray# s a
-> Int# -> a -> a -> State# s -> (# State# s, Int#, a #)
forall d a.
SmallMutableArray# d a
-> Int# -> a -> a -> State# d -> (# State# d, Int#, a #)
Exts.casSmallArray# SmallMutableArray# s a
mary Int#
i a
x a
y State# s
s
{-# INLINE casSmallUnliftedArray# #-}