Copyright | (c) Roman Leshchinskiy 2009-2012 |
---|---|
License | BSD-style |
Maintainer | Roman Leshchinskiy <rl@cse.unsw.edu.au> |
Portability | non-portable |
Safe Haskell | None |
Language | Haskell2010 |
Basic types and classes for primitive array operations.
Synopsis
-
class
Prim
a
where
- sizeOf# :: a -> Int#
- alignment# :: a -> Int#
- indexByteArray# :: ByteArray# -> Int# -> a
- readByteArray# :: MutableByteArray# s -> Int# -> State# s -> (# State# s, a #)
- writeByteArray# :: MutableByteArray# s -> Int# -> a -> State# s -> State# s
- setByteArray# :: MutableByteArray# s -> Int# -> Int# -> a -> State# s -> State# s
- indexOffAddr# :: Addr# -> Int# -> a
- readOffAddr# :: Addr# -> Int# -> State# s -> (# State# s, a #)
- writeOffAddr# :: Addr# -> Int# -> a -> State# s -> State# s
- setOffAddr# :: Addr# -> Int# -> Int# -> a -> State# s -> State# s
- sizeOf :: Prim a => a -> Int
- alignment :: Prim a => a -> Int
- defaultSetByteArray# :: Prim a => MutableByteArray# s -> Int# -> Int# -> a -> State# s -> State# s
- defaultSetOffAddr# :: Prim a => Addr# -> Int# -> Int# -> a -> State# s -> State# s
-
newtype
PrimStorable
a =
PrimStorable
{
- getPrimStorable :: a
- data Ptr a = Ptr Addr#
Documentation
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.
Size of values of type
a
. The argument is not used.
alignment# :: a -> Int# Source #
Alignment of values of type
a
. The argument is not used.
indexByteArray# :: ByteArray# -> Int# -> a Source #
Read a value from the array. The offset is in elements of type
a
rather than in bytes.
readByteArray# :: MutableByteArray# s -> Int# -> State# s -> (# State# s, a #) Source #
Read a value from the mutable array. The offset is in elements of type
a
rather than in bytes.
writeByteArray# :: MutableByteArray# s -> Int# -> a -> State# s -> State# s Source #
Write a value to the mutable array. The offset is in elements of type
a
rather than in bytes.
:: MutableByteArray# s | |
-> Int# |
offset |
-> Int# |
length |
-> a | |
-> State# s | |
-> State# s |
Fill a slice of the mutable array with a value. The offset and length
of the chunk are in elements of type
a
rather than in bytes.
indexOffAddr# :: Addr# -> Int# -> a Source #
Read a value from a memory position given by an address and an offset.
The memory block the address refers to must be immutable. The offset is in
elements of type
a
rather than in bytes.
readOffAddr# :: Addr# -> Int# -> State# s -> (# State# s, a #) Source #
Read a value from a memory position given by an address and an offset.
The offset is in elements of type
a
rather than in bytes.
writeOffAddr# :: Addr# -> Int# -> a -> State# s -> State# s Source #
Write a value to a memory position given by an address and an offset.
The offset is in elements of type
a
rather than in bytes.
Fill a memory block given by an address, an offset and a length.
The offset and length are in elements of type
a
rather than in bytes.
Instances
defaultSetByteArray# :: Prim a => MutableByteArray# s -> Int# -> Int# -> a -> State# s -> State# s Source #
An implementation of
setByteArray#
that calls
writeByteArray#
to set each element. This is helpful when writing a
Prim
instance
for a multi-word data type for which there is no CPU-accelerated way
to broadcast a value to contiguous memory. It is typically used
alongside
defaultSetOffAddr#
. For example:
data Trip = Trip Int Int Int instance Prim Trip sizeOf# _ = 3# *# sizeOf# (undefined :: Int) alignment# _ = alignment# (undefined :: Int) indexByteArray# arr# i# = ... readByteArray# arr# i# = ... writeByteArray# arr# i# (Trip a b c) = \s0 -> case writeByteArray# arr# (3# *# i#) a s0 of s1 -> case writeByteArray# arr# ((3# *# i#) +# 1#) b s1 of s2 -> case writeByteArray# arr# ((3# *# i#) +# 2# ) c s2 of s3 -> s3 setByteArray# = defaultSetByteArray# indexOffAddr# addr# i# = ... readOffAddr# addr# i# = ... writeOffAddr# addr# i# (Trip a b c) = \s0 -> case writeOffAddr# addr# (3# *# i#) a s0 of s1 -> case writeOffAddr# addr# ((3# *# i#) +# 1#) b s1 of s2 -> case writeOffAddr# addr# ((3# *# i#) +# 2# ) c s2 of s3 -> s3 setOffAddr# = defaultSetOffAddr#
defaultSetOffAddr# :: Prim a => Addr# -> Int# -> Int# -> a -> State# s -> State# s Source #
An implementation of
setOffAddr#
that calls
writeOffAddr#
to set each element. The documentation of
defaultSetByteArray#
provides an example of how to use this.
newtype PrimStorable a Source #
Newtype that uses a
Prim
instance to give rise to a
Storable
instance.
This type is intended to be used with the
DerivingVia
extension available
in GHC 8.6 and up. For example, consider a user-defined
Prim
instance for
a multi-word data type.
data Uuid = Uuid Word64 Word64 deriving Storable via (PrimStorable Uuid) instance Prim Uuid where ...
Writing the
Prim
instance is tedious and unavoidable, but the
Storable
instance comes for free once the
Prim
instance is written.
Instances
Prim a => Storable ( PrimStorable a) Source # | |
Defined in Data.Primitive.Types sizeOf :: PrimStorable a -> Int Source # alignment :: PrimStorable a -> Int Source # peekElemOff :: Ptr ( PrimStorable a) -> Int -> IO ( PrimStorable a) Source # pokeElemOff :: Ptr ( PrimStorable a) -> Int -> PrimStorable a -> IO () Source # peekByteOff :: Ptr b -> Int -> IO ( PrimStorable a) Source # pokeByteOff :: Ptr b -> Int -> PrimStorable a -> IO () Source # peek :: Ptr ( PrimStorable a) -> IO ( PrimStorable a) Source # poke :: Ptr ( PrimStorable a) -> PrimStorable a -> IO () Source # |
A value of type
represents a pointer to an object, or an
array of objects, which may be marshalled to or from Haskell values
of type
Ptr
a
a
.
The type
a
will often be an instance of class
Storable
which provides the marshalling operations.
However this is not essential, and you can provide your own operations
to access the pointer. For example you might write small foreign
functions to get or set the fields of a C
struct
.
Instances
NFData1 Ptr |
Since: deepseq-1.4.3.0 |
Defined in Control.DeepSeq |
|
Generic1 ( URec ( Ptr ()) :: k -> Type ) |
Since: base-4.9.0.0 |
Eq ( Ptr a) |
Since: base-2.1 |
Data a => Data ( Ptr a) |
Since: base-4.8.0.0 |
Defined in Data.Data gfoldl :: ( forall d b. Data d => c (d -> b) -> d -> c b) -> ( forall g. g -> c g) -> Ptr a -> c ( Ptr a) Source # gunfold :: ( forall b r. Data b => c (b -> r) -> c r) -> ( forall r. r -> c r) -> Constr -> c ( Ptr a) Source # toConstr :: Ptr a -> Constr Source # dataTypeOf :: Ptr a -> DataType Source # dataCast1 :: Typeable t => ( forall d. Data d => c (t d)) -> Maybe (c ( Ptr a)) Source # dataCast2 :: Typeable t => ( forall d e. ( Data d, Data e) => c (t d e)) -> Maybe (c ( Ptr a)) Source # gmapT :: ( forall b. Data b => b -> b) -> Ptr a -> Ptr a Source # gmapQl :: (r -> r' -> r) -> r -> ( forall d. Data d => d -> r') -> Ptr a -> r Source # gmapQr :: forall r r'. (r' -> r -> r) -> r -> ( forall d. Data d => d -> r') -> Ptr a -> r Source # gmapQ :: ( forall d. Data d => d -> u) -> Ptr a -> [u] Source # gmapQi :: Int -> ( forall d. Data d => d -> u) -> Ptr a -> u Source # gmapM :: Monad m => ( forall d. Data d => d -> m d) -> Ptr a -> m ( Ptr a) Source # gmapMp :: MonadPlus m => ( forall d. Data d => d -> m d) -> Ptr a -> m ( Ptr a) Source # gmapMo :: MonadPlus m => ( forall d. Data d => d -> m d) -> Ptr a -> m ( Ptr a) Source # |
|
Ord ( Ptr a) |
Since: base-2.1 |
Defined in GHC.Ptr |
|
Show ( Ptr a) |
Since: base-2.1 |
Foldable ( UAddr :: Type -> Type ) |
Since: base-4.9.0.0 |
Defined in Data.Foldable fold :: Monoid m => UAddr m -> m Source # foldMap :: Monoid m => (a -> m) -> UAddr a -> m Source # foldMap' :: Monoid m => (a -> m) -> UAddr a -> m Source # foldr :: (a -> b -> b) -> b -> UAddr a -> b Source # foldr' :: (a -> b -> b) -> b -> UAddr a -> b Source # foldl :: (b -> a -> b) -> b -> UAddr a -> b Source # foldl' :: (b -> a -> b) -> b -> UAddr a -> b Source # foldr1 :: (a -> a -> a) -> UAddr a -> a Source # foldl1 :: (a -> a -> a) -> UAddr a -> a Source # toList :: UAddr a -> [a] Source # null :: UAddr a -> Bool Source # length :: UAddr a -> Int Source # elem :: Eq a => a -> UAddr a -> Bool Source # maximum :: Ord a => UAddr a -> a Source # minimum :: Ord a => UAddr a -> a Source # |
|
Traversable ( UAddr :: Type -> Type ) |
Since: base-4.9.0.0 |
Storable ( Ptr a) |
Since: base-2.1 |
Defined in Foreign.Storable sizeOf :: Ptr a -> Int Source # alignment :: Ptr a -> Int Source # peekElemOff :: Ptr ( Ptr a) -> Int -> IO ( Ptr a) Source # pokeElemOff :: Ptr ( Ptr a) -> Int -> Ptr a -> IO () Source # peekByteOff :: Ptr b -> Int -> IO ( Ptr a) Source # pokeByteOff :: Ptr b -> Int -> Ptr a -> IO () Source # |
|
NFData ( Ptr a) |
Since: deepseq-1.4.2.0 |
Defined in Control.DeepSeq |
|
Prim ( Ptr a) Source # | |
Defined in Data.Primitive.Types sizeOf# :: Ptr a -> Int# Source # alignment# :: Ptr a -> Int# Source # indexByteArray# :: ByteArray# -> Int# -> Ptr a Source # readByteArray# :: MutableByteArray# s -> Int# -> State# s -> (# State# s, Ptr a #) Source # writeByteArray# :: MutableByteArray# s -> Int# -> Ptr a -> State# s -> State# s Source # setByteArray# :: MutableByteArray# s -> Int# -> Int# -> Ptr a -> State# s -> State# s Source # indexOffAddr# :: Addr# -> Int# -> Ptr a Source # readOffAddr# :: Addr# -> Int# -> State# s -> (# State# s, Ptr a #) Source # writeOffAddr# :: Addr# -> Int# -> Ptr a -> State# s -> State# s Source # setOffAddr# :: Addr# -> Int# -> Int# -> Ptr a -> State# s -> State# s Source # |
|
Functor ( URec ( Ptr ()) :: Type -> Type ) |
Since: base-4.9.0.0 |
Eq ( URec ( Ptr ()) p) |
Since: base-4.9.0.0 |
Ord ( URec ( Ptr ()) p) |
Since: base-4.9.0.0 |
Defined in GHC.Generics compare :: URec ( Ptr ()) p -> URec ( Ptr ()) p -> Ordering Source # (<) :: URec ( Ptr ()) p -> URec ( Ptr ()) p -> Bool Source # (<=) :: URec ( Ptr ()) p -> URec ( Ptr ()) p -> Bool Source # (>) :: URec ( Ptr ()) p -> URec ( Ptr ()) p -> Bool Source # (>=) :: URec ( Ptr ()) p -> URec ( Ptr ()) p -> Bool Source # max :: URec ( Ptr ()) p -> URec ( Ptr ()) p -> URec ( Ptr ()) p Source # min :: URec ( Ptr ()) p -> URec ( Ptr ()) p -> URec ( Ptr ()) p Source # |
|
Generic ( URec ( Ptr ()) p) |
Since: base-4.9.0.0 |
data URec ( Ptr ()) (p :: k) |
Used for marking occurrences of
Since: base-4.9.0.0 |
type Rep1 ( URec ( Ptr ()) :: k -> Type ) | |
Defined in GHC.Generics |
|
type Rep ( URec ( Ptr ()) p) | |
Defined in GHC.Generics |