Copyright | (c) Artem Chirkin |
---|---|
License | BSD3 |
Safe Haskell | None |
Language | Haskell2010 |
Facilities for converting Haskell data to and from raw bytes.
The main purpose of this module is to support the implementation of the DataFrame
Backend
. However, it also comes very useful for
writing FFI. To that end, the PrimBytes
class is similar to
the Storable
class: it provides means to write
your data to and read from a raw memory area. Though, it is more flexible in that
it can work with both, foreign pointers and primitive byte arrays,
and it provides means to get data field offsets by their selector names.
On top of that, a PrimBytes
instance can be derived via
the Generic
machinery.
A derived PrimBytes
instance tries to pack the data as dense as possible,
while respecting the alignment requirements. In all cases known to me,
the resulting data layout coincides with a corresponding C struct, allowing
to marshal the data without any boilerplate. However, this is not guaranteed,
but you can write a PrimBytes
instance manually if necessary
(and report an issue plz).
Note about alignment, size, and padding of the data. There are two basic sanity assumptions about these, which are not checked in this module at all:
- the alignment is always a power of 2;
- the size is always rounded up to a multiple of the alignment.
Generated instances of PrimBytes
meet these assumptions if all components of
a data meet these assumptions too.
You are strongly advised to provide all byte offset arguments to the PrimBytes
functions respecting the alignment of the data;
otherwise, the data may be written or read incorrectly.
Synopsis
- class PrimTagged a => PrimBytes a where
- type PrimFields a :: [Symbol]
- getBytes :: a -> ByteArray#
- getBytesPinned :: a -> ByteArray#
- fromBytes :: Int# -> ByteArray# -> a
- readBytes :: MutableByteArray# s -> Int# -> State# s -> (# State# s, a #)
- writeBytes :: MutableByteArray# s -> Int# -> a -> State# s -> State# s
- readAddr :: Addr# -> State# s -> (# State# s, a #)
- writeAddr :: a -> Addr# -> State# s -> State# s
- byteSize :: a -> Int#
- byteAlign :: a -> Int#
- byteOffset :: a -> Int#
- byteFieldOffset :: (Elem name (PrimFields a), KnownSymbol name) => Proxy# name -> a -> Int#
- indexArray :: ByteArray# -> Int# -> a
- readArray :: MutableByteArray# s -> Int# -> State# s -> (# State# s, a #)
- writeArray :: MutableByteArray# s -> Int# -> a -> State# s -> State# s
- bSizeOf :: (PrimBytes a, Num b) => a -> b
- bAlignOf :: (PrimBytes a, Num b) => a -> b
- bFieldOffsetOf :: forall (name :: Symbol) (a :: Type) (b :: Type). (PrimBytes a, Elem name (PrimFields a), KnownSymbol name, Num b) => a -> b
- bPeekElemOff :: forall (a :: Type). PrimBytes a => Ptr a -> Int -> IO a
- bPokeElemOff :: forall (a :: Type). PrimBytes a => Ptr a -> Int -> a -> IO ()
- bPeekByteOff :: forall (a :: Type) (b :: Type). PrimBytes a => Ptr b -> Int -> IO a
- bPokeByteOff :: forall (a :: Type) (b :: Type). PrimBytes a => Ptr b -> Int -> a -> IO ()
- bPeek :: forall (a :: Type). PrimBytes a => Ptr a -> IO a
- bPoke :: forall (a :: Type). PrimBytes a => Ptr a -> a -> IO ()
- data PrimTag a where
- PTagFloat :: PrimTag Float
- PTagDouble :: PrimTag Double
- PTagInt :: PrimTag Int
- PTagInt8 :: PrimTag Int8
- PTagInt16 :: PrimTag Int16
- PTagInt32 :: PrimTag Int32
- PTagInt64 :: PrimTag Int64
- PTagWord :: PrimTag Word
- PTagWord8 :: PrimTag Word8
- PTagWord16 :: PrimTag Word16
- PTagWord32 :: PrimTag Word32
- PTagWord64 :: PrimTag Word64
- PTagChar :: PrimTag Char
- PTagPtr :: PrimTag (Ptr a)
- PTagOther :: PrimTag a
- primTag :: PrimBytes a => a -> PrimTag a
PrimBytes API
class PrimTagged a => PrimBytes a where Source #
Defines how to read and write your data to and from Haskell unboxed byte arrays and plain pointers.
Similarly to Storable
, this class provides functions to get
the size and alignment of a data via phantom arguments.
Thus, the size and alignment of the data must not depend on the data content
(they depend only on the type of the data).
In particular, this means that dynamically sized structures like Haskell lists
or maps are not allowed.
This module provides default implementations for all methods of this class via
Generic
. Hence, to make your data an instance of PrimBytes
,
it is sufficient to write the instance head:
data MyData a b = ... deriving Generic instance (PrimBytes a, PrimBytes b) => PrimBytes (MyData a b)
.. or use the DeriveAnyClass
extension to make it even shorter:
data MyData a b = ... deriving (Generic, PrimBytes)
The derived instance tries to pack the data as dense as possible, but sometimes
it is better to write the instance by hand.
If a derived type has more than one constructor, the derived instance puts
a Word32
tag at the beginning of the byte representation.
All fields of a constructor are packed in a C-like fashion next to each other,
while respecting their alignments.
Nothing
type PrimFields a :: [Symbol] Source #
List of field names.
It is used to get field offsets using byteFieldOffset
function.
A Generic-derived instance has this list non-empty only if two obvious conditions are met:
- The data has only one constructor.
- The data uses record syntax to define its fields.
type PrimFields a = GPrimFields (Rep a)
getBytes :: a -> ByteArray# Source #
Store content of a data type in a primitive byte array
(should be used together with byteOffset
function).
Note, the default implementation of this function returns a not pinned
array, which is aligned to 8
.
Thus, it ignores the alignment of the underlying data type if it is larger.
However, alignment calculation still makes sense for data types
that are smaller than 8
bytes: they are packed more densely.
getBytesPinned :: a -> ByteArray# Source #
Store content of a data type in a primitive byte array
(should be used together with byteOffset
function).
In contrast to getBytes
, this function returns a pinned byte array,
aligned to the byteAlign
bytes of this data.
Note, GC guarantees not to move the created array. While this is very useful sometimes, it incurs a certain performance penalty.
:: Int# | Offset in bytes |
-> ByteArray# | Source array |
-> a |
Load content of a data type from a primitive byte array given an offset in bytes.
:: MutableByteArray# s | Source array |
-> Int# | Byte offset in the source array |
-> State# s | |
-> (# State# s, a #) |
Read data from a mutable byte array given an offset in bytes.
default readBytes :: (Generic a, GPrimBytes (Rep a)) => MutableByteArray# s -> Int# -> State# s -> (# State# s, a #) Source #
:: MutableByteArray# s | Destination array |
-> Int# | Byte offset in the destination array |
-> a | Data to write into the array |
-> State# s | |
-> State# s |
Write data into a mutable byte array at a given position (offset in bytes).
default writeBytes :: (Generic a, GPrimBytes (Rep a)) => MutableByteArray# s -> Int# -> a -> State# s -> State# s Source #
readAddr :: Addr# -> State# s -> (# State# s, a #) Source #
Read data from a specified address.
default readAddr :: (Generic a, GPrimBytes (Rep a)) => Addr# -> State# s -> (# State# s, a #) Source #
writeAddr :: a -> Addr# -> State# s -> State# s Source #
Write data to a specified address.
byteSize :: a -> Int# Source #
Size of a data type in bytes.
It should be a multiple of byteAlign
for indexing functions to operate
correctly.
Implementation of this function must not inspect the argument value;
a caller may provide undefined
in place of the argument.
byteAlign :: a -> Int# Source #
Alignment of a data type in bytes.
byteOffset
should be multiple of this value.
Implementation of this function must not inspect the argument value;
a caller may provide undefined
in place of the argument.
byteOffset :: a -> Int# Source #
Offset of the data in a byte array used to store the data,
measured in bytes.
Should be used together with getBytes
function.
Unless in case of special data types represented by ByteArrays,
it is equal to zero.
Implementation of this function may inspect the argument value;
a caller must not provide undefined
in place of the argument.
byteFieldOffset :: (Elem name (PrimFields a), KnownSymbol name) => Proxy# name -> a -> Int# Source #
Offset of a data record within the data type in bytes.
Implementation of this function must not inspect the argument value;
a caller may provide undefined
in place of the argument.
The default (generic) implementation of this fucntion looks for the
leftmost occurrence of a given field name (in case of multiple constructors).
If a field with the given name is not found, it returns -1
,
but this is not possible thanks to Elem name (PrimFields a)
constraint.
default byteFieldOffset :: (Generic a, GPrimBytes (Rep a), KnownSymbol name) => Proxy# name -> a -> Int# Source #
indexArray :: ByteArray# -> Int# -> a Source #
Index array given an element offset
(which is byteSize a
and should be a multiple of byteAlign a
).
readArray :: MutableByteArray# s -> Int# -> State# s -> (# State# s, a #) Source #
Read a mutable array given an element offset
(which is byteSize a
and should be a multiple of byteAlign a
).
writeArray :: MutableByteArray# s -> Int# -> a -> State# s -> State# s Source #
Write a mutable array given an element offset
(which is byteSize a
and should be a multiple of byteAlign a
).
Instances
bFieldOffsetOf :: forall (name :: Symbol) (a :: Type) (b :: Type). (PrimBytes a, Elem name (PrimFields a), KnownSymbol name, Num b) => a -> b Source #
A wrapper on byteFieldOffset
.
Storable API
Storable
can be defined in terms of PrimBytes
by doing something like the following for your data type:
instance PrimBytes a => Storable a where sizeOf = bSizeOf alignment = bAlignOf peekElemOff = bPeekElemOff pokeElemOff = bPokeElemOff peekByteOff = bPeekByteOff pokeByteOff = bPokeByteOff peek = bPeek poke = bPoke
bPeekElemOff :: forall (a :: Type). PrimBytes a => Ptr a -> Int -> IO a Source #
Same as peekElemOff
: peek an element a
by the offset
measured in byteSize a
.
Note: the size of the element must be a multiple of its alignment for a correct operation of this function.
bPokeElemOff :: forall (a :: Type). PrimBytes a => Ptr a -> Int -> a -> IO () Source #
Same as pokeElemOff
: poke an element a
by the offset
measured in byteSize a
.
Note: the size of the element must be a multiple of its alignment for a correct operation of this function.
bPeekByteOff :: forall (a :: Type) (b :: Type). PrimBytes a => Ptr b -> Int -> IO a Source #
Same as peekByteOff
: peek an element a
by the offset
measured in bytes.
Note: you'd better be sure the address is a multiple of
the data alignment (peek
).
bPokeByteOff :: forall (a :: Type) (b :: Type). PrimBytes a => Ptr b -> Int -> a -> IO () Source #
Same as pokeByteOff
: poke an element a
by the offset
measured in bytes.
Note: you'd better be sure the address is a multiple of
the data alignment (peek
).
Specialization tools
Find out which basic GHC type it is at runtime.
It is used for DataFrame
backend specialization:
by matching a PrimTag a
against its constructors, you can figure out
a specific implementation of Backend a ds
(e.g. whether this is a specialized float array, or a generic polymorphic array).
For non-basic types it defaults to PTagOther
.
PTagFloat :: PrimTag Float | |
PTagDouble :: PrimTag Double | |
PTagInt :: PrimTag Int | |
PTagInt8 :: PrimTag Int8 | |
PTagInt16 :: PrimTag Int16 | |
PTagInt32 :: PrimTag Int32 | |
PTagInt64 :: PrimTag Int64 | |
PTagWord :: PrimTag Word | |
PTagWord8 :: PrimTag Word8 | |
PTagWord16 :: PrimTag Word16 | |
PTagWord32 :: PrimTag Word32 | |
PTagWord64 :: PrimTag Word64 | |
PTagChar :: PrimTag Char | |
PTagPtr :: PrimTag (Ptr a) | |
PTagOther :: PrimTag a |