Commits

Bryan O'Sullivan  committed 7023f6c

Use the double-conversion package for rendering Doubles.

This improves Double rendering performance by
a factor of almost 34 on my 64-bit Intel laptop
running GHC 7.0.2. Nice!

  • Participants
  • Parent commits 271a74a

Comments (0)

Files changed (11)

File Data/Text/Buildable.hs

 import Data.Ratio (Ratio, denominator, numerator)
 import Data.Text.Format.Functions ((<>))
 import Data.Text.Format.Int (decimal, hexadecimal)
-import Data.Text.Format.RealFloat (formatRealFloat, showFloat)
-import Data.Text.Format.RealFloat.Fast (DispFloat, formatFloat, fshowFloat)
-import Data.Text.Format.Types (Fast(..), Hex(..), Shown(..))
-import Data.Text.Format.Types.Internal (FPControl(..))
+import Data.Text.Format.Types (Hex(..), Shown(..))
 import Data.Text.Lazy.Builder
 import Data.Time.Calendar (Day, showGregorian)
 import Data.Time.Clock (DiffTime, NominalDiffTime, UTCTime, UniversalTime)
 import Data.Time.LocalTime (LocalTime, TimeOfDay, TimeZone, ZonedTime)
 import Data.Word (Word, Word8, Word16, Word32, Word64)
 import Foreign.Ptr (IntPtr, WordPtr, Ptr, ptrToWordPtr)
+import qualified Data.Double.Conversion as C
 import qualified Data.Text as ST
 import qualified Data.Text.Lazy as LT
 
     build a = build (numerator a) <> singleton '/' <> build (denominator a)
 
 instance Buildable Float where
-    build = showFloat
+    build = fromText . C.toShortest . realToFrac
     {-# INLINE build #-}
 
 instance Buildable Double where
-    build = showFloat
-    {-# INLINE build #-}
-
-instance (RealFloat a) => Buildable (FPControl a) where
-    build (FPControl fmt decs x) = formatRealFloat fmt decs x
-    {-# INLINE build #-}
-
-instance (RealFloat a, DispFloat a) => Buildable (Fast a) where
-    build = fshowFloat . fromFast
-    {-# INLINE build #-}
-
-instance (RealFloat a, DispFloat a) => Buildable (Fast (FPControl a)) where
-    build (Fast (FPControl fmt decs x)) = formatFloat fmt decs x
+    build = fromText . C.toShortest
     {-# INLINE build #-}
 
 instance Buildable DiffTime where

File Data/Text/Format.hs

       Format
     , Only(..)
     -- ** Types for format control
-    , Fast(..)
     , Shown(..)
     -- * Rendering
     , format
     , hex
     -- ** Floating point numbers
     , expt
-    , expt_
     , fixed
-    , fixed_
-    , generic
+    , prec
     ) where
 
 import Control.Monad.IO.Class (MonadIO(liftIO))
 import Data.Text.Format.Functions ((<>))
 import Data.Text.Format.Params (Params(..))
-import Data.Text.Format.Types.Internal (FPControl(..), FPFormat(..), Fast(..))
-import Data.Text.Format.Types.Internal (Format(..), Hex(..), Only(..), Shown(..))
+import Data.Text.Format.Types.Internal (Format(..), Only(..), Shown(..))
+import Data.Text.Format.Types.Internal (Hex(..))
 import Data.Text.Lazy.Builder
 import Prelude hiding (exp, print)
 import System.IO (Handle)
+import qualified Data.Double.Conversion as C
 import qualified Data.Text as ST
 import qualified Data.Text.Buildable as B
 import qualified Data.Text.Lazy as LT
 right k c =
     fromLazyText . LT.justifyLeft (fromIntegral k) c . toLazyText . B.build
 
--- ^ Render a floating point number, with the given number of decimal
--- places.  Uses decimal notation for values between @0.1@ and
+-- ^ Render a floating point number, with the given number of digits
+-- of precision.  Uses decimal notation for values between @0.1@ and
 -- @9,999,999@, and scientific notation otherwise.
-generic :: (B.Buildable a, RealFloat a) =>
+prec :: (Real a) =>
+        Int
+     -- ^ Number of digits of precision.
+     -> a -> Builder
+{-# RULES "prec/Double"
+    forall d x. prec d (x::Double) = B.build (C.toPrecision d x) #-}
+prec digits = B.build . C.toPrecision digits . realToFrac
+
+-- ^ Render a floating point number using normal notation, with the
+-- given number of decimal places.
+fixed :: (Real a) =>
          Int
       -- ^ Number of digits of precision after the decimal.
       -> a -> Builder
-generic decs = B.build . FPControl Generic (Just decs)
-
--- ^ Render a floating point number using normal notation, with the
--- given number of decimal places.
-fixed :: (B.Buildable a, RealFloat a) =>
-         Int
-      -- ^ Number of digits of precision after the decimal.
-      -> a -> Builder
-fixed decs = B.build . FPControl Fixed (Just decs)
-
--- ^ Render a floating point number using normal notation.
-fixed_ :: (B.Buildable a, RealFloat a) => a -> Builder
-fixed_ = B.build . FPControl Fixed Nothing
+fixed decs = B.build . C.toFixed decs . realToFrac
+{-# RULES "fixed/Double"
+    forall d x. fixed d (x::Double) = B.build (C.toFixed d x) #-}
 
 -- ^ Render a floating point number using scientific/engineering
 -- notation (e.g. @2.3e123@), with the given number of decimal places.
-expt :: (B.Buildable a, RealFloat a) =>
+expt :: (Real a) =>
         Int
      -- ^ Number of digits of precision after the decimal.
      -> a -> Builder
-expt decs = B.build . FPControl Exponent (Just decs)
-
--- ^ Render a floating point number using scientific/engineering
--- notation (e.g. @2.3e123@).
-expt_ :: (B.Buildable a, RealFloat a) => a -> Builder
-expt_ = B.build . FPControl Exponent Nothing
+expt decs = B.build . C.toExponential decs . realToFrac
+{-# RULES "expt/Double"
+    forall d x. expt d (x::Double) = B.build (C.toExponential d x) #-}
 
 -- ^ Render an integer using hexadecimal notation.  (No leading "0x"
 -- is added.)

File Data/Text/Format/RealFloat.hs

-{-# LANGUAGE OverloadedStrings #-}
-
--- |
--- Module:    Data.Text.Format.RealFloat
--- Copyright: (c) The University of Glasgow 1994-2002
--- License:   see libraries/base/LICENSE
---
--- Serialize a floating point value to a 'Builder'.
-
-module Data.Text.Format.RealFloat
-    (
-      formatRealFloat
-    , showFloat
-    ) where
-
-import Data.Text.Format.Functions ((<>), i2d)
-import Data.Text.Format.RealFloat.Functions (roundTo)
-import Data.Text.Format.Int (decimal)
-import Data.Text.Format.Types.Internal (FPFormat(..))
-import qualified Data.Text as T
-import Data.Array.Base (unsafeAt)
-import Data.Text.Lazy.Builder
-import Data.Array.IArray
-
--- | Show a signed 'RealFloat' value to full precision
--- using standard decimal notation for arguments whose absolute value lies
--- between @0.1@ and @9,999,999@, and scientific notation otherwise.
-showFloat :: (RealFloat a) => a -> Builder
-{-# SPECIALIZE showFloat :: Float -> Builder #-}
-{-# SPECIALIZE showFloat :: Double -> Builder #-}
-showFloat x = formatRealFloat Generic Nothing x
-
-formatRealFloat :: (RealFloat a) => FPFormat -> Maybe Int -> a -> Builder
-{-# SPECIALIZE formatRealFloat :: FPFormat -> Maybe Int -> Float -> Builder #-}
-{-# SPECIALIZE formatRealFloat :: FPFormat -> Maybe Int -> Double -> Builder #-}
-formatRealFloat fmt decs x
-   | isNaN x                   = "NaN"
-   | isInfinite x              = if x < 0 then "-Infinity" else "Infinity"
-   | x < 0 || isNegativeZero x = singleton '-' <> doFmt fmt (floatToDigits (-x))
-   | otherwise                 = doFmt fmt (floatToDigits x)
- where
-  doFmt format (is, e) =
-    let ds = map i2d is in
-    case format of
-     Generic ->
-      doFmt (if e < 0 || e > 7 then Exponent else Fixed)
-            (is,e)
-     Exponent ->
-      case decs of
-       Nothing ->
-        let show_e' = decimal (e-1) in
-        case ds of
-          "0"     -> "0.0e0"
-          [d]     -> singleton d <> ".0e" <> show_e'
-          (d:ds') -> singleton d <> singleton '.' <> fromString ds' <> singleton 'e' <> show_e'
-          []      -> error "formatRealFloat/doFmt/Exponent: []"
-       Just dec ->
-        let dec' = max dec 1 in
-        case is of
-         [0] -> "0." <> fromText (T.replicate dec' "0") <> "e0"
-         _ ->
-          let
-           (ei,is') = roundTo (dec'+1) is
-           (d:ds') = map i2d (if ei > 0 then init is' else is')
-          in
-          singleton d <> singleton '.' <> fromString ds' <> singleton 'e' <> decimal (e-1+ei)
-     Fixed ->
-      let
-       mk0 ls = case ls of { "" -> "0" ; _ -> fromString ls}
-      in
-      case decs of
-       Nothing
-          | e <= 0    -> "0." <> fromText (T.replicate (-e) "0") <> fromString ds
-          | otherwise ->
-             let
-                f 0 s    rs  = mk0 (reverse s) <> singleton '.' <> mk0 rs
-                f n s    ""  = f (n-1) ('0':s) ""
-                f n s (r:rs) = f (n-1) (r:s) rs
-             in
-                f e "" ds
-       Just dec ->
-        let dec' = max dec 0 in
-        if e >= 0 then
-         let
-          (ei,is') = roundTo (dec' + e) is
-          (ls,rs)  = splitAt (e+ei) (map i2d is')
-         in
-         mk0 ls <> (if null rs then "" else singleton '.' <> fromString rs)
-        else
-         let
-          (ei,is') = roundTo dec' (replicate (-e) 0 ++ is)
-          d:ds' = map i2d (if ei > 0 then is' else 0:is')
-         in
-         singleton d <> (if null ds' then "" else singleton '.' <> fromString ds')
-
-
--- Based on "Printing Floating-Point Numbers Quickly and Accurately"
--- by R.G. Burger and R.K. Dybvig in PLDI 96.
--- This version uses a much slower logarithm estimator. It should be improved.
-
--- | 'floatToDigits' takes a base and a non-negative 'RealFloat' number,
--- and returns a list of digits and an exponent.
--- In particular, if @x>=0@, and
---
--- > floatToDigits base x = ([d1,d2,...,dn], e)
---
--- then
---
---      (1) @n >= 1@
---
---      (2) @x = 0.d1d2...dn * (base**e)@
---
---      (3) @0 <= di <= base-1@
-
-floatToDigits :: (RealFloat a) => a -> ([Int], Int)
-{-# SPECIALIZE floatToDigits :: Float -> ([Int], Int) #-}
-{-# SPECIALIZE floatToDigits :: Double -> ([Int], Int) #-}
-floatToDigits 0 = ([0], 0)
-floatToDigits x =
- let
-  (f0, e0) = decodeFloat x
-  (minExp0, _) = floatRange x
-  p = floatDigits x
-  b = floatRadix x
-  minExp = minExp0 - p -- the real minimum exponent
-  -- Haskell requires that f be adjusted so denormalized numbers
-  -- will have an impossibly low exponent.  Adjust for this.
-  (f, e) =
-   let n = minExp - e0 in
-   if n > 0 then (f0 `quot` (expt b n), e0+n) else (f0, e0)
-  (r, s, mUp, mDn) =
-   if e >= 0 then
-    let be = expt b e in
-    if f == expt b (p-1) then
-      (f*be*b*2, 2*b, be*b, be)     -- according to Burger and Dybvig
-    else
-      (f*be*2, 2, be, be)
-   else
-    if e > minExp && f == expt b (p-1) then
-      (f*b*2, expt b (-e+1)*2, b, 1)
-    else
-      (f*2, expt b (-e)*2, 1, 1)
-  k :: Int
-  k =
-   let
-    k0 :: Int
-    k0 =
-     if b == 2 then
-        -- logBase 10 2 is very slightly larger than 8651/28738
-        -- (about 5.3558e-10), so if log x >= 0, the approximation
-        -- k1 is too small, hence we add one and need one fixup step less.
-        -- If log x < 0, the approximation errs rather on the high side.
-        -- That is usually more than compensated for by ignoring the
-        -- fractional part of logBase 2 x, but when x is a power of 1/2
-        -- or slightly larger and the exponent is a multiple of the
-        -- denominator of the rational approximation to logBase 10 2,
-        -- k1 is larger than logBase 10 x. If k1 > 1 + logBase 10 x,
-        -- we get a leading zero-digit we don't want.
-        -- With the approximation 3/10, this happened for
-        -- 0.5^1030, 0.5^1040, ..., 0.5^1070 and values close above.
-        -- The approximation 8651/28738 guarantees k1 < 1 + logBase 10 x
-        -- for IEEE-ish floating point types with exponent fields
-        -- <= 17 bits and mantissae of several thousand bits, earlier
-        -- convergents to logBase 10 2 would fail for long double.
-        -- Using quot instead of div is a little faster and requires
-        -- fewer fixup steps for negative lx.
-        let lx = p - 1 + e0
-            k1 = (lx * 8651) `quot` 28738
-        in if lx >= 0 then k1 + 1 else k1
-     else
-	-- f :: Integer, log :: Float -> Float,
-        --               ceiling :: Float -> Int
-        ceiling ((log (fromInteger (f+1) :: Float) +
-                 fromIntegral e * log (fromInteger b)) /
-                   log 10)
---WAS:            fromInt e * log (fromInteger b))
-
-    fixup n =
-      if n >= 0 then
-        if r + mUp <= expt 10 n * s then n else fixup (n+1)
-      else
-        if expt 10 (-n) * (r + mUp) <= s then n else fixup (n+1)
-   in
-   fixup k0
-
-  gen ds rn sN mUpN mDnN =
-   let
-    (dn, rn') = (rn * 10) `quotRem` sN
-    mUpN' = mUpN * 10
-    mDnN' = mDnN * 10
-   in
-   case (rn' < mDnN', rn' + mUpN' > sN) of
-    (True,  False) -> dn : ds
-    (False, True)  -> dn+1 : ds
-    (True,  True)  -> if rn' * 2 < sN then dn : ds else dn+1 : ds
-    (False, False) -> gen (dn:ds) rn' sN mUpN' mDnN'
-
-  rds =
-   if k >= 0 then
-      gen [] r (s * expt 10 k) mUp mDn
-   else
-     let bk = expt 10 (-k) in
-     gen [] (r * bk) s (mUp * bk) (mDn * bk)
- in
- (map fromIntegral (reverse rds), k)
-
--- Exponentiation with a cache for the most common numbers.
-minExpt, maxExpt :: Int
-minExpt = 0
-maxExpt = 1100
-
-expt :: Integer -> Int -> Integer
-expt base n
-    | base == 2 && n >= minExpt && n <= maxExpt = expts `unsafeAt` n
-    | base == 10 && n <= maxExpt10              = expts10 `unsafeAt` n
-    | otherwise                                 = base^n
-
-expts :: Array Int Integer
-expts = array (minExpt,maxExpt) [(n,2^n) | n <- [minExpt .. maxExpt]]
-
-maxExpt10 :: Int
-maxExpt10 = 324
-
-expts10 :: Array Int Integer
-expts10 = array (minExpt,maxExpt10) [(n,10^n) | n <- [minExpt .. maxExpt10]]

File Data/Text/Format/RealFloat/Fast.hs

-{-# LANGUAGE OverloadedStrings #-}
--- |
--- Module:      Data.Text.Format.RealFloat.Fast
--- Copyright:   (c) 2011 Daniel Fischer
--- Licence:     BSD3
--- Maintainer:  Daniel Fischer
--- Stability:   experimental
--- Portability: non-portable (GHC extensions)
---
--- Fast 'Builder' representations for floating point types.  The code
--- is largely taken from code in "GHC.Float" and the 'Show' instance
--- of 'Integer' in "GHC.Num" to get the sequence of digits.
-module Data.Text.Format.RealFloat.Fast
-    ( DispFloat(..)
-    , fshowFloat
-    , fshowEFloat
-    , fshowFFloat
-    , fshowGFloat
-    , formatFloat
-    ) where
-
-import Data.Text.Format.Functions ((<>), i2d)
-import Data.Text.Format.Int (decimal)
-import Data.Text.Format.RealFloat.Fast.Internal (posToDigits)
-import Data.Text.Format.RealFloat.Functions (roundTo)
-import Data.Text.Format.Types.Internal (FPFormat(..))
-import Data.Text.Lazy.Builder
-import qualified Data.Text as T
-
--- | Class for specifying display parameters. The type @a@
---   is supposed to be an IEEE-ish (real) floating-point
---   type with floating-point radix 2, such that the mantissa
---   returned by 'decodeFloat' satisfies
---
--- @
---   2^('binExp' x) <= 'fst' ('decodeFloat' x) < 2^('binExp' x + 1)
--- @
---
---   for @x > 0@, so @'binExp' x = 'floatDigits' x - 1@.
---   The number of decimal digits that may be required is calculated
---   with the formula
---
--- @
---   'decDigits' x = 2 + 'floor' ('floatDigits' x * 'logBase' 10 2).
--- @
---
---   The default implementation uses an approximation of
---   @'logBase' 10 2@ sufficient for mantissae of up to
---   several thousand bits. Nevertheless, hardcoding
---   the values in instance declarations may yield
---   better performance.
-class (RealFloat a) => DispFloat a where
-  -- | The number of decimal digits that may be needed to
-  --   uniquely determine a value of type @a@.
-  --   For faster conversions which need not satisfy
-  --
-  -- @
-  --   x == 'read' ('fshow' x)
-  -- @
-  --
-  --   a smaller value can be given.
-  decDigits     :: a -> Int
-  decDigits x   = 2 + (8651*(floatDigits x)) `quot` 28738
-  -- | The base 2 logarithm of the mantissa returned by
-  --   @'decodeFloat' x@ for @x > 0@.
-  binExp        :: a -> Int
-  binExp x      = floatDigits x - 1
-
-instance DispFloat Double where
-  decDigits _   = 17
-  binExp _      = 52
-
-instance DispFloat Float where
-  decDigits _   = 9
-  binExp _      = 23
-
--- | Show a signed 'DispFloat' value to full precision
--- using standard decimal notation for arguments whose absolute value lies
--- between @0.1@ and @9,999,999@, and scientific notation otherwise.
--- Analogous to @'showFloat'@ from "GHC.Float".
-fshowFloat :: (DispFloat a) => a -> Builder
-{-# SPECIALIZE fshowFloat :: Float -> Builder #-}
-{-# SPECIALIZE fshowFloat :: Double -> Builder #-}
-fshowFloat x = formatFloat Generic Nothing x
-
--- | Show a signed 'DispFloat' value
--- using scientific (exponential) notation (e.g. @2.45e2@, @1.5e-3@).
---
--- In the call @'fshowEFloat' digs val@, if @digs@ is 'Nothing',
--- the value is shown to full precision; if @digs@ is @'Just' d@,
--- then @'max' 1 d@ digits after the decimal point are shown.
--- Analogous to @'showEFloat'@ from "Numeric".
-fshowEFloat    :: (DispFloat a) => Maybe Int -> a -> Builder
-{-# SPECIALIZE fshowEFloat :: Maybe Int -> Float -> Builder #-}
-{-# SPECIALIZE fshowEFloat :: Maybe Int -> Double -> Builder #-}
-fshowEFloat d x =  formatFloat Exponent d x
-
--- | Show a signed 'DispFloat' value
--- using standard decimal notation (e.g. @245000@, @0.0015@).
---
--- In the call @'fshowFFloat' digs val@, if @digs@ is 'Nothing',
--- the value is shown to full precision; if @digs@ is @'Just' d@,
--- then @'max' 0 d@ digits after the decimal point are shown.
--- Analogous to @'showFFloat'@ from "Numeric".
-fshowFFloat    :: (DispFloat a) => Maybe Int -> a -> Builder
-{-# SPECIALIZE fshowFFloat :: Maybe Int -> Float -> Builder #-}
-{-# SPECIALIZE fshowFFloat :: Maybe Int -> Double -> Builder #-}
-fshowFFloat d x =  formatFloat Fixed d x
-
--- | Show a signed 'DispFloat' value
--- using standard decimal notation for arguments whose absolute value lies
--- between @0.1@ and @9,999,999@, and scientific notation otherwise.
---
--- In the call @'fshowGFloat' digs val@, if @digs@ is 'Nothing',
--- the value is shown to full precision; if @digs@ is @'Just' d@,
--- then @'max' 1 d@ digits after the decimal point are shown.
--- Analogous to @'showGFloat'@ from "Numeric".
-fshowGFloat    :: (DispFloat a) => Maybe Int -> a -> Builder
-{-# SPECIALIZE fshowGFloat :: Maybe Int -> Float -> Builder #-}
-{-# SPECIALIZE fshowGFloat :: Maybe Int -> Double -> Builder #-}
-fshowGFloat d x =  formatFloat Generic d x
-
-formatFloat :: DispFloat a => FPFormat -> Maybe Int -> a -> Builder
-{-# SPECIALIZE formatFloat :: FPFormat -> Maybe Int -> Float -> Builder #-}
-{-# SPECIALIZE formatFloat :: FPFormat -> Maybe Int -> Double -> Builder #-}
-formatFloat fmt decs x
-    | isNaN x                   = "NaN"
-    | isInfinite x              = if x < 0 then "-Infinity" else "Infinity"
-    | x < 0 || isNegativeZero x = singleton '-' <> doFmt fmt (fltDigs (-x))
-    | otherwise                 = doFmt fmt (fltDigs x)
-      where
-        fltDigs 0 = ([0],0)
-        fltDigs y = uncurry (posToDigits (decDigits y) (binExp y)) (decodeFloat y)
-        fluff :: [Int] -> [Int]
-        fluff [] = [0]
-        fluff xs = xs
-
-        doFmt format (is, e) =
-          case format of
-            Generic ->
-              doFmt (if e < 0 || e > 7 then Exponent else Fixed) (is,e)
-            Exponent ->
-              case decs of
-                Nothing ->
-                  let show_e' = decimal $ if ei == 0 then (e-1) else e
-                      (ei,(d:ds)) = roundToS (decDigits x) is
-                  in case is of
-                       [0] -> "0.0e0"
-                       _ -> singleton (i2d d) <> singleton '.' <> fromString (map i2d (fluff ds)) <> singleton 'e' <> show_e'
-                Just dec ->
-                  let dec' = max dec 1 in
-                  case is of
-                    [0] -> fromText "0." <> fromText (T.replicate dec' "0") <> "e0"
-                    _ -> let (ei,is') = roundTo (dec'+1) is
-                             (d:ds') = map i2d (if ei > 0 then init is' else is')
-                         in singleton d <> singleton '.' <> fromString ds' <> singleton 'e' <> decimal (e-1+ei)
-            Fixed ->
-              let mk0 ls = case ls of { "" -> "0" ; _ -> fromString ls} in
-              case decs of
-                Nothing ->
-                  let (ei, is') = roundToS (decDigits x) is
-                      e' = e+ei
-                      ds = map i2d is'
-                  in case is of
-                       [0] -> "0.0"
-                       _ | e' <= 0 -> "0." <> fromText (T.replicate (-e') "0") <> fromString (map i2d is')
-                         | otherwise ->
-                           let f 0 s    rs  = mk0 (reverse s) <> singleton '.' <> mk0 rs
-                               f n s    ""  = f (n-1) ('0':s) ""
-                               f n s (r:rs) = f (n-1) (r:s) rs
-                           in f e' "" ds
-                Just dec ->
-                  let dec' = max dec 0 in
-                  if e >= 0 then
-                     let (ei,is') = roundTo (dec' + e) is
-                         (ls,rs)  = splitAt (e+ei) (map i2d is')
-                     in mk0 ls <> (if null rs then "" else singleton '.' <> fromString rs)
-                  else
-                     let (ei,is') = roundTo dec' (replicate (-e) 0 ++ is)
-                         d:ds' = map i2d (if ei > 0 then is' else 0:is')
-                     in singleton d <> (if null ds' then "" else singleton '.' <> fromString ds')
-
-roundToS :: Int -> [Int] -> (Int,[Int])
-roundToS d is =
-    case f d is of
-      x@(0,_) -> x
-      (1,xs)  -> (1, 1:xs)
-      _       -> error "roundToS: bad Value"
-  where
-    f _ []          = (0, [])
-    f 0 (x:_)       = (if x >= 5 then 1 else 0, [])
-    f n (i:xs)
-      | i' == 10    = (1,prep 0 ds)
-      | otherwise   = (0,prep i' ds)
-        where
-          prep 0 [] = []
-          prep a bs = a:bs
-          (c,ds)    = f (n-1) xs
-          i'        = c + i

File Data/Text/Format/RealFloat/Fast/Internal.hs

-{-# LANGUAGE CPP, BangPatterns, MagicHash, UnboxedTuples #-}
--- |
--- Module:          Data.Text.Format.RealFloat.Fast.Internal
--- Copyright:       (c) 2011 Daniel Fischer
--- Licence:         BSD3
--- Maintainer:      Daniel Fischer <daniel.is.fischer@googlemail.com>
--- Stability:       experimental
--- Portability:     non-portable (GHC extensions)
---
--- Faster digit string generation for floating point numbers.
--- Uses a modification of the Integer showing code from "GHC.Num".
-module Data.Text.Format.RealFloat.Fast.Internal
-    (
-      posToDigits
-    ) where
-
-#include "MachDeps.h"
-
-import Data.Array.Base (unsafeAt)
-import Data.Array.IArray
-import GHC.Base
-import GHC.Integer
-import GHC.Num (quotRemInt)
-
-#if WORD_SIZE_IN_BITS == 32
-#define DIGITS       9
-#define BASE         1000000000
-#else
-#define DIGITS       18
-#define BASE         1000000000000000000
-#endif
-
--- digits and exponent for a floating point number.
--- floatRadix is assumed to be 2, decodeFloat to return
--- a mantissa 2^(floatDigits-1) <= mantissa < 2^floatDigits
-posToDigits :: Int -> Int -> Integer -> Int -> ([Int],Int)
-posToDigits showDigs mantExp mant scaleExp@(I# e#) = (integerToDigits decMant, e10)
-  where
-    !rex = mantExp + scaleExp
-    !l0 = (8651*rex) `quot` 28738
-    !l10 = if rex < 0 then l0-1 else l0
-    -- 10^l10 <= x < 10^(l10+2)
-    !decshift@(I# d#) = showDigs - l10
-    !binshift = e# +# d#
-    !decMant
-        | d# <# 0# =
-            (if binshift <# 0#
-                then shiftRInteger mant (negateInt# binshift)
-                else shiftLInteger mant binshift) `quot` expt5 (I# (negateInt# d#))
-        | binshift <# 0# =
-            shiftRInteger (mant * expt5 decshift) (negateInt# binshift)
-        | otherwise = shiftLInteger (mant * expt5 decshift) binshift
-    !e10 = if decMant < expt10 (showDigs+1) then l10+1 else l10+2
-
-expt5 :: Int -> Integer
-expt5 k = if k <= maxEx5 && k >= 0 then unsafeAt expts5 k else 5^k
-
-expt10 :: Int -> Integer
-expt10 k = if k <= maxEx10 && k >= 0 then unsafeAt expts10 k else 10^k
-
-maxEx5 :: Int
-maxEx5 = 349
-
-maxEx10 :: Int
-maxEx10 = 25
-
-expts5 :: Array Int Integer
-expts5 = array (0, maxEx5) [(k,5^k) | k <- [0 .. maxEx5]]
-
-expts10 :: Array Int Integer
-expts10 = array (0,maxEx10) [(k,10^k) | k <- [0 .. maxEx10]]
-
-------------------------------------------------------------------------------
---  The code to show Integers, modified to produce [Int] instead of [Char]
---  Taken from GHC.Num and modified to suit our needs
---  The GHC Licence is reproduced in the package root
-
--- Divide and conquer implementation
--- generate the sequence of digits of a positive Integer
-integerToDigits :: Integer -> [Int]
-integerToDigits nm = integerToDigits' nm []
-
-integerToDigits' :: Integer -> [Int] -> [Int]
-integerToDigits' nm ds
-    | nm < BASE = jhead (fromInteger nm) ds
-    | otherwise = case nm `quotRemInteger` BASE of
-                    (# q, r #) -> integerToDigits' q (jblock (fromInteger r) ds)
-      where
-        -- Convert an integer that fits into a machine word. Again, we have two
-        -- functions, one that drops leading zeros (jhead) and one that doesn't
-        -- (jblock)
-        jhead :: Int -> [Int] -> [Int]
-        jhead n cs
-            | n < 10    = n:cs
-            | otherwise = jhead q (r : cs)
-            where
-            (q, r) = n `quotRemInt` 10
-
-        jblock = jblock' {- ' -} DIGITS     -- bloody CPP
-
-        jblock' :: Int -> Int -> [Int] -> [Int]
-        jblock' d n cs
-            | d == 1    = n : cs
-            | otherwise = jblock' (d - 1) q (r : cs)
-            where
-            (q, r) = n `quotRemInt` 10

File Data/Text/Format/RealFloat/Functions.hs

--- |
--- Module:    Data.Text.Format.RealFloat.Functions
--- Copyright: (c) The University of Glasgow 1994-2002
--- License:   see libraries/base/LICENSE
-
-module Data.Text.Format.RealFloat.Functions
-    (
-      roundTo
-    ) where
-
-roundTo :: Int -> [Int] -> (Int,[Int])
-roundTo d is =
-  case f d is of
-    x@(0,_) -> x
-    (1,xs)  -> (1, 1:xs)
-    _       -> error "roundTo: bad Value"
- where
-  f n []     = (0, replicate n 0)
-  f 0 (x:_)  = (if x >= 5 then 1 else 0, [])
-  f n (i:xs)
-     | i' == 10  = (1,0:ds)
-     | otherwise = (0,i':ds)
-      where
-       (c,ds) = f (n-1) xs
-       i'     = c + i

File Data/Text/Format/Types.hs

     , Shown(..)
     -- * Integer format control
     , Hex(..)
-    -- * Floating point format control
-    , FPControl
-    , Fast(..)
-    , DispFloat
     ) where
 
 import Data.Text.Format.Types.Internal
-import Data.Text.Format.RealFloat.Fast (DispFloat)

File Data/Text/Format/Types/Internal.hs

     , Shown(..)
     -- * Integer format control
     , Hex(..)
-    -- * Floating point format control
-    , Fast(..)
-    , FPControl(..)
-    , FPFormat(..)
     ) where
 
 import Data.Monoid (Monoid(..))
 newtype Hex a = Hex a
     deriving (Eq, Ord, Read, Show, Num, Real, Enum, Integral)
 
--- | Control the rendering of floating point numbers.
-data FPFormat = Exponent
-              -- ^ Scientific notation (e.g. @2.3e123@).
-              | Fixed
-              -- ^ Standard decimal notation.
-              | Generic
-              -- ^ Use decimal notation for values between @0.1@ and
-              -- @9,999,999@, and scientific notation otherwise.
-                deriving (Enum, Read, Show)
-
--- | A floating point number, complete with rendering instructions.
-data FPControl a = FPControl FPFormat (Maybe Int) a
-
--- | Render a floating point number using a much faster algorithm than
--- the default (up to 10x faster). This performance comes with a
--- potential cost in readability, as the faster algorithm can produce
--- strings that are longer than the default algorithm
--- (e.g. \"@1.3300000000000001@\" instead of \"@1.33@\").
-newtype Fast a = Fast {
-      fromFast :: a
-    } deriving (Eq, Show, Read, Ord, Num, Fractional, Real, RealFrac,
-                Floating, RealFloat)
-
 -- | Use this @newtype@ wrapper for your single parameter if you are
 -- formatting a string containing exactly one substitution site.
 newtype Only a = Only {

File benchmarks/Benchmarks.hs

            , bench "large" $ nf (format "hi {}") (Only (0x7fffffff::Int))
            ]
          , bgroup "float" [
-             bgroup "slow" [
-               bench "small" $ nf (format "hi {}") (Only (1::Float))
-             , bench "medium" $ nf (format "hi {}") (Only (pi::Float))
-             , bench "large" $ nf (format "hi {}") (Only (pi*1e37::Float))
-             ]
-           , bgroup "fast" [
-               bench "small" $ nf (format "hi {}") (Only (1::Fast Float))
-             , bench "medium" $ nf (format "hi {}") (Only (pi::Fast Float))
-             , bench "large" $ nf (format "hi {}") (Only (pi*1e37::Fast Float))
-             ]
+             bench "small" $ nf (format "hi {}") (Only (1::Float))
+           , bench "medium" $ nf (format "hi {}") (Only (pi::Float))
+           , bench "large" $ nf (format "hi {}") (Only (pi*1e37::Float))
            ]
          , bgroup "double" [
-             bgroup "slow" [
-               bench "small" $ nf (format "hi {}") (Only (1::Double))
-             , bench "medium" $ nf (format "hi {}") (Only (pi::Double))
-             , bench "large" $ nf (format "hi {}") (Only (pi*1e37::Double))
-             ]
-           , bgroup "fast" [
-               bench "small" $ nf (format "hi {}") (Only (1::Fast Double))
-             , bench "medium" $ nf (format "hi {}") (Only (pi::Fast Double))
-             , bench "large" $ nf (format "hi {}") (Only (pi*1e37::Fast Double))
-             ]
+             bench "small" $ nf (format "hi {}") (Only (1::Double))
+           , bench "medium" $ nf (format "hi {}") (Only (pi::Double))
+           , bench "large" $ nf (format "hi {}") (Only (pi*1e37::Double))
            ]
          , bgroup "string" [
              bench "small" $ nf (format "hi {}") (Only ("mom" :: String))

File benchmarks/Simple.hs

 {-# LANGUAGE BangPatterns, OverloadedStrings #-}
 
-module Main (main) where
+--module Main (main) where
 
 import Control.Monad
 import System.Environment
   let t = T.format "hi mom {}\n" (Only (fromIntegral i * pi::Double))
   L.putStr . encodeUtf8 $ t
 
+dpi :: Double
+dpi = pi
+
+p6 count = counting count $ \i x -> do
+  let t = T.format "hi mom {}\n" (Only (prec 6 $! fromIntegral i * dpi))
+  L.putStr . encodeUtf8 $ t
+
 main = do
   args <- getArgs
   let count = case args of
              ("plain":_)  -> plain
              ("unit":_)   -> unit
              ("double":_) -> double
+             ("p6":_) -> p6
              ("int":_)    -> int
              _            -> error "wut?"
   start <- getCurrentTime

File text-format.cabal

   other-modules:
     Data.Text.Format.Functions
     Data.Text.Format.Int
-    Data.Text.Format.RealFloat
-    Data.Text.Format.RealFloat.Fast
-    Data.Text.Format.RealFloat.Fast.Internal
-    Data.Text.Format.RealFloat.Functions
     Data.Text.Format.Types.Internal
 
   build-depends:
     array,
     base == 4.*,
+    double-conversion,
     ghc-prim,
     integer-gmp,
     old-locale,