git.iko.soy/text
on master help sign in
Add support for rendering of integral and floating point values.
d922274Bryan O'Sullivan
Data/Text/Lazy/Builder/Functions.hsnew file+35
compare with master
unifiedsplit
@@ -0,0 +1,35 @@
1+{-# LANGUAGE MagicHash #-}
2+
3+-- |
4+-- Module : Data.Text.Lazy.Builder.Functions
5+-- Copyright : (c) 2011 MailRank, Inc.
6+--
7+-- License : BSD-style
8+-- Maintainer : bos@serpentine.com
9+-- Stability : experimental
10+-- Portability : GHC
11+--
12+-- Useful functions and combinators.
13+
14+module Data.Text.Lazy.Builder.Functions
15+ (
16+ (<>)
17+ , i2d
18+ ) where
19+
20+import Data.Monoid (mappend)
21+import Data.Text.Lazy.Builder (Builder)
22+import GHC.Base
23+
24+-- | Unsafe conversion for decimal digits.
25+{-# INLINE i2d #-}
26+i2d :: Int -> Char
27+i2d (I# i#) = C# (chr# (ord# '0'# +# i#))
28+
29+-- | The normal 'mappend' function with right associativity instead of
30+-- left.
31+(<>) :: Builder -> Builder -> Builder
32+(<>) = mappend
33+{-# INLINE (<>) #-}
34+
35+infixr 4 <>
Data/Text/Lazy/Builder/Int.hsnew file+152
@@ -0,0 +1,152 @@
1+{-# LANGUAGE BangPatterns, CPP, MagicHash, UnboxedTuples #-}
2+
3+-- Module: Data.Text.Lazy.Builder.Int
4+-- Copyright: (c) 2011 MailRank, Inc.
5+-- License: BSD3
6+-- Maintainer: Bryan O'Sullivan <bos@serpentine.com>
7+-- Stability: experimental
8+-- Portability: portable
9+--
10+-- Efficiently write an integral value to a 'Builder'.
11+
12+module Data.Text.Lazy.Builder.Int
13+ (
14+ decimal
15+ , hexadecimal
16+ ) where
17+
18+import Data.Int (Int8, Int16, Int32, Int64)
19+import Data.Monoid (mempty)
20+import Data.Text.Lazy.Builder.Functions ((<>), i2d)
21+import Data.Text.Lazy.Builder
22+import Data.Word (Word, Word8, Word16, Word32, Word64)
23+import GHC.Base (quotInt, remInt)
24+import GHC.Num (quotRemInteger)
25+import GHC.Types (Int(..))
26+
27+#ifdef __GLASGOW_HASKELL__
28+# if __GLASGOW_HASKELL__ < 611
29+import GHC.Integer.Internals
30+# else
31+import GHC.Integer.GMP.Internals
32+# endif
33+#endif
34+
35+#ifdef INTEGER_GMP
36+# define PAIR(a,b) (# a,b #)
37+#else
38+# define PAIR(a,b) (a,b)
39+#endif
40+
41+decimal :: Integral a => a -> Builder
42+{-# SPECIALIZE decimal :: Int -> Builder #-}
43+{-# SPECIALIZE decimal :: Int8 -> Builder #-}
44+{-# SPECIALIZE decimal :: Int16 -> Builder #-}
45+{-# SPECIALIZE decimal :: Int32 -> Builder #-}
46+{-# SPECIALIZE decimal :: Int64 -> Builder #-}
47+{-# SPECIALIZE decimal :: Word -> Builder #-}
48+{-# SPECIALIZE decimal :: Word8 -> Builder #-}
49+{-# SPECIALIZE decimal :: Word16 -> Builder #-}
50+{-# SPECIALIZE decimal :: Word32 -> Builder #-}
51+{-# SPECIALIZE decimal :: Word64 -> Builder #-}
52+{-# RULES "decimal/Integer" decimal = integer 10 :: Integer -> Builder #-}
53+decimal i
54+ | i < 0 = singleton '-' <> go (-i)
55+ | otherwise = go i
56+ where
57+ go n | n < 10 = digit n
58+ | otherwise = go (n `quot` 10) <> digit (n `rem` 10)
59+
60+hexadecimal :: Integral a => a -> Builder
61+{-# SPECIALIZE hexadecimal :: Int -> Builder #-}
62+{-# SPECIALIZE hexadecimal :: Int8 -> Builder #-}
63+{-# SPECIALIZE hexadecimal :: Int16 -> Builder #-}
64+{-# SPECIALIZE hexadecimal :: Int32 -> Builder #-}
65+{-# SPECIALIZE hexadecimal :: Int64 -> Builder #-}
66+{-# SPECIALIZE hexadecimal :: Word -> Builder #-}
67+{-# SPECIALIZE hexadecimal :: Word8 -> Builder #-}
68+{-# SPECIALIZE hexadecimal :: Word16 -> Builder #-}
69+{-# SPECIALIZE hexadecimal :: Word32 -> Builder #-}
70+{-# SPECIALIZE hexadecimal :: Word64 -> Builder #-}
71+{-# RULES "hexadecimal/Integer" hexadecimal = integer 16 :: Integer -> Builder #-}
72+hexadecimal i
73+ | i < 0 = singleton '-' <> go (-i)
74+ | otherwise = go i
75+ where
76+ go n | n < 16 = hexDigit n
77+ | otherwise = go (n `quot` 16) <> hexDigit (n `rem` 16)
78+
79+digit :: Integral a => a -> Builder
80+digit n = singleton $! i2d (fromIntegral n)
81+{-# INLINE digit #-}
82+
83+hexDigit :: Integral a => a -> Builder
84+hexDigit n
85+ | n <= 9 = singleton $! i2d (fromIntegral n)
86+ | otherwise = singleton $! toEnum (fromIntegral n + 87)
87+{-# INLINE hexDigit #-}
88+
89+int :: Int -> Builder
90+int = decimal
91+{-# INLINE int #-}
92+
93+data T = T !Integer !Int
94+
95+integer :: Int -> Integer -> Builder
96+integer 10 (S# i#) = decimal (I# i#)
97+integer 16 (S# i#) = hexadecimal (I# i#)
98+integer base i
99+ | i < 0 = singleton '-' <> go (-i)
100+ | otherwise = go i
101+ where
102+ go n | n < maxInt = int (fromInteger n)
103+ | otherwise = putH (splitf (maxInt * maxInt) n)
104+
105+ splitf p n
106+ | p > n = [n]
107+ | otherwise = splith p (splitf (p*p) n)
108+
109+ splith p (n:ns) = case n `quotRemInteger` p of
110+ PAIR(q,r) | q > 0 -> q : r : splitb p ns
111+ | otherwise -> r : splitb p ns
112+ splith _ _ = error "splith: the impossible happened."
113+
114+ splitb p (n:ns) = case n `quotRemInteger` p of
115+ PAIR(q,r) -> q : r : splitb p ns
116+ splitb _ _ = []
117+
118+ T maxInt10 maxDigits10 =
119+ until ((>mi) . (*10) . fstT) (\(T n d) -> T (n*10) (d+1)) (T 10 1)
120+ where mi = fromIntegral (maxBound :: Int)
121+ T maxInt16 maxDigits16 =
122+ until ((>mi) . (*16) . fstT) (\(T n d) -> T (n*16) (d+1)) (T 16 1)
123+ where mi = fromIntegral (maxBound :: Int)
124+
125+ fstT (T a _) = a
126+
127+ maxInt | base == 10 = maxInt10
128+ | otherwise = maxInt16
129+ maxDigits | base == 10 = maxDigits10
130+ | otherwise = maxDigits16
131+
132+ putH (n:ns) = case n `quotRemInteger` maxInt of
133+ PAIR(x,y)
134+ | q > 0 -> int q <> pblock r <> putB ns
135+ | otherwise -> int r <> putB ns
136+ where q = fromInteger x
137+ r = fromInteger y
138+ putH _ = error "putH: the impossible happened"
139+
140+ putB (n:ns) = case n `quotRemInteger` maxInt of
141+ PAIR(x,y) -> pblock q <> pblock r <> putB ns
142+ where q = fromInteger x
143+ r = fromInteger y
144+ putB _ = mempty
145+
146+ pblock = loop maxDigits
147+ where
148+ loop !d !n
149+ | d == 1 = digit n
150+ | otherwise = loop (d-1) q <> digit r
151+ where q = n `quotInt` base
152+ r = n `remInt` base
Data/Text/Lazy/Builder/RealFloat.hsnew file+239
@@ -0,0 +1,239 @@
1+{-# LANGUAGE OverloadedStrings #-}
2+
3+-- |
4+-- Module: Data.Text.Lazy.Builder.RealFloat
5+-- Copyright: (c) The University of Glasgow 1994-2002
6+-- License: see libraries/base/LICENSE
7+--
8+-- Write a floating point value to a 'Builder'.
9+
10+module Data.Text.Lazy.Builder.RealFloat
11+ (
12+ FPFormat(..)
13+ , realFloat
14+ , formatRealFloat
15+ ) where
16+
17+import Data.Array.Base (unsafeAt)
18+import Data.Array.IArray
19+import Data.Text.Lazy.Builder.Functions ((<>), i2d)
20+import Data.Text.Lazy.Builder.Int (decimal)
21+import Data.Text.Lazy.Builder.RealFloat.Functions (roundTo)
22+import Data.Text.Lazy.Builder
23+import qualified Data.Text as T
24+
25+-- | Control the rendering of floating point numbers.
26+data FPFormat = Exponent
27+ -- ^ Scientific notation (e.g. @2.3e123@).
28+ | Fixed
29+ -- ^ Standard decimal notation.
30+ | Generic
31+ -- ^ Use decimal notation for values between @0.1@ and
32+ -- @9,999,999@, and scientific notation otherwise.
33+ deriving (Enum, Read, Show)
34+
35+-- | Show a signed 'RealFloat' value to full precision,
36+-- using standard decimal notation for arguments whose absolute value lies
37+-- between @0.1@ and @9,999,999@, and scientific notation otherwise.
38+realFloat :: (RealFloat a) => a -> Builder
39+{-# SPECIALIZE realFloat :: Float -> Builder #-}
40+{-# SPECIALIZE realFloat :: Double -> Builder #-}
41+realFloat x = formatRealFloat Generic Nothing x
42+
43+formatRealFloat :: (RealFloat a) =>
44+ FPFormat
45+ -> Maybe Int -- ^ Number of decimal places to render.
46+ -> a
47+ -> Builder
48+{-# SPECIALIZE formatRealFloat :: FPFormat -> Maybe Int -> Float -> Builder #-}
49+{-# SPECIALIZE formatRealFloat :: FPFormat -> Maybe Int -> Double -> Builder #-}
50+formatRealFloat fmt decs x
51+ | isNaN x = "NaN"
52+ | isInfinite x = if x < 0 then "-Infinity" else "Infinity"
53+ | x < 0 || isNegativeZero x = singleton '-' <> doFmt fmt (floatToDigits (-x))
54+ | otherwise = doFmt fmt (floatToDigits x)
55+ where
56+ doFmt format (is, e) =
57+ let ds = map i2d is in
58+ case format of
59+ Generic ->
60+ doFmt (if e < 0 || e > 7 then Exponent else Fixed)
61+ (is,e)
62+ Exponent ->
63+ case decs of
64+ Nothing ->
65+ let show_e' = decimal (e-1) in
66+ case ds of
67+ "0" -> "0.0e0"
68+ [d] -> singleton d <> ".0e" <> show_e'
69+ (d:ds') -> singleton d <> singleton '.' <> fromString ds' <> singleton 'e' <> show_e'
70+ [] -> error "formatRealFloat/doFmt/Exponent: []"
71+ Just dec ->
72+ let dec' = max dec 1 in
73+ case is of
74+ [0] -> "0." <> fromText (T.replicate dec' "0") <> "e0"
75+ _ ->
76+ let
77+ (ei,is') = roundTo (dec'+1) is
78+ (d:ds') = map i2d (if ei > 0 then init is' else is')
79+ in
80+ singleton d <> singleton '.' <> fromString ds' <> singleton 'e' <> decimal (e-1+ei)
81+ Fixed ->
82+ let
83+ mk0 ls = case ls of { "" -> "0" ; _ -> fromString ls}
84+ in
85+ case decs of
86+ Nothing
87+ | e <= 0 -> "0." <> fromText (T.replicate (-e) "0") <> fromString ds
88+ | otherwise ->
89+ let
90+ f 0 s rs = mk0 (reverse s) <> singleton '.' <> mk0 rs
91+ f n s "" = f (n-1) ('0':s) ""
92+ f n s (r:rs) = f (n-1) (r:s) rs
93+ in
94+ f e "" ds
95+ Just dec ->
96+ let dec' = max dec 0 in
97+ if e >= 0 then
98+ let
99+ (ei,is') = roundTo (dec' + e) is
100+ (ls,rs) = splitAt (e+ei) (map i2d is')
101+ in
102+ mk0 ls <> (if null rs then "" else singleton '.' <> fromString rs)
103+ else
104+ let
105+ (ei,is') = roundTo dec' (replicate (-e) 0 ++ is)
106+ d:ds' = map i2d (if ei > 0 then is' else 0:is')
107+ in
108+ singleton d <> (if null ds' then "" else singleton '.' <> fromString ds')
109+
110+
111+-- Based on "Printing Floating-Point Numbers Quickly and Accurately"
112+-- by R.G. Burger and R.K. Dybvig in PLDI 96.
113+-- This version uses a much slower logarithm estimator. It should be improved.
114+
115+-- | 'floatToDigits' takes a base and a non-negative 'RealFloat' number,
116+-- and returns a list of digits and an exponent.
117+-- In particular, if @x>=0@, and
118+--
119+-- > floatToDigits base x = ([d1,d2,...,dn], e)
120+--
121+-- then
122+--
123+-- (1) @n >= 1@
124+--
125+-- (2) @x = 0.d1d2...dn * (base**e)@
126+--
127+-- (3) @0 <= di <= base-1@
128+
129+floatToDigits :: (RealFloat a) => a -> ([Int], Int)
130+{-# SPECIALIZE floatToDigits :: Float -> ([Int], Int) #-}
131+{-# SPECIALIZE floatToDigits :: Double -> ([Int], Int) #-}
132+floatToDigits 0 = ([0], 0)
133+floatToDigits x =
134+ let
135+ (f0, e0) = decodeFloat x
136+ (minExp0, _) = floatRange x
137+ p = floatDigits x
138+ b = floatRadix x
139+ minExp = minExp0 - p -- the real minimum exponent
140+ -- Haskell requires that f be adjusted so denormalized numbers
141+ -- will have an impossibly low exponent. Adjust for this.
142+ (f, e) =
143+ let n = minExp - e0 in
144+ if n > 0 then (f0 `quot` (expt b n), e0+n) else (f0, e0)
145+ (r, s, mUp, mDn) =
146+ if e >= 0 then
147+ let be = expt b e in
148+ if f == expt b (p-1) then
149+ (f*be*b*2, 2*b, be*b, be) -- according to Burger and Dybvig
150+ else
151+ (f*be*2, 2, be, be)
152+ else
153+ if e > minExp && f == expt b (p-1) then
154+ (f*b*2, expt b (-e+1)*2, b, 1)
155+ else
156+ (f*2, expt b (-e)*2, 1, 1)
157+ k :: Int
158+ k =
159+ let
160+ k0 :: Int
161+ k0 =
162+ if b == 2 then
163+ -- logBase 10 2 is very slightly larger than 8651/28738
164+ -- (about 5.3558e-10), so if log x >= 0, the approximation
165+ -- k1 is too small, hence we add one and need one fixup step less.
166+ -- If log x < 0, the approximation errs rather on the high side.
167+ -- That is usually more than compensated for by ignoring the
168+ -- fractional part of logBase 2 x, but when x is a power of 1/2
169+ -- or slightly larger and the exponent is a multiple of the
170+ -- denominator of the rational approximation to logBase 10 2,
171+ -- k1 is larger than logBase 10 x. If k1 > 1 + logBase 10 x,
172+ -- we get a leading zero-digit we don't want.
173+ -- With the approximation 3/10, this happened for
174+ -- 0.5^1030, 0.5^1040, ..., 0.5^1070 and values close above.
175+ -- The approximation 8651/28738 guarantees k1 < 1 + logBase 10 x
176+ -- for IEEE-ish floating point types with exponent fields
177+ -- <= 17 bits and mantissae of several thousand bits, earlier
178+ -- convergents to logBase 10 2 would fail for long double.
179+ -- Using quot instead of div is a little faster and requires
180+ -- fewer fixup steps for negative lx.
181+ let lx = p - 1 + e0
182+ k1 = (lx * 8651) `quot` 28738
183+ in if lx >= 0 then k1 + 1 else k1
184+ else
185+ -- f :: Integer, log :: Float -> Float,
186+ -- ceiling :: Float -> Int
187+ ceiling ((log (fromInteger (f+1) :: Float) +
188+ fromIntegral e * log (fromInteger b)) /
189+ log 10)
190+--WAS: fromInt e * log (fromInteger b))
191+
192+ fixup n =
193+ if n >= 0 then
194+ if r + mUp <= expt 10 n * s then n else fixup (n+1)
195+ else
196+ if expt 10 (-n) * (r + mUp) <= s then n else fixup (n+1)
197+ in
198+ fixup k0
199+
200+ gen ds rn sN mUpN mDnN =
201+ let
202+ (dn, rn') = (rn * 10) `quotRem` sN
203+ mUpN' = mUpN * 10
204+ mDnN' = mDnN * 10
205+ in
206+ case (rn' < mDnN', rn' + mUpN' > sN) of
207+ (True, False) -> dn : ds
208+ (False, True) -> dn+1 : ds
209+ (True, True) -> if rn' * 2 < sN then dn : ds else dn+1 : ds
210+ (False, False) -> gen (dn:ds) rn' sN mUpN' mDnN'
211+
212+ rds =
213+ if k >= 0 then
214+ gen [] r (s * expt 10 k) mUp mDn
215+ else
216+ let bk = expt 10 (-k) in
217+ gen [] (r * bk) s (mUp * bk) (mDn * bk)
218+ in
219+ (map fromIntegral (reverse rds), k)
220+
221+-- Exponentiation with a cache for the most common numbers.
222+minExpt, maxExpt :: Int
223+minExpt = 0
224+maxExpt = 1100
225+
226+expt :: Integer -> Int -> Integer
227+expt base n
228+ | base == 2 && n >= minExpt && n <= maxExpt = expts `unsafeAt` n
229+ | base == 10 && n <= maxExpt10 = expts10 `unsafeAt` n
230+ | otherwise = base^n
231+
232+expts :: Array Int Integer
233+expts = array (minExpt,maxExpt) [(n,2^n) | n <- [minExpt .. maxExpt]]
234+
235+maxExpt10 :: Int
236+maxExpt10 = 324
237+
238+expts10 :: Array Int Integer
239+expts10 = array (minExpt,maxExpt10) [(n,10^n) | n <- [minExpt .. maxExpt10]]
Data/Text/Lazy/Builder/RealFloat/Functions.hsnew file+25
@@ -0,0 +1,25 @@
1+-- |
2+-- Module: Data.Text.Lazy.Builder.RealFloat.Functions
3+-- Copyright: (c) The University of Glasgow 1994-2002
4+-- License: see libraries/base/LICENSE
5+
6+module Data.Text.Lazy.Builder.RealFloat.Functions
7+ (
8+ roundTo
9+ ) where
10+
11+roundTo :: Int -> [Int] -> (Int,[Int])
12+roundTo d is =
13+ case f d is of
14+ x@(0,_) -> x
15+ (1,xs) -> (1, 1:xs)
16+ _ -> error "roundTo: bad Value"
17+ where
18+ f n [] = (0, replicate n 0)
19+ f 0 (x:_) = (if x >= 5 then 1 else 0, [])
20+ f n (i:xs)
21+ | i' == 10 = (1,0:ds)
22+ | otherwise = (0,i':ds)
23+ where
24+ (c,ds) = f (n-1) xs
25+ i' = c + i
text.cabal+13−1
@@ -1,5 +1,5 @@
1name: text
1name: text
2−version: 0.11.0.9
2+version: 0.12.0.0
3homepage: https://bitbucket.org/bos/text
3homepage: https://bitbucket.org/bos/text
4bug-reports: https://bitbucket.org/bos/text/issues
4bug-reports: https://bitbucket.org/bos/text/issues
5synopsis: An efficient packed Unicode text type.
5synopsis: An efficient packed Unicode text type.
@@ -87,6 +87,8 @@ library
87 Data.Text.Internal
87 Data.Text.Internal
88 Data.Text.Lazy
88 Data.Text.Lazy
89 Data.Text.Lazy.Builder
89 Data.Text.Lazy.Builder
90+ Data.Text.Lazy.Builder.Int
91+ Data.Text.Lazy.Builder.RealFloat
90 Data.Text.Lazy.Encoding
92 Data.Text.Lazy.Encoding
91 Data.Text.Lazy.IO
93 Data.Text.Lazy.IO
92 Data.Text.Lazy.Internal
94 Data.Text.Lazy.Internal
@@ -104,6 +106,7 @@ library
104 Data.Text.Fusion.Internal
106 Data.Text.Fusion.Internal
105 Data.Text.Fusion.Size
107 Data.Text.Fusion.Size
106 Data.Text.IO.Internal
108 Data.Text.IO.Internal
109+ Data.Text.Lazy.Builder.Functions
107 Data.Text.Lazy.Encoding.Fusion
110 Data.Text.Lazy.Encoding.Fusion
108 Data.Text.Lazy.Fusion
111 Data.Text.Lazy.Fusion
109 Data.Text.Lazy.Search
112 Data.Text.Lazy.Search
@@ -114,6 +117,7 @@ library
114 Data.Text.Util
117 Data.Text.Util
115
118
116 build-depends:
119 build-depends:
120+ array,
117 base < 5,
121 base < 5,
118 bytestring >= 0.9 && < 1.0
122 bytestring >= 0.9 && < 1.0
119 if impl(ghc >= 6.10)
123 if impl(ghc >= 6.10)
@@ -132,6 +136,14 @@ library
132 ghc-options: -Werror
136 ghc-options: -Werror
133 cpp-options: -DASSERTS
137 cpp-options: -DASSERTS
134
138
139+ if impl(ghc >= 6.11)
140+ cpp-options: -DINTEGER_GMP
141+ build-depends: integer-gmp >= 0.2 && < 0.3
142+
143+ if impl(ghc >= 6.9) && impl(ghc < 6.11)
144+ cpp-options: -DINTEGER_GMP
145+ build-depends: integer >= 0.1 && < 0.2
146+
135source-repository head
147source-repository head
136 type: mercurial
148 type: mercurial
137 location: https://bitbucket.org/bos/text
149 location: https://bitbucket.org/bos/text