Commits

dafis  committed d4aae99

New interface to convert more general numbers.

Added String representation for numbers which need not belong to
the RealFloat class.
Reverted integerToDigits to the old divide and conquer because
we may now deal with larger Integers.

  • Participants
  • Parent commits a01ee94

Comments (0)

Files changed (7)

+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

File Text/FShow/Raw.hs

+-- |
+-- 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

File Text/FShow/RealFloat.hs

 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,
         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"
                   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])
       _       -> 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)
       _       -> 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)

File Text/FShow/RealFloat/Internals.hs

 module Text.FShow.RealFloat.Internals
     ( posToDigits
     , i2D
+    , integerLog2
     ) where
 
 #include "MachDeps.h"
 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
 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
         | 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
 -- Divide and conquer implementation
 -- generate the sequence of digits of a positive Integer
 integerToDigits :: Integer -> [Int]
-integerToDigits nm = integerToDigits' nm []
+integerToDigits nm
+    | nm < BASE = jhead (fromInteger nm) []
+    | otherwise = jprinth (jsplitf (BASE*BASE) nm) []
+      where
 
-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)
-      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)

File floatshow.cabal

 -- 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
                      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.
 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

File tests/benchmarking/fltDisp.hs

     args <- getArgs
     let k = case args of
               (a:_) -> read a
-              _ -> 10000
+              _ -> 20000
     putStr $ wook k

File tests/quickcheck/qcTests.hs

 
 import Test.QuickCheck
 import Text.FShow.RealFloat
+import Text.FShow.Raw
+import Numeric
 
 myArgs :: Args
 myArgs = stdArgs
     { replay = Nothing
-    , maxSuccess = 1000
+    , maxSuccess = 10000
     , maxDiscard = 100
     , maxSize = 10000
     , chatty = False
     args <- fmap confArgs getArgs
     mapM_ (verify args)
         [ ("Float",propFloat)
-        , ("Double",propDouble)
+--         , ("Double",propDouble)
+--         , ("Raw",propRaw)
+--         , ("Bin",propBin)
+--         , ("Dec",propDec)
+        , ("Exponent 12",propEF)
         ]
+
+instance BinDecode Double where
+  decode = decodeFloat
+  decodeL x = (52, m, e) where (m, e) = decodeFloat x
+  showDigits _ = 17
+
+instance DecimalFormat Double where
+  nanTest = isNaN
+  infTest = isInfinite
+  negTest x = x < 0 || isNegativeZero x
+
+draw :: Double -> String
+draw = rawFormat decodeL 17 (Generic Nothing) Nothing
+
+dbin :: Double -> String
+dbin = binDecFormat (Generic Nothing) Nothing
+
+ddec :: Double -> String
+ddec = decimalFormat (Generic Nothing) Nothing
+
+propRaw :: Property
+propRaw = forAll arbitrary (\d -> d == read (draw d))
+
+propBin :: Property
+propBin = forAll arbitrary (\d -> d == read (dbin d))
+
+propDec :: Property
+propDec = forAll arbitrary (\d -> d == read (ddec d))
+
+propEF :: Property
+propEF = forAll arbitrary (\d -> init (showEFloat (Just 12) (d :: Double) "")
+                            == init (rawFormat decodeL 14 Exponent (Just 12) d))