diff --git a/Data/Repa/Convert/Format.hs b/Data/Repa/Convert/Format.hs new file mode 100644 --- /dev/null +++ b/Data/Repa/Convert/Format.hs @@ -0,0 +1,68 @@ + +-- | Convert Haskell values to and from a compact binary representation. +-- +-- For testing purposes, use `packToList` which takes a format, a record, and returns a list of bytes. +-- +-- @ +-- > import Data.Repa.Convert.Format +-- +-- > let Just bytes = packToList (FixString ASCII 10 :*: Word16be :*: Float64be) ("foo" :*: 66 :*: 93.42) +-- > bytes +-- [102,111,111,0,0,0,0,0,0,0,0,66,64,87,90,225,71,174,20,123] +-- @ +-- +-- We can then unpack the raw bytes back to Haskell values with `unpackFromList`. +-- +-- @ +-- > unpackFromList (FixString ASCII 10 :*: Word16be :*: Float64be) bytes +-- Just ("foo" :*: (66 :*: 93.42)) +-- @ +-- +-- In production code use `pack` and `unpack` to work directly with a buffer in foreign memory. +-- +module Data.Repa.Convert.Format + ( -- * Data formats + Format (..) + + -- * Packing records + , Packable (..) + , packToList + , unpackFromList + + -- * Constraints + , forFormat + , listFormat + + -- * Products + , (:*:)(..) + + -- * Lists + , FixList(..) + , VarList(..) + + -- * Strings + , FixString (..) + , VarString (..) + , ASCII (..) + + -- * Atomic values + -- ** 8-bit + , Word8be (..), Int8be (..) + + -- ** 16-bit + , Word16be (..), Int16be (..) + + -- ** 32-bit + , Word32be (..), Int32be (..) + , Float32be (..) + + -- ** 64-bit + , Word64be (..), Int64be (..) + , Float64be (..)) + +where +import Data.Repa.Product +import Data.Repa.Convert.Format.Base +import Data.Repa.Convert.Format.Binary + + diff --git a/Data/Repa/Convert/Format/Base.hs b/Data/Repa/Convert/Format/Base.hs new file mode 100644 --- /dev/null +++ b/Data/Repa/Convert/Format/Base.hs @@ -0,0 +1,292 @@ + +module Data.Repa.Convert.Format.Base + ( Format (..) + , Packable (..) + , packToList + , unpackFromList + + -- * Constraints + , forFormat + , listFormat + + -- * Strict products + , (:*:)(..) + + -- * Lists + , FixList(..) + , VarList(..) + + -- * ASCII Strings + , FixString (..) + , VarString (..) + , ASCII (..)) + +where +import Data.Repa.Product +import Data.Word +import Data.Char +import System.IO.Unsafe +import qualified Foreign.Storable as S +import qualified Foreign.Marshal.Alloc as S +import qualified Foreign.Ptr as S + + +--------------------------------------------------------------------------------------------------- +-- | Relates a storage format to the Haskell type of the value +-- that is stored in that format. +class Format f where + + -- | Get the type of a value with this format. + type Value f + + -- | For fixed size storage formats, yield their size (length) in bytes. + -- + -- Yields `Nothing` if this is not a fixed size format. + -- + fixedSize :: f -> Maybe Int + + -- | Yield the size of a value in the given format. + -- + -- Yields `Nothing` when a collection of values is to be packed into a + -- fixed length format, but the size of the collection does not match + -- the format. + -- + packedSize :: f -> Value f -> Maybe Int + + +--------------------------------------------------------------------------------------------------- +-- | Class of storage formats that can have values packed and unpacked +-- from foreign bufferes. +-- +-- The methods are written using continuations to make it easier for +-- GHC to optimise its core code when packing/unpacking many fields. +-- +class Format format + => Packable format where + + -- | Pack a value into a buffer using the given format. + -- + -- If the format contains fixed width fields and the corresponding + -- value has too many elements, then this function returns `False`, + -- otherwise `True`. + -- + pack :: S.Ptr Word8 -- ^ Target Buffer. + -> format -- ^ Storage format. + -> Value format -- ^ Value to pack. + -> (Int -> IO (Maybe a)) -- ^ Continue, given the number of bytes written. + -> IO (Maybe a) + + -- | Unpack a value from a buffer using the given format. + -- + -- This is the inverse of `pack` above. + unpack :: S.Ptr Word8 -- ^ Source buffer. + -> format -- ^ Format of buffer. + -> ((Value format, Int) -> IO (Maybe a)) + -- ^ Continue, given the unpacked value and the + -- number of bytes read. + -> IO (Maybe a) + + +--------------------------------------------------------------------------------------------------- +-- | Pack a value into a list of `Word8`. +packToList + :: Packable format + => format -> Value format -> Maybe [Word8] +packToList f x + | Just size <- packedSize f x + = unsafePerformIO + $ do buf <- S.mallocBytes size + mResult <- pack buf f x (\_ -> return (Just ())) + case mResult of + Nothing -> return Nothing + Just _ -> do + xs <- mapM (S.peekByteOff buf) [0..size - 1] + S.free buf + return $ Just xs + + | otherwise + = Nothing + + +-- | Unpack a value from a list of `Word8`. +unpackFromList + :: Packable format + => format -> [Word8] -> Maybe (Value format) + +unpackFromList f xs + = unsafePerformIO + $ do let len = length xs + buf <- S.mallocBytes len + mapM_ (\(o, x) -> S.pokeByteOff buf o x) + $ zip [0 .. len - 1] xs + unpack buf f $ \(v, _) -> return (Just v) + + +--------------------------------------------------------------------------------------------------- +-- | Constrain the type of a value to match the given format. +-- +-- The value itself is not used. +-- +forFormat :: format -> Value format -> Value format +forFormat _ v = v +{-# INLINE forFormat #-} + + +-- | Constrain the type of some values to match the given format. +-- +-- The value itself is not used. +-- +listFormat :: format -> [Value format] -> [Value format] +listFormat _ v = v +{-# INLINE listFormat #-} + + +--------------------------------------------------------------------------------------------------- +instance (Format a, Format b) + => Format (a :*: b) where + type Value (a :*: b) = Value a :*: Value b + + fixedSize (xa :*: xb) + = do sa <- fixedSize xa + sb <- fixedSize xb + return $ sa + sb + {-# INLINE fixedSize #-} + + packedSize (fa :*: fb) (xa :*: xb) + = do sa <- packedSize fa xa + sb <- packedSize fb xb + return $ sa + sb + {-# INLINE packedSize #-} + + +instance (Packable fa, Packable fb) + => Packable (fa :*: fb) where + + pack buf (fa :*: fb) (xa :*: xb) k + = pack buf fa xa $ \oa + -> pack (S.plusPtr buf oa) fb xb $ \ob + -> k (oa + ob) + {-# INLINE pack #-} + + unpack buf (fa :*: fb) k + = unpack buf fa $ \(xa, oa) + -> unpack (S.plusPtr buf oa) fb $ \(xb, ob) + -> k (xa :*: xb, oa + ob) + {-# INLINE unpack #-} + + +--------------------------------------------------------------------------------------------------- +-- | Fixed length list. +-- +data FixList f = FixList f Int deriving (Eq, Show) +instance Format f => Format (FixList f) where + type Value (FixList f) = [Value f] + + fixedSize (FixList f len) + = do lenElem <- fixedSize f + return $ lenElem * len + + packedSize (FixList _ 0) _ + = return 0 + + packedSize (FixList f len) xs + | length xs == len + = do lenElems <- mapM (packedSize f) xs + return $ sum lenElems + + | otherwise + = Nothing + + +-- | Variable length list. +data VarList f = VarList f deriving (Eq, Show) +instance Format f => Format (VarList f) where + type Value (VarList f) = [Value f] + + fixedSize (VarList _) = Nothing + + packedSize (VarList f) xs@(x : _) + = do lenElem <- packedSize f x + return $ lenElem * length xs + + packedSize _ [] + = return 0 + + +--------------------------------------------------------------------------------------------------- +-- | Fixed length string. +-- +-- * When packing, if the provided string is shorter than the fixed length +-- then the extra bytes are zero-filled. +-- +data FixString t = FixString t Int deriving (Eq, Show) +instance Format (FixString ASCII) where + type Value (FixString ASCII) = String + fixedSize (FixString ASCII len) = Just len + packedSize (FixString ASCII len) _ = Just len + + +instance Packable (FixString ASCII) where + + pack buf (FixString ASCII lenField) xs k + = do let !lenChars = length xs + let !lenPad = lenField - lenChars + + if lenChars > lenField + then return Nothing + else do + mapM_ (\(o, x) -> S.pokeByteOff buf o (w8 $ ord x)) + $ zip [0 .. lenChars - 1] xs + + mapM_ (\o -> S.pokeByteOff buf (lenChars + o) (0 :: Word8)) + $ [0 .. lenPad - 1] + + k lenField + {-# NOINLINE pack #-} + + unpack buf (FixString ASCII lenField) k + = do + let load_unpackChar o + = do x :: Word8 <- S.peekByteOff buf o + return $ chr $ fromIntegral x + {-# INLINE load_unpackChar #-} + + xs <- mapM load_unpackChar [0 .. lenField - 1] + let (pre, _) = break (== '\0') xs + k (pre, lenField) + {-# NOINLINE unpack #-} + + +-- | Variable length string. +data VarString t = VarString t deriving (Eq, Show) +instance Format (VarString ASCII) where + type Value (VarString ASCII) = String + fixedSize (VarString ASCII) = Nothing + packedSize (VarString ASCII) xs = Just $ length xs + + +instance Packable (VarString ASCII) where + + pack buf (VarString ASCII) xs k + = do let !lenChars = length xs + + mapM_ (\(o, x) -> S.pokeByteOff buf o (w8 $ ord x)) + $ zip [0 .. lenChars - 1] xs + + k lenChars + {-# NOINLINE pack #-} + + unpack _ (VarString ASCII) _ + = return Nothing + {-# NOINLINE unpack #-} + + +-- | String is encoded as 8-bit ASCII characters. +data ASCII = ASCII deriving (Eq, Show) + + +--------------------------------------------------------------------------------------------------- +w8 :: Integral a => a -> Word8 +w8 = fromIntegral +{-# INLINE w8 #-} + diff --git a/Data/Repa/Convert/Format/Binary.hs b/Data/Repa/Convert/Format/Binary.hs new file mode 100644 --- /dev/null +++ b/Data/Repa/Convert/Format/Binary.hs @@ -0,0 +1,330 @@ + +-- | Atomic binary formats. +module Data.Repa.Convert.Format.Binary + ( Format (..) + + , Word8be (..), Int8be (..) + , Word16be (..), Int16be (..) + , Word32be (..), Int32be (..) + , Word64be (..), Int64be (..) + + , Float32be (..) + , Float64be (..)) +where +import Data.Repa.Convert.Format.Base +import Data.Bits +import Data.Int as V +import Data.Word as V +import qualified Foreign.Storable as S +import qualified Foreign.Marshal.Alloc as S +import qualified Foreign.Ptr as S +import qualified Control.Monad.Primitive as Prim + + +------------------------------------------------------------------------------------------- Int8be +-- | Big-endian 8-bit signed integer. +data Int8be = Int8be deriving (Eq, Show) +instance Format Int8be where + type Value Int8be = V.Int8 + fixedSize _ = Just 1 + packedSize _ _ = Just 1 + + +i8 :: Integral a => a -> Int8 +i8 = fromIntegral +{-# INLINE i8 #-} + + +------------------------------------------------------------------------------------------- Word8be +-- | Big-endian 8-bit unsigned word. +data Word8be = Word8be deriving (Eq, Show) +instance Format Word8be where + type Value Word8be = V.Word8 + fixedSize _ = Just 1 + packedSize _ _ = Just 1 + + +instance Packable Word8be where + pack buf Word8be x k + = do S.poke buf (fromIntegral x) + k 1 + {-# INLINE pack #-} + + unpack buf Word8be k + = do x <- S.peek buf + k (fromIntegral x, 1) + {-# INLINE unpack #-} + + +instance Packable Int8be where + pack buf Int8be x k = pack buf Word8be (w8 x) k + unpack buf Int8be k = unpack buf Word8be (\(x, o) -> k (i8 x, o)) + {-# INLINE pack #-} + {-# INLINE unpack #-} + + +w8 :: Integral a => a -> Word8 +w8 = fromIntegral +{-# INLINE w8 #-} + + +------------------------------------------------------------------------------------------- Int16be +--- | Big-endian 16-bit signed integer. +data Int16be = Int16be deriving (Eq, Show) +instance Format Int16be where + type Value Int16be = V.Int16 + fixedSize _ = Just 2 + packedSize _ _ = Just 2 + + + +i16 :: Integral a => a -> Int16 +i16 = fromIntegral +{-# INLINE i16 #-} + + +------------------------------------------------------------------------------------------ Word16be +-- | Big-endian 32-bit unsigned word. +data Word16be = Word16be deriving (Eq, Show) +instance Format Word16be where + type Value Word16be = V.Word16 + fixedSize _ = Just 2 + packedSize _ _ = Just 2 + + +instance Packable Word16be where + pack buf Word16be x k + = do S.poke buf (w8 ((w16 x .&. 0x0ff00) `shiftR` 8)) + S.pokeByteOff buf 1 (w8 ((w16 x .&. 0x000ff))) + k 2 + {-# INLINE pack #-} + + unpack buf Word16be k + = do x0 :: Word8 <- S.peek buf + x1 :: Word8 <- S.peekByteOff buf 1 + let !x = w16 ((w16 x0 `shiftL` 8) .|. w16 x1) + k (x, 2) + {-# INLINE unpack #-} + + +instance Packable Int16be where + pack buf Int16be x k = pack buf Word16be (w16 x) k + unpack buf Int16be k = unpack buf Word16be (\(x, o) -> k (i16 x, o)) + {-# INLINE pack #-} + {-# INLINE unpack #-} + + +w16 :: Integral a => a -> Word16 +w16 = fromIntegral +{-# INLINE w16 #-} + + +------------------------------------------------------------------------------------------- Int32be +-- | Big-endian 32-bit signed integer. +data Int32be = Int32be deriving (Eq, Show) +instance Format Int32be where + type Value Int32be = V.Int32 + fixedSize _ = Just 4 + packedSize _ _ = Just 4 + + +instance Packable Int32be where + pack buf Int32be x k = pack buf Word32be (w32 x) k + unpack buf Int32be k = unpack buf Word32be (\(x, o) -> k (i32 x, o)) + {-# INLINE pack #-} + {-# INLINE unpack #-} + + +i32 :: Integral a => a -> Int32 +i32 = fromIntegral +{-# INLINE i32 #-} + + +------------------------------------------------------------------------------------------ Word32be +-- | Big-endian 32-bit unsigned word. +data Word32be = Word32be deriving (Eq, Show) +instance Format Word32be where + type Value Word32be = V.Word32 + fixedSize _ = Just 4 + packedSize _ _ = Just 4 + + +instance Packable Word32be where + pack buf Word32be x k + = do S.poke buf (w8 ((w32 x .&. 0x0ff000000) `shiftR` 24)) + S.pokeByteOff buf 1 (w8 ((w32 x .&. 0x000ff0000) `shiftR` 16)) + S.pokeByteOff buf 2 (w8 ((w32 x .&. 0x00000ff00) `shiftR` 8)) + S.pokeByteOff buf 3 (w8 ((w32 x .&. 0x0000000ff))) + k 4 + {-# INLINE pack #-} + + unpack buf Word32be k + = do x0 :: Word8 <- S.peek buf + x1 :: Word8 <- S.peekByteOff buf 1 + x2 :: Word8 <- S.peekByteOff buf 2 + x3 :: Word8 <- S.peekByteOff buf 3 + let !x = w32 ( (w32 x0 `shiftL` 24) + .|. (w32 x1 `shiftL` 16) + .|. (w32 x2 `shiftL` 8) + .|. (w32 x3)) + k (x, 4) + {-# INLINE unpack #-} + + +w32 :: Integral a => a -> Word32 +w32 = fromIntegral +{-# INLINE w32 #-} + +------------------------------------------------------------------------------------------- Int64be +-- | Big-endian 64-bit signed integer. +data Int64be = Int64be deriving (Eq, Show) +instance Format Int64be where + type Value Int64be = V.Int64 + fixedSize _ = Just 8 + packedSize _ _ = Just 8 + + +instance Packable Int64be where + pack buf Int64be x k = pack buf Word64be (w64 x) k + unpack buf Int64be k = unpack buf Word64be (\(x, o) -> k (i64 x, o)) + {-# INLINE pack #-} + {-# INLINE unpack #-} + + +i64 :: Integral a => a -> Int64 +i64 = fromIntegral +{-# INLINE i64 #-} + + +------------------------------------------------------------------------------------------ Word64be +-- | Big-endian 64-bit unsigned word. +data Word64be = Word64be deriving (Eq, Show) +instance Format Word64be where + type Value Word64be = V.Word64 + fixedSize _ = Just 8 + packedSize _ _ = Just 8 + + +instance Packable Word64be where + pack buf Word64be x k + = do S.poke buf (w8 ((w64 x .&. 0x0ff00000000000000) `shiftR` 56)) + S.pokeByteOff buf 1 (w8 ((w64 x .&. 0x000ff000000000000) `shiftR` 48)) + S.pokeByteOff buf 2 (w8 ((w64 x .&. 0x00000ff0000000000) `shiftR` 40)) + S.pokeByteOff buf 3 (w8 ((w64 x .&. 0x0000000ff00000000) `shiftR` 32)) + S.pokeByteOff buf 4 (w8 ((w64 x .&. 0x000000000ff000000) `shiftR` 24)) + S.pokeByteOff buf 5 (w8 ((w64 x .&. 0x00000000000ff0000) `shiftR` 16)) + S.pokeByteOff buf 6 (w8 ((w64 x .&. 0x0000000000000ff00) `shiftR` 8)) + S.pokeByteOff buf 7 (w8 ((w64 x .&. 0x000000000000000ff) )) + k 8 + {-# INLINE pack #-} + + unpack buf Word64be k + = do x0 :: Word8 <- S.peek buf + x1 :: Word8 <- S.peekByteOff buf 1 + x2 :: Word8 <- S.peekByteOff buf 2 + x3 :: Word8 <- S.peekByteOff buf 3 + x4 :: Word8 <- S.peekByteOff buf 4 + x5 :: Word8 <- S.peekByteOff buf 5 + x6 :: Word8 <- S.peekByteOff buf 6 + x7 :: Word8 <- S.peekByteOff buf 7 + let !x = w64 ( (w64 x0 `shiftL` 56) + .|. (w64 x1 `shiftL` 48) + .|. (w64 x2 `shiftL` 40) + .|. (w64 x3 `shiftL` 32) + .|. (w64 x4 `shiftL` 24) + .|. (w64 x5 `shiftL` 16) + .|. (w64 x6 `shiftL` 8) + .|. (w64 x7 )) + k (x, 8) + {-# INLINE unpack #-} + + +w64 :: Integral a => a -> Word64 +w64 = fromIntegral +{-# INLINE w64 #-} + + +----------------------------------------------------------------------------------------- Float32be +-- | Big-endian 32-bit IEEE 754 float. +data Float32be = Float32be deriving (Eq, Show) +instance Format Float32be where + type Value Float32be = Float + fixedSize _ = Just 4 + packedSize _ _ = Just 4 + + +instance Packable Float32be where + pack buf Float32be x k + = pack buf Word32be (floatToWord32 x) k + {-# INLINE pack #-} + + unpack buf Float32be k + = unpack buf Word32be (\(v, i) -> k (word32ToFloat v, i)) + {-# INLINE unpack #-} + + +-- | Bitwise cast of `Float` to `Word32`. +-- +-- The resulting `Word32` contains the representation of the `Float`, +-- rather than it's value. +floatToWord32 :: Float -> Word32 +floatToWord32 d + = Prim.unsafeInlineIO + $ S.alloca $ \buf -> + do S.poke (S.castPtr buf) d + S.peek buf +{-# INLINE floatToWord32 #-} + + +-- | Inverse of `doubleToFloat32` +word32ToFloat :: Word32 -> Float +word32ToFloat w + = Prim.unsafeInlineIO + $ S.alloca $ \buf -> + do S.poke (S.castPtr buf) w + S.peek buf +{-# INLINE word32ToFloat #-} + + +----------------------------------------------------------------------------------------- Float64be +-- | Big-endian 64-bit IEEE 754 float. +data Float64be = Float64be deriving (Eq, Show) +instance Format Float64be where + type Value Float64be = Double + fixedSize _ = Just 8 + packedSize _ _ = Just 8 + + +instance Packable Float64be where + pack buf Float64be x k + = pack buf Word64be (doubleToWord64 x) k + {-# INLINE pack #-} + + unpack buf Float64be k + = unpack buf Word64be (\(v, i) -> k (word64ToDouble v, i)) + {-# INLINE unpack #-} + + +-- | Bitwise cast of `Double` to `Word64`. +-- +-- The resulting `Word64` contains the representation of the `Double`, +-- rather than it's value. +doubleToWord64 :: Double -> Word64 +doubleToWord64 d + = Prim.unsafeInlineIO + $ S.alloca $ \buf -> + do S.poke (S.castPtr buf) d + S.peek buf +{-# INLINE doubleToWord64 #-} + + +-- | Inverse of `doubleToWord64` +word64ToDouble :: Word64 -> Double +word64ToDouble w + = Prim.unsafeInlineIO + $ S.alloca $ \buf -> + do S.poke (S.castPtr buf) w + S.peek buf +{-# INLINE word64ToDouble #-} + + diff --git a/Data/Repa/Product.hs b/Data/Repa/Product.hs new file mode 100644 --- /dev/null +++ b/Data/Repa/Product.hs @@ -0,0 +1,141 @@ + +module Data.Repa.Product + ((:*:)(..)) +where +import qualified Data.Vector.Unboxed as U +import qualified Data.Vector.Generic as G +import qualified Data.Vector.Generic.Mutable as M + +-- | Strict product type, written infix. +data a :*: b + = !a :*: !b + deriving (Eq, Show) + +infixr :*: + +-- Unboxed ---------------------------------------------------------------------------------------- +-- Unboxed instance adapted from: +-- http://code.haskell.org/vector/internal/unbox-tuple-instances +-- +data instance U.Vector (a :*: b) + = V_Prod + {-# UNPACK #-} !Int + !(U.Vector a) + !(U.Vector b) + + +instance (U.Unbox a, U.Unbox b) + => U.Unbox (a :*: b) + + +data instance U.MVector s (a :*: b) + = MV_Prod {-# UNPACK #-} !Int + !(U.MVector s a) + !(U.MVector s b) + + +instance (U.Unbox a, U.Unbox b) + => M.MVector U.MVector (a :*: b) where + + basicLength (MV_Prod n_ _as _bs) = n_ + {-# INLINE basicLength #-} + + basicUnsafeSlice i_ m_ (MV_Prod _n_ as bs) + = MV_Prod m_ (M.basicUnsafeSlice i_ m_ as) + (M.basicUnsafeSlice i_ m_ bs) + {-# INLINE basicUnsafeSlice #-} + + basicOverlaps (MV_Prod _n_1 as1 bs1) (MV_Prod _n_2 as2 bs2) + = M.basicOverlaps as1 as2 + || M.basicOverlaps bs1 bs2 + {-# INLINE basicOverlaps #-} + + basicUnsafeNew n_ + = do as <- M.basicUnsafeNew n_ + bs <- M.basicUnsafeNew n_ + return $ MV_Prod n_ as bs + {-# INLINE basicUnsafeNew #-} + + basicUnsafeReplicate n_ (a :*: b) + = do as <- M.basicUnsafeReplicate n_ a + bs <- M.basicUnsafeReplicate n_ b + return $ MV_Prod n_ as bs + {-# INLINE basicUnsafeReplicate #-} + + basicUnsafeRead (MV_Prod _n_ as bs) i_ + = do a <- M.basicUnsafeRead as i_ + b <- M.basicUnsafeRead bs i_ + return (a :*: b) + {-# INLINE basicUnsafeRead #-} + + basicUnsafeWrite (MV_Prod _n_ as bs) i_ (a :*: b) + = do M.basicUnsafeWrite as i_ a + M.basicUnsafeWrite bs i_ b + {-# INLINE basicUnsafeWrite #-} + + basicClear (MV_Prod _n_ as bs) + = do M.basicClear as + M.basicClear bs + {-# INLINE basicClear #-} + + basicSet (MV_Prod _n_ as bs) (a :*: b) + = do M.basicSet as a + M.basicSet bs b + {-# INLINE basicSet #-} + + basicUnsafeCopy (MV_Prod _n_1 as1 bs1) (MV_Prod _n_2 as2 bs2) + = do M.basicUnsafeCopy as1 as2 + M.basicUnsafeCopy bs1 bs2 + {-# INLINE basicUnsafeCopy #-} + + basicUnsafeMove (MV_Prod _n_1 as1 bs1) (MV_Prod _n_2 as2 bs2) + = do M.basicUnsafeMove as1 as2 + M.basicUnsafeMove bs1 bs2 + {-# INLINE basicUnsafeMove #-} + + basicUnsafeGrow (MV_Prod n_ as bs) m_ + = do as' <- M.basicUnsafeGrow as m_ + bs' <- M.basicUnsafeGrow bs m_ + return $ MV_Prod (m_ + n_) as' bs' + {-# INLINE basicUnsafeGrow #-} + + +instance (U.Unbox a, U.Unbox b) + => G.Vector U.Vector (a :*: b) where + basicUnsafeFreeze (MV_Prod n_ as bs) + = do as' <- G.basicUnsafeFreeze as + bs' <- G.basicUnsafeFreeze bs + return $ V_Prod n_ as' bs' + {-# INLINE basicUnsafeFreeze #-} + + basicUnsafeThaw (V_Prod n_ as bs) + = do as' <- G.basicUnsafeThaw as + bs' <- G.basicUnsafeThaw bs + return $ MV_Prod n_ as' bs' + {-# INLINE basicUnsafeThaw #-} + + basicLength (V_Prod n_ _as _bs) + = n_ + {-# INLINE basicLength #-} + + basicUnsafeSlice i_ m_ (V_Prod _n_ as bs) + = V_Prod m_ (G.basicUnsafeSlice i_ m_ as) + (G.basicUnsafeSlice i_ m_ bs) + {-# INLINE basicUnsafeSlice #-} + + basicUnsafeIndexM (V_Prod _n_ as bs) i_ + = do a <- G.basicUnsafeIndexM as i_ + b <- G.basicUnsafeIndexM bs i_ + return (a :*: b) + {-# INLINE basicUnsafeIndexM #-} + + basicUnsafeCopy (MV_Prod _n_1 as1 bs1) (V_Prod _n_2 as2 bs2) + = do G.basicUnsafeCopy as1 as2 + G.basicUnsafeCopy bs1 bs2 + {-# INLINE basicUnsafeCopy #-} + + elemseq _ (a :*: b) + = G.elemseq (undefined :: U.Vector a) a + . G.elemseq (undefined :: U.Vector b) b + {-# INLINE elemseq #-} + diff --git a/LICENSE b/LICENSE new file mode 100644 --- /dev/null +++ b/LICENSE @@ -0,0 +1,25 @@ +Copyright (c) 2014-2015, The Repa Development Team + +Redistribution and use in source and binary forms, with or without +modification, are permitted provided that the following conditions are met: + +- Redistributions of source code must retain the above copyright notice, + this list of conditions and the following disclaimer. + +- Redistributions in binary form must reproduce the above copyright notice, + this list of conditions and the following disclaimer in the documentation + and/or other materials provided with the distribution. + +- The names of the copyright holders may not be used to endorse or promote + products derived from this software without specific prior written permission. + +THIS SOFTWARE IS PROVIDED "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, +INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND +FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE +COPYRIGHT HOLDERS OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, +INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT +LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, +OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF +LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE +OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF +ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. diff --git a/Setup.hs b/Setup.hs new file mode 100644 --- /dev/null +++ b/Setup.hs @@ -0,0 +1,2 @@ +import Distribution.Simple +main = defaultMain diff --git a/repa-convert.cabal b/repa-convert.cabal new file mode 100644 --- /dev/null +++ b/repa-convert.cabal @@ -0,0 +1,52 @@ +Name: repa-convert +Version: 4.0.1.0 +License: BSD3 +License-file: LICENSE +Author: The Repa Development Team +Maintainer: Ben Lippmeier +Build-Type: Simple +Cabal-Version: >=1.6 +Stability: experimental +Category: Data Structures +Homepage: http://repa.ouroborus.net +Bug-reports: repa@ouroborus.net +Description: Packing and unpacking binary data. +Synopsis: Packing and unpacking binary data. + +source-repository head + type: git + location: https://github.com/DDCSF/repa.git + +Library + build-Depends: + base == 4.7.*, + primitive == 0.5.4.*, + vector == 0.10.* + + exposed-modules: + Data.Repa.Product + Data.Repa.Convert.Format + + other-modules: + Data.Repa.Convert.Format.Base + Data.Repa.Convert.Format.Binary + + ghc-options: + -Wall -fno-warn-missing-signatures + -O2 + + extensions: + CPP + NoMonomorphismRestriction + ExistentialQuantification + BangPatterns + FlexibleContexts + FlexibleInstances + PatternGuards + MultiWayIf + TypeFamilies + TypeOperators + ScopedTypeVariables + MultiParamTypeClasses + +