{-# LANGUAGE CPP #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE Unsafe #-}
{-# LANGUAGE PolyKinds #-}
{-# LANGUAGE MagicHash #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE ViewPatterns #-}
{-# LANGUAGE UnboxedTuples #-}
{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE PatternSynonyms #-}
{-# LANGUAGE ConstraintKinds #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE DefaultSignatures #-}
{-# OPTIONS_HADDOCK not-home #-}
-----------------------------------------------------------------------------
-- |
-- Copyright   :  (C) 2015-2017 Edward Kmett
-- License     :  BSD-style (see the file LICENSE)
-- Maintainer  :  Edward Kmett <ekmett@gmail.com>
-- Stability   :  experimental
-- Portability :  non-portable
--
-----------------------------------------------------------------------------

module Data.Struct.Internal where

import Control.Exception
import Control.Monad.Primitive
import Control.Monad.ST
import Data.Primitive
import Data.Coerce
import GHC.Exts

-- $setup
-- >>> import Control.Monad.Primitive

#ifdef HLINT
{-# ANN module "HLint: ignore Eta reduce" #-}
{-# ANN module "HLint: ignore Unused LANGUAGE pragma" #-}
{-# ANN module "HLint: ignore Avoid lambda" #-}
{-# ANN module "HLint: ignore Redundant lambda" #-}
#endif

data NullPointerException = NullPointerException deriving (Int -> NullPointerException -> ShowS
[NullPointerException] -> ShowS
NullPointerException -> String
(Int -> NullPointerException -> ShowS)
-> (NullPointerException -> String)
-> ([NullPointerException] -> ShowS)
-> Show NullPointerException
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [NullPointerException] -> ShowS
$cshowList :: [NullPointerException] -> ShowS
show :: NullPointerException -> String
$cshow :: NullPointerException -> String
showsPrec :: Int -> NullPointerException -> ShowS
$cshowsPrec :: Int -> NullPointerException -> ShowS
Show, Show NullPointerException
Typeable NullPointerException
Typeable NullPointerException
-> Show NullPointerException
-> (NullPointerException -> SomeException)
-> (SomeException -> Maybe NullPointerException)
-> (NullPointerException -> String)
-> Exception NullPointerException
SomeException -> Maybe NullPointerException
NullPointerException -> String
NullPointerException -> SomeException
forall e.
Typeable e
-> Show e
-> (e -> SomeException)
-> (SomeException -> Maybe e)
-> (e -> String)
-> Exception e
displayException :: NullPointerException -> String
$cdisplayException :: NullPointerException -> String
fromException :: SomeException -> Maybe NullPointerException
$cfromException :: SomeException -> Maybe NullPointerException
toException :: NullPointerException -> SomeException
$ctoException :: NullPointerException -> SomeException
$cp2Exception :: Show NullPointerException
$cp1Exception :: Typeable NullPointerException
Exception)

-- | A 'Dict' reifies an instance of the constraint @p@ into a value.
data Dict p where
  Dict :: p => Dict p

-- | Run an ST calculation inside of a PrimMonad. This lets us avoid dispatching everything through the 'PrimMonad' dictionary.
st :: PrimMonad m => ST (PrimState m) a -> m a
st :: ST (PrimState m) a -> m a
st = ST (PrimState m) a -> m a
forall (m1 :: * -> *) (m2 :: * -> *) a.
(PrimBase m1, PrimMonad m2, PrimState m1 ~ PrimState m2) =>
m1 a -> m2 a
primToPrim
{-# INLINE[0] st #-}

-- | An instance for 'Struct' @t@ is a witness to the machine-level
--   equivalence of @t@ and @Object@.
class Struct t where
  struct :: Dict (Coercible (t s) (Object s))
#ifndef HLINT
  default struct :: Coercible (t s) (Object s) => Dict (Coercible (t s) (Object s))
#endif
  struct = Dict (Coercible (t s) (Object s))
forall (p :: Constraint). p => Dict p
Dict
  {-# MINIMAL #-}

data Object s = Object { Object s -> SmallMutableArray# s Any
runObject :: SmallMutableArray# s Any }

instance Struct Object

coerceF :: Dict (Coercible a b) -> a -> b
coerceF :: Dict (Coercible a b) -> a -> b
coerceF Dict (Coercible a b)
Dict = a -> b
coerce
{-# INLINE coerceF #-}

coerceB :: Dict (Coercible a b) -> b -> a
coerceB :: Dict (Coercible a b) -> b -> a
coerceB Dict (Coercible a b)
Dict = b -> a
coerce
{-# INLINE coerceB #-}

destruct :: Struct t => t s -> SmallMutableArray# s Any
destruct :: t s -> SmallMutableArray# s Any
destruct = \t s
x -> Object s -> SmallMutableArray# s Any
forall s. Object s -> SmallMutableArray# s Any
runObject (Dict (Coercible (t s) (Object s)) -> t s -> Object s
forall a b. Dict (Coercible a b) -> a -> b
coerceF Dict (Coercible (t s) (Object s))
forall (t :: * -> *) s.
Struct t =>
Dict (Coercible (t s) (Object s))
struct t s
x)
{-# INLINE destruct #-}

construct :: Struct t => SmallMutableArray# s Any -> t s
construct :: SmallMutableArray# s Any -> t s
construct = \SmallMutableArray# s Any
x -> Dict (Coercible (t s) (Object s)) -> Object s -> t s
forall a b. Dict (Coercible a b) -> b -> a
coerceB Dict (Coercible (t s) (Object s))
forall (t :: * -> *) s.
Struct t =>
Dict (Coercible (t s) (Object s))
struct (SmallMutableArray# s Any -> Object s
forall s. SmallMutableArray# s Any -> Object s
Object SmallMutableArray# s Any
x)
{-# INLINE construct #-}

unsafeCoerceStruct :: (Struct x, Struct y) => x s -> y s
unsafeCoerceStruct :: x s -> y s
unsafeCoerceStruct x s
x = SmallMutableArray# s Any -> y s
forall (t :: * -> *) s. Struct t => SmallMutableArray# s Any -> t s
construct (x s -> SmallMutableArray# s Any
forall (t :: * -> *) s. Struct t => t s -> SmallMutableArray# s Any
destruct x s
x)

eqStruct :: Struct t => t s -> t s -> Bool
eqStruct :: t s -> t s -> Bool
eqStruct = \t s
x t s
y -> Int# -> Bool
isTrue# (t s -> SmallMutableArray# s Any
forall (t :: * -> *) s. Struct t => t s -> SmallMutableArray# s Any
destruct t s
x SmallMutableArray# s Any -> SmallMutableArray# s Any -> Int#
forall d a.
SmallMutableArray# d a -> SmallMutableArray# d a -> Int#
`sameSmallMutableArray#` t s -> SmallMutableArray# s Any
forall (t :: * -> *) s. Struct t => t s -> SmallMutableArray# s Any
destruct t s
y)
{-# INLINE eqStruct #-}

instance Eq (Object s) where
  == :: Object s -> Object s -> Bool
(==) = Object s -> Object s -> Bool
forall (t :: * -> *) s. Struct t => t s -> t s -> Bool
eqStruct

#ifndef HLINT
pattern Struct :: Struct t => () => SmallMutableArray# s Any -> t s
pattern $bStruct :: SmallMutableArray# s Any -> t s
$mStruct :: forall r (t :: * -> *) s.
Struct t =>
t s -> (SmallMutableArray# s Any -> r) -> (Void# -> r) -> r
Struct x <- (destruct -> x) where
  Struct SmallMutableArray# s Any
x = SmallMutableArray# s Any -> t s
forall (t :: * -> *) s. Struct t => SmallMutableArray# s Any -> t s
construct SmallMutableArray# s Any
x
#endif

-- | Allocate a structure made out of `n` slots. Initialize the structure before proceeding!
alloc :: (PrimMonad m, Struct t) => Int -> m (t (PrimState m))
alloc :: Int -> m (t (PrimState m))
alloc (I# Int#
n#) = (State# (PrimState m)
 -> (# State# (PrimState m), t (PrimState m) #))
-> m (t (PrimState m))
forall (m :: * -> *) a.
PrimMonad m =>
(State# (PrimState m) -> (# State# (PrimState m), a #)) -> m a
primitive ((State# (PrimState m)
  -> (# State# (PrimState m), t (PrimState m) #))
 -> m (t (PrimState m)))
-> (State# (PrimState m)
    -> (# State# (PrimState m), t (PrimState m) #))
-> m (t (PrimState m))
forall a b. (a -> b) -> a -> b
$ \State# (PrimState m)
s -> case Int#
-> Any
-> State# (PrimState m)
-> (# State# (PrimState m), SmallMutableArray# (PrimState m) Any #)
forall a d.
Int# -> a -> State# d -> (# State# d, SmallMutableArray# d a #)
newSmallArray# Int#
n# Any
forall a. HasCallStack => a
undefined State# (PrimState m)
s of (# State# (PrimState m)
s', SmallMutableArray# (PrimState m) Any
b #) -> (# State# (PrimState m)
s', SmallMutableArray# (PrimState m) Any -> t (PrimState m)
forall (t :: * -> *) s. Struct t => SmallMutableArray# s Any -> t s
construct SmallMutableArray# (PrimState m) Any
b #)

--------------------------------------------------------------------------------
-- * Tony Hoare's billion dollar mistake
--------------------------------------------------------------------------------

-- | Box is designed to mirror object's single field but using the 'Null' type
-- instead of a mutable array. This hack relies on GHC reusing the same 'Null'
-- data constructor for all occurrences. Box's field must not be strict to
-- prevent the compiler from making assumptions about its contents.
data Box = Box Null
data Null = Null

-- | Predicate to check if a struct is 'Nil'.
--
-- >>> isNil (Nil :: Object (PrimState IO))
-- True
-- >>> o <- alloc 1 :: IO (Object (PrimState IO))
-- >>> isNil o
-- False
isNil :: Struct t => t s -> Bool
isNil :: t s -> Bool
isNil t s
t = Int# -> Bool
isTrue# ((Any -> Any -> Int#) -> SmallMutableArray# s Any -> Null -> Int#
unsafeCoerce# Any -> Any -> Int#
forall a. a -> a -> Int#
reallyUnsafePtrEquality# (t s -> SmallMutableArray# s Any
forall (t :: * -> *) s. Struct t => t s -> SmallMutableArray# s Any
destruct t s
t) Null
Null)
{-# INLINE isNil #-}

#ifndef HLINT
-- | Truly imperative.
pattern Nil :: Struct t => () => t s
pattern $bNil :: t s
$mNil :: forall r (t :: * -> *) s.
Struct t =>
t s -> (Void# -> r) -> (Void# -> r) -> r
Nil <- (isNil -> True) where
  Nil = (Null -> Box) -> Null -> t s
unsafeCoerce# Null -> Box
Box Null
Null
#endif

--------------------------------------------------------------------------------
-- * Faking SmallMutableArrayArray#s
--------------------------------------------------------------------------------

writeSmallMutableArraySmallArray# :: SmallMutableArray# s Any -> Int# -> SmallMutableArray# s Any -> State# s -> State# s
writeSmallMutableArraySmallArray# :: SmallMutableArray# s Any
-> Int# -> SmallMutableArray# s Any -> State# s -> State# s
writeSmallMutableArraySmallArray# SmallMutableArray# s Any
m Int#
i SmallMutableArray# s Any
a State# s
s = (SmallMutableArray# Any Any
 -> Int# -> Any -> State# Any -> State# Any)
-> SmallMutableArray# s Any
-> Int#
-> SmallMutableArray# s Any
-> State# s
-> State# s
unsafeCoerce# SmallMutableArray# Any Any
-> Int# -> Any -> State# Any -> State# Any
forall d a.
SmallMutableArray# d a -> Int# -> a -> State# d -> State# d
writeSmallArray# SmallMutableArray# s Any
m Int#
i SmallMutableArray# s Any
a State# s
s
{-# INLINE writeSmallMutableArraySmallArray# #-}

readSmallMutableArraySmallArray# :: SmallMutableArray# s Any -> Int# -> State# s -> (# State# s, SmallMutableArray# s Any #)
readSmallMutableArraySmallArray# :: SmallMutableArray# s Any
-> Int# -> State# s -> (# State# s, SmallMutableArray# s Any #)
readSmallMutableArraySmallArray# SmallMutableArray# s Any
m Int#
i State# s
s = (SmallMutableArray# Any Any
 -> Int# -> State# Any -> (# State# Any, Any #))
-> SmallMutableArray# s Any
-> Int#
-> State# s
-> (# State# s, SmallMutableArray# s Any #)
unsafeCoerce# SmallMutableArray# Any Any
-> Int# -> State# Any -> (# State# Any, Any #)
forall d a.
SmallMutableArray# d a -> Int# -> State# d -> (# State# d, a #)
readSmallArray# SmallMutableArray# s Any
m Int#
i State# s
s
{-# INLINE readSmallMutableArraySmallArray# #-}

writeMutableByteArraySmallArray# :: SmallMutableArray# s Any -> Int# -> MutableByteArray# s -> State# s -> State# s
writeMutableByteArraySmallArray# :: SmallMutableArray# s Any
-> Int# -> MutableByteArray# s -> State# s -> State# s
writeMutableByteArraySmallArray# SmallMutableArray# s Any
m Int#
i MutableByteArray# s
a State# s
s = (SmallMutableArray# Any Any
 -> Int# -> Any -> State# Any -> State# Any)
-> SmallMutableArray# s Any
-> Int#
-> MutableByteArray# s
-> State# s
-> State# s
unsafeCoerce# SmallMutableArray# Any Any
-> Int# -> Any -> State# Any -> State# Any
forall d a.
SmallMutableArray# d a -> Int# -> a -> State# d -> State# d
writeSmallArray# SmallMutableArray# s Any
m Int#
i MutableByteArray# s
a State# s
s
{-# INLINE writeMutableByteArraySmallArray# #-}

readMutableByteArraySmallArray# :: SmallMutableArray# s Any -> Int# -> State# s -> (# State# s, MutableByteArray# s #)
readMutableByteArraySmallArray# :: SmallMutableArray# s Any
-> Int# -> State# s -> (# State# s, MutableByteArray# s #)
readMutableByteArraySmallArray# SmallMutableArray# s Any
m Int#
i State# s
s = (SmallMutableArray# Any Any
 -> Int# -> State# Any -> (# State# Any, Any #))
-> SmallMutableArray# s Any
-> Int#
-> State# s
-> (# State# s, MutableByteArray# s #)
unsafeCoerce# SmallMutableArray# Any Any
-> Int# -> State# Any -> (# State# Any, Any #)
forall d a.
SmallMutableArray# d a -> Int# -> State# d -> (# State# d, a #)
readSmallArray# SmallMutableArray# s Any
m Int#
i State# s
s
{-# INLINE readMutableByteArraySmallArray# #-}

casSmallMutableArraySmallArray# :: SmallMutableArray# s Any -> Int# -> SmallMutableArray# s Any -> SmallMutableArray# s Any -> State# s -> (# State# s, Int#, SmallMutableArray# s Any #)
casSmallMutableArraySmallArray# :: SmallMutableArray# s Any
-> Int#
-> SmallMutableArray# s Any
-> SmallMutableArray# s Any
-> State# s
-> (# State# s, Int#, SmallMutableArray# s Any #)
casSmallMutableArraySmallArray# SmallMutableArray# s Any
m Int#
i SmallMutableArray# s Any
o SmallMutableArray# s Any
n State# s
s = (SmallMutableArray# Any Any
 -> Int# -> Any -> Any -> State# Any -> (# State# Any, Int#, Any #))
-> SmallMutableArray# s Any
-> Int#
-> SmallMutableArray# s Any
-> SmallMutableArray# s Any
-> State# s
-> (# State# s, Int#, SmallMutableArray# s Any #)
unsafeCoerce# SmallMutableArray# Any Any
-> Int# -> Any -> Any -> State# Any -> (# State# Any, Int#, Any #)
forall d a.
SmallMutableArray# d a
-> Int# -> a -> a -> State# d -> (# State# d, Int#, a #)
casSmallArray# SmallMutableArray# s Any
m Int#
i SmallMutableArray# s Any
o SmallMutableArray# s Any
n State# s
s
{-# INLINE casSmallMutableArraySmallArray# #-}

--------------------------------------------------------------------------------
-- * Field Accessors
--------------------------------------------------------------------------------

-- | A 'Slot' is a reference to another unboxed mutable object.
data Slot x y = Slot
  (forall s. SmallMutableArray# s Any -> State# s -> (# State# s, SmallMutableArray# s Any #))
  (forall s. SmallMutableArray# s Any -> SmallMutableArray# s Any -> State# s -> State# s)
  (forall s. SmallMutableArray# s Any -> SmallMutableArray# s Any -> SmallMutableArray# s Any -> State# s -> (# State# s, Int#, SmallMutableArray# s Any #))

-- | We can compose slots to get a nested slot or field accessor
class Precomposable t where
  ( # ) :: Slot x y -> t y z -> t x z

instance Precomposable Slot where
  Slot forall s.
SmallMutableArray# s Any
-> State# s -> (# State# s, SmallMutableArray# s Any #)
gxy forall s.
SmallMutableArray# s Any
-> SmallMutableArray# s Any -> State# s -> State# s
_ forall s.
SmallMutableArray# s Any
-> SmallMutableArray# s Any
-> SmallMutableArray# s Any
-> State# s
-> (# State# s, Int#, SmallMutableArray# s Any #)
_ # :: Slot x y -> Slot y z -> Slot x z
# Slot forall s.
SmallMutableArray# s Any
-> State# s -> (# State# s, SmallMutableArray# s Any #)
gyz forall s.
SmallMutableArray# s Any
-> SmallMutableArray# s Any -> State# s -> State# s
syz forall s.
SmallMutableArray# s Any
-> SmallMutableArray# s Any
-> SmallMutableArray# s Any
-> State# s
-> (# State# s, Int#, SmallMutableArray# s Any #)
cyz = (forall s.
 SmallMutableArray# s Any
 -> State# s -> (# State# s, SmallMutableArray# s Any #))
-> (forall s.
    SmallMutableArray# s Any
    -> SmallMutableArray# s Any -> State# s -> State# s)
-> (forall s.
    SmallMutableArray# s Any
    -> SmallMutableArray# s Any
    -> SmallMutableArray# s Any
    -> State# s
    -> (# State# s, Int#, SmallMutableArray# s Any #))
-> Slot x z
forall k k (x :: k) (y :: k).
(forall s.
 SmallMutableArray# s Any
 -> State# s -> (# State# s, SmallMutableArray# s Any #))
-> (forall s.
    SmallMutableArray# s Any
    -> SmallMutableArray# s Any -> State# s -> State# s)
-> (forall s.
    SmallMutableArray# s Any
    -> SmallMutableArray# s Any
    -> SmallMutableArray# s Any
    -> State# s
    -> (# State# s, Int#, SmallMutableArray# s Any #))
-> Slot x y
Slot
    (\SmallMutableArray# s Any
x State# s
s -> case SmallMutableArray# s Any
-> State# s -> (# State# s, SmallMutableArray# s Any #)
forall s.
SmallMutableArray# s Any
-> State# s -> (# State# s, SmallMutableArray# s Any #)
gxy SmallMutableArray# s Any
x State# s
s of (# State# s
s', SmallMutableArray# s Any
y #) -> SmallMutableArray# s Any
-> State# s -> (# State# s, SmallMutableArray# s Any #)
forall s.
SmallMutableArray# s Any
-> State# s -> (# State# s, SmallMutableArray# s Any #)
gyz SmallMutableArray# s Any
y State# s
s')
    (\SmallMutableArray# s Any
x SmallMutableArray# s Any
z State# s
s -> case SmallMutableArray# s Any
-> State# s -> (# State# s, SmallMutableArray# s Any #)
forall s.
SmallMutableArray# s Any
-> State# s -> (# State# s, SmallMutableArray# s Any #)
gxy SmallMutableArray# s Any
x State# s
s of (# State# s
s', SmallMutableArray# s Any
y #) -> SmallMutableArray# s Any
-> SmallMutableArray# s Any -> State# s -> State# s
forall s.
SmallMutableArray# s Any
-> SmallMutableArray# s Any -> State# s -> State# s
syz SmallMutableArray# s Any
y SmallMutableArray# s Any
z State# s
s')
    (\SmallMutableArray# s Any
x SmallMutableArray# s Any
o SmallMutableArray# s Any
n State# s
s -> case SmallMutableArray# s Any
-> State# s -> (# State# s, SmallMutableArray# s Any #)
forall s.
SmallMutableArray# s Any
-> State# s -> (# State# s, SmallMutableArray# s Any #)
gxy SmallMutableArray# s Any
x State# s
s of (# State# s
s', SmallMutableArray# s Any
y #) -> SmallMutableArray# s Any
-> SmallMutableArray# s Any
-> SmallMutableArray# s Any
-> State# s
-> (# State# s, Int#, SmallMutableArray# s Any #)
forall s.
SmallMutableArray# s Any
-> SmallMutableArray# s Any
-> SmallMutableArray# s Any
-> State# s
-> (# State# s, Int#, SmallMutableArray# s Any #)
cyz SmallMutableArray# s Any
y SmallMutableArray# s Any
o SmallMutableArray# s Any
n State# s
s')

-- | The 'Slot' at the given position in a 'Struct'
slot :: Int {- ^ slot -} -> Slot s t
slot :: Int -> Slot s t
slot (I# Int#
i) = (forall s.
 SmallMutableArray# s Any
 -> State# s -> (# State# s, SmallMutableArray# s Any #))
-> (forall s.
    SmallMutableArray# s Any
    -> SmallMutableArray# s Any -> State# s -> State# s)
-> (forall s.
    SmallMutableArray# s Any
    -> SmallMutableArray# s Any
    -> SmallMutableArray# s Any
    -> State# s
    -> (# State# s, Int#, SmallMutableArray# s Any #))
-> Slot s t
forall k k (x :: k) (y :: k).
(forall s.
 SmallMutableArray# s Any
 -> State# s -> (# State# s, SmallMutableArray# s Any #))
-> (forall s.
    SmallMutableArray# s Any
    -> SmallMutableArray# s Any -> State# s -> State# s)
-> (forall s.
    SmallMutableArray# s Any
    -> SmallMutableArray# s Any
    -> SmallMutableArray# s Any
    -> State# s
    -> (# State# s, Int#, SmallMutableArray# s Any #))
-> Slot x y
Slot
  (\SmallMutableArray# s Any
m State# s
s -> SmallMutableArray# s Any
-> Int# -> State# s -> (# State# s, SmallMutableArray# s Any #)
forall s.
SmallMutableArray# s Any
-> Int# -> State# s -> (# State# s, SmallMutableArray# s Any #)
readSmallMutableArraySmallArray# SmallMutableArray# s Any
m Int#
i State# s
s)
  (\SmallMutableArray# s Any
m SmallMutableArray# s Any
a State# s
s -> SmallMutableArray# s Any
-> Int# -> SmallMutableArray# s Any -> State# s -> State# s
forall s.
SmallMutableArray# s Any
-> Int# -> SmallMutableArray# s Any -> State# s -> State# s
writeSmallMutableArraySmallArray# SmallMutableArray# s Any
m Int#
i SmallMutableArray# s Any
a State# s
s)
  (\SmallMutableArray# s Any
m SmallMutableArray# s Any
o SmallMutableArray# s Any
n State# s
s -> SmallMutableArray# s Any
-> Int#
-> SmallMutableArray# s Any
-> SmallMutableArray# s Any
-> State# s
-> (# State# s, Int#, SmallMutableArray# s Any #)
forall s.
SmallMutableArray# s Any
-> Int#
-> SmallMutableArray# s Any
-> SmallMutableArray# s Any
-> State# s
-> (# State# s, Int#, SmallMutableArray# s Any #)
casSmallMutableArraySmallArray# SmallMutableArray# s Any
m Int#
i SmallMutableArray# s Any
o SmallMutableArray# s Any
n State# s
s)

-- | Get the value from a 'Slot'
get :: (PrimMonad m, Struct x, Struct y) => Slot x y -> x (PrimState m) -> m (y (PrimState m))
get :: Slot x y -> x (PrimState m) -> m (y (PrimState m))
get (Slot forall s.
SmallMutableArray# s Any
-> State# s -> (# State# s, SmallMutableArray# s Any #)
go forall s.
SmallMutableArray# s Any
-> SmallMutableArray# s Any -> State# s -> State# s
_ forall s.
SmallMutableArray# s Any
-> SmallMutableArray# s Any
-> SmallMutableArray# s Any
-> State# s
-> (# State# s, Int#, SmallMutableArray# s Any #)
_) = \x (PrimState m)
x -> (State# (PrimState m)
 -> (# State# (PrimState m), y (PrimState m) #))
-> m (y (PrimState m))
forall (m :: * -> *) a.
PrimMonad m =>
(State# (PrimState m) -> (# State# (PrimState m), a #)) -> m a
primitive ((State# (PrimState m)
  -> (# State# (PrimState m), y (PrimState m) #))
 -> m (y (PrimState m)))
-> (State# (PrimState m)
    -> (# State# (PrimState m), y (PrimState m) #))
-> m (y (PrimState m))
forall a b. (a -> b) -> a -> b
$ \State# (PrimState m)
s -> case SmallMutableArray# (PrimState m) Any
-> State# (PrimState m)
-> (# State# (PrimState m), SmallMutableArray# (PrimState m) Any #)
forall s.
SmallMutableArray# s Any
-> State# s -> (# State# s, SmallMutableArray# s Any #)
go (x (PrimState m) -> SmallMutableArray# (PrimState m) Any
forall (t :: * -> *) s. Struct t => t s -> SmallMutableArray# s Any
destruct x (PrimState m)
x) State# (PrimState m)
s of
                                            (# State# (PrimState m)
s', SmallMutableArray# (PrimState m) Any
y #) -> (# State# (PrimState m)
s', SmallMutableArray# (PrimState m) Any -> y (PrimState m)
forall (t :: * -> *) s. Struct t => SmallMutableArray# s Any -> t s
construct SmallMutableArray# (PrimState m) Any
y #)
{-# INLINE get #-}

-- | Set the value of a 'Slot'
set :: (PrimMonad m, Struct x, Struct y) => Slot x y -> x (PrimState m) -> y (PrimState m) -> m ()
set :: Slot x y -> x (PrimState m) -> y (PrimState m) -> m ()
set (Slot forall s.
SmallMutableArray# s Any
-> State# s -> (# State# s, SmallMutableArray# s Any #)
_ forall s.
SmallMutableArray# s Any
-> SmallMutableArray# s Any -> State# s -> State# s
go forall s.
SmallMutableArray# s Any
-> SmallMutableArray# s Any
-> SmallMutableArray# s Any
-> State# s
-> (# State# s, Int#, SmallMutableArray# s Any #)
_) = \x (PrimState m)
x y (PrimState m)
y -> (State# (PrimState m) -> State# (PrimState m)) -> m ()
forall (m :: * -> *).
PrimMonad m =>
(State# (PrimState m) -> State# (PrimState m)) -> m ()
primitive_ (SmallMutableArray# (PrimState m) Any
-> SmallMutableArray# (PrimState m) Any
-> State# (PrimState m)
-> State# (PrimState m)
forall s.
SmallMutableArray# s Any
-> SmallMutableArray# s Any -> State# s -> State# s
go (x (PrimState m) -> SmallMutableArray# (PrimState m) Any
forall (t :: * -> *) s. Struct t => t s -> SmallMutableArray# s Any
destruct x (PrimState m)
x) (y (PrimState m) -> SmallMutableArray# (PrimState m) Any
forall (t :: * -> *) s. Struct t => t s -> SmallMutableArray# s Any
destruct y (PrimState m)
y))
{-# INLINE set #-}

-- | Compare-and-swap the value of the slot. Takes the expected old value, the new value and returns if it succeeded and the value found.
cas :: (PrimMonad m, Struct x, Struct y) => Slot x y -> x (PrimState m) -> y (PrimState m) -> y (PrimState m) -> m (Bool, y (PrimState m))
cas :: Slot x y
-> x (PrimState m)
-> y (PrimState m)
-> y (PrimState m)
-> m (Bool, y (PrimState m))
cas (Slot forall s.
SmallMutableArray# s Any
-> State# s -> (# State# s, SmallMutableArray# s Any #)
_ forall s.
SmallMutableArray# s Any
-> SmallMutableArray# s Any -> State# s -> State# s
_ forall s.
SmallMutableArray# s Any
-> SmallMutableArray# s Any
-> SmallMutableArray# s Any
-> State# s
-> (# State# s, Int#, SmallMutableArray# s Any #)
go) = \x (PrimState m)
m y (PrimState m)
o y (PrimState m)
n -> (State# (PrimState m)
 -> (# State# (PrimState m), (Bool, y (PrimState m)) #))
-> m (Bool, y (PrimState m))
forall (m :: * -> *) a.
PrimMonad m =>
(State# (PrimState m) -> (# State# (PrimState m), a #)) -> m a
primitive ((State# (PrimState m)
  -> (# State# (PrimState m), (Bool, y (PrimState m)) #))
 -> m (Bool, y (PrimState m)))
-> (State# (PrimState m)
    -> (# State# (PrimState m), (Bool, y (PrimState m)) #))
-> m (Bool, y (PrimState m))
forall a b. (a -> b) -> a -> b
$ \State# (PrimState m)
s -> case SmallMutableArray# (PrimState m) Any
-> SmallMutableArray# (PrimState m) Any
-> SmallMutableArray# (PrimState m) Any
-> State# (PrimState m)
-> (# State# (PrimState m), Int#,
      SmallMutableArray# (PrimState m) Any #)
forall s.
SmallMutableArray# s Any
-> SmallMutableArray# s Any
-> SmallMutableArray# s Any
-> State# s
-> (# State# s, Int#, SmallMutableArray# s Any #)
go (x (PrimState m) -> SmallMutableArray# (PrimState m) Any
forall (t :: * -> *) s. Struct t => t s -> SmallMutableArray# s Any
destruct x (PrimState m)
m) (y (PrimState m) -> SmallMutableArray# (PrimState m) Any
forall (t :: * -> *) s. Struct t => t s -> SmallMutableArray# s Any
destruct y (PrimState m)
o) (y (PrimState m) -> SmallMutableArray# (PrimState m) Any
forall (t :: * -> *) s. Struct t => t s -> SmallMutableArray# s Any
destruct y (PrimState m)
n) State# (PrimState m)
s of
  (# State# (PrimState m)
s', Int#
i, SmallMutableArray# (PrimState m) Any
r #) -> (# State# (PrimState m)
s', (Int# -> Bool
forall a. Int# -> a
tagToEnum# Int#
i :: Bool, SmallMutableArray# (PrimState m) Any -> y (PrimState m)
forall (t :: * -> *) s. Struct t => SmallMutableArray# s Any -> t s
construct SmallMutableArray# (PrimState m) Any
r) #)

-- | A 'Field' is a reference from a struct to a normal Haskell data type.
data Field x a = Field
  (forall s. SmallMutableArray# s Any -> State# s -> (# State# s, a #)) -- get
  (forall s. SmallMutableArray# s Any -> a -> State# s -> State# s) -- set

instance Precomposable Field where
  Slot forall s.
SmallMutableArray# s Any
-> State# s -> (# State# s, SmallMutableArray# s Any #)
gxy forall s.
SmallMutableArray# s Any
-> SmallMutableArray# s Any -> State# s -> State# s
_ forall s.
SmallMutableArray# s Any
-> SmallMutableArray# s Any
-> SmallMutableArray# s Any
-> State# s
-> (# State# s, Int#, SmallMutableArray# s Any #)
_ # :: Slot x y -> Field y z -> Field x z
# Field forall s. SmallMutableArray# s Any -> State# s -> (# State# s, z #)
gyz forall s. SmallMutableArray# s Any -> z -> State# s -> State# s
syz = (forall s.
 SmallMutableArray# s Any -> State# s -> (# State# s, z #))
-> (forall s.
    SmallMutableArray# s Any -> z -> State# s -> State# s)
-> Field x z
forall k (x :: k) a.
(forall s.
 SmallMutableArray# s Any -> State# s -> (# State# s, a #))
-> (forall s.
    SmallMutableArray# s Any -> a -> State# s -> State# s)
-> Field x a
Field
    (\SmallMutableArray# s Any
x State# s
s -> case SmallMutableArray# s Any
-> State# s -> (# State# s, SmallMutableArray# s Any #)
forall s.
SmallMutableArray# s Any
-> State# s -> (# State# s, SmallMutableArray# s Any #)
gxy SmallMutableArray# s Any
x State# s
s of (# State# s
s', SmallMutableArray# s Any
y #) -> SmallMutableArray# s Any -> State# s -> (# State# s, z #)
forall s. SmallMutableArray# s Any -> State# s -> (# State# s, z #)
gyz SmallMutableArray# s Any
y State# s
s')
    (\SmallMutableArray# s Any
x z
z State# s
s -> case SmallMutableArray# s Any
-> State# s -> (# State# s, SmallMutableArray# s Any #)
forall s.
SmallMutableArray# s Any
-> State# s -> (# State# s, SmallMutableArray# s Any #)
gxy SmallMutableArray# s Any
x State# s
s of (# State# s
s', SmallMutableArray# s Any
y #) -> SmallMutableArray# s Any -> z -> State# s -> State# s
forall s. SmallMutableArray# s Any -> z -> State# s -> State# s
syz SmallMutableArray# s Any
y z
z State# s
s')

-- | Store the reference to the Haskell data type in a normal field
field :: Int {- ^ slot -} -> Field s a
field :: Int -> Field s a
field (I# Int#
i) = (forall s.
 SmallMutableArray# s Any -> State# s -> (# State# s, a #))
-> (forall s.
    SmallMutableArray# s Any -> a -> State# s -> State# s)
-> Field s a
forall k (x :: k) a.
(forall s.
 SmallMutableArray# s Any -> State# s -> (# State# s, a #))
-> (forall s.
    SmallMutableArray# s Any -> a -> State# s -> State# s)
-> Field x a
Field
  (\SmallMutableArray# s Any
m State# s
s -> (SmallMutableArray# Any Any
 -> Int# -> State# Any -> (# State# Any, Any #))
-> SmallMutableArray# s Any
-> Int#
-> State# s
-> (# State# s, a #)
unsafeCoerce# SmallMutableArray# Any Any
-> Int# -> State# Any -> (# State# Any, Any #)
forall d a.
SmallMutableArray# d a -> Int# -> State# d -> (# State# d, a #)
readSmallArray# SmallMutableArray# s Any
m Int#
i State# s
s)
  (\SmallMutableArray# s Any
m a
a State# s
s -> (SmallMutableArray# Any Any
 -> Int# -> Any -> State# Any -> State# Any)
-> SmallMutableArray# s Any -> Int# -> a -> State# s -> State# s
unsafeCoerce# SmallMutableArray# Any Any
-> Int# -> Any -> State# Any -> State# Any
forall d a.
SmallMutableArray# d a -> Int# -> a -> State# d -> State# d
writeSmallArray# SmallMutableArray# s Any
m Int#
i a
a State# s
s)
{-# INLINE field #-}

-- | Store the reference in the nth slot in the nth argument, treated as a MutableByteArray
unboxedField :: Prim a => Int {- ^ slot -} -> Int {- ^ argument -} -> Field s a
unboxedField :: Int -> Int -> Field s a
unboxedField (I# Int#
i) (I# Int#
j) = (forall s.
 SmallMutableArray# s Any -> State# s -> (# State# s, a #))
-> (forall s.
    SmallMutableArray# s Any -> a -> State# s -> State# s)
-> Field s a
forall k (x :: k) a.
(forall s.
 SmallMutableArray# s Any -> State# s -> (# State# s, a #))
-> (forall s.
    SmallMutableArray# s Any -> a -> State# s -> State# s)
-> Field x a
Field
  (\SmallMutableArray# s Any
m State# s
s -> case SmallMutableArray# s Any
-> Int# -> State# s -> (# State# s, MutableByteArray# s #)
forall s.
SmallMutableArray# s Any
-> Int# -> State# s -> (# State# s, MutableByteArray# s #)
readMutableByteArraySmallArray# SmallMutableArray# s Any
m Int#
i State# s
s of
     (# State# s
s', MutableByteArray# s
mba #) -> MutableByteArray# s -> Int# -> State# s -> (# State# s, a #)
forall a s.
Prim a =>
MutableByteArray# s -> Int# -> State# s -> (# State# s, a #)
readByteArray# MutableByteArray# s
mba Int#
j State# s
s')
  (\SmallMutableArray# s Any
m a
a State# s
s -> case SmallMutableArray# s Any
-> Int# -> State# s -> (# State# s, MutableByteArray# s #)
forall s.
SmallMutableArray# s Any
-> Int# -> State# s -> (# State# s, MutableByteArray# s #)
readMutableByteArraySmallArray# SmallMutableArray# s Any
m Int#
i State# s
s of
     (# State# s
s', MutableByteArray# s
mba #) -> MutableByteArray# s -> Int# -> a -> State# s -> State# s
forall a s.
Prim a =>
MutableByteArray# s -> Int# -> a -> State# s -> State# s
writeByteArray# MutableByteArray# s
mba Int#
j a
a State# s
s')
{-# INLINE unboxedField #-}

-- | Initialized the mutable array used by 'unboxedField'. Returns the array
-- after storing it in the struct to help with initialization.
initializeUnboxedField ::
  (PrimMonad m, Struct x) =>
  Int             {- ^ slot     -} ->
  Int             {- ^ elements -} ->
  Int             {- ^ element size -} ->
  x (PrimState m) {- ^ struct   -} ->
  m (MutableByteArray (PrimState m))
initializeUnboxedField :: Int
-> Int
-> Int
-> x (PrimState m)
-> m (MutableByteArray (PrimState m))
initializeUnboxedField (I# Int#
i) (I# Int#
n) (I# Int#
z) x (PrimState m)
m =
  (State# (PrimState m)
 -> (# State# (PrimState m), MutableByteArray (PrimState m) #))
-> m (MutableByteArray (PrimState m))
forall (m :: * -> *) a.
PrimMonad m =>
(State# (PrimState m) -> (# State# (PrimState m), a #)) -> m a
primitive ((State# (PrimState m)
  -> (# State# (PrimState m), MutableByteArray (PrimState m) #))
 -> m (MutableByteArray (PrimState m)))
-> (State# (PrimState m)
    -> (# State# (PrimState m), MutableByteArray (PrimState m) #))
-> m (MutableByteArray (PrimState m))
forall a b. (a -> b) -> a -> b
$ \State# (PrimState m)
s ->
    case Int#
-> State# (PrimState m)
-> (# State# (PrimState m), MutableByteArray# (PrimState m) #)
forall d. Int# -> State# d -> (# State# d, MutableByteArray# d #)
newByteArray# (Int#
n Int# -> Int# -> Int#
*# Int#
z) State# (PrimState m)
s of
      (# State# (PrimState m)
s1, MutableByteArray# (PrimState m)
mba #) ->
        (# SmallMutableArray# (PrimState m) Any
-> Int#
-> MutableByteArray# (PrimState m)
-> State# (PrimState m)
-> State# (PrimState m)
forall s.
SmallMutableArray# s Any
-> Int# -> MutableByteArray# s -> State# s -> State# s
writeMutableByteArraySmallArray# (x (PrimState m) -> SmallMutableArray# (PrimState m) Any
forall (t :: * -> *) s. Struct t => t s -> SmallMutableArray# s Any
destruct x (PrimState m)
m) Int#
i MutableByteArray# (PrimState m)
mba State# (PrimState m)
s1, MutableByteArray# (PrimState m) -> MutableByteArray (PrimState m)
forall s. MutableByteArray# s -> MutableByteArray s
MutableByteArray MutableByteArray# (PrimState m)
mba #)
{-# INLINE initializeUnboxedField #-}

-- | Get the value of a field in a struct
getField :: (PrimMonad m, Struct x) => Field x a -> x (PrimState m) -> m a
getField :: Field x a -> x (PrimState m) -> m a
getField (Field forall s. SmallMutableArray# s Any -> State# s -> (# State# s, a #)
go forall s. SmallMutableArray# s Any -> a -> State# s -> State# s
_) = \x (PrimState m)
x -> (State# (PrimState m) -> (# State# (PrimState m), a #)) -> m a
forall (m :: * -> *) a.
PrimMonad m =>
(State# (PrimState m) -> (# State# (PrimState m), a #)) -> m a
primitive (SmallMutableArray# (PrimState m) Any
-> State# (PrimState m) -> (# State# (PrimState m), a #)
forall s. SmallMutableArray# s Any -> State# s -> (# State# s, a #)
go (x (PrimState m) -> SmallMutableArray# (PrimState m) Any
forall (t :: * -> *) s. Struct t => t s -> SmallMutableArray# s Any
destruct x (PrimState m)
x))
{-# INLINE getField #-}

-- | Set the value of a field in a struct
setField :: (PrimMonad m, Struct x) => Field x a -> x (PrimState m) -> a -> m ()
setField :: Field x a -> x (PrimState m) -> a -> m ()
setField (Field forall s. SmallMutableArray# s Any -> State# s -> (# State# s, a #)
_ forall s. SmallMutableArray# s Any -> a -> State# s -> State# s
go) = \x (PrimState m)
x a
y -> (State# (PrimState m) -> State# (PrimState m)) -> m ()
forall (m :: * -> *).
PrimMonad m =>
(State# (PrimState m) -> State# (PrimState m)) -> m ()
primitive_ (SmallMutableArray# (PrimState m) Any
-> a -> State# (PrimState m) -> State# (PrimState m)
forall s. SmallMutableArray# s Any -> a -> State# s -> State# s
go (x (PrimState m) -> SmallMutableArray# (PrimState m) Any
forall (t :: * -> *) s. Struct t => t s -> SmallMutableArray# s Any
destruct x (PrimState m)
x) a
y)
{-# INLINE setField #-}


--------------------------------------------------------------------------------
-- * Modifiers
--------------------------------------------------------------------------------

modifyField :: (Struct x, PrimMonad m) => Field x a -> x (PrimState m) -> (a -> a) -> m ()
modifyField :: Field x a -> x (PrimState m) -> (a -> a) -> m ()
modifyField Field x a
s = \x (PrimState m)
o a -> a
f -> ST (PrimState m) () -> m ()
forall (m :: * -> *) a. PrimMonad m => ST (PrimState m) a -> m a
st (Field x a
-> x (PrimState (ST (PrimState m))) -> a -> ST (PrimState m) ()
forall (m :: * -> *) (x :: * -> *) a.
(PrimMonad m, Struct x) =>
Field x a -> x (PrimState m) -> a -> m ()
setField Field x a
s x (PrimState m)
x (PrimState (ST (PrimState m)))
o (a -> ST (PrimState m) ()) -> (a -> a) -> a -> ST (PrimState m) ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> a
f (a -> ST (PrimState m) ())
-> ST (PrimState m) a -> ST (PrimState m) ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Field x a -> x (PrimState (ST (PrimState m))) -> ST (PrimState m) a
forall (m :: * -> *) (x :: * -> *) a.
(PrimMonad m, Struct x) =>
Field x a -> x (PrimState m) -> m a
getField Field x a
s x (PrimState m)
x (PrimState (ST (PrimState m)))
o)
{-# INLINE modifyField #-}

modifyField' :: (Struct x, PrimMonad m) => Field x a -> x (PrimState m) -> (a -> a) -> m ()
modifyField' :: Field x a -> x (PrimState m) -> (a -> a) -> m ()
modifyField' Field x a
s = \x (PrimState m)
o a -> a
f -> ST (PrimState m) () -> m ()
forall (m :: * -> *) a. PrimMonad m => ST (PrimState m) a -> m a
st (Field x a
-> x (PrimState (ST (PrimState m))) -> a -> ST (PrimState m) ()
forall (m :: * -> *) (x :: * -> *) a.
(PrimMonad m, Struct x) =>
Field x a -> x (PrimState m) -> a -> m ()
setField Field x a
s x (PrimState m)
x (PrimState (ST (PrimState m)))
o (a -> ST (PrimState m) ())
-> ST (PrimState m) a -> ST (PrimState m) ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< (\a
x -> a -> ST (PrimState m) a
forall (m :: * -> *) a. Monad m => a -> m a
return (a -> ST (PrimState m) a) -> a -> ST (PrimState m) a
forall a b. (a -> b) -> a -> b
$! a -> a
f a
x) (a -> ST (PrimState m) a)
-> ST (PrimState m) a -> ST (PrimState m) a
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Field x a -> x (PrimState (ST (PrimState m))) -> ST (PrimState m) a
forall (m :: * -> *) (x :: * -> *) a.
(PrimMonad m, Struct x) =>
Field x a -> x (PrimState m) -> m a
getField Field x a
s x (PrimState m)
x (PrimState (ST (PrimState m)))
o)
{-# INLINE modifyField' #-}