diff --git a/CHANGELOG b/CHANGELOG --- a/CHANGELOG +++ b/CHANGELOG @@ -1,3 +1,9 @@ +0.5.0.7 (2021-10-16): + - Switching from TravisCI to GithubActions + - Linting Haddock warnings + - Remove some trailing whitespaces +0.5.0.6 (2019-04-13): + - Nudging everything to the correct urls, emails, etc 0.5.0.2 (2015-05-06): - Fixed the benchmarking url 0.5.0.1 (2015-05-06): diff --git a/README b/README deleted file mode 100644 --- a/README +++ /dev/null @@ -1,36 +0,0 @@ -bytestring-lexing -================= - -This is a simple package and should be easy to install. You should -be able to use one of the following standard methods to install it. - - -- With cabal-install and without the source: - $> cabal install bytestring-lexing - - -- With cabal-install and with the source already: - $> cd bytestring-lexing - $> cabal install - - -- Without cabal-install, but with the source already: - $> cd bytestring-lexing - $> runhaskell Setup.hs configure --user - $> runhaskell Setup.hs build - $> runhaskell Setup.hs test - $> runhaskell Setup.hs haddock --hyperlink-source - $> runhaskell Setup.hs copy - $> runhaskell Setup.hs register - -The test step is optional and currently does nothing. The Haddock -step is also optional. - - -Portability -=========== - -An attempt has been made to keep this library portable. However, -the decimalPrecision function in Data.ByteString.Lex.Fractional -requires ScopedTypeVariables for efficiency. If your compiler does -not support ScopedTypeVariables, this should be easy enough to fix. -Contact the maintainer if this is an issue for you. - ------------------------------------------------------------ fin. diff --git a/README.md b/README.md new file mode 100644 --- /dev/null +++ b/README.md @@ -0,0 +1,185 @@ +bytestring-lexing +================= +[![Hackage version](https://img.shields.io/hackage/v/bytestring-lexing.svg?style=flat)](https://hackage.haskell.org/package/bytestring-lexing) +[![Build Status](https://github.com/wrengr/bytestring-lexing/workflows/ci/badge.svg)](https://github.com/wrengr/bytestring-lexing/actions?query=workflow%3Aci) +[![Dependencies](https://img.shields.io/hackage-deps/v/bytestring-lexing.svg?style=flat)](http://packdeps.haskellers.com/specific?package=bytestring-lexing) + +The bytestring-lexing package offers extremely efficient `ByteString` +parsers for some common lexemes: namely integral and fractional +numbers. In addition, it provides efficient serializers for (some +of) the formats it parses. + +As of version 0.3.0, bytestring-lexing offers the best-in-show +parsers for integral values. And as of version 0.5.0 it offers (to +my knowledge) the best-in-show parser for fractional/floating +numbers. A record of these benchmarks can be found +[here](http://code.haskell.org/~wren/bytestring-lexing/bench/html) + + +## Install + +This is a simple package and should be easy to install. You should +be able to use any of the standard methods to install it. + + -- With cabal-install and without the source: + $> cabal install bytestring-lexing + + -- With cabal-install and with the source already: + $> cd bytestring-lexing + $> cabal install + + -- Without cabal-install, but with the source already: + $> cd bytestring-lexing + $> runhaskell Setup.hs configure --user + $> runhaskell Setup.hs build + $> runhaskell Setup.hs haddock --hyperlink-source + $> runhaskell Setup.hs copy + $> runhaskell Setup.hs register + +The Haddock step is optional. + + +### Testing + +If you want to run the test suite, use the following standard method +(with `runhaskell Setup.hs` in lieu of `cabal`, if necessary): + + $> cd bytestring-lexing + $> cabal configure --enable-tests --enable-coverage + $> cabal build + $> cabal test --keep-tix-files + +The results of the code coverage are in +`./dist/hpc/vanilla/html/bytestring-lexing-$VERSION/hpc_index.html`. +If you're not interested in the coverage of the test suite, then +you needn't pass the `--enable-coverage` nor `--keep-tix-files` +flags. Note that older versions of cabal used the flag name +`--enable-library-coverage` instead of `--enable-coverage`. And +IIRC hpc integration in cabal was broken for ghc-7.6. + + +### Benchmarks + +If you want to run the benchmarking code, then do: + + $> cd bytestring-lexing/bench + $> cabal configure + $> cabal build + $> for b in isSpace numDigits packDecimal readDecimal readExponential ceilEightThirds; do + ./dist/build/bench-${b}/bench-${b} -o ${b}.html; + done && open *.html + +Of course, you needn't run all the benchmarking programs if you +don't want. Notably, these benchmarks are artefacts of the development +of the library. They are not necessarily the most up-to-date +reflection of the library itself, nor of other Haskell libraries +we've compared against in the past. + + +## Portability + +An attempt has been made to keep this library portable. However, +we do make use of two simple language extensions. Both of these +would be easy enough to remove, but they should not pose a significant +portability burden. If they do in fact pose a burden for your +compiler, contact the maintainer. + +* ScopedTypeVariables - the `decimalPrecision` function in + `Data.ByteString.Lex.Fractional` uses ScopedTypeVariables for + efficiency; namely to ensure that the constant function + `decimalPrecision` need only compute its result once (per type), + and that its result has no data dependency on the proxy argument. +* BangPatterns - are used to make the code prettier and to "improve" + code coverage over the equivalent semantics via the following + idiom: + + foo x ... z + | x `seq` ... `seq` z `seq` False = error "impossible" + | otherwise = ... + + BangPatterns are supported in GHC as far back as [version + 6.6.1][ghc-bangpatterns], and are also supported by + [JHC][jhc-bangpatterns] and [UHC][uhc-bangpatterns]. As of 2010, + they were [not supported by Hugs][hugs-bangpatterns]; but alas + Hugs is pretty much dead now. + +[ghc-bangpatterns]: + https://downloads.haskell.org/~ghc/6.6.1/docs/html/users_guide/sec-bang-patterns.html +[jhc-bangpatterns]: + http://repetae.net/computer/jhc/manual.html#code-options +[uhc-bangpatterns]: + https://github.com/UU-ComputerScience/uhc-js/issues/1 +[hugs-bangpatterns]: + https://mail.haskell.org/pipermail/haskell-cafe/2010-July/079946.html + + +## Changes: Version 0.5.0 (2015-05-06) vs 0.4.3 (2013-03-21) + +I've completely overhauled the parsers for fractional numbers. + +The old `Data.ByteString.Lex.Double` and `Data.ByteString.Lex.Lazy.Double` +modules have been removed, as has their reliance on Alex as a build +tool. I know some users were reluctant to use bytestring-lexing +because of that dependency, and forked their own version of +bytestring-lexing-0.3.0's integral parsers. This is no longer an +issue, and those users are requested to switch over to using +bytestring-lexing. + +The old modules are replaced by the new `Data.ByteString.Lex.Fractional` +module. This module provides two variants of the primary parsers. +The `readDecimal` and `readExponential` functions are very simple +and should suffice for most users' needs. The `readDecimalLimited` +and `readExponentialLimited` are variants which take an argument +specifying the desired precision limit (in decimal digits). With +care, the limited-precision parsers can perform far more efficiently +than the unlimited-precision parsers. Performance aside, they can +also be used to intentionally restrict the precision of your program's +inputs. + + +## Benchmarks: Version 0.5.0 (2015-05-06) + +The Criterion output of the benchmark discussed below, [is available +here](http://code.haskell.org/~wren/bytestring-lexing/bench/html/readExponential-0.5.0_ereshkigal.html). +The main competitors we compare against are the previous version +of bytestring-lexing (which already surpassed text and +attoparsec/scientific) and bytestring-read which was the previous +best-in-show. + +The unlimited-precision parsers provide 3.3x to 3.9x speedup over +the `readDouble` function from bytestring-lexing-0.4.3.3, as well +as being polymorphic over all `Fractional` values. For `Float`/`Double`: +these functions have essentially the same performance as bytestring-read +on reasonable inputs (1.07x to 0.89x), but for inputs which have +far more precision than `Float`/`Double` can handle these functions +are much slower than bytestring-read (0.30x 'speedup'). However, +for `Rational`: these functions provide 1.26x to 1.96x speedup +compared to bytestring-read. + +The limited-precision parsers do even better, but require some care +to use properly. For types with infinite precision (e.g., `Rational`) +we can pass in an 'infinite' limit by passing the length of the +input string plus one. For `Rational`: doing so provides 1.5x speedup +over the unlimited-precision parsers (and 1.9x to 3x speedup over +bytestring-read), because we can avoid intermediate renormalizations. +Whether other unlimited precision types would see the same benefit +remains an open question. + +For types with inherently limited precision (e.g., `Float`/`Double`), +we could either pass in an 'infinite' limit or we could pass in the +actual inherent limit. For types with inherently limited precision, +passing in an 'infinite' limit degrades performance compared to the +unlimited-precision parsers (0.51x to 0.8x 'speedup'). Whereas, +passing in the actual inherent limit gives 1.3x to 4.5x speedup +over the unlimited-precision parsers. They also provide 1.2x to +1.4x speedup over bytestring-read; for a total of 5.1x to 14.4x +speedup over bytestring-lexing-0.4.3.3! + + +## Links + +* [Website](https://wrengr.org/) +* [Blog](http://winterkoninkje.dreamwidth.org/) +* [Twitter](https://twitter.com/wrengr) +* [Hackage](http://hackage.haskell.org/package/bytestring-lexing) +* [GitHub](https://github.com/wrengr/bytestring-lexing) diff --git a/bytestring-lexing.cabal b/bytestring-lexing.cabal --- a/bytestring-lexing.cabal +++ b/bytestring-lexing.cabal @@ -1,51 +1,119 @@ ---------------------------------------------------------------- --- wren gayle romano ~ 2015.06.05 +-- wren gayle romano ~ 2021.10.16 ---------------------------------------------------------------- --- By and large Cabal >=1.2 is fine; but >= 1.6 gives tested-with: --- and source-repository:. -Cabal-Version: >= 1.6 +-- Cabal >=1.10 is required by Hackage. +Cabal-Version: >= 1.10 Build-Type: Simple Name: bytestring-lexing -Version: 0.5.0.2 +Version: 0.5.0.7 Stability: provisional -Homepage: http://code.haskell.org/~wren/ +Homepage: https://wrengr.org/ Author: wren gayle romano, Don Stewart -Maintainer: wren@community.haskell.org -Copyright: Copyright (c) 2012--2015 wren gayle romano, 2008--2011 Don Stewart -License: BSD2 +Maintainer: wren@cpan.org +Copyright: Copyright (c) 2012--2021 wren gayle romano, 2008--2011 Don Stewart +License: BSD3 License-File: LICENSE Category: Data Synopsis: - Parse and produce literals efficiently from strict or lazy bytestrings. + Efficiently parse and produce common integral and fractional numbers. Description: - Parse and produce literals efficiently from strict or lazy bytestrings. + The bytestring-lexing package offers extremely efficient `ByteString` + parsers for some common lexemes: namely integral and fractional + numbers. In addition, it provides efficient serializers for (some + of) the formats it parses. . + As of version 0.3.0, bytestring-lexing offers the best-in-show + parsers for integral values. (According to the Warp web server's + benchmark of parsing the Content-Length field of HTTP headers.) And + as of version 0.5.0 it offers (to my knowledge) the best-in-show + parser for fractional/floating numbers. + . Some benchmarks for this package can be found at: - + +---------------------------------------------------------------- +Extra-source-files: + AUTHORS, CHANGELOG, README.md --- Formerly tested with GHCs 6.8.2, 6.10.1, 6.12.1, 7.0.3, 7.6.1, 7.8.0; but those are no longer verified. +-- This should work as far back as GHC 7.4.1, but we don't verify that by CI. +-- Tested-With: - GHC ==7.8.3, GHC == 7.10.1 -Extra-source-files: - AUTHORS, README, CHANGELOG + GHC ==8.0.2, + GHC ==8.2.2, + GHC ==8.4.4, + GHC ==8.6.5, + GHC ==8.8.4, + GHC ==8.10.3, + GHC ==9.0.1 + Source-Repository head - Type: darcs - Location: http://community.haskell.org/~wren/bytestring-lexing + Type: git + Location: https://github.com/wrengr/bytestring-lexing.git ---------------------------------------------------------------- Library + Default-Language: Haskell2010 Ghc-Options: -O2 Hs-Source-Dirs: src Exposed-Modules: Data.ByteString.Lex.Integral Data.ByteString.Lex.Fractional Other-Modules: Data.ByteString.Lex.Internal - - -- Should actually be able to work as far back as base-2.0... - Build-Depends: base >= 4 && < 5, bytestring + + -- These lower bounds are probably more restrictive than + -- necessary. But then, we don't maintain any CI tests for + -- older versions, so these are the lowest bounds we've verified. + Build-Depends: base >= 4.5 && < 4.16 + , bytestring >= 0.9.2.1 && < 0.12 + +---------------------------------------------------------------- +-- +-- You can either: +-- (1) have type:exitcode-stdio-1.0 & main-is: +-- where main-is exports `main::IO()` as usual. Or, +-- (2) have type:detailed-0.9 & test-module: +-- where test-module exports tests::IO[Distribution.TestSuite.Test] +-- and you have Build-Depends: Cabal >= 1.9.2 +-- +-- Rather than using Cabal's built-in detailed-0.9 framework, we +-- could use the test-framework* family of packages with +-- exitcode-stdio-1.0. cf., +-- Or +-- the tasty* family of packages with exitcode-stdio-1.0. Notice +-- that test-framework-smallcheck is deprecated in favor of +-- tasty-smallcheck. Both have more dependencies than Cabal, so +-- will be harder to install on legacy systems; but then we wouldn't +-- have to maintain our own code to glue into Cabal's detailed-0.9. +-- Note that the oldest Tasty requires base>=4.5 whereas the oldest +-- test-framework seems to have no lower bound on base. + +Test-Suite test-all + Default-Language: Haskell2010 + Hs-Source-Dirs: test + Type: exitcode-stdio-1.0 + -- HACK: main-is must *not* have ./test/ like it does for executables! + Main-Is: Main.hs + Other-Modules: Integral + , Fractional + -- We must include this library in order for the tests to use + -- it; but we must not give a version restriction lest Cabal + -- give warnings. + Build-Depends: base >= 4.5 && < 5 + , bytestring >= 0.9.2.1 && < 0.12 + , bytestring-lexing + , tasty >= 0.10.1.2 && < 1.5 + , tasty-smallcheck >= 0.8.0.1 && < 0.9 + , tasty-quickcheck >= 0.8.3.2 && < 0.11 + -- QuickCheck >= 2.10 && < 2.15 + -- smallcheck >= 1.1.1 && < 1.3 + -- lazysmallcheck >= 0.6 && < 0.7 + +-- cabal configure flags: +-- * --enable-tests +-- * --enable-coverage (replaces the deprecated --enable-library-coverage) +-- * --enable-benchmarks (doesn't seem to actually work... At least, I was getting errors whenever I tried passing this; maybe upping the cabal-version to 1.8 fixed that?) ---------------------------------------------------------------- ----------------------------------------------------------- fin. diff --git a/src/Data/ByteString/Lex/Fractional.hs b/src/Data/ByteString/Lex/Fractional.hs --- a/src/Data/ByteString/Lex/Fractional.hs +++ b/src/Data/ByteString/Lex/Fractional.hs @@ -1,14 +1,14 @@ {-# OPTIONS_GHC -Wall -fwarn-tabs #-} -{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE BangPatterns, ScopedTypeVariables #-} ---------------------------------------------------------------- --- 2015.06.05 +-- 2015.06.11 -- | -- Module : Data.ByteString.Lex.Fractional --- Copyright : Copyright (c) 2015 wren gayle romano +-- Copyright : Copyright (c) 2015--2019 wren gayle romano -- License : BSD2 --- Maintainer : wren@community.haskell.org +-- Maintainer : wren@cpan.org -- Stability : provisional --- Portability : Haskell98 + ScopedTypeVariables +-- Portability : BangPatterns + ScopedTypeVariables -- -- Functions for parsing and producing 'Fractional' values from\/to -- 'ByteString's based on the \"Char8\" encoding. That is, we assume @@ -49,7 +49,7 @@ import Data.Word (Word8) import qualified Data.ByteString.Lex.Integral as I import Data.ByteString.Lex.Integral (readSigned) -import Data.ByteString.Lex.Internal (numDecimalDigits) +import Data.ByteString.Lex.Internal ---------------------------------------------------------------- ---------------------------------------------------------------- @@ -58,15 +58,11 @@ -- TODO: should we really be this strict? justPair :: a -> b -> Maybe (a,b) {-# INLINE justPair #-} -justPair x y - | x `seq` y `seq` False = undefined - | otherwise = Just (x,y) +justPair !x !y = Just (x,y) pair :: a -> b -> (a,b) {-# INLINE pair #-} -pair x y - | x `seq` y `seq` False = undefined - | otherwise = (x,y) +pair !x !y = (x,y) -- NOTE: We use 'fromInteger' everywhere instead of 'fromIntegral' @@ -74,22 +70,7 @@ -- This is always correct, but for some result types there are other -- intermediate types which may be faster. -{-# INLINE isNotPeriod #-} -isNotPeriod :: Word8 -> Bool -isNotPeriod w = w /= 0x2E -{-# INLINE isNotE #-} -isNotE :: Word8 -> Bool -isNotE w = w /= 0x65 && w /= 0x45 - -{-# INLINE isDecimal #-} -isDecimal :: Word8 -> Bool -isDecimal w = 0x39 >= w && w >= 0x30 - -{-# INLINE isDecimalZero #-} -isDecimalZero :: Word8 -> Bool -isDecimalZero w = w == 0x30 - ---------------------------------------------------------------- ----- Decimal @@ -149,12 +130,14 @@ -- those are best handled by helper functions which then use this -- function for the actual numerical parsing. This function recognizes -- both upper-case, lower-case, and mixed-case hexadecimal. +-- +-- This is just a thin wrapper around 'I.readHexadecimal'. readHexadecimal :: (Fractional a) => ByteString -> Maybe (a, ByteString) {-# SPECIALIZE readHexadecimal :: ByteString -> Maybe (Float, ByteString), ByteString -> Maybe (Double, ByteString), ByteString -> Maybe (Rational, ByteString) #-} -readHexadecimal xs = +readHexadecimal xs = case I.readHexadecimal xs of Nothing -> Nothing Just (n, xs') -> justPair (fromInteger n) xs' @@ -179,12 +162,14 @@ -- \"0o\", but because there are different variants, those are best -- handled by helper functions which then use this function for the -- actual numerical parsing. +-- +-- This is just a thin wrapper around 'I.readOctal'. readOctal :: (Fractional a) => ByteString -> Maybe (a, ByteString) {-# SPECIALIZE readOctal :: ByteString -> Maybe (Float, ByteString), ByteString -> Maybe (Double, ByteString), ByteString -> Maybe (Rational, ByteString) #-} -readOctal xs = +readOctal xs = case I.readOctal xs of Nothing -> Nothing Just (n, xs') -> justPair (fromInteger n) xs' @@ -248,7 +233,7 @@ -- representation, as defined by a fundep or typefamily! We use -- 'Integer' which is sufficient for all cases, but it'd be better -- to use @Word24@ for 'Float', @Word53@ for 'Double', and @a@ for --- @'Ratio' a@. +-- @'Data.Ratio.Ratio' a@. data DecimalFraction a = DF !Integer {-# UNPACK #-}!Int -- BUG: Can't unpack integers... @@ -358,26 +343,21 @@ where -- All calls to 'I.readDecimal' are monomorphized at 'Integer', -- as specified by what 'DF' needs. - - -- TODO: verify this is ~inferred~ strict in both @p@ and @xs@ - -- without the guard trick or BangPatterns - start p xs - | p `seq` xs `seq` False = undefined - | otherwise = - case lengthDropWhile isDecimalZero xs of - (0, _) -> readWholePart p xs - (_, ys) -> - case BS.uncons ys of - Nothing -> justPair (DF 0 0) BS.empty - Just (y0,ys0) - | isDecimal y0 -> readWholePart p ys - | isNotPeriod y0 -> justPair (DF 0 0) ys - | otherwise -> - case lengthDropWhile isDecimalZero ys0 of - (0, _) -> readFractionPart p 0 ys - (scale, zs) -> afterDroppingZeroes p scale zs + start !p !xs = + case lengthDropWhile isDecimalZero xs of + (0, _) -> readWholePart p xs + (_, ys) -> + case BS.uncons ys of + Nothing -> justPair (DF 0 0) BS.empty + Just (y0,ys0) + | isDecimal y0 -> readWholePart p ys + | isNotPeriod y0 -> justPair (DF 0 0) ys + | otherwise -> + case lengthDropWhile isDecimalZero ys0 of + (0, _) -> readFractionPart p 0 ys + (scale, zs) -> afterDroppingZeroes p scale zs - afterDroppingZeroes p scale xs = + afterDroppingZeroes !p !scale !xs = let ys = BS.take p xs in case I.readDecimal ys of Nothing -> justPair (DF 0 0) xs @@ -386,7 +366,7 @@ in justPair (DF part (negate scale')) (BS.dropWhile isDecimal ys') - readWholePart p xs = + readWholePart !p !xs = let ys = BS.take p xs in case I.readDecimal ys of Nothing -> Nothing @@ -411,7 +391,7 @@ then justPair (DF whole 0) xs' else readFractionPart (p-len) whole xs' - dropFractionPart xs = + dropFractionPart !xs = case BS.uncons xs of Nothing -> BS.empty -- == xs Just (x0,xs0) @@ -428,7 +408,7 @@ -- isDecimal@ is a noop; but there's no reason to branch on -- testing for that. The @+1@ in @BS.drop (1+scale)@ is for the -- 'BSU.unsafeTail' in @ys@. - readFractionPart p whole xs = + readFractionPart !p !whole !xs = let ys = BS.take p (BSU.unsafeTail xs) in case I.readDecimal ys of Nothing -> justPair (DF whole 0) xs @@ -449,12 +429,12 @@ Int -> ByteString -> Maybe (Rational, ByteString) #-} readExponentialLimited = start where - start p xs = + start !p !xs = case readDecimalLimited_ p xs of Nothing -> Nothing Just (df,xs') -> Just $! readExponentPart df xs' - readExponentPart df xs + readExponentPart !df !xs | BS.null xs = pair (fromDF df) BS.empty | isNotE (BSU.unsafeHead xs) = pair (fromDF df) xs | otherwise = diff --git a/src/Data/ByteString/Lex/Integral.hs b/src/Data/ByteString/Lex/Integral.hs --- a/src/Data/ByteString/Lex/Integral.hs +++ b/src/Data/ByteString/Lex/Integral.hs @@ -1,13 +1,14 @@ {-# OPTIONS_GHC -Wall -fwarn-tabs #-} +{-# LANGUAGE BangPatterns #-} ---------------------------------------------------------------- --- 2013.03.21 +-- 2015.06.11 -- | -- Module : Data.ByteString.Lex.Integral --- Copyright : Copyright (c) 2010--2015 wren gayle romano +-- Copyright : Copyright (c) 2010--2019 wren gayle romano -- License : BSD2 --- Maintainer : wren@community.haskell.org +-- Maintainer : wren@cpan.org -- Stability : provisional --- Portability : Haskell98 +-- Portability : BangPatterns -- -- Functions for parsing and producing 'Integral' values from\/to -- 'ByteString's based on the \"Char8\" encoding. That is, we assume @@ -96,9 +97,8 @@ Just $ loop (fromIntegral (w - 0x30)) (BSU.unsafeTail xs) | otherwise -> Nothing - loop n xs - | n `seq` xs `seq` False = undefined -- for strictness analysis - | BS.null xs = (n, BS.empty) -- not @xs@, to help GC + loop !n !xs + | BS.null xs = (n, BS.empty) -- not @xs@, to help GC | otherwise = case BSU.unsafeHead xs of w | 0x39 >= w && w >= 0x30 -> @@ -131,18 +131,6 @@ ByteString -> Maybe (Word64, ByteString) #-} readDecimal = start where - isDecimal :: Word8 -> Bool - {-# INLINE isDecimal #-} - isDecimal w = 0x39 >= w && w >= 0x30 - - toDigit :: (Integral a) => Word8 -> a - {-# INLINE toDigit #-} - toDigit w = fromIntegral (w - 0x30) - - addDigit :: Int -> Word8 -> Int - {-# INLINE addDigit #-} - addDigit n w = n * 10 + toDigit w - -- TODO: should we explicitly drop all leading zeros before we jump into the unrolled loop? start :: (Integral a) => ByteString -> Maybe (a, ByteString) start xs @@ -153,8 +141,7 @@ | otherwise -> Nothing loop0 :: (Integral a) => a -> ByteString -> (a, ByteString) - loop0 m xs - | m `seq` xs `seq` False = undefined + loop0 !m !xs | BS.null xs = (m, BS.empty) | otherwise = case BSU.unsafeHead xs of @@ -163,57 +150,49 @@ loop1, loop2, loop3, loop4, loop5, loop6, loop7, loop8 :: (Integral a) => a -> Int -> ByteString -> (a, ByteString) - loop1 m n xs - | m `seq` n `seq` xs `seq` False = undefined + loop1 !m !n !xs | BS.null xs = (m*10 + fromIntegral n, BS.empty) | otherwise = case BSU.unsafeHead xs of w | isDecimal w -> loop2 m (addDigit n w) (BSU.unsafeTail xs) | otherwise -> (m*10 + fromIntegral n, xs) - loop2 m n xs - | m `seq` n `seq` xs `seq` False = undefined + loop2 !m !n !xs | BS.null xs = (m*100 + fromIntegral n, BS.empty) | otherwise = case BSU.unsafeHead xs of w | isDecimal w -> loop3 m (addDigit n w) (BSU.unsafeTail xs) | otherwise -> (m*100 + fromIntegral n, xs) - loop3 m n xs - | m `seq` n `seq` xs `seq` False = undefined + loop3 !m !n !xs | BS.null xs = (m*1000 + fromIntegral n, BS.empty) | otherwise = case BSU.unsafeHead xs of w | isDecimal w -> loop4 m (addDigit n w) (BSU.unsafeTail xs) | otherwise -> (m*1000 + fromIntegral n, xs) - loop4 m n xs - | m `seq` n `seq` xs `seq` False = undefined + loop4 !m !n !xs | BS.null xs = (m*10000 + fromIntegral n, BS.empty) | otherwise = case BSU.unsafeHead xs of w | isDecimal w -> loop5 m (addDigit n w) (BSU.unsafeTail xs) | otherwise -> (m*10000 + fromIntegral n, xs) - loop5 m n xs - | m `seq` n `seq` xs `seq` False = undefined + loop5 !m !n !xs | BS.null xs = (m*100000 + fromIntegral n, BS.empty) | otherwise = case BSU.unsafeHead xs of w | isDecimal w -> loop6 m (addDigit n w) (BSU.unsafeTail xs) | otherwise -> (m*100000 + fromIntegral n, xs) - loop6 m n xs - | m `seq` n `seq` xs `seq` False = undefined + loop6 !m !n !xs | BS.null xs = (m*1000000 + fromIntegral n, BS.empty) | otherwise = case BSU.unsafeHead xs of w | isDecimal w -> loop7 m (addDigit n w) (BSU.unsafeTail xs) | otherwise -> (m*1000000 + fromIntegral n, xs) - loop7 m n xs - | m `seq` n `seq` xs `seq` False = undefined + loop7 !m !n !xs | BS.null xs = (m*10000000 + fromIntegral n, BS.empty) | otherwise = case BSU.unsafeHead xs of w | isDecimal w -> loop8 m (addDigit n w) (BSU.unsafeTail xs) | otherwise -> (m*10000000 + fromIntegral n, xs) - loop8 m n xs - | m `seq` n `seq` xs `seq` False = undefined + loop8 !m !n !xs | BS.null xs = (m*100000000 + fromIntegral n, BS.empty) | otherwise = case BSU.unsafeHead xs of @@ -245,18 +224,6 @@ ByteString -> Word64 #-} readDecimal_ = start where - isDecimal :: Word8 -> Bool - {-# INLINE isDecimal #-} - isDecimal w = 0x39 >= w && w >= 0x30 - - toDigit :: (Integral a) => Word8 -> a - {-# INLINE toDigit #-} - toDigit w = fromIntegral (w - 0x30) - - addDigit :: Int -> Word8 -> Int - {-# INLINE addDigit #-} - addDigit n w = n * 10 + toDigit w - start xs | BS.null xs = 0 | otherwise = @@ -265,8 +232,7 @@ | otherwise -> 0 loop0 :: (Integral a) => a -> ByteString -> a - loop0 m xs - | m `seq` xs `seq` False = undefined + loop0 !m !xs | BS.null xs = m | otherwise = case BSU.unsafeHead xs of @@ -275,57 +241,49 @@ loop1, loop2, loop3, loop4, loop5, loop6, loop7, loop8 :: (Integral a) => a -> Int -> ByteString -> a - loop1 m n xs - | m `seq` n `seq` xs `seq` False = undefined + loop1 !m !n !xs | BS.null xs = m*10 + fromIntegral n | otherwise = case BSU.unsafeHead xs of w | isDecimal w -> loop2 m (addDigit n w) (BSU.unsafeTail xs) | otherwise -> m*10 + fromIntegral n - loop2 m n xs - | m `seq` n `seq` xs `seq` False = undefined + loop2 !m !n !xs | BS.null xs = m*100 + fromIntegral n | otherwise = case BSU.unsafeHead xs of w | isDecimal w -> loop3 m (addDigit n w) (BSU.unsafeTail xs) | otherwise -> m*100 + fromIntegral n - loop3 m n xs - | m `seq` n `seq` xs `seq` False = undefined + loop3 !m !n !xs | BS.null xs = m*1000 + fromIntegral n | otherwise = case BSU.unsafeHead xs of w | isDecimal w -> loop4 m (addDigit n w) (BSU.unsafeTail xs) | otherwise -> m*1000 + fromIntegral n - loop4 m n xs - | m `seq` n `seq` xs `seq` False = undefined + loop4 !m !n !xs | BS.null xs = m*10000 + fromIntegral n | otherwise = case BSU.unsafeHead xs of w | isDecimal w -> loop5 m (addDigit n w) (BSU.unsafeTail xs) | otherwise -> m*10000 + fromIntegral n - loop5 m n xs - | m `seq` n `seq` xs `seq` False = undefined + loop5 !m !n !xs | BS.null xs = m*100000 + fromIntegral n | otherwise = case BSU.unsafeHead xs of w | isDecimal w -> loop6 m (addDigit n w) (BSU.unsafeTail xs) | otherwise -> m*100000 + fromIntegral n - loop6 m n xs - | m `seq` n `seq` xs `seq` False = undefined + loop6 !m !n !xs | BS.null xs = m*1000000 + fromIntegral n | otherwise = case BSU.unsafeHead xs of w | isDecimal w -> loop7 m (addDigit n w) (BSU.unsafeTail xs) | otherwise -> m*1000000 + fromIntegral n - loop7 m n xs - | m `seq` n `seq` xs `seq` False = undefined + loop7 !m !n !xs | BS.null xs = m*10000000 + fromIntegral n | otherwise = case BSU.unsafeHead xs of w | isDecimal w -> loop8 m (addDigit n w) (BSU.unsafeTail xs) | otherwise -> m*10000000 + fromIntegral n - loop8 m n xs - | m `seq` n `seq` xs `seq` False = undefined + loop8 !m !n !xs | BS.null xs = m*100000000 + fromIntegral n | otherwise = case BSU.unsafeHead xs of @@ -346,6 +304,8 @@ -- This implementation is modified from: -- +-- See the banchmarks for implementation details. +-- BUG: the additional guard in 'numDecimalDigits' results in a 3x slowdown!! -- -- | Convert a non-negative integer into an (unsigned) ASCII decimal -- string. This function is unsafe to use on negative inputs. @@ -368,8 +328,7 @@ where getDigit = BSU.unsafeIndex packDecimal_digits - loop n p - | n `seq` p `seq` False = undefined -- for strictness analysis + loop !n !p | n >= 100 = do let (q,r) = n `quotRem` 100 write2 r p @@ -377,12 +336,10 @@ | n >= 10 = write2 n p | otherwise = poke p (0x30 + fromIntegral n) - write2 i0 p - | i0 `seq` p `seq` False = undefined -- for strictness analysis - | otherwise = do - let i = fromIntegral i0; j = i + i - poke p (getDigit $! j + 1) - poke (p `plusPtr` negate 1) (getDigit j) + write2 !i0 !p = do + let i = fromIntegral i0; j = i + i + poke p (getDigit $! j + 1) + poke (p `plusPtr` negate 1) (getDigit j) packDecimal_digits :: ByteString {-# NOINLINE packDecimal_digits #-} @@ -392,7 +349,7 @@ \4041424344454647484950515253545556575859\ \6061626364656667686970717273747576777879\ \8081828384858687888990919293949596979899" - -- BUG: syntax highlighting fail: -> + -- BUG: jEdit syntax highlighting fail: -> ---------------------------------------------------------------- ---------------------------------------------------------------- @@ -440,9 +397,8 @@ Just $ loop (fromIntegral (w-0x61+10)) (BSU.unsafeTail xs) | otherwise -> Nothing - loop n xs - | n `seq` xs `seq` False = undefined -- for strictness analysis - | BS.null xs = (n, BS.empty) -- not @xs@, to help GC + loop !n !xs + | BS.null xs = (n, BS.empty) -- not @xs@, to help GC | otherwise = case BSU.unsafeHead xs of w | 0x39 >= w && w >= 0x30 -> @@ -510,13 +466,11 @@ return () -- needed for type checking step :: Ptr Word8 -> Word8 -> IO (Ptr Word8) - step p w - | p `seq` w `seq` False = undefined -- for strictness analysis - | otherwise = do - let ix = fromIntegral w - poke p (BSU.unsafeIndex hexDigits ((ix .&. 0xF0) `shiftR` 4)) - poke (p `plusPtr` 1) (BSU.unsafeIndex hexDigits (ix .&. 0x0F)) - return (p `plusPtr` 2) + step !p !w = do + let ix = fromIntegral w + poke p (BSU.unsafeIndex hexDigits ((ix .&. 0xF0) `shiftR` 4)) + poke (p `plusPtr` 1) (BSU.unsafeIndex hexDigits (ix .&. 0x0F)) + return (p `plusPtr` 2) _asHexadecimal_overflow :: String {-# NOINLINE _asHexadecimal_overflow #-} @@ -539,8 +493,7 @@ foldIO f z0 (BSI.PS fp off len) = FFI.withForeignPtr fp $ \p0 -> do let q = p0 `plusPtr` (off+len) - let go z p - | z `seq` p `seq` False = undefined -- for strictness analysis + let go !z !p | p == q = return z | otherwise = do w <- peek p @@ -585,9 +538,8 @@ Just $ loop (fromIntegral (w - 0x30)) (BSU.unsafeTail xs) | otherwise -> Nothing - loop n xs - | n `seq` xs `seq` False = undefined -- for strictness analysis - | BS.null xs = (n, BS.empty) -- not @xs@, to help GC + loop !n !xs + | BS.null xs = (n, BS.empty) -- not @xs@, to help GC | otherwise = case BSU.unsafeHead xs of w | 0x37 >= w && w >= 0x30 -> diff --git a/src/Data/ByteString/Lex/Internal.hs b/src/Data/ByteString/Lex/Internal.hs --- a/src/Data/ByteString/Lex/Internal.hs +++ b/src/Data/ByteString/Lex/Internal.hs @@ -1,29 +1,65 @@ {-# OPTIONS_GHC -Wall -fwarn-tabs #-} +{-# LANGUAGE BangPatterns #-} ---------------------------------------------------------------- --- 2015.06.05 +-- 2015.06.11 -- | -- Module : Data.ByteString.Lex.Internal --- Copyright : Copyright (c) 2010--2015 wren gayle romano +-- Copyright : Copyright (c) 2010--2019 wren gayle romano -- License : BSD2 --- Maintainer : wren@community.haskell.org +-- Maintainer : wren@cpan.org -- Stability : provisional --- Portability : Haskell98 +-- Portability : BangPatterns -- --- Some functions we want to share across the other modules without actually exposing them to the user. +-- Some functions we want to share across the other modules without +-- actually exposing them to the user. ---------------------------------------------------------------- module Data.ByteString.Lex.Internal ( + -- * Character-based bit-bashing + isNotPeriod + , isNotE + , isDecimal + , isDecimalZero + , toDigit + , addDigit -- * Integral logarithms - numDigits + , numDigits , numTwoPowerDigits , numDecimalDigits ) where -import Data.Word (Word64) +import Data.Word (Word8, Word64) import Data.Bits (Bits(shiftR)) ---------------------------------------------------------------- ---------------------------------------------------------------- +----- Character-based bit-bashing + +{-# INLINE isNotPeriod #-} +isNotPeriod :: Word8 -> Bool +isNotPeriod w = w /= 0x2E + +{-# INLINE isNotE #-} +isNotE :: Word8 -> Bool +isNotE w = w /= 0x65 && w /= 0x45 + +{-# INLINE isDecimal #-} +isDecimal :: Word8 -> Bool +isDecimal w = 0x39 >= w && w >= 0x30 + +{-# INLINE isDecimalZero #-} +isDecimalZero :: Word8 -> Bool +isDecimalZero w = w == 0x30 + +{-# INLINE toDigit #-} +toDigit :: (Integral a) => Word8 -> a +toDigit w = fromIntegral (w - 0x30) + +{-# INLINE addDigit #-} +addDigit :: Int -> Word8 -> Int +addDigit n w = n * 10 + toDigit w + +---------------------------------------------------------------- ----- Integral logarithms -- TODO: cf. integer-gmp:GHC.Integer.Logarithms made available in version 0.3.0.0 (ships with GHC 7.2.1). @@ -53,13 +89,13 @@ numDigits :: Integer -> Integer -> Int {-# INLINE numDigits #-} -numDigits b0 n0 +numDigits !b0 !n0 | b0 <= 1 = error (_numDigits ++ _nonpositiveBase) | n0 < 0 = error (_numDigits ++ _negativeNumber) -- BUG: need to check n0 to be sure we won't overflow Int | otherwise = 1 + fst (ilog b0 n0) where - ilog b n + ilog !b !n | n < b = (0, n) | r < b = ((,) $! 2*e) r | otherwise = ((,) $! 2*e+1) $! (r `quot` b) @@ -74,15 +110,14 @@ -- for a more general implementation. numTwoPowerDigits :: (Integral a, Bits a) => Int -> a -> Int {-# INLINE numTwoPowerDigits #-} -numTwoPowerDigits p n0 +numTwoPowerDigits !p !n0 | p <= 0 = error (_numTwoPowerDigits ++ _nonpositiveBase) | n0 < 0 = error (_numTwoPowerDigits ++ _negativeNumber) | n0 == 0 = 1 -- BUG: need to check n0 to be sure we won't overflow Int | otherwise = go 0 n0 where - go d n - | d `seq` n `seq` False = undefined + go !d !n | n > 0 = go (d+1) (n `shiftR` p) | otherwise = d @@ -103,10 +138,9 @@ | otherwise = go 1 (fromIntegral n0 :: Word64) where limit = fromIntegral (maxBound :: Word64) - + fin n bound = if n >= bound then 1 else 0 - go k n - | k `seq` False = undefined -- For strictness analysis + go !k !n | n < 10 = k | n < 100 = k + 1 | n < 1000 = k + 2 diff --git a/test/Fractional.hs b/test/Fractional.hs new file mode 100644 --- /dev/null +++ b/test/Fractional.hs @@ -0,0 +1,248 @@ +{-# OPTIONS_GHC -Wall -fwarn-tabs #-} +{-# LANGUAGE RankNTypes, ScopedTypeVariables #-} +---------------------------------------------------------------- +-- 2015.06.11 +-- | +-- Module : test/Fractional +-- Copyright : Copyright (c) 2015 wren gayle romano +-- License : BSD2 +-- Maintainer : wren@community.haskell.org +-- Stability : test framework +-- Portability : ScopedTypeVariables + RankNTypes +-- +-- Correctness testing for "Data.ByteString.Lex.Fractional". +---------------------------------------------------------------- +module Fractional (main, tests) where + +import qualified Test.Tasty as Tasty +--import qualified Test.Tasty.SmallCheck as SC +import qualified Test.Tasty.QuickCheck as QC +import Data.ByteString (ByteString) +import qualified Data.ByteString as BS +import qualified Data.ByteString.Char8 as BS8 +import Data.ByteString.Lex.Fractional +--import Control.Monad ((<=<)) + +---------------------------------------------------------------- +---------------------------------------------------------------- +-- We reimplement Data.Proxy to avoid build errors on older systems + +data Proxy a = Proxy + +asProxyTypeOf :: a -> Proxy a -> a +asProxyTypeOf a _ = a + +---------------------------------------------------------------- +-- | Fuzzy equality checking for floating-point numbers. +(=~=) :: (Fractional a, Ord a) => a -> a -> Bool +(=~=) a b = a == b || abs (a - b) <= max (abs a) (abs b) * 1e20 + + +---------------------------------------------------------------- +----- QuickCheck\/SmallCheck properties +-- N.B., these properties do not hold of 'Rational', since those +-- are shown as @numerator % denominator@. + + +-- | Converting a non-negative number to a string using 'show' and +-- then reading it back using 'readDecimal' returns the original +-- number. +prop_readDecimal_show + :: (Show a, Ord a, Fractional a) => Proxy a -> Integer -> Bool +prop_readDecimal_show proxy x = + let px = abs x in + case (readDecimal . BS8.pack . show) px of + Nothing -> False + Just (py, rest) -> + BS.null rest && py =~= (fromInteger px `asProxyTypeOf` proxy) + + +-- | Converting a number to a string using 'show' and then reading +-- it back using @'readSigned' 'readDecimal'@ returns the original +-- number. +prop_readSignedDecimal_show + :: (Show a, Ord a, Fractional a) => Proxy a -> Integer -> Bool +prop_readSignedDecimal_show proxy x = + case (readSigned readDecimal . BS8.pack . show) x of + Nothing -> False + Just (y, rest) -> + BS.null rest && y =~= (fromInteger x `asProxyTypeOf` proxy) + +---------------------------------------------------------------- +-- | Converting a non-negative number to a string using 'show' and +-- then reading it back using 'readExponential' returns the original +-- number. +prop_readExponential_show :: (Show a, Ord a, Fractional a) => a -> Bool +prop_readExponential_show x = + let px = abs x in + case (readExponential . BS8.pack . show) px of + Nothing -> False + Just (py, rest) -> BS.null rest && px =~= py + + +-- | Converting a number to a string using 'show' and then reading +-- it back using @'readSigned' 'readExponential'@ returns the +-- original number. +prop_readSignedExponential_show + :: (Show a, Ord a, Fractional a) => a -> Bool +prop_readSignedExponential_show x = + case (readSigned readExponential . BS8.pack . show) x of + Nothing -> False + Just (y, rest) -> BS.null rest && x =~= y + +---------------------------------------------------------------- + +-- | Use \"infinity\" as the precision-limit for a reader. +atInfinity + :: (Int -> ByteString -> Maybe (a,ByteString)) + -> ByteString -> Maybe (a,ByteString) +atInfinity f = (\xs -> f (1 + BS.length xs) xs) + +-- | Use a 'RealFloat' type's inherent limit as the precision-limit +-- for a reader. +atInherent + :: forall a. RealFloat a + => (Int -> ByteString -> Maybe (a,ByteString)) + -> ByteString -> Maybe (a,ByteString) +atInherent f = f (decimalPrecision (Proxy::Proxy a)) + + +-- BUG: at Double, fails on 5.0e-324 +-- +-- | Converting a non-negative number to a string using 'show' and +-- then reading it back using 'readDecimalLimited' with an \"infinite\" +-- precision limit returns the original number. +prop_readDecimalLimitedInfinity_show + :: (Show a, Ord a, Fractional a) => Proxy a -> Integer -> Bool +prop_readDecimalLimitedInfinity_show proxy x = + let px = abs x in + case (atInfinity readDecimalLimited . BS8.pack . show) px of + Nothing -> False + Just (py, rest) -> + BS.null rest && py =~= (fromInteger px `asProxyTypeOf` proxy) + +-- | Converting a non-negative number to a string using 'show' and +-- then reading it back using 'readExponentialLimited' with an +-- \"infinite\" precision limit returns the original number. +prop_readExponentialLimitedInfinity_show + :: (Show a, Ord a, Fractional a) => a -> Bool +prop_readExponentialLimitedInfinity_show x = + let px = abs x in + case (atInfinity readExponentialLimited . BS8.pack . show) px of + Nothing -> False + Just (py, rest) -> BS.null rest && px =~= py + + +-- | Converting a non-negative number to a string using 'show' and +-- then reading it back using 'readDecimalLimited' with the type's +-- inherent precision limit returns the original number. +prop_readDecimalLimitedInherent_show + :: (Show a, Ord a, RealFloat a) => Proxy a -> Integer -> Bool +prop_readDecimalLimitedInherent_show proxy x = + let px = abs x in + case (atInherent readDecimalLimited . BS8.pack . show) px of + Nothing -> False + Just (py, rest) -> + BS.null rest && py =~= (fromInteger px `asProxyTypeOf` proxy) + +-- | Converting a non-negative number to a string using 'show' and +-- then reading it back using 'readExponentialLimited' with the +-- type's inherent precision limit returns the original number. +prop_readExponentialLimitedInherent_show + :: (Show a, Ord a, RealFloat a) => a -> Bool +prop_readExponentialLimitedInherent_show x = + let px = abs x in + case (atInherent readExponentialLimited . BS8.pack . show) px of + Nothing -> False + Just (py, rest) -> BS.null rest && px =~= py + +---------------------------------------------------------------- +---------------------------------------------------------------- +floatProxy :: Proxy Float +floatProxy = Proxy + +doubleProxy :: Proxy Double +doubleProxy = Proxy + +atFloat :: (Float -> a) -> Float -> a +atFloat = id + +atDouble :: (Double -> a) -> Double -> a +atDouble = id + +qc_testGroup_Proxy + :: QC.Testable b + => String + -> (forall a. (RealFloat a, Ord a, Show a) => Proxy a -> b) + -> Tasty.TestTree +qc_testGroup_Proxy n f = + Tasty.testGroup n + [ QC.testProperty "Float" $ f floatProxy + , QC.testProperty "Double" $ f doubleProxy + ] + +qc_testGroup_At + :: QC.Testable b + => String + -> (forall a. (RealFloat a, Ord a, Show a) => a -> b) + -> Tasty.TestTree +qc_testGroup_At n f = + Tasty.testGroup n + [ QC.testProperty "Float" $ atFloat f + , QC.testProperty "Double" $ atDouble f + ] + +---------------------------------------------------------------- +main :: IO () +main = Tasty.defaultMain tests + +tests :: Tasty.TestTree +tests = Tasty.testGroup "Fractional Tests" + [Tasty.testGroup "Properties" + [ quickcheckTests + , smallcheckTests + ] + -- TODO: add some HUnit tests + ] + + +quickcheckTests :: Tasty.TestTree +quickcheckTests = Tasty.testGroup "(checked by QuickCheck)" + [ qc_testGroup_Proxy + "prop_readDecimal_show" + prop_readDecimal_show + , qc_testGroup_Proxy + "prop_readSignedDecimal_show" + prop_readSignedDecimal_show + , qc_testGroup_At + "prop_readExponential_show" + prop_readExponential_show + , qc_testGroup_At + "prop_readSignedExponential_show" + prop_readSignedExponential_show + , qc_testGroup_Proxy + "prop_readDecimalLimitedInfinity_show" + prop_readDecimalLimitedInfinity_show + , qc_testGroup_At + "prop_readExponentialLimitedInfinity_show" + prop_readExponentialLimitedInfinity_show + , qc_testGroup_Proxy + "prop_readDecimalLimitedInherent_show" + prop_readDecimalLimitedInherent_show + , qc_testGroup_At + "prop_readExponentialLimitedInherent_show" + prop_readExponentialLimitedInherent_show + ] + + +-- TODO: how to properly utilize SmallCheck for this module? +-- TODO: how can we set a default 'SmallCheckDepth' while still allowing @--smallcheck-depth@ to override that default? +smallcheckTests :: Tasty.TestTree +smallcheckTests = + -- Tasty.localOption (SC.SmallCheckDepth (2 ^ (8 :: Int))) $ + Tasty.testGroup "(checked by SmallCheck)" + [ + ] + +---------------------------------------------------------------- +----------------------------------------------------------- fin. diff --git a/test/Integral.hs b/test/Integral.hs new file mode 100644 --- /dev/null +++ b/test/Integral.hs @@ -0,0 +1,227 @@ +{-# OPTIONS_GHC -Wall -fwarn-tabs #-} +{-# LANGUAGE RankNTypes, FlexibleContexts #-} +---------------------------------------------------------------- +-- 2015.06.11 +-- | +-- Module : test/Integral +-- Copyright : Copyright (c) 2010--2015 wren gayle romano +-- License : BSD2 +-- Maintainer : wren@community.haskell.org +-- Stability : test framework +-- Portability : FlexibleContexts + RankNTypes +-- +-- Correctness testing for "Data.ByteString.Lex.Integral". +---------------------------------------------------------------- +module Integral (main, tests) where + +import qualified Test.Tasty as Tasty +import qualified Test.Tasty.SmallCheck as SC +import qualified Test.Tasty.QuickCheck as QC +import Data.Int (Int32, Int64) +import Control.Monad ((<=<)) +import qualified Data.ByteString as BS +import qualified Data.ByteString.Char8 as BS8 +import Data.ByteString.Lex.Integral + +---------------------------------------------------------------- +---------------------------------------------------------------- +----- QuickCheck\/SmallCheck properties + +-- | Converting a non-negative number to a string using 'show' and +-- then reading it back using 'readDecimal' returns the original +-- number. +prop_readDecimal_show :: (Show a, Integral a) => a -> Bool +prop_readDecimal_show x = + let px = abs x + in Just (px, BS.empty) == (readDecimal . BS8.pack . show) px + + +-- | Converting a number to a string using 'show' and then reading +-- it back using @'readSigned' 'readDecimal'@ returns the original +-- number. +prop_readSignedDecimal_show :: (Show a, Integral a) => a -> Bool +prop_readSignedDecimal_show x = + Just (x, BS.empty) == (readSigned readDecimal . BS8.pack . show) x + + +-- | Converting a non-negative number to a string using 'show' and +-- then reading it back using 'readDecimal_' returns the original +-- number. +prop_readDecimalzu_show :: (Show a, Integral a) => a -> Bool +prop_readDecimalzu_show x = + let px = abs x + in px == (readDecimal_ . BS8.pack . show) px + + +-- | Converting a non-negative number to a bytestring using +-- 'packDecimal' and then reading it back using 'read' returns the +-- original number. +prop_read_packDecimal :: (Read a, Integral a) => a -> Bool +prop_read_packDecimal x = + let px = abs x + in px == (read . maybe "" BS8.unpack . packDecimal) px + + +-- | Converting a non-negative number to a string using 'packDecimal' +-- and then reading it back using 'readDecimal' returns the original +-- number. +prop_readDecimal_packDecimal :: (Show a, Integral a) => a -> Bool +prop_readDecimal_packDecimal x = + let px = abs x + in Just (px, BS.empty) == (readDecimal <=< packDecimal) px +-- TODO: how can we check the other composition with QC/SC? + +---------------------------------------------------------------- +-- | Converting a non-negative number to a string using 'packHexadecimal' +-- and then reading it back using 'readHexadecimal' returns the +-- original number. +prop_readHexadecimal_packHexadecimal :: (Show a, Integral a) => a -> Bool +prop_readHexadecimal_packHexadecimal x = + let px = abs x + in Just (px, BS.empty) == (readHexadecimal <=< packHexadecimal) px + +-- TODO: how can we check the other composition with QC/SC? + +---------------------------------------------------------------- +-- | Converting a non-negative number to a string using 'packOctal' +-- and then reading it back using 'readOctal' returns the original +-- number. +prop_readOctal_packOctal :: (Show a, Integral a) => a -> Bool +prop_readOctal_packOctal x = + let px = abs x + in Just (px, BS.empty) == (readOctal <=< packOctal) px + +-- TODO: how can we check the other composition with QC/SC? + +---------------------------------------------------------------- +{- +-- | A more obviously correct but much slower implementation than +-- the public one. +packDecimal :: (Integral a) => a -> Maybe ByteString +packDecimal = start + where + start n0 + | n0 < 0 = Nothing + | otherwise = Just $ loop n0 BS.empty + + loop !n !xs + | n <= 9 = BS.cons (0x30 + fromIntegral n) xs + | otherwise = + let (q,r) = n `quotRem` 10 + in loop q (BS.cons (0x30 + fromIntegral r) xs) +-} + +---------------------------------------------------------------- +---------------------------------------------------------------- + +atInt :: (Int -> a) -> Int -> a +atInt = id + +atInt32 :: (Int32 -> a) -> Int32 -> a +atInt32 = id + +atInt64 :: (Int64 -> a) -> Int64 -> a +atInt64 = id + +atInteger :: (Integer -> a) -> Integer -> a +atInteger = id + +-- | Test 'Integers' around the 'Int' boundary. This combinator is +-- for smallcheck. +intBoundary :: (Integer -> a) -> Integer -> a +intBoundary f x = f (x + fromIntegral (maxBound - 8 :: Int)) + + +qc_testGroup + :: QC.Testable b + => String + -> (forall a. (Integral a, Read a, Show a) => a -> b) + -> Tasty.TestTree +qc_testGroup n f = + Tasty.testGroup n + [ QC.testProperty "Int" $ atInt f + , QC.testProperty "Int32" $ atInt32 f + , QC.testProperty "Int64" $ atInt64 f + , QC.testProperty "Integer" $ atInteger f + ] + +sc_testGroup + :: SC.Testable IO b + => String + -> (forall a. (Integral a, Read a, Show a) => a -> b) + -> Tasty.TestTree +sc_testGroup n f = + Tasty.testGroup n + [ SC.testProperty "Int" $ atInt f + , SC.testProperty "IntBoundary" $ intBoundary f + ] + +---------------------------------------------------------------- +main :: IO () +main = Tasty.defaultMain tests + +tests :: Tasty.TestTree +tests = Tasty.testGroup "Integral Tests" + [Tasty.testGroup "Properties" + [ quickcheckTests + , smallcheckTests + ] + -- TODO: add some HUnit tests + ] + +quickcheckTests :: Tasty.TestTree +quickcheckTests = Tasty.testGroup "(checked by QuickCheck)" + [ qc_testGroup + "prop_readDecimal_show" + prop_readDecimal_show + , qc_testGroup + "prop_readDecimalzu_show" + prop_readDecimalzu_show + , qc_testGroup + "prop_readSignedDecimal_show" + prop_readSignedDecimal_show + , qc_testGroup + "prop_read_packDecimal" + prop_read_packDecimal + , qc_testGroup + "prop_readDecimal_packDecimal" + prop_readDecimal_packDecimal + , qc_testGroup + "prop_readHexadecimal_packHexadecimal" + prop_readHexadecimal_packHexadecimal + , qc_testGroup + "prop_readOctal_packOctal" + prop_readOctal_packOctal + ] + + +-- TODO: how can we set our default 'SmallCheckDepth' to 2^8 while still allowing @--smallcheck-depth@ to override that default? +smallcheckTests :: Tasty.TestTree +smallcheckTests = + Tasty.localOption (SC.SmallCheckDepth (2 ^ (8 :: Int))) $ + Tasty.testGroup "(checked by SmallCheck)" + [ sc_testGroup + "prop_readDecimal_show" + prop_readDecimal_show + , sc_testGroup + "prop_readDecimalzu_show" + prop_readDecimalzu_show + , sc_testGroup + "prop_readSignedDecimal_show" + prop_readSignedDecimal_show + , sc_testGroup + "prop_read_packDecimal" + prop_read_packDecimal + , sc_testGroup + "prop_readDecimal_packDecimal" + prop_readDecimal_packDecimal + , sc_testGroup + "prop_readHexadecimal_packHexadecimal" + prop_readHexadecimal_packHexadecimal + , sc_testGroup + "prop_readOctal_packOctal" + prop_readOctal_packOctal + ] + +---------------------------------------------------------------- +----------------------------------------------------------- fin. diff --git a/test/Main.hs b/test/Main.hs new file mode 100644 --- /dev/null +++ b/test/Main.hs @@ -0,0 +1,29 @@ +{-# OPTIONS_GHC -Wall -fwarn-tabs #-} +---------------------------------------------------------------- +-- 2015.06.11 +-- | +-- Module : test/Main +-- Copyright : Copyright (c) 2015 wren gayle romano +-- License : BSD2 +-- Maintainer : wren@community.haskell.org +-- Stability : benchmark +-- Portability : Haskell98 +-- +-- Run all the basic correctness tests. +---------------------------------------------------------------- +module Main (main) where +import qualified Test.Tasty as Tasty +import qualified Integral +import qualified Fractional + +---------------------------------------------------------------- +---------------------------------------------------------------- + +main :: IO () +main = Tasty.defaultMain . Tasty.testGroup "Main" $ + [ Integral.tests + , Fractional.tests + ] + +---------------------------------------------------------------- +----------------------------------------------------------- fin.