bytestring-lexing 0.4.3.3 → 0.5.0
raw patch · 12 files changed
+641/−1252 lines, 12 filesdep −arraydep ~basedep ~bytestringPVP ok
version bump matches the API change (PVP)
Dependencies removed: array
Dependency ranges changed: base, bytestring
API changes (from Hackage documentation)
- Data.ByteString.Lex.Double: instance Functor AlexLastAcc
- Data.ByteString.Lex.Double: readDouble :: ByteString -> Maybe (Double, ByteString)
- Data.ByteString.Lex.Double: unsafeReadDouble :: ByteString -> Maybe (Double, ByteString)
- Data.ByteString.Lex.Lazy.Double: instance Functor AlexLastAcc
- Data.ByteString.Lex.Lazy.Double: readDouble :: ByteString -> Maybe (Double, ByteString)
+ Data.ByteString.Lex.Fractional: decimalPrecision :: RealFloat a => proxy a -> Int
+ Data.ByteString.Lex.Fractional: readDecimal :: Fractional a => ByteString -> Maybe (a, ByteString)
+ Data.ByteString.Lex.Fractional: readDecimalLimited :: Fractional a => Int -> ByteString -> Maybe (a, ByteString)
+ Data.ByteString.Lex.Fractional: readExponential :: Fractional a => ByteString -> Maybe (a, ByteString)
+ Data.ByteString.Lex.Fractional: readExponentialLimited :: Fractional a => Int -> ByteString -> Maybe (a, ByteString)
+ Data.ByteString.Lex.Fractional: readHexadecimal :: Fractional a => ByteString -> Maybe (a, ByteString)
+ Data.ByteString.Lex.Fractional: readOctal :: Fractional a => ByteString -> Maybe (a, ByteString)
+ Data.ByteString.Lex.Fractional: readSigned :: Num a => (ByteString -> Maybe (a, ByteString)) -> ByteString -> Maybe (a, ByteString)
Files
- AUTHORS +4/−0
- CHANGELOG +7/−0
- LICENSE +1/−1
- README +0/−0
- bytestring-lexing.cabal +13/−50
- dist/build/Data/ByteString/Lex/Double.hs +0/−438
- dist/build/Data/ByteString/Lex/Lazy/Double.hs +0/−400
- src/Data/ByteString/Lex/Double.x +0/−121
- src/Data/ByteString/Lex/Fractional.hs +468/−0
- src/Data/ByteString/Lex/Integral.hs +16/−132
- src/Data/ByteString/Lex/Internal.hs +132/−19
- src/Data/ByteString/Lex/Lazy/Double.x +0/−91
AUTHORS view
@@ -12,3 +12,7 @@ Erik de Castro Lopo, Vincent Hanquez, and Christoph Breitkopf --- for excessive tweaking and benchmarking of the readDecimal function.++Hirotomo Moriwaki --- for highlighting the inefficiency of the old+ Alex-based parser by publishing bytestring-read. And for the+ idea behind the new (v0.5.0) limited-precision parsers.
CHANGELOG view
@@ -1,3 +1,10 @@+0.5.0 (2015-05-05):+ - 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):
LICENSE view
@@ -1,4 +1,4 @@-Copyright (c) wren gayle romano 2012--2013; Don Stewart 2008, 2010+Copyright (c) wren gayle romano 2012--2015; Don Stewart 2008, 2010 All rights reserved.
README view
bytestring-lexing.cabal view
@@ -1,5 +1,5 @@ ------------------------------------------------------------------- wren gayle romano <wren@community.haskell.org> ~ 2015.05.30+-- wren gayle romano <wren@community.haskell.org> ~ 2015.06.05 ---------------------------------------------------------------- -- By and large Cabal >=1.2 is fine; but >= 1.6 gives tested-with:@@ -8,13 +8,13 @@ Build-Type: Simple Name: bytestring-lexing-Version: 0.4.3.3+Version: 0.5.0 Stability: provisional Homepage: http://code.haskell.org/~wren/ Author: wren gayle romano, Don Stewart Maintainer: wren@community.haskell.org Copyright: Copyright (c) 2012--2015 wren gayle romano, 2008--2011 Don Stewart-License: BSD3+License: BSD2 License-File: LICENSE Category: Data@@ -26,8 +26,10 @@ Some benchmarks for this package can be found at: <http://community.haskell.org/~wren/bytestring-lexing/test/bench/html> ++-- Formerly tested with GHCs 6.8.2, 6.10.1, 6.12.1, 7.0.3, 7.6.1, 7.8.0; but those are no longer verified. Tested-With:- GHC ==6.8.2, GHC ==6.10.1, GHC ==6.12.1, GHC ==7.0.3, GHC ==7.6.1, GHC == 7.8.0+ GHC ==7.8.3, GHC == 7.10.1 Extra-source-files: AUTHORS, README, CHANGELOG Source-Repository head@@ -35,54 +37,15 @@ Location: http://community.haskell.org/~wren/bytestring-lexing -----------------------------------------------------------------Flag base4- Default: True- Description: base-4.0 emits "Prelude deprecated" messages in- order to get people to be explicit about which- version of base they use.-Flag splitBase- Default: True- Description: base-3.0 (GHC 6.8) broke out the packages: array,- bytestring, containers, directory, old-locale,- old-time, packedstring, pretty, process, random.-Flag bytestringInBase- Default: False- Description: The bytestring library was included in base-2.0- and base-2.1.1, but for base-1.0 and base-3.0 it- was a separate package.----------------------------------------------------------------- Library- Hs-Source-Dirs: src- Exposed-Modules: Data.ByteString.Lex.Integral- Data.ByteString.Lex.Double- Data.ByteString.Lex.Lazy.Double- Other-Modules: Data.ByteString.Lex.Internal-- -- I think this is all that needs doing to get rid of the warnings?- if flag(base4)- Build-Depends: base >= 4 && < 5- else- Build-Depends: base < 4+ Ghc-Options: -O2+ Hs-Source-Dirs: src+ Exposed-Modules: Data.ByteString.Lex.Integral+ Data.ByteString.Lex.Fractional+ Other-Modules: Data.ByteString.Lex.Internal - if flag(bytestringInBase)- Build-Depends: base >= 2.0 && < 2.2- else- Build-Depends: base < 2.0 || >= 3, bytestring-- if flag(splitBase)- Build-Depends: base >= 3 && < 5, bytestring, array- else- Build-Depends: base < 3-- Ghc-Options: -O2-- -- bytestring-posn was added in alex >= 2.3 (2008)- -- GHC 7.8.2 requires alex >= 3.1.3...- if impl(ghc >= 7.8)- Build-Tools: alex >= 3.1.3- else- Build-Tools: alex >= 2.3-+ -- Should actually be able to work as far back as base-2.0...+ Build-Depends: base >= 4 && < 5, bytestring ---------------------------------------------------------------- ----------------------------------------------------------- fin.
− dist/build/Data/ByteString/Lex/Double.hs
@@ -1,438 +0,0 @@-{-# LANGUAGE CPP,MagicHash #-}-{-# LINE 1 "src/Data/ByteString/Lex/Double.x" #-}---- Turn off some common warnings about Alex-generated code.--- {-# OPTIONS_GHC -Wall -fno-warn-tabs -fno-warn-missing-signatures #-}-------------------------------------------------------------------- 2012.01.25--- |--- Module : Data.ByteString.Lex.Double--- Copyright : Copyright (c) 2008--2011 Don Stewart--- License : BSD2/MIT--- Maintainer : wren@community.haskell.org--- Stability : stable--- Portability : Haskell98------ Efficiently parse floating point literals from a 'ByteString'.-------------------------------------------------------------------module Data.ByteString.Lex.Double (readDouble, unsafeReadDouble) where--import qualified Data.ByteString as B-import Data.ByteString.Internal-import Data.ByteString.Lex.Internal (strtod, c_strtod)-import qualified Data.ByteString.Unsafe as B--import Foreign-import Foreign.C.Types-import Foreign.C.String-------------------------------------------------------------------#if __GLASGOW_HASKELL__ >= 603-#include "ghcconfig.h"-#elif defined(__GLASGOW_HASKELL__)-#include "config.h"-#endif-#if __GLASGOW_HASKELL__ >= 503-import Data.Array-import Data.Char (ord)-import Data.Array.Base (unsafeAt)-#else-import Array-import Char (ord)-#endif-#if __GLASGOW_HASKELL__ >= 503-import GHC.Exts-#else-import GlaExts-#endif-{-# LINE 1 "templates/wrappers.hs" #-}-{-# LINE 1 "templates/wrappers.hs" #-}-{-# LINE 1 "<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 Data.Word (Word8)---------import qualified Data.Char-import qualified Data.ByteString as ByteString-import qualified Data.ByteString.Internal as ByteString-import qualified Data.ByteString.Unsafe as ByteString--{-# LINE 47 "templates/wrappers.hs" #-}--type Byte = Word8---- -------------------------------------------------------------------------------- The input type--{-# LINE 72 "templates/wrappers.hs" #-}--{-# LINE 92 "templates/wrappers.hs" #-}--{-# LINE 106 "templates/wrappers.hs" #-}---data AlexInput = AlexInput { alexChar :: {-# UNPACK #-}!Char- , alexStr :: {-# UNPACK #-}!ByteString.ByteString }--alexInputPrevChar :: AlexInput -> Char-alexInputPrevChar = alexChar--alexGetByte (AlexInput _ cs)- | ByteString.null cs = Nothing- | otherwise = Just $! (ByteString.head cs, AlexInput c cs')- where- (c,cs') = (ByteString.w2c (ByteString.unsafeHead cs)- , ByteString.unsafeTail cs)----- -------------------------------------------------------------------------------- Token positions---- `Posn' records the location of a token in the input text. It has three--- fields: the address (number of chacaters preceding the token), line number--- and column of a token within the file. `start_pos' gives the position of the--- start of the file and `eof_pos' a standard encoding for the end of file.--- `move_pos' calculates the new position after traversing a given character,--- assuming the usual eight character tab stops.--{-# LINE 144 "templates/wrappers.hs" #-}---- -------------------------------------------------------------------------------- Default monad--{-# LINE 242 "templates/wrappers.hs" #-}----- -------------------------------------------------------------------------------- Monad (with ByteString input)--{-# LINE 333 "templates/wrappers.hs" #-}----- -------------------------------------------------------------------------------- Basic wrapper--{-# LINE 360 "templates/wrappers.hs" #-}----- -------------------------------------------------------------------------------- Basic wrapper, ByteString version--{-# LINE 378 "templates/wrappers.hs" #-}------ alexScanTokens :: String -> [token]-alexScanTokens str = go (AlexInput '\n' str)- where go inp@(AlexInput _ str) =- case alexScan inp 0 of- AlexEOF -> []- AlexError _ -> error "lexical error"- AlexSkip inp' len -> go inp'- AlexToken inp'@(AlexInput _ str') _ act -> act (ByteString.unsafeTake len str) : go inp'- where len = ByteString.length str - ByteString.length str'------- -------------------------------------------------------------------------------- Posn wrapper---- Adds text positions to the basic model.--{-# LINE 409 "templates/wrappers.hs" #-}----- -------------------------------------------------------------------------------- Posn wrapper, ByteString version--{-# LINE 424 "templates/wrappers.hs" #-}----- -------------------------------------------------------------------------------- GScan wrapper---- For compatibility with previous versions of Alex, and because we can.--alex_base :: AlexAddr-alex_base = AlexA# "\xd6\xff\xff\xff\xe0\xff\xff\xff\xe8\xff\xff\xff\x04\x00\x00\x00\x0e\x00\x00\x00\x1f\x00\x00\x00\x27\x00\x00\x00\x40\x00\x00\x00\x69\x00\x00\x00"#--alex_table :: AlexAddr-alex_table = AlexA# "\x00\x00\x04\x00\x00\x00\x04\x00\x00\x00\x00\x00\x07\x00\x08\x00\x08\x00\x08\x00\x08\x00\x08\x00\x08\x00\x08\x00\x08\x00\x08\x00\x05\x00\x05\x00\x05\x00\x05\x00\x05\x00\x05\x00\x05\x00\x05\x00\x06\x00\x06\x00\x06\x00\x06\x00\x06\x00\x06\x00\x06\x00\x06\x00\x06\x00\x06\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x06\x00\x06\x00\x06\x00\x06\x00\x06\x00\x06\x00\x03\x00\x00\x00\x03\x00\x00\x00\x00\x00\x08\x00\x08\x00\x08\x00\x08\x00\x08\x00\x08\x00\x08\x00\x08\x00\x08\x00\x08\x00\x07\x00\x08\x00\x08\x00\x08\x00\x08\x00\x08\x00\x08\x00\x08\x00\x08\x00\x08\x00\x00\x00\x06\x00\x06\x00\x06\x00\x06\x00\x06\x00\x06\x00\x05\x00\x05\x00\x05\x00\x05\x00\x05\x00\x05\x00\x05\x00\x05\x00\x06\x00\x06\x00\x06\x00\x06\x00\x06\x00\x06\x00\x06\x00\x06\x00\x06\x00\x06\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x06\x00\x06\x00\x06\x00\x06\x00\x06\x00\x06\x00\x03\x00\x00\x00\x08\x00\x08\x00\x08\x00\x08\x00\x08\x00\x08\x00\x08\x00\x08\x00\x08\x00\x08\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x03\x00\x00\x00\x00\x00\x06\x00\x06\x00\x06\x00\x06\x00\x06\x00\x06\x00\x00\x00\x01\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x03\x00\x02\x00\x08\x00\x08\x00\x08\x00\x08\x00\x08\x00\x08\x00\x08\x00\x08\x00\x08\x00\x08\x00\x00\x00\x00\x00\x03\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x03\x00\x01\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x02\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x03\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00"#--alex_check :: AlexAddr-alex_check = AlexA# "\xff\xff\x2b\x00\xff\xff\x2d\x00\xff\xff\xff\xff\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\x37\x00\x38\x00\x39\x00\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\x37\x00\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\x37\x00\x38\x00\x39\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x41\x00\x42\x00\x43\x00\x44\x00\x45\x00\x46\x00\x2b\x00\xff\xff\x2d\x00\xff\xff\xff\xff\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\x37\x00\x38\x00\x39\x00\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\x37\x00\x38\x00\x39\x00\xff\xff\x61\x00\x62\x00\x63\x00\x64\x00\x65\x00\x66\x00\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\x37\x00\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\x37\x00\x38\x00\x39\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x41\x00\x42\x00\x43\x00\x44\x00\x45\x00\x46\x00\x2e\x00\xff\xff\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\x37\x00\x38\x00\x39\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x45\x00\xff\xff\xff\xff\x61\x00\x62\x00\x63\x00\x64\x00\x65\x00\x66\x00\xff\xff\x4f\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x2e\x00\x58\x00\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\x37\x00\x38\x00\x39\x00\xff\xff\xff\xff\x65\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x45\x00\x6f\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x78\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x65\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff"#--alex_deflt :: AlexAddr-alex_deflt = AlexA# "\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff"#--alex_accept = listArray (0::Int,8) [AlexAccNone,AlexAccNone,AlexAccNone,AlexAccNone,AlexAccNone,AlexAcc (alex_action_0),AlexAcc (alex_action_0),AlexAcc (alex_action_0),AlexAcc (alex_action_0)]-{-# LINE 53 "src/Data/ByteString/Lex/Double.x" #-}----- | Parse the initial portion of the ByteString as a Double precision--- floating point value. The expected form of the numeric literal--- is given by:------ * An optional '+' or '-' sign ------ * Decimal digits, OR------ * 0 [oO] and a sequence of octal digits, OR------ * 0 [xX] and a sequence of hexadecimal digits, OR------ * An optional decimal point, followed by a sequence of decimal digits, ------ * And an optional exponent------ The result is returned as a pair of a double-precision floating--- point value and the remaining input, or @Nothing@ should no parse--- be found.------ For example, to sum a file of floating point numbers, one per line, ------ > import qualified Data.ByteString.Char8 as S--- > import qualified Data.ByteString.Unsafe as S--- > import Data.ByteString.Lex.Double--- > --- > main = print . go 0 =<< S.getContents--- > where--- > go n s = case readDouble s of--- > Nothing -> n--- > Just (k,rest) -> go (n+k) (S.tail rest)----readDouble :: ByteString -> Maybe (Double, ByteString)-readDouble str = case alexScan (AlexInput '\n' str) 0 of- AlexEOF -> Nothing- AlexError _ -> Nothing- AlexToken (AlexInput _ rest) n _ ->- case strtod (B.unsafeTake n str) of d -> d `seq` Just $! (d , rest)--------------------------------------------------------------------- | Bare bones, unsafe wrapper for C's @strtod(3)@. This provides--- a non-copying direct parsing of Double values from a ByteString.--- It uses @strtod@ directly on the bytestring buffer. @strtod@--- requires the string to be null terminated, or for a guarantee--- that parsing will find a floating point value before the end of--- the string.----unsafeReadDouble :: ByteString -> Maybe (Double, ByteString)-{-# INLINE unsafeReadDouble #-}-unsafeReadDouble b- | B.null b = Nothing- | otherwise = inlinePerformIO $- alloca $ \resptr ->- B.unsafeUseAsCString b $ \ptr -> do -- copy just the bytes we want to parse--- resetErrno- d <- c_strtod ptr resptr -- --- err <- getErrno- newPtr <- peek resptr- return $! case d of- 0 | newPtr == ptr -> Nothing--- _ | err == eRANGE -> Nothing -- adds 10% overhead- _ | otherwise ->- let rest = B.unsafeDrop (newPtr `minusPtr` ptr) b- z = realToFrac d- in z `seq` rest `seq` Just $! (z, rest)---alex_action_0 = strtod -{-# LINE 1 "templates/GenericTemplate.hs" #-}-{-# LINE 1 "templates/GenericTemplate.hs" #-}-{-# LINE 1 "<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 21 "templates/GenericTemplate.hs" #-}-------- Do not remove this comment. Required to fix CPP parsing when using GCC and a clang-compiled alex.-#if __GLASGOW_HASKELL__ > 706-#define GTE(n,m) (tagToEnum# (n >=# m))-#define EQ(n,m) (tagToEnum# (n ==# m))-#else-#define GTE(n,m) (n >=# m)-#define EQ(n,m) (n ==# m)-#endif-{-# LINE 51 "templates/GenericTemplate.hs" #-}---data AlexAddr = AlexA# Addr#--- Do not remove this comment. Required to fix CPP parsing when using GCC and a clang-compiled alex.-#if __GLASGOW_HASKELL__ < 503-uncheckedShiftL# = shiftL#-#endif--{-# INLINE alexIndexInt16OffAddr #-}-alexIndexInt16OffAddr (AlexA# arr) off =-#ifdef WORDS_BIGENDIAN- narrow16Int# i- where- i = word2Int# ((high `uncheckedShiftL#` 8#) `or#` low)- high = int2Word# (ord# (indexCharOffAddr# arr (off' +# 1#)))- low = int2Word# (ord# (indexCharOffAddr# arr off'))- off' = off *# 2#-#else- indexInt16OffAddr# arr off-#endif------{-# INLINE alexIndexInt32OffAddr #-}-alexIndexInt32OffAddr (AlexA# arr) off = -#ifdef WORDS_BIGENDIAN- narrow32Int# i- where- i = word2Int# ((b3 `uncheckedShiftL#` 24#) `or#`- (b2 `uncheckedShiftL#` 16#) `or#`- (b1 `uncheckedShiftL#` 8#) `or#` b0)- b3 = int2Word# (ord# (indexCharOffAddr# arr (off' +# 3#)))- b2 = int2Word# (ord# (indexCharOffAddr# arr (off' +# 2#)))- b1 = int2Word# (ord# (indexCharOffAddr# arr (off' +# 1#)))- b0 = int2Word# (ord# (indexCharOffAddr# arr off'))- off' = off *# 4#-#else- indexInt32OffAddr# arr off-#endif-------#if __GLASGOW_HASKELL__ < 503-quickIndex arr i = arr ! i-#else--- GHC >= 503, unsafeAt is available from Data.Array.Base.-quickIndex = unsafeAt-#endif------- -------------------------------------------------------------------------------- Main lexing routines--data AlexReturn a- = AlexEOF- | AlexError !AlexInput- | AlexSkip !AlexInput !Int- | AlexToken !AlexInput !Int a---- alexScan :: AlexInput -> StartCode -> AlexReturn a-alexScan input (I# (sc))- = alexScanUser undefined input (I# (sc))--alexScanUser user input (I# (sc))- = case alex_scan_tkn user input 0# input sc AlexNone of- (AlexNone, input') ->- case alexGetByte input of- Nothing -> ---- AlexEOF- Just _ ->---- AlexError input'-- (AlexLastSkip input'' len, _) ->---- AlexSkip input'' len-- (AlexLastAcc k input''' len, _) ->---- AlexToken input''' len k----- Push the input through the DFA, remembering the most recent accepting--- state it encountered.--alex_scan_tkn user orig_input len input s last_acc =- input `seq` -- strict in the input- let - new_acc = (check_accs (alex_accept `quickIndex` (I# (s))))- in- new_acc `seq`- case alexGetByte input of- Nothing -> (new_acc, input)- Just (c, new_input) -> ---- case fromIntegral c of { (I# (ord_c)) ->- let- base = alexIndexInt32OffAddr alex_base s- offset = (base +# ord_c)- check = alexIndexInt16OffAddr alex_check offset- - new_s = if GTE(offset,0#) && EQ(check,ord_c)- then alexIndexInt16OffAddr alex_table offset- else alexIndexInt16OffAddr alex_deflt s- in- case new_s of- -1# -> (new_acc, input)- -- on an error, we want to keep the input *before* the- -- character that failed, not after.- _ -> alex_scan_tkn user orig_input (if c < 0x80 || c >= 0xC0 then (len +# 1#) else len)- -- note that the length is increased ONLY if this is the 1st byte in a char encoding)- new_input new_s new_acc- }- where- check_accs (AlexAccNone) = last_acc- check_accs (AlexAcc a ) = AlexLastAcc a input (I# (len))- check_accs (AlexAccSkip) = AlexLastSkip input (I# (len))-{-# LINE 198 "templates/GenericTemplate.hs" #-}--data AlexLastAcc a- = AlexNone- | AlexLastAcc a !AlexInput !Int- | AlexLastSkip !AlexInput !Int--instance Functor AlexLastAcc where- fmap f AlexNone = AlexNone- fmap f (AlexLastAcc x y z) = AlexLastAcc (f x) y z- fmap f (AlexLastSkip x y) = AlexLastSkip x y--data AlexAcc a user- = AlexAccNone- | AlexAcc a- | AlexAccSkip-{-# LINE 242 "templates/GenericTemplate.hs" #-}---- used by wrappers-iUnbox (I# (i)) = i
− dist/build/Data/ByteString/Lex/Lazy/Double.hs
@@ -1,400 +0,0 @@-{-# LANGUAGE CPP,MagicHash #-}-{-# LINE 1 "src/Data/ByteString/Lex/Lazy/Double.x" #-}---- Turn off some common warnings about Alex-generated code.--- {-# OPTIONS_GHC -Wall -fno-warn-tabs -fno-warn-missing-signatures #-}-------------------------------------------------------------------- 2012.01.25--- |--- Module : Data.ByteString.Lex.Lazy.Double--- Copyright : Copyright (c) 2008--2011 Don Stewart--- License : BSD2/MIT--- Maintainer : wren@community.haskell.org--- Stability : stable--- Portability : Haskell98------ Efficiently parse floating point literals from a 'ByteString'.-------------------------------------------------------------------module Data.ByteString.Lex.Lazy.Double (readDouble) where--import qualified Data.ByteString.Lazy as LB-import qualified Data.ByteString as SB-import Data.ByteString.Lex.Internal (strtod)-------------------------------------------------------------------#if __GLASGOW_HASKELL__ >= 603-#include "ghcconfig.h"-#elif defined(__GLASGOW_HASKELL__)-#include "config.h"-#endif-#if __GLASGOW_HASKELL__ >= 503-import Data.Array-import Data.Char (ord)-import Data.Array.Base (unsafeAt)-#else-import Array-import Char (ord)-#endif-#if __GLASGOW_HASKELL__ >= 503-import GHC.Exts-#else-import GlaExts-#endif-{-# LINE 1 "templates/wrappers.hs" #-}-{-# LINE 1 "templates/wrappers.hs" #-}-{-# LINE 1 "<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 Data.Word (Word8)---import qualified Data.Char-import qualified Data.ByteString.Lazy as ByteString-import qualified Data.ByteString.Internal as ByteString (w2c)--{-# LINE 47 "templates/wrappers.hs" #-}--type Byte = Word8---- -------------------------------------------------------------------------------- The input type--{-# LINE 72 "templates/wrappers.hs" #-}--{-# LINE 92 "templates/wrappers.hs" #-}---type AlexInput = (Char,- ByteString.ByteString)--alexInputPrevChar :: AlexInput -> Char-alexInputPrevChar (c,_) = c--alexGetByte (_, cs)- | ByteString.null cs = Nothing- | otherwise = Just (ByteString.head cs,- (ByteString.w2c $ ByteString.head cs,- ByteString.tail cs))---{-# LINE 121 "templates/wrappers.hs" #-}---- -------------------------------------------------------------------------------- Token positions---- `Posn' records the location of a token in the input text. It has three--- fields: the address (number of chacaters preceding the token), line number--- and column of a token within the file. `start_pos' gives the position of the--- start of the file and `eof_pos' a standard encoding for the end of file.--- `move_pos' calculates the new position after traversing a given character,--- assuming the usual eight character tab stops.--{-# LINE 144 "templates/wrappers.hs" #-}---- -------------------------------------------------------------------------------- Default monad--{-# LINE 242 "templates/wrappers.hs" #-}----- -------------------------------------------------------------------------------- Monad (with ByteString input)--{-# LINE 333 "templates/wrappers.hs" #-}----- -------------------------------------------------------------------------------- Basic wrapper--{-# LINE 360 "templates/wrappers.hs" #-}----- -------------------------------------------------------------------------------- Basic wrapper, ByteString version------ alexScanTokens :: String -> [token]-alexScanTokens str = go ('\n',str)- where go inp@(_,str) =- case alexScan inp 0 of- AlexEOF -> []- AlexError _ -> error "lexical error"- AlexSkip inp' len -> go inp'- AlexToken inp'@(_,str') _ act -> act (ByteString.take len str) : go inp'- where len = ByteString.length str - ByteString.length str'----{-# LINE 392 "templates/wrappers.hs" #-}----- -------------------------------------------------------------------------------- Posn wrapper---- Adds text positions to the basic model.--{-# LINE 409 "templates/wrappers.hs" #-}----- -------------------------------------------------------------------------------- Posn wrapper, ByteString version--{-# LINE 424 "templates/wrappers.hs" #-}----- -------------------------------------------------------------------------------- GScan wrapper---- For compatibility with previous versions of Alex, and because we can.--alex_base :: AlexAddr-alex_base = AlexA# "\xd6\xff\xff\xff\xe0\xff\xff\xff\xe8\xff\xff\xff\x04\x00\x00\x00\x0e\x00\x00\x00\x1f\x00\x00\x00\x27\x00\x00\x00\x40\x00\x00\x00\x69\x00\x00\x00"#--alex_table :: AlexAddr-alex_table = AlexA# "\x00\x00\x04\x00\x00\x00\x04\x00\x00\x00\x00\x00\x07\x00\x08\x00\x08\x00\x08\x00\x08\x00\x08\x00\x08\x00\x08\x00\x08\x00\x08\x00\x05\x00\x05\x00\x05\x00\x05\x00\x05\x00\x05\x00\x05\x00\x05\x00\x06\x00\x06\x00\x06\x00\x06\x00\x06\x00\x06\x00\x06\x00\x06\x00\x06\x00\x06\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x06\x00\x06\x00\x06\x00\x06\x00\x06\x00\x06\x00\x03\x00\x00\x00\x03\x00\x00\x00\x00\x00\x08\x00\x08\x00\x08\x00\x08\x00\x08\x00\x08\x00\x08\x00\x08\x00\x08\x00\x08\x00\x07\x00\x08\x00\x08\x00\x08\x00\x08\x00\x08\x00\x08\x00\x08\x00\x08\x00\x08\x00\x00\x00\x06\x00\x06\x00\x06\x00\x06\x00\x06\x00\x06\x00\x05\x00\x05\x00\x05\x00\x05\x00\x05\x00\x05\x00\x05\x00\x05\x00\x06\x00\x06\x00\x06\x00\x06\x00\x06\x00\x06\x00\x06\x00\x06\x00\x06\x00\x06\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x06\x00\x06\x00\x06\x00\x06\x00\x06\x00\x06\x00\x03\x00\x00\x00\x08\x00\x08\x00\x08\x00\x08\x00\x08\x00\x08\x00\x08\x00\x08\x00\x08\x00\x08\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x03\x00\x00\x00\x00\x00\x06\x00\x06\x00\x06\x00\x06\x00\x06\x00\x06\x00\x00\x00\x01\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x03\x00\x02\x00\x08\x00\x08\x00\x08\x00\x08\x00\x08\x00\x08\x00\x08\x00\x08\x00\x08\x00\x08\x00\x00\x00\x00\x00\x03\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x03\x00\x01\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x02\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x03\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00"#--alex_check :: AlexAddr-alex_check = AlexA# "\xff\xff\x2b\x00\xff\xff\x2d\x00\xff\xff\xff\xff\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\x37\x00\x38\x00\x39\x00\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\x37\x00\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\x37\x00\x38\x00\x39\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x41\x00\x42\x00\x43\x00\x44\x00\x45\x00\x46\x00\x2b\x00\xff\xff\x2d\x00\xff\xff\xff\xff\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\x37\x00\x38\x00\x39\x00\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\x37\x00\x38\x00\x39\x00\xff\xff\x61\x00\x62\x00\x63\x00\x64\x00\x65\x00\x66\x00\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\x37\x00\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\x37\x00\x38\x00\x39\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x41\x00\x42\x00\x43\x00\x44\x00\x45\x00\x46\x00\x2e\x00\xff\xff\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\x37\x00\x38\x00\x39\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x45\x00\xff\xff\xff\xff\x61\x00\x62\x00\x63\x00\x64\x00\x65\x00\x66\x00\xff\xff\x4f\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x2e\x00\x58\x00\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\x37\x00\x38\x00\x39\x00\xff\xff\xff\xff\x65\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x45\x00\x6f\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x78\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x65\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff"#--alex_deflt :: AlexAddr-alex_deflt = AlexA# "\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff"#--alex_accept = listArray (0::Int,8) [AlexAccNone,AlexAccNone,AlexAccNone,AlexAccNone,AlexAccNone,AlexAcc (alex_action_0),AlexAcc (alex_action_0),AlexAcc (alex_action_0),AlexAcc (alex_action_0)]-{-# LINE 48 "src/Data/ByteString/Lex/Lazy/Double.x" #-}----- | Parse the initial portion of the ByteString as a Double precision--- floating point value. The expected form of the numeric literal--- is given by:------ * An optional '+' or '-' sign ------ * Decimal digits, OR------ * 0 [oO] and a sequence of octal digits, OR------ * 0 [xX] and a sequence of hexadecimal digits, OR------ * An optional decimal point, followed by a sequence of decimal digits, ------ * And an optional exponent------ The result is returned as a pair of a double-precision floating--- point value and the remaining input, or @Nothing@ should no parse--- be found.------ For example, to sum a file of floating point numbers, one per line, ------ > import qualified Data.ByteString.Char8 as S--- > import qualified Data.ByteString.Unsafe as S--- > import Data.ByteString.Lex.Double--- > --- > main = print . go 0 =<< S.getContents--- > where--- > go n s = case readDouble s of--- > Nothing -> n--- > Just (k,rest) -> go (n+k) (S.tail rest)----readDouble :: LB.ByteString -> Maybe (Double, LB.ByteString)-readDouble str = case alexScan ('\n', str) 0 of- AlexEOF -> Nothing- AlexError _ -> Nothing- AlexToken (_, rest) n _ ->- case strtod . strict . LB.take (fromIntegral n) $ str of- d -> Just $! (d , rest)--strict = SB.concat . LB.toChunks--alex_action_0 = strtod . strict -{-# LINE 1 "templates/GenericTemplate.hs" #-}-{-# LINE 1 "templates/GenericTemplate.hs" #-}-{-# LINE 1 "<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 21 "templates/GenericTemplate.hs" #-}-------- Do not remove this comment. Required to fix CPP parsing when using GCC and a clang-compiled alex.-#if __GLASGOW_HASKELL__ > 706-#define GTE(n,m) (tagToEnum# (n >=# m))-#define EQ(n,m) (tagToEnum# (n ==# m))-#else-#define GTE(n,m) (n >=# m)-#define EQ(n,m) (n ==# m)-#endif-{-# LINE 51 "templates/GenericTemplate.hs" #-}---data AlexAddr = AlexA# Addr#--- Do not remove this comment. Required to fix CPP parsing when using GCC and a clang-compiled alex.-#if __GLASGOW_HASKELL__ < 503-uncheckedShiftL# = shiftL#-#endif--{-# INLINE alexIndexInt16OffAddr #-}-alexIndexInt16OffAddr (AlexA# arr) off =-#ifdef WORDS_BIGENDIAN- narrow16Int# i- where- i = word2Int# ((high `uncheckedShiftL#` 8#) `or#` low)- high = int2Word# (ord# (indexCharOffAddr# arr (off' +# 1#)))- low = int2Word# (ord# (indexCharOffAddr# arr off'))- off' = off *# 2#-#else- indexInt16OffAddr# arr off-#endif------{-# INLINE alexIndexInt32OffAddr #-}-alexIndexInt32OffAddr (AlexA# arr) off = -#ifdef WORDS_BIGENDIAN- narrow32Int# i- where- i = word2Int# ((b3 `uncheckedShiftL#` 24#) `or#`- (b2 `uncheckedShiftL#` 16#) `or#`- (b1 `uncheckedShiftL#` 8#) `or#` b0)- b3 = int2Word# (ord# (indexCharOffAddr# arr (off' +# 3#)))- b2 = int2Word# (ord# (indexCharOffAddr# arr (off' +# 2#)))- b1 = int2Word# (ord# (indexCharOffAddr# arr (off' +# 1#)))- b0 = int2Word# (ord# (indexCharOffAddr# arr off'))- off' = off *# 4#-#else- indexInt32OffAddr# arr off-#endif-------#if __GLASGOW_HASKELL__ < 503-quickIndex arr i = arr ! i-#else--- GHC >= 503, unsafeAt is available from Data.Array.Base.-quickIndex = unsafeAt-#endif------- -------------------------------------------------------------------------------- Main lexing routines--data AlexReturn a- = AlexEOF- | AlexError !AlexInput- | AlexSkip !AlexInput !Int- | AlexToken !AlexInput !Int a---- alexScan :: AlexInput -> StartCode -> AlexReturn a-alexScan input (I# (sc))- = alexScanUser undefined input (I# (sc))--alexScanUser user input (I# (sc))- = case alex_scan_tkn user input 0# input sc AlexNone of- (AlexNone, input') ->- case alexGetByte input of- Nothing -> ---- AlexEOF- Just _ ->---- AlexError input'-- (AlexLastSkip input'' len, _) ->---- AlexSkip input'' len-- (AlexLastAcc k input''' len, _) ->---- AlexToken input''' len k----- Push the input through the DFA, remembering the most recent accepting--- state it encountered.--alex_scan_tkn user orig_input len input s last_acc =- input `seq` -- strict in the input- let - new_acc = (check_accs (alex_accept `quickIndex` (I# (s))))- in- new_acc `seq`- case alexGetByte input of- Nothing -> (new_acc, input)- Just (c, new_input) -> ---- case fromIntegral c of { (I# (ord_c)) ->- let- base = alexIndexInt32OffAddr alex_base s- offset = (base +# ord_c)- check = alexIndexInt16OffAddr alex_check offset- - new_s = if GTE(offset,0#) && EQ(check,ord_c)- then alexIndexInt16OffAddr alex_table offset- else alexIndexInt16OffAddr alex_deflt s- in- case new_s of- -1# -> (new_acc, input)- -- on an error, we want to keep the input *before* the- -- character that failed, not after.- _ -> alex_scan_tkn user orig_input (if c < 0x80 || c >= 0xC0 then (len +# 1#) else len)- -- note that the length is increased ONLY if this is the 1st byte in a char encoding)- new_input new_s new_acc- }- where- check_accs (AlexAccNone) = last_acc- check_accs (AlexAcc a ) = AlexLastAcc a input (I# (len))- check_accs (AlexAccSkip) = AlexLastSkip input (I# (len))-{-# LINE 198 "templates/GenericTemplate.hs" #-}--data AlexLastAcc a- = AlexNone- | AlexLastAcc a !AlexInput !Int- | AlexLastSkip !AlexInput !Int--instance Functor AlexLastAcc where- fmap f AlexNone = AlexNone- fmap f (AlexLastAcc x y z) = AlexLastAcc (f x) y z- fmap f (AlexLastSkip x y) = AlexLastSkip x y--data AlexAcc a user- = AlexAccNone- | AlexAcc a- | AlexAccSkip-{-# LINE 242 "templates/GenericTemplate.hs" #-}---- used by wrappers-iUnbox (I# (i)) = i
− src/Data/ByteString/Lex/Double.x
@@ -1,121 +0,0 @@-{--- Turn off some common warnings about Alex-generated code.--- {-# OPTIONS_GHC -Wall -fno-warn-tabs -fno-warn-missing-signatures #-}-------------------------------------------------------------------- 2012.01.25--- |--- Module : Data.ByteString.Lex.Double--- Copyright : Copyright (c) 2008--2011 Don Stewart--- License : BSD2/MIT--- Maintainer : wren@community.haskell.org--- Stability : stable--- Portability : Haskell98------ Efficiently parse floating point literals from a 'ByteString'.-------------------------------------------------------------------module Data.ByteString.Lex.Double (readDouble, unsafeReadDouble) where--import qualified Data.ByteString as B-import Data.ByteString.Internal-import Data.ByteString.Lex.Internal (strtod, c_strtod)-import qualified Data.ByteString.Unsafe as B--import Foreign-import Foreign.C.Types-import Foreign.C.String------------------------------------------------------------------}--%wrapper "strict-bytestring"--$space = [\ \t\xa0]-$digit = 0-9-$octit = 0-7-$hexit = [$digit A-F a-f]--@sign = [\-\+]-@decimal = $digit+-@octal = $octit+-@hexadecimal = $hexit+-@exponent = [eE] [\-\+]? @decimal--@number = @decimal- | @decimal \. @decimal @exponent?- | @decimal @exponent- | 0[oO] @octal- | 0[xX] @hexadecimal--lex :---@sign? @number { strtod }--{---- | Parse the initial portion of the ByteString as a Double precision--- floating point value. The expected form of the numeric literal--- is given by:------ * An optional '+' or '-' sign ------ * Decimal digits, OR------ * 0 [oO] and a sequence of octal digits, OR------ * 0 [xX] and a sequence of hexadecimal digits, OR------ * An optional decimal point, followed by a sequence of decimal digits, ------ * And an optional exponent------ The result is returned as a pair of a double-precision floating--- point value and the remaining input, or @Nothing@ should no parse--- be found.------ For example, to sum a file of floating point numbers, one per line, ------ > import qualified Data.ByteString.Char8 as S--- > import qualified Data.ByteString.Unsafe as S--- > import Data.ByteString.Lex.Double--- > --- > main = print . go 0 =<< S.getContents--- > where--- > go n s = case readDouble s of--- > Nothing -> n--- > Just (k,rest) -> go (n+k) (S.tail rest)----readDouble :: ByteString -> Maybe (Double, ByteString)-readDouble str = case alexScan (AlexInput '\n' str) 0 of- AlexEOF -> Nothing- AlexError _ -> Nothing- AlexToken (AlexInput _ rest) n _ ->- case strtod (B.unsafeTake n str) of d -> d `seq` Just $! (d , rest)--------------------------------------------------------------------- | Bare bones, unsafe wrapper for C's @strtod(3)@. This provides--- a non-copying direct parsing of Double values from a ByteString.--- It uses @strtod@ directly on the bytestring buffer. @strtod@--- requires the string to be null terminated, or for a guarantee--- that parsing will find a floating point value before the end of--- the string.----unsafeReadDouble :: ByteString -> Maybe (Double, ByteString)-{-# INLINE unsafeReadDouble #-}-unsafeReadDouble b- | B.null b = Nothing- | otherwise = inlinePerformIO $- alloca $ \resptr ->- B.unsafeUseAsCString b $ \ptr -> do -- copy just the bytes we want to parse--- resetErrno- d <- c_strtod ptr resptr -- --- err <- getErrno- newPtr <- peek resptr- return $! case d of- 0 | newPtr == ptr -> Nothing--- _ | err == eRANGE -> Nothing -- adds 10% overhead- _ | otherwise ->- let rest = B.unsafeDrop (newPtr `minusPtr` ptr) b- z = realToFrac d- in z `seq` rest `seq` Just $! (z, rest)--}
+ src/Data/ByteString/Lex/Fractional.hs view
@@ -0,0 +1,468 @@+{-# OPTIONS_GHC -Wall -fwarn-tabs #-}+{-# LANGUAGE ScopedTypeVariables #-}+----------------------------------------------------------------+-- 2015.06.05+-- |+-- Module : Data.ByteString.Lex.Fractional+-- Copyright : Copyright (c) 2015 wren gayle romano+-- License : BSD2+-- Maintainer : wren@community.haskell.org+-- Stability : provisional+-- Portability : Haskell98 + 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+ -- packDecimal+ -- TODO: asDecimal -- this will be really hard to make efficient...+ -- * Hexadecimal conversions+ , readHexadecimal+ -- packHexadecimal+ -- asHexadecimal+ -- * Octal conversions+ , readOctal+ -- packOctal+ -- asOctal -- this will be really hard to make efficient...+ -- * Exponential conversions+ , readExponential+ -- packExponential+ -- 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 (numDecimalDigits)++----------------------------------------------------------------+----------------------------------------------------------------++-- | 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+ | x `seq` y `seq` False = undefined+ | otherwise = Just (x,y)++pair :: a -> b -> (a,b)+{-# INLINE pair #-}+pair x y+ | x `seq` y `seq` False = undefined+ | otherwise = (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.++{-# INLINE isNotPeriod #-}+isNotPeriod :: Word8 -> Bool+isNotPeriod w = w /= 0x2E++{-# INLINE isNotE #-}+isNotE :: Word8 -> Bool+isNotE w = w /= 0x65 && w /= 0x45++{-# INLINE isDecimal #-}+isDecimal :: Word8 -> Bool+isDecimal w = 0x39 >= w && w >= 0x30++{-# INLINE isDecimalZero #-}+isDecimalZero :: Word8 -> Bool+isDecimalZero w = w == 0x30++----------------------------------------------------------------+----- Decimal++-- | 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.+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.+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+-- @'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.++ -- TODO: verify this is ~inferred~ strict in both @p@ and @xs@+ -- without the guard trick or BangPatterns+ start p xs+ | p `seq` xs `seq` False = undefined+ | otherwise =+ case lengthDropWhile isDecimalZero xs of+ (0, _) -> readWholePart p xs+ (_, ys) ->+ case BS.uncons ys of+ Nothing -> justPair (DF 0 0) BS.empty+ Just (y0,ys0)+ | isDecimal y0 -> readWholePart p ys+ | isNotPeriod y0 -> justPair (DF 0 0) ys+ | otherwise ->+ case lengthDropWhile isDecimalZero ys0 of+ (0, _) -> readFractionPart p 0 ys+ (scale, zs) -> afterDroppingZeroes p scale zs++ 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
@@ -4,7 +4,7 @@ -- | -- Module : Data.ByteString.Lex.Integral -- Copyright : Copyright (c) 2010--2015 wren gayle romano--- License : BSD3+-- License : BSD2 -- Maintainer : wren@community.haskell.org -- Stability : provisional -- Portability : Haskell98@@ -12,6 +12,8 @@ -- 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 (@@ -44,6 +46,7 @@ import Foreign.Ptr (Ptr, plusPtr) import qualified Foreign.ForeignPtr as FFI (withForeignPtr) import Foreign.Storable (peek, poke)+import Data.ByteString.Lex.Internal ---------------------------------------------------------------- ----- General@@ -54,7 +57,7 @@ -- provide both signed and unsigned versions of the -- {read,pack}{Decimal,Octal,Hex} functions... -+-- TODO: move to somewhere more general, shared by both Integral and Fractional -- | Adjust a reading function to recognize an optional leading -- sign. As with the other functions, we assume an ASCII-compatible -- encoding of the sign characters.@@ -113,7 +116,7 @@ -- call 'fromIntegral' to perform the conversion at the end. However, -- doing this will make your code succeptible to overflow bugs if -- the target type is larger than @Int@.-readDecimal :: Integral a => ByteString -> Maybe (a, ByteString)+readDecimal :: (Integral a) => ByteString -> Maybe (a, ByteString) {-# SPECIALIZE readDecimal :: ByteString -> Maybe (Int, ByteString), ByteString -> Maybe (Int8, ByteString),@@ -132,7 +135,7 @@ {-# INLINE isDecimal #-} isDecimal w = 0x39 >= w && w >= 0x30 - toDigit :: Integral a => Word8 -> a+ toDigit :: (Integral a) => Word8 -> a {-# INLINE toDigit #-} toDigit w = fromIntegral (w - 0x30) @@ -141,7 +144,7 @@ addDigit n w = n * 10 + toDigit w -- TODO: should we explicitly drop all leading zeros before we jump into the unrolled loop?- start :: Integral a => ByteString -> Maybe (a, ByteString)+ start :: (Integral a) => ByteString -> Maybe (a, ByteString) start xs | BS.null xs = Nothing | otherwise =@@ -149,7 +152,7 @@ w | isDecimal w -> Just $ loop0 (toDigit w) (BSU.unsafeTail xs) | otherwise -> Nothing - loop0 :: Integral a => a -> ByteString -> (a, ByteString)+ loop0 :: (Integral a) => a -> ByteString -> (a, ByteString) loop0 m xs | m `seq` xs `seq` False = undefined | BS.null xs = (m, BS.empty)@@ -159,7 +162,7 @@ | otherwise -> (m, xs) loop1, loop2, loop3, loop4, loop5, loop6, loop7, loop8- :: Integral a => a -> Int -> ByteString -> (a, ByteString)+ :: (Integral a) => a -> Int -> ByteString -> (a, ByteString) loop1 m n xs | m `seq` n `seq` xs `seq` False = undefined | BS.null xs = (m*10 + fromIntegral n, BS.empty)@@ -225,7 +228,9 @@ -- the string, and returns @0@ instead of @Nothing@. This is twice -- as fast for 'Int64' on 32-bit systems, but has identical performance -- to 'readDecimal' for all other types and architectures.-readDecimal_ :: Integral a => ByteString -> a+--+-- /Since: 0.4.0/+readDecimal_ :: (Integral a) => ByteString -> a {-# SPECIALIZE readDecimal_ :: ByteString -> Int, ByteString -> Int8,@@ -244,7 +249,7 @@ {-# INLINE isDecimal #-} isDecimal w = 0x39 >= w && w >= 0x30 - toDigit :: Integral a => Word8 -> a+ toDigit :: (Integral a) => Word8 -> a {-# INLINE toDigit #-} toDigit w = fromIntegral (w - 0x30) @@ -259,7 +264,7 @@ w | isDecimal w -> loop0 (toDigit w) (BSU.unsafeTail xs) | otherwise -> 0 - loop0 :: Integral a => a -> ByteString -> a+ loop0 :: (Integral a) => a -> ByteString -> a loop0 m xs | m `seq` xs `seq` False = undefined | BS.null xs = m@@ -269,7 +274,7 @@ | otherwise -> m loop1, loop2, loop3, loop4, loop5, loop6, loop7, loop8- :: Integral a => a -> Int -> ByteString -> a+ :: (Integral a) => a -> Int -> ByteString -> a loop1 m n xs | m `seq` n `seq` xs `seq` False = undefined | BS.null xs = m*10 + fromIntegral n@@ -697,127 +702,6 @@ _asOctal_overflow = "asOctal: cannot create buffer larger than (maxBound::Int)" -- -}----------------------------------------------------------------------------------------------------------------------------------------- Integral logarithms---- TODO: cf. integer-gmp:GHC.Integer.Logarithms made available in version 0.3.0.0 (ships with GHC 7.2.1).--- <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 @./test/bench/BenchNumDigits.hs@ for other implementation--- choices.------ | @numDigits b n@ computes the number of base-@b@ digits required--- to represent the number @n@. N.B., this implementation is unsafe--- and will throw errors if the base is @(<= 1)@, or if the number--- is negative. If the base happens to be a power of 2, then see--- 'numTwoPowerDigits' for a more efficient implementation.------ We must be careful about the input types here. When using small--- unsigned types or very large values, the repeated squaring can--- overflow causing the function to loop. (E.g., the fourth squaring--- of 10 overflows 32-bits (==1874919424) which is greater than the--- third squaring. For 64-bit, the 5th squaring overflows, but it's--- negative so will be caught.) Forcing the type to Integer ensures--- correct behavior, but makes it substantially slower.--numDigits :: Integer -> Integer -> Int-{-# INLINE numDigits #-}-numDigits b0 n0- | b0 <= 1 = error (_numDigits ++ _nonpositiveBase)- | n0 < 0 = error (_numDigits ++ _negativeNumber)- -- BUG: need to check n0 to be sure we won't overflow Int- | otherwise = 1 + fst (ilog b0 n0)- where- ilog b n- | n < b = (0, n)- | r < b = ((,) $! 2*e) r- | otherwise = ((,) $! 2*e+1) $! (r `quot` b)- where- (e, r) = ilog (b*b) n----- | Compute the number of base-@2^p@ digits required to represent a--- number @n@. N.B., this implementation is unsafe and will throw--- errors if the base power is non-positive, or if the number is--- negative. For bases which are not a power of 2, see 'numDigits'--- for a more general implementation.-numTwoPowerDigits :: (Integral a, Bits a) => Int -> a -> Int-{-# INLINE numTwoPowerDigits #-}-numTwoPowerDigits p n0- | p <= 0 = error (_numTwoPowerDigits ++ _nonpositiveBase)- | n0 < 0 = error (_numTwoPowerDigits ++ _negativeNumber)- | n0 == 0 = 1- -- BUG: need to check n0 to be sure we won't overflow Int- | otherwise = go 0 n0- where- go d n- | d `seq` n `seq` False = undefined- | n > 0 = go (d+1) (n `shiftR` p)- | otherwise = d----- This implementation is from:--- <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...- | n0 > limit = numDigits 10 (toInteger n0)- | otherwise = go 1 (fromIntegral n0 :: Word64)- where- limit = fromIntegral (maxBound :: Word64)- - fin n bound = if n >= bound then 1 else 0- go k n- | k `seq` False = undefined -- For strictness analysis- | n < 10 = k- | n < 100 = k + 1- | n < 1000 = k + 2- | n < 1000000000000 =- k + if n < 100000000- then if n < 1000000- then if n < 10000- then 3- else 4 + fin n 100000- else 6 + fin n 10000000- else if n < 10000000000- then 8 + fin n 1000000000- else 10 + fin n 100000000000- | otherwise = go (k + 12) (n `quot` 1000000000000)---_numDigits :: String-_numDigits = "numDigits"-{-# NOINLINE _numDigits #-}--_numTwoPowerDigits :: String-_numTwoPowerDigits = "numTwoPowerDigits"-{-# NOINLINE _numTwoPowerDigits #-}--_numDecimalDigits :: String-_numDecimalDigits = "numDecimalDigits"-{-# NOINLINE _numDecimalDigits #-}--_nonpositiveBase :: String-_nonpositiveBase = ": base must be greater than one"-{-# NOINLINE _nonpositiveBase #-}--_negativeNumber :: String-_negativeNumber = ": number must be non-negative"-{-# NOINLINE _negativeNumber #-} ---------------------------------------------------------------- ----------------------------------------------------------- fin.
src/Data/ByteString/Lex/Internal.hs view
@@ -1,34 +1,147 @@ {-# OPTIONS_GHC -Wall -fwarn-tabs #-}-{-# LANGUAGE ForeignFunctionInterface #-} ------------------------------------------------------------------- 2012.01.25+-- 2015.06.05 -- | -- Module : Data.ByteString.Lex.Internal--- Copyright : Copyright (c) 2008--2011 Don Stewart.--- License : BSD2/MIT+-- Copyright : Copyright (c) 2010--2015 wren gayle romano+-- License : BSD2 -- Maintainer : wren@community.haskell.org--- Stability : stable--- Portability : Haskell98 + FFI+-- Stability : provisional+-- Portability : Haskell98 ----- Efficiently parse floating point literals from a 'ByteString'.+-- Some functions we want to share across the other modules without actually exposing them to the user. ----------------------------------------------------------------+module Data.ByteString.Lex.Internal+ (+ -- * Integral logarithms+ numDigits+ , numTwoPowerDigits+ , numDecimalDigits+ ) where -module Data.ByteString.Lex.Internal (strtod, c_strtod) where+import Data.Word (Word64)+import Data.Bits (Bits(shiftR)) -import qualified Data.ByteString.Internal as BSI (inlinePerformIO)-import qualified Data.ByteString as BS-import Foreign.C.String (CString)-import Foreign.Ptr (Ptr, nullPtr) ----------------------------------------------------------------+----------------------------------------------------------------+----- Integral logarithms --- | Safe, minimal copy of substring identified by Alex.-strtod :: BS.ByteString -> Double-{-# INLINE strtod #-}-strtod b =- BSI.inlinePerformIO . BS.useAsCString b $ \ptr -> c_strtod ptr nullPtr+-- 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> -foreign import ccall unsafe "stdlib.h strtod" - c_strtod :: CString -> Ptr CString -> IO Double++-- 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 @./test/bench/BenchNumDigits.hs@ for other implementation+-- choices.+--+-- | @numDigits b n@ computes the number of base-@b@ digits required+-- to represent the number @n@. N.B., this implementation is unsafe+-- and will throw errors if the base is @(<= 1)@, or if the number+-- is negative. If the base happens to be a power of 2, then see+-- 'numTwoPowerDigits' for a more efficient implementation.+--+-- We must be careful about the input types here. When using small+-- unsigned types or very large values, the repeated squaring can+-- overflow causing the function to loop. (E.g., the fourth squaring+-- of 10 overflows 32-bits (==1874919424) which is greater than the+-- third squaring. For 64-bit, the 5th squaring overflows, but it's+-- negative so will be caught.) Forcing the type to Integer ensures+-- correct behavior, but makes it substantially slower.++numDigits :: Integer -> Integer -> Int+{-# INLINE numDigits #-}+numDigits b0 n0+ | b0 <= 1 = error (_numDigits ++ _nonpositiveBase)+ | n0 < 0 = error (_numDigits ++ _negativeNumber)+ -- BUG: need to check n0 to be sure we won't overflow Int+ | otherwise = 1 + fst (ilog b0 n0)+ where+ ilog b n+ | n < b = (0, n)+ | r < b = ((,) $! 2*e) r+ | otherwise = ((,) $! 2*e+1) $! (r `quot` b)+ where+ (e, r) = ilog (b*b) n+++-- | Compute the number of base-@2^p@ digits required to represent a+-- number @n@. N.B., this implementation is unsafe and will throw+-- errors if the base power is non-positive, or if the number is+-- negative. For bases which are not a power of 2, see 'numDigits'+-- for a more general implementation.+numTwoPowerDigits :: (Integral a, Bits a) => Int -> a -> Int+{-# INLINE numTwoPowerDigits #-}+numTwoPowerDigits p n0+ | p <= 0 = error (_numTwoPowerDigits ++ _nonpositiveBase)+ | n0 < 0 = error (_numTwoPowerDigits ++ _negativeNumber)+ | n0 == 0 = 1+ -- BUG: need to check n0 to be sure we won't overflow Int+ | otherwise = go 0 n0+ where+ go d n+ | d `seq` n `seq` False = undefined+ | n > 0 = go (d+1) (n `shiftR` p)+ | otherwise = d+++-- This implementation is from:+-- <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...+ | n0 > limit = numDigits 10 (toInteger n0)+ | otherwise = go 1 (fromIntegral n0 :: Word64)+ where+ limit = fromIntegral (maxBound :: Word64)+ + fin n bound = if n >= bound then 1 else 0+ go k n+ | k `seq` False = undefined -- For strictness analysis+ | n < 10 = k+ | n < 100 = k + 1+ | n < 1000 = k + 2+ | n < 1000000000000 =+ k + if n < 100000000+ then if n < 1000000+ then if n < 10000+ then 3+ else 4 + fin n 100000+ else 6 + fin n 10000000+ else if n < 10000000000+ then 8 + fin n 1000000000+ else 10 + fin n 100000000000+ | otherwise = go (k + 12) (n `quot` 1000000000000)+++_numDigits :: String+_numDigits = "numDigits"+{-# NOINLINE _numDigits #-}++_numTwoPowerDigits :: String+_numTwoPowerDigits = "numTwoPowerDigits"+{-# NOINLINE _numTwoPowerDigits #-}++_numDecimalDigits :: String+_numDecimalDigits = "numDecimalDigits"+{-# NOINLINE _numDecimalDigits #-}++_nonpositiveBase :: String+_nonpositiveBase = ": base must be greater than one"+{-# NOINLINE _nonpositiveBase #-}++_negativeNumber :: String+_negativeNumber = ": number must be non-negative"+{-# NOINLINE _negativeNumber #-} ---------------------------------------------------------------- ----------------------------------------------------------- fin.
− src/Data/ByteString/Lex/Lazy/Double.x
@@ -1,91 +0,0 @@-{--- Turn off some common warnings about Alex-generated code.--- {-# OPTIONS_GHC -Wall -fno-warn-tabs -fno-warn-missing-signatures #-}-------------------------------------------------------------------- 2012.01.25--- |--- Module : Data.ByteString.Lex.Lazy.Double--- Copyright : Copyright (c) 2008--2011 Don Stewart--- License : BSD2/MIT--- Maintainer : wren@community.haskell.org--- Stability : stable--- Portability : Haskell98------ Efficiently parse floating point literals from a 'ByteString'.-------------------------------------------------------------------module Data.ByteString.Lex.Lazy.Double (readDouble) where--import qualified Data.ByteString.Lazy as LB-import qualified Data.ByteString as SB-import Data.ByteString.Lex.Internal (strtod)------------------------------------------------------------------}--%wrapper "basic-bytestring"--$space = [\ \t\xa0]-$digit = 0-9-$octit = 0-7-$hexit = [$digit A-F a-f]--@sign = [\-\+]-@decimal = $digit+-@octal = $octit+-@hexadecimal = $hexit+-@exponent = [eE] [\-\+]? @decimal--@number = @decimal- | @decimal \. @decimal @exponent?- | @decimal @exponent- | 0[oO] @octal- | 0[xX] @hexadecimal--lex :---@sign? @number { strtod . strict }--{---- | Parse the initial portion of the ByteString as a Double precision--- floating point value. The expected form of the numeric literal--- is given by:------ * An optional '+' or '-' sign ------ * Decimal digits, OR------ * 0 [oO] and a sequence of octal digits, OR------ * 0 [xX] and a sequence of hexadecimal digits, OR------ * An optional decimal point, followed by a sequence of decimal digits, ------ * And an optional exponent------ The result is returned as a pair of a double-precision floating--- point value and the remaining input, or @Nothing@ should no parse--- be found.------ For example, to sum a file of floating point numbers, one per line, ------ > import qualified Data.ByteString.Char8 as S--- > import qualified Data.ByteString.Unsafe as S--- > import Data.ByteString.Lex.Double--- > --- > main = print . go 0 =<< S.getContents--- > where--- > go n s = case readDouble s of--- > Nothing -> n--- > Just (k,rest) -> go (n+k) (S.tail rest)----readDouble :: LB.ByteString -> Maybe (Double, LB.ByteString)-readDouble str = case alexScan ('\n', str) 0 of- AlexEOF -> Nothing- AlexError _ -> Nothing- AlexToken (_, rest) n _ ->- case strtod . strict . LB.take (fromIntegral n) $ str of- d -> Just $! (d , rest)--strict = SB.concat . LB.toChunks-}