Skip to content

Commit 567e8a6

Browse files
la-wula-wu
committed
Use manual strictness
- Strict extension is from ghc >= 8.0.1
1 parent 2c9dda8 commit 567e8a6

File tree

3 files changed

+74
-77
lines changed

3 files changed

+74
-77
lines changed

‎Data/ByteString/Builder/RealFloat/D2S.hs

Lines changed: 32 additions & 33 deletions
Original file line numberDiff line numberDiff line change
@@ -1,5 +1,4 @@
11
{-# LANGUAGE TemplateHaskell #-}
2-
{-# LANGUAGE Strict #-}
32
{-# LANGUAGE BangPatterns, MagicHash, UnboxedTuples #-}
43

54
module Data.ByteString.Builder.RealFloat.D2S
@@ -103,21 +102,21 @@ mulPow5InvDivPow2 m q j = mulShift64Unboxed m (get_double_pow5_inv_split (word2I
103102

104103

105104
acceptBounds :: Word64 -> Bool
106-
acceptBounds (W64# v) = boxToBool (acceptBoundsUnboxed v)
105+
acceptBounds !(W64# v) = boxToBool (acceptBoundsUnboxed v)
107106

108107
data BoundsState = BoundsState
109-
{ vu :: Word64
110-
, vv :: Word64
111-
, vw :: Word64
112-
, lastRemovedDigit :: Word64
113-
, vuIsTrailingZeros :: Bool
114-
, vvIsTrailingZeros :: Bool
108+
{ vu :: !Word64
109+
, vv :: !Word64
110+
, vw :: !Word64
111+
, lastRemovedDigit :: !Word64
112+
, vuIsTrailingZeros :: !Bool
113+
, vvIsTrailingZeros :: !Bool
115114
} deriving Show
116115

117116
trimTrailing' :: BoundsState -> (BoundsState, Int32)
118-
trimTrailing' d
117+
trimTrailing' !d
119118
| vw' > vu' =
120-
let (vv', vvRem) = dquotRem10Boxed $ vv d
119+
let !(vv', vvRem) = dquotRem10Boxed $ vv d
121120
in fmap ((+) 1) . trimTrailing' $
122121
d { vu = vu'
123122
, vv = vv'
@@ -128,14 +127,14 @@ trimTrailing' d
128127
}
129128
| otherwise = (d, 0)
130129
where
131-
(vu', vuRem) = dquotRem10Boxed $ vu d
132-
vw' = dwrapped dquot10 (vw d)
130+
!(vu', vuRem) = dquotRem10Boxed $ vu d
131+
!vw' = dwrapped dquot10 (vw d)
133132

134133
trimTrailing'' :: BoundsState -> (BoundsState, Int32)
135134
trimTrailing'' d
136135
| vuRem == 0 =
137-
let (vv', vvRem) = dquotRem10Boxed $ vv d
138-
vw' = dwrapped dquot10 (vw d)
136+
let !(vv', vvRem) = dquotRem10Boxed $ vv d
137+
!vw' = dwrapped dquot10 (vw d)
139138
in fmap ((+) 1) . trimTrailing'' $
140139
d { vu = vu'
141140
, vv = vv'
@@ -145,12 +144,12 @@ trimTrailing'' d
145144
}
146145
| otherwise = (d, 0)
147146
where
148-
(vu', vuRem) = dquotRem10Boxed $ vu d
147+
!(vu', vuRem) = dquotRem10Boxed $ vu d
149148

150149
trimTrailing :: BoundsState -> (BoundsState, Int32)
151150
trimTrailing d =
152-
let (d', r) = trimTrailing' d
153-
(d'', r') = if vuIsTrailingZeros d'
151+
let !(d', r) = trimTrailing' d
152+
!(d'', r') = if vuIsTrailingZeros d'
154153
then trimTrailing'' d'
155154
else (d', 0)
156155
res = if vvIsTrailingZeros d'' && lastRemovedDigit d'' == 5 && vv d'' `rem` 2 == 0
@@ -166,25 +165,25 @@ trimNoTrailing'' u' v' w' lastRemoved count =
166165
in trimNoTrailing' vu' vv' vw' ld (count +# 1#)
167166
0# -> (# u', v', lastRemoved , count #)
168167
where
169-
vu' = dquot10 u'
170-
vw' = dquot10 w'
168+
!vu' = dquot10 u'
169+
!vw' = dquot10 w'
171170

172171
trimNoTrailing' :: Word# -> Word# -> Word# -> Word# -> Int# -> (# Word#, Word#, Word#, Int# #)
173172
trimNoTrailing' u' v' w' lastRemoved count =
174173
-- Loop iterations below (approximately), without div 100 optimization:
175174
-- 0: 0.03%, 1: 13.8%, 2: 70.6%, 3: 14.0%, 4: 1.40%, 5: 0.14%, 6+: 0.02%
176175
-- Loop iterations below (approximately), with div 100 optimization:
177176
-- 0: 70.6%, 1: 27.8%, 2: 1.40%, 3: 0.14%, 4+: 0.02%
178-
let vw' = dquot100 w'
179-
vu' = dquot100 u'
177+
let !vw' = dquot100 w'
178+
!vu' = dquot100 u'
180179
in case vw' `gtWord#` vu' of
181-
1# -> let vv' = dquot100 v'
182-
ld = dquot10 (v' `minusWord#` (vv' `timesWord#` 100##))
180+
1# -> let !vv' = dquot100 v'
181+
!ld = dquot10 (v' `minusWord#` (vv' `timesWord#` 100##))
183182
in trimNoTrailing'' vu' vv' vw' ld (count +# 2#)
184183
0# -> trimNoTrailing'' u' v' w' lastRemoved count
185184

186185
trimNoTrailing :: BoundsState -> (BoundsState, Int32)
187-
trimNoTrailing (BoundsState (W64# u' ) (W64# v') (W64# w') (W64# ld) _ _) =
186+
trimNoTrailing !(BoundsState (W64# u' ) (W64# v') (W64# w') (W64# ld) _ _) =
188187
let !(# vu', vv', ld', c' #) = trimNoTrailing' u' v' w' ld 0#
189188
in (BoundsState (W64# vu') (W64# vv') 0 (W64# ld') False False, I32# c')
190189

@@ -240,31 +239,31 @@ calculate b s = vv s + asWord (roundUp b s)
240239

241240
d2d :: Word64 -> Word32 -> FloatingDecimal
242241
d2d m e =
243-
let mf = if e == 0
242+
let !mf = if e == 0
244243
then m
245244
else (1 .<< double_mantissa_bits) .|. m
246-
ef = if e == 0
245+
!ef = if e == 0
247246
then toS 1 - toS double_bias - toS double_mantissa_bits
248247
else fromIntegral e - toS double_bias - toS double_mantissa_bits
249-
e2 = fromIntegral ef - 2 :: Int32
248+
!e2 = fromIntegral ef - 2 :: Int32
250249
-- Step 2. 3-tuple (u, v, w) * 2**e2
251-
u = 4 * mf - 1 - asWord (m /= 0 || e <= 1)
252-
v = 4 * mf
253-
w = 4 * mf + 2
250+
!u = 4 * mf - 1 - asWord (m /= 0 || e <= 1)
251+
!v = 4 * mf
252+
!w = 4 * mf + 2
254253
-- Step 3. convert to decimal power base
255-
(state, e10) =
254+
!(state, e10) =
256255
if e2 >= 0
257256
then d2dGT e2 u v w
258257
else d2dLT e2 u v w
259258
-- Step 4: Find the shortest decimal representation in the interval of
260259
-- valid representations.
261-
(output, removed) =
260+
!(output, removed) =
262261
if vvIsTrailingZeros state || vuIsTrailingZeros state
263262
then pmap (\s -> calculate (not (acceptBounds v)
264263
|| not (vuIsTrailingZeros s)) s)
265264
$ trimTrailing state
266265
else pmap (calculate True) $ trimNoTrailing state
267-
e' = e10 + removed
266+
!e' = e10 + removed
268267
in FloatingDecimal output e'
269268

270269
breakdown :: Double -> (Bool, Word64, Word64)

‎Data/ByteString/Builder/RealFloat/F2S.hs

Lines changed: 29 additions & 30 deletions
Original file line numberDiff line numberDiff line change
@@ -1,5 +1,4 @@
11
{-# LANGUAGE TemplateHaskell #-}
2-
{-# LANGUAGE Strict #-}
32
{-# LANGUAGE BangPatterns, MagicHash, UnboxedTuples #-}
43

54
module Data.ByteString.Builder.RealFloat.F2S
@@ -70,21 +69,21 @@ mulPow5DivPow2 :: Word# -> Int# -> Int# -> Word#
7069
mulPow5DivPow2 m i j = mulShift32Unboxed m (get_float_pow5_split i) j
7170

7271
acceptBounds :: Word32 -> Bool
73-
acceptBounds (W32# v) = boxToBool (acceptBoundsUnboxed v)
72+
acceptBounds !(W32# v) = boxToBool (acceptBoundsUnboxed v)
7473

7574
data BoundsState = BoundsState
76-
{ vu :: Word32
77-
, vv :: Word32
78-
, vw :: Word32
79-
, lastRemovedDigit :: Word32
80-
, vuIsTrailingZeros :: Bool
81-
, vvIsTrailingZeros :: Bool
75+
{ vu :: !Word32
76+
, vv :: !Word32
77+
, vw :: !Word32
78+
, lastRemovedDigit :: !Word32
79+
, vuIsTrailingZeros :: !Bool
80+
, vvIsTrailingZeros :: !Bool
8281
}
8382

8483
trimTrailing' :: BoundsState -> (BoundsState, Int32)
85-
trimTrailing' d
84+
trimTrailing' !d
8685
| vw' > vu' =
87-
let (vv', vvRem) = fquotRem10Boxed $ vv d
86+
let !(vv', vvRem) = fquotRem10Boxed $ vv d
8887
in fmap ((+) 1) . trimTrailing' $
8988
d { vu = vu'
9089
, vv = vv'
@@ -99,10 +98,10 @@ trimTrailing' d
9998
vw' = fwrapped fquot10 (vw d)
10099

101100
trimTrailing'' :: BoundsState -> (BoundsState, Int32)
102-
trimTrailing'' d
101+
trimTrailing'' !d
103102
| vuRem == 0 =
104-
let (vv', vvRem) = fquotRem10Boxed $ vv d
105-
vw' = fwrapped fquot10 (vw d)
103+
let !(vv', vvRem) = fquotRem10Boxed $ vv d
104+
!vw' = fwrapped fquot10 (vw d)
106105
in fmap ((+) 1) . trimTrailing'' $
107106
d { vu = vu'
108107
, vv = vv'
@@ -115,9 +114,9 @@ trimTrailing'' d
115114
(vu', vuRem) = fquotRem10Boxed $ vu d
116115

117116
trimTrailing :: BoundsState -> (BoundsState, Int32)
118-
trimTrailing d =
119-
let (d', r) = trimTrailing' d
120-
(d'', r') = if vuIsTrailingZeros d'
117+
trimTrailing !d =
118+
let !(d', r) = trimTrailing' d
119+
!(d'', r') = if vuIsTrailingZeros d'
121120
then trimTrailing'' d'
122121
else (d', 0)
123122
res = if vvIsTrailingZeros d'' && lastRemovedDigit d'' == 5 && vv d'' `rem` 2 == 0
@@ -133,11 +132,11 @@ trimNoTrailing' u' v' w' lastRemoved count =
133132
in trimNoTrailing' vu' vv' vw' ld (count +# 1#)
134133
0# -> (# u', v', lastRemoved , count #)
135134
where
136-
vu' = fquot10 u'
137-
vw' = fquot10 w'
135+
!vu' = fquot10 u'
136+
!vw' = fquot10 w'
138137

139138
trimNoTrailing :: BoundsState -> (BoundsState, Int32)
140-
trimNoTrailing (BoundsState (W32# u') (W32# v') (W32# w') (W32# ld) _ _) =
139+
trimNoTrailing !(BoundsState (W32# u') (W32# v') (W32# w') (W32# ld) _ _) =
141140
let !(# vu', vv', ld', c' #) = trimNoTrailing' u' v' w' ld 0#
142141
in (BoundsState (W32# vu') (W32# vv') 0 (W32# ld') False False, I32# c')
143142

@@ -150,7 +149,7 @@ f2dGT (I32# e2) (W32# u) (W32# v) (W32# w) =
150149
u' = mulPow5InvDivPow2 u q i
151150
v' = mulPow5InvDivPow2 v q i
152151
w' = mulPow5InvDivPow2 w q i
153-
lastRemoved =
152+
!lastRemoved =
154153
case (q `neWord#` 0##) `andI#` ((fquot10 (w' `minusWord#` 1##)) `leWord#` fquot10 u') of
155154
-- We need to know one removed digit even if we are not going to loop
156155
-- below. We could use q = X - 1 above, except that would require 33
@@ -181,7 +180,7 @@ f2dLT (I32# e2) (W32# u) (W32# v) (W32# w) =
181180
u' = mulPow5DivPow2 u i j
182181
v' = mulPow5DivPow2 v i j
183182
w' = mulPow5DivPow2 w i j
184-
lastRemoved =
183+
!lastRemoved =
185184
case (q `neWord#` 0##) `andI#` ((fquot10 (u'`minusWord#` 1##)) `leWord#` fquot10 u') of
186185
1# -> let j' = word2Int# q -# 1# -# (pow5bitsUnboxed (i +# 1#) -# unbox float_pow5_bitcount)
187186
in frem10 (mulPow5DivPow2 v (i +# 1#) j')
@@ -206,31 +205,31 @@ calculate b s = vv s + asWord (roundUp b s)
206205

207206
f2d :: Word32 -> Word32 -> FloatingDecimal
208207
f2d m e =
209-
let mf = if e == 0
208+
let !mf = if e == 0
210209
then m
211210
else (1 .<< float_mantissa_bits) .|. m
212-
ef = if e == 0
211+
!ef = if e == 0
213212
then toS 1 - toS (float_bias + float_mantissa_bits)
214213
else toS e - toS (float_bias + float_mantissa_bits)
215-
e2 = ef - 2
214+
!e2 = ef - 2
216215
-- Step 2. 3-tuple (u, v, w) * 2**e2
217-
u = 4 * mf - 1 - asWord (m /= 0 || e <= 1)
218-
v = 4 * mf
219-
w = 4 * mf + 2
216+
!u = 4 * mf - 1 - asWord (m /= 0 || e <= 1)
217+
!v = 4 * mf
218+
!w = 4 * mf + 2
220219
-- Step 3. convert to decimal power base
221-
(state, e10) =
220+
!(state, e10) =
222221
if e2 >= 0
223222
then f2dGT e2 u v w
224223
else f2dLT e2 u v w
225224
-- Step 4: Find the shortest decimal representation in the interval of
226225
-- valid representations.
227-
(output, removed) =
226+
!(output, removed) =
228227
if vvIsTrailingZeros state || vuIsTrailingZeros state
229228
then pmap (\s -> calculate (not (acceptBounds v)
230229
|| not (vuIsTrailingZeros s)) s)
231230
$ trimTrailing state
232231
else pmap (calculate True) $ trimNoTrailing state
233-
e' = e10 + removed
232+
!e' = e10 + removed
234233
in FloatingDecimal output e'
235234

236235
breakdown :: Float -> (Bool, Word32, Word32)

‎Data/ByteString/Builder/RealFloat/Internal.hs

Lines changed: 13 additions & 14 deletions
Original file line numberDiff line numberDiff line change
@@ -1,4 +1,3 @@
1-
{-# LANGUAGE Strict #-}
21
{-# LANGUAGE FlexibleContexts #-}
32
{-# LANGUAGE BangPatterns, MagicHash, UnboxedTuples #-}
43

@@ -189,10 +188,10 @@ acceptBoundsUnboxed _ = 0#
189188
-- acceptBoundsUnboxed v = ((v `uncheckedShiftRL#` 2#) `and#` 1##) `eqWord#` 0##
190189

191190
fcoerceToWord :: Float -> Word32
192-
fcoerceToWord x = runST (cast x)
191+
fcoerceToWord !x = runST (cast x)
193192

194193
dcoerceToWord :: Double -> Word64
195-
dcoerceToWord x = runST (cast x)
194+
dcoerceToWord !x = runST (cast x)
196195

197196
{-# INLINE cast #-}
198197
cast :: (MArray (STUArray s) a (ST s),
@@ -344,23 +343,23 @@ second = fromIntegral
344343
{-# SPECIALIZE writeMantissa :: Ptr Word8 -> Int -> Word32 -> IO (Ptr Word8) #-}
345344
{-# SPECIALIZE writeMantissa :: Ptr Word8 -> Int -> Word64 -> IO (Ptr Word8) #-}
346345
writeMantissa :: (Mantissa a) => Ptr Word8 -> Int -> a -> IO (Ptr Word8)
347-
writeMantissa ptr olength = go (ptr `plusPtr` olength)
346+
writeMantissa !ptr !olength = go (ptr `plusPtr` olength)
348347
where
349-
go p mantissa
348+
go !p !mantissa
350349
| mantissa >= 10000 = do
351-
let (m', c) = quotRem10000 mantissa
352-
(c1, c0) = quotRem100 c
350+
let !(m', c) = quotRem10000 mantissa
351+
!(c1, c0) = quotRem100 c
353352
copy (digit_table `unsafeAt` fromIntegral c0) (p `plusPtr` (-1))
354353
copy (digit_table `unsafeAt` fromIntegral c1) (p `plusPtr` (-3))
355354
go (p `plusPtr` (-4)) m'
356355
| mantissa >= 100 = do
357-
let (m', c) = quotRem100 mantissa
356+
let !(m', c) = quotRem100 mantissa
358357
copy (digit_table `unsafeAt` fromIntegral c) (p `plusPtr` (-1))
359358
finalize m'
360359
| otherwise = finalize mantissa
361360
finalize mantissa
362361
| mantissa >= 10 = do
363-
let bs = digit_table `unsafeAt` fromIntegral mantissa
362+
let !bs = digit_table `unsafeAt` fromIntegral mantissa
364363
poke (ptr `plusPtr` 2) (first bs)
365364
poke (ptr `plusPtr` 1) (c2w '.')
366365
poke ptr (second bs)
@@ -375,9 +374,9 @@ writeMantissa ptr olength = go (ptr `plusPtr` olength)
375374
return (ptr `plusPtr` 3)
376375

377376
writeExponent :: Ptr Word8 -> Int32 -> IO (Ptr Word8)
378-
writeExponent ptr expo
377+
writeExponent !ptr !expo
379378
| expo >= 100 = do
380-
let (e1, e0) = fquotRem10Boxed (fromIntegral expo)
379+
let !(e1, e0) = fquotRem10Boxed (fromIntegral expo)
381380
copy (digit_table `unsafeAt` fromIntegral e1) ptr
382381
poke (ptr `plusPtr` 2) (toAscii e0 :: Word8)
383382
return $ ptr `plusPtr` 3
@@ -398,9 +397,9 @@ writeSign ptr False = return ptr
398397
{-# SPECIALIZE toCharsScientific :: Bool -> Word32 -> Int32 -> BoundedPrim () #-}
399398
{-# SPECIALIZE toCharsScientific :: Bool -> Word64 -> Int32 -> BoundedPrim () #-}
400399
toCharsScientific :: (Mantissa a) => Bool -> a -> Int32 -> BoundedPrim ()
401-
toCharsScientific sign mantissa expo = boundedPrim maxEncodedLength $ \_ p0 -> do
402-
let olength = decimalLength mantissa
403-
expo' = expo + fromIntegral olength - 1
400+
toCharsScientific !sign !mantissa !expo = boundedPrim maxEncodedLength $ \_ !p0 -> do
401+
let !olength = decimalLength mantissa
402+
!expo' = expo + fromIntegral olength - 1
404403
p1 <- writeSign p0 sign
405404
p2 <- writeMantissa p1 olength mantissa
406405
poke p2 (c2w 'e')

0 commit comments

Comments
 (0)