repa-scalar (empty) → 4.2.0.1
raw patch · 9 files changed
+938/−0 lines, 9 filesdep +basedep +bytestringdep +double-conversionsetup-changed
Dependencies added: base, bytestring, double-conversion, primitive, vector
Files
- Data/Repa/Scalar/Date32.hs +260/−0
- Data/Repa/Scalar/Double.hs +79/−0
- Data/Repa/Scalar/Int.hs +127/−0
- Data/Repa/Scalar/Product.hs +266/−0
- Data/Repa/Scalar/Singleton/Bool.hs +18/−0
- Data/Repa/Scalar/Singleton/Nat.hs +106/−0
- LICENSE +25/−0
- Setup.hs +2/−0
- repa-scalar.cabal +55/−0
+ Data/Repa/Scalar/Date32.hs view
@@ -0,0 +1,260 @@++module Data.Repa.Scalar.Date32+ ( Date32++ -- * Projections+ , year, month, day++ -- * Packing and Unpacking+ , pack+ , unpack++ -- * Operators+ , next++ -- * Loading+ , loadYYYYsMMsDD+ , loadDDsMMsYYYY)+where+import Data.Word+import Data.Bits+import GHC.Exts+import GHC.Word+import Foreign.Storable+import Foreign.Ptr+import Control.Monad+import Data.Repa.Scalar.Int+import qualified Foreign.Ptr as F+import qualified Foreign.Storable as F+import Prelude as P+++-- | A date packed into a 32-bit word.+--+-- The bitwise format is:+--+-- @+-- 32 16 8 0 +-- | year | month | day |+-- @+--+-- Pros: Packing and unpacking a Date32 is simpler than using other formats+-- that represent dates as a number of days from some epoch. We can also+-- avoid worrying about what the epoch should be, and the representation+-- will not overflow until year 65536. +--+-- Cons: Computing a range of dates is slower than with representations+-- using an epoch, as we cannot simply add one to get to the next valid date.+--+newtype Date32 + = Date32 Word32+ deriving (Eq, Ord, Show)+++instance Storable Date32 where+ sizeOf (Date32 w) = sizeOf w+ alignment (Date32 w) = alignment w+ peek ptr = liftM Date32 (peek (castPtr ptr))+ poke ptr (Date32 w) = poke (castPtr ptr) w+ {-# INLINE sizeOf #-}+ {-# INLINE alignment #-}+ {-# INLINE peek #-}+ {-# INLINE poke #-}+++---------------------------------------------------------------------------------------------------+-- | Pack a year, month and day into a `Word32`. +--+-- If any components of the date are out-of-range then they will be bit-wise+-- truncated so they fit in their destination fields.+--+pack :: (Int, Int, Int) -> Date32+pack (yy, mm, dd) + = Date32+ $ ((fromIntegral yy .&. 0x0ffff) `shiftL` 16) + .|. ((fromIntegral mm .&. 0x0ff) `shiftL` 8)+ .|. (fromIntegral dd .&. 0x0ff)+{-# INLINE pack #-}+++-- | Inverse of `pack`.+--+-- This function does a simple bit-wise unpacking of the given `Word32`, +-- and does not guarantee that the returned fields are within a valid +-- range for the given calendar date.+--+unpack :: Date32 -> (Int, Int, Int)+unpack (Date32 date)+ = ( fromIntegral $ (date `shiftR` 16) .&. 0x0ffff+ , fromIntegral $ (date `shiftR` 8) .&. 0x0ff+ , fromIntegral $ date .&. 0x0ff)+{-# INLINE unpack #-}+++-- | Take the year number of a `Date32`.+year :: Date32 -> Int+year date+ = case unpack date of+ (yy, _, _) -> yy+++-- | Take the month number of a `Date32`.+month :: Date32 -> Int+month date+ = case unpack date of+ (_, mm, _) -> mm+++-- | Take the day number of a `Date32`.+day :: Date32 -> Int+day date+ = case unpack date of+ (_, _, dd) -> dd+++---------------------------------------------------------------------------------------------------+-- | Yield the next date in the series.+--+-- This assumes leap years occur every four years, +-- which is valid after year 1900 and before year 2100.+--+next :: Date32 -> Date32+next (Date32 (W32# date))+ = Date32 (W32# (next' date))+{-# INLINE next #-}++next' :: Word# -> Word#+next' !date+ | (yy, mm, dd) <- unpack (Date32 (W32# date))+ , (yy', mm', dd') + <- case mm of+ 1 -> if dd >= 31 then (yy, 2, 1) else (yy, mm, dd + 1) -- Jan++ 2 -> if yy `mod` 4 == 0 -- Feb+ then if dd >= 29+ then (yy, 3, 1) + else (yy, mm, dd + 1)+ else if dd >= 28+ then (yy, 3, 1)+ else (yy, mm, dd + 1)++ 3 -> if dd >= 31 then (yy, 4, 1) else (yy, mm, dd + 1) -- Mar+ 4 -> if dd >= 30 then (yy, 5, 1) else (yy, mm, dd + 1) -- Apr+ 5 -> if dd >= 31 then (yy, 6, 1) else (yy, mm, dd + 1) -- May+ 6 -> if dd >= 30 then (yy, 7, 1) else (yy, mm, dd + 1) -- Jun+ 7 -> if dd >= 31 then (yy, 8, 1) else (yy, mm, dd + 1) -- Jul+ 8 -> if dd >= 31 then (yy, 9, 1) else (yy, mm, dd + 1) -- Aug+ 9 -> if dd >= 30 then (yy, 10, 1) else (yy, mm, dd + 1) -- Sep+ 10 -> if dd >= 31 then (yy, 11, 1) else (yy, mm, dd + 1) -- Oct+ 11 -> if dd >= 30 then (yy, 12, 1) else (yy, mm, dd + 1) -- Nov+ 12 -> if dd >= 31 then (yy + 1, 1, 1) else (yy, mm, dd + 1) -- Dec+ _ -> (0, 0, 0)+ = case pack (yy', mm', dd') of+ Date32 (W32# w) -> w+{-# NOINLINE next' #-}+++---------------------------------------------------------------------------------------------------+-- | Read a date in YYYYsMMsDD format from the given buffer.+loadYYYYsMMsDD + :: Word8 -- ^ Separating character.+ -> Ptr Word8 -- ^ Buffer.+ -> Int -- ^ Length of buffer.+ -> IO (Maybe (Date32, Int)) -- ^ Result.++loadYYYYsMMsDD !sep !buf (I# len_)+ = loadYear+ where loadYear + | (# 1#, yy, ix' #) <- loadInt# buf len_+ = sep1 ix' yy+ | otherwise = return Nothing++ sep1 ix yy+ | 1# <- ix <# len_ + = F.peekByteOff buf (I# ix) >>= \(r :: Word8)+ -> if r == sep+ then loadMonth (ix +# 1#) yy + else return Nothing++ | otherwise = return Nothing++ loadMonth ix yy+ | 1# <- ix <# len_ + , (# 1#, mm, o #) <- loadInt# (buf `F.plusPtr` (I# ix)) len_+ = sep2 (ix +# o) yy mm+ | otherwise = return Nothing++ sep2 ix yy mm+ | 1# <- ix <# len_+ = F.peekByteOff buf (I# ix) >>= \(r :: Word8)+ -> if r == sep+ then loadDay (ix +# 1#) yy mm + else return Nothing++ | otherwise = return Nothing++ loadDay ix yy mm+ | 1# <- ix <# len_+ , (# 1#, dd, o #) <- loadInt# (buf `F.plusPtr` (I# ix)) len_+ = return + $ Just (pack ( fromIntegral (I# yy)+ , fromIntegral (I# mm)+ , fromIntegral (I# dd))+ , I# (ix +# o))++ | otherwise = return Nothing+{-# INLINE loadYYYYsMMsDD #-}+++---------------------------------------------------------------------------------------------------+-- | Read a date in YYYYsMMsDD format from the given buffer.+loadDDsMMsYYYY+ :: Word8 -- ^ Separating character.+ -> Ptr Word8 -- ^ Buffer.+ -> Int -- ^ Length of buffer.+ -> IO (Maybe (Date32, Int)) -- ^ Result.++loadDDsMMsYYYY !sep !buf (I# len_)+ = loadDay+ where loadDay + | (# 1#, dd, ix' #) <- loadInt# buf len_+ = sep1 ix' dd+ | otherwise = return Nothing++ sep1 ix dd+ | 1# <- ix <# len_ + = F.peekByteOff buf (I# ix) >>= \(r :: Word8)+ -> if r == sep+ then loadMonth (ix +# 1#) dd+ else return Nothing++ | otherwise = return Nothing++ loadMonth ix dd+ | 1# <- ix <# len_ + , (# 1#, mm, o #) <- loadInt# (buf `F.plusPtr` (I# ix)) len_+ = sep2 (ix +# o) dd mm+ | otherwise = return Nothing++ sep2 ix dd mm+ | 1# <- ix <# len_+ = F.peekByteOff buf (I# ix) >>= \(r :: Word8)+ -> if r == sep+ then loadYear (ix +# 1#) dd mm+ else return Nothing++ | otherwise = return Nothing++ loadYear ix dd mm + | 1# <- ix <# len_+ , (# 1#, yy, o #) <- loadInt# (buf `F.plusPtr` (I# ix)) len_+ = return + $ Just (pack ( fromIntegral (I# yy)+ , fromIntegral (I# mm)+ , fromIntegral (I# dd))+ , I# (ix +# o))++ | otherwise = return Nothing+{-# INLINE loadDDsMMsYYYY #-}++
+ Data/Repa/Scalar/Double.hs view
@@ -0,0 +1,79 @@++-- | Loading and storing doubles directly from/to memory buffers.+module Data.Repa.Scalar.Double+ ( -- * Loading+ loadDouble++ -- * Storing+ , storeDoubleShortest+ , storeDoubleFixed)+where+import Data.Word+import GHC.Exts+import qualified Data.ByteString.Internal as BS+import qualified Data.Double.Conversion.ByteString as DC+import qualified Foreign.Ptr as F+import qualified Foreign.ForeignPtr as F+import qualified Foreign.Storable as F+import qualified Foreign.Marshal.Alloc as F+import qualified Foreign.Marshal.Utils as F+++-- Double -----------------------------------------------------------------------------------------+-- | Load an ASCII `Double` from a foreign buffer+-- returning the value and number of characters read.+loadDouble + :: Ptr Word8 -- ^ Buffer holding ASCII representation.+ -> Int -- ^ Length of buffer.+ -> IO (Double, Int) -- ^ Result, and number of characters read from buffer.++loadDouble !pIn !len+ = F.allocaBytes (len + 1) $ \pBuf ->+ F.alloca $ \pRes ->+ do+ -- Copy the data to our new buffer.+ F.copyBytes pBuf pIn (fromIntegral len)++ -- Poke a 0 on the end to ensure it's null terminated.+ F.pokeByteOff pBuf len (0 :: Word8)++ -- Call the C strtod function+ let !d = strtod pBuf pRes++ -- Read back the end pointer.+ res <- F.peek pRes++ return (d, res `F.minusPtr` pBuf)+{-# INLINE loadDouble #-}+++-- TODO: strtod will skip whitespace before the actual double, +-- but we probably want to avoid this to be consistent.+foreign import ccall unsafe+ strtod :: Ptr Word8 -> Ptr (Ptr Word8) -> Double++++-- | Store an ASCII `Double`, yielding a freshly allocated buffer+-- and its length.+--+-- * The value is printed as either (sign)digits.digits,+-- or in exponential format, depending on which is shorter.+--+-- * The result is buffer not null terminated.+--+storeDoubleShortest :: Double -> IO (F.ForeignPtr Word8, Int)+storeDoubleShortest d+ = case DC.toShortest d of+ BS.PS p _ n -> return (p, n)+{-# INLINE storeDoubleShortest #-}+++-- | Like `showDoubleShortest`, but use a fixed number of digits after+-- the decimal point.+storeDoubleFixed :: Int -> Double -> IO (F.ForeignPtr Word8, Int)+storeDoubleFixed !prec !d+ = case DC.toFixed prec d of+ BS.PS p _ n -> return (p, n)+{-# INLINE storeDoubleFixed #-}+
+ Data/Repa/Scalar/Int.hs view
@@ -0,0 +1,127 @@++-- | Loading and storing integers directly from/to memory buffers.+module Data.Repa.Scalar.Int+ ( -- * Loading+ loadInt+ , loadInt#+ , loadIntWith#++ -- * Storing+ , storeInt)+where+import Data.Word+import Data.Char+import GHC.Exts+import qualified Data.ByteString.Internal as BS+import qualified Data.Double.Conversion.ByteString as DC+import qualified Foreign.ForeignPtr as F+import qualified Foreign.Storable as F+++-- Int --------------------------------------------------------------------------------------------+-- | Load an ASCII `Int` from a foreign buffer,+-- returning the value and number of characters read.+loadInt :: Ptr Word8 -- ^ Buffer holding digits.+ -> Int -- ^ Length of buffer.+ -> IO (Maybe (Int, Int)) -- ^ Int read, and length of digits.+ +loadInt !ptr (I# len)+ = case loadInt# ptr len of+ (# 0#, _, _ #) -> return $ Nothing+ (# _, n, ix #) -> return $ Just (I# n, I# ix)+{-# INLINE loadInt #-}+++-- | Like `loadInt`, but via unboxed types.+loadInt#+ :: Ptr Word8 -- ^ Buffer holding digits.+ -> Int# -- ^ Length of buffer.+ -> (# Int#, Int#, Int# #) -- ^ Convert success?, value, length read.++loadInt# buf len+ = let peek8 ix+ -- accursed .. may increase sharing of the result value, + -- but this isn't a problem here because the result is not+ -- mutable, and will be unboxed by the simplifier anyway.+ = case BS.accursedUnutterablePerformIO (F.peekByteOff buf (I# ix)) of+ (w8 :: Word8) -> case fromIntegral w8 of+ I# i -> i+ {-# INLINE peek8 #-}++ in loadIntWith# peek8 len+{-# NOINLINE loadInt# #-}+++-- | Like `loadInt#`, but use the given function to get characters+-- from the input buffer.+loadIntWith# + :: (Int# -> Int#) -- ^ Function to get a byte from the source.+ -> Int# -- ^ Length of buffer+ -> (# Int#, Int#, Int# #) -- ^ Convert success?, value, length read.++loadIntWith# !get len+ = start 0#+ where+ start !ix+ | 1# <- ix >=# len = (# 0#, 0#, 0# #)+ | otherwise = sign ix+ {-# INLINE start #-}++ -- Check for explicit sign character,+ -- and encode what it was as an integer.+ sign !ix+ | !s <- get 0#+ = case chr $ fromIntegral (I# s) of+ '-' -> loop 1# (ix +# 1#) 0#+ '+' -> loop 2# (ix +# 1#) 0#+ _ -> loop 0# ix 0#+ {-# INLINE sign #-}++ loop !neg !ix !n + -- We've hit the end of the array.+ | 1# <- ix >=# len + = end neg ix n++ | otherwise+ = case get ix of+ -- Current character is a digit, so add it to the accmulator.+ w | 1# <- w >=# 0x30# + , 1# <- w <=# 0x039#+ -> loop neg ( ix +# 1#) + ((n *# 10#) +# (w -# 0x30#))++ -- Current character is not a digit.+ | otherwise+ -> end neg ix n++ end !neg !ix !n+ -- We didn't find any digits, and there was no explicit sign.+ | 1# <- ix ==# 0#+ , 1# <- neg ==# 0#+ = (# 0#, 0#, 0# #)++ -- We didn't find any digits, but there was an explicit sign.+ | 1# <- ix ==# 1#+ , 1# <- neg /=# 0#+ = (# 0#, 0#, 0# #)++ -- Number was explicitly negated.+ | 1# <- neg ==# 1# + , I# n' <- negate (I# n)+ = (# 1#, n', ix #)++ -- Number was not negated.+ | otherwise+ = (# 1#, n, ix #)+ {-# NOINLINE end #-}+{-# INLINE loadIntWith# #-}+++-- | Store an ASCII `Int`, allocating a new buffer.+storeInt :: Int -> IO (F.ForeignPtr Word8)+storeInt i+ = case DC.toFixed 0 (fromIntegral i) of+ BS.PS p _ _ -> return p+{-# INLINE storeInt #-}++
+ Data/Repa/Scalar/Product.hs view
@@ -0,0 +1,266 @@+{-# OPTIONS_GHC -fno-warn-unticked-promoted-constructors #-}+module Data.Repa.Scalar.Product+ ( -- * Product type+ (:*:) (..)+ , IsProdList (..)++ -- * Selecting+ , Select (..)++ -- * Discarding+ , Discard (..), Keep(..), Drop(..)++ -- * Masking+ , Mask (..))+where+import Data.Repa.Scalar.Singleton.Nat+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 :*:+++class IsProdList p where+ -- | Check if a sequence of products forms a valid list, + -- using () for the nil value.+ --+ -- @+ -- isProdList (1 :*: 4 :*: 5) ... no instance+ --+ -- isProdList (1 :*: 4 :*: ()) = True+ -- @+ --+ isProdList :: p -> Bool++instance IsProdList () where+ isProdList _ = True+ {-# INLINE isProdList #-}+++instance IsProdList fs => IsProdList (f :*: fs) where+ isProdList (_ :*: xs) = isProdList xs+ {-# INLINE isProdList #-}+++---------------------------------------------------------------------------------------------------+class IsProdList t+ => Select (n :: N) t where+ type Select' n t+ -- | Return just the given field in this tuple.+ select :: Nat n -> t -> Select' n t+++instance IsProdList ts+ => Select Z (t1 :*: ts) where+ type Select' Z (t1 :*: ts) = t1+ select Zero (t1 :*: _) = t1+ {-# INLINE select #-}+++instance Select n ts+ => Select (S n) (t1 :*: ts) where+ type Select' (S n) (t1 :*: ts) = Select' n ts+ select (Succ n) (_ :*: xs) = select n xs+ {-# INLINE select #-}+++---------------------------------------------------------------------------------------------------+class IsProdList t + => Discard (n :: N) t where+ type Discard' n t+ -- | Discard the given field in this tuple.+ discard :: Nat n -> t -> Discard' n t+++instance IsProdList ts + => Discard Z (t1 :*: ts) where+ type Discard' Z (t1 :*: ts) = ts+ discard Zero (_ :*: xs) = xs+ {-# INLINE discard #-}+++instance Discard n ts + => Discard (S n) (t1 :*: ts) where+ type Discard' (S n) (t1 :*: ts) = t1 :*: Discard' n ts+ discard (Succ n) (x1 :*: xs) = x1 :*: discard n xs+ {-# INLINE discard #-}+++---------------------------------------------------------------------------------------------------+-- | Singleton to indicate a field that should be dropped.+data Drop = Drop++-- | Singleton to indicate a field that should be kept.+data Keep = Keep+++-- | Class of data types that can have parts masked out.+class (IsProdList m, IsProdList t) => Mask m t where+ type Mask' m t+ -- | Mask out some component of a type.+ --+ -- @ + -- mask (Keep :*: Drop :*: Keep :*: ()) + -- (1 :*: \"foo\" :*: \'a\' :*: ()) = (1 :*: \'a\' :*: ())+ --+ -- mask (Drop :*: Drop :*: Drop :*: ()) + -- (1 :*: \"foo\" :*: \'a\' :*: ()) = ()+ -- @+ --+ mask :: m -> t -> Mask' m t+++instance Mask () () where+ type Mask' () () = ()+ mask () () = ()+ {-# INLINE mask #-}+++instance Mask ms ts + => Mask (Keep :*: ms) (t1 :*: ts) where+ type Mask' (Keep :*: ms) (t1 :*: ts) = t1 :*: Mask' ms ts+ mask (_ :*: ms) (x1 :*: xs) = x1 :*: mask ms xs+ {-# INLINE mask #-}+++instance Mask ms ts+ => Mask (Drop :*: ms) (t1 :*: ts) where+ type Mask' (Drop :*: ms) (t1 :*: ts) = Mask' ms ts+ mask (_ :*: ms) (_ :*: xs) = mask ms xs+ {-# INLINE mask #-}+++-- 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 #-}+
+ Data/Repa/Scalar/Singleton/Bool.hs view
@@ -0,0 +1,18 @@+{-# OPTIONS_GHC -fno-warn-unticked-promoted-constructors #-}+module Data.Repa.Scalar.Singleton.Bool+ ( B (..)+ , Boolean (..))+where++data B = Y | N++deriving instance Show B+++data Boolean (b :: B) where+ Yes :: Boolean Y+ No :: Boolean N++deriving instance Show (Boolean b)++
+ Data/Repa/Scalar/Singleton/Nat.hs view
@@ -0,0 +1,106 @@+{-# OPTIONS_GHC -fno-warn-unticked-promoted-constructors #-}+{-# LANGUAGE UndecidableInstances #-}+-- | Singleton-typed natural numbers and arithmetic.+-- +-- Used for indexing into hetrogenous list types.+--+module Data.Repa.Scalar.Singleton.Nat+ ( N (..)+ , Nat (..)+ , Add (..)+ , Mul (..)++ -- * Literals+ , nat0, nat1, nat2, nat3, nat4, nat5, nat6, nat7, nat8, nat9)+where+++-- | Peano natural numbers.+data N = Z | S N+++deriving instance Show N+++-- | Peano natural number singletons.+data Nat (n :: N) where+ Zero :: Nat Z+ Succ :: Nat n -> Nat (S n)++deriving instance Show (Nat n)+++---------------------------------------------------------------------------------------------------+class Add x y where+ type AddR x y :: N+ -- | Addition of singleton typed natural numbers.+ add :: Nat x -> Nat y -> Nat (AddR x y)++instance Add Z x where+ type AddR Z y = y+ add Zero y = y+ {-# INLINE add #-}++instance Add x (S y) => Add (S x) y where+ type AddR (S x) y = AddR x (S y)+ add (Succ x) y = add x (Succ y)+ {-# INLINE add #-}+++---------------------------------------------------------------------------------------------------+class Mul x y where+ type MulR x y :: N+ -- | Multiplication of singleton typed natural numbers.+ mul :: Nat x -> Nat y -> Nat (MulR x y)++instance Mul Z x where+ type MulR Z y = Z+ mul Zero _ = Zero++instance (Mul x y, Add (MulR x y) y) + => Mul (S x) y where+ type MulR (S x) y = AddR (MulR x y) y+ mul (Succ x) y = add (mul x y) y+++---------------------------------------------------------------------------------------------------+nat0 :: Nat Z+nat0 = Zero+{-# INLINE nat0 #-}++nat1 :: Nat (S Z)+nat1 = Succ Zero+{-# INLINE nat1 #-}++nat2 :: Nat (S (S Z))+nat2 = Succ $ Succ Zero+{-# INLINE nat2 #-}++nat3 :: Nat (S (S (S Z)))+nat3 = Succ $ Succ $ Succ Zero+{-# INLINE nat3 #-}++nat4 :: Nat (S (S (S (S Z))))+nat4 = Succ $ Succ $ Succ $ Succ Zero+{-# INLINE nat4 #-}++nat5 :: Nat (S (S (S (S (S Z)))))+nat5 = Succ $ Succ $ Succ $ Succ $ Succ Zero+{-# INLINE nat5 #-}++nat6 :: Nat (S (S (S (S (S (S Z))))))+nat6 = Succ $ Succ $ Succ $ Succ $ Succ $ Succ Zero+{-# INLINE nat6 #-}++nat7 :: Nat (S (S (S (S (S (S (S Z)))))))+nat7 = Succ $ Succ $ Succ $ Succ $ Succ $ Succ $ Succ Zero+{-# INLINE nat7 #-}++nat8 :: Nat (S (S (S (S (S (S (S (S Z))))))))+nat8 = Succ $ Succ $ Succ $ Succ $ Succ $ Succ $ Succ $ Succ Zero+{-# INLINE nat8 #-}++nat9 :: Nat (S (S (S (S (S (S (S (S (S Z)))))))))+nat9 = Succ $ Succ $ Succ $ Succ $ Succ $ Succ $ Succ $ Succ $ Succ Zero+{-# INLINE nat9 #-}+
+ LICENSE view
@@ -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.
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ repa-scalar.cabal view
@@ -0,0 +1,55 @@+Name: repa-scalar+Version: 4.2.0.1+License: BSD3+License-file: LICENSE+Author: The Repa Development Team+Maintainer: Ben Lippmeier <benl@ouroborus.net>+Build-Type: Simple+Cabal-Version: >=1.6+Stability: experimental+Category: Data Structures+Homepage: http://repa.ouroborus.net+Bug-reports: repa@ouroborus.net+Description: Scalar data types and conversions.+Synopsis: Scalar data types and conversions.++source-repository head+ type: git+ location: https://github.com/DDCSF/repa.git++Library+ build-Depends: + base == 4.8.*,+ primitive == 0.6.*,+ vector == 0.10.*,+ bytestring == 0.10.*,+ double-conversion == 2.0.*++ exposed-modules:+ Data.Repa.Scalar.Date32+ Data.Repa.Scalar.Double+ Data.Repa.Scalar.Int+ Data.Repa.Scalar.Singleton.Nat+ Data.Repa.Scalar.Singleton.Bool+ Data.Repa.Scalar.Product++ ghc-options:+ -Wall -fno-warn-missing-signatures+ -O2+++ extensions:+ GADTs+ DataKinds+ MagicHash+ BangPatterns+ TypeFamilies+ UnboxedTuples+ TypeOperators+ KindSignatures+ PatternGuards+ FlexibleInstances+ StandaloneDeriving+ ScopedTypeVariables+ MultiParamTypeClasses+ ForeignFunctionInterface