module Data.Repa.Convert.Format.Numeric
        ( IntAsc                (..)
        , IntAsc0               (..)
        , DoubleAsc             (..)
        , DoubleFixedPack       (..))
where
import Data.Repa.Convert.Internal.Format
import Data.Repa.Convert.Internal.Packable
import GHC.Exts
import Data.Word
import qualified Data.Repa.Scalar.Int           as S
import qualified Data.Repa.Scalar.Double        as S
import qualified Foreign.ForeignPtr             as F
import qualified Foreign.Marshal.Utils          as F
import qualified Foreign.Ptr                    as F
import Prelude hiding (fail)
#include "repa-convert.h"


------------------------------------------------------------------------------------------- IntAsc
-- | Human-readable ASCII Integer.
data IntAsc     = IntAsc        deriving (IntAsc -> IntAsc -> Bool
(IntAsc -> IntAsc -> Bool)
-> (IntAsc -> IntAsc -> Bool) -> Eq IntAsc
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: IntAsc -> IntAsc -> Bool
== :: IntAsc -> IntAsc -> Bool
$c/= :: IntAsc -> IntAsc -> Bool
/= :: IntAsc -> IntAsc -> Bool
Eq, Int -> IntAsc -> ShowS
[IntAsc] -> ShowS
IntAsc -> String
(Int -> IntAsc -> ShowS)
-> (IntAsc -> String) -> ([IntAsc] -> ShowS) -> Show IntAsc
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> IntAsc -> ShowS
showsPrec :: Int -> IntAsc -> ShowS
$cshow :: IntAsc -> String
show :: IntAsc -> String
$cshowList :: [IntAsc] -> ShowS
showList :: [IntAsc] -> ShowS
Show)
instance Format IntAsc where
 type Value IntAsc      = Int

 fieldCount :: IntAsc -> Int
fieldCount IntAsc
_           = Int
1
 {-# INLINE minSize    #-}

 minSize :: IntAsc -> Int
minSize    IntAsc
_           = Int
1
 {-# INLINE fieldCount #-}

 fixedSize :: IntAsc -> Maybe Int
fixedSize  IntAsc
_           = Maybe Int
forall a. Maybe a
Nothing
 {-# INLINE fixedSize  #-}

 -- Max length of a pretty printed 64-bit Int is 20 bytes including sign.
 packedSize :: IntAsc -> Value IntAsc -> Maybe Int
packedSize IntAsc
_ Value IntAsc
_         = Int -> Maybe Int
forall a. a -> Maybe a
Just Int
20               
 {-# INLINE packedSize #-}


instance Packable IntAsc where

 packer :: IntAsc
-> Value IntAsc -> Addr# -> IO () -> (Addr# -> IO ()) -> IO ()
packer IntAsc
IntAsc (I# Int#
v) Addr#
dst IO ()
_fails Addr# -> IO ()
k
  = do  Int
len     <- Addr# -> Int# -> IO Int
S.storeInt# Addr#
dst Int#
v
        let !(Ptr Addr#
dst') = Ptr Any -> Int -> Ptr Any
forall a b. Ptr a -> Int -> Ptr b
F.plusPtr (Addr# -> Ptr Any
forall a. Addr# -> Ptr a
Ptr Addr#
dst) Int
len
        Addr# -> IO ()
k Addr#
dst'
 {-# INLINE packer #-}


instance Unpackable IntAsc where

 unpacker :: IntAsc
-> Addr#
-> Addr#
-> (Word8 -> Bool)
-> IO ()
-> (Addr# -> Value IntAsc -> IO ())
-> IO ()
unpacker IntAsc
IntAsc Addr#
start Addr#
end Word8 -> Bool
_stop IO ()
fail Addr# -> Value IntAsc -> IO ()
eat
  = let !len :: Int
len = Int# -> Int
I# (Addr# -> Addr# -> Int#
minusAddr# Addr#
end Addr#
start) in 
    if Int
len Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0
     then do
        Ptr Word8 -> Int -> IO () -> (Int -> Int -> IO ()) -> IO ()
forall b. Ptr Word8 -> Int -> b -> (Int -> Int -> b) -> b
S.loadInt (Addr# -> Ptr Word8
pw8 Addr#
start) Int
len 
                IO ()
fail 
                (\Int
val (I# Int#
off) -> Addr# -> Value IntAsc -> IO ()
eat (Addr# -> Int# -> Addr#
plusAddr# Addr#
start Int#
off) Int
Value IntAsc
val)
     else IO ()
fail
 {-# INLINE unpacker #-}


------------------------------------------------------------------------------------------- IntAsc
-- | Human-readable ASCII integer,
--   using leading zeros to pad the encoding out to a fixed length.
data IntAsc0    = IntAsc0 Int   deriving (IntAsc0 -> IntAsc0 -> Bool
(IntAsc0 -> IntAsc0 -> Bool)
-> (IntAsc0 -> IntAsc0 -> Bool) -> Eq IntAsc0
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: IntAsc0 -> IntAsc0 -> Bool
== :: IntAsc0 -> IntAsc0 -> Bool
$c/= :: IntAsc0 -> IntAsc0 -> Bool
/= :: IntAsc0 -> IntAsc0 -> Bool
Eq, Int -> IntAsc0 -> ShowS
[IntAsc0] -> ShowS
IntAsc0 -> String
(Int -> IntAsc0 -> ShowS)
-> (IntAsc0 -> String) -> ([IntAsc0] -> ShowS) -> Show IntAsc0
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> IntAsc0 -> ShowS
showsPrec :: Int -> IntAsc0 -> ShowS
$cshow :: IntAsc0 -> String
show :: IntAsc0 -> String
$cshowList :: [IntAsc0] -> ShowS
showList :: [IntAsc0] -> ShowS
Show)
instance Format IntAsc0 where
 type Value IntAsc0     = Int
 fieldCount :: IntAsc0 -> Int
fieldCount IntAsc0
_           = Int
1
 minSize :: IntAsc0 -> Int
minSize    IntAsc0
_           = Int
1
 fixedSize :: IntAsc0 -> Maybe Int
fixedSize  IntAsc0
_           = Maybe Int
forall a. Maybe a
Nothing

 -- Max length of a pretty printed 64-bit Int is 20 bytes including sign.
 packedSize :: IntAsc0 -> Value IntAsc0 -> Maybe Int
packedSize (IntAsc0 Int
n) Value IntAsc0
_ = Int -> Maybe Int
forall a. a -> Maybe a
Just (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
20)
 {-# INLINE minSize    #-}
 {-# INLINE fieldCount #-}
 {-# INLINE fixedSize  #-}
 {-# INLINE packedSize #-}


instance Packable IntAsc0 where

 packer :: IntAsc0
-> Value IntAsc0 -> Addr# -> IO () -> (Addr# -> IO ()) -> IO ()
packer (IntAsc0 (I# Int#
pad)) (I# Int#
v) Addr#
dst IO ()
_fails Addr# -> IO ()
k
  = do  Int
len     <- Addr# -> Int# -> Int# -> IO Int
S.storeIntPad# Addr#
dst Int#
v Int#
pad
        let !(Ptr Addr#
dst') = Ptr Any -> Int -> Ptr Any
forall a b. Ptr a -> Int -> Ptr b
F.plusPtr (Addr# -> Ptr Any
forall a. Addr# -> Ptr a
Ptr Addr#
dst) Int
len
        Addr# -> IO ()
k Addr#
dst'
 {-# INLINE packer #-}


instance Unpackable IntAsc0 where

 unpacker :: IntAsc0
-> Addr#
-> Addr#
-> (Word8 -> Bool)
-> IO ()
-> (Addr# -> Value IntAsc0 -> IO ())
-> IO ()
unpacker (IntAsc0 Int
_) Addr#
start Addr#
end Word8 -> Bool
_stop IO ()
fail Addr# -> Value IntAsc0 -> IO ()
eat
  = let !len :: Int
len = Int# -> Int
I# (Addr# -> Addr# -> Int#
minusAddr# Addr#
end Addr#
start) in
    if  Int
len Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0
     then do
        Ptr Word8 -> Int -> IO () -> (Int -> Int -> IO ()) -> IO ()
forall b. Ptr Word8 -> Int -> b -> (Int -> Int -> b) -> b
S.loadInt (Addr# -> Ptr Word8
pw8 Addr#
start) Int
len
                IO ()
fail
                (\Int
val (I# Int#
off) -> Addr# -> Value IntAsc0 -> IO ()
eat (Addr# -> Int# -> Addr#
plusAddr# Addr#
start Int#
off) Int
Value IntAsc0
val)
     else IO ()
fail
 {-# INLINE unpacker #-}


----------------------------------------------------------------------------------------- DoubleAsc
-- | Human-readable ASCII Double.
data DoubleAsc  = DoubleAsc     deriving (DoubleAsc -> DoubleAsc -> Bool
(DoubleAsc -> DoubleAsc -> Bool)
-> (DoubleAsc -> DoubleAsc -> Bool) -> Eq DoubleAsc
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: DoubleAsc -> DoubleAsc -> Bool
== :: DoubleAsc -> DoubleAsc -> Bool
$c/= :: DoubleAsc -> DoubleAsc -> Bool
/= :: DoubleAsc -> DoubleAsc -> Bool
Eq, Int -> DoubleAsc -> ShowS
[DoubleAsc] -> ShowS
DoubleAsc -> String
(Int -> DoubleAsc -> ShowS)
-> (DoubleAsc -> String)
-> ([DoubleAsc] -> ShowS)
-> Show DoubleAsc
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> DoubleAsc -> ShowS
showsPrec :: Int -> DoubleAsc -> ShowS
$cshow :: DoubleAsc -> String
show :: DoubleAsc -> String
$cshowList :: [DoubleAsc] -> ShowS
showList :: [DoubleAsc] -> ShowS
Show)
instance Format DoubleAsc where
 type Value DoubleAsc   = Double
 fieldCount :: DoubleAsc -> Int
fieldCount DoubleAsc
_           = Int
1
 minSize :: DoubleAsc -> Int
minSize    DoubleAsc
_           = Int
1
 fixedSize :: DoubleAsc -> Maybe Int
fixedSize  DoubleAsc
_           = Maybe Int
forall a. Maybe a
Nothing

 -- Max length of a pretty-printed 64-bit double is 24 bytes.
 packedSize :: DoubleAsc -> Value DoubleAsc -> Maybe Int
packedSize DoubleAsc
_ Value DoubleAsc
_         = Int -> Maybe Int
forall a. a -> Maybe a
Just Int
24
 {-# INLINE minSize    #-}
 {-# INLINE fieldCount #-}
 {-# INLINE fixedSize  #-}
 {-# INLINE packedSize #-}


instance Packable DoubleAsc where

 packer :: DoubleAsc
-> Value DoubleAsc -> Addr# -> IO () -> (Addr# -> IO ()) -> IO ()
packer  DoubleAsc
DoubleAsc Value DoubleAsc
v Addr#
dst IO ()
_fails Addr# -> IO ()
k
  = do  (ForeignPtr Word8
fptr, Int
len)  <- Double -> IO (ForeignPtr Word8, Int)
S.storeDoubleShortest Double
Value DoubleAsc
v
        ForeignPtr Word8 -> (Ptr Word8 -> IO ()) -> IO ()
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
F.withForeignPtr ForeignPtr Word8
fptr ((Ptr Word8 -> IO ()) -> IO ()) -> (Ptr Word8 -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr Word8
ptr
         -> Ptr Word8 -> Ptr Word8 -> Int -> IO ()
forall a. Ptr a -> Ptr a -> Int -> IO ()
F.copyBytes (Addr# -> Ptr Word8
forall a. Addr# -> Ptr a
Ptr Addr#
dst) Ptr Word8
ptr Int
len
        let !(Ptr Addr#
dst') = Ptr Any -> Int -> Ptr Any
forall a b. Ptr a -> Int -> Ptr b
F.plusPtr (Addr# -> Ptr Any
forall a. Addr# -> Ptr a
Ptr Addr#
dst) Int
len
        Addr# -> IO ()
k Addr#
dst'
 {-# INLINE packer   #-}


instance Unpackable DoubleAsc where

 unpacker :: DoubleAsc
-> Addr#
-> Addr#
-> (Word8 -> Bool)
-> IO ()
-> (Addr# -> Value DoubleAsc -> IO ())
-> IO ()
unpacker DoubleAsc
DoubleAsc Addr#
start Addr#
end Word8 -> Bool
_stop IO ()
fail Addr# -> Value DoubleAsc -> IO ()
eat
  = let !len :: Int
len = Int# -> Int
I# (Addr# -> Addr# -> Int#
minusAddr# Addr#
end Addr#
start) in
    if Int
len Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0
      then do
        (Double
v, I# Int#
o)  <- Ptr Word8 -> Int -> IO (Double, Int)
S.loadDouble (Addr# -> Ptr Word8
pw8 Addr#
start) Int
len
        Addr# -> Value DoubleAsc -> IO ()
eat (Addr# -> Int# -> Addr#
plusAddr# Addr#
start Int#
o) Double
Value DoubleAsc
v
      else IO ()
fail
 {-# INLINE unpacker #-}


-------------------------------------------------------------------------------- DoubleFixedPack
-- | Human-readable ASCII Double.
-- 
--   When packing we use a fixed number of zeros after the decimal
--   point, though when unpacking we allow a greater precision.
--
data DoubleFixedPack    = DoubleFixedPack Int   deriving (DoubleFixedPack -> DoubleFixedPack -> Bool
(DoubleFixedPack -> DoubleFixedPack -> Bool)
-> (DoubleFixedPack -> DoubleFixedPack -> Bool)
-> Eq DoubleFixedPack
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: DoubleFixedPack -> DoubleFixedPack -> Bool
== :: DoubleFixedPack -> DoubleFixedPack -> Bool
$c/= :: DoubleFixedPack -> DoubleFixedPack -> Bool
/= :: DoubleFixedPack -> DoubleFixedPack -> Bool
Eq, Int -> DoubleFixedPack -> ShowS
[DoubleFixedPack] -> ShowS
DoubleFixedPack -> String
(Int -> DoubleFixedPack -> ShowS)
-> (DoubleFixedPack -> String)
-> ([DoubleFixedPack] -> ShowS)
-> Show DoubleFixedPack
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> DoubleFixedPack -> ShowS
showsPrec :: Int -> DoubleFixedPack -> ShowS
$cshow :: DoubleFixedPack -> String
show :: DoubleFixedPack -> String
$cshowList :: [DoubleFixedPack] -> ShowS
showList :: [DoubleFixedPack] -> ShowS
Show)
instance Format DoubleFixedPack where
 type Value DoubleFixedPack = Double
 fieldCount :: DoubleFixedPack -> Int
fieldCount DoubleFixedPack
_           = Int
1
 minSize :: DoubleFixedPack -> Int
minSize    DoubleFixedPack
_           = Int
1
 fixedSize :: DoubleFixedPack -> Maybe Int
fixedSize  DoubleFixedPack
_           = Maybe Int
forall a. Maybe a
Nothing

 -- Max length of a pretty-printed 64-bit double is 24 bytes.
 packedSize :: DoubleFixedPack -> Value DoubleFixedPack -> Maybe Int
packedSize (DoubleFixedPack Int
prec) Value DoubleFixedPack
_         
                        = Int -> Maybe Int
forall a. a -> Maybe a
Just (Int
24 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
prec)
 {-# INLINE minSize    #-}
 {-# INLINE fieldCount #-}
 {-# INLINE fixedSize  #-}
 {-# INLINE packedSize #-}


instance Packable DoubleFixedPack where

 packer :: DoubleFixedPack
-> Value DoubleFixedPack
-> Addr#
-> IO ()
-> (Addr# -> IO ())
-> IO ()
packer   (DoubleFixedPack Int
prec) Value DoubleFixedPack
v Addr#
dst IO ()
_fails Addr# -> IO ()
k
  = do  (ForeignPtr Word8
fptr, Int
len)  <- Int -> Double -> IO (ForeignPtr Word8, Int)
S.storeDoubleFixed Int
prec Double
Value DoubleFixedPack
v
        ForeignPtr Word8 -> (Ptr Word8 -> IO ()) -> IO ()
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
F.withForeignPtr ForeignPtr Word8
fptr ((Ptr Word8 -> IO ()) -> IO ()) -> (Ptr Word8 -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr Word8
ptr
         -> Ptr Word8 -> Ptr Word8 -> Int -> IO ()
forall a. Ptr a -> Ptr a -> Int -> IO ()
F.copyBytes (Addr# -> Ptr Word8
forall a. Addr# -> Ptr a
Ptr Addr#
dst) Ptr Word8
ptr Int
len
        let !(Ptr Addr#
dst') = Ptr Any -> Int -> Ptr Any
forall a b. Ptr a -> Int -> Ptr b
F.plusPtr (Addr# -> Ptr Any
forall a. Addr# -> Ptr a
Ptr Addr#
dst) Int
len
        Addr# -> IO ()
k Addr#
dst'
 {-# INLINE packer #-}


instance Unpackable DoubleFixedPack where

 unpacker :: DoubleFixedPack
-> Addr#
-> Addr#
-> (Word8 -> Bool)
-> IO ()
-> (Addr# -> Value DoubleFixedPack -> IO ())
-> IO ()
unpacker (DoubleFixedPack Int
_) Addr#
start Addr#
end Word8 -> Bool
_stop IO ()
fail Addr# -> Value DoubleFixedPack -> IO ()
eat
  = let !len :: Int
len = Int# -> Int
I# (Addr# -> Addr# -> Int#
minusAddr# Addr#
end Addr#
start) in
    if Int
len Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0
     then do
       (Double
v, I# Int#
o)  <- Ptr Word8 -> Int -> IO (Double, Int)
S.loadDouble (Addr# -> Ptr Word8
pw8 Addr#
start) Int
len
       Addr# -> Value DoubleFixedPack -> IO ()
eat (Addr# -> Int# -> Addr#
plusAddr# Addr#
start Int#
o) Double
Value DoubleFixedPack
v
     else IO ()
fail
 {-# INLINE unpacker #-}


pw8 :: Addr# -> Ptr Word8
pw8 :: Addr# -> Ptr Word8
pw8 Addr#
addr = Addr# -> Ptr Word8
forall a. Addr# -> Ptr a
Ptr Addr#
addr
{-# INLINE pw8 #-}