Skip to content

Commit ce6e47c

Browse files
BebeSparkelSparkelBebeSparkelSparkel
committed
moved FloatFormat to Internal so that it can be exported and users can manipulate it beyond the regular formants
1 parent ed08885 commit ce6e47c

File tree

4 files changed

+64
-60
lines changed

4 files changed

+64
-60
lines changed

‎Data/ByteString/Builder/RealFloat.hs‎

Lines changed: 1 addition & 39 deletions
Original file line numberDiff line numberDiff line change
@@ -8,8 +8,6 @@
88
{-# LANGUAGE TypeApplications #-}
99
{-# LANGUAGE BlockArguments #-}
1010
{-# LANGUAGE NamedFieldPuns #-}
11-
{-# LANGUAGE NoFieldSelectors #-}
12-
{-# LANGUAGE DuplicateRecordFields #-}
1311
-- |
1412
-- Module : Data.ByteString.Builder.RealFloat
1513
-- Copyright : (c) Lawrence Wu 2021
@@ -84,15 +82,14 @@ module Data.ByteString.Builder.RealFloat
8482

8583
import Data.ByteString.Builder.Internal (Builder)
8684
import qualified Data.ByteString.Builder.RealFloat.Internal as R
85+
import Data.ByteString.Builder.RealFloat.Internal (FloatFormat(..), fScientific, fGeneric)
8786
import Data.ByteString.Builder.RealFloat.Internal (positiveZero, negativeZero)
8887
import qualified Data.ByteString.Builder.RealFloat.F2S as RF
8988
import qualified Data.ByteString.Builder.RealFloat.D2S as RD
9089
import qualified Data.ByteString.Builder.Prim as BP
9190
import GHC.Float (roundTo)
9291
import GHC.Word (Word32, Word64)
9392
import GHC.Show (intToDigit)
94-
import Data.Char (ord)
95-
import GHC.Prim (Word8#)
9693
import Data.Bits (Bits)
9794
import Data.Proxy (Proxy(Proxy))
9895
import Data.Maybe (fromMaybe)
@@ -117,41 +114,6 @@ floatDec = formatFloating generic
117114
doubleDec :: Double -> Builder
118115
doubleDec = formatFloating generic
119116

120-
-- | Format type for use with `formatFloat` and `formatDouble`.
121-
--
122-
-- @since 0.11.2.0
123-
data FloatFormat
124-
-- | scientific notation
125-
= FScientific
126-
{ eE :: Word8#
127-
, specials :: R.SpecialStrings
128-
}
129-
-- | standard notation with `Maybe Int` digits after the decimal
130-
| FStandard
131-
{ precision :: Maybe Int
132-
, specials :: R.SpecialStrings
133-
}
134-
-- | dispatches to scientific or standard notation based on the exponent
135-
| FGeneric
136-
{ eE :: Word8#
137-
, precision :: Maybe Int
138-
, stdExpoRange :: (Int, Int)
139-
, specials :: R.SpecialStrings
140-
}
141-
deriving Show
142-
143-
fScientific :: Char -> R.SpecialStrings -> FloatFormat
144-
fScientific eE specials = FScientific
145-
{ eE = R.asciiRaw $ ord eE
146-
, specials
147-
}
148-
149-
fGeneric :: Char -> Maybe Int -> (Int, Int) -> R.SpecialStrings -> FloatFormat
150-
fGeneric eE precision stdExpoRange specials = FGeneric
151-
{ eE = R.asciiRaw $ ord eE
152-
, ..
153-
}
154-
155117
-- | Standard notation with `n` decimal places
156118
--
157119
-- @since 0.11.2.0

‎Data/ByteString/Builder/RealFloat/D2S.hs‎

Lines changed: 3 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -2,6 +2,7 @@
22
{-# LANGUAGE MagicHash #-}
33
{-# LANGUAGE ScopedTypeVariables #-}
44
{-# LANGUAGE TypeApplications #-}
5+
{-# LANGUAGE NamedFieldPuns #-}
56
-- |
67
-- Module : Data.ByteString.Builder.RealFloat.D2S
78
-- Copyright : (c) Lawrence Wu 2021
@@ -171,15 +172,15 @@ d2dGeneral m e =
171172
!v = 4 * mf
172173
!w = 4 * mf + 2
173174
-- Step 3. convert to decimal power base
174-
!(state, e10) =
175+
!(state@BoundsState{vvIsTrailingZeros, vuIsTrailingZeros}, e10) =
175176
if e2 >= 0
176177
then d2dGT e2 u v w
177178
else d2dLT e2 u v w
178179
-- Step 4: Find the shortest decimal representation in the interval of
179180
-- valid representations.
180181
!(output, removed) =
181182
let rounded = closestCorrectlyRounded (acceptBounds v)
182-
in first rounded $ if vvIsTrailingZeros state || vuIsTrailingZeros state
183+
in first rounded $ if vvIsTrailingZeros || vuIsTrailingZeros
183184
then trimTrailing state
184185
else trimNoTrailing state
185186
!e' = e10 + removed

‎Data/ByteString/Builder/RealFloat/F2S.hs‎

Lines changed: 3 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -1,6 +1,7 @@
11
{-# LANGUAGE ScopedTypeVariables #-}
22
{-# LANGUAGE BangPatterns, MagicHash #-}
33
{-# LANGUAGE TypeApplications #-}
4+
{-# LANGUAGE NamedFieldPuns #-}
45
-- |
56
-- Module : Data.ByteString.Builder.RealFloat.F2S
67
-- Copyright : (c) Lawrence Wu 2021
@@ -150,15 +151,15 @@ f2d m e =
150151
!v = 4 * mf
151152
!w = 4 * mf + 2
152153
-- Step 3. convert to decimal power base
153-
!(state, e10) =
154+
!(state@BoundsState{vvIsTrailingZeros, vuIsTrailingZeros}, e10) =
154155
if e2 >= 0
155156
then f2dGT e2 u v w
156157
else f2dLT e2 u v w
157158
-- Step 4: Find the shortest decimal representation in the interval of
158159
-- valid representations.
159160
!(output, removed) =
160161
let rounded = closestCorrectlyRounded (acceptBounds v)
161-
in first rounded $ if vvIsTrailingZeros state || vuIsTrailingZeros state
162+
in first rounded $ if vvIsTrailingZeros || vuIsTrailingZeros
162163
then trimTrailing state
163164
else trimNoTrailing state
164165
!e' = e10 + removed

‎Data/ByteString/Builder/RealFloat/Internal.hs‎

Lines changed: 57 additions & 17 deletions
Original file line numberDiff line numberDiff line change
@@ -9,6 +9,9 @@
99
{-# LANGUAGE TypeApplications #-}
1010
{-# LANGUAGE AllowAmbiguousTypes #-}
1111
{-# LANGUAGE BlockArguments #-}
12+
{-# LANGUAGE NamedFieldPuns #-}
13+
{-# LANGUAGE NoFieldSelectors #-}
14+
{-# LANGUAGE DuplicateRecordFields #-}
1215
-- |
1316
-- Module : Data.ByteString.Builder.RealFloat.Internal
1417
-- Copyright : (c) Lawrence Wu 2021
@@ -83,6 +86,9 @@ module Data.ByteString.Builder.RealFloat.Internal
8386
, CastToWord(..)
8487
, ToInt(..)
8588
, FromInt(..)
89+
, FloatFormat(..)
90+
, fScientific
91+
, fGeneric
8692

8793
, module Data.ByteString.Builder.RealFloat.TableGenerator
8894
) where
@@ -656,43 +662,44 @@ data BoundsState a = BoundsState
656662
trimTrailing :: Mantissa a => BoundsState a -> (BoundsState a, Int32)
657663
trimTrailing !initial = (res, r + r')
658664
where
659-
!(d', r) = trimTrailing' initial
660-
!(d'', r') = if vuIsTrailingZeros d' then trimTrailing'' d' else (d', 0)
661-
res = if vvIsTrailingZeros d'' && lastRemovedDigit d'' == 5 && vv d'' `rem` 2 == 0
665+
!(d'@BoundsState{vuIsTrailingZeros = vuIsTrailingZeros'}, r) = trimTrailing' initial
666+
!(d''@BoundsState{vvIsTrailingZeros = vvIsTrailingZeros'', lastRemovedDigit = lastRemovedDigit'', vv = vv''}, r') =
667+
if vuIsTrailingZeros' then trimTrailing'' d' else (d', 0)
668+
res = if vvIsTrailingZeros'' && lastRemovedDigit'' == 5 && vv'' `rem` 2 == 0
662669
-- set `{ lastRemovedDigit = 4 }` to round-even
663670
then d''
664671
else d''
665672

666-
trimTrailing' !d
673+
trimTrailing' !d@BoundsState{..}
667674
| vw' > vu' =
668675
fmap ((+) 1) . trimTrailing' $
669676
d { vu = vu'
670677
, vv = vv'
671678
, vw = vw'
672679
, lastRemovedDigit = vvRem
673-
, vuIsTrailingZeros = vuIsTrailingZeros d && vuRem == 0
674-
, vvIsTrailingZeros = vvIsTrailingZeros d && lastRemovedDigit d == 0
680+
, vuIsTrailingZeros = vuIsTrailingZeros && vuRem == 0
681+
, vvIsTrailingZeros = vvIsTrailingZeros && lastRemovedDigit == 0
675682
}
676683
| otherwise = (d, 0)
677684
where
678-
!(vv', vvRem) = quotRem10 $ vv d
679-
!(vu', vuRem) = quotRem10 $ vu d
680-
!(vw', _ ) = quotRem10 $ vw d
685+
!(vv', vvRem) = quotRem10 vv
686+
!(vu', vuRem) = quotRem10 vu
687+
!(vw', _ ) = quotRem10 vw
681688

682-
trimTrailing'' !d
689+
trimTrailing'' !d@BoundsState{..}
683690
| vuRem == 0 =
684691
fmap ((+) 1) . trimTrailing'' $
685692
d { vu = vu'
686693
, vv = vv'
687694
, vw = vw'
688695
, lastRemovedDigit = vvRem
689-
, vvIsTrailingZeros = vvIsTrailingZeros d && lastRemovedDigit d == 0
696+
, vvIsTrailingZeros = vvIsTrailingZeros && lastRemovedDigit == 0
690697
}
691698
| otherwise = (d, 0)
692699
where
693-
!(vu', vuRem) = quotRem10 $ vu d
694-
!(vv', vvRem) = quotRem10 $ vv d
695-
!(vw', _ ) = quotRem10 $ vw d
700+
!(vu', vuRem) = quotRem10 vu
701+
!(vv', vvRem) = quotRem10 vv
702+
!(vw', _ ) = quotRem10 vw
696703

697704

698705
-- | Trim digits and update bookkeeping state when the table-computed
@@ -731,10 +738,10 @@ trimNoTrailing !(BoundsState u v w ld _ _) =
731738
-- bounds
732739
{-# INLINE closestCorrectlyRounded #-}
733740
closestCorrectlyRounded :: Mantissa a => Bool -> BoundsState a -> a
734-
closestCorrectlyRounded acceptBound s = vv s + boolToWord roundUp
741+
closestCorrectlyRounded acceptBound BoundsState{..} = vv + boolToWord roundUp
735742
where
736-
outsideBounds = not (vuIsTrailingZeros s) || not acceptBound
737-
roundUp = (vv s == vu s && outsideBounds) || lastRemovedDigit s >= 5
743+
outsideBounds = not vuIsTrailingZeros || not acceptBound
744+
roundUp = (vv == vu && outsideBounds) || lastRemovedDigit >= 5
738745

739746
-- Wrappe around int2Word#
740747
asciiRaw :: Int -> Word8#
@@ -972,3 +979,36 @@ instance MantissaBits Double where mantissaBits = 52
972979
class ExponentBits a where exponentBits :: Int
973980
instance ExponentBits Float where exponentBits = 8
974981
instance ExponentBits Double where exponentBits = 11
982+
983+
-- | Format type for use with `formatFloat` and `formatDouble`.
984+
--
985+
-- @since 0.11.2.0
986+
data FloatFormat
987+
-- | scientific notation
988+
= FScientific
989+
{ eE :: Word8#
990+
, specials :: SpecialStrings
991+
}
992+
-- | standard notation with `Maybe Int` digits after the decimal
993+
| FStandard
994+
{ precision :: Maybe Int
995+
, specials :: SpecialStrings
996+
}
997+
-- | dispatches to scientific or standard notation based on the exponent
998+
| FGeneric
999+
{ eE :: Word8#
1000+
, precision :: Maybe Int
1001+
, stdExpoRange :: (Int, Int)
1002+
, specials :: SpecialStrings
1003+
}
1004+
deriving Show
1005+
fScientific :: Char -> SpecialStrings -> FloatFormat
1006+
fScientific eE specials = FScientific
1007+
{ eE = asciiRaw $ ord eE
1008+
, specials
1009+
}
1010+
fGeneric :: Char -> Maybe Int -> (Int, Int) -> SpecialStrings -> FloatFormat
1011+
fGeneric eE precision stdExpoRange specials = FGeneric
1012+
{ eE = asciiRaw $ ord eE
1013+
, ..
1014+
}

0 commit comments

Comments
 (0)