Skip to content

Commit

Permalink
added SpecialStrings for customizing special IEEE754 float values
Browse files Browse the repository at this point in the history
  • Loading branch information
BebeSparkelSparkel committed Dec 27, 2023
1 parent 7e11412 commit 62d5070
Show file tree
Hide file tree
Showing 4 changed files with 58 additions and 15 deletions.
41 changes: 36 additions & 5 deletions Data/ByteString/Builder/RealFloat.hs
Original file line number Diff line number Diff line change
Expand Up @@ -62,7 +62,11 @@ module Data.ByteString.Builder.RealFloat

-- * Custom formatting
, formatFloat
, formatFloatSpecials
, formatDouble
, formatDoubleSpecials
, R.SpecialStrings(..)
, defaultSpecialStrings
, FloatFormat
, standard
, standardDefaultPrecision
Expand Down Expand Up @@ -161,7 +165,15 @@ data FormatMode
-- @since 0.11.2.0
{-# INLINABLE formatFloat #-}
formatFloat :: FloatFormat -> Float -> Builder
formatFloat (MkFloatFormat fmt prec) = \f ->
formatFloat = formatFloatSpecials defaultSpecialStrings

-- TODO: support precision argument for FGeneric and FScientific
-- | Like formatFloat but allows custom strings for the special values.
--
-- @since ??????
{-# INLINABLE formatFloatSpecials #-}
formatFloatSpecials :: R.SpecialStrings -> FloatFormat -> Float -> Builder
formatFloatSpecials ss (MkFloatFormat fmt prec) = \f ->
let (RF.FloatingDecimal m e) = RF.f2Intermediate f
e' = R.int32ToInt e + R.decimalLength9 m in
case fmt of
Expand All @@ -172,13 +184,12 @@ formatFloat (MkFloatFormat fmt prec) = \f ->
if e' >= 0 && e' <= 7
then sign f `mappend` showStandard (R.word32ToWord64 m) e' prec
else BP.primBounded (R.toCharsScientific (f < 0) m e) ()
FScientific -> RF.f2s f
FScientific -> RF.f2s ss f
FStandard ->
case specialStr f of
Just b -> b
Nothing -> sign f `mappend` showStandard (R.word32ToWord64 m) e' prec

-- TODO: support precision argument for FGeneric and FScientific
-- | Returns a rendered Double. Returns the \'shortest\' representation in
-- scientific notation and takes an optional precision argument in standard
-- notation. Also see `doubleDec`.
Expand All @@ -204,7 +215,15 @@ formatFloat (MkFloatFormat fmt prec) = \f ->
-- @since 0.11.2.0
{-# INLINABLE formatDouble #-}
formatDouble :: FloatFormat -> Double -> Builder
formatDouble (MkFloatFormat fmt prec) = \f ->
formatDouble = formatDoubleSpecials defaultSpecialStrings

-- TODO: support precision argument for FGeneric and FScientific
-- | Like formatDouble but allows custom strings for the special values.
--
-- @since ??????
{-# INLINABLE formatDoubleSpecials #-}
formatDoubleSpecials :: R.SpecialStrings -> FloatFormat -> Double -> Builder
formatDoubleSpecials ss (MkFloatFormat fmt prec) = \f ->
let (RD.FloatingDecimal m e) = RD.d2Intermediate f
e' = R.int32ToInt e + R.decimalLength17 m in
case fmt of
Expand All @@ -215,12 +234,24 @@ formatDouble (MkFloatFormat fmt prec) = \f ->
if e' >= 0 && e' <= 7
then sign f `mappend` showStandard m e' prec
else BP.primBounded (R.toCharsScientific (f < 0) m e) ()
FScientific -> RD.d2s f
FScientific -> RD.d2s ss f
FStandard ->
case specialStr f of
Just b -> b
Nothing -> sign f `mappend` showStandard m e' prec

-- | Standard strings for special values of IEEE754 floating point values.
--
-- @since ?????
defaultSpecialStrings :: R.SpecialStrings
defaultSpecialStrings = R.SpecialStrings
{ R.nan = "NaN"
, R.positiveInfinity = "Infinity"
, R.negativeInfinity = "-Infinity"
, R.positiveZero = "0.0e0"
, R.negativeZero = "-0.0e0"
}

-- | Char7 encode a 'Char'.
{-# INLINE char7 #-}
char7 :: Char -> Builder
Expand Down
4 changes: 2 additions & 2 deletions Data/ByteString/Builder/RealFloat/D2S.hs
Original file line number Diff line number Diff line change
Expand Up @@ -222,8 +222,8 @@ d2s' formatter specialFormatter d =
in formatter sign m e

-- | Render a Double in scientific notation
d2s :: Double -> Builder
d2s d = primBounded (d2s' toCharsScientific toCharsNonNumbersAndZero d) ()
d2s :: SpecialStrings -> Double -> Builder
d2s ss d = primBounded (d2s' toCharsScientific (toCharsNonNumbersAndZero ss) d) ()

-- | Returns the decimal representation of a Double. NaN and Infinity will
-- return `FloatingDecimal 0 0`
Expand Down
4 changes: 2 additions & 2 deletions Data/ByteString/Builder/RealFloat/F2S.hs
Original file line number Diff line number Diff line change
Expand Up @@ -202,8 +202,8 @@ f2s' formatter specialFormatter f =
in formatter sign m e

-- | Render a Float in scientific notation
f2s :: Float -> Builder
f2s f = primBounded (f2s' toCharsScientific toCharsNonNumbersAndZero f) ()
f2s :: SpecialStrings -> Float -> Builder
f2s ss f = primBounded (f2s' toCharsScientific (toCharsNonNumbersAndZero ss) f) ()

-- | Returns the decimal representation of a Float. NaN and Infinity will
-- return `FloatingDecimal 0 0`
Expand Down
24 changes: 18 additions & 6 deletions Data/ByteString/Builder/RealFloat/Internal.hs
Original file line number Diff line number Diff line change
Expand Up @@ -22,6 +22,7 @@
module Data.ByteString.Builder.RealFloat.Internal
( mask
, NonNumbersAndZero(..)
, SpecialStrings(..)
, toCharsNonNumbersAndZero
, decimalLength9
, decimalLength17
Expand Down Expand Up @@ -69,6 +70,7 @@ module Data.ByteString.Builder.RealFloat.Internal

import Control.Monad (foldM)
import Data.Bits (Bits(..), FiniteBits(..))
import Data.Bool (bool)
import Data.ByteString.Internal (c2w)
import Data.ByteString.Builder.Prim.Internal (BoundedPrim, boundedPrim)
import Data.ByteString.Builder.RealFloat.TableGenerator
Expand Down Expand Up @@ -246,13 +248,23 @@ data NonNumbersAndZero = NonNumbersAndZero
, mantissa_non_zero :: Bool
}

-- | Strings for special values of IEEE754 floating point values.
--
-- @since ?????
data SpecialStrings = SpecialStrings
{ nan :: String
, positiveInfinity :: String
, negativeInfinity :: String
, positiveZero :: String
, negativeZero :: String
} deriving Show

-- | Renders NonNumbersAndZero into bounded primitive
toCharsNonNumbersAndZero :: NonNumbersAndZero -> BoundedPrim ()
toCharsNonNumbersAndZero NonNumbersAndZero{..}
| mantissa_non_zero = boundString "NaN"
| exponent_all_one = boundString $ signStr ++ "Infinity"
| otherwise = boundString $ signStr ++ "0.0e0"
where signStr = if negative then "-" else ""
toCharsNonNumbersAndZero :: SpecialStrings -> NonNumbersAndZero -> BoundedPrim ()
toCharsNonNumbersAndZero SpecialStrings{..} NonNumbersAndZero{..}
| mantissa_non_zero = boundString nan
| exponent_all_one = bool (boundString positiveInfinity) (boundString negativeInfinity) negative
| otherwise = bool (boundString positiveZero) (boundString negativeZero) negative

-- | Part of the calculation on whether to round up the decimal representation.
-- This is currently a constant function to match behavior in Base `show` and
Expand Down

0 comments on commit 62d5070

Please sign in to comment.