floatshow 0.1.1 → 0.2.0

raw patch · 5 files changed

+431/−28 lines, 5 filesPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

Files

• Changes +5/−0
• Text/FShow/Raw.hs +292/−0
• Text/FShow/RealFloat.hs +26/−14
• Text/FShow/RealFloat/Internals.hs +100/−12
• floatshow.cabal +8/−2

@@ -1,1 +1,6 @@+0.2.0:  Raw interface for non-RealFloat types+        Back to the old integerToDigits because we may now deal with+        larger Integers, the performance loss for Double/Float is+        small enough to accept.+0.1.1:  Leaner integerToDigits 0.1:    First release

@@ -0,0 +1,292 @@+-- |+-- Module:          Text.FShow.Raw+-- Copyright:       (c) 2011 Daniel Fischer+-- Licence:         BSD3+-- Maintainer:      Daniel Fischer <daniel.is.fischer@googlemail.com>+-- Stability:       experimental+-- Portability:     non-portable (GHC extensions)+--+-- Lower level conversion of base-2 numbers to base-10 representations.+-- These functions can be used to define 'Show' instances for types which+-- don't support the full 'RealFloat' interface but have an analogue to+-- 'decodeFloat' (and maybe to 'isNaN', 'isInfinite' and 'isNegativeZero').+module Text.FShow.Raw+    ( -- * Classes+      BinDecode(..)+    , DecimalFormat(..)+      -- * Format type+    , FormatStyle(..)+      -- * Functions+      -- ** Medium level+    , decimalFormat+    , binDecFormat+      -- ** Low level+    , rawFormat+    , fullRawFormat+    , formatDigits+      -- ** Dangerous+    , posToDigits+      -- ** Auxiliary+    , fullDecimalDigits+    , integerLog2+    ) where++import Text.FShow.RealFloat.Internals++import Data.Maybe (fromMaybe)++-- | Class for types whose values can be decoded into the form+--   @m * 2^e@ with an 'Integer' mantissa @m@ and an 'Int' exponent @e@.+--+--   Minimal complete definition: one of 'decode' and 'decodeL'.+--+--   It is strongly recommended to override the default implementation+--   of 'showDigits' if the datatype allows distinguishing values+--   without using an exact representation.+class BinDecode a where+  -- | 'decode' is analogous to 'decodeFloat'.+  {-# INLINE decode #-}+  decode :: a -> (Integer, Int)+  decode x = case decodeL x of+               (_, n, e) -> (n, e)+  -- | 'decodeL' gives the integer base-@2@ logarithm of the mantissa+  --   in addition to the result of 'decode'. If the absolute value of+  --   the mantissa always has the same highest set bit (excepting @0@),+  --   specifying that as a constant will be faster than calculating the+  --   logarithm for each individual mantissa.+  --   If @x = m*2^e@ with @m /= 0@, then+  --   @'decodeL' x == ('integerLog2' (abs m), m, e)@ must hold.+  {-# INLINE decodeL #-}+  decodeL :: a -> (Int, Integer, Int)+  decodeL x = case decode x of+                (0,_) -> (0,0,0)+                (n,e) -> (integerLog2 (abs n), n, e)+  -- | The number of significant digits needed to uniquely determine the+  --   value (or however many digits are desired). Usually, 'showDigits'+  --   will be a constant function, but that is not necessary. However,+  --   all values of 'showDigits' must be positive.+  --+  --   If the mantissa always has the same highest bit, @highBit@, set+  --   when it is nonzero,+  --+  -- @+  --   'showDigits' _ = 2 + 'floor' ((highBit+1) * 'logBase 10 2)+  -- @+  --+  --   is sufficient to make the values and formatted 'String's+  --   uniquely determine each other and in general this is the smallest+  --   number to achieve that (calculate the number once and supply the+  --   result as a constant).+  --+  --   If the highest set bit of nonzero mantissae varies, things are not+  --   so easy. If the width of mantissae is bounded, plugging the largest+  --   possible value into the above formula works, but may yield an unduly+  --   large number for common cases. Using the formula with @highBit@+  --   determined by the mantissa almost works, but if the representation+  --   is rounded at all, with sufficiently many bits in the mantissa,+  --   there will be values between the original and the representation.+  --   So, with mantissae of width varying over a large range, the only+  --   feasible way of obtaining a bijection between values and their+  --   decimal representations is printing to full precision in+  --   general, optionally capping atthe upper limit.+  --+  --   The default implementation prints values exactly, which in general+  --   is undesirable because it involves huge 'Integer's and long+  --   representations.+  {-# INLINE showDigits #-}+  showDigits :: a -> Int+  showDigits x = case decodeL x of+                   (a, _, e) -> fullDecimalDigits a e++-- | Class for types whose values may be @NaN@ or infinite and can+--   otherwise be decoded into the form @m * 2^e@.+class (Num a, Ord a, BinDecode a) => DecimalFormat a where+  -- | @'nanTest'@ defaults to @'const' 'False'@+  {-# INLINE nanTest #-}+  nanTest :: a -> Bool+  nanTest _ = False+  -- | @'infTest'@ defaults to @'const' 'False'@+  {-# INLINE infTest #-}+  infTest :: a -> Bool+  infTest _ = False+  -- | @'negTest' x@ defaults to @x < 0@, it must be overridden if+  --   negative zero has to be accounted for.+  {-# INLINE negTest #-}+  negTest :: a -> Bool+  negTest x = x < 0++-- | The Style in which to format the display 'String'+data FormatStyle+    = Exponent  -- ^ Display in scientific notation, e.g. @1.234e-5@+    | Fixed     -- ^ Display in standard decimal notation, e.g. @0.0123@+                --   or @123.456@+    | Generic (Maybe (Int,Int))+        -- ^ Use 'Fixed' for numbers with magnitude close enough to @1@,+        --   'Exponent' otherwise. The default range for using 'Fixed'+        --   is @0.1 <= |x| < 10^7@, corresponding to @'Generic' ('Just' (-1,7))@.++-- | @'fullDecimalDigits' a e@ calculates the number of decimal digits that+--   may be required to exactly display a value @x = m * 2^e@ where @m@ is+--   an 'Integer' satisfying @2^a <= m < 2^(a+1)@. Usually, the calculated+--   value is not much larger than the actual number of digits in the+--   exact decimal representation, but it will be if the exponent @e@+--   is negative and has large absolute value and the mantissa is divisible+--   by a large power of @2@.+fullDecimalDigits :: Int -> Int -> Int+fullDecimalDigits a e+    | e >= 0    = q+2+    | p > 0     = q+1-e+    | otherwise = q-e+      where+        p = a+e+1+        q = (p*8651) `quot` 28738++-- | 'rawFormat' is a low-level formatter. The sign is determined from+--   the sign of the mantissa.+rawFormat :: (a -> (Int,Integer,Int))   -- ^ decoder, same restrictions as 'decodeL'+          -> Int                        -- ^ number of significant digits+          -> FormatStyle                -- ^ formatting style+          -> Maybe Int                  -- ^ desired precision+          -> a                          -- ^ value to be displayed+          -> String+rawFormat decoder decimals fmt prec x+    | mt < 0    = '-':formatDigits fmt decimals prec digits ex1+    | mt == 0   = formatDigits fmt decimals prec [0] 0+    | otherwise = formatDigits fmt decimals prec digits ex1+      where+        (md,mt,ex) = decoder x+        (digits,ex1) = posToDigits decimals md (abs mt) ex++-- | 'fullRawFormat' is a low-level formatter producing an exact representation+--   of a value which can be decoded into the form @m * 2^e@.+fullRawFormat :: (a -> (Int,Integer,Int))   -- ^ decoder, same restriction as 'decodeL'+              -> FormatStyle                -- ^ formatting style+              -> a                          -- ^ value to be displayed+              -> String+fullRawFormat decoder fmt x+    | mt < 0    = '-':formatDigits fmt decs Nothing digits ex1+    | mt == 0   = formatDigits fmt 2 Nothing [0] 0+    | otherwise = formatDigits fmt decs Nothing digits ex1+      where+        (md, mt, ex)    = decoder x+        decs            = fullDecimalDigits md ex+        (digits, ex1)   = posToDigits decs md (abs mt) ex++-- | 'binDecFormat' is the formatter for instances of the 'BinDecode'+--   class. Any special values must be processed before it is called.+--   It fills in the missing arguments before calling 'rawFormat'.+{-# INLINE binDecFormat #-}+binDecFormat :: BinDecode a => FormatStyle -> Maybe Int -> a -> String+binDecFormat fmt decs x = rawFormat decodeL (showDigits x) fmt decs x++-- | 'decimalFormat' is a slightly higher-level formatter, treating the+--   special cases of @NaN@ and infinities.+decimalFormat :: DecimalFormat a => FormatStyle -> Maybe Int -> a -> String+decimalFormat fmt decs x+    | nanTest x = "NaN"+    | infTest x = if negTest x then "-Infinity" else "Infinity"+    | negTest x = '-':formatDigits fmt sd decs digits ex1+    | otherwise = formatDigits fmt sd decs digits ex1+      where+        sd = showDigits x+        (md,mt,ex) = decodeL (abs x)+        (digits,ex1)+            | mt == 0   = ([0],0)+            | otherwise = posToDigits sd md mt ex++-- | 'formatDigits' builds the display 'String' from the digits and+--   the exponent of a nonnegative number.+{-# INLINE formatDigits #-}+formatDigits :: FormatStyle     -- ^ formatting style+             -> Int             -- ^ number of significant digits required+             -> Maybe Int       -- ^ desired precision+             -> [Int]           -- ^ list of significant digits+             -> Int             -- ^ base-@10@ logarithm+             -> String+formatDigits style sig decs digits ex =+    case style of+      Generic rg -> let dst = case fromMaybe (-1,7) rg of+                                (lo, hi) -> if lo <= ex && ex < hi+                                               then Fixed else Exponent+                    in formatDigits dst sig decs digits ex+      Exponent ->+        case decs of+          Nothing ->+            let (c,d:ds) = roundToS sig digits+                show_e   = show (ex+c)+                fluff :: [Int] -> [Int]+                fluff [] = [0]+                fluff xs = xs+            in case digits of+                 [0] -> "0.0e0"+                 _ -> i2D d : '.' : map i2D (fluff ds) ++ 'e' : show_e+          Just pl ->+            let sd = max 1 pl+            in case digits of+                 [0] -> '0' : '.' : take sd (repeat '0') ++ "e0"+                 _   ->+                     let (c,digs) = roundTo (sd+1) digits+                         (d:ds)   = map i2D (if c == 0 then digs else init digs)+                     in d : '.' : ds ++ 'e' : show (ex+c)+      Fixed ->+        let mk0 ls = case ls of { "" -> "0" ; _ -> ls}+        in case decs of+             Nothing ->+               let (c,is) = roundToS sig digits+                   e'     = ex+1+c+                   ds     = map i2D is+               in case digits of+                    [0] -> "0.0"+                    _ | 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 pl ->+               let dec  = max 0 pl+                   e'   = ex+1+               in+               if e' >= 0 then+                  let (c,is')   = roundTo (dec + e') digits+                      (ls,rs)   = splitAt (e'+c) (map i2D is')+                  in mk0 ls ++ (if null rs then "" else '.':rs)+               else+                  let (c,is')   = roundTo dec (replicate (-e') 0 ++ digits)+                      d:ds'     = map i2D (if c == 0 then 0:is' else is')+                  in d : (if null ds' then "" else '.':ds')++roundToS :: Int -> [Int] -> (Int,[Int])+roundToS d is =+    case f d is of+      x@(0,_) -> x+      (1,xs)  -> (1, 1:xs)+      _       -> error "roundToS: bad Value"+  where+    f _ []          = (0, [])+    f 0 (x:_)       = (if x < 5 then 0 else 1, [])+    f n (i:xs)+      | i' == 10    = (1,prep 0 ds)+      | otherwise   = (0,prep i' ds)+        where+          prep 0 [] = []+          prep a bs = a:bs+          (c,ds)    = f (n-1) xs+          i'        = c + i++roundTo :: Int -> [Int] -> (Int,[Int])+roundTo d is =+    case f d is of+      x@(0,_) -> x+      (1,xs)  -> (1, 1:xs)+      _       -> error "roundTo: bad Value"+  where+    f n []          = (0, replicate n 0)+    f 0 (x:_)       = (if x < 5 then 0 else 1, [])+    f n [i]         = (if i < 5 then 0 else 1, replicate n 0)+    f n (i:xs)+      | i' == 10    = (1,0:ds)+      | otherwise   = (0,i':ds)+        where+          (c,ds)    = f (n-1) xs+          i'        = c + i

@@ -194,6 +194,15 @@ fshowGFloat    :: (DispFloat a) => Maybe Int -> a -> ShowS fshowGFloat d x =  showString (formatFloat FFGeneric d x) +{-+Code duplication ahead. The below code is - with minor modifications -+replicated in Text.FShow.Raw.+Yuck!+But reusing that interface here costs too much performance here, so+this is staying.+'Tis a library, it needn't be pretty, it's gotta be fast.+-}+ data FFFormat = FFExponent | FFFixed | FFGeneric  {-# SPECIALISE formatFloat :: FFFormat -> Maybe Int -> Double -> String,@@ -217,11 +226,11 @@         doFmt format (is, e) =           case format of             FFGeneric ->-              doFmt (if e < 0 || e > 7 then FFExponent else FFFixed) (is,e)+              doFmt (if e < (-1) || e > 6 then FFExponent else FFFixed) (is,e)             FFExponent ->               case decs of                 Nothing ->-                  let show_e' = if ei == 0 then show (e-1) else show e+                  let show_e' = show (e+ei)                       (ei,(d:ds)) = roundToS (decDigits x) is                   in case is of                        [0] -> "0.0e0"@@ -231,32 +240,34 @@                   case is of                     [0] -> '0' :'.' : take dec' (repeat '0') ++ "e0"                     _ -> let (ei,is') = roundTo (dec'+1) is-                             (d:ds') = map i2D (if ei > 0 then init is' else is')-                         in d:'.':ds' ++ 'e':show (e-1+ei)+                             (d:ds') = map i2D (if ei == 0 then is' else init is')+                         in d:'.':ds' ++ 'e':show (e+ei)             FFFixed ->               let mk0 ls = case ls of { "" -> "0" ; _ -> ls} in               case decs of                 Nothing ->                   let (ei, is') = roundToS (decDigits x) is-                      e' = e+ei+                      e' = e+1+ei                       ds = map i2D is'                   in case is of                        [0] -> "0.0"-                       _ | e' <= 0 -> "0." ++ replicate (-e') '0' ++ map i2D is'+                       _ | 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 i2D is')+                  let dec' = max dec 0+                      e' = e+1+                  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 '.':rs)                   else-                     let (ei,is') = roundTo dec' (replicate (-e) 0 ++ is)-                         d:ds' = map i2D (if ei > 0 then is' else 0:is')+                     let (ei,is') = roundTo dec' (replicate (-e') 0 ++ is)+                         d:ds' = map i2D (if ei == 0 then 0:is' else is')                      in d : (if null ds' then "" else '.':ds')  roundToS :: Int -> [Int] -> (Int,[Int])@@ -267,7 +278,7 @@       _       -> error "roundToS: bad Value"   where     f _ []          = (0, [])-    f 0 (x:_)       = (if x >= 5 then 1 else 0, [])+    f 0 (x:_)       = (if x < 5 then 0 else 1, [])     f n (i:xs)       | i' == 10    = (1,prep 0 ds)       | otherwise   = (0,prep i' ds)@@ -285,7 +296,8 @@       _       -> error "roundTo: bad Value"   where     f n []          = (0, replicate n 0)-    f 0 (x:_)       = (if x >= 5 then 1 else 0, [])+    f 0 (x:_)       = (if x < 5 then 0 else 1, [])+    f n [i]         = (if i < 5 then 0 else 1, replicate n 0)     f n (i:xs)       | i' == 10    = (1,0:ds)       | otherwise   = (0,i':ds)

@@ -13,6 +13,7 @@ module Text.FShow.RealFloat.Internals     ( posToDigits     , i2D+    , integerLog2     ) where  #include "MachDeps.h"@@ -23,7 +24,24 @@ import Data.Array.Base (unsafeAt) import Data.Array.IArray +#if __GLASGOW_HASKELL__ >= 702+import GHC.Base+import GHC.Integer.Logarithms +-- | Integer base-@2@ logarithm of a positive 'Integer'.+{-# INLINE integerLog2 #-}+integerLog2 :: Integer -> Int+integerLog2 n = I# (integerLog2# n)+#else+import GHC.Float (integerLogBase)++-- | Integer base-@2@ logarithm of a positive 'Integer'.+{-# INLINE integerLog2 #-}+integerLog2 :: Integer -> Int+integerLog2 = integerLogBase 2+#endif++ #if WORD_SIZE_IN_BITS == 32 #define DIGITS       9 #define BASE         1000000000@@ -37,10 +55,38 @@ i2D :: Int -> Char i2D (I# i#) = C# (chr# (ord# '0'# +# i#)) --- digits and exponent for a floating point number.--- floatRadix is assumed to be 2, decodeFloat to return--- a mantissa 2^(floatDigits-1) <= mantissa < 2^floatDigits-posToDigits :: Int -> Int -> Integer -> Int -> ([Int],Int)+-- | 'posToDigits' converts a positive number into a list of digits and+--   an exponent. If @x = 10^e*d_1.d_2...d_m...@ with @d_1 /= 0@ and+--   @0 <= d_i <= 9@, the result is @([d_1,d_2,...,d_m],e)@, where+--   @m@ is one or two larger than the number of requested digits,+--   provided that @2^(-70776) <= x < 2^248236@ (with 64-bit 'Int's,+--   the upper bound is about @2^1.3e9@).+--+--   The number @x@ is (indirectly) given in the form+--   @mantissa * 2^exponent@, similar to 'encodeFloat',+--   as the final two arguments. The second argument is the base-2+--   logarithm of the mantissa and the first is the number of decimal+--   digits needed to discriminate between different numbers.+--+--   In @'posToDigits' digs mlog mant exp@, it is assumed that+--+-- * @digs > 0@, @mlog >= 0@,+--+-- * @2^mlog <= mant < 2^(mlog+1)@.+--+--   These assumptions are not checked, and if they're not satisfied,+--   wrong results or worse are the consequences. /You have been warned/.+--+--   The digits argument may be smaller than would be necessary to uniquely+--   determine each value if that is not required. As a rule of thumb,+--   requiring fewer significant digits means faster generation of the+--   representation.+{-# INLINE posToDigits #-}+posToDigits :: Int      -- ^ number of digits required+            -> Int      -- ^ base @2@ logarithm of the mantissa+            -> Integer  -- ^ mantissa+            -> Int      -- ^ scaling exponent+            -> ([Int], Int) posToDigits showDigs mantExp mant scaleExp@(I# e#) = (integerToDigits decMant, e10)   where     !rex = mantExp + scaleExp@@ -57,7 +103,7 @@         | binshift <# 0# =             shiftRInteger (mant * expt5 decshift) (negateInt# binshift)         | otherwise = shiftLInteger (mant * expt5 decshift) binshift-    !e10 = if decMant < expt10 (showDigs+1) then l10+1 else l10+2+    !e10 = if decMant < expt10 (showDigs+1) then l10 else l10+1  expt5 :: Int -> Integer expt5 k = if k <= maxEx5 && k >= 0 then unsafeAt expts5 k else 5^k@@ -85,14 +131,56 @@ -- Divide and conquer implementation -- generate the sequence of digits of a positive Integer integerToDigits :: Integer -> [Int]-integerToDigits nm = integerToDigits' nm []--integerToDigits' :: Integer -> [Int] -> [Int]-integerToDigits' nm ds-    | nm < BASE = jhead (fromInteger nm) ds-    | otherwise = case nm `quotRemInteger` BASE of-                    (# q, r #) -> integerToDigits' q (jblock (fromInteger r) ds)+integerToDigits nm+    | nm < BASE = jhead (fromInteger nm) []+    | otherwise = jprinth (jsplitf (BASE*BASE) nm) []       where++        -- Split n into digits in base p. We first split n into digits+        -- in base p*p and then split each of these digits into two.+        -- Note that the first 'digit' modulo p*p may have a leading zero+        -- in base p that we need to drop - this is what jsplith takes care of.+        -- jsplitb the handles the remaining digits.+        jsplitf :: Integer -> Integer -> [Integer]+        jsplitf p n+            | p > n     = [n]+            | otherwise = jsplith p (jsplitf (p*p) n)++        jsplith :: Integer -> [Integer] -> [Integer]+        jsplith p (n:ns) =+            case n `quotRemInteger` p of+            (# q, r #) ->+                if q > 0 then q : r : jsplitb p ns+                        else     r : jsplitb p ns+        jsplith _ [] = error "jsplith: []"++        jsplitb :: Integer -> [Integer] -> [Integer]+        jsplitb _ []     = []+        jsplitb p (n:ns) = case n `quotRemInteger` p of+                        (# q, r #) ->+                            q : r : jsplitb p ns++        -- Convert a number that has been split into digits in base BASE^2+        -- this includes a last splitting step and then conversion of digits+        -- that all fit into a machine word.+        jprinth :: [Integer] -> [Int] -> [Int]+        jprinth (n:ns) cs =+            case n `quotRemInteger` BASE of+            (# q', r' #) ->+                let q = fromInteger q'+                    r = fromInteger r'+                in if q > 0 then jhead q $ jblock r $ jprintb ns cs+                            else jhead r $ jprintb ns cs+        jprinth [] _ = error "jprinth []"++        jprintb :: [Integer] -> [Int] -> [Int]+        jprintb []     cs = cs+        jprintb (n:ns) cs = case n `quotRemInteger` BASE of+                            (# q', r' #) ->+                                let q = fromInteger q'+                                    r = fromInteger r'+                                in jblock q $ jblock r $ jprintb ns cs+         -- Convert an integer that fits into a machine word. Again, we have two         -- functions, one that drops leading zeros (jhead) and one that doesn't         -- (jblock)

@@ -7,13 +7,14 @@ -- The package version. See the Haskell package versioning policy -- (http://www.haskell.org/haskellwiki/Package_versioning_policy) for -- standards guiding when and how versions should be incremented.-Version:             0.1.1+Version:             0.2.0  -- Constraint on the version of Cabal needed to build this package. Cabal-version:       >=1.6  -- A short (one-line) description of the package.-Synopsis:            Alternative faster String representations for Double and Float+Synopsis:            Alternative faster String representations for Double and Float,+                     String representations for more general numeric types.  -- A longer description of the package. Description:         The String representations provided by this package@@ -26,6 +27,10 @@                      shorter representation, the display functions of this                      package can be faster, sometimes by a big margin. +                     Text.FShow.Raw provides building blocks for representations+                     of numeric types which don't belong to RealFloat but have+                     some of its functionality.+                      The bulk of the code is a minor modification of code from                      the base package, whence the GHC License is included as                      an extra-source-file.@@ -67,6 +72,7 @@ Library   -- Modules exported by the library.   Exposed-modules:   Text.FShow.RealFloat+                     Text.FShow.Raw    -- Packages needed in order to build this package.   Build-depends:     base >= 4 && < 5, array >= 0.1 && < 0.4