-- | Loading and storing doubles directly from/to memory buffers.
--
--   * Calls out to foreign load and store functions written in C and C++,
--     so performance should be alright.
--
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.
--
--   * Calls out do the stdlib `strtod` function.
--
loadDouble 
        :: Ptr Word8            -- ^ Buffer holding ASCII representation.
        -> Int                  -- ^ Length of buffer.
        -> IO (Double, Int)     -- ^ Result, and number of characters read from buffer.

loadDouble :: Ptr Word8 -> Int -> IO (Double, Int)
loadDouble !Ptr Word8
pIn !Int
len
 = Int -> (Ptr Word8 -> IO (Double, Int)) -> IO (Double, Int)
forall a b. Int -> (Ptr a -> IO b) -> IO b
F.allocaBytes (Int
len Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) ((Ptr Word8 -> IO (Double, Int)) -> IO (Double, Int))
-> (Ptr Word8 -> IO (Double, Int)) -> IO (Double, Int)
forall a b. (a -> b) -> a -> b
$ \Ptr Word8
pBuf ->
   (Ptr (Ptr Word8) -> IO (Double, Int)) -> IO (Double, Int)
forall a b. Storable a => (Ptr a -> IO b) -> IO b
F.alloca                ((Ptr (Ptr Word8) -> IO (Double, Int)) -> IO (Double, Int))
-> (Ptr (Ptr Word8) -> IO (Double, Int)) -> IO (Double, Int)
forall a b. (a -> b) -> a -> b
$ \Ptr (Ptr Word8)
pRes ->
    do
        -- Copy the data to our new buffer.
        Ptr Word8 -> Ptr Word8 -> Int -> IO ()
forall a. Ptr a -> Ptr a -> Int -> IO ()
F.copyBytes Ptr Word8
pBuf Ptr Word8
pIn (Int -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
len)

        -- Poke a 0 on the end to ensure it's null terminated.
        Ptr Word8 -> Int -> Word8 -> IO ()
forall b. Ptr b -> Int -> Word8 -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
F.pokeByteOff Ptr Word8
pBuf Int
len (Word8
0 :: Word8)

        -- Call the C strtod function
        let !d :: Double
d  = Ptr Word8 -> Ptr (Ptr Word8) -> Double
strtod Ptr Word8
pBuf Ptr (Ptr Word8)
pRes

        -- Read back the end pointer.
        Ptr Word8
res     <- Ptr (Ptr Word8) -> IO (Ptr Word8)
forall a. Storable a => Ptr a -> IO a
F.peek Ptr (Ptr Word8)
pRes

        (Double, Int) -> IO (Double, Int)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Double
d, Ptr Word8
res Ptr Word8 -> Ptr Word8 -> Int
forall a b. Ptr a -> Ptr b -> Int
`F.minusPtr` Ptr Word8
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.
--
--   * Calls out to the `double-conversion` library which is binding
--     to a C++ implementation.
--
--   * 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 :: Double -> IO (ForeignPtr Word8, Int)
storeDoubleShortest Double
d
 = case Double -> ByteString
DC.toShortest Double
d of
        BS.PS ForeignPtr Word8
p Int
_ Int
n  -> (ForeignPtr Word8, Int) -> IO (ForeignPtr Word8, Int)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (ForeignPtr Word8
p, Int
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 :: Int -> Double -> IO (ForeignPtr Word8, Int)
storeDoubleFixed !Int
prec !Double
d
 = case Int -> Double -> ByteString
DC.toFixed Int
prec Double
d of
        BS.PS ForeignPtr Word8
p Int
_ Int
n  -> (ForeignPtr Word8, Int) -> IO (ForeignPtr Word8, Int)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (ForeignPtr Word8
p, Int
n)
{-# INLINE storeDoubleFixed #-}