From 70bcdcf9515661ccac1aa7ba57f77e5a9c0e7bcf Mon Sep 17 00:00:00 2001 From: William Rusnack Date: Sat, 20 Jan 2024 10:49:58 -0500 Subject: [PATCH] added an explicit exponent sign got FGeneric and FScientific so that a + will prepend the exponent digits if positive --- Data/ByteString/Builder/RealFloat.hs | 26 +++++++++++----- Data/ByteString/Builder/RealFloat/Internal.hs | 31 +++++++++++++------ .../builder/Data/ByteString/Builder/Tests.hs | 15 ++++++++- 3 files changed, 55 insertions(+), 17 deletions(-) diff --git a/Data/ByteString/Builder/RealFloat.hs b/Data/ByteString/Builder/RealFloat.hs index 2d33f00d5..891b7c80a 100644 --- a/Data/ByteString/Builder/RealFloat.hs +++ b/Data/ByteString/Builder/RealFloat.hs @@ -79,6 +79,7 @@ module Data.ByteString.Builder.RealFloat , standardDefaultPrecision , scientific , scientificZeroPaddedExponent + , scientificExplicitExponentSign , generic ) where @@ -143,7 +144,7 @@ standardDefaultPrecision = FStandard -- -- @since 0.11.2.0 scientific :: FloatFormat a -scientific = fScientific 'e' scientificSpecialStrings False +scientific = fScientific 'e' scientificSpecialStrings False False -- | Like @scientific@ but has a zero padded exponent. scientificZeroPaddedExponent :: forall a. ZeroPadCount a => FloatFormat a @@ -157,6 +158,17 @@ scientificZeroPaddedExponent = scientific where positiveZero = "0.0e" <> replicate (zeroPadCount @a) '0' +scientificExplicitExponentSign :: FloatFormat a +scientificExplicitExponentSign = scientific + { expoExplicitSign = True + , specials = scientificSpecialStrings + { positiveZero + , negativeZero = '-' : positiveZero + } + } + where + positiveZero = "0.0e+0" + class ZeroPadCount a where zeroPadCount :: Int instance ZeroPadCount Float where zeroPadCount = 2 instance ZeroPadCount Double where zeroPadCount = 3 @@ -178,7 +190,7 @@ standardSpecialStrings = scientificSpecialStrings -- -- @since 0.11.2.0 generic :: FloatFormat a -generic = fGeneric 'e' Nothing (0,7) standardSpecialStrings False +generic = fGeneric 'e' Nothing (0,7) standardSpecialStrings False False -- TODO: support precision argument for FGeneric and FScientific -- | Returns a rendered Float. Returns the \'shortest\' representation in @@ -266,13 +278,13 @@ formatFloating :: forall a mw ew ei. formatFloating fmt f = case fmt of FGeneric {stdExpoRange = (minExpo,maxExpo), ..} -> specialsOr specials if e' >= minExpo && e' <= maxExpo - then std precision - else sci expoZeroPad eE - FScientific {..} -> specialsOr specials $ sci expoZeroPad eE + then std precision + else sci eE expoZeroPad expoExplicitSign + FScientific {..} -> specialsOr specials $ sci eE expoZeroPad expoExplicitSign FStandard {..} -> specialsOr specials $ std precision where - sci expoZeroPad eE = BP.primBounded (R.toCharsScientific @a Proxy expoZeroPad eE sign m e) () - std precision = printSign f `mappend` showStandard (toWord64 m) e' precision + sci expoZeroPad expoExplicitSign eE = BP.primBounded (R.toCharsScientific @a Proxy expoZeroPad expoExplicitSign eE sign m e) () + std precision = printSign f <> showStandard (toWord64 m) e' precision e' = R.toInt e + R.decimalLength m R.FloatingDecimal m e = toD @a mantissa expo (sign, mantissa, expo) = R.breakdown f diff --git a/Data/ByteString/Builder/RealFloat/Internal.hs b/Data/ByteString/Builder/RealFloat/Internal.hs index 4b9ec0081..3789d19c6 100644 --- a/Data/ByteString/Builder/RealFloat/Internal.hs +++ b/Data/ByteString/Builder/RealFloat/Internal.hs @@ -757,6 +757,9 @@ asciiDot = ord '.' asciiMinus :: Int asciiMinus = ord '-' +asciiPlus :: Int +asciiPlus = ord '+' + -- | Convert a single-digit number to the ascii ordinal e.g '1' -> 0x31 toAscii :: Word# -> Word# toAscii a = a `plusWord#` word8ToWord# (asciiRaw asciiZero) @@ -918,11 +921,17 @@ writeSign ptr True s1 = in (# ptr `plusAddr#` 1#, s2 #) writeSign ptr False s = (# ptr, s #) +writeExpoSign :: Bool -> Addr# -> Bool -> State# d -> (# Addr#, State# d #) +writeExpoSign False = writeSign +writeExpoSign True = \ptr sign s1 -> + let s2 = poke ptr (asciiRaw if sign then asciiMinus else asciiPlus) s1 + in (# ptr `plusAddr#` 1#, s2 #) + -- | Returns the decimal representation of a floating point number in -- scientific (exponential) notation {-# INLINABLE toCharsScientific #-} -{-# SPECIALIZE toCharsScientific :: Proxy Float -> Bool -> Word8# -> Bool -> Word32 -> Int32 -> BoundedPrim () #-} -{-# SPECIALIZE toCharsScientific :: Proxy Double -> Bool -> Word8# -> Bool -> Word64 -> Int32 -> BoundedPrim () #-} +{-# SPECIALIZE toCharsScientific :: Proxy Float -> Word8# -> Bool -> Bool -> Bool -> Word32 -> Int32 -> BoundedPrim () #-} +{-# SPECIALIZE toCharsScientific :: Proxy Double -> Word8# -> Bool -> Bool -> Bool -> Word64 -> Int32 -> BoundedPrim () #-} toCharsScientific :: forall a mw ei. ( MaxEncodedLength a , WriteZeroPaddedExponent a @@ -932,15 +941,16 @@ toCharsScientific :: forall a mw ei. , Integral ei , ToInt ei , FromInt ei - ) => Proxy a -> Bool -> Word8# -> Bool -> mw -> ei -> BoundedPrim () -toCharsScientific _ expoZeroPad eE !sign !mantissa !expo = boundedPrim (maxEncodedLength @a) $ \_ !(Ptr p0)-> do + ) => Proxy a -> Word8# -> Bool -> Bool -> Bool -> mw -> ei -> BoundedPrim () +toCharsScientific _ eE !expoZeroPad !expoExplicitSign !sign !mantissa !expo = + boundedPrim (maxEncodedLength @a) $ \_ !(Ptr p0)-> do let !olength@(I# ol) = decimalLength mantissa !expo' = expo + fromInt olength - 1 IO $ \s1 -> let !(# p1, s2 #) = writeSign p0 sign s1 !(# p2, s3 #) = writeMantissa p1 ol mantissa s2 s4 = poke p2 eE s3 - !(# p3, s5 #) = writeSign (p2 `plusAddr#` 1#) (expo' < 0) s4 + !(# p3, s5 #) = writeExpoSign expoExplicitSign (p2 `plusAddr#` 1#) (expo' < 0) s4 !(# p4, s6 #) = writeExponent p3 (abs expo') s5 in (# s6, (Ptr p4) #) where @@ -1018,6 +1028,7 @@ data FloatFormat a { eE :: Word8# , specials :: SpecialStrings , expoZeroPad :: Bool -- ^ pad the exponent with zeros + , expoExplicitSign :: Bool -- ^ Always prepend a + or - to the exponent } -- | standard notation with `Maybe Int` digits after the decimal | FStandard @@ -1031,15 +1042,17 @@ data FloatFormat a , stdExpoRange :: (Int, Int) , specials :: SpecialStrings , expoZeroPad :: Bool -- ^ pad the exponent with zeros + , expoExplicitSign :: Bool -- ^ Always prepend a + or - to the exponent } deriving Show -fScientific :: Char -> SpecialStrings -> Bool -> FloatFormat a -fScientific eE specials expoZeroPad = FScientific +fScientific :: Char -> SpecialStrings -> Bool -> Bool -> FloatFormat a +fScientific eE specials expoZeroPad expoExplicitSign = FScientific { eE = asciiRaw $ ord eE , .. } -fGeneric :: Char -> Maybe Int -> (Int, Int) -> SpecialStrings -> Bool -> FloatFormat a -fGeneric eE precision stdExpoRange specials expoZeroPad = FGeneric +fGeneric :: Char -> Maybe Int -> (Int, Int) -> SpecialStrings -> Bool -> Bool -> FloatFormat a +fGeneric eE precision stdExpoRange specials expoZeroPad expoExplicitSign = FGeneric { eE = asciiRaw $ ord eE , .. } + diff --git a/tests/builder/Data/ByteString/Builder/Tests.hs b/tests/builder/Data/ByteString/Builder/Tests.hs index 90d9177f7..aabe40976 100644 --- a/tests/builder/Data/ByteString/Builder/Tests.hs +++ b/tests/builder/Data/ByteString/Builder/Tests.hs @@ -30,6 +30,7 @@ import Control.Monad.Trans.Writer (WriterT, execWriterT, tell) import Foreign (minusPtr) import Data.Char (chr, isDigit) +import Data.Bifunctor (second) import Data.Bits ((.|.), shiftL) import Data.Foldable import Data.Semigroup (Semigroup(..)) @@ -53,7 +54,7 @@ import Control.Exception (evaluate) import System.IO (openTempFile, hPutStr, hClose, hSetBinaryMode, hSetEncoding, utf8, hSetNewlineMode, noNewlineTranslation) import Foreign (ForeignPtr, withForeignPtr, castPtr) import Foreign.C.String (withCString) -import Numeric (showFFloat) +import Numeric (showFFloat, showEFloat) import System.Posix.Internals (c_unlink) import Test.Tasty (TestTree, TestName, testGroup) @@ -761,6 +762,18 @@ testsFloating = testGroup "RealFloat" $ indexEnd (padLen + 1) == 'e' || indexEnd (padLen + 1) == '-' && indexEnd (padLen + 2) == 'e' ] + , testMatches "explict exponent sign" + (formatFloat (scientificExplicitExponentSign)) + (\f -> (if abs f >= 1 || abs f == 0 + then uncurry (<>) . second (("e+" <>) . tail) . break (== 'e') + else id) + $ showEFloat Nothing f "") + [ ( 0 , "0.0e+0" ) + , ( -0 , "-0.0e+0" ) + , ( 1.0 , "1.0e+0" ) + , ( 20.0 , "2.0e+1" ) + , ( 0.3 , "3.0e-1" ) + ] , testMatches "f2sPowersOf10" floatDec show $ fmap asShowRef [read ("1.0e" ++ show x) :: Float | x <- [-46..39 :: Int]] ]