scientific 0.3.1.0 → 0.3.2.0
raw patch · 5 files changed
+247/−17 lines, 5 filesdep ~basePVP ok
version bump matches the API change (PVP)
Dependency ranges changed: base
API changes (from Hackage documentation)
+ Data.Scientific: floatingOrInteger :: (RealFloat r, Integral i) => Scientific -> Either r i
Files
- changelog +70/−0
- scientific.cabal +4/−1
- src/Data/Scientific.hs +46/−11
- src/Math/NumberTheory/Logarithms.hs +107/−5
- test/test.hs +20/−0
+ changelog view
@@ -0,0 +1,70 @@+0.3.2.0++ * Add the floatingOrInteger function+ * Fix build on GHC-7.0.4+ * More efficient and better behaving magnitude computation+ * Lower the number of cached magnitudes to 324 (same as GHC.Float)++0.3.1.0++ * Don't normalize on construction but do it when pretty-printing+ instead. Also provide a manual normalize function.+ * Improve efficiency of toRealFloat+ * Added note about caching magnitudes+ * Dropped dependency on arithmoi+ * Make benchmark easier to build+ * Add junit XML output support (for Jenkins)++0.3.0.2++ * Lower the minimal QuickCheck version.+ * Make sure sized exponents are generated in the QuickCheck tests.++0.3.0.1++ * Fix build for bytestring-0.10.0.*++0.3.0.0++ * Fix a DoS vulnerability that allowed an attacker to crash the+ process by sending a scientific with a huge exponent like+ 1e1000000000.+ * Fix various RealFrac methods.+ * Cache some powers of 10 to speed up the magnitude computation.+ * Normalize scientific numbers on construction.+ * Move the Text Builder to its own module &+ provide a ByteString builder+ * Added more documentation++0.2.0.2++ * Widen the dreaded pointlessly tight upper bounds++0.2.0.1++ * Support the latest versions of smallcheck and tasty++0.2.0.0++ * added deriving data++0.1.0.1++ * Loosen upper bounds on package versions++0.1.0.0++ * Fixed bugs & Changed API++0.0.0.2++ * Support building the library on GHC >= 7.0.1++0.0.0.1++ * Simplification in the Show instance+ * Optimization in fromRealFloat++0.0.0.0++ * Initial commit
scientific.cabal view
@@ -1,5 +1,5 @@ name: scientific-version: 0.3.1.0+version: 0.3.2.0 synopsis: Numbers represented using scientific notation description: @Data.Scientific@ provides a space efficient and arbitrary precision@@ -40,6 +40,9 @@ category: Data build-type: Simple cabal-version: >=1.10++extra-source-files:+ changelog source-repository head type: git
src/Data/Scientific.hs view
@@ -1,4 +1,7 @@-{-# LANGUAGE DeriveDataTypeable, BangPatterns, ScopedTypeVariables #-}+{-# LANGUAGE CPP #-}+{-# LANGUAGE DeriveDataTypeable #-}+{-# LANGUAGE BangPatterns #-}+{-# LANGUAGE ScopedTypeVariables #-} -- | -- Module : Data.Scientific@@ -35,11 +38,6 @@ -- to @'Integral's@ (like: 'Int') or @'RealFloat's@ (like: 'Double' or 'Float') -- will always be bounded by the target type. ----- Note that, in order to do fast magnitude computations (@10^e@), this module--- computes the first 1100 powers of 10 and stores them in a top-level--- array. This means that the first magnitude computation (used in 'realToFrac'--- among others) is slower but subsequent computations should be O(1).--- -- This module is designed to be imported qualified: -- -- @import Data.Scientific as Scientific@@@ -56,6 +54,7 @@ -- * Conversions , fromFloatDigits , toRealFloat+ , floatingOrInteger -- * Pretty printing , formatScientific@@ -90,7 +89,13 @@ import Text.ParserCombinators.ReadP ( ReadP ) import Data.Text.Lazy.Builder.RealFloat (FPFormat(..)) +#if MIN_VERSION_base(4,5,0)+import Data.Bits (unsafeShiftR)+#else+import Data.Bits (shiftR)+#endif + ---------------------------------------------------------------------- -- Type ----------------------------------------------------------------------@@ -245,7 +250,7 @@ then (0, s) else let (q, r) = c `quotRem` magnitude (-e) in (fromInteger q, scientific r e)- | otherwise = (fromInteger c * magnitude e, 0)+ | otherwise = (toIntegral s, 0) {-# INLINE properFraction #-} -- | @'truncate' s@ returns the integer nearest @s@@@ -345,22 +350,41 @@ {-# INLINE positivize #-} whenFloating :: (Num a) => (Integer -> Int -> a) -> Scientific -> a-whenFloating f (Scientific c e)+whenFloating f s@(Scientific c e) | e < 0 = f c e- | otherwise = fromInteger c * magnitude e+ | otherwise = toIntegral s {-# INLINE whenFloating #-} +-- | 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+{-# INLINE toIntegral #-} + ---------------------------------------------------------------------- -- Exponentiation with a cache for the most common numbers. ---------------------------------------------------------------------- +-- | The same limit as in GHC.Float. maxExpt :: Int-maxExpt = 1100+maxExpt = 324 expts10 :: Array Int Integer-expts10 = listArray (0, maxExpt) $ iterate (*10) 1+expts10 = listArray (0, maxExpt) $ 1 : 10 : go 2+ where+ go :: Int -> [Integer]+ go !ix = xx : 10*xx : go (ix+2)+ where+ xx = x * x+ x = expts10 ! half +#if MIN_VERSION_base(4,5,0)+ half = ix `unsafeShiftR` 1+#else+ half = ix `shiftR` 1+#endif+ -- | @magnitude e == 10 ^ e@ magnitude :: (Num a) => Int -> a magnitude e | e <= maxExpt = cachedPow10 e@@ -434,6 +458,17 @@ radix = floatRadix (undefined :: a) digits = floatDigits (undefined :: a) (lo, hi) = floatRange (undefined :: a)++-- | @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'.+floatingOrInteger :: (RealFloat r, Integral i) => Scientific -> Either r i+floatingOrInteger s+ | base10Exponent s >= 0 = Right (toIntegral s)+ | base10Exponent s' >= 0 = Right (toIntegral s')+ | otherwise = Left (toRealFloat s')+ where+ s' = normalize s ----------------------------------------------------------------------
src/Math/NumberTheory/Logarithms.hs view
@@ -1,13 +1,115 @@-{-# LANGUAGE CPP, MagicHash #-}+{-# LANGUAGE CPP, MagicHash, UnboxedTuples #-} --- | Integer logarithm, copied from @arithmoi@+-- | Integer logarithm, copied from Daniel Fischer's @arithmoi@ module Math.NumberTheory.Logarithms ( integerLog10' ) where import GHC.Base-#if __GLASGOW_HASKELL__ < 705-import GHC.Word-#endif++#if __GLASGOW_HASKELL__ >= 702 import GHC.Integer.Logarithms+#else+#include "MachDeps.h"++import GHC.Integer.GMP.Internals++#if (WORD_SIZE_IN_BITS != 32) && (WORD_SIZE_IN_BITS != 64)+#error Only word sizes 32 and 64 are supported.+#endif+++#if WORD_SIZE_IN_BITS == 32++#define WSHIFT 5+#define MMASK 31++#else++#define WSHIFT 6+#define MMASK 63++#endif++-- | Calculate the integer base 2 logarithm of an 'Integer'.+-- The calculation is much more efficient than for the general case.+--+-- The argument must be strictly positive, that condition is /not/ checked.+integerLog2# :: Integer -> Int#+integerLog2# (S# i) = wordLog2# (int2Word# i)+integerLog2# (J# s ba) = check (s -# 1#)+ where+ check i = case indexWordArray# ba i of+ 0## -> check (i -# 1#)+ w -> wordLog2# w +# (uncheckedIShiftL# i WSHIFT#)++-- | This function calculates the integer base 2 logarithm of a 'Word#'.+-- @'wordLog2#' 0## = -1#@.+{-# INLINE wordLog2# #-}+wordLog2# :: Word# -> Int#+wordLog2# w =+ case leadingZeros of+ BA lz ->+ let zeros u = indexInt8Array# lz (word2Int# u) in+#if WORD_SIZE_IN_BITS == 64+ case uncheckedShiftRL# w 56# of+ a ->+ if a `neWord#` 0##+ then 64# -# zeros a+ else+ case uncheckedShiftRL# w 48# of+ b ->+ if b `neWord#` 0##+ then 56# -# zeros b+ else+ case uncheckedShiftRL# w 40# of+ c ->+ if c `neWord#` 0##+ then 48# -# zeros c+ else+ case uncheckedShiftRL# w 32# of+ d ->+ if d `neWord#` 0##+ then 40# -# zeros d+ else+#endif+ case uncheckedShiftRL# w 24# of+ e ->+ if e `neWord#` 0##+ then 32# -# zeros e+ else+ case uncheckedShiftRL# w 16# of+ f ->+ if f `neWord#` 0##+ then 24# -# zeros f+ else+ case uncheckedShiftRL# w 8# of+ g ->+ if g `neWord#` 0##+ then 16# -# zeros g+ else 8# -# zeros w++-- Lookup table+data BA = BA ByteArray#++leadingZeros :: BA+leadingZeros =+ let mkArr s =+ case newByteArray# 256# s of+ (# s1, mba #) ->+ case writeInt8Array# mba 0# 9# s1 of+ s2 ->+ let fillA lim val idx st =+ if idx ==# 256#+ then st+ else if idx <# lim+ then case writeInt8Array# mba idx val st of+ nx -> fillA lim val (idx +# 1#) nx+ else fillA (2# *# lim) (val -# 1#) idx st+ in case fillA 2# 8# 1# s2 of+ s3 -> case unsafeFreezeByteArray# mba s3 of+ (# _, ba #) -> ba+ in case mkArr realWorld# of+ b -> BA b+#endif -- | Only defined for positive inputs! integerLog10' :: Integer -> Int
test/test.hs view
@@ -131,11 +131,31 @@ , testGroup "Conversions" [ testGroup "Float" $ conversionsProperties (undefined :: Float) , testGroup "Double" $ conversionsProperties (undefined :: Double)++ , testGroup "floatingOrInteger"+ [ testProperty "correct conversion" $ \s ->+ case floatingOrInteger s :: Either Double Int of+ Left d -> d == toRealFloat s+ Right i -> i == fromInteger (coefficient s') * 10^(base10Exponent s')+ where+ s' = normalize s+ , testProperty "Integer == Right" $ \(i::Integer) ->+ (floatingOrInteger (fromInteger i) :: Either Double Integer) == Right i+ , smallQuick "Double == Left"+ (\(d::Double) -> isFloating d SC.==>+ (floatingOrInteger (realToFrac d) :: Either Double Integer) == Left d)+ (\(d::Double) -> isFloating d QC.==>+ (floatingOrInteger (realToFrac d) :: Either Double Integer) == Left d)+ ] ] ] testMain :: TestTree -> IO () testMain = defaultMainWithIngredients (antXMLRunner:defaultIngredients)++isFloating :: Double -> Bool+isFloating 0 = False+isFloating d = fromInteger (floor d :: Integer) /= d conversionsProperties :: forall realFloat. ( RealFloat realFloat