From 567e8a659b3ab4ccdd87c434394e82fc8ca01df5 Mon Sep 17 00:00:00 2001 From: Lawrence Wu Date: Sun, 21 Feb 2021 22:38:50 -0600 Subject: [PATCH] Use manual strictness - Strict extension is from ghc >= 8.0.1 --- Data/ByteString/Builder/RealFloat/D2S.hs | 65 +++++++++---------- Data/ByteString/Builder/RealFloat/F2S.hs | 59 +++++++++-------- Data/ByteString/Builder/RealFloat/Internal.hs | 27 ++++---- 3 files changed, 74 insertions(+), 77 deletions(-) diff --git a/Data/ByteString/Builder/RealFloat/D2S.hs b/Data/ByteString/Builder/RealFloat/D2S.hs index e6ea77447..676531cb1 100644 --- a/Data/ByteString/Builder/RealFloat/D2S.hs +++ b/Data/ByteString/Builder/RealFloat/D2S.hs @@ -1,5 +1,4 @@ {-# LANGUAGE TemplateHaskell #-} -{-# LANGUAGE Strict #-} {-# LANGUAGE BangPatterns, MagicHash, UnboxedTuples #-} module Data.ByteString.Builder.RealFloat.D2S @@ -103,21 +102,21 @@ mulPow5InvDivPow2 m q j = mulShift64Unboxed m (get_double_pow5_inv_split (word2I acceptBounds :: Word64 -> Bool -acceptBounds (W64# v) = boxToBool (acceptBoundsUnboxed v) +acceptBounds !(W64# v) = boxToBool (acceptBoundsUnboxed v) data BoundsState = BoundsState - { vu :: Word64 - , vv :: Word64 - , vw :: Word64 - , lastRemovedDigit :: Word64 - , vuIsTrailingZeros :: Bool - , vvIsTrailingZeros :: Bool + { vu :: !Word64 + , vv :: !Word64 + , vw :: !Word64 + , lastRemovedDigit :: !Word64 + , vuIsTrailingZeros :: !Bool + , vvIsTrailingZeros :: !Bool } deriving Show trimTrailing' :: BoundsState -> (BoundsState, Int32) -trimTrailing' d +trimTrailing' !d | vw' > vu' = - let (vv', vvRem) = dquotRem10Boxed $ vv d + let !(vv', vvRem) = dquotRem10Boxed $ vv d in fmap ((+) 1) . trimTrailing' $ d { vu = vu' , vv = vv' @@ -128,14 +127,14 @@ trimTrailing' d } | otherwise = (d, 0) where - (vu', vuRem) = dquotRem10Boxed $ vu d - vw' = dwrapped dquot10 (vw d) + !(vu', vuRem) = dquotRem10Boxed $ vu d + !vw' = dwrapped dquot10 (vw d) trimTrailing'' :: BoundsState -> (BoundsState, Int32) trimTrailing'' d | vuRem == 0 = - let (vv', vvRem) = dquotRem10Boxed $ vv d - vw' = dwrapped dquot10 (vw d) + let !(vv', vvRem) = dquotRem10Boxed $ vv d + !vw' = dwrapped dquot10 (vw d) in fmap ((+) 1) . trimTrailing'' $ d { vu = vu' , vv = vv' @@ -145,12 +144,12 @@ trimTrailing'' d } | otherwise = (d, 0) where - (vu', vuRem) = dquotRem10Boxed $ vu d + !(vu', vuRem) = dquotRem10Boxed $ vu d trimTrailing :: BoundsState -> (BoundsState, Int32) trimTrailing d = - let (d', r) = trimTrailing' d - (d'', r') = if vuIsTrailingZeros d' + let !(d', r) = trimTrailing' d + !(d'', r') = if vuIsTrailingZeros d' then trimTrailing'' d' else (d', 0) res = if vvIsTrailingZeros d'' && lastRemovedDigit d'' == 5 && vv d'' `rem` 2 == 0 @@ -166,8 +165,8 @@ trimNoTrailing'' u' v' w' lastRemoved count = in trimNoTrailing' vu' vv' vw' ld (count +# 1#) 0# -> (# u', v', lastRemoved , count #) where - vu' = dquot10 u' - vw' = dquot10 w' + !vu' = dquot10 u' + !vw' = dquot10 w' trimNoTrailing' :: Word# -> Word# -> Word# -> Word# -> Int# -> (# Word#, Word#, Word#, Int# #) trimNoTrailing' u' v' w' lastRemoved count = @@ -175,16 +174,16 @@ trimNoTrailing' u' v' w' lastRemoved count = -- 0: 0.03%, 1: 13.8%, 2: 70.6%, 3: 14.0%, 4: 1.40%, 5: 0.14%, 6+: 0.02% -- Loop iterations below (approximately), with div 100 optimization: -- 0: 70.6%, 1: 27.8%, 2: 1.40%, 3: 0.14%, 4+: 0.02% - let vw' = dquot100 w' - vu' = dquot100 u' + let !vw' = dquot100 w' + !vu' = dquot100 u' in case vw' `gtWord#` vu' of - 1# -> let vv' = dquot100 v' - ld = dquot10 (v' `minusWord#` (vv' `timesWord#` 100##)) + 1# -> let !vv' = dquot100 v' + !ld = dquot10 (v' `minusWord#` (vv' `timesWord#` 100##)) in trimNoTrailing'' vu' vv' vw' ld (count +# 2#) 0# -> trimNoTrailing'' u' v' w' lastRemoved count trimNoTrailing :: BoundsState -> (BoundsState, Int32) -trimNoTrailing (BoundsState (W64# u' ) (W64# v') (W64# w') (W64# ld) _ _) = +trimNoTrailing !(BoundsState (W64# u' ) (W64# v') (W64# w') (W64# ld) _ _) = let !(# vu', vv', ld', c' #) = trimNoTrailing' u' v' w' ld 0# in (BoundsState (W64# vu') (W64# vv') 0 (W64# ld') False False, I32# c') @@ -240,31 +239,31 @@ calculate b s = vv s + asWord (roundUp b s) d2d :: Word64 -> Word32 -> FloatingDecimal d2d m e = - let mf = if e == 0 + let !mf = if e == 0 then m else (1 .<< double_mantissa_bits) .|. m - ef = if e == 0 + !ef = if e == 0 then toS 1 - toS double_bias - toS double_mantissa_bits else fromIntegral e - toS double_bias - toS double_mantissa_bits - e2 = fromIntegral ef - 2 :: Int32 + !e2 = fromIntegral ef - 2 :: Int32 -- Step 2. 3-tuple (u, v, w) * 2**e2 - u = 4 * mf - 1 - asWord (m /= 0 || e <= 1) - v = 4 * mf - w = 4 * mf + 2 + !u = 4 * mf - 1 - asWord (m /= 0 || e <= 1) + !v = 4 * mf + !w = 4 * mf + 2 -- Step 3. convert to decimal power base - (state, e10) = + !(state, e10) = if e2 >= 0 then d2dGT e2 u v w else d2dLT e2 u v w -- Step 4: Find the shortest decimal representation in the interval of -- valid representations. - (output, removed) = + !(output, removed) = if vvIsTrailingZeros state || vuIsTrailingZeros state then pmap (\s -> calculate (not (acceptBounds v) || not (vuIsTrailingZeros s)) s) $ trimTrailing state else pmap (calculate True) $ trimNoTrailing state - e' = e10 + removed + !e' = e10 + removed in FloatingDecimal output e' breakdown :: Double -> (Bool, Word64, Word64) diff --git a/Data/ByteString/Builder/RealFloat/F2S.hs b/Data/ByteString/Builder/RealFloat/F2S.hs index 023142893..6f350213a 100644 --- a/Data/ByteString/Builder/RealFloat/F2S.hs +++ b/Data/ByteString/Builder/RealFloat/F2S.hs @@ -1,5 +1,4 @@ {-# LANGUAGE TemplateHaskell #-} -{-# LANGUAGE Strict #-} {-# LANGUAGE BangPatterns, MagicHash, UnboxedTuples #-} module Data.ByteString.Builder.RealFloat.F2S @@ -70,21 +69,21 @@ mulPow5DivPow2 :: Word# -> Int# -> Int# -> Word# mulPow5DivPow2 m i j = mulShift32Unboxed m (get_float_pow5_split i) j acceptBounds :: Word32 -> Bool -acceptBounds (W32# v) = boxToBool (acceptBoundsUnboxed v) +acceptBounds !(W32# v) = boxToBool (acceptBoundsUnboxed v) data BoundsState = BoundsState - { vu :: Word32 - , vv :: Word32 - , vw :: Word32 - , lastRemovedDigit :: Word32 - , vuIsTrailingZeros :: Bool - , vvIsTrailingZeros :: Bool + { vu :: !Word32 + , vv :: !Word32 + , vw :: !Word32 + , lastRemovedDigit :: !Word32 + , vuIsTrailingZeros :: !Bool + , vvIsTrailingZeros :: !Bool } trimTrailing' :: BoundsState -> (BoundsState, Int32) -trimTrailing' d +trimTrailing' !d | vw' > vu' = - let (vv', vvRem) = fquotRem10Boxed $ vv d + let !(vv', vvRem) = fquotRem10Boxed $ vv d in fmap ((+) 1) . trimTrailing' $ d { vu = vu' , vv = vv' @@ -99,10 +98,10 @@ trimTrailing' d vw' = fwrapped fquot10 (vw d) trimTrailing'' :: BoundsState -> (BoundsState, Int32) -trimTrailing'' d +trimTrailing'' !d | vuRem == 0 = - let (vv', vvRem) = fquotRem10Boxed $ vv d - vw' = fwrapped fquot10 (vw d) + let !(vv', vvRem) = fquotRem10Boxed $ vv d + !vw' = fwrapped fquot10 (vw d) in fmap ((+) 1) . trimTrailing'' $ d { vu = vu' , vv = vv' @@ -115,9 +114,9 @@ trimTrailing'' d (vu', vuRem) = fquotRem10Boxed $ vu d trimTrailing :: BoundsState -> (BoundsState, Int32) -trimTrailing d = - let (d', r) = trimTrailing' d - (d'', r') = if vuIsTrailingZeros d' +trimTrailing !d = + let !(d', r) = trimTrailing' d + !(d'', r') = if vuIsTrailingZeros d' then trimTrailing'' d' else (d', 0) res = if vvIsTrailingZeros d'' && lastRemovedDigit d'' == 5 && vv d'' `rem` 2 == 0 @@ -133,11 +132,11 @@ trimNoTrailing' u' v' w' lastRemoved count = in trimNoTrailing' vu' vv' vw' ld (count +# 1#) 0# -> (# u', v', lastRemoved , count #) where - vu' = fquot10 u' - vw' = fquot10 w' + !vu' = fquot10 u' + !vw' = fquot10 w' trimNoTrailing :: BoundsState -> (BoundsState, Int32) -trimNoTrailing (BoundsState (W32# u') (W32# v') (W32# w') (W32# ld) _ _) = +trimNoTrailing !(BoundsState (W32# u') (W32# v') (W32# w') (W32# ld) _ _) = let !(# vu', vv', ld', c' #) = trimNoTrailing' u' v' w' ld 0# in (BoundsState (W32# vu') (W32# vv') 0 (W32# ld') False False, I32# c') @@ -150,7 +149,7 @@ f2dGT (I32# e2) (W32# u) (W32# v) (W32# w) = u' = mulPow5InvDivPow2 u q i v' = mulPow5InvDivPow2 v q i w' = mulPow5InvDivPow2 w q i - lastRemoved = + !lastRemoved = case (q `neWord#` 0##) `andI#` ((fquot10 (w' `minusWord#` 1##)) `leWord#` fquot10 u') of -- We need to know one removed digit even if we are not going to loop -- 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) = u' = mulPow5DivPow2 u i j v' = mulPow5DivPow2 v i j w' = mulPow5DivPow2 w i j - lastRemoved = + !lastRemoved = case (q `neWord#` 0##) `andI#` ((fquot10 (u'`minusWord#` 1##)) `leWord#` fquot10 u') of 1# -> let j' = word2Int# q -# 1# -# (pow5bitsUnboxed (i +# 1#) -# unbox float_pow5_bitcount) in frem10 (mulPow5DivPow2 v (i +# 1#) j') @@ -206,31 +205,31 @@ calculate b s = vv s + asWord (roundUp b s) f2d :: Word32 -> Word32 -> FloatingDecimal f2d m e = - let mf = if e == 0 + let !mf = if e == 0 then m else (1 .<< float_mantissa_bits) .|. m - ef = if e == 0 + !ef = if e == 0 then toS 1 - toS (float_bias + float_mantissa_bits) else toS e - toS (float_bias + float_mantissa_bits) - e2 = ef - 2 + !e2 = ef - 2 -- Step 2. 3-tuple (u, v, w) * 2**e2 - u = 4 * mf - 1 - asWord (m /= 0 || e <= 1) - v = 4 * mf - w = 4 * mf + 2 + !u = 4 * mf - 1 - asWord (m /= 0 || e <= 1) + !v = 4 * mf + !w = 4 * mf + 2 -- Step 3. convert to decimal power base - (state, e10) = + !(state, e10) = if e2 >= 0 then f2dGT e2 u v w else f2dLT e2 u v w -- Step 4: Find the shortest decimal representation in the interval of -- valid representations. - (output, removed) = + !(output, removed) = if vvIsTrailingZeros state || vuIsTrailingZeros state then pmap (\s -> calculate (not (acceptBounds v) || not (vuIsTrailingZeros s)) s) $ trimTrailing state else pmap (calculate True) $ trimNoTrailing state - e' = e10 + removed + !e' = e10 + removed in FloatingDecimal output e' breakdown :: Float -> (Bool, Word32, Word32) diff --git a/Data/ByteString/Builder/RealFloat/Internal.hs b/Data/ByteString/Builder/RealFloat/Internal.hs index f964bf22e..8953f1694 100644 --- a/Data/ByteString/Builder/RealFloat/Internal.hs +++ b/Data/ByteString/Builder/RealFloat/Internal.hs @@ -1,4 +1,3 @@ -{-# LANGUAGE Strict #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE BangPatterns, MagicHash, UnboxedTuples #-} @@ -189,10 +188,10 @@ acceptBoundsUnboxed _ = 0# -- acceptBoundsUnboxed v = ((v `uncheckedShiftRL#` 2#) `and#` 1##) `eqWord#` 0## fcoerceToWord :: Float -> Word32 -fcoerceToWord x = runST (cast x) +fcoerceToWord !x = runST (cast x) dcoerceToWord :: Double -> Word64 -dcoerceToWord x = runST (cast x) +dcoerceToWord !x = runST (cast x) {-# INLINE cast #-} cast :: (MArray (STUArray s) a (ST s), @@ -344,23 +343,23 @@ second = fromIntegral {-# SPECIALIZE writeMantissa :: Ptr Word8 -> Int -> Word32 -> IO (Ptr Word8) #-} {-# SPECIALIZE writeMantissa :: Ptr Word8 -> Int -> Word64 -> IO (Ptr Word8) #-} writeMantissa :: (Mantissa a) => Ptr Word8 -> Int -> a -> IO (Ptr Word8) -writeMantissa ptr olength = go (ptr `plusPtr` olength) +writeMantissa !ptr !olength = go (ptr `plusPtr` olength) where - go p mantissa + go !p !mantissa | mantissa >= 10000 = do - let (m', c) = quotRem10000 mantissa - (c1, c0) = quotRem100 c + let !(m', c) = quotRem10000 mantissa + !(c1, c0) = quotRem100 c copy (digit_table `unsafeAt` fromIntegral c0) (p `plusPtr` (-1)) copy (digit_table `unsafeAt` fromIntegral c1) (p `plusPtr` (-3)) go (p `plusPtr` (-4)) m' | mantissa >= 100 = do - let (m', c) = quotRem100 mantissa + let !(m', c) = quotRem100 mantissa copy (digit_table `unsafeAt` fromIntegral c) (p `plusPtr` (-1)) finalize m' | otherwise = finalize mantissa finalize mantissa | mantissa >= 10 = do - let bs = digit_table `unsafeAt` fromIntegral mantissa + let !bs = digit_table `unsafeAt` fromIntegral mantissa poke (ptr `plusPtr` 2) (first bs) poke (ptr `plusPtr` 1) (c2w '.') poke ptr (second bs) @@ -375,9 +374,9 @@ writeMantissa ptr olength = go (ptr `plusPtr` olength) return (ptr `plusPtr` 3) writeExponent :: Ptr Word8 -> Int32 -> IO (Ptr Word8) -writeExponent ptr expo +writeExponent !ptr !expo | expo >= 100 = do - let (e1, e0) = fquotRem10Boxed (fromIntegral expo) + let !(e1, e0) = fquotRem10Boxed (fromIntegral expo) copy (digit_table `unsafeAt` fromIntegral e1) ptr poke (ptr `plusPtr` 2) (toAscii e0 :: Word8) return $ ptr `plusPtr` 3 @@ -398,9 +397,9 @@ writeSign ptr False = return ptr {-# SPECIALIZE toCharsScientific :: Bool -> Word32 -> Int32 -> BoundedPrim () #-} {-# SPECIALIZE toCharsScientific :: Bool -> Word64 -> Int32 -> BoundedPrim () #-} toCharsScientific :: (Mantissa a) => Bool -> a -> Int32 -> BoundedPrim () -toCharsScientific sign mantissa expo = boundedPrim maxEncodedLength $ \_ p0 -> do - let olength = decimalLength mantissa - expo' = expo + fromIntegral olength - 1 +toCharsScientific !sign !mantissa !expo = boundedPrim maxEncodedLength $ \_ !p0 -> do + let !olength = decimalLength mantissa + !expo' = expo + fromIntegral olength - 1 p1 <- writeSign p0 sign p2 <- writeMantissa p1 olength mantissa poke p2 (c2w 'e')