diff --git a/Data/ByteString/Lex/Double.x b/Data/ByteString/Lex/Double.x deleted file mode 100644 --- a/Data/ByteString/Lex/Double.x +++ /dev/null @@ -1,130 +0,0 @@ -{ --- | --- Module : Data.ByteString.Lex.Double --- Copyright : (c) Galois, Inc. 2008 --- License : All rights reserved --- --- Maintainer: Don Stewart --- 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 #-} - -} diff --git a/Data/ByteString/Lex/Internal.hs b/Data/ByteString/Lex/Internal.hs deleted file mode 100644 --- a/Data/ByteString/Lex/Internal.hs +++ /dev/null @@ -1,31 +0,0 @@ -{-# LANGUAGE ForeignFunctionInterface #-} - --------------------------------------------------------------------- --- | --- Module : Data.ByteString.Lex.Internal --- Copyright : (c) Galois, Inc. 2008 --- License : All rights reserved --- --- Maintainer: Don Stewart --- 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 diff --git a/Data/ByteString/Lex/Lazy/Double.x b/Data/ByteString/Lex/Lazy/Double.x deleted file mode 100644 --- a/Data/ByteString/Lex/Lazy/Double.x +++ /dev/null @@ -1,89 +0,0 @@ -{ --- | --- Module : Data.ByteString.Lex.Lazy.Double --- Copyright : (c) Galois, Inc. 2008 --- License : All rights reserved --- --- Maintainer: Don Stewart --- 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 -} diff --git a/LICENSE b/LICENSE --- a/LICENSE +++ b/LICENSE @@ -1,4 +1,4 @@ -Copyright (c) Don Stewart 2008 +Copyright (c) wren ng thornton 2012; Don Stewart 2008, 2010 All rights reserved. diff --git a/Setup.hs b/Setup.hs new file mode 100644 --- /dev/null +++ b/Setup.hs @@ -0,0 +1,7 @@ +#!/usr/bin/env runhaskell + +module Main (main) where +import Distribution.Simple + +main :: IO () +main = defaultMain diff --git a/Setup.lhs b/Setup.lhs deleted file mode 100644 --- a/Setup.lhs +++ /dev/null @@ -1,3 +0,0 @@ -#!/usr/bin/env runhaskell -> import Distribution.Simple -> main = defaultMain diff --git a/bytestring-lexing.cabal b/bytestring-lexing.cabal --- a/bytestring-lexing.cabal +++ b/bytestring-lexing.cabal @@ -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 ~ 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. diff --git a/dist/build/Data/ByteString/Lex/Double.hs b/dist/build/Data/ByteString/Lex/Double.hs new file mode 100644 --- /dev/null +++ b/dist/build/Data/ByteString/Lex/Double.hs @@ -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 "" #-} +{-# LINE 1 "" #-} +{-# LINE 1 "templates/wrappers.hs" #-} +-- ----------------------------------------------------------------------------- +-- Alex wrapper code. +-- +-- This code is in the PUBLIC DOMAIN; you may copy it freely and use +-- it for any purpose whatsoever. + + + + + + + +import 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 "" #-} +{-# LINE 1 "" #-} +{-# LINE 1 "templates/GenericTemplate.hs" #-} +-- ----------------------------------------------------------------------------- +-- ALEX TEMPLATE +-- +-- This code is in the PUBLIC DOMAIN; you may copy it freely and use +-- it for any purpose whatsoever. + +-- ----------------------------------------------------------------------------- +-- INTERNALS and main scanner engine + +{-# LINE 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 diff --git a/dist/build/Data/ByteString/Lex/Lazy/Double.hs b/dist/build/Data/ByteString/Lex/Lazy/Double.hs new file mode 100644 --- /dev/null +++ b/dist/build/Data/ByteString/Lex/Lazy/Double.hs @@ -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 "" #-} +{-# LINE 1 "" #-} +{-# LINE 1 "templates/wrappers.hs" #-} +-- ----------------------------------------------------------------------------- +-- Alex wrapper code. +-- +-- This code is in the PUBLIC DOMAIN; you may copy it freely and use +-- it for any purpose whatsoever. + + + +import 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 "" #-} +{-# LINE 1 "" #-} +{-# LINE 1 "templates/GenericTemplate.hs" #-} +-- ----------------------------------------------------------------------------- +-- ALEX TEMPLATE +-- +-- This code is in the PUBLIC DOMAIN; you may copy it freely and use +-- it for any purpose whatsoever. + +-- ----------------------------------------------------------------------------- +-- INTERNALS and main scanner engine + +{-# LINE 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 diff --git a/src/Data/ByteString/Lex/Double.x b/src/Data/ByteString/Lex/Double.x new file mode 100644 --- /dev/null +++ b/src/Data/ByteString/Lex/Double.x @@ -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) + +} diff --git a/src/Data/ByteString/Lex/Integral.hs b/src/Data/ByteString/Lex/Integral.hs new file mode 100644 --- /dev/null +++ b/src/Data/ByteString/Lex/Integral.hs @@ -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, +-- | 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). +-- + + +-- This implementation is derived from +-- +-- modified to use 'quot' instead of 'div', to ensure strictness, +-- and using more guard notation (but this last one's compiled +-- away). See @./test/bench/BenchNumDigits.hs@ for other implementation +-- choices. +-- +-- | @numDigits b n@ computes the number of base-@b@ digits required +-- to represent the number @n@. N.B., this implementation is unsafe +-- and will throw errors if the base is @(<= 1)@, or if the number +-- is negative. If the base happens to be a power of 2, then see +-- '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. diff --git a/src/Data/ByteString/Lex/Internal.hs b/src/Data/ByteString/Lex/Internal.hs new file mode 100644 --- /dev/null +++ b/src/Data/ByteString/Lex/Internal.hs @@ -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. diff --git a/src/Data/ByteString/Lex/Lazy/Double.x b/src/Data/ByteString/Lex/Lazy/Double.x new file mode 100644 --- /dev/null +++ b/src/Data/ByteString/Lex/Lazy/Double.x @@ -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 +}