module Raaz.Core.Types.Endian
( EndianStore(..)
, LE, BE, littleEndian, bigEndian
, storeAt, storeAtIndex
, loadFrom, loadFromIndex
) where
import Control.DeepSeq ( NFData)
import Control.Monad ( liftM )
import Data.Bits
import Data.Monoid
import Data.Typeable
import Data.Vector.Unboxed ( MVector(..), Vector, Unbox )
import Data.Word ( Word32, Word64, Word8 )
import Foreign.Ptr ( castPtr )
import Foreign.Storable ( Storable(..) )
import qualified Data.Vector.Generic as GV
import qualified Data.Vector.Generic.Mutable as GVM
import Raaz.Core.MonoidalAction
import Raaz.Core.Types.Pointer
import Raaz.Core.Types.Equality
class Storable w => EndianStore w where
store :: Pointer
-> w
-> IO ()
load :: Pointer -> IO w
instance EndianStore Word8 where
store = poke . castPtr
load = peek . castPtr
storeAtIndex :: EndianStore w
=> Pointer
-> Int
-> w
-> IO ()
storeAtIndex cptr index w = storeAt cptr offset w
where offset = toEnum index * byteSize w
storeAt :: ( EndianStore w
, LengthUnit offset
)
=> Pointer
-> offset
-> w
-> IO ()
storeAt cptr offset = store (Sum offset <.> cptr)
loadFromIndex :: EndianStore w
=> Pointer
-> Int
-> IO w
loadFromIndex cptr index = loadP undefined
where loadP :: (EndianStore w, Storable w) => w -> IO w
loadP w = loadFrom cptr offset
where offset = toEnum index * byteSize w
loadFrom :: ( EndianStore w
, LengthUnit offset
)
=> Pointer
-> offset
-> IO w
loadFrom cptr offset = load (Sum offset <.> cptr)
--}
newtype LE w = LE w
deriving ( Bounded, Enum, Read, Show
, Integral, Num, Real, Eq, Equality, Ord
, Bits, Storable, Typeable, NFData
)
newtype BE w = BE w
deriving ( Bounded, Enum, Read, Show
, Integral, Num, Real, Eq, Equality, Ord
, Bits, Storable, Typeable, NFData
)
littleEndian :: w -> LE w
littleEndian = LE
bigEndian :: w -> BE w
bigEndian = BE
foreign import ccall unsafe "raaz/core/endian.h raazLoadLE32"
c_loadLE32 :: Pointer -> IO Word32
foreign import ccall unsafe "raaz/core/endian.h raazStoreLE32"
c_storeLE32 :: Pointer -> Word32 -> IO ()
instance EndianStore (LE Word32) where
load = fmap LE . c_loadLE32
store ptr (LE w) = c_storeLE32 ptr w
foreign import ccall unsafe "raaz/core/endian.h raazLoadBE32"
c_loadBE32 :: Pointer -> IO Word32
foreign import ccall unsafe "raaz/core/endian.h raazStoreBE32"
c_storeBE32 :: Pointer -> Word32 -> IO ()
instance EndianStore (BE Word32) where
load = fmap BE . c_loadBE32
store ptr (BE w) = c_storeBE32 ptr w
foreign import ccall unsafe "raaz/core/endian.h raazLoadLE64"
c_loadLE64 :: Pointer -> IO Word64
foreign import ccall unsafe "raaz/core/endian.h raazStoreLE64"
c_storeLE64 :: Pointer -> Word64 -> IO ()
instance EndianStore (LE Word64) where
load = fmap LE . c_loadLE64
store ptr (LE w) = c_storeLE64 ptr w
foreign import ccall unsafe "raaz/core/endian.h raazLoadBE64"
c_loadBE64 :: Pointer -> IO Word64
foreign import ccall unsafe "raaz/core/endian.h raazStoreBE64"
c_storeBE64 :: Pointer -> Word64 -> IO ()
instance EndianStore (BE Word64) where
load = fmap BE . c_loadBE64
store ptr (BE w) = c_storeBE64 ptr w
instance Unbox w => Unbox (LE w)
instance Unbox w => Unbox (BE w)
newtype instance MVector s (LE w) = MV_LE (MVector s w)
newtype instance Vector (LE w) = V_LE (Vector w)
newtype instance MVector s (BE w) = MV_BE (MVector s w)
newtype instance Vector (BE w) = V_BE (Vector w)
instance Unbox w => GVM.MVector MVector (LE w) where
basicLength (MV_LE v) = GVM.basicLength v
basicUnsafeSlice i n (MV_LE v) = MV_LE $ GVM.basicUnsafeSlice i n v
basicOverlaps (MV_LE v1) (MV_LE v2) = GVM.basicOverlaps v1 v2
basicUnsafeRead (MV_LE v) i = LE `liftM` GVM.basicUnsafeRead v i
basicUnsafeWrite (MV_LE v) i (LE x) = GVM.basicUnsafeWrite v i x
basicClear (MV_LE v) = GVM.basicClear v
basicSet (MV_LE v) (LE x) = GVM.basicSet v x
basicUnsafeNew n = MV_LE `liftM` GVM.basicUnsafeNew n
basicUnsafeReplicate n (LE x) = MV_LE `liftM` GVM.basicUnsafeReplicate n x
basicUnsafeCopy (MV_LE v1) (MV_LE v2) = GVM.basicUnsafeCopy v1 v2
basicUnsafeGrow (MV_LE v) n = MV_LE `liftM` GVM.basicUnsafeGrow v n
#if MIN_VERSION_vector(0,11,0)
basicInitialize (MV_LE v) = GVM.basicInitialize v
#endif
instance Unbox w => GV.Vector Vector (LE w) where
basicUnsafeFreeze (MV_LE v) = V_LE `liftM` GV.basicUnsafeFreeze v
basicUnsafeThaw (V_LE v) = MV_LE `liftM` GV.basicUnsafeThaw v
basicLength (V_LE v) = GV.basicLength v
basicUnsafeSlice i n (V_LE v) = V_LE $ GV.basicUnsafeSlice i n v
basicUnsafeIndexM (V_LE v) i = LE `liftM` GV.basicUnsafeIndexM v i
basicUnsafeCopy (MV_LE mv) (V_LE v) = GV.basicUnsafeCopy mv v
elemseq _ (LE x) = GV.elemseq (undefined :: Vector a) x
instance Unbox w => GVM.MVector MVector (BE w) where
basicLength (MV_BE v) = GVM.basicLength v
basicUnsafeSlice i n (MV_BE v) = MV_BE $ GVM.basicUnsafeSlice i n v
basicOverlaps (MV_BE v1) (MV_BE v2) = GVM.basicOverlaps v1 v2
basicUnsafeRead (MV_BE v) i = BE `liftM` GVM.basicUnsafeRead v i
basicUnsafeWrite (MV_BE v) i (BE x) = GVM.basicUnsafeWrite v i x
basicClear (MV_BE v) = GVM.basicClear v
basicSet (MV_BE v) (BE x) = GVM.basicSet v x
basicUnsafeNew n = MV_BE `liftM` GVM.basicUnsafeNew n
basicUnsafeReplicate n (BE x) = MV_BE `liftM` GVM.basicUnsafeReplicate n x
basicUnsafeCopy (MV_BE v1) (MV_BE v2) = GVM.basicUnsafeCopy v1 v2
basicUnsafeGrow (MV_BE v) n = MV_BE `liftM` GVM.basicUnsafeGrow v n
#if MIN_VERSION_vector(0,11,0)
basicInitialize (MV_BE v) = GVM.basicInitialize v
#endif
instance Unbox w => GV.Vector Vector (BE w) where
basicUnsafeFreeze (MV_BE v) = V_BE `liftM` GV.basicUnsafeFreeze v
basicUnsafeThaw (V_BE v) = MV_BE `liftM` GV.basicUnsafeThaw v
basicLength (V_BE v) = GV.basicLength v
basicUnsafeSlice i n (V_BE v) = V_BE $ GV.basicUnsafeSlice i n v
basicUnsafeIndexM (V_BE v) i = BE `liftM` GV.basicUnsafeIndexM v i
basicUnsafeCopy (MV_BE mv) (V_BE v) = GV.basicUnsafeCopy mv v
elemseq _ (BE x) = GV.elemseq (undefined :: Vector a) x