Hello community, here is the log from the commit of package ghc-scientific for openSUSE:Factory checked in at 2017-06-21 13:55:53 ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ Comparing /work/SRC/openSUSE:Factory/ghc-scientific (Old) and /work/SRC/openSUSE:Factory/.ghc-scientific.new (New) ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
Package is "ghc-scientific" Wed Jun 21 13:55:53 2017 rev:15 rq:504677 version:0.3.4.15 Changes: -------- --- /work/SRC/openSUSE:Factory/ghc-scientific/ghc-scientific.changes 2017-05-06 18:29:02.320415313 +0200 +++ /work/SRC/openSUSE:Factory/.ghc-scientific.new/ghc-scientific.changes 2017-06-21 13:55:53.574362033 +0200 @@ -1,0 +2,10 @@ +Mon Jun 12 09:41:44 UTC 2017 - [email protected] + +- Update to version 0.3.4.15. + +------------------------------------------------------------------- +Wed May 31 14:01:07 UTC 2017 - [email protected] + +- Update to version 0.3.4.13. + +------------------------------------------------------------------- Old: ---- scientific-0.3.4.12.tar.gz New: ---- scientific-0.3.4.15.tar.gz ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ Other differences: ------------------ ++++++ ghc-scientific.spec ++++++ --- /var/tmp/diff_new_pack.LudrUV/_old 2017-06-21 13:55:54.302259357 +0200 +++ /var/tmp/diff_new_pack.LudrUV/_new 2017-06-21 13:55:54.310258229 +0200 @@ -19,7 +19,7 @@ %global pkg_name scientific %bcond_with tests Name: ghc-%{pkg_name} -Version: 0.3.4.12 +Version: 0.3.4.15 Release: 0 Summary: Numbers represented using scientific notation License: BSD-3-Clause ++++++ scientific-0.3.4.12.tar.gz -> scientific-0.3.4.15.tar.gz ++++++ diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/scientific-0.3.4.12/bench/bench.hs new/scientific-0.3.4.15/bench/bench.hs --- old/scientific-0.3.4.12/bench/bench.hs 2017-04-11 16:40:48.000000000 +0200 +++ new/scientific-0.3.4.15/bench/bench.hs 2017-06-04 22:37:46.000000000 +0200 @@ -1,16 +1,20 @@ module Main where import Criterion.Main +import Data.Int +import Data.Word import Data.Scientific main :: IO () main = defaultMain [ bgroup "realToFrac" [ bgroup "Scientific->Double" - [ sToD "pos" pos - , sToD "neg" neg - , sToD "int" int - , sToD "negInt" negInt + [ sToD "dangerouslyBig" dangerouslyBig + , sToD "dangerouslySmall" dangerouslySmall + , sToD "pos" pos + , sToD "neg" neg + , sToD "int" int + , sToD "negInt" negInt ] , bgroup "Double->Scientific" [ dToS "pos" pos @@ -40,6 +44,19 @@ , bgroup "toDecimalDigits" [ bench "big" (nf toDecimalDigits $! big) ] + + , bgroup "fromFloatDigits" + [ bench "pos" $ nf (fromFloatDigits :: Double -> Scientific) pos + , bench "neg" $ nf (fromFloatDigits :: Double -> Scientific) neg + , bench "int" $ nf (fromFloatDigits :: Double -> Scientific) int + , bench "negInt" $ nf (fromFloatDigits :: Double -> Scientific) negInt + ] + + , bgroup "toBoundedInteger" + [ bgroup "0" $ benchToBoundedInteger 0 + , bgroup "dangerouslyBig" $ benchToBoundedInteger dangerouslyBig + , bgroup "64" $ benchToBoundedInteger 64 + ] ] where pos :: Fractional a => a @@ -57,6 +74,12 @@ big :: Scientific big = read $ "0." ++ concat (replicate 20 "0123456789") + dangerouslyBig :: Scientific + dangerouslyBig = read "1e500" + + dangerouslySmall :: Scientific + dangerouslySmall = read "1e-500" + realToFracStoD :: Scientific -> Double realToFracStoD = fromRational . toRational {-# INLINE realToFracStoD #-} @@ -65,11 +88,10 @@ realToFracDtoS = fromRational . toRational {-# INLINE realToFracDtoS #-} - sToD :: String -> Scientific -> Benchmark sToD name f = bgroup name - [ bench "fromScientific" . nf (realToFrac :: Scientific -> Double) $! f - , bench "via Rational" . nf (realToFracStoD :: Scientific -> Double) $! f + [ bench "toRealFloat" . nf (realToFrac :: Scientific -> Double) $! f + , bench "via Rational" . nf (realToFracStoD :: Scientific -> Double) $! f ] dToS :: String -> Double -> Benchmark @@ -101,3 +123,17 @@ 1 -> m _ -> error "round default defn: Bad value" {-# INLINE roundDefault #-} + +benchToBoundedInteger :: Scientific -> [Benchmark] +benchToBoundedInteger s = + [ bench "Int" $ nf (toBoundedInteger :: Scientific -> Maybe Int) s + , bench "Int8" $ nf (toBoundedInteger :: Scientific -> Maybe Int8) s + , bench "Int16" $ nf (toBoundedInteger :: Scientific -> Maybe Int16) s + , bench "Int32" $ nf (toBoundedInteger :: Scientific -> Maybe Int32) s + , bench "Int64" $ nf (toBoundedInteger :: Scientific -> Maybe Int64) s + , bench "Word" $ nf (toBoundedInteger :: Scientific -> Maybe Word) s + , bench "Word8" $ nf (toBoundedInteger :: Scientific -> Maybe Word8) s + , bench "Word16" $ nf (toBoundedInteger :: Scientific -> Maybe Word16) s + , bench "Word32" $ nf (toBoundedInteger :: Scientific -> Maybe Word32) s + , bench "Word64" $ nf (toBoundedInteger :: Scientific -> Maybe Word64) s + ] diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/scientific-0.3.4.12/changelog new/scientific-0.3.4.15/changelog --- old/scientific-0.3.4.12/changelog 2017-04-11 16:40:48.000000000 +0200 +++ new/scientific-0.3.4.15/changelog 2017-06-04 22:37:46.000000000 +0200 @@ -1,3 +1,12 @@ +0.3.4.15 + * Fix build for base < 4.8. + +0.3.4.14 + * Some minor performance improvements. + +0.3.4.13 + * Support criterion-1.2 + 0.3.4.12 * Support base-4.10 diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/scientific-0.3.4.12/scientific.cabal new/scientific-0.3.4.15/scientific.cabal --- old/scientific-0.3.4.12/scientific.cabal 2017-04-11 16:40:48.000000000 +0200 +++ new/scientific-0.3.4.15/scientific.cabal 2017-06-04 22:37:46.000000000 +0200 @@ -1,5 +1,5 @@ name: scientific -version: 0.3.4.12 +version: 0.3.4.15 synopsis: Numbers represented using scientific notation description: @Data.Scientific@ provides the number type 'Scientific'. Scientific numbers are @@ -123,4 +123,4 @@ ghc-options: -O2 build-depends: scientific , base >= 4.3 && < 4.11 - , criterion >= 0.5 && < 1.2 + , criterion >= 0.5 && < 1.3 diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/scientific-0.3.4.12/src/Data/Scientific.hs new/scientific-0.3.4.15/src/Data/Scientific.hs --- old/scientific-0.3.4.12/src/Data/Scientific.hs 2017-04-11 16:40:48.000000000 +0200 +++ new/scientific-0.3.4.15/src/Data/Scientific.hs 2017-06-04 22:37:46.000000000 +0200 @@ -98,11 +98,13 @@ import Data.Data (Data) import Data.Function (on) import Data.Hashable (Hashable(..)) +import Data.Int (Int8, Int16, Int32, Int64) import qualified Data.Map as M (Map, empty, insert, lookup) import Data.Ratio ((%), numerator, denominator) import Data.Typeable (Typeable) import qualified Data.Vector as V import qualified Data.Vector.Mutable as VM +import Data.Word (Word, Word8, Word16, Word32, Word64) import Math.NumberTheory.Logarithms (integerLog10') import qualified Numeric (floatToDigits) import qualified Text.Read as Read @@ -184,26 +186,26 @@ instance Eq Scientific where (==) = (==) `on` toRational - {-# INLINE (==) #-} + {-# INLINABLE (==) #-} (/=) = (/=) `on` toRational - {-# INLINE (/=) #-} + {-# INLINABLE (/=) #-} instance Ord Scientific where (<) = (<) `on` toRational - {-# INLINE (<) #-} + {-# INLINABLE (<) #-} (<=) = (<=) `on` toRational - {-# INLINE (<=) #-} + {-# INLINABLE (<=) #-} (>) = (>) `on` toRational - {-# INLINE (>) #-} + {-# INLINABLE (>) #-} (>=) = (>=) `on` toRational - {-# INLINE (>=) #-} + {-# INLINABLE (>=) #-} compare = compare `on` toRational - {-# INLINE compare #-} + {-# INLINABLE compare #-} instance Num Scientific where Scientific c1 e1 + Scientific c2 e2 @@ -212,7 +214,7 @@ where l = magnitude (e2 - e1) r = magnitude (e1 - e2) - {-# INLINE (+) #-} + {-# INLINABLE (+) #-} Scientific c1 e1 - Scientific c2 e2 | e1 < e2 = Scientific (c1 - c2*l) e1 @@ -220,23 +222,23 @@ where l = magnitude (e2 - e1) r = magnitude (e1 - e2) - {-# INLINE (-) #-} + {-# INLINABLE (-) #-} Scientific c1 e1 * Scientific c2 e2 = Scientific (c1 * c2) (e1 + e2) - {-# INLINE (*) #-} + {-# INLINABLE (*) #-} abs (Scientific c e) = Scientific (abs c) e - {-# INLINE abs #-} + {-# INLINABLE abs #-} negate (Scientific c e) = Scientific (negate c) e - {-# INLINE negate #-} + {-# INLINABLE negate #-} signum (Scientific c _) = Scientific (signum c) 0 - {-# INLINE signum #-} + {-# INLINABLE signum #-} fromInteger i = Scientific i 0 - {-# INLINE fromInteger #-} + {-# INLINABLE fromInteger #-} -- | /WARNING:/ 'toRational' needs to compute the 'Integer' magnitude: -- @10^e@. If applied to a huge exponent this could fill up all space @@ -249,7 +251,7 @@ toRational (Scientific c e) | e < 0 = c % magnitude (-e) | otherwise = (c * magnitude e) % 1 - {-# INLINE toRational #-} + {-# INLINABLE toRational #-} {-# RULES "realToFrac_toRealFloat_Double" @@ -267,10 +269,10 @@ -- the repetition and indicate where it starts. instance Fractional Scientific where recip = fromRational . recip . toRational - {-# INLINE recip #-} + {-# INLINABLE recip #-} x / y = fromRational $ toRational x / toRational y - {-# INLINE (/) #-} + {-# INLINABLE (/) #-} fromRational rational | d == 0 = throw DivideByZero @@ -352,7 +354,8 @@ longDivNoLimit !c !e _ns 0 = (Scientific c e, Nothing) longDivNoLimit !c !e ns !n | Just e' <- M.lookup n ns = (Scientific c e, Just (-e')) - | n < d = longDivNoLimit (c * 10) (e - 1) (M.insert n e ns) (n * 10) + | n < d = let !ns' = M.insert n e ns + in longDivNoLimit (c * 10) (e - 1) ns' (n * 10) | otherwise = case n `quotRemInteger` d of (#q, r#) -> longDivNoLimit (c + q) e ns r @@ -367,7 +370,8 @@ go !c !e ns !n | Just e' <- M.lookup n ns = Right (Scientific c e, Just (-e')) | e <= l = Left (Scientific c e, n % (d * magnitude (-e))) - | n < d = go (c * 10) (e - 1) (M.insert n e ns) (n * 10) + | n < d = let !ns' = M.insert n e ns + in go (c * 10) (e - 1) ns' (n * 10) | otherwise = case n `quotRemInteger` d of (#q, r#) -> go (c + q) e ns r @@ -450,7 +454,7 @@ else case c `quotRemInteger` magnitude (-e) of (#q, r#) -> (fromInteger q, Scientific r e) | otherwise = (toIntegral s, 0) - {-# INLINE properFraction #-} + {-# INLINABLE properFraction #-} -- | @'truncate' s@ returns the integer nearest @s@ -- between zero and @s@ @@ -458,7 +462,7 @@ if dangerouslySmall c e then 0 else fromInteger $ c `quotInteger` magnitude (-e) - {-# INLINE truncate #-} + {-# INLINABLE truncate #-} -- | @'round' s@ returns the nearest integer to @s@; -- the even integer if @s@ is equidistant between two integers @@ -475,7 +479,7 @@ 0 -> if even n then n else m 1 -> m _ -> error "round default defn: Bad value" - {-# INLINE round #-} + {-# INLINABLE round #-} -- | @'ceiling' s@ returns the least integer not less than @s@ ceiling = whenFloating $ \c e -> @@ -486,7 +490,7 @@ else case c `quotRemInteger` magnitude (-e) of (#q, r#) | r <= 0 -> fromInteger q | otherwise -> fromInteger (q + 1) - {-# INLINE ceiling #-} + {-# INLINABLE ceiling #-} -- | @'floor' s@ returns the greatest integer not greater than @s@ floor = whenFloating $ \c e -> @@ -495,7 +499,7 @@ then -1 else 0 else fromInteger (c `divInteger` magnitude (-e)) - {-# INLINE floor #-} + {-# INLINABLE floor #-} ---------------------------------------------------------------------- @@ -546,8 +550,8 @@ limit = maxExpt positivize :: (Ord a, Num a, Num b) => (a -> b) -> (a -> b) -positivize f x | x < 0 = -(f (-x)) - | otherwise = f x +positivize f x | x < 0 = -(f (-x)) + | otherwise = f x {-# INLINE positivize #-} whenFloating :: (Num a) => (Integer -> Int -> a) -> Scientific -> a @@ -559,7 +563,7 @@ -- | Precondition: the 'Scientific' @s@ needs to be an integer: -- @base10Exponent (normalize s) >= 0@ toIntegral :: (Num a) => Scientific -> a -toIntegral (Scientific c e) = fromInteger c * magnitude e +toIntegral (Scientific c e) = fromInteger c * fromInteger (magnitude e) {-# INLINE toIntegral #-} @@ -593,14 +597,13 @@ go 2 -- | @magnitude e == 10 ^ e@ -magnitude :: (Num a) => Int -> a +magnitude :: Int -> Integer magnitude e | e < maxExpt = cachedPow10 e | otherwise = cachedPow10 hi * 10 ^ (e - hi) where - cachedPow10 p = fromInteger (V.unsafeIndex expts10 p) + cachedPow10 = V.unsafeIndex expts10 hi = maxExpt - 1 -{-# INLINE magnitude #-} ---------------------------------------------------------------------- @@ -629,9 +632,15 @@ where (digits, e) = Numeric.floatToDigits 10 r + go :: [Int] -> Integer -> Int -> Scientific go [] !c !n = Scientific c (e - n) go (d:ds) !c !n = go ds (c * 10 + toInteger d) (n + 1) +{-# INLINABLE fromFloatDigits #-} + +{-# SPECIALIZE fromFloatDigits :: Double -> Scientific #-} +{-# SPECIALIZE fromFloatDigits :: Float -> Scientific #-} + -- | Safely convert a 'Scientific' number into a 'RealFloat' (like a 'Double' or a -- 'Float'). -- @@ -647,37 +656,47 @@ toRealFloat :: (RealFloat a) => Scientific -> a toRealFloat = either id id . toBoundedRealFloat +{-# INLINABLE toRealFloat #-} +{-# INLINABLE toBoundedRealFloat #-} + +{-# SPECIALIZE toRealFloat :: Scientific -> Double #-} +{-# SPECIALIZE toRealFloat :: Scientific -> Float #-} +{-# SPECIALIZE toBoundedRealFloat :: Scientific -> Either Double Double #-} +{-# SPECIALIZE toBoundedRealFloat :: Scientific -> Either Float Float #-} + -- | Preciser version of `toRealFloat`. If the 'base10Exponent' of the given -- 'Scientific' is too big or too small to be represented in the target type, -- Infinity or 0 will be returned as 'Left'. toBoundedRealFloat :: forall a. (RealFloat a) => Scientific -> Either a a toBoundedRealFloat s@(Scientific c e) - | c == 0 = Right 0 - | e > limit && e > hiLimit = Left $ sign (1/0) -- Infinity - | e < -limit && e < loLimit && e + d < loLimit = Left $ sign 0 - | otherwise = Right $ realToFrac s + | c == 0 = Right 0 + | e > limit = if e > hiLimit then Left $ sign (1/0) -- Infinity + else Right $ fromRational ((c * magnitude e) % 1) + | e < -limit = if e < loLimit && e + d < loLimit then Left $ sign 0 + else Right $ fromRational (c % magnitude (-e)) + | otherwise = Right $ fromRational (toRational s) + -- We can't use realToFrac here + -- because that will cause an infinite loop + -- when the function is specialized for Double and Float + -- caused by the realToFrac_toRealFloat_Double/Float rewrite RULEs. where - (loLimit, hiLimit) = exponentLimits (undefined :: a) + hiLimit, loLimit :: Int + hiLimit = ceiling (fromIntegral hi * log10Radix) + loLimit = floor (fromIntegral lo * log10Radix) - + ceiling (fromIntegral digits * log10Radix) + + log10Radix :: Double + log10Radix = logBase 10 $ fromInteger radix + + radix = floatRadix (undefined :: a) + digits = floatDigits (undefined :: a) + (lo, hi) = floatRange (undefined :: a) d = integerLog10' (abs c) sign x | c < 0 = -x | otherwise = x -exponentLimits :: forall a. (RealFloat a) => a -> (Int, Int) -exponentLimits _ = (loLimit, hiLimit) - where - loLimit = floor (fromIntegral lo * log10Radix) - - ceiling (fromIntegral digits * log10Radix) - hiLimit = ceiling (fromIntegral hi * log10Radix) - - log10Radix :: Double - log10Radix = logBase 10 $ fromInteger radix - - radix = floatRadix (undefined :: a) - digits = floatDigits (undefined :: a) - (lo, hi) = floatRange (undefined :: a) - -- | Convert a `Scientific` to a bounded integer. -- -- If the given `Scientific` doesn't fit in the target representation, it will @@ -718,6 +737,17 @@ n :: Integer n = toIntegral s' +{-# SPECIALIZE toBoundedInteger :: Scientific -> Maybe Int #-} +{-# SPECIALIZE toBoundedInteger :: Scientific -> Maybe Int8 #-} +{-# SPECIALIZE toBoundedInteger :: Scientific -> Maybe Int16 #-} +{-# SPECIALIZE toBoundedInteger :: Scientific -> Maybe Int32 #-} +{-# SPECIALIZE toBoundedInteger :: Scientific -> Maybe Int64 #-} +{-# SPECIALIZE toBoundedInteger :: Scientific -> Maybe Word #-} +{-# SPECIALIZE toBoundedInteger :: Scientific -> Maybe Word8 #-} +{-# SPECIALIZE toBoundedInteger :: Scientific -> Maybe Word16 #-} +{-# SPECIALIZE toBoundedInteger :: Scientific -> Maybe Word32 #-} +{-# SPECIALIZE toBoundedInteger :: Scientific -> Maybe Word64 #-} + -- | @floatingOrInteger@ determines if the scientific is floating point -- or integer. In case it's floating-point the scientific is converted -- to the desired 'RealFloat' using 'toRealFloat'.
