@@ -1,3 +1,9 @@
1+{-# LANGUAGE BangPatterns, CPP, MagicHash, RankNTypes, ScopedTypeVariables,
2+ UnboxedTuples #-}
3+#if __GLASGOW_HASKELL__ >= 702
4+{-# LANGUAGE Trustworthy #-}
5+#endif
6+
17-- Module: Data.Text.Lazy.Builder.Int
28-- Copyright: (c) 2013 Bryan O'Sullivan
39-- (c) 2011 MailRank, Inc.
@@ -13,13 +19,6 @@ module Data.Text.Lazy.Builder.Int
1319 , hexadecimal
1420 ) where
1521
16−-- import Data.Text.Lazy (Text)
17−import qualified Data.Text.Lazy as L
18−import qualified Data.Text as T
19−import qualified Data.JSString.Int as JSS
20−import Data.Text.Internal (Text (..))
21−import Data.Text.Lazy.Builder
22−
2322import Data.Int (Int8, Int16, Int32, Int64)
2423import Data.Monoid (mempty)
2524import qualified Data.ByteString.Unsafe as B
@@ -53,4 +52,213 @@ import GHC.Integer
5352#endif
5453
5554decimal :: Integral a => a -> Builder
56−decimal n = fromText $ Text $ JSS.decimal n
55+{-# RULES "decimal/Int8" decimal = boundedDecimal :: Int8 -> Builder #-}
56+{-# RULES "decimal/Int" decimal = boundedDecimal :: Int -> Builder #-}
57+{-# RULES "decimal/Int16" decimal = boundedDecimal :: Int16 -> Builder #-}
58+{-# RULES "decimal/Int32" decimal = boundedDecimal :: Int32 -> Builder #-}
59+{-# RULES "decimal/Int64" decimal = boundedDecimal :: Int64 -> Builder #-}
60+{-# RULES "decimal/Word" decimal = positive :: Data.Word.Word -> Builder #-}
61+{-# RULES "decimal/Word8" decimal = positive :: Word8 -> Builder #-}
62+{-# RULES "decimal/Word16" decimal = positive :: Word16 -> Builder #-}
63+{-# RULES "decimal/Word32" decimal = positive :: Word32 -> Builder #-}
64+{-# RULES "decimal/Word64" decimal = positive :: Word64 -> Builder #-}
65+{-# RULES "decimal/Integer" decimal = integer 10 :: Integer -> Builder #-}
66+decimal i = decimal' (<= -128) i
67+{-# NOINLINE decimal #-}
68+
69+boundedDecimal :: (Integral a, Bounded a) => a -> Builder
70+{-# SPECIALIZE boundedDecimal :: Int -> Builder #-}
71+{-# SPECIALIZE boundedDecimal :: Int8 -> Builder #-}
72+{-# SPECIALIZE boundedDecimal :: Int16 -> Builder #-}
73+{-# SPECIALIZE boundedDecimal :: Int32 -> Builder #-}
74+{-# SPECIALIZE boundedDecimal :: Int64 -> Builder #-}
75+boundedDecimal i = decimal' (== minBound) i
76+
77+decimal' :: (Integral a) => (a -> Bool) -> a -> Builder
78+{-# INLINE decimal' #-}
79+decimal' p i
80+ | i < 0 = if p i
81+ then let (q, r) = i `quotRem` 10
82+ qq = -q
83+ !n = countDigits qq
84+ in writeN (n + 2) $ \marr off -> do
85+ unsafeWrite marr off minus
86+ posDecimal marr (off+1) n qq
87+ unsafeWrite marr (off+n+1) (i2w (-r))
88+ else let j = -i
89+ !n = countDigits j
90+ in writeN (n + 1) $ \marr off ->
91+ unsafeWrite marr off minus >> posDecimal marr (off+1) n j
92+ | otherwise = positive i
93+
94+positive :: (Integral a) => a -> Builder
95+{-# SPECIALIZE positive :: Int -> Builder #-}
96+{-# SPECIALIZE positive :: Int8 -> Builder #-}
97+{-# SPECIALIZE positive :: Int16 -> Builder #-}
98+{-# SPECIALIZE positive :: Int32 -> Builder #-}
99+{-# SPECIALIZE positive :: Int64 -> Builder #-}
100+{-# SPECIALIZE positive :: Word -> Builder #-}
101+{-# SPECIALIZE positive :: Word8 -> Builder #-}
102+{-# SPECIALIZE positive :: Word16 -> Builder #-}
103+{-# SPECIALIZE positive :: Word32 -> Builder #-}
104+{-# SPECIALIZE positive :: Word64 -> Builder #-}
105+positive i
106+ | i < 10 = writeN 1 $ \marr off -> unsafeWrite marr off (i2w i)
107+ | otherwise = let !n = countDigits i
108+ in writeN n $ \marr off -> posDecimal marr off n i
109+
110+posDecimal :: (Integral a) =>
111+ forall s. MArray s -> Int -> Int -> a -> ST s ()
112+{-# INLINE posDecimal #-}
113+posDecimal marr off0 ds v0 = go (off0 + ds - 1) v0
114+ where go off v
115+ | v >= 100 = do
116+ let (q, r) = v `quotRem` 100
117+ write2 off r
118+ go (off - 2) q
119+ | v < 10 = unsafeWrite marr off (i2w v)
120+ | otherwise = write2 off v
121+ write2 off i0 = do
122+ let i = fromIntegral i0; j = i + i
123+ unsafeWrite marr off $ get (j + 1)
124+ unsafeWrite marr (off - 1) $ get j
125+ get = fromIntegral . B.unsafeIndex digits
126+
127+minus, zero :: Word16
128+{-# INLINE minus #-}
129+{-# INLINE zero #-}
130+minus = 45
131+zero = 48
132+
133+i2w :: (Integral a) => a -> Word16
134+{-# INLINE i2w #-}
135+i2w v = zero + fromIntegral v
136+
137+countDigits :: (Integral a) => a -> Int
138+{-# INLINE countDigits #-}
139+countDigits v0
140+ | fromIntegral v64 == v0 = go 1 v64
141+ | otherwise = goBig 1 (fromIntegral v0)
142+ where v64 = fromIntegral v0
143+ goBig !k (v :: Integer)
144+ | v > big = goBig (k + 19) (v `quot` big)
145+ | otherwise = go k (fromIntegral v)
146+ big = 10000000000000000000
147+ go !k (v :: Word64)
148+ | v < 10 = k
149+ | v < 100 = k + 1
150+ | v < 1000 = k + 2
151+ | v < 1000000000000 =
152+ k + if v < 100000000
153+ then if v < 1000000
154+ then if v < 10000
155+ then 3
156+ else 4 + fin v 100000
157+ else 6 + fin v 10000000
158+ else if v < 10000000000
159+ then 8 + fin v 1000000000
160+ else 10 + fin v 100000000000
161+ | otherwise = go (k + 12) (v `quot` 1000000000000)
162+ fin v n = if v >= n then 1 else 0
163+
164+hexadecimal :: Integral a => a -> Builder
165+{-# SPECIALIZE hexadecimal :: Int -> Builder #-}
166+{-# SPECIALIZE hexadecimal :: Int8 -> Builder #-}
167+{-# SPECIALIZE hexadecimal :: Int16 -> Builder #-}
168+{-# SPECIALIZE hexadecimal :: Int32 -> Builder #-}
169+{-# SPECIALIZE hexadecimal :: Int64 -> Builder #-}
170+{-# SPECIALIZE hexadecimal :: Word -> Builder #-}
171+{-# SPECIALIZE hexadecimal :: Word8 -> Builder #-}
172+{-# SPECIALIZE hexadecimal :: Word16 -> Builder #-}
173+{-# SPECIALIZE hexadecimal :: Word32 -> Builder #-}
174+{-# SPECIALIZE hexadecimal :: Word64 -> Builder #-}
175+{-# RULES "hexadecimal/Integer"
176+ hexadecimal = hexInteger :: Integer -> Builder #-}
177+hexadecimal i
178+ | i < 0 = error hexErrMsg
179+ | otherwise = go i
180+ where
181+ go n | n < 16 = hexDigit n
182+ | otherwise = go (n `quot` 16) <> hexDigit (n `rem` 16)
183+{-# NOINLINE[0] hexadecimal #-}
184+
185+hexInteger :: Integer -> Builder
186+hexInteger i
187+ | i < 0 = error hexErrMsg
188+ | otherwise = integer 16 i
189+
190+hexErrMsg :: String
191+hexErrMsg = "Data.Text.Lazy.Builder.Int.hexadecimal: applied to negative number"
192+
193+hexDigit :: Integral a => a -> Builder
194+hexDigit n
195+ | n <= 9 = singleton $! i2d (fromIntegral n)
196+ | otherwise = singleton $! toEnum (fromIntegral n + 87)
197+{-# INLINE hexDigit #-}
198+
199+data T = T !Integer !Int
200+
201+integer :: Int -> Integer -> Builder
202+#ifdef INTEGER_GMP
203+integer 10 (S# i#) = decimal (I# i#)
204+integer 16 (S# i#) = hexadecimal (I# i#)
205+#endif
206+integer base i
207+ | i < 0 = singleton '-' <> go (-i)
208+ | otherwise = go i
209+ where
210+ go n | n < maxInt = int (fromInteger n)
211+ | otherwise = putH (splitf (maxInt * maxInt) n)
212+
213+ splitf p n
214+ | p > n = [n]
215+ | otherwise = splith p (splitf (p*p) n)
216+
217+ splith p (n:ns) = case n `quotRemInteger` p of
218+ PAIR(q,r) | q > 0 -> q : r : splitb p ns
219+ | otherwise -> r : splitb p ns
220+ splith _ _ = error "splith: the impossible happened."
221+
222+ splitb p (n:ns) = case n `quotRemInteger` p of
223+ PAIR(q,r) -> q : r : splitb p ns
224+ splitb _ _ = []
225+
226+ T maxInt10 maxDigits10 =
227+ until ((>mi) . (*10) . fstT) (\(T n d) -> T (n*10) (d+1)) (T 10 1)
228+ where mi = fromIntegral (maxBound :: Int)
229+ T maxInt16 maxDigits16 =
230+ until ((>mi) . (*16) . fstT) (\(T n d) -> T (n*16) (d+1)) (T 16 1)
231+ where mi = fromIntegral (maxBound :: Int)
232+
233+ fstT (T a _) = a
234+
235+ maxInt | base == 10 = maxInt10
236+ | otherwise = maxInt16
237+ maxDigits | base == 10 = maxDigits10
238+ | otherwise = maxDigits16
239+
240+ putH (n:ns) = case n `quotRemInteger` maxInt of
241+ PAIR(x,y)
242+ | q > 0 -> int q <> pblock r <> putB ns
243+ | otherwise -> int r <> putB ns
244+ where q = fromInteger x
245+ r = fromInteger y
246+ putH _ = error "putH: the impossible happened"
247+
248+ putB (n:ns) = case n `quotRemInteger` maxInt of
249+ PAIR(x,y) -> pblock q <> pblock r <> putB ns
250+ where q = fromInteger x
251+ r = fromInteger y
252+ putB _ = Data.Monoid.mempty
253+
254+ int :: Int -> Builder
255+ int x | base == 10 = decimal x
256+ | otherwise = hexadecimal x
257+
258+ pblock = loop maxDigits
259+ where
260+ loop !d !n
261+ | d == 1 = hexDigit n
262+ | otherwise = loop (d-1) q <> hexDigit r
263+ where q = n `quotInt` base
264+ r = n `remInt` base