floatshow (empty) → 0.1
raw patch · 8 files changed
+697/−0 lines, 8 filesdep +arraydep +basedep +integer-gmpsetup-changed
Dependencies added: array, base, integer-gmp, integer-simple
Files
- Changes +1/−0
- GHC_LICENCE +32/−0
- LICENSE +30/−0
- README +95/−0
- Setup.hs +2/−0
- Text/FShow/RealFloat.hs +294/−0
- Text/FShow/RealFloat/Internals.hs +155/−0
- floatshow.cabal +88/−0
+ Changes view
@@ -0,0 +1,1 @@+0.1: First release
+ GHC_LICENCE view
@@ -0,0 +1,32 @@++The Glasgow Haskell Compiler License++Copyright 2004, The University Court of the University of Glasgow.+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 name of the University nor the names of its contributors may be+used to endorse or promote products derived from this software without+specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE UNIVERSITY COURT OF THE UNIVERSITY OF+GLASGOW AND THE 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+UNIVERSITY COURT OF THE UNIVERSITY OF GLASGOW OR THE 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.
+ LICENSE view
@@ -0,0 +1,30 @@+Copyright (c)2011, Daniel Fischer++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 Daniel Fischer 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.
+ README view
@@ -0,0 +1,95 @@+The Show instances for RealFloat types provided in base are very elegant,+as they produce the shortest string which 'read' converts back to the+original number. That, however, involves a check after each digit has been+determined and arithmetic of usually fairly large Integers, which makes these+Show instances rather slow.++For cases where having the conversion fast is more important than having it+produce elegant output, this package provides alternative conversions, which+avoid the checks and reduce the occurrences of large Integers by just producing+a sufficiently long output string.++The speed gain can be substantial if the numbers have exponents of large+absolute modulus, but for the more common case of numbers whose exponents+have small absolute modulus, the difference is (although still significant+for Double) too small in my opinion to seriously consider replacing the+Show instances.++Some benchmarks produced with criterion (http://hackage.haskell.org/package/criterion)+show a considerable speedup, or example, converting 10,000 numbers to String+and calculating the length produced:++------------------------------------------------------------------+benchmarking show @ Double+collecting 100 samples, 1 iterations each, in estimated 46.89312 s+mean: 358.0839 ms, lb 356.3200 ms, ub 364.6815 ms, ci 0.950+std dev: 15.48404 ms, lb 3.952743 ms, ub 35.75519 ms, ci 0.950++benchmarking fshow @ Double+collecting 100 samples, 1 iterations each, in estimated 4.252911 s+mean: 42.75838 ms, lb 42.62119 ms, ub 43.06433 ms, ci 0.950+std dev: 996.1030 us, lb 550.6931 us, ub 1.925554 ms, ci 0.950++benchmarking show @ Double7+collecting 100 samples, 1 iterations each, in estimated 3.706884 s+mean: 37.06166 ms, lb 36.94387 ms, ub 37.32157 ms, ci 0.950+std dev: 861.9554 us, lb 445.2281 us, ub 1.401369 ms, ci 0.950++benchmarking show @ Float+collecting 100 samples, 1 iterations each, in estimated 11.79528 s+mean: 133.0406 ms, lb 127.1293 ms, ub 141.4778 ms, ci 0.950+std dev: 35.72864 ms, lb 27.26726 ms, ub 45.51660 ms, ci 0.950++benchmarking fshow @ Float+collecting 100 samples, 1 iterations each, in estimated 2.885604 s+mean: 28.91291 ms, lb 28.77308 ms, ub 29.28824 ms, ci 0.950+std dev: 1.091232 ms, lb 489.6288 us, ub 2.287669 ms, ci 0.950++benchmarking show @ Float7+collecting 100 samples, 1 iterations each, in estimated 2.264500 s+mean: 22.70168 ms, lb 22.59001 ms, ub 22.97338 ms, ci 0.950+std dev: 827.6377 us, lb 248.5136 us, ub 1.466120 ms, ci 0.950+------------------------------------------------------------------++The difference is far smaller however if we consider only numbers+with exponents of small absolute modulus (numbers between 1e-8 and+1e8 here):++------------------------------------------------------------------+benchmarking show @ Double+collecting 100 samples, 1 iterations each, in estimated 18.12048 s+mean: 183.0913 ms, lb 182.7177 ms, ub 183.6225 ms, ci 0.950+std dev: 2.261846 ms, lb 1.735274 ms, ub 2.905363 ms, ci 0.950++benchmarking fshow @ Double+collecting 100 samples, 1 iterations each, in estimated 3.522301 s+mean: 35.31092 ms, lb 35.19515 ms, ub 35.49955 ms, ci 0.950+std dev: 745.9619 us, lb 519.2986 us, ub 1.078124 ms, ci 0.950++benchmarking show @ Double7+collecting 100 samples, 1 iterations each, in estimated 3.172088 s+mean: 30.59535 ms, lb 29.79293 ms, ub 31.93459 ms, ci 0.950+std dev: 5.227548 ms, lb 3.553355 ms, ub 7.501725 ms, ci 0.950++benchmarking show @ Float+collecting 100 samples, 1 iterations each, in estimated 2.982783 s+mean: 32.53753 ms, lb 31.31817 ms, ub 34.15244 ms, ci 0.950+std dev: 7.154208 ms, lb 5.749231 ms, ub 8.477582 ms, ci 0.950++benchmarking fshow @ Float+collecting 100 samples, 1 iterations each, in estimated 2.393794 s+mean: 24.16462 ms, lb 24.06772 ms, ub 24.41152 ms, ci 0.950+std dev: 735.0625 us, lb 348.1389 us, ub 1.499519 ms, ci 0.950++benchmarking show @ Float7+collecting 100 samples, 1 iterations each, in estimated 2.562690 s+mean: 25.74102 ms, lb 25.67765 ms, ub 25.93221 ms, ci 0.950+std dev: 509.0308 us, lb 199.9313 us, ub 1.099169 ms, ci 0.950+------------------------------------------------------------------++Another benchmark, calculating d*sin(d^2) for d = 1, ..., 200000+and writing their string representations to a file, timed 'show'+at 4.26s, 'fshow' at 1.08s and 'show' for the newtype wrapper+Double7 (rounds to seven significant digits) around Double at 0.55s.+A corresponding C programme ran in 0.26s with the default precision+and in 0.32s with a precision of 17 digits.
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ Text/FShow/RealFloat.hs view
@@ -0,0 +1,294 @@+-- |+-- Module: Text.FShow.RealFloat+-- Copyright: (c) 2011 Daniel Fischer+-- Licence: BSD3+-- Maintainer: Daniel Fischer+-- Stability: experimental+-- Portability: non-portable (GHC extensions)+--+-- Faster 'String' representations for floating point types.+-- The code is largely taken from code in "GHC.Float" and the 'Show'+-- instance of 'Integer' in "GHC.Num" to get the sequence of digits.+{-# LANGUAGE GeneralizedNewtypeDeriving #-}+module Text.FShow.RealFloat+ ( FShow(..)+ , fshows+ , DispFloat(..)+ , fshowFloat+ , fshowEFloat+ , fshowFFloat+ , fshowGFloat+ , Double7(..)+ , Float7(..)+ ) where++import GHC.Show+import GHC.Float (showSignedFloat)+import Text.FShow.RealFloat.Internals++-- | Class for specifying display parameters. The type @a@+-- is supposed to be an IEEE-ish (real) floating-point+-- type with floating-point radix 2, such that the mantissa+-- returned by 'decodeFloat' satisfies+--+-- @+-- 2^('binExp' x) <= 'fst' ('decodeFloat' x) < 2^('binExp' x + 1)+-- @+--+-- for @x > 0@, so @'binExp' x = 'floatDigits' x - 1@.+-- The number of decimal digits that may be required is calculated+-- with the formula+--+-- @+-- 'decDigits' x = 2 + 'floor' ('floatDigits' x * 'logBase' 10 2).+-- @+--+-- The default implementation uses an approximation of+-- @'logBase' 10 2@ sufficient for mantissae of up to+-- several thousand bits. Nevertheless, hardcoding+-- the values in instance declarations may yield+-- better performance.+class (RealFloat a) => DispFloat a where+ -- | The number of decimal digits that may be needed to+ -- uniquely determine a value of type @a@.+ -- For faster conversions which need not satisfy+ --+ -- @+ -- x == 'read' ('fshow' x)+ -- @+ --+ -- a smaller value can be given.+ decDigits :: a -> Int+ decDigits x = 2 + (8651*(floatDigits x)) `quot` 28738+ -- | The base 2 logarithm of the mantissa returned by+ -- @'decodeFloat' x@ for @x > 0@.+ binExp :: a -> Int+ binExp x = floatDigits x - 1++instance DispFloat Double where+ decDigits _ = 17+ binExp _ = 52++instance DispFloat Float where+ decDigits _ = 9+ binExp _ = 23++-- | newtype wrapper for 'Double'. The 'Show' (and 'FShow') instance+-- displays numbers rounded to seven significant digits.+newtype Double7 = D7 Double+ deriving (Eq, Ord, Num, Fractional, Real, RealFrac, Floating, RealFloat)++instance DispFloat Double7 where+ decDigits _ = 7+ binExp _ = 52++instance Show Double7 where+ showsPrec p = showSignedFloat fshowFloat p++instance FShow Double7 where+ fshowsPrec p = showSignedFloat fshowFloat p+ fshowList = showList__ (fshowsPrec 0)++-- | newtype wrapper for 'Float'. The 'Show' (and 'FShow') instance+-- displays numbers rounded to seven significant digits.+newtype Float7 = F7 Float+ deriving (Eq, Ord, Num, Fractional, Real, RealFrac, Floating, RealFloat)++instance DispFloat Float7 where+ decDigits _ = 7+ binExp _ = 23++instance Show Float7 where+ showsPrec p = showSignedFloat fshowFloat p++instance FShow Float7 where+ fshowsPrec p = showSignedFloat fshowFloat p+ fshowList = showList__ (fshowsPrec 0)++{-+ The code below is a minor modification of code from GHC.Float+ and Numeric from the base package. The GHC Licence is included+ in the package root.+-}++-- | A duplicate of the 'Show' class.+class FShow a where+ fshow :: a -> String+ fshowsPrec :: Int -> a -> ShowS+ fshowList :: [a] -> ShowS+ fshow x = fshowsPrec 0 x ""+ fshowsPrec _ x s = fshow x ++ s+ fshowList xs s = showList__ fshows xs s++-- | Same as @'shows'@, but using an 'FShow' instance.+fshows :: FShow a => a -> ShowS+fshows x = showString (fshow x)++instance FShow Double where+ fshowsPrec p = showSignedFloat fshowFloat p+ fshowList = showList__ (fshowsPrec 0)++instance FShow Float where+ fshowsPrec p = showSignedFloat fshowFloat p+ fshowList = showList__ (fshowsPrec 0)++instance (FShow a) => FShow [a] where+ fshowsPrec _ = fshowList++{-# SPECIALISE fshowFloat ::+ Float -> ShowS,+ Float7 -> ShowS,+ Double7 -> ShowS,+ Double -> ShowS #-}+-- | Show a signed 'DispFloat' value to full precision+-- using standard decimal notation for arguments whose absolute value lies+-- between @0.1@ and @9,999,999@, and scientific notation otherwise.+-- Analogous to @'showFloat'@ from "GHC.Float".+fshowFloat :: (DispFloat a) => a -> ShowS+fshowFloat x = showString (formatFloat FFGeneric Nothing x)++{-# SPECIALISE fshowEFloat ::+ Maybe Int -> Float -> ShowS,+ Maybe Int -> Float7 -> ShowS,+ Maybe Int -> Double7 -> ShowS,+ Maybe Int -> Double -> ShowS #-}+{-# SPECIALISE fshowFFloat ::+ Maybe Int -> Float -> ShowS,+ Maybe Int -> Float7 -> ShowS,+ Maybe Int -> Double7 -> ShowS,+ Maybe Int -> Double -> ShowS #-}+{-# SPECIALISE fshowGFloat ::+ Maybe Int -> Float -> ShowS,+ Maybe Int -> Float7 -> ShowS,+ Maybe Int -> Double7 -> ShowS,+ Maybe Int -> Double -> ShowS #-}++-- | Show a signed 'DispFloat' value+-- using scientific (exponential) notation (e.g. @2.45e2@, @1.5e-3@).+--+-- In the call @'fshowEFloat' digs val@, if @digs@ is 'Nothing',+-- the value is shown to full precision; if @digs@ is @'Just' d@,+-- then @'max' 1 d@ digits after the decimal point are shown.+-- Analogous to @'showEFloat'@ from "Numeric".+fshowEFloat :: (DispFloat a) => Maybe Int -> a -> ShowS+fshowEFloat d x = showString (formatFloat FFExponent d x)++-- | Show a signed 'DispFloat' value+-- using standard decimal notation (e.g. @245000@, @0.0015@).+--+-- In the call @'fshowFFloat' digs val@, if @digs@ is 'Nothing',+-- the value is shown to full precision; if @digs@ is @'Just' d@,+-- then @'max' 0 d@ digits after the decimal point are shown.+-- Analogous to @'showFFloat'@ from "Numeric".+fshowFFloat :: (DispFloat a) => Maybe Int -> a -> ShowS+fshowFFloat d x = showString (formatFloat FFFixed d x)++-- | Show a signed 'DispFloat' value+-- using standard decimal notation for arguments whose absolute value lies+-- between @0.1@ and @9,999,999@, and scientific notation otherwise.+--+-- In the call @'fshowGFloat' digs val@, if @digs@ is 'Nothing',+-- the value is shown to full precision; if @digs@ is @'Just' d@,+-- then @'max' 1 d@ digits after the decimal point are shown.+-- Analogous to @'showGFloat'@ from "Numeric".+fshowGFloat :: (DispFloat a) => Maybe Int -> a -> ShowS+fshowGFloat d x = showString (formatFloat FFGeneric d x)++data FFFormat = FFExponent | FFFixed | FFGeneric++{-# SPECIALISE formatFloat :: FFFormat -> Maybe Int -> Double -> String,+ FFFormat -> Maybe Int -> Float -> String,+ FFFormat -> Maybe Int -> Double7 -> String,+ FFFormat -> Maybe Int -> Float7 -> String+ #-}+formatFloat :: DispFloat a => FFFormat -> Maybe Int -> a -> String+formatFloat fmt decs x+ | isNaN x = "NaN"+ | isInfinite x = if x < 0 then "-Infinity" else "Infinity"+ | x < 0 || isNegativeZero x = '-':doFmt fmt (fltDigs (-x))+ | otherwise = doFmt fmt (fltDigs x)+ where+ fltDigs 0 = ([0],0)+ fltDigs y = uncurry (posToDigits (decDigits y) (binExp y)) (decodeFloat y)+ fluff :: [Int] -> [Int]+ fluff [] = [0]+ fluff xs = xs++ doFmt format (is, e) =+ case format of+ FFGeneric ->+ doFmt (if e < 0 || e > 7 then FFExponent else FFFixed) (is,e)+ FFExponent ->+ case decs of+ Nothing ->+ let show_e' = if ei == 0 then show (e-1) else show e+ (ei,(d:ds)) = roundToS (decDigits x) is+ in case is of+ [0] -> "0.0e0"+ _ -> i2D d : '.' : map i2D (fluff ds) ++ ('e' : show_e')+ 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 i2D (if ei > 0 then init is' else is')+ in d:'.':ds' ++ 'e':show (e-1+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+ ds = map i2D is'+ in case is of+ [0] -> "0.0"+ _ | e' <= 0 -> "0." ++ replicate (-e') '0' ++ map i2D is'+ | 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')+ 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')+ 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 1 else 0, [])+ 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 1 else 0, [])+ f n (i:xs)+ | i' == 10 = (1,0:ds)+ | otherwise = (0,i':ds)+ where+ (c,ds) = f (n-1) xs+ i' = c + i
+ Text/FShow/RealFloat/Internals.hs view
@@ -0,0 +1,155 @@+-- |+-- Module: Text.FShow.RealFloat.Internals+-- Copyright: (c) 2011 Daniel Fischer+-- Licence: BSD3+-- Maintainer: Daniel Fischer <daniel.is.fischer@googlemail.com>+-- Stability: experimental+-- Portability: non-portable (GHC extensions)+--+-- Faster digit string generation for floating point numbers.+-- Uses a modification of the Integer showing code from "GHC.Num".+{-# LANGUAGE CPP, BangPatterns, MagicHash, UnboxedTuples #-}+{-# OPTIONS_HADDOCK hide #-}+module Text.FShow.RealFloat.Internals+ ( posToDigits+ , i2D+ ) where++#include "MachDeps.h"++import GHC.Base+import GHC.Num (quotRemInt)+import GHC.Integer+import Data.Array.Base (unsafeAt)+import Data.Array.IArray+++#if WORD_SIZE_IN_BITS == 32+#define DIGITS 9+#define BASE 1000000000+#else+#define DIGITS 18+#define BASE 1000000000000000000+#endif++-- unsafe Int -> Char conversion for decimal digits+{-# INLINE i2D #-}+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 showDigs mantExp mant scaleExp@(I# e#) = (integerToDigits decMant, e10)+ where+ !rex = mantExp + scaleExp+ !l0 = (8651*rex) `quot` 28738+ !l10 = if rex < 0 then l0-1 else l0+ -- 10^l10 <= x < 10^(l10+2)+ !decshift@(I# d#) = showDigs - l10+ !binshift = e# +# d#+ !decMant+ | d# <# 0# =+ (if binshift <# 0#+ then shiftRInteger mant (negateInt# binshift)+ else shiftLInteger mant binshift) `quot` expt5 (I# (negateInt# d#))+ | 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++expt5 :: Int -> Integer+expt5 k = if k <= maxEx5 && k >= 0 then unsafeAt expts5 k else 5^k++expt10 :: Int -> Integer+expt10 k = if k <= maxEx10 && k >= 0 then unsafeAt expts10 k else 10^k++maxEx5 :: Int+maxEx5 = 349++maxEx10 :: Int+maxEx10 = 25++expts5 :: Array Int Integer+expts5 = array (0, maxEx5) [(k,5^k) | k <- [0 .. maxEx5]]++expts10 :: Array Int Integer+expts10 = array (0,maxEx10) [(k,10^k) | k <- [0 .. maxEx10]]++------------------------------------------------------------------------------+-- The code to show Integers, modified to produce [Int] instead of [Char]+-- Taken from GHC.Num and modified to suit our needs+-- The GHC Licence is reproduced in the package root++-- Divide and conquer implementation+-- generate the sequence of digits of a positive Integer+integerToDigits :: Integer -> [Int]+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)+ jhead :: Int -> [Int] -> [Int]+ jhead n cs+ | n < 10 = n:cs+ | otherwise = jhead q (r : cs)+ where+ (q, r) = n `quotRemInt` 10++ jblock = jblock' {- ' -} DIGITS -- bloody CPP++ jblock' :: Int -> Int -> [Int] -> [Int]+ jblock' d n cs+ | d == 1 = n : cs+ | otherwise = jblock' (d - 1) q (r : cs)+ where+ (q, r) = n `quotRemInt` 10
+ floatshow.cabal view
@@ -0,0 +1,88 @@+-- floatshow.cabal auto-generated by cabal init. For additional+-- options, see+-- http://www.haskell.org/cabal/release/cabal-latest/doc/users-guide/authors.html#pkg-descr.+-- The name of the package.+Name: floatshow++-- 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++-- 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++-- A longer description of the package.+Description: The String representations provided by this package+ are generally longer than show's output, which constructs+ the shortest string that is parsed as the original+ number by read. This requires some time-consuming checks,+ so show is slow for floating-point numbers. By producing+ a digit-string guaranteed to be long enough to uniquely+ determine the number without caring whether there's a+ shorter representation, the display functions of this+ package can be faster, sometimes by a big margin.++ 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.++-- URL for the project homepage or repository.+Homepage: https://bitbucket.org/dafis/floatshow+Bug-reports: https://bitbucket.org/dafis/floatshow/issues++-- The license under which the package is released.+License: BSD3++-- The file containing the license text.+License-file: LICENSE++-- The package author(s).+Author: Daniel Fischer++-- An email address to which users can send suggestions, bug reports,+-- and patches.+Maintainer: daniel.is.fischer@googlemail.com++-- A copyright notice.+Copyright: (c) 2011 Daniel Fischer++Category: Text++Build-type: Simple++-- Extra files to be distributed with the package, such as examples or+-- a README.+Extra-source-files: GHC_LICENCE+ README+ Changes++Flag gmp+ Description: Use integer-gmp+ Default: True++Library+ -- Modules exported by the library.+ Exposed-modules: Text.FShow.RealFloat++ -- Packages needed in order to build this package.+ Build-depends: base >= 4 && < 5, array >= 0.1 && < 0.4+ if flag(gmp)+ Build-depends: integer-gmp+ else+ Build-depends: integer-simple++ -- Modules not exported by this package.+ Other-modules: Text.FShow.RealFloat.Internals++ -- Extra tools (e.g. alex, hsc2hs, ...) needed to build the source.+ -- Build-tools:+ -- Extensions: CPP, MagicHash, UnboxedTuples, BangPatterns+ ghc-options: -O2 -fspec-constr-count=5 -Wall++source-repository head+ type: mercurial+ location: https://bitbucket.org/dafis/floatshow