Skip to content
New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Padded exponent #644

Closed
Closed
Show file tree
Hide file tree
Changes from all commits
Commits
Show all changes
34 commits
Select commit Hold shift + click to select a range
332bcf6
improved RealFloat benchmarks
BebeSparkelSparkel Jan 9, 2024
36241cc
better names for RealFloat tests
BebeSparkelSparkel Jan 9, 2024
b3a2276
averaged realfloat specal strings instead of checking each special va…
BebeSparkelSparkel Jan 12, 2024
9a86e45
improved test and add bench for small doubles
BebeSparkelSparkel Jan 12, 2024
a0998bf
improved tests for FStandard
BebeSparkelSparkel Jan 15, 2024
ce7d20e
added better labels to real float tests
BebeSparkelSparkel Jan 15, 2024
b98fc5d
differencated special values from basic values and Float from Double
BebeSparkelSparkel Jan 15, 2024
edd64cd
put float test in the correct group
BebeSparkelSparkel Jan 16, 2024
b20d7a6
combined FloatFormat and FormatMode
BebeSparkelSparkel Jan 7, 2024
b22b6b3
customized FGeneric exponent range
BebeSparkelSparkel Jan 7, 2024
37e8d22
FScientific now has a selectable case E
BebeSparkelSparkel Jan 7, 2024
1b16c67
generaized FloatingDecimal and intermediate
BebeSparkelSparkel Jan 7, 2024
d3cdedc
generailized decimalLength
BebeSparkelSparkel Jan 7, 2024
e11b303
generalized mantissa to Word64
BebeSparkelSparkel Jan 7, 2024
aa15ac2
generalized f2s and d2s
BebeSparkelSparkel Jan 7, 2024
053f87a
added formatFloating which combines the logic of formatFlat and forma…
BebeSparkelSparkel Jan 7, 2024
40f90a4
added SpecialStrings for scientific non-normal float values
BebeSparkelSparkel Jan 7, 2024
b1e3e30
added SpecialStrings to standard floating point non-normal values
BebeSparkelSparkel Jan 7, 2024
945916b
RealFloat optimizations
BebeSparkelSparkel Jan 9, 2024
08c5050
generalized breakdown
BebeSparkelSparkel Jan 9, 2024
d87507b
added some INLINABLE to RealFloat.Internal
BebeSparkelSparkel Jan 9, 2024
0ea0a35
toCharsNonNumbersAndZero now accepts the sign, mantissa, and exponent…
BebeSparkelSparkel Jan 9, 2024
e181e2a
toCharsNonNumberAndZero now takes the float and only uses bit operati…
BebeSparkelSparkel Jan 11, 2024
cbeeef8
removed f2s d2s
BebeSparkelSparkel Jan 12, 2024
bf287a5
removed f2s f2s' f2Intermediate
BebeSparkelSparkel Jan 12, 2024
f399638
removed specialStr and replaced with improved version of toCharsNonNu…
BebeSparkelSparkel Jan 11, 2024
d9ebd68
clean up
BebeSparkelSparkel Jan 12, 2024
bd2b685
cleaned up function formatFloating
BebeSparkelSparkel Jan 12, 2024
a9cbf58
fixed precison printing of zero and neg zero for FStandard
BebeSparkelSparkel Jan 14, 2024
bbd4f76
labels for RealFloat format parameters
BebeSparkelSparkel Jan 16, 2024
a1e556e
fix possible overflow error when converting String to Builder
BebeSparkelSparkel Jan 16, 2024
182d76f
specialized maxEncodeLength to Float and Double
BebeSparkelSparkel Jan 16, 2024
8479796
moved FloatFormat to Internal so that it can be exported and users ca…
BebeSparkelSparkel Jan 16, 2024
a2c7324
added zero padded exponent for scientific floating builder
BebeSparkelSparkel Jan 16, 2024
File filter

Filter by extension

Filter by extension

Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
200 changes: 125 additions & 75 deletions Data/ByteString/Builder/RealFloat.hs
Original file line number Diff line number Diff line change
@@ -1,3 +1,14 @@
{-# LANGUAGE MagicHash #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE ExplicitForAll #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE BlockArguments #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE AllowAmbiguousTypes #-}
-- |
-- Module : Data.ByteString.Builder.RealFloat
-- Copyright : (c) Lawrence Wu 2021
Expand Down Expand Up @@ -67,17 +78,23 @@
, standard
, standardDefaultPrecision
, scientific
, scientificZeroPaddedExponent
, generic
) where

import Data.ByteString.Builder.Internal (Builder)
import qualified Data.ByteString.Builder.RealFloat.Internal as R
import Data.ByteString.Builder.RealFloat.Internal (FloatFormat(..), fScientific, fGeneric)
import Data.ByteString.Builder.RealFloat.Internal (positiveZero, negativeZero)

Check failure on line 88 in Data/ByteString/Builder/RealFloat.hs

View workflow job for this annotation

GitHub Actions / build (ubuntu-latest, 9.8)

Module ‘Data.ByteString.Builder.RealFloat.Internal’ does not export ‘positiveZero’.

Check failure on line 88 in Data/ByteString/Builder/RealFloat.hs

View workflow job for this annotation

GitHub Actions / build (ubuntu-latest, 9.8)

Module ‘Data.ByteString.Builder.RealFloat.Internal’ does not export ‘negativeZero’.
import qualified Data.ByteString.Builder.RealFloat.F2S as RF
import qualified Data.ByteString.Builder.RealFloat.D2S as RD
import qualified Data.ByteString.Builder.Prim as BP
import GHC.Float (roundTo)
import GHC.Word (Word64)
import GHC.Word (Word32, Word64)
import GHC.Show (intToDigit)
import Data.Bits (Bits)
import Data.Proxy (Proxy(Proxy))
import Data.Maybe (fromMaybe)

-- | Returns a rendered Float. Matches `show` in displaying in standard or
-- scientific notation
Expand All @@ -87,7 +104,7 @@
-- @
{-# INLINABLE floatDec #-}
floatDec :: Float -> Builder
floatDec = formatFloat generic
floatDec = formatFloating generic

-- | Returns a rendered Double. Matches `show` in displaying in standard or
-- scientific notation
Expand All @@ -97,43 +114,71 @@
-- @
{-# INLINABLE doubleDec #-}
doubleDec :: Double -> Builder
doubleDec = formatDouble generic

-- | Format type for use with `formatFloat` and `formatDouble`.
--
-- @since 0.11.2.0
data FloatFormat = MkFloatFormat FormatMode (Maybe Int)
doubleDec = formatFloating generic

-- | Standard notation with `n` decimal places
--
-- @since 0.11.2.0
standard :: Int -> FloatFormat
standard n = MkFloatFormat FStandard (Just n)
standard :: Int -> FloatFormat a
standard n = FStandard
{ precision = Just n
, specials = standardSpecialStrings {positiveZero, negativeZero}
}
where
positiveZero = if n == 0
then "0"
else "0." <> replicate n '0'
negativeZero = "-" <> positiveZero

-- | Standard notation with the \'default precision\' (decimal places matching `show`)
--
-- @since 0.11.2.0
standardDefaultPrecision :: FloatFormat
standardDefaultPrecision = MkFloatFormat FStandard Nothing
standardDefaultPrecision :: FloatFormat a
standardDefaultPrecision = FStandard
{ precision = Nothing
, specials = standardSpecialStrings
}

-- | Scientific notation with \'default precision\' (decimal places matching `show`)
--
-- @since 0.11.2.0
scientific :: FloatFormat
scientific = MkFloatFormat FScientific Nothing
scientific :: FloatFormat a
scientific = fScientific 'e' scientificSpecialStrings False

-- | Like @scientific@ but has a zero padded exponent.
scientificZeroPaddedExponent :: forall a. ZeroPadCount a => FloatFormat a
scientificZeroPaddedExponent = scientific
{ expoZeroPad = True
, specials = scientificSpecialStrings
{ positiveZero
, negativeZero = '-' : positiveZero
}
}
where
positiveZero = "0.0e" <> replicate (zeroPadCount @a) '0'

class ZeroPadCount a where zeroPadCount :: Int
instance ZeroPadCount Float where zeroPadCount = 2
instance ZeroPadCount Double where zeroPadCount = 3

scientificSpecialStrings, standardSpecialStrings :: R.SpecialStrings
scientificSpecialStrings = R.SpecialStrings
{ R.nan = "NaN"
, R.positiveInfinity = "Infinity"
, R.negativeInfinity = "-Infinity"
, R.positiveZero = "0.0e0"
, R.negativeZero = "-0.0e0"
}
standardSpecialStrings = scientificSpecialStrings
{ R.positiveZero = "0.0"
, R.negativeZero = "-0.0"
}

-- | Standard or scientific notation depending on the exponent. Matches `show`
--
-- @since 0.11.2.0
generic :: FloatFormat
generic = MkFloatFormat FGeneric Nothing

-- | ByteString float-to-string format
data FormatMode
= FScientific -- ^ scientific notation
| FStandard -- ^ standard notation with `Maybe Int` digits after the decimal
| FGeneric -- ^ dispatches to scientific or standard notation based on the exponent
deriving Show
generic :: FloatFormat a
generic = fGeneric 'e' Nothing (0,7) standardSpecialStrings False

-- TODO: support precision argument for FGeneric and FScientific
-- | Returns a rendered Float. Returns the \'shortest\' representation in
Expand All @@ -160,23 +205,8 @@
--
-- @since 0.11.2.0
{-# INLINABLE formatFloat #-}
formatFloat :: FloatFormat -> Float -> Builder
formatFloat (MkFloatFormat fmt prec) = \f ->
let (RF.FloatingDecimal m e) = RF.f2Intermediate f
e' = R.int32ToInt e + R.decimalLength9 m in
case fmt of
FGeneric ->
case specialStr f of
Just b -> b
Nothing ->
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
FStandard ->
case specialStr f of
Just b -> b
Nothing -> sign f `mappend` showStandard (R.word32ToWord64 m) e' prec
formatFloat :: FloatFormat Float -> Float -> Builder
formatFloat = formatFloating

-- TODO: support precision argument for FGeneric and FScientific
-- | Returns a rendered Double. Returns the \'shortest\' representation in
Expand All @@ -203,47 +233,67 @@
--
-- @since 0.11.2.0
{-# INLINABLE formatDouble #-}
formatDouble :: FloatFormat -> Double -> Builder
formatDouble (MkFloatFormat fmt prec) = \f ->
let (RD.FloatingDecimal m e) = RD.d2Intermediate f
e' = R.int32ToInt e + R.decimalLength17 m in
case fmt of
FGeneric ->
case specialStr f of
Just b -> b
Nothing ->
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
FStandard ->
case specialStr f of
Just b -> b
Nothing -> sign f `mappend` showStandard m e' prec
formatDouble :: FloatFormat Double -> Double -> Builder
formatDouble = formatFloating

{-# INLINABLE formatFloating #-}
{-# SPECIALIZE formatFloating :: FloatFormat Float -> Float -> Builder #-}
{-# SPECIALIZE formatFloating :: FloatFormat Double -> Double -> Builder #-}
formatFloating :: forall a mw ew ei.
-- a
--( ToS a
( ToD a
, RealFloat a
, R.ExponentBits a
, R.MantissaBits a
, R.CastToWord a
, R.MaxEncodedLength a
, R.WriteZeroPaddedExponent a
-- mantissa
, mw ~ R.MantissaWord a
, R.Mantissa mw
, ToWord64 mw
, R.DecimalLength mw
-- exponent
, ew ~ R.ExponentWord a
, Integral ew
, Bits ew
, ei ~ R.ExponentInt a
, R.ToInt ei
, Integral ei
, R.FromInt ei
) => FloatFormat a -> a -> Builder
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
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
e' = R.toInt e + R.decimalLength m
R.FloatingDecimal m e = toD @a mantissa expo
(sign, mantissa, expo) = R.breakdown f
specialsOr specials = flip fromMaybe $ R.toCharsNonNumbersAndZero specials f

class ToWord64 a where toWord64 :: a -> Word64
instance ToWord64 Word32 where toWord64 = R.word32ToWord64
instance ToWord64 Word64 where toWord64 = id

class ToD a where toD :: R.MantissaWord a -> R.ExponentWord a -> R.FloatingDecimal a
instance ToD Float where toD = RF.f2d
instance ToD Double where toD = RD.d2d

-- | Char7 encode a 'Char'.
{-# INLINE char7 #-}
char7 :: Char -> Builder
char7 = BP.primFixed BP.char7

-- | Char7 encode a 'String'.
{-# INLINE string7 #-}
string7 :: String -> Builder
string7 = BP.primMapListFixed BP.char7

-- | Encodes a `-` if input is negative
sign :: RealFloat a => a -> Builder
sign f = if f < 0 then char7 '-' else mempty

-- | Special rendering for Nan, Infinity, and 0. See
-- RealFloat.Internal.NonNumbersAndZero
specialStr :: RealFloat a => a -> Maybe Builder
specialStr f
| isNaN f = Just $ string7 "NaN"
| isInfinite f = Just $ sign f `mappend` string7 "Infinity"
| isNegativeZero f = Just $ string7 "-0.0"
| f == 0 = Just $ string7 "0.0"
| otherwise = Nothing
printSign :: RealFloat a => a -> Builder
printSign f = if f < 0 then char7 '-' else mempty

-- | Returns a list of decimal digits in a Word64
digits :: Word64 -> [Int]
Expand All @@ -259,7 +309,7 @@
Nothing
| e <= 0 -> char7 '0'
`mappend` char7 '.'
`mappend` string7 (replicate (-e) '0')
`mappend` R.string7 (replicate (-e) '0')
`mappend` mconcat (digitsToBuilder ds)
| otherwise ->
let f 0 s rs = mk0 (reverse s) `mappend` char7 '.' `mappend` mk0 rs
Expand Down
Loading
Loading