scientific 0.3.3.8 → 0.3.4.0

raw patch · 7 files changed

+472/−229 lines, 7 filesdep +binarydep +containersdep +vectordep −arraydep ~basedep ~criteriondep ~tastyPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

Dependencies added: binary, containers, vector

Dependencies removed: array

Dependency ranges changed: base, criterion, tasty

API changes (from Hackage documentation)

Files

• changelog +11/−0
• scientific.cabal +26/−15
• src/Data/ByteString/Builder/Scientific.hs +6/−28
• src/Data/Scientific.hs +353/−147
• src/Data/Text/Lazy/Builder/Scientific.hs +3/−28
• src/Utils.hs +36/−0
• test/test.hs +37/−11

@@ -1,3 +1,14 @@+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. 

@@ -1,17 +1,18 @@ name:                scientific-version:             0.3.3.8+version:             0.3.4.0 synopsis:            Numbers represented using scientific notation description:-  @Data.Scientific@ provides a space efficient and arbitrary precision-  scientific number type.-  .-  'Scientific' numbers are represented using-  <http://en.wikipedia.org/wiki/Scientific_notation scientific notation>. It-  uses a coefficient @c :: 'Integer'@ and a base-10 exponent @e :: 'Int'@ (do-  note that since we're using an 'Int' to represent the exponent these numbers-  aren't truly arbitrary precision). A scientific number corresponds to the+  @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+  @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:@@ -62,6 +63,7 @@   exposed-modules:     Data.Scientific                        Data.Text.Lazy.Builder.Scientific   other-modules:       Math.NumberTheory.Logarithms+                       Utils   other-extensions:    DeriveDataTypeable, BangPatterns   ghc-options:         -Wall   build-depends:       base        >= 4.3   && < 4.9@@ -69,7 +71,9 @@                      , deepseq     >= 1.3   && < 1.5                      , text        >= 0.8   && < 1.3                      , hashable    >= 1.1.2 && < 1.3-                     , array       >= 0.1   && < 0.6+                     , vector      >= 0.5   && < 0.12+                     , containers  >= 0.5   && < 0.6+                     , binary      >= 0.4.1 && < 0.8    if flag(integer-simple)       build-depends: integer-simple@@ -82,8 +86,11 @@    if flag(bytestring-builder)     exposed-modules:   Data.ByteString.Builder.Scientific-    build-depends:     bytestring  >= 0.10  && < 0.11+    build-depends:     bytestring >= 0.10 && < 0.11 +  if impl(ghc >= 7.2.1)+    cpp-options: -DGENERICS+ test-suite test-scientific   type:             exitcode-stdio-1.0   hs-source-dirs:   test@@ -93,7 +100,8 @@    build-depends: scientific                , base             >= 4.3   && < 4.9-               , tasty            >= 0.5   && < 0.11+               , binary           >= 0.4.1 && < 0.8+               , tasty            >= 0.5   && < 0.12                , tasty-ant-xml    >= 1.0   && < 1.1                , tasty-hunit      >= 0.8   && < 0.10                , tasty-smallcheck >= 0.2   && < 0.9@@ -101,8 +109,11 @@                , smallcheck       >= 1.0   && < 1.2                , QuickCheck       >= 2.5   && < 2.9                , text             >= 0.8   && < 1.3-               , bytestring       >= 0.10  && < 0.11 +  if flag(bytestring-builder)+    build-depends: bytestring >= 0.10 && < 0.11+    cpp-options: -DBYTESTRING_BUILDER+ benchmark bench-scientific   type:             exitcode-stdio-1.0   hs-source-dirs:   bench src@@ -110,13 +121,13 @@   default-language: Haskell2010   ghc-options:      -O2   build-depends:    base        >= 4.3   && < 4.9-                  , criterion   >= 0.5   && < 1.1+                  , criterion   >= 0.5   && < 1.2                   , ghc-prim                   , deepseq     >= 1.3   && < 1.5                   , text        >= 0.8   && < 1.3                   , bytestring  >= 0.10  && < 0.11                   , hashable    >= 1.1.2 && < 1.3-                  , array       >= 0.1   && < 0.6+                  , vector      >= 0.5   && < 0.12    if flag(integer-simple)       build-depends: integer-simple

@@ -1,4 +1,4 @@-{-# LANGUAGE CPP, MagicHash, OverloadedStrings #-}+{-# LANGUAGE CPP, OverloadedStrings #-}  module Data.ByteString.Builder.Scientific     ( scientificBuilder@@ -22,8 +22,10 @@ import           Data.ByteString.Builder.Extra (byteStringCopy) #endif -import GHC.Base                     (Int(I#), Char(C#), chr#, ord#, (+#))+#if !MIN_VERSION_base(4,8,0) import Data.Monoid                  (mempty)+#endif+ #if MIN_VERSION_base(4,5,0) import Data.Monoid                  ((<>)) #else@@ -33,6 +35,8 @@ infixr 6 <> #endif +import Utils (roundTo, i2d)+ -- | 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@@ -107,29 +111,3 @@           d:ds' = map i2d (if ei > 0 then is' else 0:is')          in          char8 d <> (if null ds' then mempty else char8 '.' <> string8 ds')---- | Unsafe conversion for decimal digits.-{-# INLINE i2d #-}-i2d :: Int -> Char-i2d (I# i#) = C# (chr# (ord# '0'# +# i#))--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

@@ -2,22 +2,29 @@ {-# LANGUAGE DeriveDataTypeable #-} {-# LANGUAGE BangPatterns #-} {-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE UnboxedTuples #-}+{-# LANGUAGE PatternGuards #-} +#ifdef GENERICS+{-# LANGUAGE DeriveGeneric #-}+#endif+ -- | -- Module      :  Data.Scientific -- Copyright   :  Bas van Dijk 2013 -- License     :  BSD3 -- Maintainer  :  Bas van Dijk <v.dijk.bas@gmail.com> ----- @Data.Scientific@ provides a space efficient and arbitrary precision--- scientific number type.+-- This module 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 an 'Integer' 'coefficient' @c@ and an 'Int'+-- 'base10Exponent' @e@. A scientific number corresponds to the 'Fractional'+-- number: @'fromInteger' c * 10 '^^' e@. ----- 'Scientific' numbers are represented using--- <http://en.wikipedia.org/wiki/Scientific_notation scientific notation>. It--- uses an 'Integer' 'coefficient' @c@ and an 'Int' 'base10Exponent' @e@ (do--- note that since we're using an 'Int' to represent the exponent these numbers--- aren't truly arbitrary precision). 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@@ -42,7 +49,8 @@ -- 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.+-- 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: --@@ -62,6 +70,8 @@     , isInteger        -- * Conversions+    , fromRationalRepetend+    , toRationalRepetend     , floatingOrInteger     , toRealFloat     , toBoundedRealFloat@@ -83,16 +93,20 @@ -- Imports ---------------------------------------------------------------------- +import           Control.Exception            (throw, ArithException(DivideByZero)) import           Control.Monad                (mplus)+import           Control.Monad.ST             (runST) import           Control.DeepSeq              (NFData(rnf))-import           Data.Array                   (Array, listArray, (!))+import           Data.Binary                  (Binary, get, put) import           Data.Char                    (intToDigit, ord) import           Data.Data                    (Data) import           Data.Function                (on)-import           Data.Functor                 ((<$>)) import           Data.Hashable                (Hashable(..))+import qualified Data.Map.Strict     as M     (Map, empty, insert, lookup) import           Data.Ratio                   ((%), numerator, denominator) import           Data.Typeable                (Typeable)+import qualified Data.Vector         as V+import qualified Data.Vector.Mutable as VM import           Math.NumberTheory.Logarithms (integerLog10') import qualified Numeric                      (floatToDigits) import qualified Text.Read                       as Read@@ -102,13 +116,22 @@ import           Text.ParserCombinators.ReadP     ( ReadP ) import           Data.Text.Lazy.Builder.RealFloat (FPFormat(..)) +#if !MIN_VERSION_base(4,8,0)+import           Data.Functor                 ((<$>))+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, divInteger, quotInteger) +import Utils (roundTo)++ ---------------------------------------------------------------------- -- Type ----------------------------------------------------------------------@@ -122,7 +145,7 @@ -- A scientific number with 'coefficient' @c@ and 'base10Exponent' @e@ -- corresponds to the 'Fractional' number: @'fromInteger' c * 10 '^^' e@ data Scientific = Scientific-    { coefficient    ::                !Integer+    { coefficient :: !Integer       -- ^ The coefficient of a scientific number.       --       -- Note that this number is not necessarily normalized, i.e.@@ -153,6 +176,16 @@ instance Hashable Scientific where     hashWithSalt salt = hashWithSalt salt . toRational +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++    get = Scientific <$> get <*> (fromInteger <$> get)+ instance Eq Scientific where     (==) = (==) `on` toRational     {-# INLINE (==) #-}@@ -178,23 +211,23 @@  instance Num Scientific where     Scientific c1 e1 + Scientific c2 e2-       | e1 < e2   = scientific (c1   + c2*l) e1-       | otherwise = scientific (c1*r + c2  ) e2+       | e1 < e2   = Scientific (c1   + c2*l) e1+       | otherwise = Scientific (c1*r + c2  ) e2          where            l = magnitude (e2 - e1)            r = magnitude (e1 - e2)     {-# INLINE (+) #-}      Scientific c1 e1 - Scientific c2 e2-       | e1 < e2   = scientific (c1   - c2*l) e1-       | otherwise = scientific (c1*r - c2  ) e2+       | e1 < e2   = Scientific (c1   - c2*l) e1+       | otherwise = Scientific (c1*r - c2  ) e2          where            l = magnitude (e2 - e1)            r = magnitude (e1 - e2)     {-# INLINE (-) #-}      Scientific c1 e1 * Scientific c2 e2 =-        scientific (c1 * c2) (e1 + e2)+        Scientific (c1 * c2) (e1 + e2)     {-# INLINE (*) #-}      abs (Scientific c e) = Scientific (abs c) e@@ -206,7 +239,7 @@     signum (Scientific c _) = Scientific (signum c) 0     {-# INLINE signum #-} -    fromInteger i = scientific i 0+    fromInteger i = Scientific i 0     {-# INLINE fromInteger #-}  -- | /WARNING:/ 'toRational' needs to compute the 'Integer' magnitude:@@ -231,8 +264,11 @@    realToFrac = toRealFloat :: Scientific -> Float #-}  -- | /WARNING:/ '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.+-- 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. instance Fractional Scientific where     recip = fromRational . recip . toRational     {-# INLINE recip #-}@@ -240,20 +276,170 @@     x / y = fromRational $ toRational x / toRational y     {-# INLINE (/) #-} -    fromRational rational = positivize (longDiv 0 0) (numerator rational)+    fromRational 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  0 = Scientific c e         longDiv !c !e !n                           -- TODO: Use a logarithm here!             | n < d     = longDiv (c * 10) (e - 1) (n * 10)-            | otherwise = longDiv (c + q)   e      r-                            where-                              (q, r) = n `quotRem` d+            | otherwise = case n `quotRemInteger` d of+                            (#q, r#) -> longDiv (c + q) e r          d = denominator rational +-- | Like 'fromRational', this function converts a `Rational` to a `Scientific`+-- but instead of 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.+--+-- 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+        | 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 n = case mbLimit of+                      Nothing -> Right $ longDivNoLimit 0 0 M.empty n+                      Just l  -> longDivWithLimit (-l) n++        -- Divide the numerator by the denominator using long division.+        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     = longDivNoLimit (c * 10) (e - 1) (M.insert n e ns) (n * 10)+            | 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     = go (c * 10) (e - 1) (M.insert n e ns) (n * 10)+                  | otherwise = case n `quotRemInteger` d of+                                  (#q, r#) -> go (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)@+--+-- 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>+-- 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+ instance RealFrac Scientific where     -- | The function 'properFraction' takes a Scientific number @s@     -- and returns a pair @(n,f)@ such that @s = n+f@, and:@@ -265,8 +451,8 @@     properFraction s@(Scientific c e)         | e < 0     = if dangerouslySmall c e                       then (0, s)-                      else let (q, r) = c `quotRem` magnitude (-e)-                           in (fromInteger q, scientific r e)+                      else case c `quotRemInteger` magnitude (-e) of+                             (#q, r#) -> (fromInteger q, Scientific r e)         | otherwise = (toIntegral s, 0)     {-# INLINE properFraction #-} @@ -275,7 +461,7 @@     truncate = whenFloating $ \c e ->                  if dangerouslySmall c e                  then 0-                 else fromInteger $ c `quot` magnitude (-e)+                 else fromInteger $ c `quotInteger` magnitude (-e)     {-# INLINE truncate #-}      -- | @'round' s@ returns the nearest integer to @s@;@@ -283,10 +469,11 @@     round = whenFloating $ \c e ->               if dangerouslySmall c e               then 0-              else let (q, r) = c `quotRem` magnitude (-e)+              else let (#q, r#) = c `quotRemInteger` magnitude (-e)                        n = fromInteger q-                       m = if r < 0 then n - 1 else n + 1-                       f = scientific r e+                       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@@ -300,8 +487,9 @@                 then if c <= 0                      then 0                      else 1-                else let (q, r) = c `quotRem` magnitude (-e)-                     in fromInteger $! if r <= 0 then q else q + 1+                else case c `quotRemInteger` magnitude (-e) of+                       (#q, r#) | r <= 0    -> fromInteger q+                                | otherwise -> fromInteger (q + 1)     {-# INLINE ceiling #-}      -- | @'floor' s@ returns the greatest integer not greater than @s@@@ -310,7 +498,7 @@               then if c < 0                    then -1                    else 0-              else fromInteger (c `div` magnitude (-e))+              else fromInteger (c `divInteger` magnitude (-e))     {-# INLINE floor #-}  @@ -387,27 +575,35 @@ maxExpt :: Int maxExpt = 324 -expts10 :: Array Int Integer-expts10 = listArray (0, maxExpt) $ 1 : 10 : go 2-    where-      go :: Int -> [Integer]-      go !ix = xx : 10*xx : go (ix+2)+expts10 :: V.Vector Integer+expts10 = runST $ do+    mv <- VM.unsafeNew maxExpt+    VM.unsafeWrite mv 0  1+    VM.unsafeWrite mv 1 10+    let go !ix+          | ix == maxExpt = V.unsafeFreeze mv+          | otherwise = do+              VM.unsafeWrite mv  ix        xx+              VM.unsafeWrite mv (ix+1) (10*xx)+              go (ix+2)           where             xx = x * x-            x  = expts10 ! half-+            x  = V.unsafeIndex expts10 half #if MIN_VERSION_base(4,5,0)-            half = ix `unsafeShiftR` 1+            !half = ix `unsafeShiftR` 1 #else-            half = ix `shiftR` 1+            !half = ix `shiftR` 1 #endif+    go 2  -- | @magnitude e == 10 ^ e@ magnitude :: (Num a) => Int -> a-magnitude e | e <= maxExpt = cachedPow10 e-            | otherwise    = cachedPow10 maxExpt * 10 ^ (e - maxExpt)+magnitude e | e < maxExpt = cachedPow10 e+            | otherwise   = cachedPow10 hi * 10 ^ (e - hi)     where-      cachedPow10 p = fromInteger (expts10 ! p)+      cachedPow10 p = fromInteger (V.unsafeIndex expts10 p)++      hi = maxExpt - 1 {-# INLINE magnitude #-}  @@ -430,9 +626,9 @@ -- algorithm doesn't know in which direction the short decimal representation -- would be rounded and computes more digits fromFloatDigits :: (RealFloat a) => a -> Scientific-fromFloatDigits = positivize fromNonNegRealFloat+fromFloatDigits = positivize fromPositiveRealFloat     where-      fromNonNegRealFloat r = go digits 0 0+      fromPositiveRealFloat r = go digits 0 0         where           (digits, e) = Numeric.floatToDigits 10 r @@ -510,15 +706,16 @@     s' = normalize s      dangerouslyBig = e > limit &&-                     e > integerLog10' (max (abs $ toInteger (minBound :: i))-                                            (abs $ toInteger (maxBound :: i)))+                     e > integerLog10' (max (abs iMinBound) (abs iMaxBound))      fromIntegerBounded :: Integer -> Maybe i     fromIntegerBounded i-        | i < toInteger (minBound :: i) ||-          i > toInteger (maxBound :: i) = Nothing-        | otherwise = Just $ fromInteger 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@@ -596,9 +793,10 @@                 else return (-e)    (ReadP.satisfy isE >>-           ((scientific signedCoeff . (expnt +)) <$> eP)) `mplus`-     return (scientific signedCoeff    expnt)+           ((Scientific signedCoeff . (expnt +)) <$> eP)) `mplus`+     return (Scientific signedCoeff    expnt) + foldDigits :: (a -> Int -> a) -> a -> ReadP a foldDigits f z = do     c <- ReadP.satisfy isDecimal@@ -633,99 +831,109 @@ ----------------------------------------------------------------------  instance Show Scientific where-    show = formatScientific Generic Nothing+    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 fmt decs scntfc@(Scientific c _)-   | c < 0     = '-':doFmt fmt (toDecimalDigits (-scntfc))-   | otherwise =     doFmt fmt (toDecimalDigits   scntfc )+formatScientific format mbDecs s+    | coefficient s < 0 = '-':formatPositiveScientific (-s)+    | otherwise         =     formatPositiveScientific   s   where-    doFmt :: FPFormat -> ([Int], Int) -> String-    doFmt format (is, e) =-      let ds = map intToDigit 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' = show (e-1) in-          case ds of-            "0"     -> "0.0e0"-            [d]     -> d : ".0e" ++ show_e'-            (d:ds') -> d : '.' : ds' ++ "e" ++ show_e'-            []      -> error "formatScientific/doFmt/FFExponent: []"-         Just dec ->-          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)-       Fixed ->-        let-         mk0 ls = case ls of { "" -> "0" ; _ -> ls}-        in-        case decs of-         Nothing-            | 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-         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 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')+    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 -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+    fmtAsExponentMbDecs :: ([Int], Int) -> String+    fmtAsExponentMbDecs x = case mbDecs of+                              Nothing  -> fmtAsExponent x+                              Just dec -> fmtAsExponentDecs dec x -  b2 = base `quot` 2+    fmtAsFixedMbDecs :: ([Int], Int) -> String+    fmtAsFixedMbDecs x = case mbDecs of+                           Nothing  -> fmtAsFixed x+                           Just dec -> fmtAsFixedDecs dec x -  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)+    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-       (c,ds) = f (n-1) (even i) xs-       i'     = c + i+        mk0 ls = case ls of { "" -> "0" ; _ -> ls}  ----------------------------------------------------------------------  -- | Similar to 'Numeric.floatToDigits', @toDecimalDigits@ takes a--- non-negative 'Scientific' number, and returns a list of digits and+-- 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)@@ -740,18 +948,16 @@ -- 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') = (is,  n + e)+toDecimalDigits (Scientific 0  _)  = ([0], 1)+toDecimalDigits (Scientific c' e') =+    case normalizePositive c' e' of+      (c, e) -> case reverseAndLength $ digits c of+                  (is, n) -> (is, n + e)   where-    Scientific c e = normalizePositive c' e'--    (is, n) = reverseAndLength $ digits c-     digits :: Integer -> [Int]     digits 0 = []-    digits i = fromIntegral r : digits q-      where-        (q, r) = i `quotRem` 10+    digits i = case i `quotRemInteger` 10 of+                 (# q, r #) -> fromIntegral r : digits q      reverseAndLength :: [a] -> ([a], Int)     reverseAndLength l = rev l [] 0@@ -771,11 +977,11 @@ -- 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+    | c > 0 = case normalizePositive   c  e of (c', e') -> Scientific   c'  e'+    | c < 0 = case normalizePositive (-c) e of (c', e') -> Scientific (-c') e'     | otherwise {- c == 0 -} = Scientific 0 0 -normalizePositive :: Integer -> Int -> Scientific-normalizePositive c !e = case quotRem c 10 of-                           (q, 0) -> normalizePositive q (e+1)-                           _      -> Scientific c e+normalizePositive :: Integer -> Int -> (Integer, Int)+normalizePositive c !e = case quotRemInteger c 10 of+                           (# c', 0 #) -> normalizePositive c' (e+1)+                           _           -> (c, e)

@@ -1,4 +1,4 @@-{-# LANGUAGE CPP, MagicHash, OverloadedStrings #-}+{-# LANGUAGE CPP, OverloadedStrings #-}  module Data.Text.Lazy.Builder.Scientific     ( scientificBuilder@@ -14,7 +14,6 @@ import Data.Text.Lazy.Builder       (Builder, fromString, singleton, fromText) import Data.Text.Lazy.Builder.Int   (decimal) import qualified Data.Text as T     (replicate)-import GHC.Base                     (Int(I#), Char(C#), chr#, ord#, (+#)) #if MIN_VERSION_base(4,5,0) import Data.Monoid                  ((<>)) #else@@ -24,6 +23,8 @@ infixr 6 <> #endif +import Utils (roundTo, i2d)+ -- | 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@@ -94,29 +95,3 @@           d:ds' = map i2d (if ei > 0 then is' else 0:is')          in          singleton d <> (if null ds' then "" else singleton '.' <> fromString ds')---- | Unsafe conversion for decimal digits.-{-# INLINE i2d #-}-i2d :: Int -> Char-i2d (I# i#) = C# (chr# (ord# '0'# +# i#))--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

@@ -0,0 +1,36 @@+{-# 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# ))

@@ -10,7 +10,9 @@  module Main where +#if !MIN_VERSION_base(4,8,0) import           Control.Applicative+#endif import           Control.Monad import           Data.Int import           Data.Word@@ -23,17 +25,21 @@ 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++#ifdef BYTESTRING_BUILDER import qualified Data.ByteString.Lazy.Char8         as BLC8 import qualified Data.ByteString.Builder.Scientific as B-import qualified Data.Text.Lazy.Builder.Scientific  as T  #if !MIN_VERSION_bytestring(0,10,2) import qualified Data.ByteString.Lazy.Builder       as B #else import qualified Data.ByteString.Builder            as B #endif+#endif  main :: IO () main = testMain $ testGroup "scientific"@@ -43,6 +49,11 @@        (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, ".")]@@ -61,16 +72,20 @@      , testGroup "Builder"       [ testProperty "Text" $ \s ->-          formatScientific B.Generic Nothing s ==-          TL.unpack (TLB.toLazyText $ T.formatScientificBuilder B.Generic Nothing s)+          formatScientific Scientific.Generic Nothing s ==+          TL.unpack (TLB.toLazyText $+                       T.formatScientificBuilder Scientific.Generic Nothing s) +#ifdef BYTESTRING_BUILDER       , testProperty "ByteString" $ \s ->-          formatScientific B.Generic Nothing s ==-          BLC8.unpack (B.toLazyByteString $ B.formatScientificBuilder B.Generic Nothing s)+          formatScientific Scientific.Generic Nothing s ==+          BLC8.unpack (B.toLazyByteString $+                        B.formatScientificBuilder Scientific.Generic Nothing s)+#endif       ]      , testProperty "formatScientific_fromFloatDigits" $ \(d::Double) ->-        formatScientific B.Generic Nothing (Scientific.fromFloatDigits d) ==+        formatScientific Scientific.Generic Nothing (Scientific.fromFloatDigits d) ==         show d      -- , testProperty "formatScientific_realToFrac" $ \(d::Double) ->@@ -141,7 +156,15 @@     ]    , testGroup "Conversions"-    [ testGroup "Float"  $ conversionsProperties (undefined :: Float)+    [ 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"@@ -342,10 +365,13 @@  instance QC.Arbitrary Scientific where     arbitrary = QC.frequency-                  [ (70, scientific <$> QC.arbitrary <*> intGen)-                  , (20, scientific <$> QC.arbitrary <*> bigIntGen)-                  , (10, scientific <$> pure 0       <*> bigIntGen)-                  ]+      [ (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)