bytestring-lexing 0.2.1 → 0.3.0
raw patch · 13 files changed
+1763/−281 lines, 13 filesdep ~basedep ~bytestringsetup-changednew-uploaderPVP ok
version bump matches the API change (PVP)
Dependency ranges changed: base, bytestring
API changes (from Hackage documentation)
- Data.ByteString.Lex.Double: instance Functor AlexLastAcc
- Data.ByteString.Lex.Lazy.Double: instance Functor AlexLastAcc
+ Data.ByteString.Lex.Integral: asHexadecimal :: ByteString -> ByteString
+ Data.ByteString.Lex.Integral: packDecimal :: Integral a => a -> Maybe ByteString
+ Data.ByteString.Lex.Integral: packHexadecimal :: Integral a => a -> Maybe ByteString
+ Data.ByteString.Lex.Integral: packOctal :: Integral a => a -> Maybe ByteString
+ Data.ByteString.Lex.Integral: readDecimal :: Integral a => ByteString -> Maybe (a, ByteString)
+ Data.ByteString.Lex.Integral: readHexadecimal :: Integral a => ByteString -> Maybe (a, ByteString)
+ Data.ByteString.Lex.Integral: readOctal :: Integral a => ByteString -> Maybe (a, ByteString)
+ Data.ByteString.Lex.Integral: readSigned :: Num a => (ByteString -> Maybe (a, ByteString)) -> ByteString -> Maybe (a, ByteString)
Files
- Data/ByteString/Lex/Double.x +0/−130
- Data/ByteString/Lex/Internal.hs +0/−31
- Data/ByteString/Lex/Lazy/Double.x +0/−89
- LICENSE +1/−1
- Setup.hs +7/−0
- Setup.lhs +0/−3
- bytestring-lexing.cabal +68/−27
- dist/build/Data/ByteString/Lex/Double.hs +436/−0
- dist/build/Data/ByteString/Lex/Lazy/Double.hs +401/−0
- src/Data/ByteString/Lex/Double.x +121/−0
- src/Data/ByteString/Lex/Integral.hs +604/−0
- src/Data/ByteString/Lex/Internal.hs +34/−0
- src/Data/ByteString/Lex/Lazy/Double.x +91/−0
− Data/ByteString/Lex/Double.x
@@ -1,130 +0,0 @@-{--- |--- 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, 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-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.--- 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------ import from Internal--------------------------------------------------------------------------------- | 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, c_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.x
@@ -1,89 +0,0 @@-{--- |--- 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 ng thornton 2012; Don Stewart 2008, 2010 All rights reserved.
+ 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,31 +1,72 @@-Name: bytestring-lexing-Version: 0.2.1-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+----------------------------------------------------------------+-- wren ng thornton <wren@community.haskell.org> ~ 2012.01.25+---------------------------------------------------------------- -flag small_base- description: Choose the new smaller, split-up base package.+Name: bytestring-lexing+Version: 0.3.0+-- Source-Repository requires version 1.6+Cabal-Version: >= 1.6+Build-Type: Simple+Stability: provisional+Copyright: Copyright (c) 2012 wren ng thornton, 2008--2011 Don Stewart+License: BSD3+License-File: LICENSE+Author: wren ng thornton, Don Stewart+Maintainer: wren@community.haskell.org+Homepage: http://code.haskell.org/~wren/+Category: Data+Synopsis: Parse literals efficiently from strict or lazy bytestrings+Description: Parse literals efficiently from strict or lazy bytestrings -library- exposed-modules: Data.ByteString.Lex.Double- Data.ByteString.Lex.Lazy.Double- other-modules: Data.ByteString.Lex.Internal+Tested-With: GHC ==6.8.2, GHC ==6.10.1, GHC ==6.12.1, GHC ==7.0.3+Source-Repository head+ Type: darcs+ Location: http://community.haskell.org/~wren/bytestring-lexing - if flag(small_base)- build-depends: base >= 3 && < 5, bytestring, array- else- build-depends: base < 3+----------------------------------------------------------------+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 - ghc-options: -O2- build-tools: alex+ -- I think this is all that needs doing to get rid of the warnings?+ if flag(base4)+ Build-Depends: base >= 4 && < 5+ else+ Build-Depends: base < 4+ + if flag(bytestringInBase)+ Build-Depends: base >= 2.0 && < 2.2+ else+ Build-Depends: base < 2.0 || >= 3, bytestring++ if flag(splitBase)+ Build-Depends: base >= 3 && < 5, bytestring, array+ else+ Build-Depends: base < 3++ Ghc-Options: -O2++ -- When bytestring-posn was added (2008):+ Build-Tools: alex >= 2.3++----------------------------------------------------------------+----------------------------------------------------------- fin.
+ dist/build/Data/ByteString/Lex/Double.hs view
@@ -0,0 +1,436 @@+{-# 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 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\xe2\xff\xff\xff\xfa\xff\xff\xff\x05\x00\x00\x00\xec\xff\xff\xff\x23\x00\x00\x00\x30\x00\x00\x00\x43\x00\x00\x00\x5a\x00\x00\x00\x64\x00\x00\x00\x7f\x00\x00\x00\x89\x00\x00\x00\x98\x00\x00\x00\xa2\x00\x00\x00\xac\x00\x00\x00\xb4\x00\x00\x00"#++alex_table :: AlexAddr+alex_table = AlexA# "\x00\x00\x08\x00\x00\x00\x08\x00\x00\x00\x00\x00\x02\x00\x01\x00\x01\x00\x01\x00\x01\x00\x01\x00\x01\x00\x01\x00\x01\x00\x01\x00\x09\x00\x00\x00\x01\x00\x01\x00\x01\x00\x01\x00\x01\x00\x01\x00\x01\x00\x01\x00\x01\x00\x01\x00\x04\x00\x04\x00\x04\x00\x04\x00\x04\x00\x04\x00\x04\x00\x04\x00\x04\x00\x04\x00\x00\x00\x0c\x00\x09\x00\x00\x00\x01\x00\x01\x00\x01\x00\x01\x00\x01\x00\x01\x00\x01\x00\x01\x00\x01\x00\x01\x00\x00\x00\x03\x00\x03\x00\x03\x00\x03\x00\x03\x00\x03\x00\x03\x00\x03\x00\x03\x00\x03\x00\x0c\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x0c\x00\x00\x00\x0e\x00\x0a\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x0f\x00\x05\x00\x05\x00\x05\x00\x05\x00\x05\x00\x05\x00\x05\x00\x05\x00\x05\x00\x05\x00\x00\x00\x00\x00\x0c\x00\x06\x00\x06\x00\x06\x00\x06\x00\x06\x00\x06\x00\x06\x00\x06\x00\x00\x00\x0e\x00\x0a\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x0f\x00\x07\x00\x07\x00\x07\x00\x07\x00\x07\x00\x07\x00\x07\x00\x07\x00\x07\x00\x07\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x07\x00\x07\x00\x07\x00\x07\x00\x07\x00\x07\x00\x02\x00\x01\x00\x01\x00\x01\x00\x01\x00\x01\x00\x01\x00\x01\x00\x01\x00\x01\x00\x03\x00\x03\x00\x03\x00\x03\x00\x03\x00\x03\x00\x03\x00\x03\x00\x03\x00\x03\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x07\x00\x07\x00\x07\x00\x07\x00\x07\x00\x07\x00\x0b\x00\x00\x00\x0b\x00\x00\x00\x00\x00\x04\x00\x04\x00\x04\x00\x04\x00\x04\x00\x04\x00\x04\x00\x04\x00\x04\x00\x04\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\x0d\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\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\x07\x00\x07\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x07\x00\x07\x00\x07\x00\x07\x00\x07\x00\x07\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x07\x00\x07\x00\x07\x00\x07\x00\x07\x00\x07\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\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\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"#++alex_accept = listArray (0::Int,15) [[],[(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 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 37 "templates/GenericTemplate.hs" #-}++{-# LINE 47 "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 predx : rest)+ | predx user orig_input (I# (len)) input+ = AlexLastAcc a input (I# (len))+ check_accs (AlexAccSkipPred predx : rest)+ | predx 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
+ dist/build/Data/ByteString/Lex/Lazy/Double.hs view
@@ -0,0 +1,401 @@+{-# 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 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\xe2\xff\xff\xff\xfa\xff\xff\xff\x05\x00\x00\x00\xec\xff\xff\xff\x23\x00\x00\x00\x30\x00\x00\x00\x43\x00\x00\x00\x5a\x00\x00\x00\x64\x00\x00\x00\x7f\x00\x00\x00\x89\x00\x00\x00\x98\x00\x00\x00\xa2\x00\x00\x00\xac\x00\x00\x00\xb4\x00\x00\x00"#++alex_table :: AlexAddr+alex_table = AlexA# "\x00\x00\x08\x00\x00\x00\x08\x00\x00\x00\x00\x00\x02\x00\x01\x00\x01\x00\x01\x00\x01\x00\x01\x00\x01\x00\x01\x00\x01\x00\x01\x00\x09\x00\x00\x00\x01\x00\x01\x00\x01\x00\x01\x00\x01\x00\x01\x00\x01\x00\x01\x00\x01\x00\x01\x00\x04\x00\x04\x00\x04\x00\x04\x00\x04\x00\x04\x00\x04\x00\x04\x00\x04\x00\x04\x00\x00\x00\x0c\x00\x09\x00\x00\x00\x01\x00\x01\x00\x01\x00\x01\x00\x01\x00\x01\x00\x01\x00\x01\x00\x01\x00\x01\x00\x00\x00\x03\x00\x03\x00\x03\x00\x03\x00\x03\x00\x03\x00\x03\x00\x03\x00\x03\x00\x03\x00\x0c\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x0c\x00\x00\x00\x0e\x00\x0a\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x0f\x00\x05\x00\x05\x00\x05\x00\x05\x00\x05\x00\x05\x00\x05\x00\x05\x00\x05\x00\x05\x00\x00\x00\x00\x00\x0c\x00\x06\x00\x06\x00\x06\x00\x06\x00\x06\x00\x06\x00\x06\x00\x06\x00\x00\x00\x0e\x00\x0a\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x0f\x00\x07\x00\x07\x00\x07\x00\x07\x00\x07\x00\x07\x00\x07\x00\x07\x00\x07\x00\x07\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x07\x00\x07\x00\x07\x00\x07\x00\x07\x00\x07\x00\x02\x00\x01\x00\x01\x00\x01\x00\x01\x00\x01\x00\x01\x00\x01\x00\x01\x00\x01\x00\x03\x00\x03\x00\x03\x00\x03\x00\x03\x00\x03\x00\x03\x00\x03\x00\x03\x00\x03\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x07\x00\x07\x00\x07\x00\x07\x00\x07\x00\x07\x00\x0b\x00\x00\x00\x0b\x00\x00\x00\x00\x00\x04\x00\x04\x00\x04\x00\x04\x00\x04\x00\x04\x00\x04\x00\x04\x00\x04\x00\x04\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\x0d\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\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\x07\x00\x07\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x07\x00\x07\x00\x07\x00\x07\x00\x07\x00\x07\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x07\x00\x07\x00\x07\x00\x07\x00\x07\x00\x07\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\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\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"#++alex_accept = listArray (0::Int,15) [[],[(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 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 37 "templates/GenericTemplate.hs" #-}++{-# LINE 47 "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 predx : rest)+ | predx user orig_input (I# (len)) input+ = AlexLastAcc a input (I# (len))+ check_accs (AlexAccSkipPred predx : rest)+ | predx 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
+ src/Data/ByteString/Lex/Double.x view
@@ -0,0 +1,121 @@+{+-- 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/Integral.hs view
@@ -0,0 +1,604 @@+{-# OPTIONS_GHC -Wall -fwarn-tabs #-}+----------------------------------------------------------------+-- 2012.01.27+-- |+-- Module : Data.ByteString.Lex.Integral+-- Copyright : Copyright (c) 2010--2012 wren ng thornton+-- License : BSD3+-- Maintainer : wren@community.haskell.org+-- Stability : provisional+-- Portability : Haskell98+--+-- 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.+----------------------------------------------------------------+module Data.ByteString.Lex.Integral+ (+ -- * 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+ -- TODO: asOctal -- this will be hard to make really 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)++----------------------------------------------------------------+----- 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...+++-- | 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+ | n `seq` xs `seq` False = undefined -- for strictness analysis+ | 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+ isDecimal :: Word8 -> Bool+ {-# INLINE isDecimal #-}+ isDecimal w = 0x39 >= w && w >= 0x30+ + toDigit :: Integral a => Word8 -> a+ {-# INLINE toDigit #-}+ toDigit w = fromIntegral (w - 0x30)+ + addDigit :: Int -> Word8 -> Int+ {-# INLINE addDigit #-}+ addDigit n w = n * 10 + toDigit w+ + start :: 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+ | m `seq` xs `seq` False = undefined+ | 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+ | m `seq` n `seq` xs `seq` False = undefined+ | BS.null xs = (m*10 + fromIntegral n, BS.empty)+ | otherwise =+ case BSU.unsafeHead xs of+ w | isDecimal w -> loop2 m (addDigit n w) (BSU.unsafeTail xs)+ | otherwise -> (m*10 + fromIntegral n, xs)+ loop2 m n xs+ | m `seq` n `seq` xs `seq` False = undefined+ | BS.null xs = (m*100 + fromIntegral n, BS.empty)+ | otherwise =+ case BSU.unsafeHead xs of+ w | isDecimal w -> loop3 m (addDigit n w) (BSU.unsafeTail xs)+ | otherwise -> (m*100 + fromIntegral n, xs)+ loop3 m n xs+ | m `seq` n `seq` xs `seq` False = undefined+ | BS.null xs = (m*1000 + fromIntegral n, BS.empty)+ | otherwise =+ case BSU.unsafeHead xs of+ w | isDecimal w -> loop4 m (addDigit n w) (BSU.unsafeTail xs)+ | otherwise -> (m*1000 + fromIntegral n, xs)+ loop4 m n xs+ | m `seq` n `seq` xs `seq` False = undefined+ | BS.null xs = (m*10000 + fromIntegral n, BS.empty)+ | otherwise =+ case BSU.unsafeHead xs of+ w | isDecimal w -> loop5 m (addDigit n w) (BSU.unsafeTail xs)+ | otherwise -> (m*10000 + fromIntegral n, xs)+ loop5 m n xs+ | m `seq` n `seq` xs `seq` False = undefined+ | BS.null xs = (m*100000 + fromIntegral n, BS.empty)+ | otherwise =+ case BSU.unsafeHead xs of+ w | isDecimal w -> loop6 m (addDigit n w) (BSU.unsafeTail xs)+ | otherwise -> (m*100000 + fromIntegral n, xs)+ loop6 m n xs+ | m `seq` n `seq` xs `seq` False = undefined+ | BS.null xs = (m*1000000 + fromIntegral n, BS.empty)+ | otherwise =+ case BSU.unsafeHead xs of+ w | isDecimal w -> loop7 m (addDigit n w) (BSU.unsafeTail xs)+ | otherwise -> (m*1000000 + fromIntegral n, xs)+ loop7 m n xs+ | m `seq` n `seq` xs `seq` False = undefined+ | BS.null xs = (m*10000000 + fromIntegral n, BS.empty)+ | otherwise =+ case BSU.unsafeHead xs of+ w | isDecimal w -> loop8 m (addDigit n w) (BSU.unsafeTail xs)+ | otherwise -> (m*10000000 + fromIntegral n, xs)+ loop8 m n xs+ | m `seq` n `seq` xs `seq` False = undefined+ | 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)++----------------------------------------------------------------+-- | 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)+++-- Beware the overflow issues of 'numDigits', noted at bottom.+-- | 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 = numDigits 10 (toInteger n0)+ in BSI.unsafeCreate size $ \p0 ->+ loop n0 (p0 `plusPtr` (size - 1))+ where+ loop :: (Integral a) => a -> Ptr Word8 -> IO ()+ loop n p+ | n `seq` p `seq` False = undefined -- for strictness analysis+ | n <= 9 = do+ poke p (0x30 + fromIntegral n)+ | otherwise = do+ -- quotRem == divMod when both @n@ and @b@ are positive,+ -- but 'quotRem' is often faster (for Int it's one machine-op!)+ let (q,r) = n `quotRem` 10+ poke p (0x30 + fromIntegral r)+ loop q (p `plusPtr` negate 1)+++----------------------------------------------------------------+----------------------------------------------------------------+----- 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+ | n `seq` xs `seq` False = undefined -- for strictness analysis+ | 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 = twoPowerNumDigits 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 =+ 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+ | p `seq` w `seq` False = undefined -- for strictness analysis+ | otherwise = do+ let ix = fromIntegral w+ poke p (BSU.unsafeIndex hexDigits ((ix .&. 0xF0) `shiftR` 4))+ poke (p `plusPtr` 1) (BSU.unsafeIndex hexDigits (ix .&. 0x0F))+ return (p `plusPtr` 2)+++-- TODO: benchmark against the magichash hack used in Warp.+-- | 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+ | z `seq` p `seq` False = undefined -- for strictness analysis+ | 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+ | n `seq` xs `seq` False = undefined -- for strictness analysis+ | 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 = twoPowerNumDigits 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)+++{-+-- @ceilEightThirds x == ceiling (fromIntegral x * 8 / 3)@+ceilEightThirds :: Nat -> Nat+ceilEightThirds (Nat# x)+ | 0 == r = Nat# q+ | otherwise = Nat# (q+1)+ where+ (q,r) = (x * 8) `quotRem` 3++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 p q+ | q == qF = ...{- Handle the last one or two Word8 -}+ | otherwise = do+ ...{- Take three Word8 and write 8 chars at a time -}+ -- Cf. the @word24@ package+ loop (p `plusPtr` 8) (q `plusPtr` 3)+ + loop p0 (q0 `plusPtr` off)++ {- N.B., @BSU.unsafeIndex octDigits == (0x30 +)@ -}+-}++----------------------------------------------------------------+----------------------------------------------------------------+----- 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+-- 'twoPowerNumDigits' 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+ | 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++_numDigits_nonpositiveBase :: String+{-# NOINLINE _numDigits_nonpositiveBase #-}+_numDigits_nonpositiveBase = "numDigits: base must be greater than one"++_numDigits_negativeNumber :: String+{-# NOINLINE _numDigits_negativeNumber #-}+_numDigits_negativeNumber = "numDigits: number must be non-negative"+++-- | 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.+twoPowerNumDigits :: (Integral a, Bits a) => Int -> a -> Int+{-# INLINE twoPowerNumDigits #-}+twoPowerNumDigits p n0+ | p <= 0 = error _twoPowerNumDigits_nonpositiveBase+ | n0 < 0 = error _twoPowerNumDigits_negativeNumber+ | n0 == 0 = 1+ | otherwise = go 0 n0+ where+ go d n+ | d `seq` n `seq` False = undefined+ | n > 0 = go (d+1) (n `shiftR` p)+ | otherwise = d++_twoPowerNumDigits_nonpositiveBase :: String+{-# NOINLINE _twoPowerNumDigits_nonpositiveBase #-}+_twoPowerNumDigits_nonpositiveBase =+ "twoPowerNumDigits: base must be positive"++_twoPowerNumDigits_negativeNumber :: String+{-# NOINLINE _twoPowerNumDigits_negativeNumber #-}+_twoPowerNumDigits_negativeNumber =+ "twoPowerNumDigits: number must be non-negative"++----------------------------------------------------------------+----------------------------------------------------------- fin.
+ src/Data/ByteString/Lex/Internal.hs view
@@ -0,0 +1,34 @@+{-# OPTIONS_GHC -Wall -fwarn-tabs #-}+{-# LANGUAGE ForeignFunctionInterface #-}+----------------------------------------------------------------+-- 2012.01.25+-- |+-- Module : Data.ByteString.Lex.Internal+-- Copyright : Copyright (c) 2008--2011 Don Stewart.+-- License : BSD2/MIT+-- Maintainer : wren@community.haskell.org+-- Stability : stable+-- Portability : Haskell98 + FFI+--+-- Efficiently parse floating point literals from a 'ByteString'.+----------------------------------------------------------------++module Data.ByteString.Lex.Internal (strtod, c_strtod) where++import qualified Data.ByteString.Internal as BSI (inlinePerformIO)+import qualified Data.ByteString as BS+import Foreign.C.String (CString)+import Foreign.Ptr (Ptr, nullPtr)+----------------------------------------------------------------++-- | 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++foreign import ccall unsafe "stdlib.h strtod" + c_strtod :: CString -> Ptr CString -> IO Double++----------------------------------------------------------------+----------------------------------------------------------- fin.
+ src/Data/ByteString/Lex/Lazy/Double.x view
@@ -0,0 +1,91 @@+{+-- 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+}