text-format 0.2.1.0 → 0.3.0.0
raw patch · 15 files changed
+292/−699 lines, 15 filesdep +double-conversionPVP ok
version bump matches the API change (PVP)
Dependencies added: double-conversion
API changes (from Hackage documentation)
- Data.Text.Buildable: instance (RealFloat a, DispFloat a) => Buildable (Fast (FPControl a))
- Data.Text.Buildable: instance (RealFloat a, DispFloat a) => Buildable (Fast a)
- Data.Text.Buildable: instance RealFloat a => Buildable (FPControl a)
- Data.Text.Format: Fast :: a -> Fast a
- Data.Text.Format: expt_ :: (Buildable a, RealFloat a) => a -> Builder
- Data.Text.Format: fixed_ :: (Buildable a, RealFloat a) => a -> Builder
- Data.Text.Format: fromFast :: Fast a -> a
- Data.Text.Format: newtype Fast a
- Data.Text.Format.Types: Fast :: a -> Fast a
- Data.Text.Format.Types: class RealFloat a => DispFloat a
- Data.Text.Format.Types: data FPControl a
- Data.Text.Format.Types: fromFast :: Fast a -> a
- Data.Text.Format.Types: newtype Fast a
+ Data.Text.Format: prec :: Real a => Int -> a -> Builder
- Data.Text.Format: expt :: (Buildable a, RealFloat a) => Int -> a -> Builder
+ Data.Text.Format: expt :: Real a => Int -> a -> Builder
- Data.Text.Format: fixed :: (Buildable a, RealFloat a) => Int -> a -> Builder
+ Data.Text.Format: fixed :: Real a => Int -> a -> Builder
Files
- Data/Text/Buildable.hs +4/−18
- Data/Text/Format.hs +23/−18
- Data/Text/Format/RealFloat.hs +0/−225
- Data/Text/Format/RealFloat/Fast.hs +0/−199
- Data/Text/Format/RealFloat/Fast/Internal.hs +0/−106
- Data/Text/Format/RealFloat/Functions.hs +0/−25
- Data/Text/Format/Types.hs +0/−5
- Data/Text/Format/Types/Internal.hs +0/−27
- benchmarks/Benchmarks.hs +69/−0
- benchmarks/Makefile +20/−0
- benchmarks/Simple.hs +94/−0
- benchmarks/printf.c +38/−0
- benchmarks/wprintf.c +39/−0
- tests/Benchmarks.hs +0/−70
- text-format.cabal +5/−6
Data/Text/Buildable.hs view
@@ -20,10 +20,7 @@ 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)@@ -31,6 +28,7 @@ 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 @@ -110,23 +108,11 @@ 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
Data/Text/Format.hs view
@@ -17,7 +17,6 @@ Format , Only(..) -- ** Types for format control- , Fast(..) , Shown(..) -- * Rendering , format@@ -31,19 +30,19 @@ , hex -- ** Floating point numbers , expt- , expt_ , fixed- , fixed_+ , 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@@ -86,30 +85,36 @@ right k c = fromLazyText . LT.justifyLeft (fromIntegral k) c . toLazyText . B.build +-- ^ 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.+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 :: (B.Buildable a, RealFloat a) =>+fixed :: (Real 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.)
− Data/Text/Format/RealFloat.hs
@@ -1,225 +0,0 @@-{-# 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]]
− Data/Text/Format/RealFloat/Fast.hs
@@ -1,199 +0,0 @@-{-# 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
− Data/Text/Format/RealFloat/Fast/Internal.hs
@@ -1,106 +0,0 @@-{-# 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
− Data/Text/Format/RealFloat/Functions.hs
@@ -1,25 +0,0 @@--- |--- 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
Data/Text/Format/Types.hs view
@@ -18,11 +18,6 @@ , 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)
Data/Text/Format/Types/Internal.hs view
@@ -18,10 +18,6 @@ , Shown(..) -- * Integer format control , Hex(..)- -- * Floating point format control- , Fast(..)- , FPControl(..)- , FPFormat(..) ) where import Data.Monoid (Monoid(..))@@ -60,29 +56,6 @@ -- | Render an integral type in hexadecimal. 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.
+ benchmarks/Benchmarks.hs view
@@ -0,0 +1,69 @@+{-# LANGUAGE OverloadedStrings #-}++import Criterion.Main+import Data.Text.Format+import qualified Data.Text as T+import qualified Data.Text.Lazy as L+import qualified Text.Printf as P++printf1 :: (P.PrintfArg a) => String -> a -> String+printf1 f a = P.printf f a++printf2 :: (P.PrintfArg a, P.PrintfArg b) => String -> (a,b) -> String+printf2 f (a,b) = P.printf f a b++main = defaultMain [+ bgroup "arity" [+ bench "0" $ nf (format "hi") ()+ , bench "1" $ nf (format "hi {}") (Only $ T.pack "mom")+ , bench "2" $ nf (format "hi {}, how are {}")+ (T.pack "mom", T.pack "you")+ , bench "3" $ nf (format "hi {}, how are {} keeping {}")+ (T.pack "mom", T.pack "you", T.pack "now")+ , bench "4" $ nf (format "hi {}, {} - how are {} keeping {}")+ (T.pack "mom", T.pack "hey", T.pack "you", T.pack "now")+ ]+ , bgroup "comparison" [+ bench "format1" $ nf (format "hi mom {}\n") (Only (pi::Double))+ , bench "printf1" $ nf (printf1 "hi mom %f\n") (pi::Double)+ , bench "format2" $ nf (format "hi mom {} {}\n") (pi::Double, "yeah"::T.Text)+ , bench "printf2" $ nf (printf2 "hi mom %f %s\n") (pi::Double, "yeah"::String)+ ]+ , bgroup "types" [+ bench "unit" $ nf (format "hi") ()+ , bgroup "int" [+ bench "small" $ nf (format "hi {}") (Only (1::Int))+ , bench "medium" $ nf (format "hi {}") (Only (1234::Int))+ , bench "large" $ nf (format "hi {}") (Only (0x7fffffff::Int))+ ]+ , bgroup "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" [+ 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))+ , bench "medium" $ nf (format "hi {}")+ (Only . concat . replicate 64 $ ("mom" :: String))+ , bench "large" $ nf (format "hi {}")+ (Only . concat . replicate 1024 $ ("mom" :: String))+ ]+ , bgroup "text" [+ bench "small" $ nf (format "hi {}") (Only (T.pack "mom"))+ , bench "medium" $ nf (format "hi {}") (Only (T.replicate 64 "mom"))+ , bench "large" $ nf (format "hi {}") (Only (T.replicate 1024 "mom"))+ ]+ , bgroup "lazytext" [+ bench "small" $ nf (format "hi {}") (Only (L.pack "mom"))+ , bench "medium" $ nf (format "hi {}")+ (Only . L.fromChunks . replicate 64 $ "mom")+ , bench "large" $ nf (format "hi {}")+ (Only . L.fromChunks . replicate 1024 $ "mom")+ ]+ ]+ ]
+ benchmarks/Makefile view
@@ -0,0 +1,20 @@+ghc := ghc++programs := bm simple c-printf c-wprintf++all: $(programs)++bm: Benchmarks.hs+ $(ghc) -rtsopts -O -o $@ $<++simple: Simple.hs+ $(ghc) -rtsopts -O -o $@ $<++c-printf: printf.c+ $(CC) -O2 -o $@ $<++c-wprintf: wprintf.c+ $(CC) -O2 -o $@ $<++clean:+ -rm -f $(programs) *.hi *.o *.hp
+ benchmarks/Simple.hs view
@@ -0,0 +1,94 @@+{-# LANGUAGE BangPatterns, OverloadedStrings #-}++--module Main (main) where++import Control.Monad+import Data.Bits+import System.Environment+import Data.Text.Format as T+import Data.Time.Clock+import Data.Text (Text)+import qualified Data.Text as T+import Data.Text.Lazy.Encoding+import qualified Data.ByteString.Lazy as L+import System.IO++counting :: Int -> (Int -> () -> IO ()) -> IO ()+counting count act = loop 0+ where loop !i | i < count = act i () >> loop (i+1)+ | otherwise = return ()+{-# NOINLINE counting #-}+ +idle count = counting count $ \_ x -> return ()++plain count = counting count $ \_ x -> do+ L.putStr . encodeUtf8 $ "hi mom\n"++unit count = counting count $ \_ x -> do+ let t = T.format "hi mom\n" x+ L.putStr . encodeUtf8 $ t++int count = counting count $ \i x -> do+ let t = T.format "hi mom {}\n" (Only i)+ L.putStr . encodeUtf8 $ t++double count = counting count $ \i x -> do+ let t = T.format "hi mom {}\n" (Only (fromIntegral i * dpi))+ L.putStr . encodeUtf8 $ t++p6 count = counting count $ \i x -> do+ let t = T.format "hi mom {}\n" (Only (prec 6 $! fromIntegral i * dpi))+ L.putStr . encodeUtf8 $ t++arg :: Int -> Text+arg i = T.replicate (i.&.4) "fnord"+{-# NOINLINE arg #-}++one count = counting count $ \i x -> do+ let t = T.format "hi mom {}\n" (Only (arg i))+ L.putStr . encodeUtf8 $ t++two count = counting count $ \i x -> do+ let t = T.format "hi mom {} {}\n" (arg i,arg (i+1))+ L.putStr . encodeUtf8 $ t++three count = counting count $ \i x -> do+ let t = T.format "hi mom {} {} {}\n" (arg i,arg (i+1),arg (i+2))+ L.putStr . encodeUtf8 $ t++four count = counting count $ \i x -> do+ let t = T.format "hi mom {} {} {} {}\n" (arg i,arg (i+1),arg (i+2),arg (i+3))+ L.putStr . encodeUtf8 $ t++five count = counting count $ \i x -> do+ let t = T.format "hi mom {} {} {} {} {}\n"+ (arg i,arg (i+1),arg (i+2),arg (i+3),arg (i+4))+ L.putStr . encodeUtf8 $ t++dpi :: Double+dpi = pi++main = do+ args <- getArgs+ let count = case args of+ (_:x:_) -> read x+ _ -> 100000+ let bm = case args of+ ("idle":_) -> idle+ ("plain":_) -> plain+ ("unit":_) -> unit+ ("double":_) -> double+ ("p6":_) -> p6+ ("int":_) -> int+ ("one":_) -> one+ ("two":_) -> two+ ("three":_) -> three+ ("four":_) -> four+ ("five":_) -> five+ _ -> error "wut?"+ start <- getCurrentTime+ bm count+ elapsed <- (`diffUTCTime` start) `fmap` getCurrentTime+ T.hprint stderr "{} iterations in {} secs ({} thousand/sec)\n"+ (count, elapsed,+ fromRational (toRational count / toRational elapsed / 1e3) :: Double)
+ benchmarks/printf.c view
@@ -0,0 +1,38 @@+#include <math.h>+#include <stdio.h>+#include <stdlib.h>+#include <sys/time.h>++double gettime(void)+{+ struct timeval tv;++ gettimeofday(&tv, NULL);++ return tv.tv_sec + (tv.tv_usec / 1e6);+}++void loop(int count)+{+ int i;++ for (i = 0; i < count; i++)+ printf("hi mom %g\n", (double) i * M_PI);+}++int main(int argc, char **argv)+{+ double start, elapsed;+ int i, count;++ count = argc == 2 ? atoi(argv[1]) : 1600000;++ start = gettime();+ + loop(count);++ elapsed = gettime() - start;++ fprintf(stderr, "%d iterations in %g secs (%g thousand/sec)\n",+ count, elapsed, count / elapsed / 1e3);+}
+ benchmarks/wprintf.c view
@@ -0,0 +1,39 @@+#include <math.h>+#include <stdio.h>+#include <stdlib.h>+#include <sys/time.h>+#include <wchar.h>++double gettime(void)+{+ struct timeval tv;++ gettimeofday(&tv, NULL);++ return tv.tv_sec + (tv.tv_usec / 1e6);+}++void loop(int count)+{+ int i;++ for (i = 0; i < count; i++)+ wprintf(L"hi mom %g\n", (double) i * M_PI);+}++int main(int argc, char **argv)+{+ double start, elapsed;+ int i, count;++ count = argc == 2 ? atoi(argv[1]) : 1600000;++ start = gettime();+ + loop(count);++ elapsed = gettime() - start;++ fprintf(stderr, "%d iterations in %g secs (%g thousand/sec)\n",+ count, elapsed, count / elapsed / 1e3);+}
− tests/Benchmarks.hs
@@ -1,70 +0,0 @@-{-# LANGUAGE OverloadedStrings #-}--import Criterion.Main-import Data.Text.Format-import qualified Data.Text as T-import qualified Data.Text.Lazy as L--main = defaultMain [- bgroup "arity" [- bench "0" $ nf (format "hi") ()- , bench "1" $ nf (format "hi {}") (Only $ T.pack "mom")- , bench "2" $ nf (format "hi {}, how are {}")- (T.pack "mom", T.pack "you")- , bench "3" $ nf (format "hi {}, how are {} keeping {}")- (T.pack "mom", T.pack "you", T.pack "now")- , bench "4" $ nf (format "hi {}, {} - how are {} keeping {}")- (T.pack "mom", T.pack "hey", T.pack "you", T.pack "now")- ]- , bgroup "types" [- bench "unit" $ nf (format "hi") ()- , bgroup "int" [- bench "small" $ nf (format "hi {}") (Only (1::Int))- , bench "medium" $ nf (format "hi {}") (Only (1234::Int))- , 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))- ]- ]- , 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))- ]- ]- , bgroup "string" [- bench "small" $ nf (format "hi {}") (Only ("mom" :: String))- , bench "medium" $ nf (format "hi {}")- (Only . concat . replicate 64 $ ("mom" :: String))- , bench "large" $ nf (format "hi {}")- (Only . concat . replicate 1024 $ ("mom" :: String))- ]- , bgroup "text" [- bench "small" $ nf (format "hi {}") (Only (T.pack "mom"))- , bench "medium" $ nf (format "hi {}") (Only (T.replicate 64 "mom"))- , bench "large" $ nf (format "hi {}") (Only (T.replicate 1024 "mom"))- ]- , bgroup "lazytext" [- bench "small" $ nf (format "hi {}") (Only (L.pack "mom"))- , bench "medium" $ nf (format "hi {}")- (Only . L.fromChunks . replicate 64 $ "mom")- , bench "large" $ nf (format "hi {}")- (Only . L.fromChunks . replicate 1024 $ "mom")- ]- ]- ]
text-format.cabal view
@@ -1,5 +1,5 @@ name: text-format-version: 0.2.1.0+version: 0.3.0.0 license: BSD3 license-file: LICENSE homepage: https://github.com/mailrank/text-format@@ -18,7 +18,9 @@ extra-source-files: README.markdown- tests/Benchmarks.hs+ benchmarks/Makefile+ benchmarks/*.c+ benchmarks/*.hs flag developer description: operate in developer mode@@ -34,15 +36,12 @@ 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,