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 (Eq, Show) instance Format IntAsc where type Value IntAsc = Int fieldCount _ = 1 {-# INLINE minSize #-} minSize _ = 1 {-# INLINE fieldCount #-} fixedSize _ = Nothing {-# INLINE fixedSize #-} -- Max length of a pretty printed 64-bit Int is 20 bytes including sign. packedSize _ _ = Just 20 {-# INLINE packedSize #-} instance Packable IntAsc where packer IntAsc (I# v) dst _fails k = do len <- S.storeInt# dst v let !(Ptr dst') = F.plusPtr (Ptr dst) len k dst' {-# INLINE packer #-} instance Unpackable IntAsc where unpacker IntAsc start end _stop fail eat = let !len = I# (minusAddr# end start) in if len > 0 then do S.loadInt (pw8 start) len fail (\val (I# off) -> eat (plusAddr# start off) val) else 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 (Eq, Show) instance Format IntAsc0 where type Value IntAsc0 = Int fieldCount _ = 1 minSize _ = 1 fixedSize _ = Nothing -- Max length of a pretty printed 64-bit Int is 20 bytes including sign. packedSize (IntAsc0 n) _ = Just (n + 20) {-# INLINE minSize #-} {-# INLINE fieldCount #-} {-# INLINE fixedSize #-} {-# INLINE packedSize #-} instance Packable IntAsc0 where packer (IntAsc0 (I# pad)) (I# v) dst _fails k = do len <- S.storeIntPad# dst v pad let !(Ptr dst') = F.plusPtr (Ptr dst) len k dst' {-# INLINE packer #-} instance Unpackable IntAsc0 where unpacker (IntAsc0 _) start end _stop fail eat = let !len = I# (minusAddr# end start) in if len > 0 then do S.loadInt (pw8 start) len fail (\val (I# off) -> eat (plusAddr# start off) val) else fail {-# INLINE unpacker #-} ----------------------------------------------------------------------------------------- DoubleAsc -- | Human-readable ASCII Double. data DoubleAsc = DoubleAsc deriving (Eq, Show) instance Format DoubleAsc where type Value DoubleAsc = Double fieldCount _ = 1 minSize _ = 1 fixedSize _ = Nothing -- Max length of a pretty-printed 64-bit double is 24 bytes. packedSize _ _ = Just 24 {-# INLINE minSize #-} {-# INLINE fieldCount #-} {-# INLINE fixedSize #-} {-# INLINE packedSize #-} instance Packable DoubleAsc where packer DoubleAsc v dst _fails k = do (fptr, len) <- S.storeDoubleShortest v F.withForeignPtr fptr $ \ptr -> F.copyBytes (Ptr dst) ptr len let !(Ptr dst') = F.plusPtr (Ptr dst) len k dst' {-# INLINE packer #-} instance Unpackable DoubleAsc where unpacker DoubleAsc start end _stop fail eat = let !len = I# (minusAddr# end start) in if len > 0 then do (v, I# o) <- S.loadDouble (pw8 start) len eat (plusAddr# start o) v else 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 (Eq, Show) instance Format DoubleFixedPack where type Value DoubleFixedPack = Double fieldCount _ = 1 minSize _ = 1 fixedSize _ = Nothing -- Max length of a pretty-printed 64-bit double is 24 bytes. packedSize (DoubleFixedPack prec) _ = Just (24 + prec) {-# INLINE minSize #-} {-# INLINE fieldCount #-} {-# INLINE fixedSize #-} {-# INLINE packedSize #-} instance Packable DoubleFixedPack where packer (DoubleFixedPack prec) v dst _fails k = do (fptr, len) <- S.storeDoubleFixed prec v F.withForeignPtr fptr $ \ptr -> F.copyBytes (Ptr dst) ptr len let !(Ptr dst') = F.plusPtr (Ptr dst) len k dst' {-# INLINE packer #-} instance Unpackable DoubleFixedPack where unpacker (DoubleFixedPack _) start end _stop fail eat = let !len = I# (minusAddr# end start) in if len > 0 then do (v, I# o) <- S.loadDouble (pw8 start) len eat (plusAddr# start o) v else fail {-# INLINE unpacker #-} pw8 :: Addr# -> Ptr Word8 pw8 addr = Ptr addr {-# INLINE pw8 #-}