scientific-0.3.6.2/0000755000000000000000000000000013274161562012175 5ustar0000000000000000scientific-0.3.6.2/Setup.hs0000644000000000000000000000005613274161562013632 0ustar0000000000000000import Distribution.Simple main = defaultMain scientific-0.3.6.2/LICENSE0000644000000000000000000000276213274161562013211 0ustar0000000000000000Copyright (c) 2013, Bas van Dijk All rights reserved. Redistribution and use in source and binary forms, with or without modification, are permitted provided that the following conditions are met: * Redistributions of source code must retain the above copyright notice, this list of conditions and the following disclaimer. * Redistributions in binary form must reproduce the above copyright notice, this list of conditions and the following disclaimer in the documentation and/or other materials provided with the distribution. * Neither the name of Bas van Dijk nor the names of other contributors may be used to endorse or promote products derived from this software without specific prior written permission. THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. scientific-0.3.6.2/scientific.cabal0000644000000000000000000001110713274161562015301 0ustar0000000000000000name: scientific version: 0.3.6.2 synopsis: Numbers represented using scientific notation description: "Data.Scientific" provides the number type 'Scientific'. Scientific numbers are arbitrary precision and space efficient. They are represented using . The implementation uses a coefficient @c :: 'Integer'@ and a base-10 exponent @e :: 'Int'@. A scientific number corresponds to the 'Fractional' number: @'fromInteger' c * 10 '^^' e@. . Note that since we're using an 'Int' to represent the exponent these numbers aren't truly arbitrary precision. I intend to change the type of the exponent to 'Integer' in a future release. . 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: . * A 'Scientific' is more efficient to construct. Rational numbers need to be constructed using '%' which has to compute the 'gcd' of the 'numerator' and 'denominator'. . * 'Scientific' is safe against numbers with huge exponents. For example: @1e1000000000 :: 'Rational'@ will fill up all space and crash your program. Scientific works as expected: . >>> 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 category: Data build-type: Simple cabal-version: >=1.10 extra-source-files: changelog Tested-With: GHC == 7.6.3 , GHC == 7.8.4 , GHC == 7.10.3 , GHC == 8.0.2 , GHC == 8.2.2 , GHC == 8.4.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 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 && < 5 , integer-logarithms >= 1 , deepseq >= 1.3 , text >= 0.8 , hashable >= 1.1.2 , primitive >= 0.1 , containers >= 0.1 , binary >= 0.4.1 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 if flag(integer-simple) build-depends: integer-simple else build-depends: integer-gmp 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 && < 5 , binary >= 0.4.1 , tasty >= 0.5 , tasty-ant-xml >= 1.0 , tasty-hunit >= 0.8 , tasty-smallcheck >= 0.2 , tasty-quickcheck >= 0.8 , smallcheck >= 1.0 , QuickCheck >= 2.5 , text >= 0.8 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 benchmark bench-scientific type: exitcode-stdio-1.0 hs-source-dirs: bench main-is: bench.hs default-language: Haskell2010 ghc-options: -O2 build-depends: scientific , base >= 4.3 && < 5 , criterion >= 0.5 scientific-0.3.6.2/changelog0000644000000000000000000001624213274161562014054 0ustar00000000000000000.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. 0.3.5.0 * Export scientificP :: ReadP Scientific (Courtesy of Shlok Datye @shlok) 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 0.3.4.11 * Support tasty-ant-xml-1.1.0 0.3.4.10 * Tighten lower bound on vector from 0.5 to 0.7 because building with vector < 0.7 results in a build error. * Move the internal modules Math.NumberTheory.Logarithms and GHC.Integer.Logarithms.Compat to their own package integer-logarithms so other people can share that code. 0.3.4.9 * Support QuickCheck-2.9. 0.3.4.8 * Make bytestring-builder's installation conditional based on a Cabal flag. 0.3.4.7 * Unconditionally export Data.ByteString.Builder.Scientific. The bytestring-builder cabal flag has been removed. Depend on bytestring-builder for backwards compatibility for GHC < 7.8. 0.3.4.6 * Made toDecimalDigits more similar to floatToDigits Previously: toDecimalDigits 0 == ([0],1) Now: toDecimalDigits 0 == ([0],0) Because: Numeric.floatToDigits 10 (0 :: Double) == ([0],0) * Introduce a special case for 0 in fromFloatDigits fromFloatDigits 0 = 0 This should fix https://github.com/bos/aeson/issues/369 0.3.4.5 The following are all a courtesy of Oleg Grenrus (phadej): * Support GHC-8.0.1 * Support binary-0.8 * Enable Travis continuous integration 0.3.4.4 * Improved performance of toDecimalDigits by 13%. 0.3.4.3 * Fix build with integer-simple. 0.3.4.2 * Fix build on GHC-7.4. Courtesy of Adam Bergmark.. 0.3.4.1 * Fix build on GHC-7.0.4 0.3.4.0 * Added fromRationalRepetend & toRationalRepetend for safely converting from and to rationals which have a repeating decimal representation like: 1 % 28 = 0.03(571428). * Added a Binary instance. * Various performance improvements. * Support vector-0.11 * Support tasty-0.11 * Support criterion-1.1.0.0 0.3.3.8 * Support QuickCheck-2.8. 0.3.3.7 * Fixed both the Prelude Data.Scientific> reads "0.0" :: [(Data.Scientific.Scientific,String)] [(0.0,".0"),(0.0,"")] problem and the read " 8" :: Scientific fails, while read " 8" :: Double succeeds problem. Courtesy of neongreen. 0.3.3.6 * Fixed bug in the x / y method for Scientific. Since I was using the default implementation: `x * recip y` the operation would diverge when `recip y` had an infinite decimal output. This shouldn't happen when the result of / is finite again. For example: 0.6 / 0.3 should yield 2.0. This is now fixed by using the following implementation: `x / y = fromRational $ toRational x / toRational y` 0.3.3.5 * Fixed bug when converting the Scientific: `scientific 0 someBigExponent` to a bounded Integral using toBoundedInteger or to a bounded RealFloat using toBoundedRealFloat. If someBigExponent was big enough to trigger the big-exponent protection the beforementioned functions didn't return 0. This is fixed by explicitly handling a coefficient of 0. 0.3.3.4 * Relax upper version bounds of base and deepseq for the test suite and benchmarks. 0.3.3.3 * Add support for `deepseq-1.4`. 0.3.3.2 * Fix parsing of empty digit string (#21). 0.3.3.1 * Allow newer tasty, tasty-hunit and criterion. 0.3.3.0 * Add the isFloating or isInteger predicates. Courtesy of Zejun Wu (@watashi). * Add the toRealFloat' and toBoundedInteger functions. Courtesy of Fujimura Daisuke (@fujimura). 0.3.2.2 * Enable package to link with integer-simple instead of integer-gmp using the -finteger-simple cabal flag. Courtesy of @k0ral. 0.3.2.1 * Parameterize inclusion of the Data.ByteString.Builder.Scientific module using the bytestring-builder flag. Disabling this flag allows building on GHC-7.0.4 which has bytestring-0.9 installed by default. 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-0.3.6.2/test/0000755000000000000000000000000013274161562013154 5ustar0000000000000000scientific-0.3.6.2/test/test.hs0000644000000000000000000004457413274161562014505 0ustar0000000000000000{-# LANGUAGE CPP #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE RankNTypes #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-} {-# OPTIONS_GHC -fno-warn-orphans #-} 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, assertBool) import qualified Test.SmallCheck as SC import qualified Test.SmallCheck.Series as SC import qualified Test.Tasty.SmallCheck as SC (testProperty) import qualified Test.QuickCheck as QC import qualified Test.Tasty.QuickCheck as QC (testProperty) import qualified Data.Binary as Binary (encode, decode) import qualified Data.Text.Lazy as TL (unpack) import qualified Data.Text.Lazy.Builder as TLB (toLazyText) import qualified Data.Text.Lazy.Builder.Scientific as T import Numeric ( floatToDigits ) 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" [ 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 -> s /= 0 QC.==> abs (Scientific.coefficient s) `mod` 10 /= 0) , testGroup "Binary" [ testProperty "decode . encode == id" $ \s -> Binary.decode (Binary.encode s) === s ] , testGroup "Parsing" [ testCase "reads \"\"" $ testReads "" [] , testCase "reads \"1.\"" $ testReads "1." [(1.0, ".")] , testCase "reads \"1.2e\"" $ testReads "1.2e" [(1.2, "e")] , 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 , testGroup "toDecimalDigits" [ smallQuick "laws" (SC.over nonNegativeScientificSeries toDecimalDigits_laws) (QC.forAll nonNegativeScientificGen toDecimalDigits_laws) , smallQuick "== Numeric.floatToDigits" (toDecimalDigits_eq_floatToDigits . SC.getNonNegative) (toDecimalDigits_eq_floatToDigits . QC.getNonNegative) ] , testGroup "Builder" [ testProperty "Text" $ \s -> formatScientific Scientific.Generic Nothing s == TL.unpack (TLB.toLazyText $ T.formatScientificBuilder Scientific.Generic Nothing s) , testProperty "ByteString" $ \s -> formatScientific Scientific.Generic Nothing s == BLC8.unpack (B.toLazyByteString $ B.formatScientificBuilder Scientific.Generic Nothing s) ] , testProperty "formatScientific_fromFloatDigits" $ \(d::Double) -> formatScientific Scientific.Generic Nothing (Scientific.fromFloatDigits d) == show d -- , testProperty "formatScientific_realToFrac" $ \(d::Double) -> -- formatScientific B.Generic Nothing (realToFrac d :: Scientific) == -- 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) , testProperty "+" $ bin (+) , testProperty "-" $ bin (-) , testProperty "*" $ bin (*) , testProperty "abs" $ unary abs , testProperty "negate" $ unary negate , testProperty "signum" $ unary signum ] , testProperty "0 identity of +" $ \a -> a + 0 === a , testProperty "1 identity of *" $ \a -> 1 * a === a , testProperty "0 identity of *" $ \a -> 0 * a === 0 , testProperty "associativity of +" $ \a b c -> a + (b + c) === (a + b) + c , testProperty "commutativity of +" $ \a b -> a + b === b + a , testProperty "distributivity of * over +" $ \a b c -> a * (b + c) === a * b + a * c , testProperty "subtracting the addition" $ \x y -> x + y - y === x , testProperty "+ and negate" $ \x -> x + negate x === 0 , testProperty "- and negate" $ \x -> x - negate x === x + x , smallQuick "abs . negate == id" (SC.over nonNegativeScientificSeries $ \x -> abs (negate x) === x) (QC.forAll nonNegativeScientificGen $ \x -> abs (negate x) === x) ] , testGroup "Real" [ testProperty "fromRational . toRational == id" $ \x -> (fromRational . toRational) x === x ] , testGroup "RealFrac" [ testGroup "Equal to Rational" [ testProperty "properFraction" $ \x -> let (n1::Integer, f1::Scientific) = properFraction x (n2::Integer, f2::Rational) = properFraction (toRational x) in (n1 == n2) && (f1 == fromRational f2) , testProperty "round" $ \(x::Scientific) -> (round x :: Integer) == round (toRational x) , testProperty "truncate" $ \(x::Scientific) -> (truncate x :: Integer) == truncate (toRational x) , testProperty "ceiling" $ \(x::Scientific) -> (ceiling x :: Integer) == ceiling (toRational x) , testProperty "floor" $ \(x::Scientific) -> (floor x :: Integer) == floor (toRational x) ] , testProperty "properFraction_laws" properFraction_laws , testProperty "round" $ \s -> round s == roundDefault s , testProperty "truncate" $ \s -> truncate s == truncateDefault s , testProperty "ceiling" $ \s -> ceiling s == ceilingDefault s , testProperty "floor" $ \s -> floor s == floorDefault s ] , testGroup "Conversions" [ testProperty "fromRationalRepetend" $ \(l, r) -> r == (case fromRationalRepetend (Just l) r of Left (s, rr) -> toRational s + rr Right (s, mbRepetend) -> case mbRepetend of Nothing -> toRational s Just repetend -> toRationalRepetend s repetend) , 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) -> genericIsFloating d SC.==> (floatingOrInteger (realToFrac d) :: Either Double Integer) == Left d) (\(d::Double) -> genericIsFloating d QC.==> (floatingOrInteger (realToFrac d) :: Either Double Integer) == Left d) ] , testGroup "toBoundedInteger" [ testGroup "correct conversion" [ testProperty "Int64" $ toBoundedIntegerConversion (undefined :: Int64) , testProperty "Word64" $ toBoundedIntegerConversion (undefined :: Word64) , testProperty "NegativeNum" $ toBoundedIntegerConversion (undefined :: NegativeInt) ] ] ] , testGroup "toBoundedRealFloat" [ testCase "0 * 10^1000 == 0" $ toBoundedRealFloat (scientific 0 1000) @?= Right (0 :: Float) ] , testGroup "toBoundedInteger" [ testGroup "to Int64" $ [ testCase "succ of maxBound" $ let i = succ . fromIntegral $ (maxBound :: Int64) s = scientific i 0 in (toBoundedInteger s :: Maybe Int64) @?= Nothing , testCase "pred of minBound" $ let i = pred . fromIntegral $ (minBound :: Int64) s = scientific i 0 in (toBoundedInteger s :: Maybe Int64) @?= Nothing , testCase "0 * 10^1000 == 0" $ toBoundedInteger (scientific 0 1000) @?= Just (0 :: Int64) ] ] , testGroup "Predicates" [ testProperty "isFloating" $ \s -> isFloating s == genericIsFloating s , testProperty "isInteger" $ \s -> isInteger s == not (genericIsFloating s) ] ] testMain :: TestTree -> IO () testMain = defaultMainWithIngredients (antXMLRunner:defaultIngredients) testReads :: String -> [(Scientific, String)] -> Assertion testReads inp out = reads inp @?= out testRead :: String -> Scientific -> Assertion testRead inp out = read 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 toDecimalDigits_eq_floatToDigits :: Double -> Bool toDecimalDigits_eq_floatToDigits d = Scientific.toDecimalDigits (Scientific.fromFloatDigits d) == Numeric.floatToDigits 10 d conversionsProperties :: forall realFloat. ( RealFloat realFloat , QC.Arbitrary realFloat , SC.Serial IO realFloat , Show realFloat ) => realFloat -> [TestTree] conversionsProperties _ = [ -- testProperty "fromFloatDigits_1" $ \(d :: realFloat) -> -- Scientific.fromFloatDigits d === realToFrac d -- testProperty "fromFloatDigits_2" $ \(s :: Scientific) -> -- Scientific.fromFloatDigits (realToFrac s :: realFloat) == s testProperty "toRealFloat" $ \(d :: realFloat) -> (Scientific.toRealFloat . realToFrac) d == d , testProperty "toRealFloat . fromFloatDigits == id" $ \(d :: realFloat) -> (Scientific.toRealFloat . Scientific.fromFloatDigits) d == d -- , testProperty "fromFloatDigits . toRealFloat == id" $ \(s :: Scientific) -> -- Scientific.fromFloatDigits (Scientific.toRealFloat s :: realFloat) == s ] toBoundedIntegerConversion :: forall i. (Integral i, Bounded i) => i -> Scientific -> Bool toBoundedIntegerConversion _ s = case toBoundedInteger s :: Maybe i of Just i -> i == (fromIntegral $ (coefficient s') * 10^(base10Exponent s')) && i >= minBound && i <= maxBound where s' = normalize s Nothing -> isFloating s || s < fromIntegral (minBound :: i) || s > fromIntegral (maxBound :: i) testProperty :: (SC.Testable IO test, QC.Testable test) => TestName -> test -> TestTree testProperty n test = smallQuick n test test smallQuick :: (SC.Testable IO smallCheck, QC.Testable quickCheck) => TestName -> smallCheck -> quickCheck -> TestTree smallQuick n sc qc = testGroup n [ SC.testProperty "smallcheck" sc , QC.testProperty "quickcheck" qc ] -- | ('==') specialized to 'Scientific' so we don't have to put type -- signatures everywhere. (===) :: Scientific -> Scientific -> Bool (===) = (==) infix 4 === bin :: (forall a. Num a => a -> a -> a) -> Scientific -> Scientific -> Bool bin op a b = toRational (a `op` b) == toRational a `op` toRational b unary :: (forall a. Num a => a -> a) -> Scientific -> Bool unary op a = toRational (op a) == op (toRational a) toDecimalDigits_laws :: Scientific -> Bool toDecimalDigits_laws x = let (ds, e) = Scientific.toDecimalDigits x rule1 = n >= 1 n = length ds rule2 = toRational x == coeff * 10 ^^ e coeff = foldr (\di a -> a / 10 + fromIntegral di) 0 (0:ds) rule3 = all (\di -> 0 <= di && di <= 9) ds rule4 | n == 1 = True | otherwise = null $ takeWhile (==0) $ reverse ds in rule1 && rule2 && rule3 && rule4 properFraction_laws :: Scientific -> Bool properFraction_laws x = fromInteger n + f === x && (positive n == posX || n == 0) && (positive f == posX || f == 0) && abs f < 1 where posX = positive x (n, f) = properFraction x :: (Integer, Scientific) positive :: (Ord a, Num a) => a -> Bool positive y = y >= 0 floorDefault :: Scientific -> Integer floorDefault x = if r < 0 then n - 1 else n where (n,r) = properFraction x ceilingDefault :: Scientific -> Integer ceilingDefault x = if r > 0 then n + 1 else n where (n,r) = properFraction x truncateDefault :: Scientific -> Integer truncateDefault x = m where (m,_) = properFraction x roundDefault :: Scientific -> Integer roundDefault x = let (n,r) = properFraction x m = if r < 0 then n - 1 else n + 1 in case signum (abs r - 0.5) of -1 -> n 0 -> if even n then n else m 1 -> m _ -> error "round default defn: Bad value" newtype NegativeInt = NegativeInt Int deriving (Show, Enum, Eq, Ord, Num, Real, Integral) instance Bounded NegativeInt where minBound = -100 maxBound = -10 ---------------------------------------------------------------------- -- SmallCheck instances ---------------------------------------------------------------------- instance (Monad m) => SC.Serial m Scientific where series = scientifics scientifics :: (Monad m) => SC.Series m Scientific scientifics = SC.cons2 scientific nonNegativeScientificSeries :: (Monad m) => SC.Series m Scientific nonNegativeScientificSeries = liftM SC.getNonNegative SC.series normalizedScientificSeries :: (Monad m) => SC.Series m Scientific normalizedScientificSeries = liftM Scientific.normalize SC.series ---------------------------------------------------------------------- -- QuickCheck instances ---------------------------------------------------------------------- instance QC.Arbitrary Scientific where arbitrary = QC.frequency [ (70, scientific <$> QC.arbitrary <*> intGen) , (20, scientific <$> QC.arbitrary <*> bigIntGen) , (10, scientific <$> pure 0 <*> bigIntGen) ] shrink s = zipWith scientific (QC.shrink $ Scientific.coefficient s) (QC.shrink $ Scientific.base10Exponent s) nonNegativeScientificGen :: QC.Gen Scientific nonNegativeScientificGen = scientific <$> (QC.getNonNegative <$> QC.arbitrary) <*> intGen normalizedScientificGen :: QC.Gen Scientific normalizedScientificGen = Scientific.normalize <$> QC.arbitrary bigIntGen :: QC.Gen Int 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 scientific-0.3.6.2/src/0000755000000000000000000000000013274161562012764 5ustar0000000000000000scientific-0.3.6.2/src/Utils.hs0000644000000000000000000000154413274161562014424 0ustar0000000000000000{-# LANGUAGE BangPatterns #-} {-# LANGUAGE MagicHash #-} {-# LANGUAGE UnboxedTuples #-} module Utils ( roundTo , i2d ) where import GHC.Base (Int(I#), Char(C#), chr#, ord#, (+#)) roundTo :: Int -> [Int] -> (Int, [Int]) roundTo d is = case f d True is of x@(0,_) -> x (1,xs) -> (1, 1:xs) _ -> error "roundTo: bad Value" where base = 10 b2 = base `quot` 2 f n _ [] = (0, replicate n 0) f 0 e (x:xs) | x == b2 && e && all (== 0) xs = (0, []) -- Round to even when at exactly half the base | otherwise = (if x >= b2 then 1 else 0, []) f n _ (i:xs) | i' == base = (1,0:ds) | otherwise = (0,i':ds) where (c,ds) = f (n-1) (even i) xs i' = c + i -- | Unsafe conversion for decimal digits. {-# INLINE i2d #-} i2d :: Int -> Char i2d (I# i#) = C# (chr# (ord# '0'# +# i# )) scientific-0.3.6.2/src/Data/0000755000000000000000000000000013274161562013635 5ustar0000000000000000scientific-0.3.6.2/src/Data/Scientific.hs0000644000000000000000000012214013274161562016251 0ustar0000000000000000{-# LANGUAGE CPP #-} {-# LANGUAGE DeriveDataTypeable #-} {-# LANGUAGE BangPatterns #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE UnboxedTuples #-} {-# LANGUAGE PatternGuards #-} -- | -- Module : Data.Scientific -- Copyright : Bas van Dijk 2013 -- License : BSD3 -- Maintainer : Bas van Dijk -- -- This module provides the number type 'Scientific'. Scientific numbers are -- arbitrary precision and space efficient. They are represented using -- . The -- implementation uses an 'Integer' 'coefficient' @c@ and an 'Int' -- 'base10Exponent' @e@. A scientific number corresponds to the 'Fractional' -- number: @'fromInteger' c * 10 '^^' e@. -- -- Note that since we're using an 'Int' to represent the exponent these numbers -- 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: -- -- * A 'Scientific' is more efficient to construct. Rational numbers need to be -- constructed using '%' which has to compute the 'gcd' of the 'numerator' and -- 'denominator'. -- -- * 'Scientific' is safe against numbers with huge exponents. For example: -- @1e1000000000 :: 'Rational'@ will fill up all space and crash your -- program. Scientific works as expected: -- -- > > 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. -- -- This module is designed to be imported qualified: -- -- @import Data.Scientific as Scientific@ module Data.Scientific ( Scientific -- * Construction , scientific -- * Projections , coefficient , base10Exponent -- * Predicates , isFloating , isInteger -- * Conversions -- ** Rational , unsafeFromRational , fromRationalRepetend , fromRationalRepetendLimited , fromRationalRepetendUnlimited , toRationalRepetend -- ** Floating & integer , floatingOrInteger , toRealFloat , toBoundedRealFloat , toBoundedInteger , fromFloatDigits -- * Parsing , scientificP -- * Pretty printing , formatScientific , FPFormat(..) , toDecimalDigits -- * Normalization , normalize ) where ---------------------------------------------------------------------- -- Imports ---------------------------------------------------------------------- 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.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) import qualified Text.Read as Read import Text.Read (readPrec) import qualified Text.ParserCombinators.ReadPrec as ReadPrec import qualified Text.ParserCombinators.ReadP as ReadP import Text.ParserCombinators.ReadP ( ReadP ) import Data.Text.Lazy.Builder.RealFloat (FPFormat(..)) #if !MIN_VERSION_base(4,9,0) import Control.Applicative ((*>)) #endif #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) ---------------------------------------------------------------------- -- Type ---------------------------------------------------------------------- -- | An arbitrary-precision number represented using -- . -- -- This type describes the set of all @'Real's@ which have a finite -- decimal expansion. -- -- A scientific number with 'coefficient' @c@ and 'base10Exponent' @e@ -- corresponds to the 'Fractional' number: @'fromInteger' c * 10 '^^' e@ data Scientific = Scientific { coefficient :: !Integer -- ^ The coefficient of a scientific number. -- -- Note that this number is not necessarily normalized, i.e. -- it could contain trailing zeros. -- -- Scientific numbers are automatically normalized when pretty printed or -- in 'toDecimalDigits'. -- -- Use 'normalize' to do manual normalization. , base10Exponent :: {-# UNPACK #-} !Int -- ^ The base-10 exponent of a scientific number. } deriving (Typeable, Data) -- | @scientific c e@ constructs a scientific number which corresponds -- to the 'Fractional' number: @'fromInteger' c * 10 '^^' e@. scientific :: Integer -> Int -> Scientific scientific = Scientific ---------------------------------------------------------------------- -- Instances ---------------------------------------------------------------------- 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. instance Hashable Scientific where 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) = 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 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 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 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 log10cx = integerLog10' cx log10cy = integerLog10' cy 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 | otherwise = Scientific (c1*r + c2 ) e2 where l = magnitude (e2 - e1) r = magnitude (e1 - e2) {-# INLINABLE (+) #-} Scientific c1 e1 - Scientific c2 e2 | e1 < e2 = Scientific (c1 - c2*l) e1 | otherwise = Scientific (c1*r - c2 ) e2 where l = magnitude (e2 - e1) r = magnitude (e1 - e2) {-# INLINABLE (-) #-} Scientific c1 e1 * Scientific c2 e2 = Scientific (c1 * c2) (e1 + e2) {-# INLINABLE (*) #-} abs (Scientific c e) = Scientific (abs c) e {-# INLINABLE abs #-} negate (Scientific c e) = Scientific (negate c) e {-# INLINABLE negate #-} signum (Scientific c _) = Scientific (signum c) 0 {-# INLINABLE signum #-} fromInteger i = Scientific i 0 {-# INLINABLE fromInteger #-} -- | /WARNING:/ 'toRational' needs to compute the 'Integer' magnitude: -- @10^e@. If applied to a huge exponent this could fill up all space -- and crash your program! -- -- Avoid applying 'toRational' (or 'realToFrac') to scientific numbers -- coming from an untrusted source and use 'toRealFloat' instead. The -- latter guards against excessive space usage. instance Real Scientific where toRational (Scientific c e) | e < 0 = c % magnitude (-e) | otherwise = (c * magnitude e) % 1 {-# INLINABLE toRational #-} {-# RULES "realToFrac_toRealFloat_Double" realToFrac = toRealFloat :: Scientific -> Double #-} {-# RULES "realToFrac_toRealFloat_Float" realToFrac = toRealFloat :: Scientific -> Float #-} -- | /WARNING:/ 'recip' and '/' will throw an error when their outputs are -- . -- -- '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 (/) #-} 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 (s, mbRepetendIx) = fromRationalRepetendUnlimited rational -- | Although 'fromRational' is unsafe because it will throw errors on -- , -- @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 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 -- -- it detects the repeating part, the /repetend/, and returns where it starts. -- -- To detect the repetition this function consumes space linear in the number of -- digits in the resulting scientific. In order to bound the space usage an -- optional limit can be specified. If the number of digits reaches this limit -- @Left (s, r)@ will be returned. Here @s@ is the 'Scientific' constructed so -- far and @r@ is the remaining 'Rational'. @toRational s + r@ yields the -- original 'Rational' -- -- If the limit is not reached or no limit was specified @Right (s, -- mbRepetendIx)@ will be returned. Here @s@ is the 'Scientific' without any -- repetition and @mbRepetendIx@ specifies if and where in the fractional part -- the repetend begins. -- -- For example: -- -- @fromRationalRepetend Nothing (1 % 28) == Right (3.571428e-2, Just 2)@ -- -- This represents the repeating decimal: @0.03571428571428571428...@ -- which is sometimes also unambiguously denoted as @0.03(571428)@. -- Here the repetend is enclosed in parentheses and starts at the 3rd digit (index 2) -- in the fractional part. Specifying a limit results in the following: -- -- @fromRationalRepetend (Just 4) (1 % 28) == Left (3.5e-2, 1 % 1400)@ -- -- You can expect the following property to hold. -- -- @ forall (mbLimit :: Maybe Int) (r :: Rational). -- r == (case 'fromRationalRepetend' mbLimit r of -- Left (s, r') -> toRational s + r' -- Right (s, mbRepetendIx) -> -- case mbRepetendIx of -- Nothing -> toRational s -- Just repetendIx -> 'toRationalRepetend' s repetendIx) -- @ fromRationalRepetend :: Maybe Int -- ^ Optional limit -> Rational -> Either (Scientific, Rational) (Scientific, Maybe Int) 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) Right (s, mb) -> Right (-s, mb) | otherwise = longDiv num where num = numerator rational longDiv :: Integer -> Either (Scientific, Rational) (Scientific, Maybe Int) longDiv = longDivWithLimit 0 0 M.empty 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 -> (Integer -> (Scientific, Maybe Int)) 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 = 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 d = denominator rational -- | -- Converts a `Scientific` with a /repetend/ (a repeating part in the fraction), -- which starts at the given index, into its corresponding 'Rational'. -- -- For example to convert the repeating decimal @0.03(571428)@ you would use: -- @toRationalRepetend 0.03571428 2 == 1 % 28@ -- -- Preconditions for @toRationalRepetend s r@: -- -- * @r >= 0@ -- -- * @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: -- -- and is defined as follows: -- -- @ -- (fromInteger nonRepetend + repetend % nines) / -- fromInteger (10^^r) -- where -- c = coefficient s -- e = base10Exponent s -- -- -- Size of the fractional part. -- f = (-e) -- -- -- Size of the repetend. -- n = f - r -- -- m = 10^^n -- -- (nonRepetend, repetend) = c \`quotRem\` m -- -- nines = m - 1 -- @ -- Also see: 'fromRationalRepetend'. toRationalRepetend :: Scientific -> Int -- ^ Repetend index -> Rational toRationalRepetend s r | r < 0 = error "toRationalRepetend: Negative repetend index!" | r >= f = error "toRationalRepetend: Repetend index >= than number of digits in the fractional part!" | otherwise = (fromInteger nonRepetend + repetend % nines) / fromInteger (magnitude r) where c = coefficient s e = base10Exponent s -- Size of the fractional part. f = (-e) -- Size of the repetend. n = f - r m = magnitude n (#nonRepetend, repetend#) = c `quotRemInteger` m 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: -- -- * @n@ is an integral number with the same sign as @s@; and -- -- * @f@ is a fraction with the same type and sign as @s@, -- and with absolute value less than @1@. properFraction s@(Scientific c e) | e < 0 = if dangerouslySmall c e then (0, s) else case c `quotRemInteger` magnitude (-e) of (#q, r#) -> (fromInteger q, Scientific r e) | otherwise = (toIntegral s, 0) {-# INLINABLE properFraction #-} -- | @'truncate' s@ returns the integer nearest @s@ -- between zero and @s@ truncate = whenFloating $ \c e -> if dangerouslySmall c e then 0 else fromInteger $ c `quotInteger` magnitude (-e) {-# INLINABLE truncate #-} -- | @'round' s@ returns the nearest integer to @s@; -- the even integer if @s@ is equidistant between two integers round = whenFloating $ \c e -> if dangerouslySmall c e then 0 else let (#q, r#) = c `quotRemInteger` magnitude (-e) n = fromInteger q m | r < 0 = n - 1 | otherwise = n + 1 f = Scientific r e in case signum $ coefficient $ abs f - 0.5 of -1 -> n 0 -> if even n then n else m 1 -> m _ -> error "round default defn: Bad value" {-# INLINABLE round #-} -- | @'ceiling' s@ returns the least integer not less than @s@ ceiling = whenFloating $ \c e -> if dangerouslySmall c e then if c <= 0 then 0 else 1 else case c `quotRemInteger` magnitude (-e) of (#q, r#) | r <= 0 -> fromInteger q | otherwise -> fromInteger (q + 1) {-# INLINABLE ceiling #-} -- | @'floor' s@ returns the greatest integer not greater than @s@ floor = whenFloating $ \c e -> if dangerouslySmall c e then if c < 0 then -1 else 0 else fromInteger (c `divInteger` magnitude (-e)) {-# INLINABLE floor #-} ---------------------------------------------------------------------- -- Internal utilities ---------------------------------------------------------------------- -- | This function is used in the 'RealFrac' methods to guard against -- computing a huge magnitude (-e) which could take up all space. -- -- Think about parsing a scientific number from an untrusted -- string. An attacker could supply 1e-1000000000. Lets say we want to -- 'floor' that number to an 'Int'. When we naively try to floor it -- using: -- -- @ -- floor = whenFloating $ \c e -> -- fromInteger (c `div` magnitude (-e)) -- @ -- -- We will compute the huge Integer: @magnitude 1000000000@. This -- computation will quickly fill up all space and crash the program. -- -- Note that for large /positive/ exponents there is no risk of a -- space-leak since 'whenFloating' will compute: -- -- @fromInteger c * magnitude e :: a@ -- -- where @a@ is the target type (Int in this example). So here the -- space usage is bounded by the target type. -- -- For large negative exponents we check if the exponent is smaller -- than some limit (currently -324). In that case we know that the -- scientific number is really small (unless the coefficient has many -- digits) so we can immediately return -1 for negative scientific -- numbers or 0 for positive numbers. -- -- More precisely if @dangerouslySmall c e@ returns 'True' the -- scientific number @s@ is guaranteed to be between: -- @-0.1 > s < 0.1@. -- -- Note that we avoid computing the number of decimal digits in c -- (log10 c) if the exponent is not below the limit. dangerouslySmall :: Integer -> Int -> Bool dangerouslySmall c e = e < (-limit) && e < (-integerLog10' (abs c)) - 1 {-# INLINE dangerouslySmall #-} limit :: Int limit = maxExpt positivize :: (Ord a, Num a, Num b) => (a -> b) -> (a -> b) positivize f x | x < 0 = -(f (-x)) | otherwise = f x {-# INLINE positivize #-} whenFloating :: (Num a) => (Integer -> Int -> a) -> Scientific -> a whenFloating f s@(Scientific c e) | e < 0 = f c 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 = 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 :: 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 ---------------------------------------------------------------------- -- Conversions ---------------------------------------------------------------------- -- | Convert a 'RealFloat' (like a 'Double' or 'Float') into a 'Scientific' -- number. -- -- Note that this function uses 'Numeric.floatToDigits' to compute the digits -- and exponent of the 'RealFloat' number. Be aware that the algorithm used in -- 'Numeric.floatToDigits' doesn't work as expected for some numbers, e.g. as -- the 'Double' @1e23@ is converted to @9.9999999999999991611392e22@, and that -- value is shown as @9.999999999999999e22@ rather than the shorter @1e23@; the -- algorithm doesn't take the rounding direction for values exactly half-way -- between two adjacent representable values into account, so if you have a -- value with a short decimal representation exactly half-way between two -- adjacent representable values, like @5^23*2^e@ for @e@ close to 23, the -- algorithm doesn't know in which direction the short decimal representation -- would be rounded and computes more digits fromFloatDigits :: (RealFloat a) => a -> Scientific fromFloatDigits 0 = 0 fromFloatDigits rf = positivize fromPositiveRealFloat rf where fromPositiveRealFloat r = go digits 0 0 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'). -- -- Note that this function uses 'realToFrac' (@'fromRational' . 'toRational'@) -- internally but it guards against computing huge Integer magnitudes (@10^e@) -- that could fill up all space and crash your program. 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 respectively. Use -- 'toBoundedRealFloat' which explicitly handles this case by returning 'Left'. -- -- Always prefer 'toRealFloat' over 'realToFrac' when converting from scientific -- numbers coming from an untrusted source. 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 = 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 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 -- | Convert a `Scientific` to a bounded integer. -- -- If the given `Scientific` doesn't fit in the target representation, it will -- return `Nothing`. -- -- This function also guards against computing huge Integer magnitudes (@10^e@) -- that could fill up all space and crash your program. toBoundedInteger :: forall i. (Integral i, Bounded i) => Scientific -> Maybe i toBoundedInteger s | c == 0 = fromIntegerBounded 0 | integral = if dangerouslyBig then Nothing else fromIntegerBounded n | otherwise = Nothing where c = coefficient s integral = e >= 0 || e' >= 0 e = base10Exponent s e' = base10Exponent s' s' = normalize s dangerouslyBig = e > limit && e > integerLog10' (max (abs iMinBound) (abs iMaxBound)) fromIntegerBounded :: Integer -> Maybe i fromIntegerBounded i | i < iMinBound || i > iMaxBound = Nothing | otherwise = Just $ fromInteger i iMinBound = toInteger (minBound :: i) iMaxBound = toInteger (maxBound :: i) -- This should not be evaluated if the given Scientific is dangerouslyBig -- since it could consume all space and crash the process: 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' 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 | base10Exponent s >= 0 = Right (toIntegral s) | base10Exponent s' >= 0 = Right (toIntegral s') | otherwise = Left (toRealFloat s') where s' = normalize s ---------------------------------------------------------------------- -- Predicates ---------------------------------------------------------------------- -- | Return 'True' if the scientific is a floating point, 'False' otherwise. -- -- Also see: 'floatingOrInteger'. isFloating :: Scientific -> Bool isFloating = not . isInteger -- | Return 'True' if the scientific is an integer, 'False' otherwise. -- -- Also see: 'floatingOrInteger'. isInteger :: Scientific -> Bool isInteger s = base10Exponent s >= 0 || base10Exponent s' >= 0 where s' = normalize s ---------------------------------------------------------------------- -- Parsing ---------------------------------------------------------------------- -- | Supports the skipping of parentheses and whitespaces. Example: -- -- > > read " ( (( -1.0e+3 ) ))" :: Scientific -- > -1000.0 -- -- (Note: This @Read@ instance makes internal use of -- 'scientificP' to parse the floating-point number.) instance Read Scientific where readPrec = Read.parens $ ReadPrec.lift (ReadP.skipSpaces >> scientificP) -- A strict pair data SP = SP !Integer {-# UNPACK #-}!Int -- | A parser for parsing a floating-point -- number into a 'Scientific' value. Example: -- -- > > import Text.ParserCombinators.ReadP (readP_to_S) -- > > readP_to_S scientificP "3" -- > [(3.0,"")] -- > > readP_to_S scientificP "3.0e2" -- > [(3.0,"e2"),(300.0,"")] -- > > readP_to_S scientificP "+3.0e+2" -- > [(3.0,"e+2"),(300.0,"")] -- > > readP_to_S scientificP "-3.0e-2" -- > [(-3.0,"e-2"),(-3.0e-2,"")] -- -- Note: This parser only parses the number itself; it does -- not parse any surrounding parentheses or whitespaces. scientificP :: ReadP Scientific scientificP = do let positive = (('+' ==) <$> ReadP.satisfy isSign) `mplus` return True pos <- positive let step :: Num a => a -> Int -> a step a digit = a * 10 + fromIntegral digit {-# INLINE step #-} n <- foldDigits step 0 let s = SP n 0 fractional = foldDigits (\(SP a e) digit -> SP (step a digit) (e-1)) s SP coeff expnt <- (ReadP.satisfy (== '.') >> fractional) ReadP.<++ return s let signedCoeff | pos = coeff | otherwise = (-coeff) eP = do posE <- positive e <- foldDigits step 0 if posE then return e else return (-e) (ReadP.satisfy isE >> ((Scientific signedCoeff . (expnt +)) <$> eP)) `mplus` return (Scientific signedCoeff expnt) foldDigits :: (a -> Int -> a) -> a -> ReadP a foldDigits f z = do c <- ReadP.satisfy isDecimal let digit = ord c - 48 a = f z digit ReadP.look >>= go a where go !a [] = return a go !a (c:cs) | isDecimal c = do _ <- ReadP.get let digit = ord c - 48 go (f a digit) cs | otherwise = return a isDecimal :: Char -> Bool isDecimal c = c >= '0' && c <= '9' {-# INLINE isDecimal #-} isSign :: Char -> Bool isSign c = c == '-' || c == '+' {-# INLINE isSign #-} isE :: Char -> Bool isE c = c == 'e' || c == 'E' {-# INLINE isE #-} ---------------------------------------------------------------------- -- 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 where showPositive :: Scientific -> String showPositive = fmtAsGeneric . toDecimalDigits fmtAsGeneric :: ([Int], Int) -> String fmtAsGeneric x@(_is, e) | e < 0 || e > 7 = fmtAsExponent x | otherwise = fmtAsFixed x fmtAsExponent :: ([Int], Int) -> String fmtAsExponent (is, e) = case ds of "0" -> "0.0e0" [d] -> d : '.' :'0' : 'e' : show_e' (d:ds') -> d : '.' : ds' ++ ('e' : show_e') [] -> error "formatScientific/doFmt/FFExponent: []" where show_e' = show (e-1) ds = map intToDigit is fmtAsFixed :: ([Int], Int) -> String fmtAsFixed (is, e) | e <= 0 = '0':'.':(replicate (-e) '0' ++ ds) | otherwise = let f 0 s rs = mk0 (reverse s) ++ '.':mk0 rs f n s "" = f (n-1) ('0':s) "" f n s (r:rs) = f (n-1) (r:s) rs in f e "" ds where mk0 "" = "0" mk0 ls = ls ds = map intToDigit is -- | Like 'show' but provides rendering options. formatScientific :: FPFormat -> Maybe Int -- ^ Number of decimal places to render. -> Scientific -> String formatScientific format mbDecs s | coefficient s < 0 = '-':formatPositiveScientific (-s) | otherwise = formatPositiveScientific s where formatPositiveScientific :: Scientific -> String formatPositiveScientific s' = case format of Generic -> fmtAsGeneric $ toDecimalDigits s' Exponent -> fmtAsExponentMbDecs $ toDecimalDigits s' Fixed -> fmtAsFixedMbDecs $ toDecimalDigits s' fmtAsGeneric :: ([Int], Int) -> String fmtAsGeneric x@(_is, e) | e < 0 || e > 7 = fmtAsExponentMbDecs x | otherwise = fmtAsFixedMbDecs x fmtAsExponentMbDecs :: ([Int], Int) -> String fmtAsExponentMbDecs x = case mbDecs of Nothing -> fmtAsExponent x Just dec -> fmtAsExponentDecs dec x fmtAsFixedMbDecs :: ([Int], Int) -> String fmtAsFixedMbDecs x = case mbDecs of Nothing -> fmtAsFixed x Just dec -> fmtAsFixedDecs dec x fmtAsExponentDecs :: Int -> ([Int], Int) -> String fmtAsExponentDecs dec (is, e) = let dec' = max dec 1 in 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) fmtAsFixedDecs :: Int -> ([Int], Int) -> String fmtAsFixedDecs dec (is, e) = let dec' = max dec 0 in if e >= 0 then let (ei,is') = roundTo (dec' + e) is (ls,rs) = splitAt (e+ei) (map intToDigit is') 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') where mk0 ls = case ls of { "" -> "0" ; _ -> ls} ---------------------------------------------------------------------- -- | Similar to 'Numeric.floatToDigits', @toDecimalDigits@ takes a -- positive 'Scientific' number, and returns a list of digits and -- a base-10 exponent. In particular, if @x>=0@, and -- -- > toDecimalDigits x = ([d1,d2,...,dn], e) -- -- then -- -- 1. @n >= 1@ -- 2. @x = 0.d1d2...dn * (10^^e)@ -- 3. @0 <= di <= 9@ -- 4. @null $ takeWhile (==0) $ reverse [d1,d2,...,dn]@ -- -- The last property means that the coefficient will be normalized, i.e. doesn't -- contain trailing zeros. toDecimalDigits :: Scientific -> ([Int], Int) toDecimalDigits (Scientific 0 _) = ([0], 0) toDecimalDigits (Scientific c' e') = case normalizePositive c' e' of Scientific c e -> go c 0 [] where go :: Integer -> Int -> [Int] -> ([Int], Int) go 0 !n ds = (ds, ne) where !ne = n + e go i !n ds = case i `quotRemInteger` 10 of (# q, r #) -> go q (n+1) (d:ds) where !d = fromIntegral r ---------------------------------------------------------------------- -- Normalization ---------------------------------------------------------------------- -- | Normalize a scientific number by dividing out powers of 10 from the -- 'coefficient' and incrementing the 'base10Exponent' each time. -- -- You should rarely have a need for this function since scientific numbers are -- automatically normalized when pretty-printed and in 'toDecimalDigits'. normalize :: Scientific -> Scientific normalize (Scientific c e) | c > 0 = normalizePositive c e | c < 0 = -(normalizePositive (-c) e) | otherwise {- c == 0 -} = Scientific 0 0 normalizePositive :: Integer -> Int -> Scientific normalizePositive !c !e = case quotRemInteger c 10 of (# c', r #) | r == 0 -> normalizePositive c' (e+1) | otherwise -> Scientific c e scientific-0.3.6.2/src/Data/ByteString/0000755000000000000000000000000013274161562015727 5ustar0000000000000000scientific-0.3.6.2/src/Data/ByteString/Builder/0000755000000000000000000000000013274161562017315 5ustar0000000000000000scientific-0.3.6.2/src/Data/ByteString/Builder/Scientific.hs0000644000000000000000000000713213274161562021734 0ustar0000000000000000{-# LANGUAGE CPP, OverloadedStrings #-} module Data.ByteString.Builder.Scientific ( scientificBuilder , formatScientificBuilder , FPFormat(..) ) where import Data.Scientific (Scientific) import qualified Data.Scientific as Scientific import Data.Text.Lazy.Builder.RealFloat (FPFormat(..)) import qualified Data.ByteString.Char8 as BC8 import Data.ByteString.Builder (Builder, string8, char8, intDec) import Data.ByteString.Builder.Extra (byteStringCopy) 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 -- precision, using standard decimal notation for arguments whose -- absolute value lies between @0.1@ and @9,999,999@, and scientific -- notation otherwise. scientificBuilder :: Scientific -> Builder scientificBuilder = formatScientificBuilder Generic Nothing -- | Like 'scientificBuilder' but provides rendering options. formatScientificBuilder :: FPFormat -> Maybe Int -- ^ Number of decimal places to render. -> Scientific -> Builder formatScientificBuilder fmt decs scntfc | scntfc < 0 = char8 '-' <> doFmt fmt (Scientific.toDecimalDigits (-scntfc)) | otherwise = doFmt fmt (Scientific.toDecimalDigits scntfc) where doFmt format (is, e) = let ds = map i2d is in case format of Generic -> doFmt (if e < 0 || e > 7 then Exponent else Fixed) (is,e) Exponent -> case decs of Nothing -> let show_e' = intDec (e-1) in case ds of "0" -> byteStringCopy "0.0e0" [d] -> char8 d <> byteStringCopy ".0e" <> show_e' (d:ds') -> char8 d <> char8 '.' <> string8 ds' <> char8 'e' <> show_e' [] -> error $ "Data.ByteString.Builder.Scientific.formatScientificBuilder" ++ "/doFmt/Exponent: []" Just dec -> let dec' = max dec 1 in case is of [0] -> byteStringCopy "0." <> 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) Fixed -> let mk0 ls = case ls of { "" -> char8 '0' ; _ -> string8 ls} in case decs of Nothing | e <= 0 -> byteStringCopy "0." <> byteStringCopy (BC8.replicate (-e) '0') <> string8 ds | otherwise -> let f 0 s rs = mk0 (reverse s) <> char8 '.' <> mk0 rs f n s "" = f (n-1) ('0':s) "" f n s (r:rs) = f (n-1) (r:s) rs in f e "" ds Just dec -> let dec' = max dec 0 in if e >= 0 then let (ei,is') = roundTo (dec' + e) is (ls,rs) = splitAt (e+ei) (map i2d is') 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') scientific-0.3.6.2/src/Data/Text/0000755000000000000000000000000013274161562014561 5ustar0000000000000000scientific-0.3.6.2/src/Data/Text/Lazy/0000755000000000000000000000000013274161562015500 5ustar0000000000000000scientific-0.3.6.2/src/Data/Text/Lazy/Builder/0000755000000000000000000000000013274161562017066 5ustar0000000000000000scientific-0.3.6.2/src/Data/Text/Lazy/Builder/Scientific.hs0000644000000000000000000000657713274161562021521 0ustar0000000000000000{-# LANGUAGE CPP, OverloadedStrings #-} module Data.Text.Lazy.Builder.Scientific ( scientificBuilder , formatScientificBuilder , FPFormat(..) ) where import Data.Scientific (Scientific) import qualified Data.Scientific as Scientific import Data.Text.Lazy.Builder.RealFloat (FPFormat(..)) import Data.Text.Lazy.Builder (Builder, fromString, singleton, fromText) import Data.Text.Lazy.Builder.Int (decimal) 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 -- absolute value lies between @0.1@ and @9,999,999@, and scientific -- notation otherwise. scientificBuilder :: Scientific -> Builder scientificBuilder = formatScientificBuilder Generic Nothing -- | Like 'scientificBuilder' but provides rendering options. formatScientificBuilder :: FPFormat -> Maybe Int -- ^ Number of decimal places to render. -> Scientific -> Builder formatScientificBuilder fmt decs scntfc | scntfc < 0 = singleton '-' <> doFmt fmt (Scientific.toDecimalDigits (-scntfc)) | otherwise = doFmt fmt (Scientific.toDecimalDigits scntfc) where doFmt format (is, e) = let ds = map i2d is in case format of Generic -> doFmt (if e < 0 || e > 7 then Exponent else Fixed) (is,e) Exponent -> case decs of Nothing -> let show_e' = decimal (e-1) in case ds of "0" -> "0.0e0" [d] -> singleton d <> ".0e" <> show_e' (d:ds') -> singleton d <> singleton '.' <> fromString ds' <> singleton 'e' <> show_e' [] -> error $ "Data.Text.Lazy.Builder.Scientific.formatScientificBuilder" ++ "/doFmt/Exponent: []" Just dec -> let dec' = max dec 1 in 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) Fixed -> let mk0 ls = case ls of { "" -> "0" ; _ -> fromString ls} in case decs of Nothing | e <= 0 -> "0." <> fromText (T.replicate (-e) "0") <> fromString ds | otherwise -> let f 0 s rs = mk0 (reverse s) <> singleton '.' <> mk0 rs f n s "" = f (n-1) ('0':s) "" f n s (r:rs) = f (n-1) (r:s) rs in f e "" ds Just dec -> let dec' = max dec 0 in if e >= 0 then let (ei,is') = roundTo (dec' + e) is (ls,rs) = splitAt (e+ei) (map i2d is') 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') scientific-0.3.6.2/src/GHC/0000755000000000000000000000000013274161562013365 5ustar0000000000000000scientific-0.3.6.2/src/GHC/Integer/0000755000000000000000000000000013274161562014762 5ustar0000000000000000scientific-0.3.6.2/src/GHC/Integer/Compat.hs0000644000000000000000000000062413274161562016543 0ustar0000000000000000{-# LANGUAGE CPP #-} module GHC.Integer.Compat (divInteger) where #ifdef MIN_VERSION_integer_simple #if MIN_VERSION_integer_simple(0,1,1) import GHC.Integer (divInteger) #else divInteger :: Integer -> Integer -> Integer divInteger = div #endif #else #if MIN_VERSION_integer_gmp(0,5,1) import GHC.Integer (divInteger) #else divInteger :: Integer -> Integer -> Integer divInteger = div #endif #endif scientific-0.3.6.2/bench/0000755000000000000000000000000013274161562013254 5ustar0000000000000000scientific-0.3.6.2/bench/bench.hs0000644000000000000000000001172213274161562014672 0ustar0000000000000000module Main where import Criterion.Main import Data.Int import Data.Word import Data.Scientific main :: IO () main = defaultMain [ bgroup "realToFrac" [ bgroup "Scientific->Double" [ sToD "dangerouslyBig" dangerouslyBig , sToD "dangerouslySmall" dangerouslySmall , sToD "pos" pos , sToD "neg" neg , sToD "int" int , sToD "negInt" negInt ] , bgroup "Double->Scientific" [ dToS "pos" pos , dToS "neg" neg , dToS "int" int , dToS "negInt" negInt ] ] , bgroup "floor" [ bench "floor" (nf (floor :: Scientific -> Integer) $! pos) , bench "floorDefault" (nf floorDefault $! pos) ] , bgroup "ceiling" [ bench "ceiling" (nf (ceiling :: Scientific -> Integer) $! pos) , bench "ceilingDefault" (nf ceilingDefault $! pos) ] , bgroup "truncate" [ bench "truncate" (nf (truncate :: Scientific -> Integer) $! pos) , bench "truncateDefault" (nf truncateDefault $! pos) ] , bgroup "round" [ bench "round" (nf (round :: Scientific -> Integer) $! pos) , bench "roundDefault" (nf roundDefault $! pos) ] , 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 pos = 12345.12345 neg :: Fractional a => a neg = -pos int :: Fractional a => a int = 12345 negInt :: Fractional a => a negInt = -int 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 #-} realToFracDtoS :: Double -> Scientific realToFracDtoS = fromRational . toRational {-# INLINE realToFracDtoS #-} sToD :: String -> Scientific -> Benchmark sToD name f = bgroup name [ bench "toRealFloat" . nf (realToFrac :: Scientific -> Double) $! f , bench "via Rational" . nf (realToFracStoD :: Scientific -> Double) $! f ] dToS :: String -> Double -> Benchmark dToS name f = bgroup name [ bench "fromRealFloat" . nf (realToFrac :: Double -> Scientific) $! f , bench "via Rational" . nf (realToFracDtoS :: Double -> Scientific) $! f ] floorDefault :: Scientific -> Integer floorDefault x = if r < 0 then n - 1 else n where (n,r) = properFraction x {-# INLINE floorDefault #-} ceilingDefault :: Scientific -> Integer ceilingDefault x = if r > 0 then n + 1 else n where (n,r) = properFraction x {-# INLINE ceilingDefault #-} truncateDefault :: Scientific -> Integer truncateDefault x = m where (m,_) = properFraction x {-# INLINE truncateDefault #-} roundDefault :: Scientific -> Integer roundDefault x = let (n,r) = properFraction x m = if r < 0 then n - 1 else n + 1 in case signum (abs r - 0.5) of -1 -> n 0 -> if even n then n else m 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 ]