bytestring-lexing 0.2 → 0.5.0.15
raw patch · 18 files changed
Files
- AUTHORS +18/−0
- CHANGELOG +56/−0
- Data/ByteString/Lex/Double.hs +0/−445
- Data/ByteString/Lex/Double.x +0/−130
- Data/ByteString/Lex/Internal.hs +0/−31
- Data/ByteString/Lex/Lazy/Double.hs +0/−401
- Data/ByteString/Lex/Lazy/Double.x +0/−91
- LICENSE +1/−1
- README.md +175/−0
- Setup.hs +7/−0
- Setup.lhs +0/−3
- bytestring-lexing.cabal +144/−26
- src/Data/ByteString/Lex/Fractional.hs +448/−0
- src/Data/ByteString/Lex/Integral.hs +666/−0
- src/Data/ByteString/Lex/Internal.hs +195/−0
- test/Fractional.hs +248/−0
- test/Integral.hs +227/−0
- test/Main.hs +29/−0
+ AUTHORS view
@@ -0,0 +1,18 @@+=== Haskell bytestring-lexing package AUTHORS/THANKS file ===++The bytestring-lexing package was originally written by Don Stewart+and released under the terms in the LICENSE file. In January 2012+maintainership was taken over by wren gayle romano. I would also+like to give thanks to the following contributers:++Bryan O'Sullivan --- For adding support for parsing Doubles from+ lazy bytestrings back during Don's maintainership. Also for+ inspiring the improved (v0.4.2) packDecimal implementation.++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.
+ CHANGELOG view
@@ -0,0 +1,56 @@+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):+ - Data.ByteString.Lex.Integral: Corrected a segmentation fault in packDecimal.+0.4.2 (2013-03-20):+ - Data.ByteString.Lex.Integral: Improved packDecimal.+0.4.1 (2012-00-00):+ - Data.ByteString.Lex.Integral: Added buffer overflow check for asHexadecimal+0.4.0 (2012-02-03):+ - Data.ByteString.Lex.Integral: added readDecimal_++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):+ - 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):
− Data/ByteString/Lex/Double.hs
@@ -1,445 +0,0 @@-{-# OPTIONS -fglasgow-exts -cpp #-}-{-# LINE 1 "Double.x" #-}- {-*- haskell -*-}------------------------------------------------------------------------- |--- Module : Data.ByteString.Lex.Double--- Copyright : (c) Galois, Inc. 2008--- License : All rights reserved------ Maintainer: Don Stewart <dons@galois.com>--- Stability : provisional--- Portability:------------------------------------------------------------------------------ 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)-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 "<built-in>" #-}-{-# LINE 1 "<command-line>" #-}-{-# 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 qualified Data.ByteString.Char8 as ByteString-import qualified Data.ByteString.Internal as ByteString-import qualified Data.ByteString.Unsafe as ByteString------ -------------------------------------------------------------------------------- The input type--{-# LINE 35 "templates/wrappers.hs" #-}--{-# LINE 51 "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 74 "templates/wrappers.hs" #-}---- -------------------------------------------------------------------------------- Default monad--{-# LINE 162 "templates/wrappers.hs" #-}----- -------------------------------------------------------------------------------- Monad (with ByteString input)--{-# LINE 251 "templates/wrappers.hs" #-}----- -------------------------------------------------------------------------------- Basic wrapper--{-# LINE 273 "templates/wrappers.hs" #-}----- -------------------------------------------------------------------------------- Basic wrapper, ByteString version--{-# LINE 297 "templates/wrappers.hs" #-}----data AlexInput = AlexInput { alexChar :: {-# UNPACK #-}!Char- , alexStr :: {-# UNPACK #-}!ByteString.ByteString }--alexGetChar (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)--alexInputPrevChar = alexChar---- 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' len act -> act (ByteString.unsafeTake len str) : go inp'------- -------------------------------------------------------------------------------- Posn wrapper---- Adds text positions to the basic model.--{-# LINE 339 "templates/wrappers.hs" #-}----- -------------------------------------------------------------------------------- Posn wrapper, ByteString version--{-# LINE 354 "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\xe5\xff\xff\xff\xf1\xff\xff\xff\x09\x00\x00\x00\x14\x00\x00\x00\xfb\xff\xff\xff\x32\x00\x00\x00\x3f\x00\x00\x00\x52\x00\x00\x00\x69\x00\x00\x00\x73\x00\x00\x00\x8e\x00\x00\x00\x98\x00\x00\x00\xa7\x00\x00\x00\xb1\x00\x00\x00\xbb\x00\x00\x00\xc3\x00\x00\x00"#--alex_table :: AlexAddr-alex_table = AlexA# "\x00\x00\x09\x00\x00\x00\x09\x00\x00\x00\x00\x00\x03\x00\x02\x00\x02\x00\x02\x00\x02\x00\x02\x00\x02\x00\x02\x00\x02\x00\x02\x00\x09\x00\x00\x00\x09\x00\x00\x00\x00\x00\x03\x00\x02\x00\x02\x00\x02\x00\x02\x00\x02\x00\x02\x00\x02\x00\x02\x00\x02\x00\x0a\x00\x00\x00\x02\x00\x02\x00\x02\x00\x02\x00\x02\x00\x02\x00\x02\x00\x02\x00\x02\x00\x02\x00\x05\x00\x05\x00\x05\x00\x05\x00\x05\x00\x05\x00\x05\x00\x05\x00\x05\x00\x05\x00\x00\x00\x0d\x00\x0a\x00\x00\x00\x02\x00\x02\x00\x02\x00\x02\x00\x02\x00\x02\x00\x02\x00\x02\x00\x02\x00\x02\x00\x00\x00\x04\x00\x04\x00\x04\x00\x04\x00\x04\x00\x04\x00\x04\x00\x04\x00\x04\x00\x04\x00\x0d\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x0d\x00\x00\x00\x0f\x00\x0b\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x10\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\x0d\x00\x07\x00\x07\x00\x07\x00\x07\x00\x07\x00\x07\x00\x07\x00\x07\x00\x00\x00\x0f\x00\x0b\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x10\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\x08\x00\x08\x00\x08\x00\x08\x00\x08\x00\x08\x00\x03\x00\x02\x00\x02\x00\x02\x00\x02\x00\x02\x00\x02\x00\x02\x00\x02\x00\x02\x00\x04\x00\x04\x00\x04\x00\x04\x00\x04\x00\x04\x00\x04\x00\x04\x00\x04\x00\x04\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x08\x00\x08\x00\x08\x00\x08\x00\x08\x00\x08\x00\x0c\x00\x00\x00\x0c\x00\x00\x00\x00\x00\x05\x00\x05\x00\x05\x00\x05\x00\x05\x00\x05\x00\x05\x00\x05\x00\x05\x00\x05\x00\x05\x00\x05\x00\x05\x00\x05\x00\x05\x00\x05\x00\x05\x00\x05\x00\x05\x00\x05\x00\x0e\x00\x00\x00\x0e\x00\x00\x00\x00\x00\x06\x00\x06\x00\x06\x00\x06\x00\x06\x00\x06\x00\x06\x00\x06\x00\x06\x00\x06\x00\x06\x00\x06\x00\x06\x00\x06\x00\x06\x00\x06\x00\x06\x00\x06\x00\x06\x00\x06\x00\x07\x00\x07\x00\x07\x00\x07\x00\x07\x00\x07\x00\x07\x00\x07\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\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\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\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\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\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\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\x2e\x00\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\x45\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\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\x37\x00\x38\x00\x39\x00\x45\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x65\x00\xff\xff\x4f\x00\x45\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\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\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\x37\x00\xff\xff\x6f\x00\x65\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x78\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\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\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x61\x00\x62\x00\x63\x00\x64\x00\x65\x00\x66\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\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\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\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x61\x00\x62\x00\x63\x00\x64\x00\x65\x00\x66\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"#--alex_deflt :: AlexAddr-alex_deflt = AlexA# "\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\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_accept = listArray (0::Int,16) [[],[],[(AlexAcc (alex_action_0))],[(AlexAcc (alex_action_0))],[(AlexAcc (alex_action_0))],[(AlexAcc (alex_action_0))],[(AlexAcc (alex_action_0))],[(AlexAcc (alex_action_0))],[(AlexAcc (alex_action_0))],[],[],[],[],[],[],[],[]]-{-# LINE 54 "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-precisoin 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)---- Safe, minimal copy of substring identified by Alex.-strtod :: ByteString -> Double-strtod b = inlinePerformIO $ B.useAsCString b $ \ptr -> c_strtod ptr nullPtr-{-# INLINE strtod #-}--foreign import ccall unsafe "stdlib.h strtod" - c_strtod :: CString -> Ptr CString -> IO Double--------------------------------------------------------------------------------- | Bare bones, unsafe wrapper for strtod. 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)-unsafeReadDouble b | B.null b = Nothing-unsafeReadDouble b = 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)-{-# INLINE unsafeReadDouble #-}---alex_action_0 = strtod -{-# LINE 1 "templates/GenericTemplate.hs" #-}-{-# LINE 1 "templates/GenericTemplate.hs" #-}-{-# LINE 1 "<built-in>" #-}-{-# LINE 1 "<command-line>" #-}-{-# 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 35 "templates/GenericTemplate.hs" #-}--{-# LINE 45 "templates/GenericTemplate.hs" #-}---data AlexAddr = AlexA# Addr#--#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 alexGetChar 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 alexGetChar input of- Nothing -> (new_acc, input)- Just (c, new_input) -> ---- let- base = alexIndexInt32OffAddr alex_base s- (I# (ord_c)) = ord c- offset = (base +# ord_c)- check = alexIndexInt16OffAddr alex_check offset- - new_s = if (offset >=# 0#) && (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 (len +# 1#) - new_input new_s new_acc-- where- check_accs [] = last_acc- check_accs (AlexAcc a : _) = AlexLastAcc a input (I# (len))- check_accs (AlexAccSkip : _) = AlexLastSkip input (I# (len))- check_accs (AlexAccPred a pred : rest)- | pred user orig_input (I# (len)) input- = AlexLastAcc a input (I# (len))- check_accs (AlexAccSkipPred pred : rest)- | pred user orig_input (I# (len)) input- = AlexLastSkip input (I# (len))- check_accs (_ : rest) = check_accs rest--data AlexLastAcc a- = AlexNone- | AlexLastAcc a !AlexInput !Int- | AlexLastSkip !AlexInput !Int--data AlexAcc a user- = AlexAcc a- | AlexAccSkip- | AlexAccPred a (AlexAccPred user)- | AlexAccSkipPred (AlexAccPred user)--type AlexAccPred user = user -> AlexInput -> Int -> AlexInput -> Bool---- -------------------------------------------------------------------------------- Predicates on a rule--alexAndPred p1 p2 user in1 len in2- = p1 user in1 len in2 && p2 user in1 len in2----alexPrevCharIsPred :: Char -> AlexAccPred _ -alexPrevCharIs c _ input _ _ = c == alexInputPrevChar input----alexPrevCharIsOneOfPred :: Array Char Bool -> AlexAccPred _ -alexPrevCharIsOneOf arr _ input _ _ = arr ! alexInputPrevChar input----alexRightContext :: Int -> AlexAccPred _-alexRightContext (I# (sc)) user _ _ input = - case alex_scan_tkn user input 0# input sc AlexNone of- (AlexNone, _) -> False- _ -> True- -- TODO: there's no need to find the longest- -- match when checking the right context, just- -- the first match will do.---- used by wrappers-iUnbox (I# (i)) = i
− Data/ByteString/Lex/Double.x
@@ -1,130 +0,0 @@-{ {-*- haskell -*-}------------------------------------------------------------------------- |--- Module : Data.ByteString.Lex.Double--- Copyright : (c) Galois, Inc. 2008--- License : All rights reserved------ Maintainer: Don Stewart <dons@galois.com>--- Stability : provisional--- Portability:------------------------------------------------------------------------------ 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)-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-precisoin 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 my_strtod (B.unsafeTake n str) of d -> d `seq` Just $! (d , rest)---- Safe, minimal copy of substring identified by Alex.-my_strtod :: ByteString -> Double-my_strtod b = inlinePerformIO $ B.useAsCString b $ \ptr -> c_strtod ptr nullPtr-{-# INLINE my_strtod #-}--foreign import ccall unsafe "stdlib.h strtod" - c_strtod :: CString -> Ptr CString -> IO Double--------------------------------------------------------------------------------- | Bare bones, unsafe wrapper for strtod. 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)-unsafeReadDouble b | B.null b = Nothing-unsafeReadDouble b = 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)-{-# INLINE unsafeReadDouble #-}--}
− Data/ByteString/Lex/Internal.hs
@@ -1,31 +0,0 @@-{-# LANGUAGE ForeignFunctionInterface #-}------------------------------------------------------------------------- |--- Module : Data.ByteString.Lex.Internal--- Copyright : (c) Galois, Inc. 2008--- License : All rights reserved------ Maintainer: Don Stewart <dons@galois.com>--- Stability : provisional--- Portability:------------------------------------------------------------------------------ Efficiently parse floating point literals from a ByteString-----module Data.ByteString.Lex.Internal ( strtod ) where--import Data.ByteString.Internal (inlinePerformIO)-import qualified Data.ByteString as B-import Foreign.C.String (CString)-import Foreign.Ptr (Ptr, nullPtr)---- Safe, minimal copy of substring identified by Alex.-strtod :: B.ByteString -> Double-strtod b = inlinePerformIO . B.useAsCString b $ \ptr -> c_strtod ptr nullPtr-{-# INLINE strtod #-}--foreign import ccall unsafe "stdlib.h strtod" - c_strtod :: CString -> Ptr CString -> IO Double
− Data/ByteString/Lex/Lazy/Double.hs
@@ -1,401 +0,0 @@-{-# OPTIONS -fglasgow-exts -cpp #-}-{-# LINE 1 "Data/ByteString/Lex/Lazy/Double.x" #-}- {-*- haskell -*-}------------------------------------------------------------------------- |--- Module : Data.ByteString.Lex.Lazy.Double--- Copyright : (c) Galois, Inc. 2008--- License : All rights reserved------ Maintainer: Don Stewart <dons@galois.com>--- Stability : provisional--- Portability:------------------------------------------------------------------------------ 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 "<built-in>" #-}-{-# LINE 1 "<command-line>" #-}-{-# 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 qualified Data.ByteString.Lazy.Char8 as ByteString------------ -------------------------------------------------------------------------------- The input type--{-# LINE 35 "templates/wrappers.hs" #-}--{-# LINE 51 "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 74 "templates/wrappers.hs" #-}---- -------------------------------------------------------------------------------- Default monad--{-# LINE 162 "templates/wrappers.hs" #-}----- -------------------------------------------------------------------------------- Monad (with ByteString input)--{-# LINE 251 "templates/wrappers.hs" #-}----- -------------------------------------------------------------------------------- Basic wrapper--{-# LINE 273 "templates/wrappers.hs" #-}----- -------------------------------------------------------------------------------- Basic wrapper, ByteString version---type AlexInput = (Char,ByteString.ByteString)--alexGetChar (_, cs) | ByteString.null cs = Nothing- | otherwise = Just (ByteString.head cs, (ByteString.head cs, ByteString.tail cs))--alexInputPrevChar (c,_) = c---- 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' len act -> act (ByteString.take (fromIntegral len) str) : go inp'-----{-# LINE 322 "templates/wrappers.hs" #-}----- -------------------------------------------------------------------------------- Posn wrapper---- Adds text positions to the basic model.--{-# LINE 339 "templates/wrappers.hs" #-}----- -------------------------------------------------------------------------------- Posn wrapper, ByteString version--{-# LINE 354 "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\xe5\xff\xff\xff\xf1\xff\xff\xff\x09\x00\x00\x00\x14\x00\x00\x00\xfb\xff\xff\xff\x32\x00\x00\x00\x3f\x00\x00\x00\x52\x00\x00\x00\x69\x00\x00\x00\x73\x00\x00\x00\x8e\x00\x00\x00\x98\x00\x00\x00\xa7\x00\x00\x00\xb1\x00\x00\x00\xbb\x00\x00\x00\xc3\x00\x00\x00"#--alex_table :: AlexAddr-alex_table = AlexA# "\x00\x00\x09\x00\x00\x00\x09\x00\x00\x00\x00\x00\x03\x00\x02\x00\x02\x00\x02\x00\x02\x00\x02\x00\x02\x00\x02\x00\x02\x00\x02\x00\x09\x00\x00\x00\x09\x00\x00\x00\x00\x00\x03\x00\x02\x00\x02\x00\x02\x00\x02\x00\x02\x00\x02\x00\x02\x00\x02\x00\x02\x00\x0a\x00\x00\x00\x02\x00\x02\x00\x02\x00\x02\x00\x02\x00\x02\x00\x02\x00\x02\x00\x02\x00\x02\x00\x05\x00\x05\x00\x05\x00\x05\x00\x05\x00\x05\x00\x05\x00\x05\x00\x05\x00\x05\x00\x00\x00\x0d\x00\x0a\x00\x00\x00\x02\x00\x02\x00\x02\x00\x02\x00\x02\x00\x02\x00\x02\x00\x02\x00\x02\x00\x02\x00\x00\x00\x04\x00\x04\x00\x04\x00\x04\x00\x04\x00\x04\x00\x04\x00\x04\x00\x04\x00\x04\x00\x0d\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x0d\x00\x00\x00\x0f\x00\x0b\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x10\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\x0d\x00\x07\x00\x07\x00\x07\x00\x07\x00\x07\x00\x07\x00\x07\x00\x07\x00\x00\x00\x0f\x00\x0b\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x10\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\x08\x00\x08\x00\x08\x00\x08\x00\x08\x00\x08\x00\x03\x00\x02\x00\x02\x00\x02\x00\x02\x00\x02\x00\x02\x00\x02\x00\x02\x00\x02\x00\x04\x00\x04\x00\x04\x00\x04\x00\x04\x00\x04\x00\x04\x00\x04\x00\x04\x00\x04\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x08\x00\x08\x00\x08\x00\x08\x00\x08\x00\x08\x00\x0c\x00\x00\x00\x0c\x00\x00\x00\x00\x00\x05\x00\x05\x00\x05\x00\x05\x00\x05\x00\x05\x00\x05\x00\x05\x00\x05\x00\x05\x00\x05\x00\x05\x00\x05\x00\x05\x00\x05\x00\x05\x00\x05\x00\x05\x00\x05\x00\x05\x00\x0e\x00\x00\x00\x0e\x00\x00\x00\x00\x00\x06\x00\x06\x00\x06\x00\x06\x00\x06\x00\x06\x00\x06\x00\x06\x00\x06\x00\x06\x00\x06\x00\x06\x00\x06\x00\x06\x00\x06\x00\x06\x00\x06\x00\x06\x00\x06\x00\x06\x00\x07\x00\x07\x00\x07\x00\x07\x00\x07\x00\x07\x00\x07\x00\x07\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\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\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\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\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\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\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\x2e\x00\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\x45\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\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\x37\x00\x38\x00\x39\x00\x45\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x65\x00\xff\xff\x4f\x00\x45\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\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\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\x37\x00\xff\xff\x6f\x00\x65\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x78\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\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\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x61\x00\x62\x00\x63\x00\x64\x00\x65\x00\x66\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\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\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\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x61\x00\x62\x00\x63\x00\x64\x00\x65\x00\x66\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"#--alex_deflt :: AlexAddr-alex_deflt = AlexA# "\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\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_accept = listArray (0::Int,16) [[],[],[(AlexAcc (alex_action_0))],[(AlexAcc (alex_action_0))],[(AlexAcc (alex_action_0))],[(AlexAcc (alex_action_0))],[(AlexAcc (alex_action_0))],[(AlexAcc (alex_action_0))],[(AlexAcc (alex_action_0))],[],[],[],[],[],[],[],[]]-{-# LINE 49 "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-precisoin 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 "<built-in>" #-}-{-# LINE 1 "<command-line>" #-}-{-# 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 35 "templates/GenericTemplate.hs" #-}--{-# LINE 45 "templates/GenericTemplate.hs" #-}---data AlexAddr = AlexA# Addr#--#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 alexGetChar 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 alexGetChar input of- Nothing -> (new_acc, input)- Just (c, new_input) -> ---- let- base = alexIndexInt32OffAddr alex_base s- (I# (ord_c)) = ord c- offset = (base +# ord_c)- check = alexIndexInt16OffAddr alex_check offset- - new_s = if (offset >=# 0#) && (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 (len +# 1#) - new_input new_s new_acc-- where- check_accs [] = last_acc- check_accs (AlexAcc a : _) = AlexLastAcc a input (I# (len))- check_accs (AlexAccSkip : _) = AlexLastSkip input (I# (len))- check_accs (AlexAccPred a pred : rest)- | pred user orig_input (I# (len)) input- = AlexLastAcc a input (I# (len))- check_accs (AlexAccSkipPred pred : rest)- | pred user orig_input (I# (len)) input- = AlexLastSkip input (I# (len))- check_accs (_ : rest) = check_accs rest--data AlexLastAcc a- = AlexNone- | AlexLastAcc a !AlexInput !Int- | AlexLastSkip !AlexInput !Int--data AlexAcc a user- = AlexAcc a- | AlexAccSkip- | AlexAccPred a (AlexAccPred user)- | AlexAccSkipPred (AlexAccPred user)--type AlexAccPred user = user -> AlexInput -> Int -> AlexInput -> Bool---- -------------------------------------------------------------------------------- Predicates on a rule--alexAndPred p1 p2 user in1 len in2- = p1 user in1 len in2 && p2 user in1 len in2----alexPrevCharIsPred :: Char -> AlexAccPred _ -alexPrevCharIs c _ input _ _ = c == alexInputPrevChar input----alexPrevCharIsOneOfPred :: Array Char Bool -> AlexAccPred _ -alexPrevCharIsOneOf arr _ input _ _ = arr ! alexInputPrevChar input----alexRightContext :: Int -> AlexAccPred _-alexRightContext (I# (sc)) user _ _ input = - case alex_scan_tkn user input 0# input sc AlexNone of- (AlexNone, _) -> False- _ -> True- -- TODO: there's no need to find the longest- -- match when checking the right context, just- -- the first match will do.---- used by wrappers-iUnbox (I# (i)) = i
− Data/ByteString/Lex/Lazy/Double.x
@@ -1,91 +0,0 @@-{ {-*- haskell -*-}------------------------------------------------------------------------- |--- Module : Data.ByteString.Lex.Lazy.Double--- Copyright : (c) Galois, Inc. 2008--- License : All rights reserved------ Maintainer: Don Stewart <dons@galois.com>--- Stability : provisional--- Portability:------------------------------------------------------------------------------ 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-precisoin 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-}
LICENSE view
@@ -1,4 +1,4 @@-Copyright (c) Don Stewart 2008+Copyright (c) wren gayle romano 2012--2015; Don Stewart 2008, 2010 All rights reserved.
+ README.md view
@@ -0,0 +1,175 @@+bytestring-lexing+=================+[](https://hackage.haskell.org/package/bytestring-lexing) +[](https://github.com/wrengr/bytestring-lexing/actions?query=workflow%3Aci)+[](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)
+ Setup.hs view
@@ -0,0 +1,7 @@+#!/usr/bin/env runhaskell++module Main (main) where+import Distribution.Simple++main :: IO ()+main = defaultMain
− Setup.lhs
@@ -1,3 +0,0 @@-#!/usr/bin/env runhaskell-> import Distribution.Simple-> main = defaultMain
bytestring-lexing.cabal view
@@ -1,30 +1,148 @@-Name: bytestring-lexing-Version: 0.2-Synopsis: Parse literals efficiently from bytestrings-Description: Parse literals efficiently from bytestrings-License: BSD3-License-file: LICENSE-Category: Data-Copyright: Copyright (c) Don Stewart 2008-Author: Don Stewart-Maintainer: dons@galois.com-Stability: provisional-Homepage: http://code.haskell.org/~dons/code/bytestring-lexing-Tested-With: GHC ==6.8.2, GHC ==6.10.1-Build-Type: Simple-Cabal-Version: >= 1.2+Cabal-Version: 2.2+-- Cabal >=2.2 is required for:+-- <https://cabal.readthedocs.io/en/latest/cabal-package.html#common-stanzas>+-- Since 2.1, the Cabal-Version must be the absolutely first thing+-- in the file, even before comments. Also, no longer uses ">=".+-- <https://github.com/haskell/cabal/issues/4899> -flag small_base- description: Choose the new smaller, split-up base package.+----------------------------------------------------------------+-- wren gayle romano <wren@cpan.org> ~ 2025-02-11+---------------------------------------------------------------- -library- exposed-modules: Data.ByteString.Lex.Double- Data.ByteString.Lex.Lazy.Double- other-modules: Data.ByteString.Lex.Internal+Name: bytestring-lexing+Version: 0.5.0.15+Build-Type: Simple+Stability: provisional+Homepage: https://wrengr.org/software/hackage.html+Bug-Reports: https://github.com/wrengr/bytestring-lexing/issues+Author: wren gayle romano, Don Stewart+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 - if flag(small_base)- build-depends: base >= 3, bytestring, array- else- build-depends: base < 3+Category: Data+Synopsis:+ Efficiently parse and produce common integral and fractional numbers.+Description:+ 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:+ <https://github.com/wrengr/bytestring-lexing/tree/master/bench/html> - ghc-options: -O2+----------------------------------------------------------------+Extra-source-files:+ AUTHORS, CHANGELOG, README.md++-- We only list here what is still being verified by CI:+-- <https://github.com/wrengr/bytestring-lexing/actions?query=workflow%3Aci>+-- For older versions of GHC and older versions of this library, see:+-- <https://matrix.hackage.haskell.org/#/package/bytestring-lexing/>+-- And if needed, you can try relaxing the lower bounds according to:+-- <https://gitlab.haskell.org/ghc/ghc/-/wikis/commentary/libraries/version-history>+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: git+ Location: https://github.com/wrengr/bytestring-lexing.git++----------------------------------------------------------------+-- This stanza requires Cabal>=2.2:+-- <https://cabal.readthedocs.io/en/latest/cabal-package.html#common-stanzas>+-- 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.+ -- <https://github.com/haskell/bytestring/pull/175>+ Build-Depends: base >= 4.9 && < 4.22+ , bytestring >= 0.10.8 && < 0.13++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++----------------------------------------------------------------+-- <https://www.haskell.org/cabal/users-guide/developing-packages.html#test-suites>+-- 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.,+-- <http://hackage.haskell.org/package/Decimal-0.4.2/src/Decimal.cabal> Or+-- the tasty* family of packages with exitcode-stdio-1.0. Notice+-- that test-framework-smallcheck is deprecated in favor of+-- tasty-smallcheck. Both have more dependencies than Cabal, so+-- will be harder to install on legacy systems; but then we wouldn't+-- have to maintain our own code to glue into Cabal's detailed-0.9.+-- Note that the oldest Tasty requires base>=4.5 whereas the oldest+-- test-framework seems to have no lower bound on base.++Test-Suite test-all+ 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 <https://github.com/haskell/cabal/issues/5119>:+ -- 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.
+ src/Data/ByteString/Lex/Fractional.hs view
@@ -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.
+ src/Data/ByteString/Lex/Integral.hs view
@@ -0,0 +1,666 @@+{-# OPTIONS_GHC -Wall -fwarn-tabs #-}+{-# LANGUAGE BangPatterns #-}+----------------------------------------------------------------+-- 2021.10.17+-- |+-- Module : Data.ByteString.Lex.Integral+-- Copyright : Copyright (c) 2010--2021 wren gayle romano+-- License : BSD2+-- Maintainer : wren@cpan.org+-- Stability : provisional+-- 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+ (+ -- * General combinators+ readSigned+ -- , packSigned+ -- * Decimal conversions+ , readDecimal+ , readDecimal_+ , packDecimal+ -- TODO: asDecimal -- this will be really hard to make efficient...+ -- * Hexadecimal conversions+ , readHexadecimal+ , packHexadecimal+ , asHexadecimal+ -- * Octal conversions+ , readOctal+ , packOctal+ -- TODO: asOctal -- this will be really hard to make efficient...+ ) where++import Data.ByteString (ByteString)+import qualified Data.ByteString as BS+import qualified Data.ByteString.Char8 as BS8 (pack)+import qualified Data.ByteString.Internal as BSI+import qualified Data.ByteString.Unsafe as BSU+import Data.Int+import Data.Word+import Data.Bits+import Foreign.Ptr (Ptr, plusPtr)+import qualified Foreign.ForeignPtr as FFI (withForeignPtr)+import Foreign.Storable (peek, poke)+import Data.ByteString.Lex.Internal++----------------------------------------------------------------+----- General++-- TODO: On the one hand, making this a combinator is "the right+-- thing to do" for generality. However, for performance critical+-- code, we could optimize away some extraneous guards if we just+-- 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.+readSigned+ :: (Num a)+ => (ByteString -> Maybe (a, ByteString))+ -> ByteString -> Maybe (a, ByteString)+readSigned f xs+ | BS.null xs = Nothing+ | otherwise =+ case BSU.unsafeHead xs of+ 0x2D -> f (BSU.unsafeTail xs) >>= \(n, ys) -> return (negate n, ys)+ 0x2B -> f (BSU.unsafeTail xs)+ _ -> f xs+++----------------------------------------------------------------+----- Decimal++{-+-- 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+ -- This implementation is near verbatim from+ -- bytestring-0.9.1.7:Data.ByteString.Char8.readInt. We do+ -- remove the superstrictness by lifting the 'Just' so it can+ -- be returned after seeing the first byte. Do beware of the+ -- scope of 'fromIntegral', we want to avoid unnecessary+ -- 'Integral' operations and do as much as possible in 'Word8'.+ start xs+ | BS.null xs = Nothing+ | otherwise =+ case BSU.unsafeHead xs of+ w | 0x39 >= w && w >= 0x30 ->+ Just $ loop (fromIntegral (w - 0x30)) (BSU.unsafeTail xs)+ | otherwise -> Nothing++ 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 ->+ loop (n * 10 + fromIntegral (w - 0x30)) (BSU.unsafeTail xs)+ | otherwise -> (n,xs)+-}++-- | Read an unsigned\/non-negative integral value in ASCII decimal+-- 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.+--+-- If you are extremely concerned with performance, then it is more+-- performant to use this function at @Int@ or @Word@ and then to+-- 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)+{-# SPECIALIZE readDecimal ::+ ByteString -> Maybe (Int, ByteString),+ ByteString -> Maybe (Int8, ByteString),+ ByteString -> Maybe (Int16, ByteString),+ ByteString -> Maybe (Int32, ByteString),+ ByteString -> Maybe (Int64, ByteString),+ ByteString -> Maybe (Integer, ByteString),+ ByteString -> Maybe (Word, ByteString),+ ByteString -> Maybe (Word8, ByteString),+ ByteString -> Maybe (Word16, ByteString),+ ByteString -> Maybe (Word32, ByteString),+ ByteString -> Maybe (Word64, ByteString) #-}+readDecimal = start+ where+ -- TODO: should we explicitly drop all leading zeros before we jump into the unrolled loop?+ start :: (Integral a) => ByteString -> Maybe (a, ByteString)+ start xs+ | BS.null xs = Nothing+ | otherwise =+ case BSU.unsafeHead xs of+ w | isDecimal w -> Just $ loop0 (toDigit w) (BSU.unsafeTail xs)+ | otherwise -> Nothing++ loop0 :: (Integral a) => a -> ByteString -> (a, ByteString)+ loop0 !m !xs+ | BS.null xs = (m, BS.empty)+ | otherwise =+ case BSU.unsafeHead xs of+ w | isDecimal w -> loop1 m (toDigit w) (BSU.unsafeTail xs)+ | otherwise -> (m, xs)++ loop1, loop2, loop3, loop4, loop5, loop6, loop7, loop8+ :: (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+ | 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+ | 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+ | 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+ | 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+ | 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+ | 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+ | BS.null xs = (m*100000000 + fromIntegral n, BS.empty)+ | otherwise =+ case BSU.unsafeHead xs of+ w | isDecimal w -> loop0+ (m*1000000000 + fromIntegral (addDigit n w))+ (BSU.unsafeTail xs)+ | otherwise -> (m*100000000 + fromIntegral n, xs)++----------------------------------------------------------------++-- | A variant of 'readDecimal' which does not return the tail of+-- 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.+--+-- /Since: 0.4.0/+readDecimal_ :: (Integral a) => ByteString -> a+{-# SPECIALIZE readDecimal_ ::+ ByteString -> Int,+ ByteString -> Int8,+ ByteString -> Int16,+ ByteString -> Int32,+ ByteString -> Int64,+ ByteString -> Integer,+ ByteString -> Word,+ ByteString -> Word8,+ ByteString -> Word16,+ ByteString -> Word32,+ ByteString -> Word64 #-}+readDecimal_ = start+ where+ start xs+ | BS.null xs = 0+ | otherwise =+ case BSU.unsafeHead xs of+ w | isDecimal w -> loop0 (toDigit w) (BSU.unsafeTail xs)+ | otherwise -> 0++ loop0 :: (Integral a) => a -> ByteString -> a+ loop0 !m !xs+ | BS.null xs = m+ | otherwise =+ case BSU.unsafeHead xs of+ w | isDecimal w -> loop1 m (toDigit w) (BSU.unsafeTail xs)+ | otherwise -> m++ loop1, loop2, loop3, loop4, loop5, loop6, loop7, loop8+ :: (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+ | 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+ | 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+ | 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+ | 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+ | 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+ | 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+ | BS.null xs = m*100000000 + fromIntegral n+ | otherwise =+ case BSU.unsafeHead xs of+ w | isDecimal w -> loop0+ (m*1000000000 + fromIntegral (addDigit n w))+ (BSU.unsafeTail xs)+ | otherwise -> m*100000000 + fromIntegral n++----------------------------------------------------------------+-- | Convert a non-negative integer into an (unsigned) ASCII decimal+-- string. Returns @Nothing@ on negative inputs.+packDecimal :: (Integral a) => a -> Maybe ByteString+{-# INLINE packDecimal #-}+packDecimal n+ | n < 0 = Nothing+ | otherwise = Just (unsafePackDecimal n)+++-- This implementation is modified from:+-- <http://www.serpentine.com/blog/2013/03/20/whats-good-for-c-is-good-for-haskell/>+-- 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.+unsafePackDecimal :: (Integral a) => a -> ByteString+{-# SPECIALIZE unsafePackDecimal ::+ Int -> ByteString,+ Int8 -> ByteString,+ Int16 -> ByteString,+ Int32 -> ByteString,+ Int64 -> ByteString,+ Integer -> ByteString,+ Word -> ByteString,+ Word8 -> ByteString,+ Word16 -> ByteString,+ Word32 -> ByteString,+ Word64 -> ByteString #-}+unsafePackDecimal n0 =+ let size = numDecimalDigits n0+ in BSI.unsafeCreate size $ \p0 -> loop n0 (p0 `plusPtr` (size - 1))+ where+ getDigit = BSU.unsafeIndex packDecimal_digits++ 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 = 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:+-- <https://github.com/haskell/bytestring/pull/418>+packDecimal_digits :: ByteString+{-# NOINLINE packDecimal_digits #-}+packDecimal_digits = BS8.pack+ "0001020304050607080910111213141516171819\+ \2021222324252627282930313233343536373839\+ \4041424344454647484950515253545556575859\+ \6061626364656667686970717273747576777879\+ \8081828384858687888990919293949596979899"++----------------------------------------------------------------+----------------------------------------------------------------+----- 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.+readHexadecimal :: (Integral a) => ByteString -> Maybe (a, ByteString)+{-# SPECIALIZE readHexadecimal ::+ ByteString -> Maybe (Int, ByteString),+ ByteString -> Maybe (Int8, ByteString),+ ByteString -> Maybe (Int16, ByteString),+ ByteString -> Maybe (Int32, ByteString),+ ByteString -> Maybe (Int64, ByteString),+ ByteString -> Maybe (Integer, ByteString),+ ByteString -> Maybe (Word, ByteString),+ ByteString -> Maybe (Word8, ByteString),+ ByteString -> Maybe (Word16, ByteString),+ ByteString -> Maybe (Word32, ByteString),+ ByteString -> Maybe (Word64, ByteString) #-}+readHexadecimal = start+ where+ -- TODO: Would it be worth trying to do the magichash trick+ -- used by Warp here? It'd really help remove branch prediction+ -- issues etc.+ --+ -- Beware the urge to make this code prettier, cf 'readDecimal'.+ start xs+ | BS.null xs = Nothing+ | otherwise =+ case BSU.unsafeHead xs of+ w | 0x39 >= w && w >= 0x30 ->+ Just $ loop (fromIntegral (w - 0x30)) (BSU.unsafeTail xs)+ | 0x46 >= w && w >= 0x41 ->+ Just $ loop (fromIntegral (w-0x41+10)) (BSU.unsafeTail xs)+ | 0x66 >= w && w >= 0x61 ->+ Just $ loop (fromIntegral (w-0x61+10)) (BSU.unsafeTail xs)+ | otherwise -> Nothing++ 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 ->+ loop (n*16 + fromIntegral (w - 0x30)) (BSU.unsafeTail xs)+ | 0x46 >= w && w >= 0x41 ->+ loop (n*16 + fromIntegral (w-0x41+10)) (BSU.unsafeTail xs)+ | 0x66 >= w && w >= 0x61 ->+ loop (n*16 + fromIntegral (w-0x61+10)) (BSU.unsafeTail xs)+ | otherwise -> (n,xs)+++-- | Convert a non-negative integer into a lower-case ASCII hexadecimal+-- string. Returns @Nothing@ on negative inputs.+packHexadecimal :: (Integral a) => a -> Maybe ByteString+{-# INLINE packHexadecimal #-}+packHexadecimal n+ | n < 0 = Nothing+ | otherwise = Just (unsafePackHexadecimal n)+++-- | Convert a non-negative integer into a lower-case ASCII hexadecimal+-- string. This function is unsafe to use on negative inputs.+unsafePackHexadecimal :: (Integral a) => a -> ByteString+{-# SPECIALIZE unsafePackHexadecimal ::+ Int -> ByteString,+ Int8 -> ByteString,+ Int16 -> ByteString,+ Int32 -> ByteString,+ Int64 -> ByteString,+ Integer -> ByteString,+ Word -> ByteString,+ Word8 -> ByteString,+ Word16 -> ByteString,+ Word32 -> ByteString,+ Word64 -> ByteString #-}+unsafePackHexadecimal n0 =+ let size = numTwoPowerDigits 4 (toInteger n0) -- for Bits+ in BSI.unsafeCreate size $ \p0 ->+ loop n0 (p0 `plusPtr` (size - 1))+ where+ -- TODO: benchmark using @hexDigits@ vs using direct manipulations.+ loop :: (Integral a) => a -> Ptr Word8 -> IO ()+ loop n p+ | n <= 15 = do+ poke p (BSU.unsafeIndex hexDigits (fromIntegral n .&. 0x0F))+ | otherwise = do+ let (q,r) = n `quotRem` 16+ poke p (BSU.unsafeIndex hexDigits (fromIntegral r .&. 0x0F))+ loop q (p `plusPtr` negate 1)+++-- Inspired by, <http://forums.xkcd.com/viewtopic.php?f=11&t=16666&p=553936>+-- | Convert a bitvector into a lower-case ASCII hexadecimal string.+-- This is helpful for visualizing raw binary data, rather than for+-- parsing as such.+asHexadecimal :: ByteString -> ByteString+asHexadecimal = start+ where+ start buf+ | BS.length buf > maxBound `quot` 2 =+ error _asHexadecimal_overflow+ | otherwise =+ BSI.unsafeCreate (2 * BS.length buf) $ \p0 -> do+ _ <- foldIO step p0 buf+ return () -- needed for type checking++ step :: Ptr Word8 -> Word8 -> IO (Ptr Word8)+ 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 #-}+_asHexadecimal_overflow =+ "asHexadecimal: cannot create buffer larger than (maxBound::Int)"+++-- 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:+-- <https://github.com/haskell/bytestring/pull/418>+--+-- | The lower-case ASCII hexadecimal digits, in numerical order+-- for use as a lookup table.+hexDigits :: ByteString+{-# NOINLINE hexDigits #-}+hexDigits = BS8.pack "0123456789abcdef"+++-- | We can only do this for MonadIO not just any Monad, but that's+-- good enough for what we need...+foldIO :: (a -> Word8 -> IO a) -> a -> ByteString -> IO a+{-# INLINE foldIO #-}+foldIO f z0 (BSI.PS fp off len) =+ FFI.withForeignPtr fp $ \p0 -> do+ let q = p0 `plusPtr` (off+len)+ let go !z !p+ | p == q = return z+ | otherwise = do+ w <- peek p+ z' <- f z w+ go z' (p `plusPtr` 1)+ go z0 (p0 `plusPtr` off)+++----------------------------------------------------------------+----------------------------------------------------------------+----- 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.+readOctal :: (Integral a) => ByteString -> Maybe (a, ByteString)+{-# SPECIALIZE readOctal ::+ ByteString -> Maybe (Int, ByteString),+ ByteString -> Maybe (Int8, ByteString),+ ByteString -> Maybe (Int16, ByteString),+ ByteString -> Maybe (Int32, ByteString),+ ByteString -> Maybe (Int64, ByteString),+ ByteString -> Maybe (Integer, ByteString),+ ByteString -> Maybe (Word, ByteString),+ ByteString -> Maybe (Word8, ByteString),+ ByteString -> Maybe (Word16, ByteString),+ ByteString -> Maybe (Word32, ByteString),+ ByteString -> Maybe (Word64, ByteString) #-}+readOctal = start+ where+ start xs+ | BS.null xs = Nothing+ | otherwise =+ case BSU.unsafeHead xs of+ w | 0x37 >= w && w >= 0x30 ->+ Just $ loop (fromIntegral (w - 0x30)) (BSU.unsafeTail xs)+ | otherwise -> Nothing++ 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 ->+ loop (n * 8 + fromIntegral (w - 0x30)) (BSU.unsafeTail xs)+ | otherwise -> (n,xs)+++-- | Convert a non-negative integer into an ASCII octal string.+-- Returns @Nothing@ on negative inputs.+packOctal :: (Integral a) => a -> Maybe ByteString+{-# INLINE packOctal #-}+packOctal n+ | n < 0 = Nothing+ | otherwise = Just (unsafePackOctal n)+++-- | Convert a non-negative integer into an ASCII octal string.+-- This function is unsafe to use on negative inputs.+unsafePackOctal :: (Integral a) => a -> ByteString+{-# SPECIALIZE unsafePackOctal ::+ Int -> ByteString,+ Int8 -> ByteString,+ Int16 -> ByteString,+ Int32 -> ByteString,+ Int64 -> ByteString,+ Integer -> ByteString,+ Word -> ByteString,+ Word8 -> ByteString,+ Word16 -> ByteString,+ Word32 -> ByteString,+ Word64 -> ByteString #-}+unsafePackOctal n0 =+ let size = numTwoPowerDigits 3 (toInteger n0) -- for Bits+ in BSI.unsafeCreate size $ \p0 ->+ loop n0 (p0 `plusPtr` (size - 1))+ where+ loop :: (Integral a) => a -> Ptr Word8 -> IO ()+ loop n p+ | n <= 7 = do+ poke p (0x30 + fromIntegral n)+ | otherwise = do+ let (q,r) = n `quotRem` 8+ poke p (0x30 + fromIntegral r)+ loop q (p `plusPtr` negate 1)++{-+-- BUG: This doesn't quite work right...+asOctal :: ByteString -> ByteString+asOctal buf =+ BSI.unsafeCreate (ceilEightThirds $ BS.length buf) $ \p0 -> do+ let (BSI.PS fq off len) = buf+ FFI.withForeignPtr fq $ \q0 -> do+ let qF = q0 `plusPtr` (off + len - rem len 3)+ let loop :: Ptr Word8 -> Ptr Word8 -> IO ()+ loop p q+ | q /= qF = do+ {- Take three Word8s and write 8 chars at a time -}+ i <- peek q+ j <- peek (q `plusPtr` 1) :: IO Word8+ k <- peek (q `plusPtr` 2) :: IO Word8+ let w = fromIntegral i+ .|. (fromIntegral j `shiftL` 8)+ .|. (fromIntegral k `shiftL` 16)+ poke p (toC8( w .&. 0x07))+ poke (p `plusPtr` 1) (toC8((w `shiftR` 3) .&. 0x07))+ poke (p `plusPtr` 2) (toC8((w `shiftR` 6) .&. 0x07))+ poke (p `plusPtr` 3) (toC8((w `shiftR` 9) .&. 0x07))+ poke (p `plusPtr` 4) (toC8((w `shiftR` 12) .&. 0x07))+ poke (p `plusPtr` 5) (toC8((w `shiftR` 15) .&. 0x07))+ poke (p `plusPtr` 6) (toC8((w `shiftR` 18) .&. 0x07))+ poke (p `plusPtr` 7) (toC8((w `shiftR` 21) .&. 0x07))+ loop (p `plusPtr` 8) (q `plusPtr` 3)+ | 2 == rem len 3 = do+ {- Handle the last two Word8s -}+ i <- peek q+ j <- peek (q `plusPtr` 1) :: IO Word8+ let w = fromIntegral i+ .|. (fromIntegral j `shiftL` 8)+ poke p (toC8( w .&. 0x07))+ poke (p `plusPtr` 1) (toC8((w `shiftR` 3) .&. 0x07))+ poke (p `plusPtr` 2) (toC8((w `shiftR` 6) .&. 0x07))+ poke (p `plusPtr` 3) (toC8((w `shiftR` 9) .&. 0x07))+ poke (p `plusPtr` 4) (toC8((w `shiftR` 12) .&. 0x07))+ poke (p `plusPtr` 5) (toC8((w `shiftR` 15) .&. 0x01))+ | otherwise = do+ {- Handle the last Word8 -}+ i <- peek q+ let w = fromIntegral i+ poke p (toC8( w .&. 0x07))+ poke (p `plusPtr` 1) (toC8((w `shiftR` 3) .&. 0x07))+ poke (p `plusPtr` 2) (toC8((w `shiftR` 6) .&. 0x03))+ --+ loop p0 (q0 `plusPtr` off)+ where+ toC8 :: Int -> Word8+ toC8 i = fromIntegral (0x30+i)+ {-# INLINE toC8 #-}+ -- We can probably speed that up by using (.|.) in lieu of (+)++ -- See the benchmark file for credits and implementation details.+ ceilEightThirds x+ | x >= 3*(b-1) = error _asOctal_overflow+ | x >= b = ceiling (fromIntegral x / 3 * 8 :: Double)+ | otherwise = (x*8 + 2) `quot` 3+ where+ {-# INLINE b #-}+ b = 2^(28::Int)::Int -- b*8-1 is the last positive number for Int=Int32+ -- TODO: need to generalize for Int=Int64++_asOctal_overflow :: String+{-# NOINLINE _asOctal_overflow #-}+_asOctal_overflow =+ "asOctal: cannot create buffer larger than (maxBound::Int)"+-- -}++----------------------------------------------------------------+----------------------------------------------------------- fin.
+ src/Data/ByteString/Lex/Internal.hs view
@@ -0,0 +1,195 @@+{-# OPTIONS_GHC -Wall -fwarn-tabs #-}+{-# LANGUAGE BangPatterns #-}+----------------------------------------------------------------+-- 2024-04-11+-- |+-- Module : Data.ByteString.Lex.Internal+-- Copyright : Copyright (c) 2010--2024 wren gayle romano+-- License : BSD2+-- Maintainer : wren@cpan.org+-- Stability : provisional+-- Portability : BangPatterns+--+-- 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++import Data.Word (Word8, Word64)+import Data.Bits (Bits(shiftR))++----------------------------------------------------------------+----------------------------------------------------------------+----- Character-based bit-bashing++{-# INLINE isNotPeriod #-}+isNotPeriod :: Word8 -> Bool+isNotPeriod w = w /= 0x2E++{-# INLINE isNotE #-}+isNotE :: Word8 -> Bool+isNotE w = w /= 0x65 && w /= 0x45++{-# INLINE isDecimal #-}+isDecimal :: Word8 -> Bool+isDecimal w = 0x39 >= w && w >= 0x30++{-# INLINE isDecimalZero #-}+isDecimalZero :: Word8 -> Bool+isDecimalZero w = w == 0x30++{-# INLINE toDigit #-}+toDigit :: (Integral a) => Word8 -> a+toDigit w = fromIntegral (w - 0x30)++{-# INLINE addDigit #-}+addDigit :: Int -> Word8 -> Int+addDigit n w = n * 10 + toDigit w++----------------------------------------------------------------+----- Integral logarithms++-- TODO: cf. integer-gmp:GHC.Integer.Logarithms made available in+-- version 0.3.0.0 (ships with GHC 7.2.1).+-- <http://haskell.org/ghc/docs/7.2.1/html/libraries/integer-gmp-0.3.0.0/GHC-Integer-Logarithms.html>+++-- This implementation is derived from+-- <http://www.haskell.org/pipermail/haskell-cafe/2009-August/065854.html>+-- 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:+-- <http://www.serpentine.com/blog/2013/03/20/whats-good-for-c-is-good-for-haskell/>+--+-- | 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.
+ test/Fractional.hs view
@@ -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.
+ test/Integral.hs view
@@ -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.
+ test/Main.hs view
@@ -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.