diff --git a/AUTHORS b/AUTHORS --- a/AUTHORS +++ b/AUTHORS @@ -12,3 +12,7 @@ Erik de Castro Lopo, Vincent Hanquez, and Christoph Breitkopf --- for excessive tweaking and benchmarking of the readDecimal function. + +Hirotomo Moriwaki --- for highlighting the inefficiency of the old + Alex-based parser by publishing bytestring-read. And for the + idea behind the new (v0.5.0) limited-precision parsers. diff --git a/CHANGELOG b/CHANGELOG --- a/CHANGELOG +++ b/CHANGELOG @@ -1,24 +1,56 @@ -0.4.3.1 (2014.03.07): +0.5.0.15 (2025-02-11): + - Updated version bounds for GHC 9.12 +0.5.0.14 (2024-08-29): + - Updating version bounds for the test suite, and factoring out + the `Common library-build-depends` stanza. +0.5.0.13 (2024-08-29): + - Updated version bounds for GHC 9.10 +0.5.0.11 (2023-11-15): + - Updated version bounds for base-4.19, bytestring-0.12, tasty-1.5 +0.5.0.10 (2023-03-19): + - Updated version bounds for GHC 9.6 +0.5.0.9 (2021-08-28): + - Updated version bounds for GHC 9.4 +0.5.0.8 (2021-11-02): + - Updated version bounds for GHC 9.2.1 +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): + - Cleaned up the README file +0.5.0 (2015-05-06): + - Corrected the License field in the .cabal file to say BSD2 (instead of BSD3) + - Data.ByteString.Lex.{Double,.Lazy.Double}: removed + - Data.ByteString.Lex.Fractional: added based on the inefficiency of the old Alex-based parsers, as demonstrated by Hirotomo Moriwaki's bytestring-read (v0.3.0). + +0.4.3.3 (2015-05-30): + - Moved VERSION to CHANGELOG +0.4.3.1 (2014-03-07): - Updated the .cabal file to require newer alex for newer ghc. -0.4.3 (2013.03.21): +0.4.3 (2013-03-21): - Data.ByteString.Lex.Integral: Corrected a segmentation fault in packDecimal. -0.4.2 (2013.03.20): +0.4.2 (2013-03-20): - Data.ByteString.Lex.Integral: Improved packDecimal. -0.4.1 (2012.00.00): +0.4.1 (2012-00-00): - Data.ByteString.Lex.Integral: Added buffer overflow check for asHexadecimal -0.4.0 (2012.02.03): +0.4.0 (2012-02-03): - Data.ByteString.Lex.Integral: added readDecimal_ -0.3.0 (2012.01.28): +0.3.0 (2012-01-28): - Added Data.ByteString.Lex.Integral - Converted repo to Darcs-2 hashed format. - wren ng thornton took over maintainership. -0.2.1 (2010.02.14): -0.2 (2008.10.15): +0.2.1 (2010-02-14): +0.2 (2008-10-15): - Add support for lexing lazy bytestrings. -0.1.2 (2008.07.23): -0.1.0.2 (2008.07.23): -0.1.0.1 (2008.07.19): -0.1.0 (2008.07.19): +0.1.2 (2008-07-23): +0.1.0.2 (2008-07-23): +0.1.0.1 (2008-07-19): +0.1.0 (2008-07-19): diff --git a/LICENSE b/LICENSE --- a/LICENSE +++ b/LICENSE @@ -1,4 +1,4 @@ -Copyright (c) wren gayle romano 2012--2013; Don Stewart 2008, 2010 +Copyright (c) wren gayle romano 2012--2015; Don Stewart 2008, 2010 All rights reserved. diff --git a/README b/README deleted file mode 100644 --- a/README +++ /dev/null @@ -1,39 +0,0 @@ -bytestring-lexing -================= - -This is a relatively simple package and should be easy to install. -It requires Alex for generating the Double lexers. Once that is -installed, 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, -it relies on some language extensions which have been accepted into -the Haskell standard following the Haskell98 report. All the required -language extensions are: - -FFI - ------------------------------------------------------------ fin. diff --git a/README.md b/README.md new file mode 100644 --- /dev/null +++ b/README.md @@ -0,0 +1,175 @@ +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](https://github.com/wrengr/bytestring-lexing/tree/master/bench/html) + + +## Install + +This is a simple package and should be easy to install. You should +be able to use the standard: + + $> cabal install bytestring-lexing + + +### Testing + +To run the test suite (without coverage information), you can use +the standard method (with `runhaskell Setup.hs` in lieu of `cabal`, +if necessary): + + $> cd bytestring-lexing + $> cabal configure --enable-tests + $> cabal build + $> cabal test + +If you want coverage information as well, there are a few options +depending on your version of Cabal. For modern cabal with v2/nix-style +builds, add `--enable-coverage` to the configure step, and the +results will be located at +`./dist-newstyle/build/$ARCH/$GHC/bytestring-lexing-$VERSION/opt/hpc/vanilla/html/bytestring-lexing-$VERSION/hpc_index.html`. +For v1/classic builds, add `--enable-coverage` to the configure +step and also add `--keep-tix-files` to the test step, and the +results are instead located at +`./dist/hpc/vanilla/html/bytestring-lexing-$VERSION/hpc_index.html`. +For very old versions of Cabal, you must use `--enable-library-coverage` +in lieu of `--enable-coverage`. + + +### 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](https://github.com/wrengr/bytestring-lexing/blob/master/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,88 +1,148 @@ +Cabal-Version: 2.2 +-- Cabal >=2.2 is required for: +-- +-- Since 2.1, the Cabal-Version must be the absolutely first thing +-- in the file, even before comments. Also, no longer uses ">=". +-- + ---------------------------------------------------------------- --- wren gayle romano ~ 2015.05.30 +-- wren gayle romano ~ 2025-02-11 ---------------------------------------------------------------- --- By and large Cabal >=1.2 is fine; but >= 1.6 gives tested-with: --- and source-repository:. -Cabal-Version: >= 1.6 -Build-Type: Simple - Name: bytestring-lexing -Version: 0.4.3.3 +Version: 0.5.0.15 +Build-Type: Simple Stability: provisional -Homepage: http://code.haskell.org/~wren/ +Homepage: https://wrengr.org/software/hackage.html +Bug-Reports: https://github.com/wrengr/bytestring-lexing/issues Author: wren gayle romano, Don Stewart -Maintainer: wren@community.haskell.org -Copyright: Copyright (c) 2012--2015 wren gayle romano, 2008--2011 Don Stewart -License: BSD3 +Maintainer: wren@cpan.org +Copyright: 2012–2025 wren romano, 2008–2011 Don Stewart +-- Cabal-2.2 requires us to say "BSD-3-Clause" not "BSD3" +License: BSD-3-Clause 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: - + -Tested-With: - GHC ==6.8.2, GHC ==6.10.1, GHC ==6.12.1, GHC ==7.0.3, GHC ==7.6.1, GHC == 7.8.0 +---------------------------------------------------------------- Extra-source-files: - AUTHORS, README, CHANGELOG + AUTHORS, CHANGELOG, README.md + +-- We only list here what is still being verified by CI: +-- +-- For older versions of GHC and older versions of this library, see: +-- +-- And if needed, you can try relaxing the lower bounds according to: +-- +Tested-With: + 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, + GHC ==9.2.4, + GHC ==9.4.8, + GHC ==9.6.5, + GHC ==9.8.2, + GHC ==9.10.1, + GHC ==9.12.1 + Source-Repository head - Type: darcs - Location: http://community.haskell.org/~wren/bytestring-lexing + Type: git + Location: https://github.com/wrengr/bytestring-lexing.git ---------------------------------------------------------------- -Flag base4 - Default: True - Description: base-4.0 emits "Prelude deprecated" messages in - order to get people to be explicit about which - version of base they use. -Flag splitBase - Default: True - Description: base-3.0 (GHC 6.8) broke out the packages: array, - bytestring, containers, directory, old-locale, - old-time, packedstring, pretty, process, random. -Flag bytestringInBase - Default: False - Description: The bytestring library was included in base-2.0 - and base-2.1.1, but for base-1.0 and base-3.0 it - was a separate package. ----------------------------------------------------------------- -Library - Hs-Source-Dirs: src - Exposed-Modules: Data.ByteString.Lex.Integral - Data.ByteString.Lex.Double - Data.ByteString.Lex.Lazy.Double - Other-Modules: Data.ByteString.Lex.Internal - - -- I think this is all that needs doing to get rid of the warnings? - if flag(base4) - Build-Depends: base >= 4 && < 5 - else - Build-Depends: base < 4 - - if flag(bytestringInBase) - Build-Depends: base >= 2.0 && < 2.2 - else - Build-Depends: base < 2.0 || >= 3, bytestring +-- This stanza requires Cabal>=2.2: +-- +-- While Cabal-2.2 only ships with GHC 8.4.1, the dependencies to +-- build it have essentially the same lower bounds as we do. (They +-- require bytestring>=0.9.2.1 and deepseq>=1.3) So users of older +-- GHC should still be able to compile it; and if they can't, then +-- they already can't compile this package. +-- +-- N.B., the "import:" field must be the first thing in a stanza. +Common library-build-depends + Default-Language: Haskell2010 + -- TODO(2021-10-23): bytestring 0.11.0.0 changed the internal + -- representation of ByteStrings to remove the offset. While + -- they do offer pattern synonyms for backwards combatibility, + -- we should re-verify that our code doesn't depend on the details. + -- + Build-Depends: base >= 4.9 && < 4.22 + , bytestring >= 0.10.8 && < 0.13 - if flag(splitBase) - Build-Depends: base >= 3 && < 5, bytestring, array - else - Build-Depends: base < 3 +Library + Import: library-build-depends + Ghc-Options: -O2 + Hs-Source-Dirs: src + Exposed-Modules: Data.ByteString.Lex.Integral + Data.ByteString.Lex.Fractional + Other-Modules: Data.ByteString.Lex.Internal - Ghc-Options: -O2 +---------------------------------------------------------------- +-- +-- 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. - -- bytestring-posn was added in alex >= 2.3 (2008) - -- GHC 7.8.2 requires alex >= 3.1.3... - if impl(ghc >= 7.8) - Build-Tools: alex >= 3.1.3 - else - Build-Tools: alex >= 2.3 +Test-Suite test-all + Import: library-build-depends + 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 our own library for the tests to use it; but + -- we must not give a version restriction lest Cabal give warnings. + -- There's also bug : + -- if we don't pass -any, then Cabal will fill in ">= 0 && <= $ThisVersion" + -- which will also give a warning. + Build-Depends: bytestring-lexing -any + , tasty >= 0.10.1.2 && < 1.6 + , tasty-smallcheck >= 0.8.0.1 && < 0.9 + , tasty-quickcheck >= 0.8.3.2 && < 0.12 + -- QuickCheck >= 2.10 && < 2.16 + -- 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/dist/build/Data/ByteString/Lex/Double.hs b/dist/build/Data/ByteString/Lex/Double.hs deleted file mode 100644 --- a/dist/build/Data/ByteString/Lex/Double.hs +++ /dev/null @@ -1,438 +0,0 @@ -{-# LANGUAGE CPP,MagicHash #-} -{-# LINE 1 "src/Data/ByteString/Lex/Double.x" #-} - --- Turn off some common warnings about Alex-generated code. --- {-# OPTIONS_GHC -Wall -fno-warn-tabs -fno-warn-missing-signatures #-} ----------------------------------------------------------------- --- 2012.01.25 --- | --- Module : Data.ByteString.Lex.Double --- Copyright : Copyright (c) 2008--2011 Don Stewart --- License : BSD2/MIT --- Maintainer : wren@community.haskell.org --- Stability : stable --- Portability : Haskell98 --- --- Efficiently parse floating point literals from a 'ByteString'. ----------------------------------------------------------------- - -module Data.ByteString.Lex.Double (readDouble, unsafeReadDouble) where - -import qualified Data.ByteString as B -import Data.ByteString.Internal -import Data.ByteString.Lex.Internal (strtod, c_strtod) -import qualified Data.ByteString.Unsafe as B - -import Foreign -import Foreign.C.Types -import Foreign.C.String ----------------------------------------------------------------- - -#if __GLASGOW_HASKELL__ >= 603 -#include "ghcconfig.h" -#elif defined(__GLASGOW_HASKELL__) -#include "config.h" -#endif -#if __GLASGOW_HASKELL__ >= 503 -import Data.Array -import Data.Char (ord) -import Data.Array.Base (unsafeAt) -#else -import Array -import Char (ord) -#endif -#if __GLASGOW_HASKELL__ >= 503 -import GHC.Exts -#else -import GlaExts -#endif -{-# LINE 1 "templates/wrappers.hs" #-} -{-# LINE 1 "templates/wrappers.hs" #-} -{-# LINE 1 "" #-} -{-# LINE 1 "" #-} -{-# LINE 1 "templates/wrappers.hs" #-} --- ----------------------------------------------------------------------------- --- Alex wrapper code. --- --- This code is in the PUBLIC DOMAIN; you may copy it freely and use --- it for any purpose whatsoever. - -import Data.Word (Word8) - - - - - - - - -import qualified Data.Char -import qualified Data.ByteString as ByteString -import qualified Data.ByteString.Internal as ByteString -import qualified Data.ByteString.Unsafe as ByteString - -{-# LINE 47 "templates/wrappers.hs" #-} - -type Byte = Word8 - --- ----------------------------------------------------------------------------- --- The input type - -{-# LINE 72 "templates/wrappers.hs" #-} - -{-# LINE 92 "templates/wrappers.hs" #-} - -{-# LINE 106 "templates/wrappers.hs" #-} - - -data AlexInput = AlexInput { alexChar :: {-# UNPACK #-}!Char - , alexStr :: {-# UNPACK #-}!ByteString.ByteString } - -alexInputPrevChar :: AlexInput -> Char -alexInputPrevChar = alexChar - -alexGetByte (AlexInput _ cs) - | ByteString.null cs = Nothing - | otherwise = Just $! (ByteString.head cs, AlexInput c cs') - where - (c,cs') = (ByteString.w2c (ByteString.unsafeHead cs) - , ByteString.unsafeTail cs) - - --- ----------------------------------------------------------------------------- --- Token positions - --- `Posn' records the location of a token in the input text. It has three --- fields: the address (number of chacaters preceding the token), line number --- and column of a token within the file. `start_pos' gives the position of the --- start of the file and `eof_pos' a standard encoding for the end of file. --- `move_pos' calculates the new position after traversing a given character, --- assuming the usual eight character tab stops. - -{-# LINE 144 "templates/wrappers.hs" #-} - --- ----------------------------------------------------------------------------- --- Default monad - -{-# LINE 242 "templates/wrappers.hs" #-} - - --- ----------------------------------------------------------------------------- --- Monad (with ByteString input) - -{-# LINE 333 "templates/wrappers.hs" #-} - - --- ----------------------------------------------------------------------------- --- Basic wrapper - -{-# LINE 360 "templates/wrappers.hs" #-} - - --- ----------------------------------------------------------------------------- --- Basic wrapper, ByteString version - -{-# LINE 378 "templates/wrappers.hs" #-} - - - --- alexScanTokens :: String -> [token] -alexScanTokens str = go (AlexInput '\n' str) - where go inp@(AlexInput _ str) = - case alexScan inp 0 of - AlexEOF -> [] - AlexError _ -> error "lexical error" - AlexSkip inp' len -> go inp' - AlexToken inp'@(AlexInput _ str') _ act -> act (ByteString.unsafeTake len str) : go inp' - where len = ByteString.length str - ByteString.length str' - - - - --- ----------------------------------------------------------------------------- --- Posn wrapper - --- Adds text positions to the basic model. - -{-# LINE 409 "templates/wrappers.hs" #-} - - --- ----------------------------------------------------------------------------- --- Posn wrapper, ByteString version - -{-# LINE 424 "templates/wrappers.hs" #-} - - --- ----------------------------------------------------------------------------- --- GScan wrapper - --- For compatibility with previous versions of Alex, and because we can. - -alex_base :: AlexAddr -alex_base = AlexA# "\xd6\xff\xff\xff\xe0\xff\xff\xff\xe8\xff\xff\xff\x04\x00\x00\x00\x0e\x00\x00\x00\x1f\x00\x00\x00\x27\x00\x00\x00\x40\x00\x00\x00\x69\x00\x00\x00"# - -alex_table :: AlexAddr -alex_table = AlexA# "\x00\x00\x04\x00\x00\x00\x04\x00\x00\x00\x00\x00\x07\x00\x08\x00\x08\x00\x08\x00\x08\x00\x08\x00\x08\x00\x08\x00\x08\x00\x08\x00\x05\x00\x05\x00\x05\x00\x05\x00\x05\x00\x05\x00\x05\x00\x05\x00\x06\x00\x06\x00\x06\x00\x06\x00\x06\x00\x06\x00\x06\x00\x06\x00\x06\x00\x06\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x06\x00\x06\x00\x06\x00\x06\x00\x06\x00\x06\x00\x03\x00\x00\x00\x03\x00\x00\x00\x00\x00\x08\x00\x08\x00\x08\x00\x08\x00\x08\x00\x08\x00\x08\x00\x08\x00\x08\x00\x08\x00\x07\x00\x08\x00\x08\x00\x08\x00\x08\x00\x08\x00\x08\x00\x08\x00\x08\x00\x08\x00\x00\x00\x06\x00\x06\x00\x06\x00\x06\x00\x06\x00\x06\x00\x05\x00\x05\x00\x05\x00\x05\x00\x05\x00\x05\x00\x05\x00\x05\x00\x06\x00\x06\x00\x06\x00\x06\x00\x06\x00\x06\x00\x06\x00\x06\x00\x06\x00\x06\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x06\x00\x06\x00\x06\x00\x06\x00\x06\x00\x06\x00\x03\x00\x00\x00\x08\x00\x08\x00\x08\x00\x08\x00\x08\x00\x08\x00\x08\x00\x08\x00\x08\x00\x08\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x03\x00\x00\x00\x00\x00\x06\x00\x06\x00\x06\x00\x06\x00\x06\x00\x06\x00\x00\x00\x01\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x03\x00\x02\x00\x08\x00\x08\x00\x08\x00\x08\x00\x08\x00\x08\x00\x08\x00\x08\x00\x08\x00\x08\x00\x00\x00\x00\x00\x03\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x03\x00\x01\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x02\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x03\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00"# - -alex_check :: AlexAddr -alex_check = AlexA# "\xff\xff\x2b\x00\xff\xff\x2d\x00\xff\xff\xff\xff\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\x37\x00\x38\x00\x39\x00\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\x37\x00\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\x37\x00\x38\x00\x39\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x41\x00\x42\x00\x43\x00\x44\x00\x45\x00\x46\x00\x2b\x00\xff\xff\x2d\x00\xff\xff\xff\xff\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\x37\x00\x38\x00\x39\x00\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\x37\x00\x38\x00\x39\x00\xff\xff\x61\x00\x62\x00\x63\x00\x64\x00\x65\x00\x66\x00\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\x37\x00\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\x37\x00\x38\x00\x39\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x41\x00\x42\x00\x43\x00\x44\x00\x45\x00\x46\x00\x2e\x00\xff\xff\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\x37\x00\x38\x00\x39\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x45\x00\xff\xff\xff\xff\x61\x00\x62\x00\x63\x00\x64\x00\x65\x00\x66\x00\xff\xff\x4f\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x2e\x00\x58\x00\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\x37\x00\x38\x00\x39\x00\xff\xff\xff\xff\x65\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x45\x00\x6f\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x78\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x65\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff"# - -alex_deflt :: AlexAddr -alex_deflt = AlexA# "\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff"# - -alex_accept = listArray (0::Int,8) [AlexAccNone,AlexAccNone,AlexAccNone,AlexAccNone,AlexAccNone,AlexAcc (alex_action_0),AlexAcc (alex_action_0),AlexAcc (alex_action_0),AlexAcc (alex_action_0)] -{-# LINE 53 "src/Data/ByteString/Lex/Double.x" #-} - - --- | Parse the initial portion of the ByteString as a Double precision --- floating point value. The expected form of the numeric literal --- is given by: --- --- * An optional '+' or '-' sign --- --- * Decimal digits, OR --- --- * 0 [oO] and a sequence of octal digits, OR --- --- * 0 [xX] and a sequence of hexadecimal digits, OR --- --- * An optional decimal point, followed by a sequence of decimal digits, --- --- * And an optional exponent --- --- The result is returned as a pair of a double-precision floating --- point value and the remaining input, or @Nothing@ should no parse --- be found. --- --- For example, to sum a file of floating point numbers, one per line, --- --- > import qualified Data.ByteString.Char8 as S --- > import qualified Data.ByteString.Unsafe as S --- > import Data.ByteString.Lex.Double --- > --- > main = print . go 0 =<< S.getContents --- > where --- > go n s = case readDouble s of --- > Nothing -> n --- > Just (k,rest) -> go (n+k) (S.tail rest) --- -readDouble :: ByteString -> Maybe (Double, ByteString) -readDouble str = case alexScan (AlexInput '\n' str) 0 of - AlexEOF -> Nothing - AlexError _ -> Nothing - AlexToken (AlexInput _ rest) n _ -> - case strtod (B.unsafeTake n str) of d -> d `seq` Just $! (d , rest) - ----------------------------------------------------------------- --- | Bare bones, unsafe wrapper for C's @strtod(3)@. This provides --- a non-copying direct parsing of Double values from a ByteString. --- It uses @strtod@ directly on the bytestring buffer. @strtod@ --- requires the string to be null terminated, or for a guarantee --- that parsing will find a floating point value before the end of --- the string. --- -unsafeReadDouble :: ByteString -> Maybe (Double, ByteString) -{-# INLINE unsafeReadDouble #-} -unsafeReadDouble b - | B.null b = Nothing - | otherwise = inlinePerformIO $ - alloca $ \resptr -> - B.unsafeUseAsCString b $ \ptr -> do -- copy just the bytes we want to parse --- resetErrno - d <- c_strtod ptr resptr -- --- err <- getErrno - newPtr <- peek resptr - return $! case d of - 0 | newPtr == ptr -> Nothing --- _ | err == eRANGE -> Nothing -- adds 10% overhead - _ | otherwise -> - let rest = B.unsafeDrop (newPtr `minusPtr` ptr) b - z = realToFrac d - in z `seq` rest `seq` Just $! (z, rest) - - -alex_action_0 = strtod -{-# LINE 1 "templates/GenericTemplate.hs" #-} -{-# LINE 1 "templates/GenericTemplate.hs" #-} -{-# LINE 1 "" #-} -{-# LINE 1 "" #-} -{-# LINE 1 "templates/GenericTemplate.hs" #-} --- ----------------------------------------------------------------------------- --- ALEX TEMPLATE --- --- This code is in the PUBLIC DOMAIN; you may copy it freely and use --- it for any purpose whatsoever. - --- ----------------------------------------------------------------------------- --- INTERNALS and main scanner engine - -{-# LINE 21 "templates/GenericTemplate.hs" #-} - - - - - --- Do not remove this comment. Required to fix CPP parsing when using GCC and a clang-compiled alex. -#if __GLASGOW_HASKELL__ > 706 -#define GTE(n,m) (tagToEnum# (n >=# m)) -#define EQ(n,m) (tagToEnum# (n ==# m)) -#else -#define GTE(n,m) (n >=# m) -#define EQ(n,m) (n ==# m) -#endif -{-# LINE 51 "templates/GenericTemplate.hs" #-} - - -data AlexAddr = AlexA# Addr# --- Do not remove this comment. Required to fix CPP parsing when using GCC and a clang-compiled alex. -#if __GLASGOW_HASKELL__ < 503 -uncheckedShiftL# = shiftL# -#endif - -{-# INLINE alexIndexInt16OffAddr #-} -alexIndexInt16OffAddr (AlexA# arr) off = -#ifdef WORDS_BIGENDIAN - narrow16Int# i - where - i = word2Int# ((high `uncheckedShiftL#` 8#) `or#` low) - high = int2Word# (ord# (indexCharOffAddr# arr (off' +# 1#))) - low = int2Word# (ord# (indexCharOffAddr# arr off')) - off' = off *# 2# -#else - indexInt16OffAddr# arr off -#endif - - - - - -{-# INLINE alexIndexInt32OffAddr #-} -alexIndexInt32OffAddr (AlexA# arr) off = -#ifdef WORDS_BIGENDIAN - narrow32Int# i - where - i = word2Int# ((b3 `uncheckedShiftL#` 24#) `or#` - (b2 `uncheckedShiftL#` 16#) `or#` - (b1 `uncheckedShiftL#` 8#) `or#` b0) - b3 = int2Word# (ord# (indexCharOffAddr# arr (off' +# 3#))) - b2 = int2Word# (ord# (indexCharOffAddr# arr (off' +# 2#))) - b1 = int2Word# (ord# (indexCharOffAddr# arr (off' +# 1#))) - b0 = int2Word# (ord# (indexCharOffAddr# arr off')) - off' = off *# 4# -#else - indexInt32OffAddr# arr off -#endif - - - - - - -#if __GLASGOW_HASKELL__ < 503 -quickIndex arr i = arr ! i -#else --- GHC >= 503, unsafeAt is available from Data.Array.Base. -quickIndex = unsafeAt -#endif - - - - --- ----------------------------------------------------------------------------- --- Main lexing routines - -data AlexReturn a - = AlexEOF - | AlexError !AlexInput - | AlexSkip !AlexInput !Int - | AlexToken !AlexInput !Int a - --- alexScan :: AlexInput -> StartCode -> AlexReturn a -alexScan input (I# (sc)) - = alexScanUser undefined input (I# (sc)) - -alexScanUser user input (I# (sc)) - = case alex_scan_tkn user input 0# input sc AlexNone of - (AlexNone, input') -> - case alexGetByte input of - Nothing -> - - - - AlexEOF - Just _ -> - - - - AlexError input' - - (AlexLastSkip input'' len, _) -> - - - - AlexSkip input'' len - - (AlexLastAcc k input''' len, _) -> - - - - AlexToken input''' len k - - --- Push the input through the DFA, remembering the most recent accepting --- state it encountered. - -alex_scan_tkn user orig_input len input s last_acc = - input `seq` -- strict in the input - let - new_acc = (check_accs (alex_accept `quickIndex` (I# (s)))) - in - new_acc `seq` - case alexGetByte input of - Nothing -> (new_acc, input) - Just (c, new_input) -> - - - - case fromIntegral c of { (I# (ord_c)) -> - let - base = alexIndexInt32OffAddr alex_base s - offset = (base +# ord_c) - check = alexIndexInt16OffAddr alex_check offset - - new_s = if GTE(offset,0#) && EQ(check,ord_c) - then alexIndexInt16OffAddr alex_table offset - else alexIndexInt16OffAddr alex_deflt s - in - case new_s of - -1# -> (new_acc, input) - -- on an error, we want to keep the input *before* the - -- character that failed, not after. - _ -> alex_scan_tkn user orig_input (if c < 0x80 || c >= 0xC0 then (len +# 1#) else len) - -- note that the length is increased ONLY if this is the 1st byte in a char encoding) - new_input new_s new_acc - } - where - check_accs (AlexAccNone) = last_acc - check_accs (AlexAcc a ) = AlexLastAcc a input (I# (len)) - check_accs (AlexAccSkip) = AlexLastSkip input (I# (len)) -{-# LINE 198 "templates/GenericTemplate.hs" #-} - -data AlexLastAcc a - = AlexNone - | AlexLastAcc a !AlexInput !Int - | AlexLastSkip !AlexInput !Int - -instance Functor AlexLastAcc where - fmap f AlexNone = AlexNone - fmap f (AlexLastAcc x y z) = AlexLastAcc (f x) y z - fmap f (AlexLastSkip x y) = AlexLastSkip x y - -data AlexAcc a user - = AlexAccNone - | AlexAcc a - | AlexAccSkip -{-# LINE 242 "templates/GenericTemplate.hs" #-} - --- used by wrappers -iUnbox (I# (i)) = i diff --git a/dist/build/Data/ByteString/Lex/Lazy/Double.hs b/dist/build/Data/ByteString/Lex/Lazy/Double.hs deleted file mode 100644 --- a/dist/build/Data/ByteString/Lex/Lazy/Double.hs +++ /dev/null @@ -1,400 +0,0 @@ -{-# LANGUAGE CPP,MagicHash #-} -{-# LINE 1 "src/Data/ByteString/Lex/Lazy/Double.x" #-} - --- Turn off some common warnings about Alex-generated code. --- {-# OPTIONS_GHC -Wall -fno-warn-tabs -fno-warn-missing-signatures #-} ----------------------------------------------------------------- --- 2012.01.25 --- | --- Module : Data.ByteString.Lex.Lazy.Double --- Copyright : Copyright (c) 2008--2011 Don Stewart --- License : BSD2/MIT --- Maintainer : wren@community.haskell.org --- Stability : stable --- Portability : Haskell98 --- --- Efficiently parse floating point literals from a 'ByteString'. ----------------------------------------------------------------- - -module Data.ByteString.Lex.Lazy.Double (readDouble) where - -import qualified Data.ByteString.Lazy as LB -import qualified Data.ByteString as SB -import Data.ByteString.Lex.Internal (strtod) ----------------------------------------------------------------- - -#if __GLASGOW_HASKELL__ >= 603 -#include "ghcconfig.h" -#elif defined(__GLASGOW_HASKELL__) -#include "config.h" -#endif -#if __GLASGOW_HASKELL__ >= 503 -import Data.Array -import Data.Char (ord) -import Data.Array.Base (unsafeAt) -#else -import Array -import Char (ord) -#endif -#if __GLASGOW_HASKELL__ >= 503 -import GHC.Exts -#else -import GlaExts -#endif -{-# LINE 1 "templates/wrappers.hs" #-} -{-# LINE 1 "templates/wrappers.hs" #-} -{-# LINE 1 "" #-} -{-# LINE 1 "" #-} -{-# LINE 1 "templates/wrappers.hs" #-} --- ----------------------------------------------------------------------------- --- Alex wrapper code. --- --- This code is in the PUBLIC DOMAIN; you may copy it freely and use --- it for any purpose whatsoever. - -import Data.Word (Word8) - - -import qualified Data.Char -import qualified Data.ByteString.Lazy as ByteString -import qualified Data.ByteString.Internal as ByteString (w2c) - -{-# LINE 47 "templates/wrappers.hs" #-} - -type Byte = Word8 - --- ----------------------------------------------------------------------------- --- The input type - -{-# LINE 72 "templates/wrappers.hs" #-} - -{-# LINE 92 "templates/wrappers.hs" #-} - - -type AlexInput = (Char, - ByteString.ByteString) - -alexInputPrevChar :: AlexInput -> Char -alexInputPrevChar (c,_) = c - -alexGetByte (_, cs) - | ByteString.null cs = Nothing - | otherwise = Just (ByteString.head cs, - (ByteString.w2c $ ByteString.head cs, - ByteString.tail cs)) - - -{-# LINE 121 "templates/wrappers.hs" #-} - --- ----------------------------------------------------------------------------- --- Token positions - --- `Posn' records the location of a token in the input text. It has three --- fields: the address (number of chacaters preceding the token), line number --- and column of a token within the file. `start_pos' gives the position of the --- start of the file and `eof_pos' a standard encoding for the end of file. --- `move_pos' calculates the new position after traversing a given character, --- assuming the usual eight character tab stops. - -{-# LINE 144 "templates/wrappers.hs" #-} - --- ----------------------------------------------------------------------------- --- Default monad - -{-# LINE 242 "templates/wrappers.hs" #-} - - --- ----------------------------------------------------------------------------- --- Monad (with ByteString input) - -{-# LINE 333 "templates/wrappers.hs" #-} - - --- ----------------------------------------------------------------------------- --- Basic wrapper - -{-# LINE 360 "templates/wrappers.hs" #-} - - --- ----------------------------------------------------------------------------- --- Basic wrapper, ByteString version - - - --- alexScanTokens :: String -> [token] -alexScanTokens str = go ('\n',str) - where go inp@(_,str) = - case alexScan inp 0 of - AlexEOF -> [] - AlexError _ -> error "lexical error" - AlexSkip inp' len -> go inp' - AlexToken inp'@(_,str') _ act -> act (ByteString.take len str) : go inp' - where len = ByteString.length str - ByteString.length str' - - - -{-# LINE 392 "templates/wrappers.hs" #-} - - --- ----------------------------------------------------------------------------- --- Posn wrapper - --- Adds text positions to the basic model. - -{-# LINE 409 "templates/wrappers.hs" #-} - - --- ----------------------------------------------------------------------------- --- Posn wrapper, ByteString version - -{-# LINE 424 "templates/wrappers.hs" #-} - - --- ----------------------------------------------------------------------------- --- GScan wrapper - --- For compatibility with previous versions of Alex, and because we can. - -alex_base :: AlexAddr -alex_base = AlexA# "\xd6\xff\xff\xff\xe0\xff\xff\xff\xe8\xff\xff\xff\x04\x00\x00\x00\x0e\x00\x00\x00\x1f\x00\x00\x00\x27\x00\x00\x00\x40\x00\x00\x00\x69\x00\x00\x00"# - -alex_table :: AlexAddr -alex_table = AlexA# "\x00\x00\x04\x00\x00\x00\x04\x00\x00\x00\x00\x00\x07\x00\x08\x00\x08\x00\x08\x00\x08\x00\x08\x00\x08\x00\x08\x00\x08\x00\x08\x00\x05\x00\x05\x00\x05\x00\x05\x00\x05\x00\x05\x00\x05\x00\x05\x00\x06\x00\x06\x00\x06\x00\x06\x00\x06\x00\x06\x00\x06\x00\x06\x00\x06\x00\x06\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x06\x00\x06\x00\x06\x00\x06\x00\x06\x00\x06\x00\x03\x00\x00\x00\x03\x00\x00\x00\x00\x00\x08\x00\x08\x00\x08\x00\x08\x00\x08\x00\x08\x00\x08\x00\x08\x00\x08\x00\x08\x00\x07\x00\x08\x00\x08\x00\x08\x00\x08\x00\x08\x00\x08\x00\x08\x00\x08\x00\x08\x00\x00\x00\x06\x00\x06\x00\x06\x00\x06\x00\x06\x00\x06\x00\x05\x00\x05\x00\x05\x00\x05\x00\x05\x00\x05\x00\x05\x00\x05\x00\x06\x00\x06\x00\x06\x00\x06\x00\x06\x00\x06\x00\x06\x00\x06\x00\x06\x00\x06\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x06\x00\x06\x00\x06\x00\x06\x00\x06\x00\x06\x00\x03\x00\x00\x00\x08\x00\x08\x00\x08\x00\x08\x00\x08\x00\x08\x00\x08\x00\x08\x00\x08\x00\x08\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x03\x00\x00\x00\x00\x00\x06\x00\x06\x00\x06\x00\x06\x00\x06\x00\x06\x00\x00\x00\x01\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x03\x00\x02\x00\x08\x00\x08\x00\x08\x00\x08\x00\x08\x00\x08\x00\x08\x00\x08\x00\x08\x00\x08\x00\x00\x00\x00\x00\x03\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x03\x00\x01\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x02\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x03\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00"# - -alex_check :: AlexAddr -alex_check = AlexA# "\xff\xff\x2b\x00\xff\xff\x2d\x00\xff\xff\xff\xff\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\x37\x00\x38\x00\x39\x00\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\x37\x00\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\x37\x00\x38\x00\x39\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x41\x00\x42\x00\x43\x00\x44\x00\x45\x00\x46\x00\x2b\x00\xff\xff\x2d\x00\xff\xff\xff\xff\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\x37\x00\x38\x00\x39\x00\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\x37\x00\x38\x00\x39\x00\xff\xff\x61\x00\x62\x00\x63\x00\x64\x00\x65\x00\x66\x00\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\x37\x00\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\x37\x00\x38\x00\x39\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x41\x00\x42\x00\x43\x00\x44\x00\x45\x00\x46\x00\x2e\x00\xff\xff\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\x37\x00\x38\x00\x39\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x45\x00\xff\xff\xff\xff\x61\x00\x62\x00\x63\x00\x64\x00\x65\x00\x66\x00\xff\xff\x4f\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x2e\x00\x58\x00\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\x37\x00\x38\x00\x39\x00\xff\xff\xff\xff\x65\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x45\x00\x6f\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x78\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x65\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff"# - -alex_deflt :: AlexAddr -alex_deflt = AlexA# "\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff"# - -alex_accept = listArray (0::Int,8) [AlexAccNone,AlexAccNone,AlexAccNone,AlexAccNone,AlexAccNone,AlexAcc (alex_action_0),AlexAcc (alex_action_0),AlexAcc (alex_action_0),AlexAcc (alex_action_0)] -{-# LINE 48 "src/Data/ByteString/Lex/Lazy/Double.x" #-} - - --- | Parse the initial portion of the ByteString as a Double precision --- floating point value. The expected form of the numeric literal --- is given by: --- --- * An optional '+' or '-' sign --- --- * Decimal digits, OR --- --- * 0 [oO] and a sequence of octal digits, OR --- --- * 0 [xX] and a sequence of hexadecimal digits, OR --- --- * An optional decimal point, followed by a sequence of decimal digits, --- --- * And an optional exponent --- --- The result is returned as a pair of a double-precision floating --- point value and the remaining input, or @Nothing@ should no parse --- be found. --- --- For example, to sum a file of floating point numbers, one per line, --- --- > import qualified Data.ByteString.Char8 as S --- > import qualified Data.ByteString.Unsafe as S --- > import Data.ByteString.Lex.Double --- > --- > main = print . go 0 =<< S.getContents --- > where --- > go n s = case readDouble s of --- > Nothing -> n --- > Just (k,rest) -> go (n+k) (S.tail rest) --- -readDouble :: LB.ByteString -> Maybe (Double, LB.ByteString) -readDouble str = case alexScan ('\n', str) 0 of - AlexEOF -> Nothing - AlexError _ -> Nothing - AlexToken (_, rest) n _ -> - case strtod . strict . LB.take (fromIntegral n) $ str of - d -> Just $! (d , rest) - -strict = SB.concat . LB.toChunks - -alex_action_0 = strtod . strict -{-# LINE 1 "templates/GenericTemplate.hs" #-} -{-# LINE 1 "templates/GenericTemplate.hs" #-} -{-# LINE 1 "" #-} -{-# LINE 1 "" #-} -{-# LINE 1 "templates/GenericTemplate.hs" #-} --- ----------------------------------------------------------------------------- --- ALEX TEMPLATE --- --- This code is in the PUBLIC DOMAIN; you may copy it freely and use --- it for any purpose whatsoever. - --- ----------------------------------------------------------------------------- --- INTERNALS and main scanner engine - -{-# LINE 21 "templates/GenericTemplate.hs" #-} - - - - - --- Do not remove this comment. Required to fix CPP parsing when using GCC and a clang-compiled alex. -#if __GLASGOW_HASKELL__ > 706 -#define GTE(n,m) (tagToEnum# (n >=# m)) -#define EQ(n,m) (tagToEnum# (n ==# m)) -#else -#define GTE(n,m) (n >=# m) -#define EQ(n,m) (n ==# m) -#endif -{-# LINE 51 "templates/GenericTemplate.hs" #-} - - -data AlexAddr = AlexA# Addr# --- Do not remove this comment. Required to fix CPP parsing when using GCC and a clang-compiled alex. -#if __GLASGOW_HASKELL__ < 503 -uncheckedShiftL# = shiftL# -#endif - -{-# INLINE alexIndexInt16OffAddr #-} -alexIndexInt16OffAddr (AlexA# arr) off = -#ifdef WORDS_BIGENDIAN - narrow16Int# i - where - i = word2Int# ((high `uncheckedShiftL#` 8#) `or#` low) - high = int2Word# (ord# (indexCharOffAddr# arr (off' +# 1#))) - low = int2Word# (ord# (indexCharOffAddr# arr off')) - off' = off *# 2# -#else - indexInt16OffAddr# arr off -#endif - - - - - -{-# INLINE alexIndexInt32OffAddr #-} -alexIndexInt32OffAddr (AlexA# arr) off = -#ifdef WORDS_BIGENDIAN - narrow32Int# i - where - i = word2Int# ((b3 `uncheckedShiftL#` 24#) `or#` - (b2 `uncheckedShiftL#` 16#) `or#` - (b1 `uncheckedShiftL#` 8#) `or#` b0) - b3 = int2Word# (ord# (indexCharOffAddr# arr (off' +# 3#))) - b2 = int2Word# (ord# (indexCharOffAddr# arr (off' +# 2#))) - b1 = int2Word# (ord# (indexCharOffAddr# arr (off' +# 1#))) - b0 = int2Word# (ord# (indexCharOffAddr# arr off')) - off' = off *# 4# -#else - indexInt32OffAddr# arr off -#endif - - - - - - -#if __GLASGOW_HASKELL__ < 503 -quickIndex arr i = arr ! i -#else --- GHC >= 503, unsafeAt is available from Data.Array.Base. -quickIndex = unsafeAt -#endif - - - - --- ----------------------------------------------------------------------------- --- Main lexing routines - -data AlexReturn a - = AlexEOF - | AlexError !AlexInput - | AlexSkip !AlexInput !Int - | AlexToken !AlexInput !Int a - --- alexScan :: AlexInput -> StartCode -> AlexReturn a -alexScan input (I# (sc)) - = alexScanUser undefined input (I# (sc)) - -alexScanUser user input (I# (sc)) - = case alex_scan_tkn user input 0# input sc AlexNone of - (AlexNone, input') -> - case alexGetByte input of - Nothing -> - - - - AlexEOF - Just _ -> - - - - AlexError input' - - (AlexLastSkip input'' len, _) -> - - - - AlexSkip input'' len - - (AlexLastAcc k input''' len, _) -> - - - - AlexToken input''' len k - - --- Push the input through the DFA, remembering the most recent accepting --- state it encountered. - -alex_scan_tkn user orig_input len input s last_acc = - input `seq` -- strict in the input - let - new_acc = (check_accs (alex_accept `quickIndex` (I# (s)))) - in - new_acc `seq` - case alexGetByte input of - Nothing -> (new_acc, input) - Just (c, new_input) -> - - - - case fromIntegral c of { (I# (ord_c)) -> - let - base = alexIndexInt32OffAddr alex_base s - offset = (base +# ord_c) - check = alexIndexInt16OffAddr alex_check offset - - new_s = if GTE(offset,0#) && EQ(check,ord_c) - then alexIndexInt16OffAddr alex_table offset - else alexIndexInt16OffAddr alex_deflt s - in - case new_s of - -1# -> (new_acc, input) - -- on an error, we want to keep the input *before* the - -- character that failed, not after. - _ -> alex_scan_tkn user orig_input (if c < 0x80 || c >= 0xC0 then (len +# 1#) else len) - -- note that the length is increased ONLY if this is the 1st byte in a char encoding) - new_input new_s new_acc - } - where - check_accs (AlexAccNone) = last_acc - check_accs (AlexAcc a ) = AlexLastAcc a input (I# (len)) - check_accs (AlexAccSkip) = AlexLastSkip input (I# (len)) -{-# LINE 198 "templates/GenericTemplate.hs" #-} - -data AlexLastAcc a - = AlexNone - | AlexLastAcc a !AlexInput !Int - | AlexLastSkip !AlexInput !Int - -instance Functor AlexLastAcc where - fmap f AlexNone = AlexNone - fmap f (AlexLastAcc x y z) = AlexLastAcc (f x) y z - fmap f (AlexLastSkip x y) = AlexLastSkip x y - -data AlexAcc a user - = AlexAccNone - | AlexAcc a - | AlexAccSkip -{-# LINE 242 "templates/GenericTemplate.hs" #-} - --- used by wrappers -iUnbox (I# (i)) = i diff --git a/src/Data/ByteString/Lex/Double.x b/src/Data/ByteString/Lex/Double.x deleted file mode 100644 --- a/src/Data/ByteString/Lex/Double.x +++ /dev/null @@ -1,121 +0,0 @@ -{ --- Turn off some common warnings about Alex-generated code. --- {-# OPTIONS_GHC -Wall -fno-warn-tabs -fno-warn-missing-signatures #-} ----------------------------------------------------------------- --- 2012.01.25 --- | --- Module : Data.ByteString.Lex.Double --- Copyright : Copyright (c) 2008--2011 Don Stewart --- License : BSD2/MIT --- Maintainer : wren@community.haskell.org --- Stability : stable --- Portability : Haskell98 --- --- Efficiently parse floating point literals from a 'ByteString'. ----------------------------------------------------------------- - -module Data.ByteString.Lex.Double (readDouble, unsafeReadDouble) where - -import qualified Data.ByteString as B -import Data.ByteString.Internal -import Data.ByteString.Lex.Internal (strtod, c_strtod) -import qualified Data.ByteString.Unsafe as B - -import Foreign -import Foreign.C.Types -import Foreign.C.String ----------------------------------------------------------------- -} - -%wrapper "strict-bytestring" - -$space = [\ \t\xa0] -$digit = 0-9 -$octit = 0-7 -$hexit = [$digit A-F a-f] - -@sign = [\-\+] -@decimal = $digit+ -@octal = $octit+ -@hexadecimal = $hexit+ -@exponent = [eE] [\-\+]? @decimal - -@number = @decimal - | @decimal \. @decimal @exponent? - | @decimal @exponent - | 0[oO] @octal - | 0[xX] @hexadecimal - -lex :- - -@sign? @number { strtod } - -{ - --- | Parse the initial portion of the ByteString as a Double precision --- floating point value. The expected form of the numeric literal --- is given by: --- --- * An optional '+' or '-' sign --- --- * Decimal digits, OR --- --- * 0 [oO] and a sequence of octal digits, OR --- --- * 0 [xX] and a sequence of hexadecimal digits, OR --- --- * An optional decimal point, followed by a sequence of decimal digits, --- --- * And an optional exponent --- --- The result is returned as a pair of a double-precision floating --- point value and the remaining input, or @Nothing@ should no parse --- be found. --- --- For example, to sum a file of floating point numbers, one per line, --- --- > import qualified Data.ByteString.Char8 as S --- > import qualified Data.ByteString.Unsafe as S --- > import Data.ByteString.Lex.Double --- > --- > main = print . go 0 =<< S.getContents --- > where --- > go n s = case readDouble s of --- > Nothing -> n --- > Just (k,rest) -> go (n+k) (S.tail rest) --- -readDouble :: ByteString -> Maybe (Double, ByteString) -readDouble str = case alexScan (AlexInput '\n' str) 0 of - AlexEOF -> Nothing - AlexError _ -> Nothing - AlexToken (AlexInput _ rest) n _ -> - case strtod (B.unsafeTake n str) of d -> d `seq` Just $! (d , rest) - ----------------------------------------------------------------- --- | Bare bones, unsafe wrapper for C's @strtod(3)@. This provides --- a non-copying direct parsing of Double values from a ByteString. --- It uses @strtod@ directly on the bytestring buffer. @strtod@ --- requires the string to be null terminated, or for a guarantee --- that parsing will find a floating point value before the end of --- the string. --- -unsafeReadDouble :: ByteString -> Maybe (Double, ByteString) -{-# INLINE unsafeReadDouble #-} -unsafeReadDouble b - | B.null b = Nothing - | otherwise = inlinePerformIO $ - alloca $ \resptr -> - B.unsafeUseAsCString b $ \ptr -> do -- copy just the bytes we want to parse --- resetErrno - d <- c_strtod ptr resptr -- --- err <- getErrno - newPtr <- peek resptr - return $! case d of - 0 | newPtr == ptr -> Nothing --- _ | err == eRANGE -> Nothing -- adds 10% overhead - _ | otherwise -> - let rest = B.unsafeDrop (newPtr `minusPtr` ptr) b - z = realToFrac d - in z `seq` rest `seq` Just $! (z, rest) - -} diff --git a/src/Data/ByteString/Lex/Fractional.hs b/src/Data/ByteString/Lex/Fractional.hs new file mode 100644 --- /dev/null +++ b/src/Data/ByteString/Lex/Fractional.hs @@ -0,0 +1,448 @@ +{-# OPTIONS_GHC -Wall -fwarn-tabs #-} +{-# LANGUAGE BangPatterns, ScopedTypeVariables #-} +---------------------------------------------------------------- +-- 2021.10.17 +-- | +-- Module : Data.ByteString.Lex.Fractional +-- Copyright : Copyright (c) 2015--2021 wren gayle romano +-- License : BSD2 +-- Maintainer : wren@cpan.org +-- Stability : provisional +-- Portability : BangPatterns + ScopedTypeVariables +-- +-- Functions for parsing and producing 'Fractional' values from\/to +-- 'ByteString's based on the \"Char8\" encoding. That is, we assume +-- an ASCII-compatible encoding of alphanumeric characters. +-- +-- /Since: 0.5.0/ +---------------------------------------------------------------- +module Data.ByteString.Lex.Fractional + ( + -- * General combinators + readSigned + -- packSigned + -- * Decimal conversions + , readDecimal + -- TODO: packDecimal + -- TODO: asDecimal -- this will be really hard to make efficient... + -- * Hexadecimal conversions + , readHexadecimal + -- TODO: packHexadecimal + -- TODO: asHexadecimal + -- * Octal conversions + , readOctal + -- TODO: packOctal + -- TODO: asOctal -- this will be really hard to make efficient... + -- * Exponential conversions + , readExponential + -- TODO: packExponential + -- TODO: asExponential + -- * Precision-limited conversions + , decimalPrecision + , readDecimalLimited + , readExponentialLimited + ) where + +import Data.ByteString (ByteString) +import qualified Data.ByteString as BS +import qualified Data.ByteString.Unsafe as BSU +import Data.Word (Word8) +import qualified Data.ByteString.Lex.Integral as I +import Data.ByteString.Lex.Integral (readSigned) +import Data.ByteString.Lex.Internal + +---------------------------------------------------------------- +---------------------------------------------------------------- + +-- | A helper function to ensure consistent strictness. +-- TODO: should we really be this strict? +justPair :: a -> b -> Maybe (a,b) +{-# INLINE justPair #-} +justPair !x !y = Just (x,y) + +pair :: a -> b -> (a,b) +{-# INLINE pair #-} +pair !x !y = (x,y) + + +-- NOTE: We use 'fromInteger' everywhere instead of 'fromIntegral' +-- in order to fix the types of the calls to 'I.readDecimal', etc. +-- This is always correct, but for some result types there are other +-- intermediate types which may be faster. + + +---------------------------------------------------------------- +----- Decimal + +-- | Read an unsigned\/non-negative fractional value in ASCII decimal +-- format; that is, anything matching the regex @\\d+(\\.\\d+)?@. +-- Returns @Nothing@ if there is no such number at the beginning +-- of the string, otherwise returns @Just@ the number read and the +-- remainder of the string. +-- +-- N.B., see 'readDecimalLimited' if your fractional type has limited +-- precision and you expect your inputs to have greater precision +-- than can be represented. Even for types with unlimited precision +-- (e.g., 'Rational'), you may want to check out 'readDecimalLimited'. +readDecimal :: (Fractional a) => ByteString -> Maybe (a, ByteString) +{-# SPECIALIZE readDecimal :: + ByteString -> Maybe (Float, ByteString), + ByteString -> Maybe (Double, ByteString), + ByteString -> Maybe (Rational, ByteString) #-} +readDecimal xs = + case I.readDecimal xs of + Nothing -> Nothing + Just (whole, ys) -> + case BS.uncons ys of + Nothing -> justPair (fromInteger whole) BS.empty + Just (y0,ys0) + | isNotPeriod y0 -> justPair (fromInteger whole) ys + | otherwise -> + case I.readDecimal ys0 of + Nothing -> justPair (fromInteger whole) ys + Just (part, zs) -> + let base = 10 ^ (BS.length ys - 1 - BS.length zs) + frac = fromInteger whole + (fromInteger part / base) + in justPair frac zs + + +---------------------------------------------------------------- +-- If and only if(!) we have Real, then we can use 'toRational'... +-- Similarly, only if we have RealFloat can we use 'decodeFloat'... + +-- TODO: +-- Convert a non-negative fractional number into an (unsigned) +-- ASCII decimal string. Returns @Nothing@ on negative inputs. +-- packDecimal :: (Fractional a) => a -> Maybe ByteString + + +---------------------------------------------------------------- +---------------------------------------------------------------- +----- Hexadecimal + +-- | Read a non-negative integral value in ASCII hexadecimal format. +-- Returns @Nothing@ if there is no integer at the beginning of the +-- string, otherwise returns @Just@ the integer read and the remainder +-- of the string. +-- +-- This function does not recognize the various hexadecimal sigils +-- like \"0x\", but because there are so many different variants, +-- 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 = + case I.readHexadecimal xs of + Nothing -> Nothing + Just (n, xs') -> justPair (fromInteger n) xs' + + +-- TODO: +-- Convert a non-negative integer into a lower-case ASCII hexadecimal +-- string. Returns @Nothing@ on negative inputs. +-- packHexadecimal :: (Fractional a) => a -> Maybe ByteString + + +---------------------------------------------------------------- +---------------------------------------------------------------- +----- Octal + +-- | Read a non-negative integral value in ASCII octal format. +-- Returns @Nothing@ if there is no integer at the beginning of the +-- string, otherwise returns @Just@ the integer read and the remainder +-- of the string. +-- +-- This function does not recognize the various octal sigils like +-- \"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 = + case I.readOctal xs of + Nothing -> Nothing + Just (n, xs') -> justPair (fromInteger n) xs' + +-- TODO: +-- Convert a non-negative integer into an ASCII octal string. +-- Returns @Nothing@ on negative inputs. +-- packOctal :: (Fractional a) => a -> Maybe ByteString + + +---------------------------------------------------------------- +---------------------------------------------------------------- +----- Exponential + +-- | Read an unsigned\/non-negative fractional value in ASCII +-- exponential format; that is, anything matching the regex +-- @\\d+(\\.\\d+)?([eE][\\+\\-]?\\d+)?@. Returns @Nothing@ if there +-- is no such number at the beginning of the string, otherwise +-- returns @Just@ the number read and the remainder of the string. +-- +-- N.B., the current implementation assumes the exponent is small +-- enough to fit into an 'Int'. This gives a significant performance +-- increase for @a ~ Float@ and @a ~ Double@ and agrees with the +-- 'RealFloat' class which has 'exponent' returning an 'Int'. If +-- you need a larger exponent, contact the maintainer. +-- +-- N.B., see 'readExponentialLimited' if your fractional type has +-- limited precision and you expect your inputs to have greater +-- precision than can be represented. Even for types with unlimited +-- precision, you may want to check out 'readExponentialLimited'. +readExponential :: (Fractional a) => ByteString -> Maybe (a, ByteString) +{-# SPECIALIZE readExponential :: + ByteString -> Maybe (Float, ByteString), + ByteString -> Maybe (Double, ByteString), + ByteString -> Maybe (Rational, ByteString) #-} +readExponential xs = + case readDecimal xs of + Nothing -> Nothing + Just (frac, ys) -> + case BS.uncons ys of + Nothing -> justPair frac BS.empty + Just (y0,ys0) + | isNotE y0 -> justPair frac ys + | otherwise -> + -- HACK: monomorphizing @e::Int@ for performance! + case readSigned I.readDecimal ys0 of + Nothing -> justPair frac ys + Just (ex,zs) -> justPair (frac * (10 ^^ (ex::Int))) zs + + +---------------------------------------------------------------- +---------------------------------------------------------------- +----- Limited + + +-- | A representation of unsigned fractional numbers decomposed +-- into a significand\/mantissa and a decimal exponent. This allows +-- efficient scaling by decimal exponents (cf., 'scaleDF'). +-- +-- TODO: the first component should be some @a@-specific intermediate +-- 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 +-- @'Data.Ratio.Ratio' a@. +data DecimalFraction a = DF !Integer {-# UNPACK #-}!Int +-- BUG: Can't unpack integers... + + +-- | A helpful smart constructor. +fractionDF :: Integer -> Int -> Integer -> DecimalFraction a +{-# INLINE fractionDF #-} +fractionDF whole scale part = + DF (whole * (10 ^ scale) + part) (negate scale) + -- TODO: use an unsafe variant of (^) which has an assertion instead of a runtime check? + + +-- | Extract the fractional number encoded in the record. +-- +-- > fromDF (DF frac scale) = fromIntegral frac * (10 ^^ scale) +fromDF :: Fractional a => DecimalFraction a -> a +{-# INLINE fromDF #-} +fromDF (DF frac scale) + -- Avoid possibility of returning NaN + -- TODO: really, ought to check @fromInteger frac == 0@... + | frac == 0 = 0 + -- Avoid throwing an error due to @negate minBound == minBound@ + | scale == minBound = fromInteger frac * (10 ^^ toInteger scale) + -- Now we're safe for the default implementation + | otherwise = fromInteger frac * (10 ^^ scale) + -- TODO: manually implement (^^) so that we get @_ / (10^ _)@ + -- instead of @_ * recip (10^ _)@ for negative exponents? + + +-- | Scale a decimal fraction by some power of 10. +scaleDF :: DecimalFraction a -> Int -> DecimalFraction a +{-# INLINE scaleDF #-} +scaleDF (DF frac scale) scale' = DF frac (scale + scale') + + +-- TODO: is there a way to avoid ScopedTypeVariables without losing +-- the fact that this is a constant function? +-- +-- TODO: try looking at core again to see if @n@ gets completely +-- optimized away or not. If not, is there a way to help make that +-- happen without using TH? +-- +-- | Return the 'RealFloat' type's inherent decimal precision +-- limitation. This is the number of decimal digits in @floatRadix +-- proxy ^ floatDigits proxy@. +decimalPrecision :: forall proxy a. RealFloat a => proxy a -> Int +{-# INLINE decimalPrecision #-} +decimalPrecision = + let proxy = undefined :: a + n = numDecimalDigits (floatRadix proxy ^ floatDigits proxy) + in n `seq` \_ -> n + + +-- TODO: for the isDecimalZero instance, use 'BS.breakByte' where +-- possible; or design our own similar... +-- +-- | Drop while the predicate is true, and return the number of +-- bytes dropped. +lengthDropWhile :: (Word8 -> Bool) -> ByteString -> (Int, ByteString) +{-# INLINE lengthDropWhile #-} +lengthDropWhile p xs = + let ys = BS.dropWhile p xs + in (BS.length xs - BS.length ys, ys) + {- + -- TODO: benchmark + let len = BS.length (BS.takeWhile p xs) + in (len, BS.drop len xs) + + case BS.break (not . p) xs of + (ys,zs) -> (BS.length ys, zs) + -} + + +-- | A variant of 'readDecimal' which only reads up to some limited +-- precision. The first argument gives the number of decimal digits +-- at which to limit the precision. +-- +-- For types with inherently limited precision (e.g., 'Float' and +-- 'Double'), when you pass in the precision limit (cf., +-- 'decimalPrecision') this is far more efficient than 'readDecimal'. +-- However, passing in a precision limit which is greater than the +-- type's inherent limitation will degrate performance compared to +-- 'readDecimal'. +-- +-- For types with unlimited precision (e.g., 'Rational') this may +-- still be far more efficient than 'readDecimal' (it is for +-- 'Rational', in fact). The reason being that it delays the scaling +-- the significand\/mantissa by the exponent, thus allowing you to +-- further adjust the exponent before computing the final value +-- (e.g., as in 'readExponentialLimited'). This avoids the need to +-- renormalize intermediate results, and allows faster computation +-- of the scaling factor by doing it all at once. +readDecimalLimited :: (Fractional a) => Int -> ByteString -> Maybe (a, ByteString) +{-# INLINE readDecimalLimited #-} +readDecimalLimited p xs = + case readDecimalLimited_ p xs of + Nothing -> Nothing + Just (df,ys) -> justPair (fromDF df) ys + + +readDecimalLimited_ :: (Fractional a) => Int -> ByteString -> Maybe (DecimalFraction a, ByteString) +{-# SPECIALIZE readDecimalLimited_ :: + Int -> ByteString -> Maybe (DecimalFraction Float, ByteString), + Int -> ByteString -> Maybe (DecimalFraction Double, ByteString), + Int -> ByteString -> Maybe (DecimalFraction Rational, ByteString) #-} +readDecimalLimited_ = start + where + -- All calls to 'I.readDecimal' are monomorphized at 'Integer', + -- as specified by what 'DF' needs. + 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 = + let ys = BS.take p xs in + case I.readDecimal ys of + Nothing -> justPair (DF 0 0) xs + Just (part, ys') -> + let scale' = scale + BS.length xs - BS.length ys' + in justPair (DF part (negate scale')) + (BS.dropWhile isDecimal ys') + + readWholePart !p !xs = + let ys = BS.take p xs in + case I.readDecimal ys of + Nothing -> Nothing + Just (whole, ys') + | BS.null ys' -> + case lengthDropWhile isDecimal (BS.drop p xs) of + (scale, zs) -> + justPair (DF whole scale) (dropFractionPart zs) + | otherwise -> + let len = BS.length ys - BS.length ys' + -- N.B., @xs' == ys' `BS.append` BS.drop p xs@ + xs' = BS.drop len xs + in + -- N.B., @BS.null xs'@ is impossible. Were it to + -- happen then returning @pair (DF whole 0) BS.empty@ + -- is consistent with the branch where we drop the + -- fraction part (the original input is less than + -- the original @p@ long); however, reaching this + -- branch ia that input would be a control-flow + -- error. + if isNotPeriod (BSU.unsafeHead xs') + then justPair (DF whole 0) xs' + else readFractionPart (p-len) whole xs' + + dropFractionPart !xs = + case BS.uncons xs of + Nothing -> BS.empty -- == xs + Just (x0,xs0) + | isNotPeriod x0 -> xs + | otherwise -> + case BS.uncons xs0 of + Nothing -> BS.singleton 0x2E -- == xs + Just (x1,xs1) + | isDecimal x1 -> BS.dropWhile isDecimal xs1 + | otherwise -> xs + + -- NOTES: @BS.null xs@ is impossible as it begins with a period; + -- see the call sites. If @not (BS.null ys')@ then the @BS.dropWhile + -- 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 = + let ys = BS.take p (BSU.unsafeTail xs) in + case I.readDecimal ys of + Nothing -> justPair (DF whole 0) xs + Just (part, ys') -> + let scale = BS.length ys - BS.length ys' + in justPair (fractionDF whole scale part) + (BS.dropWhile isDecimal (BS.drop (1+scale) xs)) + + +-- | A variant of 'readExponential' which only reads up to some limited +-- precision. The first argument gives the number of decimal digits +-- at which to limit the precision. See 'readDecimalLimited' for +-- more discussion of the performance benefits of using this function. +readExponentialLimited :: (Fractional a) => Int -> ByteString -> Maybe (a, ByteString) +{-# SPECIALIZE readExponentialLimited :: + Int -> ByteString -> Maybe (Float, ByteString), + Int -> ByteString -> Maybe (Double, ByteString), + Int -> ByteString -> Maybe (Rational, ByteString) #-} +readExponentialLimited = start + where + start !p !xs = + case readDecimalLimited_ p xs of + Nothing -> Nothing + Just (df,xs') -> Just $! readExponentPart df xs' + + readExponentPart !df !xs + | BS.null xs = pair (fromDF df) BS.empty + | isNotE (BSU.unsafeHead xs) = pair (fromDF df) xs + | otherwise = + -- HACK: monomorphizing at 'Int' + -- TODO: how to handle too-large exponents? + case readSigned I.readDecimal (BSU.unsafeTail xs) of + Nothing -> pair (fromDF df) xs + Just (scale, xs') -> pair (fromDF $ scaleDF df scale) xs' + +---------------------------------------------------------------- +----------------------------------------------------------- fin. 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,17 +1,20 @@ {-# OPTIONS_GHC -Wall -fwarn-tabs #-} +{-# LANGUAGE BangPatterns #-} ---------------------------------------------------------------- --- 2013.03.21 +-- 2021.10.17 -- | -- Module : Data.ByteString.Lex.Integral --- Copyright : Copyright (c) 2010--2015 wren gayle romano --- License : BSD3 --- Maintainer : wren@community.haskell.org +-- Copyright : Copyright (c) 2010--2021 wren gayle romano +-- License : BSD2 +-- 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 -- an ASCII-compatible encoding of alphanumeric characters. +-- +-- /Since: 0.3.0/ ---------------------------------------------------------------- module Data.ByteString.Lex.Integral ( @@ -30,7 +33,7 @@ -- * Octal conversions , readOctal , packOctal - -- asOctal -- this will be really hard to make efficient... + -- TODO: asOctal -- this will be really hard to make efficient... ) where import Data.ByteString (ByteString) @@ -44,6 +47,7 @@ import Foreign.Ptr (Ptr, plusPtr) import qualified Foreign.ForeignPtr as FFI (withForeignPtr) import Foreign.Storable (peek, poke) +import Data.ByteString.Lex.Internal ---------------------------------------------------------------- ----- General @@ -54,7 +58,7 @@ -- provide both signed and unsigned versions of the -- {read,pack}{Decimal,Octal,Hex} functions... - +-- TODO: move to somewhere more general, shared by both Integral and Fractional -- | Adjust a reading function to recognize an optional leading -- sign. As with the other functions, we assume an ASCII-compatible -- encoding of the sign characters. @@ -75,7 +79,8 @@ ----- Decimal {- --- We unroll this definition in order to reduce the number of conversions from native Int to the Integral type. +-- We unroll this definition in order to reduce the number of +-- conversions from native Int to the Integral type. readDecimalSimple :: (Integral a) => ByteString -> Maybe (a, ByteString) readDecimalSimple = start where @@ -93,9 +98,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 -> @@ -113,7 +117,7 @@ -- call 'fromIntegral' to perform the conversion at the end. However, -- doing this will make your code succeptible to overflow bugs if -- the target type is larger than @Int@. -readDecimal :: Integral a => ByteString -> Maybe (a, ByteString) +readDecimal :: (Integral a) => ByteString -> Maybe (a, ByteString) {-# SPECIALIZE readDecimal :: ByteString -> Maybe (Int, ByteString), ByteString -> Maybe (Int8, ByteString), @@ -128,20 +132,8 @@ 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 :: (Integral a) => ByteString -> Maybe (a, ByteString) start xs | BS.null xs = Nothing | otherwise = @@ -149,9 +141,8 @@ w | isDecimal w -> Just $ loop0 (toDigit w) (BSU.unsafeTail xs) | otherwise -> Nothing - loop0 :: Integral a => a -> ByteString -> (a, ByteString) - loop0 m xs - | m `seq` xs `seq` False = undefined + loop0 :: (Integral a) => a -> ByteString -> (a, ByteString) + loop0 !m !xs | BS.null xs = (m, BS.empty) | otherwise = case BSU.unsafeHead xs of @@ -159,58 +150,50 @@ | otherwise -> (m, xs) 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 + :: (Integral a) => a -> Int -> ByteString -> (a, ByteString) + 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 @@ -225,7 +208,9 @@ -- the string, and returns @0@ instead of @Nothing@. This is twice -- as fast for 'Int64' on 32-bit systems, but has identical performance -- to 'readDecimal' for all other types and architectures. -readDecimal_ :: Integral a => ByteString -> a +-- +-- /Since: 0.4.0/ +readDecimal_ :: (Integral a) => ByteString -> a {-# SPECIALIZE readDecimal_ :: ByteString -> Int, ByteString -> Int8, @@ -240,18 +225,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 = @@ -259,9 +232,8 @@ w | isDecimal w -> loop0 (toDigit w) (BSU.unsafeTail xs) | otherwise -> 0 - loop0 :: Integral a => a -> ByteString -> a - loop0 m xs - | m `seq` xs `seq` False = undefined + loop0 :: (Integral a) => a -> ByteString -> a + loop0 !m !xs | BS.null xs = m | otherwise = case BSU.unsafeHead xs of @@ -269,58 +241,50 @@ | otherwise -> m 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 + :: (Integral a) => a -> Int -> ByteString -> a + 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 @@ -341,6 +305,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. @@ -363,22 +329,22 @@ 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 loop q (p `plusPtr` negate 2) | 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) + +-- TODO(2021-10-23): We might should replace this with the 'Addr#' +-- hack that newer Bytestring uses for hexadecimal stuff: +-- packDecimal_digits :: ByteString {-# NOINLINE packDecimal_digits #-} packDecimal_digits = BS8.pack @@ -387,7 +353,6 @@ \4041424344454647484950515253545556575859\ \6061626364656667686970717273747576777879\ \8081828384858687888990919293949596979899" - -- BUG: syntax highlighting fail: -> ---------------------------------------------------------------- ---------------------------------------------------------------- @@ -435,9 +400,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 -> @@ -505,13 +469,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 #-} @@ -520,6 +482,10 @@ -- TODO: benchmark against the magichash hack used in Warp. +-- TODO(2021-10-23): Benchmark against the 'Addr#' hack that newer +-- Bytestring uses for hexadecimal stuff: +-- +-- -- | The lower-case ASCII hexadecimal digits, in numerical order -- for use as a lookup table. hexDigits :: ByteString @@ -534,8 +500,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 @@ -580,9 +545,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 -> @@ -697,127 +661,6 @@ _asOctal_overflow = "asOctal: cannot create buffer larger than (maxBound::Int)" -- -} - ----------------------------------------------------------------- ----------------------------------------------------------------- ------ Integral logarithms - --- TODO: cf. integer-gmp:GHC.Integer.Logarithms made available in version 0.3.0.0 (ships with GHC 7.2.1). --- - - --- This implementation is derived from --- --- modified to use 'quot' instead of 'div', to ensure strictness, --- and using more guard notation (but this last one's compiled --- away). See @./test/bench/BenchNumDigits.hs@ for other implementation --- choices. --- --- | @numDigits b n@ computes the number of base-@b@ digits required --- to represent the number @n@. N.B., this implementation is unsafe --- and will throw errors if the base is @(<= 1)@, or if the number --- is negative. If the base happens to be a power of 2, then see --- 'numTwoPowerDigits' for a more efficient implementation. --- --- We must be careful about the input types here. When using small --- unsigned types or very large values, the repeated squaring can --- overflow causing the function to loop. (E.g., the fourth squaring --- of 10 overflows 32-bits (==1874919424) which is greater than the --- third squaring. For 64-bit, the 5th squaring overflows, but it's --- negative so will be caught.) Forcing the type to Integer ensures --- correct behavior, but makes it substantially slower. - -numDigits :: Integer -> Integer -> Int -{-# INLINE numDigits #-} -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 - | n < b = (0, n) - | r < b = ((,) $! 2*e) r - | otherwise = ((,) $! 2*e+1) $! (r `quot` b) - where - (e, r) = ilog (b*b) n - - --- | Compute the number of base-@2^p@ digits required to represent a --- number @n@. N.B., this implementation is unsafe and will throw --- errors if the base power is non-positive, or if the number is --- negative. For bases which are not a power of 2, see 'numDigits' --- for a more general implementation. -numTwoPowerDigits :: (Integral a, Bits a) => Int -> a -> Int -{-# INLINE numTwoPowerDigits #-} -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 - | n > 0 = go (d+1) (n `shiftR` p) - | otherwise = d - - --- This implementation is from: --- --- --- | Compute the number of base-@10@ digits required to represent --- a number @n@. N.B., this implementation is unsafe and will throw --- errors if the number is negative. -numDecimalDigits :: (Integral a) => a -> Int -{-# INLINE numDecimalDigits #-} -numDecimalDigits n0 - | n0 < 0 = error (_numDecimalDigits ++ _negativeNumber) - -- Unfortunately this causes significant (1.2x) slowdown since - -- GHC can't see it will always fail for types other than Integer... - | n0 > limit = numDigits 10 (toInteger n0) - | 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 - | n < 10 = k - | n < 100 = k + 1 - | n < 1000 = k + 2 - | n < 1000000000000 = - k + if n < 100000000 - then if n < 1000000 - then if n < 10000 - then 3 - else 4 + fin n 100000 - else 6 + fin n 10000000 - else if n < 10000000000 - then 8 + fin n 1000000000 - else 10 + fin n 100000000000 - | otherwise = go (k + 12) (n `quot` 1000000000000) - - -_numDigits :: String -_numDigits = "numDigits" -{-# NOINLINE _numDigits #-} - -_numTwoPowerDigits :: String -_numTwoPowerDigits = "numTwoPowerDigits" -{-# NOINLINE _numTwoPowerDigits #-} - -_numDecimalDigits :: String -_numDecimalDigits = "numDecimalDigits" -{-# NOINLINE _numDecimalDigits #-} - -_nonpositiveBase :: String -_nonpositiveBase = ": base must be greater than one" -{-# NOINLINE _nonpositiveBase #-} - -_negativeNumber :: String -_negativeNumber = ": number must be non-negative" -{-# NOINLINE _negativeNumber #-} ---------------------------------------------------------------- ----------------------------------------------------------- fin. 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,34 +1,195 @@ {-# OPTIONS_GHC -Wall -fwarn-tabs #-} -{-# LANGUAGE ForeignFunctionInterface #-} +{-# LANGUAGE BangPatterns #-} ---------------------------------------------------------------- --- 2012.01.25 +-- 2024-04-11 -- | -- Module : Data.ByteString.Lex.Internal --- Copyright : Copyright (c) 2008--2011 Don Stewart. --- License : BSD2/MIT --- Maintainer : wren@community.haskell.org --- Stability : stable --- Portability : Haskell98 + FFI +-- Copyright : Copyright (c) 2010--2024 wren gayle romano +-- License : BSD2 +-- Maintainer : wren@cpan.org +-- Stability : provisional +-- Portability : BangPatterns -- --- Efficiently parse floating point literals from a 'ByteString'. +-- 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 + , numTwoPowerDigits + , numDecimalDigits + ) where -module Data.ByteString.Lex.Internal (strtod, c_strtod) where +import Data.Word (Word8, Word64) +import Data.Bits (Bits(shiftR)) -import qualified Data.ByteString.Internal as BSI (inlinePerformIO) -import qualified Data.ByteString as BS -import Foreign.C.String (CString) -import Foreign.Ptr (Ptr, nullPtr) ---------------------------------------------------------------- +---------------------------------------------------------------- +----- Character-based bit-bashing --- | Safe, minimal copy of substring identified by Alex. -strtod :: BS.ByteString -> Double -{-# INLINE strtod #-} -strtod b = - BSI.inlinePerformIO . BS.useAsCString b $ \ptr -> c_strtod ptr nullPtr +{-# INLINE isNotPeriod #-} +isNotPeriod :: Word8 -> Bool +isNotPeriod w = w /= 0x2E -foreign import ccall unsafe "stdlib.h strtod" - c_strtod :: CString -> Ptr CString -> IO Double +{-# 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). +-- + + +-- This implementation is derived from +-- +-- modified to use 'quot' instead of 'div', to ensure strictness, +-- and using more guard notation (but this last one's compiled +-- away). See @./bench/BenchNumDigits.hs@ for other implementation +-- choices. +-- +-- | @numDigits b n@ computes the number of base-@b@ digits required +-- to represent the number @n@. N.B., this implementation is unsafe +-- and will throw errors if the base is @(<= 1)@, or if the number +-- is negative. If the base happens to be a power of 2, then see +-- 'numTwoPowerDigits' for a more efficient implementation. +-- +-- We must be careful about the input types here. When using small +-- unsigned types or very large values, the repeated squaring can +-- overflow causing the function to loop. (E.g., the fourth squaring +-- of 10 overflows 32-bits (==1874919424) which is greater than the +-- third squaring. For 64-bit, the 5th squaring overflows, but it's +-- negative so will be caught.) Forcing the type to Integer ensures +-- correct behavior, but makes it substantially slower. + +numDigits :: Integer -> Integer -> Int +{-# INLINE numDigits #-} +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 = finish (ilog b0 n0) + where + finish (ND e _) = 1 + e + ilog !b !n + | n < b = ND 0 n + -- TODO(2024-04-11): Check core to see whether these @(2*)@ + -- ops are properly weakened to shifts. + | r < b = ND (2*e) r + | otherwise = ND (2*e+1) (r `quot` b) + where + -- TODO(2024-04-11): Benchmark this lazy-pattern matching, + -- vs using a strict pattern (and alas less guard-notation, + -- to ensure we only evaluate it when needed). + ND e r = ilog (b*b) n + +-- TODO(2024-04-11): Benchmark this change in the implementation +-- (relative to using @(,)@ and @($!)@). Also, need to re-run all +-- the benchmarks anyways, to see how things've changed on newer GHC. +data ND = ND {-#UNPACK#-}!Int !Integer + + +-- | Compute the number of base-@2^p@ digits required to represent a +-- number @n@. N.B., this implementation is unsafe and will throw +-- errors if the base power is non-positive, or if the number is +-- negative. For bases which are not a power of 2, see 'numDigits' +-- for a more general implementation. +numTwoPowerDigits :: (Integral a, Bits a) => Int -> a -> Int +{-# INLINE numTwoPowerDigits #-} +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 + | n > 0 = go (d+1) (n `shiftR` p) + | otherwise = d + + +-- This implementation is from: +-- +-- +-- | Compute the number of base-@10@ digits required to represent +-- a number @n@. N.B., this implementation is unsafe and will throw +-- errors if the number is negative. +numDecimalDigits :: (Integral a) => a -> Int +{-# INLINE numDecimalDigits #-} +numDecimalDigits n0 + | n0 < 0 = error (_numDecimalDigits ++ _negativeNumber) + -- Unfortunately this causes significant (1.2x) slowdown since + -- GHC can't see it will always fail for types other than Integer... + -- TODO(2024-04-11): See if we can't do more static-analysis + -- code to optimize this path (a~la my C++ safe comparisons) + | n0 > limit = numDigits 10 (toInteger n0) + | otherwise = go 1 (fromIntegral n0 :: Word64) + where + limit = fromIntegral (maxBound :: Word64) + + fin n bound = if n >= bound then 1 else 0 + go !k !n + | n < 10 = k + | n < 100 = k + 1 + | n < 1000 = k + 2 + | n < 1000000000000 = + k + if n < 100000000 + then if n < 1000000 + then if n < 10000 + then 3 + else 4 + fin n 100000 + else 6 + fin n 10000000 + else if n < 10000000000 + then 8 + fin n 1000000000 + else 10 + fin n 100000000000 + | otherwise = go (k + 12) (n `quot` 1000000000000) + + +_numDigits :: String +_numDigits = "numDigits" +{-# NOINLINE _numDigits #-} + +_numTwoPowerDigits :: String +_numTwoPowerDigits = "numTwoPowerDigits" +{-# NOINLINE _numTwoPowerDigits #-} + +_numDecimalDigits :: String +_numDecimalDigits = "numDecimalDigits" +{-# NOINLINE _numDecimalDigits #-} + +_nonpositiveBase :: String +_nonpositiveBase = ": base must be greater than one" +{-# NOINLINE _nonpositiveBase #-} + +_negativeNumber :: String +_negativeNumber = ": number must be non-negative" +{-# NOINLINE _negativeNumber #-} ---------------------------------------------------------------- ----------------------------------------------------------- fin. diff --git a/src/Data/ByteString/Lex/Lazy/Double.x b/src/Data/ByteString/Lex/Lazy/Double.x deleted file mode 100644 --- a/src/Data/ByteString/Lex/Lazy/Double.x +++ /dev/null @@ -1,91 +0,0 @@ -{ --- Turn off some common warnings about Alex-generated code. --- {-# OPTIONS_GHC -Wall -fno-warn-tabs -fno-warn-missing-signatures #-} ----------------------------------------------------------------- --- 2012.01.25 --- | --- Module : Data.ByteString.Lex.Lazy.Double --- Copyright : Copyright (c) 2008--2011 Don Stewart --- License : BSD2/MIT --- Maintainer : wren@community.haskell.org --- Stability : stable --- Portability : Haskell98 --- --- Efficiently parse floating point literals from a 'ByteString'. ----------------------------------------------------------------- - -module Data.ByteString.Lex.Lazy.Double (readDouble) where - -import qualified Data.ByteString.Lazy as LB -import qualified Data.ByteString as SB -import Data.ByteString.Lex.Internal (strtod) ----------------------------------------------------------------- -} - -%wrapper "basic-bytestring" - -$space = [\ \t\xa0] -$digit = 0-9 -$octit = 0-7 -$hexit = [$digit A-F a-f] - -@sign = [\-\+] -@decimal = $digit+ -@octal = $octit+ -@hexadecimal = $hexit+ -@exponent = [eE] [\-\+]? @decimal - -@number = @decimal - | @decimal \. @decimal @exponent? - | @decimal @exponent - | 0[oO] @octal - | 0[xX] @hexadecimal - -lex :- - -@sign? @number { strtod . strict } - -{ - --- | Parse the initial portion of the ByteString as a Double precision --- floating point value. The expected form of the numeric literal --- is given by: --- --- * An optional '+' or '-' sign --- --- * Decimal digits, OR --- --- * 0 [oO] and a sequence of octal digits, OR --- --- * 0 [xX] and a sequence of hexadecimal digits, OR --- --- * An optional decimal point, followed by a sequence of decimal digits, --- --- * And an optional exponent --- --- The result is returned as a pair of a double-precision floating --- point value and the remaining input, or @Nothing@ should no parse --- be found. --- --- For example, to sum a file of floating point numbers, one per line, --- --- > import qualified Data.ByteString.Char8 as S --- > import qualified Data.ByteString.Unsafe as S --- > import Data.ByteString.Lex.Double --- > --- > main = print . go 0 =<< S.getContents --- > where --- > go n s = case readDouble s of --- > Nothing -> n --- > Just (k,rest) -> go (n+k) (S.tail rest) --- -readDouble :: LB.ByteString -> Maybe (Double, LB.ByteString) -readDouble str = case alexScan ('\n', str) 0 of - AlexEOF -> Nothing - AlexError _ -> Nothing - AlexToken (_, rest) n _ -> - case strtod . strict . LB.take (fromIntegral n) $ str of - d -> Just $! (d , rest) - -strict = SB.concat . LB.toChunks -} 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 #-} +---------------------------------------------------------------- +-- 2021.10.17 +-- | +-- Module : test/Fractional +-- Copyright : Copyright (c) 2015--2021 wren gayle romano +-- License : BSD2 +-- Maintainer : wren@cpan.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 #-} +---------------------------------------------------------------- +-- 2021.10.17 +-- | +-- Module : test/Integral +-- Copyright : Copyright (c) 2010--2021 wren gayle romano +-- License : BSD2 +-- Maintainer : wren@cpan.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 #-} +---------------------------------------------------------------- +-- 2021.10.17 +-- | +-- Module : test/Main +-- Copyright : Copyright (c) 2015--2021 wren gayle romano +-- License : BSD2 +-- Maintainer : wren@cpan.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.