#ifdef ghcjs_HOST_OS
#endif
module Numeric.Commons
( ElemRep, ElemPrim
, PrimBytes (..)
) where
#include "MachDeps.h"
#ifndef ghcjs_HOST_OS
import GHC.Base (runRW#)
#endif
import GHC.Int (Int16 (..), Int32 (..), Int64 (..), Int8 (..))
import GHC.Prim
import GHC.Types (Double (..), Float (..), Int (..), RuntimeRep (..),
Type, Word (..))
import GHC.Word (Word16 (..), Word32 (..), Word64 (..), Word8 (..))
type family ElemRep a :: RuntimeRep
type instance ElemRep Float = 'FloatRep
type instance ElemRep Double = 'DoubleRep
type instance ElemRep Int = 'IntRep
type instance ElemRep Int8 = 'IntRep
type instance ElemRep Int16 = 'IntRep
type instance ElemRep Int32 = 'IntRep
#if WORD_SIZE_IN_BITS < 64
type instance ElemRep Int64 = 'Int64Rep
#else
type instance ElemRep Int64 = 'IntRep
#endif
type instance ElemRep Word = 'WordRep
type instance ElemRep Word8 = 'WordRep
type instance ElemRep Word16 = 'WordRep
type instance ElemRep Word32 = 'WordRep
#if WORD_SIZE_IN_BITS < 64
type instance ElemRep Word64 = 'Word64Rep
#else
type instance ElemRep Word64 = 'WordRep
#endif
type family ElemPrim a :: TYPE (r :: RuntimeRep)
type instance ElemPrim Float = Float#
type instance ElemPrim Double = Double#
type instance ElemPrim Int = Int#
type instance ElemPrim Int8 = Int#
type instance ElemPrim Int16 = Int#
type instance ElemPrim Int32 = Int#
#if WORD_SIZE_IN_BITS < 64
type instance ElemPrim Int64 = Int64#
#else
type instance ElemPrim Int64 = Int#
#endif
type instance ElemPrim Word = Word#
type instance ElemPrim Word8 = Word#
type instance ElemPrim Word16 = Word#
type instance ElemPrim Word32 = Word#
#if WORD_SIZE_IN_BITS < 64
type instance ElemPrim Word64 = Word64#
#else
type instance ElemPrim Word64 = Word#
#endif
class PrimBytes (a :: Type) where
toBytes :: a -> (# Int# , Int# , ByteArray# #)
fromBytes :: (# Int# , Int# , ByteArray# #) -> a
byteSize :: a -> Int#
byteAlign :: a -> Int#
elementByteSize :: a -> Int#
ix :: Int# -> a -> (ElemPrim a :: TYPE (ElemRep a))
instance PrimBytes Float where
#ifdef ghcjs_HOST_OS
toBytes v = (# 0#, 1#, js_wrapFloat v #)
fromBytes (# off, _, arr #) = js_unwrapFloat arr off
#else
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 #) -> (# 0#, 1#, a #)
fromBytes (# off, _, arr #) = F# (indexFloatArray# arr off)
#endif
byteSize _ = SIZEOF_HSFLOAT#
byteAlign _ = ALIGNMENT_HSFLOAT#
elementByteSize = byteSize
ix _ (F# x) = x
instance PrimBytes Double where
#ifdef ghcjs_HOST_OS
toBytes v = (# 0#, 1#, js_wrapDouble v #)
fromBytes (# off, _, arr #) = js_unwrapDouble arr off
#else
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 #) -> (# 0#, 1#, a #)
fromBytes (# off, _, arr #) = D# (indexDoubleArray# arr off)
#endif
byteSize _ = SIZEOF_HSDOUBLE#
byteAlign _ = ALIGNMENT_HSDOUBLE#
elementByteSize = byteSize
ix _ (D# x) = x
instance PrimBytes Int where
#ifdef ghcjs_HOST_OS
toBytes v = (# 0#, 1#, js_wrapInt v #)
fromBytes (# off, _, arr #) = js_unwrapInt arr off
#else
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 #) -> (# 0#, 1#, a #)
fromBytes (# off, _, arr #) = I# (indexIntArray# arr off)
#endif
byteSize _ = SIZEOF_HSINT#
byteAlign _ = ALIGNMENT_HSINT#
elementByteSize = byteSize
ix _ (I# x) = x
instance PrimBytes Int8 where
#ifdef ghcjs_HOST_OS
toBytes v = (# 0#, 1#, js_wrapInt8 v #)
fromBytes (# off, _, arr #) = js_unwrapInt8 arr off
#else
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 #) -> (# 0#, 1#, a #)
fromBytes (# off, _, arr #) = I8# (indexInt8Array# arr off)
#endif
byteSize _ = SIZEOF_INT8#
byteAlign _ = ALIGNMENT_INT8#
elementByteSize = byteSize
ix _ (I8# x) = x
instance PrimBytes Int16 where
#ifdef ghcjs_HOST_OS
toBytes v = (# 0#, 1#, js_wrapInt16 v #)
fromBytes (# off, _, arr #) = js_unwrapInt16 arr off
#else
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 #) -> (# 0#, 1#, a #)
fromBytes (# off, _, arr #) = I16# (indexInt16Array# arr off)
#endif
byteSize _ = SIZEOF_INT16#
byteAlign _ = ALIGNMENT_INT16#
elementByteSize = byteSize
ix _ (I16# x) = x
instance PrimBytes Int32 where
#ifdef ghcjs_HOST_OS
toBytes v = (# 0#, 1#, js_wrapInt32 v #)
fromBytes (# off, _, arr #) = js_unwrapInt32 arr off
#else
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 #) -> (# 0#, 1#, a #)
fromBytes (# off, _, arr #) = I32# (indexInt32Array# arr off)
#endif
byteSize _ = SIZEOF_INT32#
byteAlign _ = ALIGNMENT_INT32#
elementByteSize = byteSize
ix _ (I32# x) = x
#ifndef ghcjs_HOST_OS
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 #) -> (# 0#, 1#, a #)
fromBytes (# off, _, arr #) = I64# (indexInt64Array# arr off)
byteSize _ = SIZEOF_INT64#
byteAlign _ = ALIGNMENT_INT64#
elementByteSize = byteSize
ix _ (I64# x) = x
#endif
instance PrimBytes Word where
#ifdef ghcjs_HOST_OS
toBytes v = (# 0#, 1#, js_wrapWord v #)
fromBytes (# off, _, arr #) = js_unwrapWord arr off
#else
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 #) -> (# 0#, 1#, a #)
fromBytes (# off, _, arr #) = W# (indexWordArray# arr off)
#endif
byteSize _ = SIZEOF_HSWORD#
byteAlign _ = ALIGNMENT_HSWORD#
elementByteSize = byteSize
ix _ (W# x) = x
instance PrimBytes Word8 where
#ifdef ghcjs_HOST_OS
toBytes v = (# 0#, 1#, js_wrapWord8 v #)
fromBytes (# off, _, arr #) = js_unwrapWord8 arr off
#else
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 #) -> (# 0#, 1#, a #)
fromBytes (# off, _, arr #) = W8# (indexWord8Array# arr off)
#endif
byteSize _ = SIZEOF_WORD8#
byteAlign _ = ALIGNMENT_WORD8#
elementByteSize = byteSize
ix _ (W8# x) = x
instance PrimBytes Word16 where
#ifdef ghcjs_HOST_OS
toBytes v = (# 0#, 1#, js_wrapWord16 v #)
fromBytes (# off, _, arr #) = js_unwrapWord16 arr off
#else
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 #) -> (# 0#, 1#, a #)
fromBytes (# off, _, arr #) = W16# (indexWord16Array# arr off)
#endif
byteSize _ = SIZEOF_WORD16#
byteAlign _ = ALIGNMENT_WORD16#
elementByteSize = byteSize
ix _ (W16# x) = x
instance PrimBytes Word32 where
#ifdef ghcjs_HOST_OS
toBytes v = (# 0#, 1#, js_wrapWord32 v #)
fromBytes (# off, _, arr #) = js_unwrapWord32 arr off
#else
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 #) -> (# 0#, 1#, a #)
fromBytes (# off, _, arr #) = W32# (indexWord32Array# arr off)
#endif
byteSize _ = SIZEOF_WORD32#
byteAlign _ = ALIGNMENT_WORD32#
elementByteSize = byteSize
ix _ (W32# x) = x
#ifndef ghcjs_HOST_OS
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 #) -> (# 0#, 1#, a #)
fromBytes (# off, _, arr #) = W64# (indexWord64Array# arr off)
byteSize _ = SIZEOF_WORD64#
byteAlign _ = ALIGNMENT_WORD64#
elementByteSize = byteSize
ix _ (W64# x) = x
#endif
#ifdef ghcjs_HOST_OS
foreign import javascript unsafe "h$wrapBuffer((new Float32Array([$1])).buffer)" js_wrapFloat :: Float -> ByteArray#
foreign import javascript unsafe "h$wrapBuffer((new Float64Array([$1])).buffer)" js_wrapDouble :: Double -> ByteArray#
foreign import javascript unsafe "h$wrapBuffer((new Int32Array([$1])).buffer)" js_wrapInt :: Int -> ByteArray#
foreign import javascript unsafe "h$wrapBuffer((new Int32Array([$1])).buffer)" js_wrapInt32 :: Int32 -> ByteArray#
foreign import javascript unsafe "h$wrapBuffer((new Int16Array([$1])).buffer)" js_wrapInt16 :: Int16 -> ByteArray#
foreign import javascript unsafe "h$wrapBuffer((new Int8Array([$1])).buffer)" js_wrapInt8 :: Int8 -> ByteArray#
foreign import javascript unsafe "h$wrapBuffer((new Uint32Array([$1])).buffer)" js_wrapWord :: Word -> ByteArray#
foreign import javascript unsafe "h$wrapBuffer((new Uint32Array([$1])).buffer)" js_wrapWord32 :: Word32 -> ByteArray#
foreign import javascript unsafe "h$wrapBuffer((new Uint16Array([$1])).buffer)" js_wrapWord16 :: Word16 -> ByteArray#
foreign import javascript unsafe "h$wrapBuffer((new Uint8Array([$1])).buffer)" js_wrapWord8 :: Word8 -> ByteArray#
foreign import javascript unsafe "($1.f3 || new Float32Array($1.buf))[$2]" js_unwrapFloat :: ByteArray# -> Int# -> Float
foreign import javascript unsafe "($1.f6 || new Float64Array($1.buf))[$2]" js_unwrapDouble :: ByteArray# -> Int# -> Double
foreign import javascript unsafe "($1.i3 || new Int32Array($1.buf))[$2]" js_unwrapInt :: ByteArray# -> Int# -> Int
foreign import javascript unsafe "($1.i3 || new Int32Array($1.buf))[$2]" js_unwrapInt32 :: ByteArray# -> Int# -> Int32
foreign import javascript unsafe "($1.i1 || new Int16Array($1.buf))[$2]" js_unwrapInt16 :: ByteArray# -> Int# -> Int16
foreign import javascript unsafe "($1.i8 || new Int8Array($1.buf))[$2]" js_unwrapInt8 :: ByteArray# -> Int# -> Int8
foreign import javascript unsafe "($1.u3 || new Uint32Array($1.buf))[$2]" js_unwrapWord :: ByteArray# -> Int# -> Word
foreign import javascript unsafe "($1.u3 || new Uint32Array($1.buf))[$2]" js_unwrapWord32 :: ByteArray# -> Int# -> Word32
foreign import javascript unsafe "($1.u1 || new Uint16Array($1.buf))[$2]" js_unwrapWord16 :: ByteArray# -> Int# -> Word16
foreign import javascript unsafe "($1.u8 || new Uint8Array($1.buf))[$2]" js_unwrapWord8 :: ByteArray# -> Int# -> Word8
#endif