Copyright | (c) Alexey Kuleshevich 2020 |
---|---|
License | BSD3 |
Maintainer | Alexey Kuleshevich <lehins@yandex.ru> |
Stability | experimental |
Portability | non-portable |
Safe Haskell | None |
Language | Haskell2010 |
Synopsis
- data PVar a s
- type RW = RealWorld
- newPVar :: (MonadPrim s m, Prim a) => a -> m (PVar a s)
- withPVarST :: Prim p => p -> (forall s. PVar p s -> ST s a) -> a
- readPVar :: (MonadPrim s m, Prim a) => PVar a s -> m a
- writePVar :: (MonadPrim s m, Prim a) => PVar a s -> a -> m ()
- modifyPVar :: (MonadPrim s m, Prim a) => PVar a s -> (a -> (a, b)) -> m b
- modifyPVar_ :: (MonadPrim s m, Prim a) => PVar a s -> (a -> a) -> m ()
- fetchModifyPVar :: (MonadPrim s m, Prim a) => PVar a s -> (a -> a) -> m a
- modifyFetchPVar :: (MonadPrim s m, Prim a) => PVar a s -> (a -> a) -> m a
- modifyPVarM :: (MonadPrim s m, Prim a) => PVar a s -> (a -> m (a, b)) -> m b
- modifyPVarM_ :: (MonadPrim s m, Prim a) => PVar a s -> (a -> m a) -> m ()
- fetchModifyPVarM :: (MonadPrim s m, Prim a) => PVar a s -> (a -> m a) -> m a
- modifyFetchPVarM :: (MonadPrim s m, Prim a) => PVar a s -> (a -> m a) -> m a
- swapPVars_ :: (MonadPrim s m, Prim a) => PVar a s -> PVar a s -> m ()
- swapPVars :: (MonadPrim s m, Prim a) => PVar a s -> PVar a s -> m (a, a)
- copyPVar :: (MonadPrim s m, Prim a) => PVar a s -> PVar a s -> m ()
- sizeOfPVar :: Prim a => PVar a s -> Int
- alignmentPVar :: Prim a => PVar a s -> Int
- newPinnedPVar :: (MonadPrim s m, Prim a) => a -> m (PVar a s)
- newAlignedPinnedPVar :: (MonadPrim s m, Prim a) => a -> m (PVar a s)
- withPtrPVar :: (MonadPrim s m, Prim a) => PVar a n -> (Ptr a -> m b) -> m (Maybe b)
- withStorablePVar :: (MonadPrim s m, Storable a) => a -> (PVar a s -> Ptr a -> m b) -> m b
- withAlignedStorablePVar :: (MonadPrim s m, Storable a) => a -> (PVar a s -> Ptr a -> m b) -> m b
- copyPVarToPtr :: (MonadPrim s m, Prim a) => PVar a s -> Ptr a -> m ()
- toForeignPtrPVar :: PVar a s -> Maybe (ForeignPtr a)
- isPinnedPVar :: PVar a s -> Bool
- peekPrim :: (Storable a, MonadPrim s m) => Ptr a -> m a
- pokePrim :: (Storable a, MonadPrim s m) => Ptr a -> a -> m ()
- atomicModifyIntPVar :: MonadPrim s m => PVar Int s -> (Int -> (Int, a)) -> m a
- atomicModifyIntPVar_ :: MonadPrim s m => PVar Int s -> (Int -> Int) -> m ()
- atomicFetchModifyIntPVar :: MonadPrim s m => PVar Int s -> (Int -> Int) -> m Int
- atomicModifyFetchIntPVar :: MonadPrim s m => PVar Int s -> (Int -> Int) -> m Int
- atomicReadIntPVar :: MonadPrim s m => PVar Int s -> m Int
- atomicWriteIntPVar :: MonadPrim s m => PVar Int s -> Int -> m ()
- casIntPVar :: MonadPrim s m => PVar Int s -> Int -> Int -> m Int
- atomicAddIntPVar :: MonadPrim s m => PVar Int s -> Int -> m Int
- atomicSubIntPVar :: MonadPrim s m => PVar Int s -> Int -> m Int
- atomicAndIntPVar :: MonadPrim s m => PVar Int s -> Int -> m Int
- atomicNandIntPVar :: MonadPrim s m => PVar Int s -> Int -> m Int
- atomicOrIntPVar :: MonadPrim s m => PVar Int s -> Int -> m Int
- atomicXorIntPVar :: MonadPrim s m => PVar Int s -> Int -> m Int
- atomicNotIntPVar :: MonadPrim s m => PVar Int s -> m Int
- class Prim a
- class (PrimMonad m, s ~ PrimState m) => MonadPrim s (m :: Type -> Type)
- class Monad m => PrimMonad (m :: Type -> Type) where
- data RealWorld :: Type
- sizeOf :: Prim a => a -> Int
- alignment :: Prim a => a -> Int
- data ST s a
- runST :: (forall s. ST s a) -> a
- class Storable a where
Documentation
PVar
has significantly better performance characteristics over
IORef
, STRef
and MutVar
. This is
because value is mutated directly in memory instead of following an extra
pointer. Besides better performance there is another consequence of direct
mutation, namely the value is always evaluated to normal form when being written
into a PVar
Mutable variable with primitive value.
Since: 0.1.0
Instances
Prim a => Storable (PVar a RealWorld) Source # | |
Defined in Data.Primitive.PVar.Internal sizeOf :: PVar a RealWorld -> Int # alignment :: PVar a RealWorld -> Int # peekElemOff :: Ptr (PVar a RealWorld) -> Int -> IO (PVar a RealWorld) # pokeElemOff :: Ptr (PVar a RealWorld) -> Int -> PVar a RealWorld -> IO () # peekByteOff :: Ptr b -> Int -> IO (PVar a RealWorld) # pokeByteOff :: Ptr b -> Int -> PVar a RealWorld -> IO () # peek :: Ptr (PVar a RealWorld) -> IO (PVar a RealWorld) # poke :: Ptr (PVar a RealWorld) -> PVar a RealWorld -> IO () # | |
NFData (PVar a s) Source # | Values are already written into |
Defined in Data.Primitive.PVar.Internal |
Creation
newPVar :: (MonadPrim s m, Prim a) => a -> m (PVar a s) Source #
Create a mutable variable in unpinned memory (i.e. GC can move it) with an initial
value. This is a prefered way to create a mutable variable, since it will not
contribute to memory fragmentation. For pinned memory versions see newPinnedPVar
and
newAlignedPinnedPVar
Since: 0.1.0
:: Prim p | |
=> p | Initial value assigned to the mutable variable |
-> (forall s. PVar p s -> ST s a) | Action to run |
-> a | Result produced by the |
Run an ST
action on a mutable variable.
Since: 0.1.0
Mutable Operations
readPVar :: (MonadPrim s m, Prim a) => PVar a s -> m a Source #
Read a value from a mutable variable
Since: 0.1.0
writePVar :: (MonadPrim s m, Prim a) => PVar a s -> a -> m () Source #
Write a value into a mutable variable
Since: 0.1.0
modifyPVar :: (MonadPrim s m, Prim a) => PVar a s -> (a -> (a, b)) -> m b Source #
Apply a pure function to the contents of a mutable variable. Returns the artifact of computation.
Since: 0.2.0
modifyPVar_ :: (MonadPrim s m, Prim a) => PVar a s -> (a -> a) -> m () Source #
Apply a pure function to the contents of a mutable variable.
Since: 0.1.0
fetchModifyPVar :: (MonadPrim s m, Prim a) => PVar a s -> (a -> a) -> m a Source #
Apply a pure function to the contents of a mutable variable. Returns the old value.
Since: 0.2.0
modifyFetchPVar :: (MonadPrim s m, Prim a) => PVar a s -> (a -> a) -> m a Source #
Apply a pure function to the contents of a mutable variable. Returns the new value.
Since: 0.2.0
modifyPVarM :: (MonadPrim s m, Prim a) => PVar a s -> (a -> m (a, b)) -> m b Source #
Apply a monadic action to the contents of a mutable variable. Returns the artifact of computation.
Since: 0.2.0
modifyPVarM_ :: (MonadPrim s m, Prim a) => PVar a s -> (a -> m a) -> m () Source #
Apply a monadic action to the contents of a mutable variable.
Since: 0.1.0
fetchModifyPVarM :: (MonadPrim s m, Prim a) => PVar a s -> (a -> m a) -> m a Source #
Apply a monadic action to the contents of a mutable variable. Returns the old value.
Since: 0.2.0
modifyFetchPVarM :: (MonadPrim s m, Prim a) => PVar a s -> (a -> m a) -> m a Source #
Apply a monadic action to the contents of a mutable variable. Returns the new value.
Since: 0.2.0
swapPVars_ :: (MonadPrim s m, Prim a) => PVar a s -> PVar a s -> m () Source #
Swap contents of two mutable variables.
Since: 0.1.0
swapPVars :: (MonadPrim s m, Prim a) => PVar a s -> PVar a s -> m (a, a) Source #
Swap contents of two mutable variables. Returns their old values.
Since: 0.1.0
Copy contents of one mutable variable PVar
into another
Since: 0.1.0
sizeOfPVar :: Prim a => PVar a s -> Int Source #
Size in bytes of a value stored inside the mutable variable. PVar
itself is neither
accessed nor evaluated.
Since: 0.1.0
alignmentPVar :: Prim a => PVar a s -> Int Source #
Alignment in bytes of the value stored inside of the mutable variable. PVar
itself is
neither accessed nor evaluated.
Since: 0.1.0
Pinned memory
In theory it is unsafe to mix Storable
and Prim
operations on the same chunk of
memory, because some instances can have different memory layouts for the same
type. This is highly uncommon in practice and if you are intermixing the two concepts
together you probably already know what you are doing.
newPinnedPVar :: (MonadPrim s m, Prim a) => a -> m (PVar a s) Source #
Create a mutable variable in pinned memory with an initial value.
Since: 0.1.0
newAlignedPinnedPVar :: (MonadPrim s m, Prim a) => a -> m (PVar a s) Source #
Create a mutable variable in pinned memory with an initial value and aligned
according to its alignment
Since: 0.1.0
withPtrPVar :: (MonadPrim s m, Prim a) => PVar a n -> (Ptr a -> m b) -> m (Maybe b) Source #
Apply an action to the Ptr
that references the mutable variable, but only if it is
backed by pinned memory, cause otherwise it would be unsafe.
Since: 0.1.0
Apply an action to the newly allocated PVar
and to the Ptr
that references
it. Memory allocated with number of bytes specified by
is allocated and
pinned, therefore it is safe to operate directly with the pointer as well as over
FFI. Returning the pointer from the supplied action would be very unsafe, therefore
return the sizeOf
aPVar
if you still need it afterwards, garbage collector will cleanup the
memory when it is no longer needed.
Since: 0.1.0
withAlignedStorablePVar Source #
Same withStorablePVar
, except memory is aligned according to alignment
.
Since: 0.1.0
toForeignPtrPVar :: PVar a s -> Maybe (ForeignPtr a) Source #
Convert PVar
into a ForeignPtr
, but only if it is backed by pinned memory.
Since: 0.1.0
isPinnedPVar :: PVar a s -> Bool Source #
Check if PVar
is backed by pinned memory or not
Since: 0.1.0
peekPrim :: (Storable a, MonadPrim s m) => Ptr a -> m a Source #
Use Storable
reading functionality inside the PrimMonad
.
Since: 0.1.0
pokePrim :: (Storable a, MonadPrim s m) => Ptr a -> a -> m () Source #
Use Storable
wrting functionality inside the PrimMonad
.
Since: 0.1.0
Atomic operations
atomicModifyIntPVar :: MonadPrim s m => PVar Int s -> (Int -> (Int, a)) -> m a Source #
Apply a function to an integer element of a PVar
atomically. Implies a full memory
barrier.
Since: 0.1.0
atomicModifyIntPVar_ :: MonadPrim s m => PVar Int s -> (Int -> Int) -> m () Source #
Apply a function to an integer element of a PVar
atomically. Returns the old
value. Implies a full memory barrier.
Since: 0.1.0
atomicFetchModifyIntPVar :: MonadPrim s m => PVar Int s -> (Int -> Int) -> m Int Source #
Apply a function to an integer element of a PVar
atomically. Implies a full memory
barrier. Returns the new value.
Since: 0.2.0
atomicModifyFetchIntPVar :: MonadPrim s m => PVar Int s -> (Int -> Int) -> m Int Source #
Apply a function to an integer element of a PVar
atomically. Implies a full memory
barrier. Returns the new value.
Since: 0.2.0
atomicReadIntPVar :: MonadPrim s m => PVar Int s -> m Int Source #
Read a value from PVar
atomically. Implies a full memory barrier.
Since: 0.1.0
atomicWriteIntPVar :: MonadPrim s m => PVar Int s -> Int -> m () Source #
Write a value into an PVar
atomically. Implies a full memory barrier.
Since: 0.1.0
:: MonadPrim s m | |
=> PVar Int s | Variable to mutate |
-> Int | Old expected value |
-> Int | New value |
-> m Int | Old actual value |
Compare and swap. This is also a function that is used to implement
atomicModifyIntPVar
. Implies a full memory barrier.
Since: 0.1.0
atomicAddIntPVar :: MonadPrim s m => PVar Int s -> Int -> m Int Source #
Add two numbers, corresponds to (
done atomically. Returns the previous value of
the mutable variable. Implies a full memory barrier.+
)
Since: 0.1.0
atomicSubIntPVar :: MonadPrim s m => PVar Int s -> Int -> m Int Source #
Subtract two numbers, corresponds to (
done atomically. Returns the
previous value of the mutable variable. Implies a full memory barrier.-
)
Since: 0.1.0
atomicAndIntPVar :: MonadPrim s m => PVar Int s -> Int -> m Int Source #
Binary conjuction (AND), corresponds to (
done atomically. Returns the previous
value of the mutable variable. Implies a full memory barrier..&.
)
Since: 0.1.0
atomicNandIntPVar :: MonadPrim s m => PVar Int s -> Int -> m Int Source #
Binary negation of conjuction (NAND), corresponds to \x y ->
done atomically. Returns the previous value of the mutable variable. Implies
a full memory barrier.complement
(x
.&.
y)
Since: 0.1.0
atomicOrIntPVar :: MonadPrim s m => PVar Int s -> Int -> m Int Source #
Binary disjunction (OR), corresponds to (
done atomically. Returns the previous
value of the mutable variable. Implies a full memory barrier..|.
)
Since: 0.1.0
atomicXorIntPVar :: MonadPrim s m => PVar Int s -> Int -> m Int Source #
Binary exclusive disjunction (XOR), corresponds to
done atomically. Returns the
previous value of the mutable variable. Implies a full memory barrier.xor
Since: 0.1.0
atomicNotIntPVar :: MonadPrim s m => PVar Int s -> m Int Source #
Binary negation (NOT), corresponds to ones'
done atomically. Returns the
previous value of the mutable variable. Implies a full memory barrier.complement
Since: 0.1.0
Re-exports
Class of types supporting primitive array operations. This includes
interfacing with GC-managed memory (functions suffixed with ByteArray#
)
and interfacing with unmanaged memory (functions suffixed with Addr#
).
Endianness is platform-dependent.
sizeOf#, alignment#, indexByteArray#, readByteArray#, writeByteArray#, setByteArray#, indexOffAddr#, readOffAddr#, writeOffAddr#, setOffAddr#
Instances
class (PrimMonad m, s ~ PrimState m) => MonadPrim s (m :: Type -> Type) #
PrimMonad'
s state token type can be annoying to handle
in constraints. This typeclass lets users (visually) notice
PrimState
equality constraints less, by witnessing that
s ~
.PrimState
m
Instances
(PrimMonad m, s ~ PrimState m) => MonadPrim s m | |
Defined in Control.Monad.Primitive |
class Monad m => PrimMonad (m :: Type -> Type) #
Class of monads which can perform primitive state-transformer actions
Instances
PrimMonad IO | |
PrimMonad (ST s) | |
PrimMonad (ST s) | |
PrimMonad m => PrimMonad (MaybeT m) | |
PrimMonad m => PrimMonad (ListT m) | |
(Monoid w, PrimMonad m) => PrimMonad (WriterT w m) | |
(Monoid w, PrimMonad m) => PrimMonad (AccumT w m) | Since: primitive-0.6.3.0 |
(Monoid w, PrimMonad m) => PrimMonad (WriterT w m) | |
PrimMonad m => PrimMonad (StateT s m) | |
PrimMonad m => PrimMonad (StateT s m) | |
PrimMonad m => PrimMonad (SelectT r m) | |
PrimMonad m => PrimMonad (IdentityT m) | |
PrimMonad m => PrimMonad (ExceptT e m) | |
(Error e, PrimMonad m) => PrimMonad (ErrorT e m) | |
PrimMonad m => PrimMonad (ReaderT r m) | |
PrimMonad m => PrimMonad (ContT r m) | Since: primitive-0.6.3.0 |
(Monoid w, PrimMonad m) => PrimMonad (RWST r w s m) | |
(Monoid w, PrimMonad m) => PrimMonad (RWST r w s m) | |
RealWorld
is deeply magical. It is primitive, but it is not
unlifted (hence ptrArg
). We never manipulate values of type
RealWorld
; it's only used in the type system, to parameterise State#
.
Instances
Prim a => Storable (PVar a RealWorld) Source # | |
Defined in Data.Primitive.PVar.Internal sizeOf :: PVar a RealWorld -> Int # alignment :: PVar a RealWorld -> Int # peekElemOff :: Ptr (PVar a RealWorld) -> Int -> IO (PVar a RealWorld) # pokeElemOff :: Ptr (PVar a RealWorld) -> Int -> PVar a RealWorld -> IO () # peekByteOff :: Ptr b -> Int -> IO (PVar a RealWorld) # pokeByteOff :: Ptr b -> Int -> PVar a RealWorld -> IO () # peek :: Ptr (PVar a RealWorld) -> IO (PVar a RealWorld) # poke :: Ptr (PVar a RealWorld) -> PVar a RealWorld -> IO () # |
The strict state-transformer monad.
A computation of type
transforms an internal state indexed
by ST
s as
, and returns a value of type a
.
The s
parameter is either
- an uninstantiated type variable (inside invocations of
runST
), or RealWorld
(inside invocations ofstToIO
).
It serves to keep the internal states of different invocations
of runST
separate from each other and from invocations of
stToIO
.
The >>=
and >>
operations are strict in the state (though not in
values stored in the state). For example,
runST
(writeSTRef _|_ v >>= f) = _|_
Instances
Monad (ST s) | Since: base-2.1 |
Functor (ST s) | Since: base-2.1 |
MonadFail (ST s) | Since: base-4.11.0.0 |
Applicative (ST s) | Since: base-4.4.0.0 |
PrimMonad (ST s) | |
PrimBase (ST s) | |
Show (ST s a) | Since: base-2.1 |
Semigroup a => Semigroup (ST s a) | Since: base-4.11.0.0 |
Monoid a => Monoid (ST s a) | Since: base-4.11.0.0 |
type PrimState (ST s) | |
Defined in Control.Monad.Primitive |
runST :: (forall s. ST s a) -> a #
Return the value computed by a state transformer computation.
The forall
ensures that the internal state used by the ST
computation is inaccessible to the rest of the program.
The member functions of this class facilitate writing values of primitive types to raw memory (which may have been allocated with the above mentioned routines) and reading values from blocks of raw memory. The class, furthermore, includes support for computing the storage requirements and alignment restrictions of storable types.
Memory addresses are represented as values of type
, for some
Ptr
aa
which is an instance of class Storable
. The type argument to
Ptr
helps provide some valuable type safety in FFI code (you can't
mix pointers of different types without an explicit cast), while
helping the Haskell type system figure out which marshalling method is
needed for a given pointer.
All marshalling between Haskell and a foreign language ultimately
boils down to translating Haskell data structures into the binary
representation of a corresponding data structure of the foreign
language and vice versa. To code this marshalling in Haskell, it is
necessary to manipulate primitive data types stored in unstructured
memory blocks. The class Storable
facilitates this manipulation on
all types for which it is instantiated, which are the standard basic
types of Haskell, the fixed size Int
types (Int8
, Int16
,
Int32
, Int64
), the fixed size Word
types (Word8
, Word16
,
Word32
, Word64
), StablePtr
, all types from Foreign.C.Types,
as well as Ptr
.
sizeOf, alignment, (peek | peekElemOff | peekByteOff), (poke | pokeElemOff | pokeByteOff)
Read a value from the given memory location.
Note that the peek and poke functions might require properly
aligned addresses to function correctly. This is architecture
dependent; thus, portable code should ensure that when peeking or
poking values of some type a
, the alignment
constraint for a
, as given by the function
alignment
is fulfilled.
Write the given value to the given memory location. Alignment
restrictions might apply; see peek
.