scientific 0.3.5.1 → 0.3.8.1
raw patch · 9 files changed
Files
- bench/bench.hs +15/−0
- changelog +66/−0
- scientific.cabal +90/−70
- src/Data/ByteString/Builder/Scientific.hs +9/−22
- src/Data/Scientific.hs +224/−151
- src/Data/Text/Lazy/Builder/Scientific.hs +9/−18
- src/GHC/Integer/Compat.hs +9/−1
- src/Utils.hs +47/−0
- test/test.hs +81/−12
bench/bench.hs view
@@ -57,6 +57,21 @@ , bgroup "dangerouslyBig" $ benchToBoundedInteger dangerouslyBig , bgroup "64" $ benchToBoundedInteger 64 ]++ , bgroup "read"+ [ benchRead "123456789.123456789"+ , benchRead "12345678900000000000.12345678900000000000000000"+ , benchRead "12345678900000000000.12345678900000000000000000e1234"+ ]++ , bgroup "division"+ [ bench (show n ++ " / " ++ show d) $ nf (uncurry (/)) t+ | t@(n, d) <-+ [ (0.4 , 20.0)+ , (0.4e-100, 0.2e50)+ ] :: [(Scientific, Scientific)]+ ]+ ] where pos :: Fractional a => a
changelog view
@@ -1,3 +1,69 @@+0.3.7.0++ * Make division (/) on Scientifics slightly more efficient.++ * Fix the Show instance to surround negative numbers with parentheses when+ necessary.++ * Add (Template Haskell) Lift Scientific instance++ * Mark modules as Safe or Trustworthy (Safe Haskell).++0.3.6.2+ * Due to a regression introduced in 0.3.4.14 the RealFrac methods+ and floatingOrInteger became vulnerable to a space blowup when+ applied to scientifics with huge exponents. This has now been+ fixed again.++0.3.6.1+ * Fix build on GHC < 8.++0.3.6.0+ * Make the methods of the Hashable, Eq and Ord instances safe to+ use when applied to scientific numbers coming from untrusted+ sources. Previously these methods first converted their arguments+ to Rational before applying the operation. This is unsafe because+ converting a Scientific to a Rational could fill up all space and+ crash your program when the Scientific has a huge base10Exponent.++ Do note that the hash computation of the Hashable Scientific+ instance has been changed because of this improvement!++ Thanks to Tom Sydney Kerckhove (@NorfairKing) for pushing me to+ fix this.++ * fromRational :: Rational -> Scientific now throws an error+ instead of diverging when applied to a repeating decimal. This+ does mean it will consume space linear in the number of digits of+ the resulting scientific. This makes "fromRational" and the other+ Fractional methods "recip" and "/" a bit safer to use.++ * To get the old unsafe but more efficient behaviour the following+ function was added: unsafeFromRational :: Rational -> Scientific.++ * Add alternatives for fromRationalRepetend:++ fromRationalRepetendLimited+ :: Int -- ^ limit+ -> Rational+ -> Either (Scientific, Rational)+ (Scientific, Maybe Int)++ and:++ fromRationalRepetendUnlimited+ :: Rational -> (Scientific, Maybe Int)++ Thanks to Ian Jeffries (@seagreen) for the idea.++0.3.5.3+ * Dropped upper version bounds of dependencies+ because it's to much work to maintain.++0.3.5.2+ * Remove unused ghc-prim dependency.+ * Added unit tests for read and scientificP+ 0.3.5.1 * Replace use of Vector from vector with Array from primitive.
scientific.cabal view
@@ -1,8 +1,8 @@-name: scientific-version: 0.3.5.1-synopsis: Numbers represented using scientific notation+name: scientific+version: 0.3.8.1+synopsis: Numbers represented using scientific notation description:- @Data.Scientific@ provides the number type 'Scientific'. Scientific numbers are+ "Data.Scientific" provides the number type 'Scientific'. Scientific numbers are arbitrary precision and space efficient. They are represented using <http://en.wikipedia.org/wiki/Scientific_notation scientific notation>. The implementation uses a coefficient @c :: 'Integer'@ and a base-10 exponent@@ -25,95 +25,114 @@ @1e1000000000 :: 'Rational'@ will fill up all space and crash your program. Scientific works as expected: .- > > read "1e1000000000" :: Scientific- > 1.0e1000000000+ >>> read "1e1000000000" :: Scientific+ 1.0e1000000000 . * Also, the space usage of converting scientific numbers with huge exponents to @'Integral's@ (like: 'Int') or @'RealFloat's@ (like: 'Double' or 'Float') will always be bounded by the target type. -homepage: https://github.com/basvandijk/scientific-bug-reports: https://github.com/basvandijk/scientific/issues-license: BSD3-license-file: LICENSE-author: Bas van Dijk-maintainer: Bas van Dijk <v.dijk.bas@gmail.com>-category: Data-build-type: Simple-cabal-version: >=1.10--extra-source-files:- changelog+homepage: https://github.com/basvandijk/scientific+bug-reports: https://github.com/basvandijk/scientific/issues+license: BSD3+license-file: LICENSE+author: Bas van Dijk+maintainer: Bas van Dijk <v.dijk.bas@gmail.com>+category: Data+build-type: Simple+cabal-version: >=1.10+extra-source-files: changelog+tested-with:+ GHC ==8.6.5+ || ==8.8.4+ || ==8.10.7+ || ==9.0.2+ || ==9.2.8+ || ==9.4.8+ || ==9.6.6+ || ==9.8.4+ || ==9.10.3+ || ==9.12.2+ || ==9.14.1 source-repository head type: git- location: git://github.com/basvandijk/scientific.git--flag bytestring-builder- description: Depend on the bytestring-builder package for backwards compatibility.- default: False- manual: False+ location: https://github.com/basvandijk/scientific.git flag integer-simple description: Use the integer-simple package instead of integer-gmp default: False library- exposed-modules: Data.ByteString.Builder.Scientific- Data.Scientific- Data.Text.Lazy.Builder.Scientific- other-modules: GHC.Integer.Compat- Utils- other-extensions: DeriveDataTypeable, BangPatterns- ghc-options: -Wall- build-depends: base >= 4.3 && < 4.11- , ghc-prim- , integer-logarithms >= 1 && <1.1- , deepseq >= 1.3 && < 1.5- , text >= 0.8 && < 1.3- , hashable >= 1.1.2 && < 1.3- , primitive >= 0.1 && < 0.7- , containers >= 0.1 && < 0.6- , binary >= 0.4.1 && < 0.9+ exposed-modules:+ Data.ByteString.Builder.Scientific+ Data.Scientific+ Data.Text.Lazy.Builder.Scientific - if flag(bytestring-builder)- build-depends: bytestring >= 0.9 && < 0.10.4- , bytestring-builder >= 0.10.4 && < 0.11- else- build-depends: bytestring >= 0.10.4 && < 0.11+ other-modules:+ GHC.Integer.Compat+ Utils - if flag(integer-simple)- build-depends: integer-simple+ other-extensions:+ BangPatterns+ DeriveDataTypeable+ Trustworthy++ ghc-options: -Wall+ build-depends:+ base >=4.12.0.0 && <4.23+ , binary >=0.8.6.0 && <0.9+ , bytestring >=0.10.8.2 && <0.13+ , containers >=0.6.0.1 && <0.9+ , deepseq >=1.4.4.0 && <1.6+ , hashable >=1.4.4.0 && <1.6+ , integer-logarithms >=1.0.3.1 && <1.1+ , primitive >=0.9.0.0 && <0.10+ , template-haskell >=2.14.0.0 && <2.25+ , text >=1.2.3.0 && <1.3 || >=2.0 && <2.2++ if impl(ghc >=9.0)+ build-depends: base >=4.15++ if flag(integer-simple)+ build-depends: invalid-cabal-flag-settings <0+ else+ if flag(integer-simple)+ build-depends: integer-simple++ else build-depends: integer-gmp - hs-source-dirs: src- default-language: Haskell2010+ if impl(ghc <8)+ other-extensions: TemplateHaskell + if impl(ghc >=9.0)+ -- these flags may abort compilation with GHC-8.10+ -- https://gitlab.haskell.org/ghc/ghc/-/merge_requests/3295+ ghc-options: -Winferred-safe-imports -Wmissing-safe-haskell-mode++ hs-source-dirs: src+ default-language: Haskell2010+ test-suite test-scientific type: exitcode-stdio-1.0 hs-source-dirs: test main-is: test.hs default-language: Haskell2010 ghc-options: -Wall-- build-depends: scientific- , base >= 4.3 && < 4.11- , binary >= 0.4.1 && < 0.9- , tasty >= 0.5 && < 0.12- , tasty-ant-xml >= 1.0 && < 1.2- , tasty-hunit >= 0.8 && < 0.10- , tasty-smallcheck >= 0.2 && < 0.9- , tasty-quickcheck >= 0.8 && < 0.10- , smallcheck >= 1.0 && < 1.2- , QuickCheck >= 2.5 && < 2.11- , text >= 0.8 && < 1.3-- if flag(bytestring-builder)- build-depends: bytestring >= 0.9 && < 0.10.4- , bytestring-builder >= 0.10.4 && < 0.11- else- build-depends: bytestring >= 0.10.4 && < 0.11+ build-depends:+ base+ , binary+ , bytestring+ , QuickCheck >=2.14.2+ , scientific+ , smallcheck >=1.0+ , tasty >=1.4.0.1+ , tasty-hunit >=0.8+ , tasty-quickcheck >=0.8+ , tasty-smallcheck >=0.2+ , text benchmark bench-scientific type: exitcode-stdio-1.0@@ -121,6 +140,7 @@ main-is: bench.hs default-language: Haskell2010 ghc-options: -O2- build-depends: scientific- , base >= 4.3 && < 4.11- , criterion >= 0.5 && < 1.3+ build-depends:+ base+ , criterion >=0.5+ , scientific
src/Data/ByteString/Builder/Scientific.hs view
@@ -1,4 +1,4 @@-{-# LANGUAGE CPP, OverloadedStrings #-}+{-# LANGUAGE OverloadedStrings, Safe #-} module Data.ByteString.Builder.Scientific ( scientificBuilder@@ -17,18 +17,7 @@ import Utils (roundTo, i2d) -#if !MIN_VERSION_base(4,8,0)-import Data.Monoid (mempty)-#endif--#if MIN_VERSION_base(4,5,0) import Data.Monoid ((<>))-#else-import Data.Monoid (Monoid, mappend)-(<>) :: Monoid a => a -> a -> a-(<>) = mappend-infixr 6 <>-#endif -- | A @ByteString@ @Builder@ which renders a scientific number to full@@ -70,11 +59,10 @@ byteStringCopy (BC8.replicate dec' '0') <> byteStringCopy "e0" _ ->- let- (ei,is') = roundTo (dec'+1) is- (d:ds') = map i2d (if ei > 0 then init is' else is')- in- char8 d <> char8 '.' <> string8 ds' <> char8 'e' <> intDec (e-1+ei)+ let (ei,is') = roundTo (dec'+1) is+ in case map i2d (if ei > 0 then init is' else is') of+ [] -> mempty+ d:ds' -> char8 d <> char8 '.' <> string8 ds' <> char8 'e' <> intDec (e-1+ei) Fixed -> let mk0 ls = case ls of { "" -> char8 '0' ; _ -> string8 ls}@@ -100,8 +88,7 @@ in mk0 ls <> (if null rs then mempty else char8 '.' <> string8 rs) else- let- (ei,is') = roundTo dec' (replicate (-e) 0 ++ is)- d:ds' = map i2d (if ei > 0 then is' else 0:is')- in- char8 d <> (if null ds' then mempty else char8 '.' <> string8 ds')+ let (ei,is') = roundTo dec' (replicate (-e) 0 ++ is)+ in case map i2d (if ei > 0 then is' else 0:is') of+ [] -> mempty+ d:ds' -> char8 d <> (if null ds' then mempty else char8 '.' <> string8 ds')
src/Data/Scientific.hs view
@@ -1,9 +1,11 @@-{-# LANGUAGE CPP #-} {-# LANGUAGE DeriveDataTypeable #-} {-# LANGUAGE BangPatterns #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE UnboxedTuples #-} {-# LANGUAGE PatternGuards #-}+{-# LANGUAGE Trustworthy #-}+{-# LANGUAGE DeriveLift #-}+{-# LANGUAGE StandaloneDeriving #-} -- | -- Module : Data.Scientific@@ -22,6 +24,11 @@ -- aren't truly arbitrary precision. I intend to change the type of the exponent -- to 'Integer' in a future release. --+-- /WARNING:/ Although @Scientific@ has instances for all numeric classes the+-- methods should be used with caution when applied to scientific numbers coming+-- from untrusted sources. See the warnings of the instances belonging to+-- 'Scientific'.+-- -- The main application of 'Scientific' is to be used as the target of parsing -- arbitrary precision numbers coming from an untrusted source. The advantages -- over using 'Rational' for this are that:@@ -41,16 +48,9 @@ -- to @'Integral's@ (like: 'Int') or @'RealFloat's@ (like: 'Double' or 'Float') -- will always be bounded by the target type. ----- /WARNING:/ Although @Scientific@ is an instance of 'Fractional', the methods--- are only partially defined! Specifically 'recip' and '/' will diverge--- (i.e. loop and consume all space) when their outputs have an infinite decimal--- expansion. 'fromRational' will diverge when the input 'Rational' has an--- infinite decimal expansion. Consider using 'fromRationalRepetend' for these--- rationals which will detect the repetition and indicate where it starts.--- -- This module is designed to be imported qualified: ----- @import Data.Scientific as Scientific@+-- @import qualified Data.Scientific as Scientific@ module Data.Scientific ( Scientific @@ -66,8 +66,14 @@ , isInteger -- * Conversions+ -- ** Rational+ , unsafeFromRational , fromRationalRepetend+ , fromRationalRepetendLimited+ , fromRationalRepetendUnlimited , toRationalRepetend++ -- ** Floating & integer , floatingOrInteger , toRealFloat , toBoundedRealFloat@@ -94,18 +100,15 @@ import Control.Exception (throw, ArithException(DivideByZero)) import Control.Monad (mplus)-import Control.Monad.ST (runST) import Control.DeepSeq (NFData, rnf) import Data.Binary (Binary, get, put) import Data.Char (intToDigit, ord) 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.Primitive.Array as Primitive import Data.Word (Word8, Word16, Word32, Word64) import Math.NumberTheory.Logarithms (integerLog10') import qualified Numeric (floatToDigits)@@ -116,22 +119,10 @@ import Text.ParserCombinators.ReadP ( ReadP ) import Data.Text.Lazy.Builder.RealFloat (FPFormat(..)) -#if !MIN_VERSION_base(4,8,0)-import Data.Functor ((<$>))-import Data.Word (Word)-import Control.Applicative ((<*>))-#endif--#if MIN_VERSION_base(4,5,0)-import Data.Bits (unsafeShiftR)-#else-import Data.Bits (shiftR)-#endif--import GHC.Integer (quotRemInteger, quotInteger)-import GHC.Integer.Compat (divInteger)-import Utils (roundTo)+import GHC.Integer.Compat (quotRemInteger, quotInteger, divInteger)+import Utils (maxExpt, roundTo, magnitude) +import Language.Haskell.TH.Syntax (Lift (..)) ---------------------------------------------------------------------- -- Type@@ -156,6 +147,20 @@ -- in 'toDecimalDigits'. -- -- Use 'normalize' to do manual normalization.+ --+ -- /WARNING:/ 'coefficient' and 'base10exponent' violate+ -- substantivity of 'Eq'.+ --+ -- >>> let x = scientific 1 2+ -- >>> let y = scientific 100 0+ -- >>> x == y+ -- True+ --+ -- but+ --+ -- >>> (coefficient x == coefficient y, base10Exponent x == base10Exponent y)+ -- (False,False)+ -- , base10Exponent :: {-# UNPACK #-} !Int -- ^ The base-10 exponent of a scientific number.@@ -166,50 +171,80 @@ scientific :: Integer -> Int -> Scientific scientific = Scientific - ---------------------------------------------------------------------- -- Instances ---------------------------------------------------------------------- +-- | @since 0.3.7.0+deriving instance Lift Scientific+ instance NFData Scientific where rnf (Scientific _ _) = () +-- | A hash can be safely calculated from a @Scientific@. No magnitude @10^e@ is+-- calculated so there's no risk of a blowup in space or time when hashing+-- scientific numbers coming from untrusted sources.+--+-- >>> import Data.Hashable (hash)+-- >>> let x = scientific 1 2+-- >>> let y = scientific 100 0+-- >>> (x == y, hash x == hash y)+-- (True,True)+-- instance Hashable Scientific where- hashWithSalt salt = hashWithSalt salt . toRational+ hashWithSalt salt s = salt `hashWithSalt` c `hashWithSalt` e+ where+ Scientific c e = normalize s +-- | Note that in the future I intend to change the type of the 'base10Exponent'+-- from @Int@ to @Integer@. To be forward compatible the @Binary@ instance+-- already encodes the exponent as 'Integer'. instance Binary Scientific where- put (Scientific c e) = do- put c- -- In the future I intend to change the type of the base10Exponent e from- -- Int to Integer. To support backward compatability I already convert e- -- to Integer here:- put $ toInteger e-+ put (Scientific c e) = put c *> put (toInteger e) get = Scientific <$> get <*> (fromInteger <$> get) +-- | Scientific numbers can be safely compared for equality. No magnitude @10^e@+-- is calculated so there's no risk of a blowup in space or time when comparing+-- scientific numbers coming from untrusted sources. instance Eq Scientific where- (==) = (==) `on` toRational- {-# INLINABLE (==) #-}-- (/=) = (/=) `on` toRational- {-# INLINABLE (/=) #-}+ s1 == s2 = c1 == c2 && e1 == e2+ where+ Scientific c1 e1 = normalize s1+ Scientific c2 e2 = normalize s2 +-- | Scientific numbers can be safely compared for ordering. No magnitude @10^e@+-- is calculated so there's no risk of a blowup in space or time when comparing+-- scientific numbers coming from untrusted sources. instance Ord Scientific where- (<) = (<) `on` toRational- {-# INLINABLE (<) #-}-- (<=) = (<=) `on` toRational- {-# INLINABLE (<=) #-}+ compare s1 s2+ | c1 == c2 && e1 == e2 = EQ+ | c1 < 0 = if c2 < 0 then cmp (-c2) e2 (-c1) e1 else LT+ | c1 > 0 = if c2 > 0 then cmp c1 e1 c2 e2 else GT+ | otherwise = if c2 > 0 then LT else GT+ where+ Scientific c1 e1 = normalize s1+ Scientific c2 e2 = normalize s2 - (>) = (>) `on` toRational- {-# INLINABLE (>) #-}+ cmp cx ex cy ey+ | log10sx < log10sy = LT+ | log10sx > log10sy = GT+ | d < 0 = if cx <= (cy `quotInteger` magnitude (-d)) then LT else GT+ | d > 0 = if cy > (cx `quotInteger` magnitude d) then LT else GT+ | otherwise = if cx < cy then LT else GT+ where+ log10sx = log10cx + ex+ log10sy = log10cy + ey - (>=) = (>=) `on` toRational- {-# INLINABLE (>=) #-}+ log10cx = integerLog10' cx+ log10cy = integerLog10' cy - compare = compare `on` toRational- {-# INLINABLE compare #-}+ d = log10cx - log10cy +-- | /WARNING:/ '+' and '-' compute the 'Integer' magnitude: @10^e@ where @e@ is+-- the difference between the @'base10Exponent's@ of the arguments. If these+-- methods are applied to arguments which have huge exponents this could fill up+-- all space and crash your program! So don't apply these methods to scientific+-- numbers coming from untrusted sources. The other methods can be used safely. instance Num Scientific where Scientific c1 e1 + Scientific c2 e2 | e1 < e2 = Scientific (c1 + c2*l) e1@@ -264,36 +299,66 @@ "realToFrac_toRealFloat_Float" realToFrac = toRealFloat :: Scientific -> Float #-} --- | /WARNING:/ 'recip' and '/' will diverge (i.e. loop and consume all space)--- when their outputs are <https://en.wikipedia.org/wiki/Repeating_decimal repeating decimals>.+-- | /WARNING:/ 'recip' and '/' will throw an error when their outputs are+-- <https://en.wikipedia.org/wiki/Repeating_decimal repeating decimals>. ----- 'fromRational' will diverge when the input 'Rational' is a repeating decimal.--- Consider using 'fromRationalRepetend' for these rationals which will detect--- the repetition and indicate where it starts.+-- These methods also compute 'Integer' magnitudes (@10^e@). If these methods+-- are applied to arguments which have huge exponents this could fill up all+-- space and crash your program! So don't apply these methods to scientific+-- numbers coming from untrusted sources.+--+-- 'fromRational' will throw an error when the input 'Rational' is a repeating+-- decimal. Consider using 'fromRationalRepetend' for these rationals which+-- will detect the repetition and indicate where it starts. instance Fractional Scientific where recip = fromRational . recip . toRational- {-# INLINABLE recip #-} - x / y = fromRational $ toRational x / toRational y- {-# INLINABLE (/) #-}+ Scientific c1 e1 / Scientific c2 e2+ | d < 0 = fromRational (x / (fromInteger (magnitude (-d))))+ | otherwise = fromRational (x * fromInteger (magnitude d))+ where+ d = e1 - e2+ x = c1 % c2 - fromRational rational- | d == 0 = throw DivideByZero- | otherwise = positivize (longDiv 0 0) (numerator rational)+ fromRational rational =+ case mbRepetendIx of+ Nothing -> s+ Just _ix -> error $+ "fromRational has been applied to a repeating decimal " +++ "which can't be represented as a Scientific! " +++ "It's better to avoid performing fractional operations on Scientifics " +++ "and convert them to other fractional types like Double as early as possible." where- -- Divide the numerator by the denominator using long division.- longDiv :: Integer -> Int -> (Integer -> Scientific)- longDiv !c !e 0 = Scientific c e- longDiv !c !e !n- -- TODO: Use a logarithm here!- | n < d = longDiv (c * 10) (e - 1) (n * 10)- | otherwise = case n `quotRemInteger` d of- (#q, r#) -> longDiv (c + q) e r+ (s, mbRepetendIx) = fromRationalRepetendUnlimited rational - d = denominator rational+-- | Although 'fromRational' is unsafe because it will throw errors on+-- <https://en.wikipedia.org/wiki/Repeating_decimal repeating decimals>,+-- @unsafeFromRational@ is even more unsafe because it will diverge instead (i.e+-- loop and consume all space). Though it will be more efficient because it+-- doesn't need to consume space linear in the number of digits in the resulting+-- scientific to detect the repetition.+--+-- Consider using 'fromRationalRepetend' for these rationals which will detect+-- the repetition and indicate where it starts.+unsafeFromRational :: Rational -> Scientific+unsafeFromRational rational+ | d == 0 = throw DivideByZero+ | otherwise = positivize (longDiv 0 0) (numerator rational)+ where+ -- Divide the numerator by the denominator using long division.+ longDiv :: Integer -> Int -> (Integer -> Scientific)+ longDiv !c !e 0 = Scientific c e+ longDiv !c !e !n+ -- TODO: Use a logarithm here!+ | n < d = longDiv (c * 10) (e - 1) (n * 10)+ | otherwise = case n `quotRemInteger` d of+ (#q, r#) -> longDiv (c + q) e r --- | Like 'fromRational', this function converts a `Rational` to a `Scientific`--- but instead of diverging (i.e loop and consume all space) on+ d = denominator rational++-- | Like 'fromRational' and 'unsafeFromRational', this function converts a+-- `Rational` to a `Scientific` but instead of failing or diverging (i.e loop+-- and consume all space) on -- <https://en.wikipedia.org/wiki/Repeating_decimal repeating decimals> -- it detects the repeating part, the /repetend/, and returns where it starts. --@@ -335,7 +400,18 @@ -> Rational -> Either (Scientific, Rational) (Scientific, Maybe Int)-fromRationalRepetend mbLimit rational+fromRationalRepetend mbLimit rational =+ case mbLimit of+ Nothing -> Right $ fromRationalRepetendUnlimited rational+ Just l -> fromRationalRepetendLimited l rational++-- | Like 'fromRationalRepetend' but always accepts a limit.+fromRationalRepetendLimited+ :: Int -- ^ limit+ -> Rational+ -> Either (Scientific, Rational)+ (Scientific, Maybe Int)+fromRationalRepetendLimited l rational | d == 0 = throw DivideByZero | num < 0 = case longDiv (-num) of Left (s, r) -> Left (-s, -r)@@ -345,11 +421,38 @@ num = numerator rational longDiv :: Integer -> Either (Scientific, Rational) (Scientific, Maybe Int)- longDiv n = case mbLimit of- Nothing -> Right $ longDivNoLimit 0 0 M.empty n- Just l -> longDivWithLimit (-l) n+ longDiv = longDivWithLimit 0 0 M.empty - -- Divide the numerator by the denominator using long division.+ longDivWithLimit+ :: Integer+ -> Int+ -> M.Map Integer Int+ -> (Integer -> Either (Scientific, Rational)+ (Scientific, Maybe Int))+ longDivWithLimit !c !e _ns 0 = Right (Scientific c e, Nothing)+ longDivWithLimit !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 = let !ns' = M.insert n e ns+ in longDivWithLimit (c * 10) (e - 1) ns' (n * 10)+ | otherwise = case n `quotRemInteger` d of+ (#q, r#) -> longDivWithLimit (c + q) e ns r++ d = denominator rational++-- | Like 'fromRationalRepetend' but doesn't accept a limit.+fromRationalRepetendUnlimited :: Rational -> (Scientific, Maybe Int)+fromRationalRepetendUnlimited rational+ | d == 0 = throw DivideByZero+ | num < 0 = case longDiv (-num) of+ (s, mb) -> (-s, mb)+ | otherwise = longDiv num+ where+ num = numerator rational++ longDiv :: Integer -> (Scientific, Maybe Int)+ longDiv = longDivNoLimit 0 0 M.empty+ longDivNoLimit :: Integer -> Int -> M.Map Integer Int@@ -362,22 +465,6 @@ | otherwise = case n `quotRemInteger` d of (#q, r#) -> longDivNoLimit (c + q) e ns r - longDivWithLimit :: Int -> Integer -> Either (Scientific, Rational) (Scientific, Maybe Int)- longDivWithLimit l = go 0 0 M.empty- where- go :: Integer- -> Int- -> M.Map Integer Int- -> (Integer -> Either (Scientific, Rational) (Scientific, Maybe Int))- go !c !e _ns 0 = Right (Scientific c e, Nothing)- 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 = 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- d = denominator rational -- |@@ -393,6 +480,11 @@ -- -- * @r < -(base10Exponent s)@ --+-- /WARNING:/ @toRationalRepetend@ needs to compute the 'Integer' magnitude:+-- @10^^n@. Where @n@ is based on the 'base10Exponent` of the scientific. If+-- applied to a huge exponent this could fill up all space and crash your+-- program! So don't apply this function to untrusted input.+-- -- The formula to convert the @Scientific@ @s@ -- with a repetend starting at index @r@ is described in the paper: -- <http://fiziko.bureau42.com/teaching_tidbits/turning_repeating_decimals_into_fractions.pdf turning_repeating_decimals_into_fractions.pdf>@@ -443,6 +535,10 @@ nines = m - 1 +-- | /WARNING:/ the methods of the @RealFrac@ instance need to compute the+-- magnitude @10^e@. If applied to a huge exponent this could take a long+-- time. Even worse, when the destination type is unbounded (i.e. 'Integer') it+-- could fill up all space and crash your program! instance RealFrac Scientific where -- | The function 'properFraction' takes a Scientific number @s@ -- and returns a pair @(n,f)@ such that @s = n+f@, and:@@ -566,52 +662,14 @@ -- | Precondition: the 'Scientific' @s@ needs to be an integer: -- @base10Exponent (normalize s) >= 0@ toIntegral :: (Num a) => Scientific -> a-toIntegral (Scientific c e) = fromInteger c * fromInteger (magnitude e)+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 = 324 -expts10 :: Primitive.Array Integer-expts10 = runST $ do- ma <- Primitive.newArray maxExpt uninitialised- Primitive.writeArray ma 0 1- Primitive.writeArray ma 1 10- let go !ix- | ix == maxExpt = Primitive.unsafeFreezeArray ma- | otherwise = do- Primitive.writeArray ma ix xx- Primitive.writeArray ma (ix+1) (10*xx)- go (ix+2)- where- xx = x * x- x = Primitive.indexArray expts10 half-#if MIN_VERSION_base(4,5,0)- !half = ix `unsafeShiftR` 1-#else- !half = ix `shiftR` 1-#endif- go 2 -uninitialised :: error-uninitialised = error "Data.Scientific: uninitialised element" --- | @magnitude e == 10 ^ e@-magnitude :: Int -> Integer-magnitude e | e < maxExpt = cachedPow10 e- | otherwise = cachedPow10 hi * 10 ^ (e - hi)- where- cachedPow10 = Primitive.indexArray expts10-- hi = maxExpt - 1-- ---------------------------------------------------------------------- -- Conversions ----------------------------------------------------------------------@@ -754,10 +812,21 @@ {-# 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'.+-- | @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' and wrapped in 'Left'.+--+-- In case it's integer to scientific is converted to the desired 'Integral' and+-- wrapped in 'Right'.+--+-- /WARNING:/ To convert the scientific to an integral the magnitude @10^e@+-- needs to be computed. If applied to a huge exponent this could take a long+-- time. Even worse, when the destination type is unbounded (i.e. 'Integer') it+-- could fill up all space and crash your program! So don't apply this function+-- to untrusted input but use 'toBoundedInteger' instead.+-- -- Also see: 'isFloating' or 'isInteger'. floatingOrInteger :: (RealFloat r, Integral i) => Scientific -> Either r i floatingOrInteger s@@ -885,13 +954,19 @@ -- Pretty Printing ---------------------------------------------------------------------- +-- | See 'formatScientific' if you need more control over the rendering. instance Show Scientific where- show s | coefficient s < 0 = '-':showPositive (-s)- | otherwise = showPositive s+ showsPrec d s+ | coefficient s < 0 = showParen (d > prefixMinusPrec) $+ showChar '-' . showPositive (-s)+ | otherwise = showPositive s where- showPositive :: Scientific -> String- showPositive = fmtAsGeneric . toDecimalDigits+ prefixMinusPrec :: Int+ prefixMinusPrec = 6 + showPositive :: Scientific -> ShowS+ showPositive = showString . fmtAsGeneric . toDecimalDigits+ fmtAsGeneric :: ([Int], Int) -> String fmtAsGeneric x@(_is, e) | e < 0 || e > 7 = fmtAsExponent x@@ -961,11 +1036,10 @@ case is of [0] -> '0' :'.' : take dec' (repeat '0') ++ "e0" _ ->- let- (ei,is') = roundTo (dec'+1) is- (d:ds') = map intToDigit (if ei > 0 then init is' else is')- in- d:'.':ds' ++ 'e':show (e-1+ei)+ let (ei,is') = roundTo (dec'+1) is+ in case map intToDigit (if ei > 0 then init is' else is') of+ [] -> ""+ d:ds' -> d:'.':ds' ++ 'e':show (e-1+ei) fmtAsFixedDecs :: Int -> ([Int], Int) -> String fmtAsFixedDecs dec (is, e) =@@ -977,11 +1051,10 @@ in mk0 ls ++ (if null rs then "" else '.':rs) else- let- (ei,is') = roundTo dec' (replicate (-e) 0 ++ is)- d:ds' = map intToDigit (if ei > 0 then is' else 0:is')- in- d : (if null ds' then "" else '.':ds')+ let (ei,is') = roundTo dec' (replicate (-e) 0 ++ is)+ in case map intToDigit (if ei > 0 then is' else 0:is') of+ [] -> ""+ d:ds' -> d : (if null ds' then "" else '.':ds') where mk0 ls = case ls of { "" -> "0" ; _ -> ls}
src/Data/Text/Lazy/Builder/Scientific.hs view
@@ -1,4 +1,4 @@-{-# LANGUAGE CPP, OverloadedStrings #-}+{-# LANGUAGE OverloadedStrings, Safe #-} module Data.Text.Lazy.Builder.Scientific ( scientificBuilder@@ -16,14 +16,7 @@ import qualified Data.Text as T (replicate) import Utils (roundTo, i2d) -#if MIN_VERSION_base(4,5,0) import Data.Monoid ((<>))-#else-import Data.Monoid (Monoid, mappend)-(<>) :: Monoid a => a -> a -> a-(<>) = mappend-infixr 6 <>-#endif -- | A @Text@ @Builder@ which renders a scientific number to full -- precision, using standard decimal notation for arguments whose@@ -62,11 +55,10 @@ case is of [0] -> "0." <> fromText (T.replicate dec' "0") <> "e0" _ ->- let- (ei,is') = roundTo (dec'+1) is- (d:ds') = map i2d (if ei > 0 then init is' else is')- in- singleton d <> singleton '.' <> fromString ds' <> singleton 'e' <> decimal (e-1+ei)+ let (ei,is') = roundTo (dec'+1) is+ in case map i2d (if ei > 0 then init is' else is') of+ [] -> mempty+ d:ds' -> singleton d <> singleton '.' <> fromString ds' <> singleton 'e' <> decimal (e-1+ei) Fixed -> let mk0 ls = case ls of { "" -> "0" ; _ -> fromString ls}@@ -90,8 +82,7 @@ in mk0 ls <> (if null rs then "" else singleton '.' <> fromString rs) else- let- (ei,is') = roundTo dec' (replicate (-e) 0 ++ is)- d:ds' = map i2d (if ei > 0 then is' else 0:is')- in- singleton d <> (if null ds' then "" else singleton '.' <> fromString ds')+ let (ei,is') = roundTo dec' (replicate (-e) 0 ++ is)+ in case map i2d (if ei > 0 then is' else 0:is') of+ [] -> mempty+ d:ds' -> singleton d <> (if null ds' then "" else singleton '.' <> fromString ds')
src/GHC/Integer/Compat.hs view
@@ -1,7 +1,14 @@ {-# LANGUAGE CPP #-}+{-# LANGUAGE Trustworthy #-} -module GHC.Integer.Compat (divInteger) where+module GHC.Integer.Compat (divInteger, quotRemInteger, quotInteger) where +import GHC.Integer (quotRemInteger, quotInteger)++#if MIN_VERSION_base(4,15,0)+import GHC.Integer (divInteger)+#else+ #ifdef MIN_VERSION_integer_simple #if MIN_VERSION_integer_simple(0,1,1)@@ -20,4 +27,5 @@ divInteger = div #endif +#endif #endif
src/Utils.hs view
@@ -1,14 +1,24 @@+{-# LANGUAGE CPP #-} {-# LANGUAGE BangPatterns #-} {-# LANGUAGE MagicHash #-} {-# LANGUAGE UnboxedTuples #-}+{-# LANGUAGE Trustworthy #-}+{-# LANGUAGE ScopedTypeVariables #-} module Utils ( roundTo , i2d+ , maxExpt+ , magnitude ) where import GHC.Base (Int(I#), Char(C#), chr#, ord#, (+#)) +import qualified Data.Primitive.Array as Primitive+import Control.Monad.ST (runST)++import Data.Bits (unsafeShiftR)+ roundTo :: Int -> [Int] -> (Int, [Int]) roundTo d is = case f d True is of@@ -34,3 +44,40 @@ {-# INLINE i2d #-} i2d :: Int -> Char i2d (I# i#) = C# (chr# (ord# '0'# +# i# ))++----------------------------------------------------------------------+-- Exponentiation with a cache for the most common numbers.+----------------------------------------------------------------------++-- | The same limit as in GHC.Float.+maxExpt :: Int+maxExpt = 324++expts10 :: Primitive.Array Integer+expts10 = runST $ do+ ma <- Primitive.newArray maxExpt uninitialised+ Primitive.writeArray ma 0 1+ Primitive.writeArray ma 1 10+ let go !ix+ | ix == maxExpt = Primitive.unsafeFreezeArray ma+ | otherwise = do+ Primitive.writeArray ma ix xx+ Primitive.writeArray ma (ix+1) (10*xx)+ go (ix+2)+ where+ xx = x * x+ x = Primitive.indexArray expts10 half+ !half = ix `unsafeShiftR` 1+ go 2++uninitialised :: error+uninitialised = error "Data.Scientific: uninitialised element"++-- | @magnitude e == 10 ^ e@+magnitude :: Num a => Int -> a+magnitude e | e < maxExpt = cachedPow10 e+ | otherwise = cachedPow10 hi * 10 ^ (e - hi)+ where+ cachedPow10 = fromInteger . Primitive.indexArray expts10++ hi = maxExpt - 1
test/test.hs view
@@ -1,4 +1,3 @@-{-# LANGUAGE CPP #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE MultiParamTypeClasses #-}@@ -10,16 +9,12 @@ module Main where -#if !MIN_VERSION_base(4,8,0)-import Control.Applicative-#endif import Control.Monad import Data.Int import Data.Word import Data.Scientific as Scientific import Test.Tasty-import Test.Tasty.Runners.AntXML-import Test.Tasty.HUnit (testCase, (@?=), Assertion)+import Test.Tasty.HUnit (testCase, (@?=), Assertion, assertBool) import qualified Test.SmallCheck as SC import qualified Test.SmallCheck.Series as SC import qualified Test.Tasty.SmallCheck as SC (testProperty)@@ -34,10 +29,60 @@ import qualified Data.ByteString.Lazy.Char8 as BLC8 import qualified Data.ByteString.Builder.Scientific as B import qualified Data.ByteString.Builder as B+import Text.ParserCombinators.ReadP (readP_to_S) main :: IO () main = testMain $ testGroup "scientific"- [ smallQuick "normalization"+ [ testGroup "DoS protection"+ [ testGroup "Eq"+ [ testCase "1e1000000" $ assertBool "" $+ (read "1e1000000" :: Scientific) == (read "1e1000000" :: Scientific)+ ]+ , testGroup "Ord"+ [ testCase "compare 1234e1000000 123e1000001" $+ compare (read "1234e1000000" :: Scientific) (read "123e1000001" :: Scientific) @?= GT+ ]++ , testGroup "RealFrac"+ [ testGroup "floor"+ [ testCase "1e1000000" $ (floor (read "1e1000000" :: Scientific) :: Int) @?= 0+ , testCase "-1e-1000000" $ (floor (read "-1e-1000000" :: Scientific) :: Int) @?= (-1)+ , testCase "1e-1000000" $ (floor (read "1e-1000000" :: Scientific) :: Int) @?= 0+ ]+ , testGroup "ceiling"+ [ testCase "1e1000000" $ (ceiling (read "1e1000000" :: Scientific) :: Int) @?= 0+ , testCase "-1e-1000000" $ (ceiling (read "-1e-1000000" :: Scientific) :: Int) @?= 0+ , testCase "1e-1000000" $ (ceiling (read "1e-1000000" :: Scientific) :: Int) @?= 1+ ]+ , testGroup "round"+ [ testCase "1e1000000" $ (round (read "1e1000000" :: Scientific) :: Int) @?= 0+ , testCase "-1e-1000000" $ (round (read "-1e-1000000" :: Scientific) :: Int) @?= 0+ , testCase "1e-1000000" $ (round (read "1e-1000000" :: Scientific) :: Int) @?= 0+ ]+ , testGroup "truncate"+ [ testCase "1e1000000" $ (truncate (read "1e1000000" :: Scientific) :: Int) @?= 0+ , testCase "-1e-1000000" $ (truncate (read "-1e-1000000" :: Scientific) :: Int) @?= 0+ , testCase "1e-1000000" $ (truncate (read "1e-1000000" :: Scientific) :: Int) @?= 0+ ]+ , testGroup "properFracton"+ [ testCase "1e1000000" $ properFraction (read "1e1000000" :: Scientific) @?= (0 :: Int, 0)+ , testCase "-1e-1000000" $ let s = read "-1e-1000000" :: Scientific+ in properFraction s @?= (0 :: Int, s)+ , testCase "1e-1000000" $ let s = read "1e-1000000" :: Scientific+ in properFraction s @?= (0 :: Int, s)+ ]+ ]+ , testGroup "toRealFloat"+ [ testCase "1e1000000" $ assertBool "Should be infinity!" $ isInfinite $+ (toRealFloat (read "1e1000000" :: Scientific) :: Double)+ , testCase "1e-1000000" $ (toRealFloat (read "1e-1000000" :: Scientific) :: Double) @?= 0+ ]+ , testGroup "toBoundedInteger"+ [ testCase "1e1000000" $ (toBoundedInteger (read "1e1000000" :: Scientific) :: Maybe Int) @?= Nothing+ ]+ ]++ , smallQuick "normalization" (SC.over normalizedScientificSeries $ \s -> s /= 0 SC.==> abs (Scientific.coefficient s) `mod` 10 /= 0) (QC.forAll normalizedScientificGen $ \s ->@@ -55,10 +100,18 @@ , testCase "reads \"(1.3 )\"" $ testReads "(1.3 )" [(1.3, "")] , testCase "reads \"((1.3))\"" $ testReads "((1.3))" [(1.3, "")] , testCase "reads \" 1.3\"" $ testReads " 1.3" [(1.3, "")]+ , testCase "read \" ( (( -1.0e+3 ) ))\"" $ testRead " ( (( -1.0e+3 ) ))" (-1000.0)+ , testCase "scientificP \"3\"" $ testScientificP "3" [(3.0, "")]+ , testCase "scientificP \"3.0e2\"" $ testScientificP "3.0e2" [(3.0, "e2"), (300.0, "")]+ , testCase "scientificP \"+3.0e+2\"" $ testScientificP "+3.0e+2" [(3.0, "e+2"), (300.0, "")]+ , testCase "scientificP \"-3.0e-2\"" $ testScientificP "-3.0e-2" [(-3.0, "e-2"), (-3.0e-2, "")] ] , testGroup "Formatting" [ testProperty "read . show == id" $ \s -> read (show s) === s+ , testCase "show (Just 1)" $ testShow (Just 1) "Just 1.0"+ , testCase "show (Just 0)" $ testShow (Just 0) "Just 0.0"+ , testCase "show (Just (-1))" $ testShow (Just (-1)) "Just (-1.0)" , testGroup "toDecimalDigits" [ smallQuick "laws"@@ -91,6 +144,17 @@ -- show d ] + , testGroup "Eq"+ [ testProperty "==" $ \(s1 :: Scientific) (s2 :: Scientific) ->+ (s1 == s2) == (toRational s1 == toRational s2)+ , testProperty "s == s" $ \(s :: Scientific) -> s == s+ ]++ , testGroup "Ord"+ [ testProperty "compare" $ \(s1 :: Scientific) (s2 :: Scientific) ->+ compare s1 s2 == compare (toRational s1) (toRational s2)+ ]+ , testGroup "Num" [ testGroup "Equal to Rational" [ testProperty "fromInteger" $ \i -> fromInteger i === fromRational (fromInteger i)@@ -213,11 +277,20 @@ ] testMain :: TestTree -> IO ()-testMain = defaultMainWithIngredients (antXMLRunner:defaultIngredients)+testMain = defaultMainWithIngredients defaultIngredients testReads :: String -> [(Scientific, String)] -> Assertion testReads inp out = reads inp @?= out +testRead :: String -> Scientific -> Assertion+testRead inp out = read inp @?= out++testShow :: Maybe Scientific -> String -> Assertion+testShow inp out = show inp @?= out++testScientificP :: String -> [(Scientific, String)] -> Assertion+testScientificP inp out = readP_to_S Scientific.scientificP inp @?= out+ genericIsFloating :: RealFrac a => a -> Bool genericIsFloating a = fromInteger (floor a :: Integer) /= a @@ -391,8 +464,4 @@ bigIntGen = QC.sized $ \size -> QC.resize (size * 1000) intGen intGen :: QC.Gen Int-#if MIN_VERSION_QuickCheck(2,7,0) intGen = QC.arbitrary-#else-intGen = QC.sized $ \n -> QC.choose (-n, n)-#endif