diff --git a/Data/Repa/Scalar/Box.hs b/Data/Repa/Scalar/Box.hs new file mode 100644 --- /dev/null +++ b/Data/Repa/Scalar/Box.hs @@ -0,0 +1,124 @@ + +module Data.Repa.Scalar.Box + ( Box (..)) +where +import qualified Data.Vector as V +import qualified Data.Vector.Unboxed as U +import qualified Data.Vector.Generic as G +import qualified Data.Vector.Generic.Mutable as GM + + +-- | Strict, boxed wrapper for a value. +-- +-- Useful as a default case when defining instances for polytypic +-- data types. +newtype Box a + = Box a + deriving (Eq, Show) + + +-- Unboxed ---------------------------------------------------------------------------------------- +-- Unboxed instance adapted from: +-- http://code.haskell.org/vector/internal/unbox-tuple-instances +-- +data instance U.Vector (Box a) + = V_Box + {-# UNPACK #-} !Int + !(V.Vector a) + + +data instance U.MVector s (Box a) + = MV_Box + {-# UNPACK #-} !Int + !(V.MVector s a) + + +instance U.Unbox a + => GM.MVector U.MVector (Box a) where + + basicLength (MV_Box n _as) = n + {-# INLINE basicLength #-} + + basicUnsafeSlice i m (MV_Box _n as) + = MV_Box m (GM.basicUnsafeSlice i m as) + {-# INLINE basicUnsafeSlice #-} + + basicOverlaps (MV_Box _n1 as1) (MV_Box _n2 as2) + = GM.basicOverlaps as1 as2 + {-# INLINE basicOverlaps #-} + + basicUnsafeNew n + = do as <- GM.basicUnsafeNew n + return $ MV_Box n as + {-# INLINE basicUnsafeNew #-} + + basicUnsafeReplicate n (Box a) + = do as <- GM.basicUnsafeReplicate n a + return $ MV_Box n as + {-# INLINE basicUnsafeReplicate #-} + + basicUnsafeRead (MV_Box _n as) i + = do v <- GM.basicUnsafeRead as i + return $ Box v + {-# INLINE basicUnsafeRead #-} + + basicUnsafeWrite (MV_Box _n as) i (Box a) + = a `seq` GM.basicUnsafeWrite as i a + {-# INLINE basicUnsafeWrite #-} + + basicClear (MV_Box _n as) + = GM.basicClear as + {-# INLINE basicClear #-} + + basicSet (MV_Box _n as) (Box a) + = GM.basicSet as a + {-# INLINE basicSet #-} + + basicUnsafeCopy (MV_Box _n1 as1) (MV_Box _n2 as2) + = GM.basicUnsafeCopy as1 as2 + {-# INLINE basicUnsafeCopy #-} + + basicUnsafeMove (MV_Box _n1 as1) (MV_Box _n2 as2) + = GM.basicUnsafeMove as1 as2 + {-# INLINE basicUnsafeMove #-} + + basicUnsafeGrow (MV_Box n as) m + = do as' <- GM.basicUnsafeGrow as m + return $ MV_Box (m + n) as' + {-# INLINE basicUnsafeGrow #-} + + +instance U.Unbox a + => G.Vector U.Vector (Box a) where + + basicUnsafeFreeze (MV_Box n as) + = do as' <- G.basicUnsafeFreeze as + return $ V_Box n as' + {-# INLINE basicUnsafeFreeze #-} + + basicUnsafeThaw (V_Box n as) + = do as' <- G.basicUnsafeThaw as + return $ MV_Box n as' + {-# INLINE basicUnsafeThaw #-} + + basicLength (V_Box n _as) + = n + {-# INLINE basicLength #-} + + basicUnsafeSlice i m (V_Box _n as) + = V_Box m (G.basicUnsafeSlice i m as) + {-# INLINE basicUnsafeSlice #-} + + basicUnsafeIndexM (V_Box _n as) i + = do a <- G.basicUnsafeIndexM as i + return (Box a) + {-# INLINE basicUnsafeIndexM #-} + + basicUnsafeCopy (MV_Box _n1 as1) (V_Box _n2 as2) + = G.basicUnsafeCopy as1 as2 + {-# INLINE basicUnsafeCopy #-} + + elemseq _ (Box a) + = G.elemseq (undefined :: V.Vector a) a + {-# INLINE elemseq #-} + diff --git a/Data/Repa/Scalar/Date32.hs b/Data/Repa/Scalar/Date32.hs --- a/Data/Repa/Scalar/Date32.hs +++ b/Data/Repa/Scalar/Date32.hs @@ -11,6 +11,7 @@ -- * Operators , next + , diffDays -- * Loading , loadYYYYsMMsDD @@ -24,6 +25,7 @@ import Foreign.Ptr import Control.Monad import Data.Repa.Scalar.Int +import qualified Data.Time.Calendar as Time import qualified Foreign.Ptr as F import qualified Foreign.Storable as F import Prelude as P @@ -96,6 +98,7 @@ year date = case unpack date of (yy, _, _) -> yy +{-# INLINE year #-} -- | Take the month number of a `Date32`. @@ -103,6 +106,7 @@ month date = case unpack date of (_, mm, _) -> mm +{-# INLINE month #-} -- | Take the day number of a `Date32`. @@ -110,6 +114,7 @@ day date = case unpack date of (_, _, dd) -> dd +{-# INLINE day #-} --------------------------------------------------------------------------------------------------- @@ -154,6 +159,16 @@ {-# NOINLINE next' #-} +-- | Take the number of days between two `Date32`s +diffDays :: Date32 -> Date32 -> Integer +diffDays date1 date2 + | (y1, m1, d1) <- unpack date1 + , (y2, m2, d2) <- unpack date2 + = Time.diffDays + (Time.fromGregorian (fromIntegral y1) m1 d1) + (Time.fromGregorian (fromIntegral y2) m2 d2) + + --------------------------------------------------------------------------------------------------- -- | Read a date in YYYYsMMsDD format from the given buffer. loadYYYYsMMsDD @@ -165,13 +180,14 @@ loadYYYYsMMsDD !sep !buf (I# len_) = loadYear where loadYear - | (# 1#, yy, ix' #) <- loadInt# buf len_ + | 1# <- 4# <=# len_ + , (# 1#, yy, ix' #) <- loadInt' buf 4# = sep1 ix' yy | otherwise = return Nothing sep1 ix yy - | 1# <- ix <# len_ - = F.peekByteOff buf (I# ix) >>= \(r :: Word8) + | 1# <- (ix +# 1#) <=# len_ + = F.peekByteOff buf (I# ix) >>= \(r :: Word8) -> if r == sep then loadMonth (ix +# 1#) yy else return Nothing @@ -179,13 +195,13 @@ | otherwise = return Nothing loadMonth ix yy - | 1# <- ix <# len_ - , (# 1#, mm, o #) <- loadInt# (buf `F.plusPtr` (I# ix)) len_ + | 1# <- (ix +# 2#) <=# len_ + , (# 1#, mm, o #) <- loadInt' (buf `F.plusPtr` (I# ix)) 2# = sep2 (ix +# o) yy mm | otherwise = return Nothing sep2 ix yy mm - | 1# <- ix <# len_ + | 1# <- (ix +# 1#) <=# len_ = F.peekByteOff buf (I# ix) >>= \(r :: Word8) -> if r == sep then loadDay (ix +# 1#) yy mm @@ -194,8 +210,8 @@ | otherwise = return Nothing loadDay ix yy mm - | 1# <- ix <# len_ - , (# 1#, dd, o #) <- loadInt# (buf `F.plusPtr` (I# ix)) len_ + | 1# <- (ix +# 2#) <=# len_ + , (# 1#, dd, o #) <- loadInt' (buf `F.plusPtr` (I# ix)) 2# = return $ Just (pack ( fromIntegral (I# yy) , fromIntegral (I# mm) @@ -203,7 +219,7 @@ , I# (ix +# o)) | otherwise = return Nothing -{-# INLINE loadYYYYsMMsDD #-} +{-# NOINLINE loadYYYYsMMsDD #-} --------------------------------------------------------------------------------------------------- @@ -217,13 +233,14 @@ loadDDsMMsYYYY !sep !buf (I# len_) = loadDay where loadDay - | (# 1#, dd, ix' #) <- loadInt# buf len_ - = sep1 ix' dd + | 1# <- 2# <=# len_ + , (# 1#, dd, o #) <- loadInt' buf 2# + = sep1 o dd | otherwise = return Nothing sep1 ix dd - | 1# <- ix <# len_ - = F.peekByteOff buf (I# ix) >>= \(r :: Word8) + | 1# <- (ix +# 1#) <=# len_ + = F.peekByteOff buf (I# ix) >>= \(r :: Word8) -> if r == sep then loadMonth (ix +# 1#) dd else return Nothing @@ -231,14 +248,14 @@ | otherwise = return Nothing loadMonth ix dd - | 1# <- ix <# len_ - , (# 1#, mm, o #) <- loadInt# (buf `F.plusPtr` (I# ix)) len_ + | 1# <- (ix +# 2#) <=# len_ + , (# 1#, mm, o #) <- loadInt' (buf `F.plusPtr` (I# ix)) 2# = sep2 (ix +# o) dd mm | otherwise = return Nothing sep2 ix dd mm - | 1# <- ix <# len_ - = F.peekByteOff buf (I# ix) >>= \(r :: Word8) + | 1# <- (ix +# 1#) <=# len_ + = F.peekByteOff buf (I# ix) >>= \(r :: Word8) -> if r == sep then loadYear (ix +# 1#) dd mm else return Nothing @@ -246,8 +263,8 @@ | otherwise = return Nothing loadYear ix dd mm - | 1# <- ix <# len_ - , (# 1#, yy, o #) <- loadInt# (buf `F.plusPtr` (I# ix)) len_ + | 1# <- (ix +# 4#) <=# len_ + , (# 1#, yy, o #) <- loadInt' (buf `F.plusPtr` (I# ix)) 4# = return $ Just (pack ( fromIntegral (I# yy) , fromIntegral (I# mm) @@ -255,6 +272,9 @@ , I# (ix +# o)) | otherwise = return Nothing -{-# INLINE loadDDsMMsYYYY #-} +{-# NOINLINE loadDDsMMsYYYY #-} +loadInt' (Ptr addr) len + = loadInt# addr len +{-# INLINE loadInt' #-} diff --git a/Data/Repa/Scalar/Int.hs b/Data/Repa/Scalar/Int.hs --- a/Data/Repa/Scalar/Int.hs +++ b/Data/Repa/Scalar/Int.hs @@ -1,65 +1,134 @@ -- | Loading and storing integers directly from/to memory buffers. module Data.Repa.Scalar.Int - ( -- * Loading - loadInt + ( -- * Reading from strings + readInt + , readIntFromByteString + + -- * Loading from buffers + , loadInt , loadInt# , loadIntWith# - -- * Storing - , storeInt) + -- * Showing to strings + -- ** Unpadded + , showInt + , showIntToByteString + + -- ** Padded + , showIntPad + , showIntPadToByteString + + -- * Storing to buffers + -- ** Unpadded + , storeInt + , storeInt# + , storeIntWith# + + -- ** Padded + , storeIntPad + , storeIntPad# + , storeIntPadWith#) where import Data.Word import Data.Char import GHC.Exts +import qualified Data.ByteString.Char8 as BS 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 System.IO.Unsafe --- Int -------------------------------------------------------------------------------------------- +-- Read/Load -------------------------------------------------------------------------------------- +-- | Read an `Int` from a `String`, or `Nothing` if this isn't one. +readInt :: String -> Maybe Int +readInt str + = readIntFromByteString $ BS.pack str +{-# INLINE readInt #-} + + +-- | Read an `Int` from a `ByteString`, or `Nothing` if this isn't one. +readIntFromByteString + :: BS.ByteString -> Maybe Int + +readIntFromByteString (BS.PS fptr offset len) + -- accursed ... may increase sharing of result, + -- but this is ok here as we're not allocating mutable object. + = unsafePerformIO + $ F.withForeignPtr fptr + $ \ptr -> return + $ loadInt (F.plusPtr ptr offset) len + Nothing + (\val n -> if n == len + then Just val + else Nothing) + +{-# INLINE readIntFromByteString #-} + + -- | Load an ASCII `Int` from a foreign buffer, -- returning the value and number of characters read. +-- +-- * This function is set to `INLINE`. It unboxes the pointer and +-- integer then calls `loadInt#', which is `NOINLINE`. +-- loadInt :: Ptr Word8 -- ^ Buffer holding digits. -> Int -- ^ Length of buffer. - -> IO (Maybe (Int, Int)) -- ^ Int read, and length of digits. + -> b -- ^ On convert failure, return this value. + -> (Int -> Int -> b) -- ^ On convert success, given int read and number of chars. + -> b -loadInt !ptr (I# len) - = case loadInt# ptr len of - (# 0#, _, _ #) -> return $ Nothing - (# _, n, ix #) -> return $ Just (I# n, I# ix) +loadInt (Ptr addr) (I# len) fails eat + = case loadInt# addr len of + (# 0#, _, _ #) -> fails + (# _, n, ix #) -> eat (I# n) (I# ix) {-# INLINE loadInt #-} --- | Like `loadInt`, but via unboxed types. +-- | Load an ASCII `Int` from a buffer, +-- producing an unboxed tuple describing the result. +-- +-- * This function is set to `NOINLINE`, so it can be safely called from +-- multiple places in the program. +-- loadInt# - :: Ptr Word8 -- ^ Buffer holding digits. + :: Addr# -- ^ Address of buffer holding digits -> Int# -- ^ Length of buffer. -> (# Int#, Int#, Int# #) -- ^ Convert success?, value, length read. -loadInt# buf len - = let peek8 ix +loadInt# addr len + = let + buf :: Ptr Word8 + = Ptr addr + + 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 #-} + {-# INLINE peek8 #-} - in loadIntWith# peek8 len + in loadIntWith# len peek8 {-# NOINLINE loadInt# #-} --- | Like `loadInt#`, but use the given function to get characters --- from the input buffer. +-- | Primitive `Int` loading function. +-- +-- * This function is set to `INLINE`, so you will get a new copy of it in the +-- compiled program each time it is invoked. Consider providing an appropriate +-- wrapper for your use case. +-- loadIntWith# - :: (Int# -> Int#) -- ^ Function to get a byte from the source. - -> Int# -- ^ Length of buffer - -> (# Int#, Int#, Int# #) -- ^ Convert success?, value, length read. + :: Int# -- ^ Length of input buffer. + -> (Int# -> Int#) -- ^ Function to get a byte from the source. + -> (# Int#, Int#, Int# #) -- ^ Convert success?, value, length read -loadIntWith# !get len +loadIntWith# !len get = start 0# where start !ix @@ -107,7 +176,7 @@ -- Number was explicitly negated. | 1# <- neg ==# 1# - , I# n' <- negate (I# n) + , I# n' <- negate (I# n) = (# 1#, n', ix #) -- Number was not negated. @@ -117,11 +186,298 @@ {-# 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 +--------------------------------------------------------------------------------------------------- +-- | Show an `Int`, allocating a new `String`. +showInt :: Int -> String +showInt i + = BS.unpack $ showIntToByteString i +{-# INLINE showInt #-} + + +-- | Show an `Int`, allocating a new `ByteString`. +showIntToByteString :: Int -> BS.ByteString +showIntToByteString (I# i) + = unsafePerformIO + $ let + alloc len + = F.mallocBytes (I# len) + {-# INLINE alloc #-} + + write ptr ix val + = F.pokeByteOff ptr (I# ix) (fromIntegral (I# val) :: Word8) + {-# INLINE write #-} + + make ptr len + = do fptr <- F.newForeignPtr F.finalizerFree ptr + return $ BS.PS fptr 0 (I# len) + {-# INLINE make #-} + + in storeIntWith# alloc write i make +{-# NOINLINE showIntToByteString #-} + + +-- | Store an ASCII `Int` into a buffer, producing the number of bytes written. +-- +-- * This functon is set to `INLINE`. It unboxes the pointer and integer then +-- calls `storeInt#` which is `NOINLINE`. +-- +storeInt :: Ptr Word8 -- ^ Pointer to output buffer. + -> Int -- ^ Int to store. + -> IO Int -- ^ Number of bytes written. + +storeInt (Ptr addr) (I# val) + = storeInt# addr val {-# INLINE storeInt #-} + +-- | Store an ASCII `Int` into a buffer, producing the number of bytes written. +-- +-- * This function is set to NOINLINE, so it can be safely called from +-- multiple places in the program. +-- +storeInt# + :: Addr# -- ^ Address of output buffer. + -> Int# -- ^ Int to store. + -> IO Int -- ^ Number of bytes written. + +storeInt# addr val + = let + -- move along, nothing to see.. + alloc _ + = return $ Ptr addr + {-# INLINE alloc #-} + + write _ ix byte + = F.pokeByteOff (Ptr addr) (I# ix) (fromIntegral (I# byte) :: Word8) + {-# INLINE write #-} + + make _ len + = return $ I# len + {-# INLINE make #-} + + in do + storeIntWith# alloc write val make +{-# NOINLINE storeInt# #-} + + +-- | Primitive `Int` storing function. +-- +-- * This function is set to `INLINE`, so you will get a new copy of it in the compiled +-- program each time it is invoked. Consider providing an appropriate wrapper +-- for your use case. +-- +storeIntWith# + :: (Int# -> IO buf) -- ^ Function to allocate a new output buffer, + -- given the length in bytes. + -> (buf -> Int# -> Int# -> IO ()) + -- ^ Function to write a byte to the buffer, + -- given the index and byte value. + -> Int# -- ^ Int to store. + -> (buf -> Int# -> IO b) -- ^ Continuation for buffer and bytes written. + -> IO b + +storeIntWith# alloc write val k + = F.allocaBytes 32 $ \(buf :: Ptr Word8) + -> let + -- Get starting magnitude. + !start + | 1# <- val <# 0# = digits (0# -# val) 0# + | otherwise = digits val 0# + {-# INLINE start #-} + + -- Load digits into buffer. + digits !mag !ix + = do F.pokeByteOff buf (I# ix) + (fromIntegral (I# (0x030# +# mag `remInt#` 10#)) :: Word8) + let !ix' = ix +# 1# + let !mag' = mag `quotInt#` 10# + (case mag' ==# 0# of + 1# -> sign ix' + _ -> digits mag' ix') + {-# NOINLINE digits #-} + + -- Load sign into buffer. + sign !ix + = case val <# 0# of + 1# -> do F.pokeByteOff buf (I# ix) + (fromIntegral (I# 0x02d#) :: Word8) + create (ix +# 1#) + _ -> create ix + {-# INLINE sign #-} + + -- Create a new output buffer, now that we know the length. + create len + = do out <- alloc len + output len out 0# + {-# NOINLINE create #-} + + -- Read chars back from buffer to output them + -- in the correct order. + output len out ix0 + = go ix0 + where go ix + | 1# <- ix <# len + = do x :: Word8 <- F.peekByteOff buf (I# ((len -# 1#) -# ix)) + let !(I# i) = fromIntegral x + write out ix i + go (ix +# 1#) + + | otherwise + = k out len + {-# INLINE output #-} + in start +{-# INLINE storeIntWith# #-} + + +--------------------------------------------------------------------------------------------------- +-- | Show an `Int`, allocating a new `String`. +showIntPad :: Int -> Int -> String +showIntPad i pad + = BS.unpack $ showIntPadToByteString i pad +{-# INLINE showIntPad #-} + + +-- | Show an `Int`, allocating a new `ByteString`. +showIntPadToByteString :: Int -> Int -> BS.ByteString +showIntPadToByteString (I# i) pad' + = unsafePerformIO + $ let + !(I# pad) + = max 0 pad' + + alloc len + = F.mallocBytes (I# len) + {-# INLINE alloc #-} + + write ptr ix val + = F.pokeByteOff ptr (I# ix) (fromIntegral (I# val) :: Word8) + {-# INLINE write #-} + + make ptr len + = do fptr <- F.newForeignPtr F.finalizerFree ptr + return $ BS.PS fptr 0 (I# len) + {-# INLINE make #-} + + in storeIntPadWith# alloc write i pad make +{-# NOINLINE showIntPadToByteString #-} + + +-- | Store an ASCII `Int` into a buffer, producing the number of bytes written. +storeIntPad + :: Ptr Word8 -- ^ Pointer to output buffer. + -> Int -- ^ Int to store. + -> Int -- ^ Minimum number of digits. + -> IO Int -- ^ Number of bytes written. + +storeIntPad (Ptr addr) (I# val) (I# pad) + = storeIntPad# addr val pad +{-# INLINE storeIntPad #-} + + +-- | Store an ASCII `Int` into a buffer, producing the number of bytes written. +-- +-- * This function is set to NOINLINE, so it can be safely called from +-- multiple places in the program. +-- +storeIntPad# + :: Addr# -- ^ Address of output buffer. + -> Int# -- ^ Int to store. + -> Int# -- ^ Minimum number of digits. + -> IO Int -- ^ Number of bytes written. + +storeIntPad# addr val pad + = let + -- move along, nothing to see.. + alloc _ + = return $ Ptr addr + {-# INLINE alloc #-} + + write _ ix byte + = F.pokeByteOff (Ptr addr) (I# ix) (fromIntegral (I# byte) :: Word8) + {-# INLINE write #-} + + make _ len + = return $ I# len + {-# INLINE make #-} + + in do + storeIntPadWith# alloc write val pad make +{-# NOINLINE storeIntPad# #-} + + +-- | Like `storeIntWith#`, but add leading zeros to the front of the integer +-- to pad it out to at least the given number of digits. + +storeIntPadWith# + :: (Int# -> IO buf) -- ^ Function to allocate a new output buffer, + -- given the length in bytes. + -> (buf -> Int# -> Int# -> IO ()) + -- ^ Function to write a byte to the buffer, + -- given the index and byte value. + -> Int# -- ^ Int to store. + -> Int# -- ^ Pad out result to achieve at this many digits. + -> (buf -> Int# -> IO b) -- ^ Continuation for buffer and bytes written. + -> IO b + +storeIntPadWith# alloc write val pad k + = F.allocaBytes (I# (32# +# pad)) $ \(buf :: Ptr Word8) + -> let + -- Get starting magnitude. + !start + | 1# <- val <# 0# = digits (0# -# val) 0# + | otherwise = digits val 0# + {-# INLINE start #-} + + -- Load digits into buffer. + digits !mag !ix + = do F.pokeByteOff buf (I# ix) + (fromIntegral (I# (0x030# +# mag `remInt#` 10#)) :: Word8) + let !ix' = ix +# 1# + let !mag' = mag `quotInt#` 10# + (case mag' ==# 0# of + 1# -> padder ix' + _ -> digits mag' ix') + {-# NOINLINE digits #-} + + -- Pad result out with zeros. + padder !ix + | 1# <- ix >=# pad + = sign ix + + | otherwise + = do F.pokeByteOff buf (I# ix) + (fromIntegral (I# 0x030#) :: Word8) + padder (ix +# 1#) + + -- Load sign into buffer. + sign !ix + = case val <# 0# of + 1# -> do F.pokeByteOff buf (I# ix) + (fromIntegral (I# 0x02d#) :: Word8) + create (ix +# 1#) + _ -> create ix + {-# INLINE sign #-} + + -- Create a new output buffer, now that we know the length. + create len + = do out <- alloc len + output len out 0# + {-# NOINLINE create #-} + + -- Read chars back from buffer to output them + -- in the correct order. + output len out ix0 + = go ix0 + where go ix + | 1# <- ix <# len + = do x :: Word8 <- F.peekByteOff buf (I# ((len -# 1#) -# ix)) + let !(I# i) = fromIntegral x + write out ix i + go (ix +# 1#) + + | otherwise + = k out len + {-# INLINE output #-} + in start +{-# INLINE storeIntPadWith# #-} diff --git a/Data/Repa/Scalar/Option.hs b/Data/Repa/Scalar/Option.hs new file mode 100644 --- /dev/null +++ b/Data/Repa/Scalar/Option.hs @@ -0,0 +1,109 @@ + +-- | Option types are synonyms for @Maybe a@, @Maybe (a, b)@ and so on, +-- which are strict in the components. +module Data.Repa.Scalar.Option + ( -- * Single component + Option (..) + , fromOption, toOption + + -- * Two components + , Option2 (..) + , fromOption2, toOption2 + + -- * Three components + , Option3 (..) + , fromOption3, toOption3 + + -- * Four components + , Option4 (..) + , fromOption4, toOption4) +where + + +------------------------------------------------------------------------------- +-- | A strict `Maybe` type. +data Option a + = Some !a + | None + deriving (Eq, Ord, Show) + + +-- | Convert a `Maybe` to an `Option`. +toOption :: Maybe a -> Option a +toOption Nothing = None +toOption (Just x) = Some x +{-# INLINE toOption #-} + + +-- | Convert an `Option` to a `Maybe`. +fromOption :: Option a -> Maybe a +fromOption None = Nothing +fromOption (Some x) = Just x +{-# INLINE fromOption #-} + + +------------------------------------------------------------------------------- +-- | A strict `Maybe` type, with two parameters. +data Option2 a b + = Some2 !a !b + | None2 + deriving (Eq, Ord, Show) + + +-- | Convert a `Maybe` to an `Option2`. +toOption2 :: Maybe (a, b) -> Option2 a b +toOption2 Nothing = None2 +toOption2 (Just (x, y)) = Some2 x y +{-# INLINE toOption2 #-} + + +-- | Convert an `Option2` to a `Maybe`. +fromOption2 :: Option2 a b -> Maybe (a, b) +fromOption2 None2 = Nothing +fromOption2 (Some2 x y) = Just (x, y) +{-# INLINE fromOption2 #-} + + +------------------------------------------------------------------------------- +-- | A strict `Maybe` type with three parameters. +data Option3 a b c + = Some3 !a !b !c + | None3 + deriving (Eq, Ord, Show) + + +-- | Convert a `Maybe` to an `Option3`. +toOption3 :: Maybe (a, b, c) -> Option3 a b c +toOption3 Nothing = None3 +toOption3 (Just (x, y, z)) = Some3 x y z +{-# INLINE toOption3 #-} + + +-- | Convert an `Option2` to a `Maybe`. +fromOption3 :: Option3 a b c -> Maybe (a, b, c) +fromOption3 None3 = Nothing +fromOption3 (Some3 x y z) = Just (x, y, z) +{-# INLINE fromOption3 #-} + + +------------------------------------------------------------------------------- +-- | A strict `Maybe` type with four parameters. +data Option4 a b c d + = Some4 !a !b !c !d + | None4 + deriving (Eq, Ord, Show) + + +-- | Convert a `Maybe` to an `Option4`. +toOption4 :: Maybe (a, b, c, d) -> Option4 a b c d +toOption4 Nothing = None4 +toOption4 (Just (x1, x2, x3, x4)) = Some4 x1 x2 x3 x4 +{-# INLINE toOption4 #-} + + +-- | Convert an `Option2` to a `Maybe`. +fromOption4 :: Option4 a b c d -> Maybe (a, b, c, d) +fromOption4 None4 = Nothing +fromOption4 (Some4 x1 x2 x3 x4) = Just (x1, x2, x3, x4) +{-# INLINE fromOption4 #-} + diff --git a/Data/Repa/Scalar/Product.hs b/Data/Repa/Scalar/Product.hs --- a/Data/Repa/Scalar/Product.hs +++ b/Data/Repa/Scalar/Product.hs @@ -20,7 +20,7 @@ --------------------------------------------------------------------------------------------------- --- | Strict product type, written infix. +-- | A strict product type, written infix. data a :*: b = !a :*: !b deriving (Eq, Show) diff --git a/Data/Repa/Scalar/Singleton/Bool.hs b/Data/Repa/Scalar/Singleton/Bool.hs --- a/Data/Repa/Scalar/Singleton/Bool.hs +++ b/Data/Repa/Scalar/Singleton/Bool.hs @@ -1,4 +1,6 @@ {-# OPTIONS_GHC -fno-warn-unticked-promoted-constructors #-} + +-- | Singleton typed booleans. module Data.Repa.Scalar.Singleton.Bool ( B (..) , Boolean (..)) @@ -7,7 +9,6 @@ data B = Y | N deriving instance Show B - data Boolean (b :: B) where Yes :: Boolean Y diff --git a/Data/Repa/Scalar/Singleton/Nat.hs b/Data/Repa/Scalar/Singleton/Nat.hs --- a/Data/Repa/Scalar/Singleton/Nat.hs +++ b/Data/Repa/Scalar/Singleton/Nat.hs @@ -1,5 +1,6 @@ {-# OPTIONS_GHC -fno-warn-unticked-promoted-constructors #-} {-# LANGUAGE UndecidableInstances #-} + -- | Singleton-typed natural numbers and arithmetic. -- -- Used for indexing into hetrogenous list types. diff --git a/repa-scalar.cabal b/repa-scalar.cabal --- a/repa-scalar.cabal +++ b/repa-scalar.cabal @@ -1,5 +1,5 @@ Name: repa-scalar -Version: 4.2.0.1 +Version: 4.2.0.2 License: BSD3 License-file: LICENSE Author: The Repa Development Team @@ -23,14 +23,17 @@ primitive == 0.6.*, vector == 0.10.*, bytestring == 0.10.*, - double-conversion == 2.0.* + double-conversion == 2.0.*, + time == 1.6.* exposed-modules: + Data.Repa.Scalar.Singleton.Nat + Data.Repa.Scalar.Singleton.Bool + Data.Repa.Scalar.Box 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.Option Data.Repa.Scalar.Product ghc-options: