moved FloatFormat to Internal so that it can be exported and users ca…

…n manipulate it beyond the regular formants

Data/ByteString/Builder/RealFloat.hs

@@ -8,8 +8,6 @@
 {-# LANGUAGE TypeApplications #-}
 {-# LANGUAGE BlockArguments #-}
 {-# LANGUAGE NamedFieldPuns #-}
-{-# LANGUAGE NoFieldSelectors #-}
-{-# LANGUAGE DuplicateRecordFields #-}
 -- |
 -- Module      : Data.ByteString.Builder.RealFloat
 -- Copyright   : (c) Lawrence Wu 2021
@@ -84,15 +82,14 @@ module Data.ByteString.Builder.RealFloat
 
 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)
 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 (Word32, Word64)
 import GHC.Show (intToDigit)
-import Data.Char (ord)
-import GHC.Prim (Word8#)
 import Data.Bits (Bits)
 import Data.Proxy (Proxy(Proxy))
 import Data.Maybe (fromMaybe)
@@ -117,41 +114,6 @@ floatDec = formatFloating generic
 doubleDec :: Double -> Builder
 doubleDec = formatFloating generic
 
--- | Format type for use with `formatFloat` and `formatDouble`.
---
--- @since 0.11.2.0
-data FloatFormat
-  -- | scientific notation
-  = FScientific
-    { eE :: Word8#
-    , specials :: R.SpecialStrings
-    }
-  -- | standard notation with `Maybe Int` digits after the decimal
-  | FStandard
-    { precision :: Maybe Int
-    , specials :: R.SpecialStrings
-    }
-  -- | dispatches to scientific or standard notation based on the exponent
-  | FGeneric
-    { eE :: Word8#
-    , precision :: Maybe Int
-    , stdExpoRange :: (Int, Int)
-    , specials :: R.SpecialStrings
-    }
-  deriving Show
-
-fScientific :: Char -> R.SpecialStrings -> FloatFormat
-fScientific eE specials = FScientific
-  { eE = R.asciiRaw $ ord eE
-  , specials
-  }
-
-fGeneric :: Char -> Maybe Int -> (Int, Int) -> R.SpecialStrings -> FloatFormat
-fGeneric eE precision stdExpoRange specials = FGeneric
-  { eE = R.asciiRaw $ ord eE
-  , ..
-  }
-
 -- | Standard notation with `n` decimal places
 --
 -- @since 0.11.2.0

Data/ByteString/Builder/RealFloat/D2S.hs

@@ -2,6 +2,7 @@
 {-# LANGUAGE MagicHash #-}
 {-# LANGUAGE ScopedTypeVariables #-}
 {-# LANGUAGE TypeApplications #-}
+{-# LANGUAGE NamedFieldPuns #-}
 -- |
 -- Module      : Data.ByteString.Builder.RealFloat.D2S
 -- Copyright   : (c) Lawrence Wu 2021
@@ -171,15 +172,15 @@ d2dGeneral m e =
       !v = 4 * mf
       !w = 4 * mf + 2
       -- Step 3. convert to decimal power base
-      !(state, e10) =
+      !(state@BoundsState{vvIsTrailingZeros, vuIsTrailingZeros}, e10) =
         if e2 >= 0
            then d2dGT e2 u v w
            else d2dLT e2 u v w
       -- Step 4: Find the shortest decimal representation in the interval of
       -- valid representations.
       !(output, removed) =
         let rounded = closestCorrectlyRounded (acceptBounds v)
-         in first rounded $ if vvIsTrailingZeros state || vuIsTrailingZeros state
+         in first rounded $ if vvIsTrailingZeros || vuIsTrailingZeros
            then trimTrailing state
            else trimNoTrailing state
       !e' = e10 + removed

Data/ByteString/Builder/RealFloat/F2S.hs

@@ -1,6 +1,7 @@
 {-# LANGUAGE ScopedTypeVariables #-}
 {-# LANGUAGE BangPatterns, MagicHash #-}
 {-# LANGUAGE TypeApplications #-}
+{-# LANGUAGE NamedFieldPuns #-}
 -- |
 -- Module      : Data.ByteString.Builder.RealFloat.F2S
 -- Copyright   : (c) Lawrence Wu 2021
@@ -150,15 +151,15 @@ f2d m e =
       !v = 4 * mf
       !w = 4 * mf + 2
       -- Step 3. convert to decimal power base
-      !(state, e10) =
+      !(state@BoundsState{vvIsTrailingZeros, vuIsTrailingZeros}, e10) =
         if e2 >= 0
            then f2dGT e2 u v w
            else f2dLT e2 u v w
       -- Step 4: Find the shortest decimal representation in the interval of
       -- valid representations.
       !(output, removed) =
         let rounded = closestCorrectlyRounded (acceptBounds v)
-         in first rounded $ if vvIsTrailingZeros state || vuIsTrailingZeros state
+         in first rounded $ if vvIsTrailingZeros || vuIsTrailingZeros
            then trimTrailing state
            else trimNoTrailing state
       !e' = e10 + removed

Data/ByteString/Builder/RealFloat/Internal.hs

@@ -9,6 +9,9 @@
 {-# LANGUAGE TypeApplications #-}
 {-# LANGUAGE AllowAmbiguousTypes #-}
 {-# LANGUAGE BlockArguments #-}
+{-# LANGUAGE NamedFieldPuns #-}
+{-# LANGUAGE NoFieldSelectors #-}
+{-# LANGUAGE DuplicateRecordFields #-}
 -- |
 -- Module      : Data.ByteString.Builder.RealFloat.Internal
 -- Copyright   : (c) Lawrence Wu 2021
@@ -83,6 +86,9 @@ module Data.ByteString.Builder.RealFloat.Internal
     , CastToWord(..)
     , ToInt(..)
     , FromInt(..)
+    , FloatFormat(..)
+    , fScientific
+    , fGeneric
 
     , module Data.ByteString.Builder.RealFloat.TableGenerator
     ) where
@@ -656,43 +662,44 @@ data BoundsState a = BoundsState
 trimTrailing :: Mantissa a => BoundsState a -> (BoundsState a, Int32)
 trimTrailing !initial = (res, r + r')
   where
-    !(d', r) = trimTrailing' initial
-    !(d'', r') = if vuIsTrailingZeros d' then trimTrailing'' d' else (d', 0)
-    res = if vvIsTrailingZeros d'' && lastRemovedDigit d'' == 5 && vv d'' `rem` 2 == 0
+    !(d'@BoundsState{vuIsTrailingZeros = vuIsTrailingZeros'}, r) = trimTrailing' initial
+    !(d''@BoundsState{vvIsTrailingZeros = vvIsTrailingZeros'', lastRemovedDigit = lastRemovedDigit'', vv = vv''}, r') =
+      if vuIsTrailingZeros' then trimTrailing'' d' else (d', 0)
+    res = if vvIsTrailingZeros'' && lastRemovedDigit'' == 5 && vv'' `rem` 2 == 0
              -- set `{ lastRemovedDigit = 4 }` to round-even
              then d''
              else d''
 
-    trimTrailing' !d
+    trimTrailing' !d@BoundsState{..}
       | vw' > vu' =
          fmap ((+) 1) . trimTrailing' $
           d { vu = vu'
             , vv = vv'
             , vw = vw'
             , lastRemovedDigit = vvRem
-            , vuIsTrailingZeros = vuIsTrailingZeros d && vuRem == 0
-            , vvIsTrailingZeros = vvIsTrailingZeros d && lastRemovedDigit d == 0
+            , vuIsTrailingZeros = vuIsTrailingZeros && vuRem == 0
+            , vvIsTrailingZeros = vvIsTrailingZeros && lastRemovedDigit == 0
             }
       | otherwise = (d, 0)
       where
-        !(vv', vvRem) = quotRem10 $ vv d
-        !(vu', vuRem) = quotRem10 $ vu d
-        !(vw', _    ) = quotRem10 $ vw d
+        !(vv', vvRem) = quotRem10 vv
+        !(vu', vuRem) = quotRem10 vu
+        !(vw', _    ) = quotRem10 vw
 
-    trimTrailing'' !d
+    trimTrailing'' !d@BoundsState{..}
       | vuRem == 0 =
          fmap ((+) 1) . trimTrailing'' $
           d { vu = vu'
             , vv = vv'
             , vw = vw'
             , lastRemovedDigit = vvRem
-            , vvIsTrailingZeros = vvIsTrailingZeros d && lastRemovedDigit d == 0
+            , vvIsTrailingZeros = vvIsTrailingZeros && lastRemovedDigit == 0
             }
       | otherwise = (d, 0)
       where
-        !(vu', vuRem) = quotRem10 $ vu d
-        !(vv', vvRem) = quotRem10 $ vv d
-        !(vw', _    ) = quotRem10 $ vw d
+        !(vu', vuRem) = quotRem10 vu
+        !(vv', vvRem) = quotRem10 vv
+        !(vw', _    ) = quotRem10 vw
 
 
 -- | Trim digits and update bookkeeping state when the table-computed
@@ -731,10 +738,10 @@ trimNoTrailing !(BoundsState u v w ld _ _) =
 -- bounds
 {-# INLINE closestCorrectlyRounded #-}
 closestCorrectlyRounded :: Mantissa a => Bool -> BoundsState a -> a
-closestCorrectlyRounded acceptBound s = vv s + boolToWord roundUp
+closestCorrectlyRounded acceptBound BoundsState{..} = vv + boolToWord roundUp
   where
-    outsideBounds = not (vuIsTrailingZeros s) || not acceptBound
-    roundUp = (vv s == vu s && outsideBounds) || lastRemovedDigit s >= 5
+    outsideBounds = not vuIsTrailingZeros || not acceptBound
+    roundUp = (vv == vu && outsideBounds) || lastRemovedDigit >= 5
 
 -- Wrappe around int2Word#
 asciiRaw :: Int -> Word8#
@@ -972,3 +979,36 @@ instance MantissaBits Double where mantissaBits = 52
 class ExponentBits a where exponentBits :: Int
 instance ExponentBits Float where exponentBits = 8
 instance ExponentBits Double where exponentBits = 11
+
+-- | Format type for use with `formatFloat` and `formatDouble`.
+--
+-- @since 0.11.2.0
+data FloatFormat
+  -- | scientific notation
+  = FScientific
+    { eE :: Word8#
+    , specials :: SpecialStrings
+    }
+  -- | standard notation with `Maybe Int` digits after the decimal
+  | FStandard
+    { precision :: Maybe Int
+    , specials :: SpecialStrings
+    }
+  -- | dispatches to scientific or standard notation based on the exponent
+  | FGeneric
+    { eE :: Word8#
+    , precision :: Maybe Int
+    , stdExpoRange :: (Int, Int)
+    , specials :: SpecialStrings
+    }
+  deriving Show
+fScientific :: Char -> SpecialStrings -> FloatFormat
+fScientific eE specials = FScientific
+  { eE = asciiRaw $ ord eE
+  , specials
+  }
+fGeneric :: Char -> Maybe Int -> (Int, Int) -> SpecialStrings -> FloatFormat
+fGeneric eE precision stdExpoRange specials = FGeneric
+  { eE = asciiRaw $ ord eE
+  , ..
+  }