module Numeric.Commons
( PrimBytes (..)
, FloatBytes (..)
, DoubleBytes (..)
, IntBytes (..)
, WordBytes (..)
) where
#include "MachDeps.h"
#include "HsBaseConfig.h"
import GHC.Base (runRW#)
import GHC.Ptr
import GHC.Prim
import GHC.Types
import GHC.Int
import GHC.Word
import Foreign.Storable
class PrimBytes a where
toBytes :: a -> ByteArray#
fromBytes :: ByteArray# -> a
byteSize :: a -> Int#
byteAlign :: a -> Int#
class FloatBytes a where
ixF :: Int# -> a -> Float#
class DoubleBytes a where
ixD :: Int# -> a -> Double#
class IntBytes a where
ixI :: Int# -> a -> Int#
class WordBytes a where
ixW :: Int# -> a -> Word#
instance PrimBytes a => Storable a where
sizeOf x = I# (byteSize x)
alignment x = I# (byteAlign x)
peekElemOff ptr (I# offset) = peekByteOff ptr (I# (offset *# byteSize (undefined :: a)))
pokeElemOff ptr (I# offset) = pokeByteOff ptr (I# (offset *# byteSize (undefined :: a)))
peekByteOff (Ptr addr) (I# offset) = IO $ \s0 -> case newByteArray# bsize s0 of
(# s1, marr #) -> case copyAddrToByteArray# (addr `plusAddr#` offset) marr 0# bsize s1 of
s2 -> case unsafeFreezeByteArray# marr s2 of
(# s3, arr #) -> (# s3, fromBytes arr #)
where
bsize = byteSize (undefined :: a)
pokeByteOff (Ptr addr) (I# offset) x = IO $ \s0 -> case copyByteArrayToAddr# (toBytes x)
0#
(addr `plusAddr#` offset)
bsize s0 of
s2 -> (# s2, () #)
where
bsize = byteSize (undefined :: a)
peek ptr = peekByteOff ptr 0
poke ptr = pokeByteOff ptr 0
instance PrimBytes Float where
toBytes v@(F# x) = case runRW#
( \s0 -> case newByteArray# (byteSize v) s0 of
(# s1, marr #) -> case writeFloatArray# marr 0# x s1 of
s2 -> unsafeFreezeByteArray# marr s2
) of (# _, a #) -> a
fromBytes arr = F# (indexFloatArray# arr 0#)
byteSize _ = SIZEOF_HSFLOAT#
byteAlign _ = ALIGNMENT_HSFLOAT#
instance FloatBytes Float where
ixF _ (F# x) = x
instance PrimBytes Double where
toBytes v@(D# x) = case runRW#
( \s0 -> case newByteArray# (byteSize v) s0 of
(# s1, marr #) -> case writeDoubleArray# marr 0# x s1 of
s2 -> unsafeFreezeByteArray# marr s2
) of (# _, a #) -> a
fromBytes arr = D# (indexDoubleArray# arr 0#)
byteSize _ = SIZEOF_HSDOUBLE#
byteAlign _ = ALIGNMENT_HSDOUBLE#
instance DoubleBytes Double where
ixD _ (D# x) = x
instance PrimBytes Int where
toBytes v@(I# x) = case runRW#
( \s0 -> case newByteArray# (byteSize v) s0 of
(# s1, marr #) -> case writeIntArray# marr 0# x s1 of
s2 -> unsafeFreezeByteArray# marr s2
) of (# _, a #) -> a
fromBytes arr = I# (indexIntArray# arr 0#)
byteSize _ = SIZEOF_HSINT#
byteAlign _ = ALIGNMENT_HSINT#
instance IntBytes Int where
ixI _ (I# x) = x
instance PrimBytes Int8 where
toBytes v@(I8# x) = case runRW#
( \s0 -> case newByteArray# (byteSize v) s0 of
(# s1, marr #) -> case writeInt8Array# marr 0# x s1 of
s2 -> unsafeFreezeByteArray# marr s2
) of (# _, a #) -> a
fromBytes arr = I8# (indexInt8Array# arr 0#)
byteSize _ = SIZEOF_INT8#
byteAlign _ = ALIGNMENT_INT8#
instance IntBytes Int8 where
ixI _ (I8# x) = x
instance PrimBytes Int16 where
toBytes v@(I16# x) = case runRW#
( \s0 -> case newByteArray# (byteSize v) s0 of
(# s1, marr #) -> case writeInt16Array# marr 0# x s1 of
s2 -> unsafeFreezeByteArray# marr s2
) of (# _, a #) -> a
fromBytes arr = I16# (indexInt16Array# arr 0#)
byteSize _ = SIZEOF_INT16#
byteAlign _ = ALIGNMENT_INT16#
instance IntBytes Int16 where
ixI _ (I16# x) = x
instance PrimBytes Int32 where
toBytes v@(I32# x) = case runRW#
( \s0 -> case newByteArray# (byteSize v) s0 of
(# s1, marr #) -> case writeInt32Array# marr 0# x s1 of
s2 -> unsafeFreezeByteArray# marr s2
) of (# _, a #) -> a
fromBytes arr = I32# (indexInt32Array# arr 0#)
byteSize _ = SIZEOF_INT32#
byteAlign _ = ALIGNMENT_INT32#
instance IntBytes Int32 where
ixI _ (I32# x) = x
instance PrimBytes Int64 where
toBytes v@(I64# x) = case runRW#
( \s0 -> case newByteArray# (byteSize v) s0 of
(# s1, marr #) -> case writeInt64Array# marr 0# x s1 of
s2 -> unsafeFreezeByteArray# marr s2
) of (# _, a #) -> a
fromBytes arr = I64# (indexInt64Array# arr 0#)
byteSize _ = SIZEOF_INT64#
byteAlign _ = ALIGNMENT_INT64#
instance IntBytes Int64 where
ixI _ (I64# x) = x
instance PrimBytes Word where
toBytes v@(W# x) = case runRW#
( \s0 -> case newByteArray# (byteSize v) s0 of
(# s1, marr #) -> case writeWordArray# marr 0# x s1 of
s2 -> unsafeFreezeByteArray# marr s2
) of (# _, a #) -> a
fromBytes arr = W# (indexWordArray# arr 0#)
byteSize _ = SIZEOF_HSWORD#
byteAlign _ = ALIGNMENT_HSWORD#
instance WordBytes Word where
ixW _ (W# x) = x
instance PrimBytes Word8 where
toBytes v@(W8# x) = case runRW#
( \s0 -> case newByteArray# (byteSize v) s0 of
(# s1, marr #) -> case writeWord8Array# marr 0# x s1 of
s2 -> unsafeFreezeByteArray# marr s2
) of (# _, a #) -> a
fromBytes arr = W8# (indexWord8Array# arr 0#)
byteSize _ = SIZEOF_WORD8#
byteAlign _ = ALIGNMENT_WORD8#
instance WordBytes Word8 where
ixW _ (W8# x) = x
instance PrimBytes Word16 where
toBytes v@(W16# x) = case runRW#
( \s0 -> case newByteArray# (byteSize v) s0 of
(# s1, marr #) -> case writeWord16Array# marr 0# x s1 of
s2 -> unsafeFreezeByteArray# marr s2
) of (# _, a #) -> a
fromBytes arr = W16# (indexWord16Array# arr 0#)
byteSize _ = SIZEOF_WORD16#
byteAlign _ = ALIGNMENT_WORD16#
instance WordBytes Word16 where
ixW _ (W16# x) = x
instance PrimBytes Word32 where
toBytes v@(W32# x) = case runRW#
( \s0 -> case newByteArray# (byteSize v) s0 of
(# s1, marr #) -> case writeWord32Array# marr 0# x s1 of
s2 -> unsafeFreezeByteArray# marr s2
) of (# _, a #) -> a
fromBytes arr = W32# (indexWord32Array# arr 0#)
byteSize _ = SIZEOF_WORD32#
byteAlign _ = ALIGNMENT_WORD32#
instance WordBytes Word32 where
ixW _ (W32# x) = x
instance PrimBytes Word64 where
toBytes v@(W64# x) = case runRW#
( \s0 -> case newByteArray# (byteSize v) s0 of
(# s1, marr #) -> case writeWord64Array# marr 0# x s1 of
s2 -> unsafeFreezeByteArray# marr s2
) of (# _, a #) -> a
fromBytes arr = W64# (indexWord64Array# arr 0#)
byteSize _ = SIZEOF_WORD64#
byteAlign _ = ALIGNMENT_WORD64#
instance WordBytes Word64 where
ixW _ (W64# x) = x