diff --git a/AUTHORS b/AUTHORS --- a/AUTHORS +++ b/AUTHORS @@ -12,3 +12,7 @@ Erik de Castro Lopo, Vincent Hanquez, and Christoph Breitkopf --- for excessive tweaking and benchmarking of the readDecimal function. + +Hirotomo Moriwaki --- for highlighting the inefficiency of the old + Alex-based parser by publishing bytestring-read. And for the + idea behind the new (v0.5.0) limited-precision parsers. diff --git a/CHANGELOG b/CHANGELOG --- a/CHANGELOG +++ b/CHANGELOG @@ -1,3 +1,10 @@ +0.5.0 (2015-05-05): + - Corrected the License field in the .cabal file to say BSD2 (instead of BSD3) + - Data.ByteString.Lex.{Double,.Lazy.Double}: removed + - Data.ByteString.Lex.Fractional: added based on the inefficiency of the old Alex-based parsers, as demonstrated by Hirotomo Moriwaki's bytestring-read (v0.3.0). + +0.4.3.3 (2015-05-30): + - Moved VERSION to CHANGELOG 0.4.3.1 (2014.03.07): - Updated the .cabal file to require newer alex for newer ghc. 0.4.3 (2013.03.21): diff --git a/LICENSE b/LICENSE --- a/LICENSE +++ b/LICENSE @@ -1,4 +1,4 @@ -Copyright (c) wren gayle romano 2012--2013; Don Stewart 2008, 2010 +Copyright (c) wren gayle romano 2012--2015; Don Stewart 2008, 2010 All rights reserved. diff --git a/README b/README --- a/README +++ b/README diff --git a/bytestring-lexing.cabal b/bytestring-lexing.cabal --- a/bytestring-lexing.cabal +++ b/bytestring-lexing.cabal @@ -1,5 +1,5 @@ ---------------------------------------------------------------- --- wren gayle romano ~ 2015.05.30 +-- wren gayle romano ~ 2015.06.05 ---------------------------------------------------------------- -- By and large Cabal >=1.2 is fine; but >= 1.6 gives tested-with: @@ -8,13 +8,13 @@ Build-Type: Simple Name: bytestring-lexing -Version: 0.4.3.3 +Version: 0.5.0 Stability: provisional Homepage: http://code.haskell.org/~wren/ Author: wren gayle romano, Don Stewart Maintainer: wren@community.haskell.org Copyright: Copyright (c) 2012--2015 wren gayle romano, 2008--2011 Don Stewart -License: BSD3 +License: BSD2 License-File: LICENSE Category: Data @@ -26,8 +26,10 @@ Some benchmarks for this package can be found at: + +-- Formerly tested with GHCs 6.8.2, 6.10.1, 6.12.1, 7.0.3, 7.6.1, 7.8.0; but those are no longer verified. Tested-With: - GHC ==6.8.2, GHC ==6.10.1, GHC ==6.12.1, GHC ==7.0.3, GHC ==7.6.1, GHC == 7.8.0 + GHC ==7.8.3, GHC == 7.10.1 Extra-source-files: AUTHORS, README, CHANGELOG Source-Repository head @@ -35,54 +37,15 @@ Location: http://community.haskell.org/~wren/bytestring-lexing ---------------------------------------------------------------- -Flag base4 - Default: True - Description: base-4.0 emits "Prelude deprecated" messages in - order to get people to be explicit about which - version of base they use. -Flag splitBase - Default: True - Description: base-3.0 (GHC 6.8) broke out the packages: array, - bytestring, containers, directory, old-locale, - old-time, packedstring, pretty, process, random. -Flag bytestringInBase - Default: False - Description: The bytestring library was included in base-2.0 - and base-2.1.1, but for base-1.0 and base-3.0 it - was a separate package. ----------------------------------------------------------------- Library - Hs-Source-Dirs: src - Exposed-Modules: Data.ByteString.Lex.Integral - Data.ByteString.Lex.Double - Data.ByteString.Lex.Lazy.Double - Other-Modules: Data.ByteString.Lex.Internal - - -- I think this is all that needs doing to get rid of the warnings? - if flag(base4) - Build-Depends: base >= 4 && < 5 - else - Build-Depends: base < 4 + Ghc-Options: -O2 + Hs-Source-Dirs: src + Exposed-Modules: Data.ByteString.Lex.Integral + Data.ByteString.Lex.Fractional + Other-Modules: Data.ByteString.Lex.Internal - if flag(bytestringInBase) - Build-Depends: base >= 2.0 && < 2.2 - else - Build-Depends: base < 2.0 || >= 3, bytestring - - if flag(splitBase) - Build-Depends: base >= 3 && < 5, bytestring, array - else - Build-Depends: base < 3 - - Ghc-Options: -O2 - - -- bytestring-posn was added in alex >= 2.3 (2008) - -- GHC 7.8.2 requires alex >= 3.1.3... - if impl(ghc >= 7.8) - Build-Tools: alex >= 3.1.3 - else - Build-Tools: alex >= 2.3 - + -- Should actually be able to work as far back as base-2.0... + Build-Depends: base >= 4 && < 5, bytestring ---------------------------------------------------------------- ----------------------------------------------------------- fin. diff --git a/dist/build/Data/ByteString/Lex/Double.hs b/dist/build/Data/ByteString/Lex/Double.hs deleted file mode 100644 --- a/dist/build/Data/ByteString/Lex/Double.hs +++ /dev/null @@ -1,438 +0,0 @@ -{-# LANGUAGE CPP,MagicHash #-} -{-# LINE 1 "src/Data/ByteString/Lex/Double.x" #-} - --- Turn off some common warnings about Alex-generated code. --- {-# OPTIONS_GHC -Wall -fno-warn-tabs -fno-warn-missing-signatures #-} ----------------------------------------------------------------- --- 2012.01.25 --- | --- Module : Data.ByteString.Lex.Double --- Copyright : Copyright (c) 2008--2011 Don Stewart --- License : BSD2/MIT --- Maintainer : wren@community.haskell.org --- Stability : stable --- Portability : Haskell98 --- --- Efficiently parse floating point literals from a 'ByteString'. ----------------------------------------------------------------- - -module Data.ByteString.Lex.Double (readDouble, unsafeReadDouble) where - -import qualified Data.ByteString as B -import Data.ByteString.Internal -import Data.ByteString.Lex.Internal (strtod, c_strtod) -import qualified Data.ByteString.Unsafe as B - -import Foreign -import Foreign.C.Types -import Foreign.C.String ----------------------------------------------------------------- - -#if __GLASGOW_HASKELL__ >= 603 -#include "ghcconfig.h" -#elif defined(__GLASGOW_HASKELL__) -#include "config.h" -#endif -#if __GLASGOW_HASKELL__ >= 503 -import Data.Array -import Data.Char (ord) -import Data.Array.Base (unsafeAt) -#else -import Array -import Char (ord) -#endif -#if __GLASGOW_HASKELL__ >= 503 -import GHC.Exts -#else -import GlaExts -#endif -{-# LINE 1 "templates/wrappers.hs" #-} -{-# LINE 1 "templates/wrappers.hs" #-} -{-# LINE 1 "" #-} -{-# LINE 1 "" #-} -{-# LINE 1 "templates/wrappers.hs" #-} --- ----------------------------------------------------------------------------- --- Alex wrapper code. --- --- This code is in the PUBLIC DOMAIN; you may copy it freely and use --- it for any purpose whatsoever. - -import Data.Word (Word8) - - - - - - - - -import qualified Data.Char -import qualified Data.ByteString as ByteString -import qualified Data.ByteString.Internal as ByteString -import qualified Data.ByteString.Unsafe as ByteString - -{-# LINE 47 "templates/wrappers.hs" #-} - -type Byte = Word8 - --- ----------------------------------------------------------------------------- --- The input type - -{-# LINE 72 "templates/wrappers.hs" #-} - -{-# LINE 92 "templates/wrappers.hs" #-} - -{-# LINE 106 "templates/wrappers.hs" #-} - - -data AlexInput = AlexInput { alexChar :: {-# UNPACK #-}!Char - , alexStr :: {-# UNPACK #-}!ByteString.ByteString } - -alexInputPrevChar :: AlexInput -> Char -alexInputPrevChar = alexChar - -alexGetByte (AlexInput _ cs) - | ByteString.null cs = Nothing - | otherwise = Just $! (ByteString.head cs, AlexInput c cs') - where - (c,cs') = (ByteString.w2c (ByteString.unsafeHead cs) - , ByteString.unsafeTail cs) - - --- ----------------------------------------------------------------------------- --- Token positions - --- `Posn' records the location of a token in the input text. It has three --- fields: the address (number of chacaters preceding the token), line number --- and column of a token within the file. `start_pos' gives the position of the --- start of the file and `eof_pos' a standard encoding for the end of file. --- `move_pos' calculates the new position after traversing a given character, --- assuming the usual eight character tab stops. - -{-# LINE 144 "templates/wrappers.hs" #-} - --- ----------------------------------------------------------------------------- --- Default monad - -{-# LINE 242 "templates/wrappers.hs" #-} - - --- ----------------------------------------------------------------------------- --- Monad (with ByteString input) - -{-# LINE 333 "templates/wrappers.hs" #-} - - --- ----------------------------------------------------------------------------- --- Basic wrapper - -{-# LINE 360 "templates/wrappers.hs" #-} - - --- ----------------------------------------------------------------------------- --- Basic wrapper, ByteString version - -{-# LINE 378 "templates/wrappers.hs" #-} - - - --- alexScanTokens :: String -> [token] -alexScanTokens str = go (AlexInput '\n' str) - where go inp@(AlexInput _ str) = - case alexScan inp 0 of - AlexEOF -> [] - AlexError _ -> error "lexical error" - AlexSkip inp' len -> go inp' - AlexToken inp'@(AlexInput _ str') _ act -> act (ByteString.unsafeTake len str) : go inp' - where len = ByteString.length str - ByteString.length str' - - - - --- ----------------------------------------------------------------------------- --- Posn wrapper - --- Adds text positions to the basic model. - -{-# LINE 409 "templates/wrappers.hs" #-} - - --- ----------------------------------------------------------------------------- --- Posn wrapper, ByteString version - -{-# LINE 424 "templates/wrappers.hs" #-} - - --- ----------------------------------------------------------------------------- --- GScan wrapper - --- For compatibility with previous versions of Alex, and because we can. - -alex_base :: AlexAddr -alex_base = AlexA# "\xd6\xff\xff\xff\xe0\xff\xff\xff\xe8\xff\xff\xff\x04\x00\x00\x00\x0e\x00\x00\x00\x1f\x00\x00\x00\x27\x00\x00\x00\x40\x00\x00\x00\x69\x00\x00\x00"# - -alex_table :: AlexAddr -alex_table = AlexA# "\x00\x00\x04\x00\x00\x00\x04\x00\x00\x00\x00\x00\x07\x00\x08\x00\x08\x00\x08\x00\x08\x00\x08\x00\x08\x00\x08\x00\x08\x00\x08\x00\x05\x00\x05\x00\x05\x00\x05\x00\x05\x00\x05\x00\x05\x00\x05\x00\x06\x00\x06\x00\x06\x00\x06\x00\x06\x00\x06\x00\x06\x00\x06\x00\x06\x00\x06\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x06\x00\x06\x00\x06\x00\x06\x00\x06\x00\x06\x00\x03\x00\x00\x00\x03\x00\x00\x00\x00\x00\x08\x00\x08\x00\x08\x00\x08\x00\x08\x00\x08\x00\x08\x00\x08\x00\x08\x00\x08\x00\x07\x00\x08\x00\x08\x00\x08\x00\x08\x00\x08\x00\x08\x00\x08\x00\x08\x00\x08\x00\x00\x00\x06\x00\x06\x00\x06\x00\x06\x00\x06\x00\x06\x00\x05\x00\x05\x00\x05\x00\x05\x00\x05\x00\x05\x00\x05\x00\x05\x00\x06\x00\x06\x00\x06\x00\x06\x00\x06\x00\x06\x00\x06\x00\x06\x00\x06\x00\x06\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x06\x00\x06\x00\x06\x00\x06\x00\x06\x00\x06\x00\x03\x00\x00\x00\x08\x00\x08\x00\x08\x00\x08\x00\x08\x00\x08\x00\x08\x00\x08\x00\x08\x00\x08\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x03\x00\x00\x00\x00\x00\x06\x00\x06\x00\x06\x00\x06\x00\x06\x00\x06\x00\x00\x00\x01\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x03\x00\x02\x00\x08\x00\x08\x00\x08\x00\x08\x00\x08\x00\x08\x00\x08\x00\x08\x00\x08\x00\x08\x00\x00\x00\x00\x00\x03\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x03\x00\x01\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x02\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x03\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00"# - -alex_check :: AlexAddr -alex_check = AlexA# "\xff\xff\x2b\x00\xff\xff\x2d\x00\xff\xff\xff\xff\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\x37\x00\x38\x00\x39\x00\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\x37\x00\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\x37\x00\x38\x00\x39\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x41\x00\x42\x00\x43\x00\x44\x00\x45\x00\x46\x00\x2b\x00\xff\xff\x2d\x00\xff\xff\xff\xff\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\x37\x00\x38\x00\x39\x00\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\x37\x00\x38\x00\x39\x00\xff\xff\x61\x00\x62\x00\x63\x00\x64\x00\x65\x00\x66\x00\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\x37\x00\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\x37\x00\x38\x00\x39\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x41\x00\x42\x00\x43\x00\x44\x00\x45\x00\x46\x00\x2e\x00\xff\xff\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\x37\x00\x38\x00\x39\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x45\x00\xff\xff\xff\xff\x61\x00\x62\x00\x63\x00\x64\x00\x65\x00\x66\x00\xff\xff\x4f\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x2e\x00\x58\x00\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\x37\x00\x38\x00\x39\x00\xff\xff\xff\xff\x65\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x45\x00\x6f\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x78\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x65\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff"# - -alex_deflt :: AlexAddr -alex_deflt = AlexA# "\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff"# - -alex_accept = listArray (0::Int,8) [AlexAccNone,AlexAccNone,AlexAccNone,AlexAccNone,AlexAccNone,AlexAcc (alex_action_0),AlexAcc (alex_action_0),AlexAcc (alex_action_0),AlexAcc (alex_action_0)] -{-# LINE 53 "src/Data/ByteString/Lex/Double.x" #-} - - --- | Parse the initial portion of the ByteString as a Double precision --- floating point value. The expected form of the numeric literal --- is given by: --- --- * An optional '+' or '-' sign --- --- * Decimal digits, OR --- --- * 0 [oO] and a sequence of octal digits, OR --- --- * 0 [xX] and a sequence of hexadecimal digits, OR --- --- * An optional decimal point, followed by a sequence of decimal digits, --- --- * And an optional exponent --- --- The result is returned as a pair of a double-precision floating --- point value and the remaining input, or @Nothing@ should no parse --- be found. --- --- For example, to sum a file of floating point numbers, one per line, --- --- > import qualified Data.ByteString.Char8 as S --- > import qualified Data.ByteString.Unsafe as S --- > import Data.ByteString.Lex.Double --- > --- > main = print . go 0 =<< S.getContents --- > where --- > go n s = case readDouble s of --- > Nothing -> n --- > Just (k,rest) -> go (n+k) (S.tail rest) --- -readDouble :: ByteString -> Maybe (Double, ByteString) -readDouble str = case alexScan (AlexInput '\n' str) 0 of - AlexEOF -> Nothing - AlexError _ -> Nothing - AlexToken (AlexInput _ rest) n _ -> - case strtod (B.unsafeTake n str) of d -> d `seq` Just $! (d , rest) - ----------------------------------------------------------------- --- | Bare bones, unsafe wrapper for C's @strtod(3)@. This provides --- a non-copying direct parsing of Double values from a ByteString. --- It uses @strtod@ directly on the bytestring buffer. @strtod@ --- requires the string to be null terminated, or for a guarantee --- that parsing will find a floating point value before the end of --- the string. --- -unsafeReadDouble :: ByteString -> Maybe (Double, ByteString) -{-# INLINE unsafeReadDouble #-} -unsafeReadDouble b - | B.null b = Nothing - | otherwise = inlinePerformIO $ - alloca $ \resptr -> - B.unsafeUseAsCString b $ \ptr -> do -- copy just the bytes we want to parse --- resetErrno - d <- c_strtod ptr resptr -- --- err <- getErrno - newPtr <- peek resptr - return $! case d of - 0 | newPtr == ptr -> Nothing --- _ | err == eRANGE -> Nothing -- adds 10% overhead - _ | otherwise -> - let rest = B.unsafeDrop (newPtr `minusPtr` ptr) b - z = realToFrac d - in z `seq` rest `seq` Just $! (z, rest) - - -alex_action_0 = strtod -{-# LINE 1 "templates/GenericTemplate.hs" #-} -{-# LINE 1 "templates/GenericTemplate.hs" #-} -{-# LINE 1 "" #-} -{-# LINE 1 "" #-} -{-# LINE 1 "templates/GenericTemplate.hs" #-} --- ----------------------------------------------------------------------------- --- ALEX TEMPLATE --- --- This code is in the PUBLIC DOMAIN; you may copy it freely and use --- it for any purpose whatsoever. - --- ----------------------------------------------------------------------------- --- INTERNALS and main scanner engine - -{-# LINE 21 "templates/GenericTemplate.hs" #-} - - - - - --- Do not remove this comment. Required to fix CPP parsing when using GCC and a clang-compiled alex. -#if __GLASGOW_HASKELL__ > 706 -#define GTE(n,m) (tagToEnum# (n >=# m)) -#define EQ(n,m) (tagToEnum# (n ==# m)) -#else -#define GTE(n,m) (n >=# m) -#define EQ(n,m) (n ==# m) -#endif -{-# LINE 51 "templates/GenericTemplate.hs" #-} - - -data AlexAddr = AlexA# Addr# --- Do not remove this comment. Required to fix CPP parsing when using GCC and a clang-compiled alex. -#if __GLASGOW_HASKELL__ < 503 -uncheckedShiftL# = shiftL# -#endif - -{-# INLINE alexIndexInt16OffAddr #-} -alexIndexInt16OffAddr (AlexA# arr) off = -#ifdef WORDS_BIGENDIAN - narrow16Int# i - where - i = word2Int# ((high `uncheckedShiftL#` 8#) `or#` low) - high = int2Word# (ord# (indexCharOffAddr# arr (off' +# 1#))) - low = int2Word# (ord# (indexCharOffAddr# arr off')) - off' = off *# 2# -#else - indexInt16OffAddr# arr off -#endif - - - - - -{-# INLINE alexIndexInt32OffAddr #-} -alexIndexInt32OffAddr (AlexA# arr) off = -#ifdef WORDS_BIGENDIAN - narrow32Int# i - where - i = word2Int# ((b3 `uncheckedShiftL#` 24#) `or#` - (b2 `uncheckedShiftL#` 16#) `or#` - (b1 `uncheckedShiftL#` 8#) `or#` b0) - b3 = int2Word# (ord# (indexCharOffAddr# arr (off' +# 3#))) - b2 = int2Word# (ord# (indexCharOffAddr# arr (off' +# 2#))) - b1 = int2Word# (ord# (indexCharOffAddr# arr (off' +# 1#))) - b0 = int2Word# (ord# (indexCharOffAddr# arr off')) - off' = off *# 4# -#else - indexInt32OffAddr# arr off -#endif - - - - - - -#if __GLASGOW_HASKELL__ < 503 -quickIndex arr i = arr ! i -#else --- GHC >= 503, unsafeAt is available from Data.Array.Base. -quickIndex = unsafeAt -#endif - - - - --- ----------------------------------------------------------------------------- --- Main lexing routines - -data AlexReturn a - = AlexEOF - | AlexError !AlexInput - | AlexSkip !AlexInput !Int - | AlexToken !AlexInput !Int a - --- alexScan :: AlexInput -> StartCode -> AlexReturn a -alexScan input (I# (sc)) - = alexScanUser undefined input (I# (sc)) - -alexScanUser user input (I# (sc)) - = case alex_scan_tkn user input 0# input sc AlexNone of - (AlexNone, input') -> - case alexGetByte input of - Nothing -> - - - - AlexEOF - Just _ -> - - - - AlexError input' - - (AlexLastSkip input'' len, _) -> - - - - AlexSkip input'' len - - (AlexLastAcc k input''' len, _) -> - - - - AlexToken input''' len k - - --- Push the input through the DFA, remembering the most recent accepting --- state it encountered. - -alex_scan_tkn user orig_input len input s last_acc = - input `seq` -- strict in the input - let - new_acc = (check_accs (alex_accept `quickIndex` (I# (s)))) - in - new_acc `seq` - case alexGetByte input of - Nothing -> (new_acc, input) - Just (c, new_input) -> - - - - case fromIntegral c of { (I# (ord_c)) -> - let - base = alexIndexInt32OffAddr alex_base s - offset = (base +# ord_c) - check = alexIndexInt16OffAddr alex_check offset - - new_s = if GTE(offset,0#) && EQ(check,ord_c) - then alexIndexInt16OffAddr alex_table offset - else alexIndexInt16OffAddr alex_deflt s - in - case new_s of - -1# -> (new_acc, input) - -- on an error, we want to keep the input *before* the - -- character that failed, not after. - _ -> alex_scan_tkn user orig_input (if c < 0x80 || c >= 0xC0 then (len +# 1#) else len) - -- note that the length is increased ONLY if this is the 1st byte in a char encoding) - new_input new_s new_acc - } - where - check_accs (AlexAccNone) = last_acc - check_accs (AlexAcc a ) = AlexLastAcc a input (I# (len)) - check_accs (AlexAccSkip) = AlexLastSkip input (I# (len)) -{-# LINE 198 "templates/GenericTemplate.hs" #-} - -data AlexLastAcc a - = AlexNone - | AlexLastAcc a !AlexInput !Int - | AlexLastSkip !AlexInput !Int - -instance Functor AlexLastAcc where - fmap f AlexNone = AlexNone - fmap f (AlexLastAcc x y z) = AlexLastAcc (f x) y z - fmap f (AlexLastSkip x y) = AlexLastSkip x y - -data AlexAcc a user - = AlexAccNone - | AlexAcc a - | AlexAccSkip -{-# LINE 242 "templates/GenericTemplate.hs" #-} - --- used by wrappers -iUnbox (I# (i)) = i diff --git a/dist/build/Data/ByteString/Lex/Lazy/Double.hs b/dist/build/Data/ByteString/Lex/Lazy/Double.hs deleted file mode 100644 --- a/dist/build/Data/ByteString/Lex/Lazy/Double.hs +++ /dev/null @@ -1,400 +0,0 @@ -{-# LANGUAGE CPP,MagicHash #-} -{-# LINE 1 "src/Data/ByteString/Lex/Lazy/Double.x" #-} - --- Turn off some common warnings about Alex-generated code. --- {-# OPTIONS_GHC -Wall -fno-warn-tabs -fno-warn-missing-signatures #-} ----------------------------------------------------------------- --- 2012.01.25 --- | --- Module : Data.ByteString.Lex.Lazy.Double --- Copyright : Copyright (c) 2008--2011 Don Stewart --- License : BSD2/MIT --- Maintainer : wren@community.haskell.org --- Stability : stable --- Portability : Haskell98 --- --- Efficiently parse floating point literals from a 'ByteString'. ----------------------------------------------------------------- - -module Data.ByteString.Lex.Lazy.Double (readDouble) where - -import qualified Data.ByteString.Lazy as LB -import qualified Data.ByteString as SB -import Data.ByteString.Lex.Internal (strtod) ----------------------------------------------------------------- - -#if __GLASGOW_HASKELL__ >= 603 -#include "ghcconfig.h" -#elif defined(__GLASGOW_HASKELL__) -#include "config.h" -#endif -#if __GLASGOW_HASKELL__ >= 503 -import Data.Array -import Data.Char (ord) -import Data.Array.Base (unsafeAt) -#else -import Array -import Char (ord) -#endif -#if __GLASGOW_HASKELL__ >= 503 -import GHC.Exts -#else -import GlaExts -#endif -{-# LINE 1 "templates/wrappers.hs" #-} -{-# LINE 1 "templates/wrappers.hs" #-} -{-# LINE 1 "" #-} -{-# LINE 1 "" #-} -{-# LINE 1 "templates/wrappers.hs" #-} --- ----------------------------------------------------------------------------- --- Alex wrapper code. --- --- This code is in the PUBLIC DOMAIN; you may copy it freely and use --- it for any purpose whatsoever. - -import Data.Word (Word8) - - -import qualified Data.Char -import qualified Data.ByteString.Lazy as ByteString -import qualified Data.ByteString.Internal as ByteString (w2c) - -{-# LINE 47 "templates/wrappers.hs" #-} - -type Byte = Word8 - --- ----------------------------------------------------------------------------- --- The input type - -{-# LINE 72 "templates/wrappers.hs" #-} - -{-# LINE 92 "templates/wrappers.hs" #-} - - -type AlexInput = (Char, - ByteString.ByteString) - -alexInputPrevChar :: AlexInput -> Char -alexInputPrevChar (c,_) = c - -alexGetByte (_, cs) - | ByteString.null cs = Nothing - | otherwise = Just (ByteString.head cs, - (ByteString.w2c $ ByteString.head cs, - ByteString.tail cs)) - - -{-# LINE 121 "templates/wrappers.hs" #-} - --- ----------------------------------------------------------------------------- --- Token positions - --- `Posn' records the location of a token in the input text. It has three --- fields: the address (number of chacaters preceding the token), line number --- and column of a token within the file. `start_pos' gives the position of the --- start of the file and `eof_pos' a standard encoding for the end of file. --- `move_pos' calculates the new position after traversing a given character, --- assuming the usual eight character tab stops. - -{-# LINE 144 "templates/wrappers.hs" #-} - --- ----------------------------------------------------------------------------- --- Default monad - -{-# LINE 242 "templates/wrappers.hs" #-} - - --- ----------------------------------------------------------------------------- --- Monad (with ByteString input) - -{-# LINE 333 "templates/wrappers.hs" #-} - - --- ----------------------------------------------------------------------------- --- Basic wrapper - -{-# LINE 360 "templates/wrappers.hs" #-} - - --- ----------------------------------------------------------------------------- --- Basic wrapper, ByteString version - - - --- alexScanTokens :: String -> [token] -alexScanTokens str = go ('\n',str) - where go inp@(_,str) = - case alexScan inp 0 of - AlexEOF -> [] - AlexError _ -> error "lexical error" - AlexSkip inp' len -> go inp' - AlexToken inp'@(_,str') _ act -> act (ByteString.take len str) : go inp' - where len = ByteString.length str - ByteString.length str' - - - -{-# LINE 392 "templates/wrappers.hs" #-} - - --- ----------------------------------------------------------------------------- --- Posn wrapper - --- Adds text positions to the basic model. - -{-# LINE 409 "templates/wrappers.hs" #-} - - --- ----------------------------------------------------------------------------- --- Posn wrapper, ByteString version - -{-# LINE 424 "templates/wrappers.hs" #-} - - --- ----------------------------------------------------------------------------- --- GScan wrapper - --- For compatibility with previous versions of Alex, and because we can. - -alex_base :: AlexAddr -alex_base = AlexA# "\xd6\xff\xff\xff\xe0\xff\xff\xff\xe8\xff\xff\xff\x04\x00\x00\x00\x0e\x00\x00\x00\x1f\x00\x00\x00\x27\x00\x00\x00\x40\x00\x00\x00\x69\x00\x00\x00"# - -alex_table :: AlexAddr -alex_table = AlexA# "\x00\x00\x04\x00\x00\x00\x04\x00\x00\x00\x00\x00\x07\x00\x08\x00\x08\x00\x08\x00\x08\x00\x08\x00\x08\x00\x08\x00\x08\x00\x08\x00\x05\x00\x05\x00\x05\x00\x05\x00\x05\x00\x05\x00\x05\x00\x05\x00\x06\x00\x06\x00\x06\x00\x06\x00\x06\x00\x06\x00\x06\x00\x06\x00\x06\x00\x06\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x06\x00\x06\x00\x06\x00\x06\x00\x06\x00\x06\x00\x03\x00\x00\x00\x03\x00\x00\x00\x00\x00\x08\x00\x08\x00\x08\x00\x08\x00\x08\x00\x08\x00\x08\x00\x08\x00\x08\x00\x08\x00\x07\x00\x08\x00\x08\x00\x08\x00\x08\x00\x08\x00\x08\x00\x08\x00\x08\x00\x08\x00\x00\x00\x06\x00\x06\x00\x06\x00\x06\x00\x06\x00\x06\x00\x05\x00\x05\x00\x05\x00\x05\x00\x05\x00\x05\x00\x05\x00\x05\x00\x06\x00\x06\x00\x06\x00\x06\x00\x06\x00\x06\x00\x06\x00\x06\x00\x06\x00\x06\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x06\x00\x06\x00\x06\x00\x06\x00\x06\x00\x06\x00\x03\x00\x00\x00\x08\x00\x08\x00\x08\x00\x08\x00\x08\x00\x08\x00\x08\x00\x08\x00\x08\x00\x08\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x03\x00\x00\x00\x00\x00\x06\x00\x06\x00\x06\x00\x06\x00\x06\x00\x06\x00\x00\x00\x01\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x03\x00\x02\x00\x08\x00\x08\x00\x08\x00\x08\x00\x08\x00\x08\x00\x08\x00\x08\x00\x08\x00\x08\x00\x00\x00\x00\x00\x03\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x03\x00\x01\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x02\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x03\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00"# - -alex_check :: AlexAddr -alex_check = AlexA# "\xff\xff\x2b\x00\xff\xff\x2d\x00\xff\xff\xff\xff\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\x37\x00\x38\x00\x39\x00\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\x37\x00\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\x37\x00\x38\x00\x39\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x41\x00\x42\x00\x43\x00\x44\x00\x45\x00\x46\x00\x2b\x00\xff\xff\x2d\x00\xff\xff\xff\xff\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\x37\x00\x38\x00\x39\x00\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\x37\x00\x38\x00\x39\x00\xff\xff\x61\x00\x62\x00\x63\x00\x64\x00\x65\x00\x66\x00\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\x37\x00\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\x37\x00\x38\x00\x39\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x41\x00\x42\x00\x43\x00\x44\x00\x45\x00\x46\x00\x2e\x00\xff\xff\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\x37\x00\x38\x00\x39\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x45\x00\xff\xff\xff\xff\x61\x00\x62\x00\x63\x00\x64\x00\x65\x00\x66\x00\xff\xff\x4f\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x2e\x00\x58\x00\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\x37\x00\x38\x00\x39\x00\xff\xff\xff\xff\x65\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x45\x00\x6f\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x78\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x65\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff"# - -alex_deflt :: AlexAddr -alex_deflt = AlexA# "\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff"# - -alex_accept = listArray (0::Int,8) [AlexAccNone,AlexAccNone,AlexAccNone,AlexAccNone,AlexAccNone,AlexAcc (alex_action_0),AlexAcc (alex_action_0),AlexAcc (alex_action_0),AlexAcc (alex_action_0)] -{-# LINE 48 "src/Data/ByteString/Lex/Lazy/Double.x" #-} - - --- | Parse the initial portion of the ByteString as a Double precision --- floating point value. The expected form of the numeric literal --- is given by: --- --- * An optional '+' or '-' sign --- --- * Decimal digits, OR --- --- * 0 [oO] and a sequence of octal digits, OR --- --- * 0 [xX] and a sequence of hexadecimal digits, OR --- --- * An optional decimal point, followed by a sequence of decimal digits, --- --- * And an optional exponent --- --- The result is returned as a pair of a double-precision floating --- point value and the remaining input, or @Nothing@ should no parse --- be found. --- --- For example, to sum a file of floating point numbers, one per line, --- --- > import qualified Data.ByteString.Char8 as S --- > import qualified Data.ByteString.Unsafe as S --- > import Data.ByteString.Lex.Double --- > --- > main = print . go 0 =<< S.getContents --- > where --- > go n s = case readDouble s of --- > Nothing -> n --- > Just (k,rest) -> go (n+k) (S.tail rest) --- -readDouble :: LB.ByteString -> Maybe (Double, LB.ByteString) -readDouble str = case alexScan ('\n', str) 0 of - AlexEOF -> Nothing - AlexError _ -> Nothing - AlexToken (_, rest) n _ -> - case strtod . strict . LB.take (fromIntegral n) $ str of - d -> Just $! (d , rest) - -strict = SB.concat . LB.toChunks - -alex_action_0 = strtod . strict -{-# LINE 1 "templates/GenericTemplate.hs" #-} -{-# LINE 1 "templates/GenericTemplate.hs" #-} -{-# LINE 1 "" #-} -{-# LINE 1 "" #-} -{-# LINE 1 "templates/GenericTemplate.hs" #-} --- ----------------------------------------------------------------------------- --- ALEX TEMPLATE --- --- This code is in the PUBLIC DOMAIN; you may copy it freely and use --- it for any purpose whatsoever. - --- ----------------------------------------------------------------------------- --- INTERNALS and main scanner engine - -{-# LINE 21 "templates/GenericTemplate.hs" #-} - - - - - --- Do not remove this comment. Required to fix CPP parsing when using GCC and a clang-compiled alex. -#if __GLASGOW_HASKELL__ > 706 -#define GTE(n,m) (tagToEnum# (n >=# m)) -#define EQ(n,m) (tagToEnum# (n ==# m)) -#else -#define GTE(n,m) (n >=# m) -#define EQ(n,m) (n ==# m) -#endif -{-# LINE 51 "templates/GenericTemplate.hs" #-} - - -data AlexAddr = AlexA# Addr# --- Do not remove this comment. Required to fix CPP parsing when using GCC and a clang-compiled alex. -#if __GLASGOW_HASKELL__ < 503 -uncheckedShiftL# = shiftL# -#endif - -{-# INLINE alexIndexInt16OffAddr #-} -alexIndexInt16OffAddr (AlexA# arr) off = -#ifdef WORDS_BIGENDIAN - narrow16Int# i - where - i = word2Int# ((high `uncheckedShiftL#` 8#) `or#` low) - high = int2Word# (ord# (indexCharOffAddr# arr (off' +# 1#))) - low = int2Word# (ord# (indexCharOffAddr# arr off')) - off' = off *# 2# -#else - indexInt16OffAddr# arr off -#endif - - - - - -{-# INLINE alexIndexInt32OffAddr #-} -alexIndexInt32OffAddr (AlexA# arr) off = -#ifdef WORDS_BIGENDIAN - narrow32Int# i - where - i = word2Int# ((b3 `uncheckedShiftL#` 24#) `or#` - (b2 `uncheckedShiftL#` 16#) `or#` - (b1 `uncheckedShiftL#` 8#) `or#` b0) - b3 = int2Word# (ord# (indexCharOffAddr# arr (off' +# 3#))) - b2 = int2Word# (ord# (indexCharOffAddr# arr (off' +# 2#))) - b1 = int2Word# (ord# (indexCharOffAddr# arr (off' +# 1#))) - b0 = int2Word# (ord# (indexCharOffAddr# arr off')) - off' = off *# 4# -#else - indexInt32OffAddr# arr off -#endif - - - - - - -#if __GLASGOW_HASKELL__ < 503 -quickIndex arr i = arr ! i -#else --- GHC >= 503, unsafeAt is available from Data.Array.Base. -quickIndex = unsafeAt -#endif - - - - --- ----------------------------------------------------------------------------- --- Main lexing routines - -data AlexReturn a - = AlexEOF - | AlexError !AlexInput - | AlexSkip !AlexInput !Int - | AlexToken !AlexInput !Int a - --- alexScan :: AlexInput -> StartCode -> AlexReturn a -alexScan input (I# (sc)) - = alexScanUser undefined input (I# (sc)) - -alexScanUser user input (I# (sc)) - = case alex_scan_tkn user input 0# input sc AlexNone of - (AlexNone, input') -> - case alexGetByte input of - Nothing -> - - - - AlexEOF - Just _ -> - - - - AlexError input' - - (AlexLastSkip input'' len, _) -> - - - - AlexSkip input'' len - - (AlexLastAcc k input''' len, _) -> - - - - AlexToken input''' len k - - --- Push the input through the DFA, remembering the most recent accepting --- state it encountered. - -alex_scan_tkn user orig_input len input s last_acc = - input `seq` -- strict in the input - let - new_acc = (check_accs (alex_accept `quickIndex` (I# (s)))) - in - new_acc `seq` - case alexGetByte input of - Nothing -> (new_acc, input) - Just (c, new_input) -> - - - - case fromIntegral c of { (I# (ord_c)) -> - let - base = alexIndexInt32OffAddr alex_base s - offset = (base +# ord_c) - check = alexIndexInt16OffAddr alex_check offset - - new_s = if GTE(offset,0#) && EQ(check,ord_c) - then alexIndexInt16OffAddr alex_table offset - else alexIndexInt16OffAddr alex_deflt s - in - case new_s of - -1# -> (new_acc, input) - -- on an error, we want to keep the input *before* the - -- character that failed, not after. - _ -> alex_scan_tkn user orig_input (if c < 0x80 || c >= 0xC0 then (len +# 1#) else len) - -- note that the length is increased ONLY if this is the 1st byte in a char encoding) - new_input new_s new_acc - } - where - check_accs (AlexAccNone) = last_acc - check_accs (AlexAcc a ) = AlexLastAcc a input (I# (len)) - check_accs (AlexAccSkip) = AlexLastSkip input (I# (len)) -{-# LINE 198 "templates/GenericTemplate.hs" #-} - -data AlexLastAcc a - = AlexNone - | AlexLastAcc a !AlexInput !Int - | AlexLastSkip !AlexInput !Int - -instance Functor AlexLastAcc where - fmap f AlexNone = AlexNone - fmap f (AlexLastAcc x y z) = AlexLastAcc (f x) y z - fmap f (AlexLastSkip x y) = AlexLastSkip x y - -data AlexAcc a user - = AlexAccNone - | AlexAcc a - | AlexAccSkip -{-# LINE 242 "templates/GenericTemplate.hs" #-} - --- used by wrappers -iUnbox (I# (i)) = i diff --git a/src/Data/ByteString/Lex/Double.x b/src/Data/ByteString/Lex/Double.x deleted file mode 100644 --- a/src/Data/ByteString/Lex/Double.x +++ /dev/null @@ -1,121 +0,0 @@ -{ --- Turn off some common warnings about Alex-generated code. --- {-# OPTIONS_GHC -Wall -fno-warn-tabs -fno-warn-missing-signatures #-} ----------------------------------------------------------------- --- 2012.01.25 --- | --- Module : Data.ByteString.Lex.Double --- Copyright : Copyright (c) 2008--2011 Don Stewart --- License : BSD2/MIT --- Maintainer : wren@community.haskell.org --- Stability : stable --- Portability : Haskell98 --- --- Efficiently parse floating point literals from a 'ByteString'. ----------------------------------------------------------------- - -module Data.ByteString.Lex.Double (readDouble, unsafeReadDouble) where - -import qualified Data.ByteString as B -import Data.ByteString.Internal -import Data.ByteString.Lex.Internal (strtod, c_strtod) -import qualified Data.ByteString.Unsafe as B - -import Foreign -import Foreign.C.Types -import Foreign.C.String ----------------------------------------------------------------- -} - -%wrapper "strict-bytestring" - -$space = [\ \t\xa0] -$digit = 0-9 -$octit = 0-7 -$hexit = [$digit A-F a-f] - -@sign = [\-\+] -@decimal = $digit+ -@octal = $octit+ -@hexadecimal = $hexit+ -@exponent = [eE] [\-\+]? @decimal - -@number = @decimal - | @decimal \. @decimal @exponent? - | @decimal @exponent - | 0[oO] @octal - | 0[xX] @hexadecimal - -lex :- - -@sign? @number { strtod } - -{ - --- | Parse the initial portion of the ByteString as a Double precision --- floating point value. The expected form of the numeric literal --- is given by: --- --- * An optional '+' or '-' sign --- --- * Decimal digits, OR --- --- * 0 [oO] and a sequence of octal digits, OR --- --- * 0 [xX] and a sequence of hexadecimal digits, OR --- --- * An optional decimal point, followed by a sequence of decimal digits, --- --- * And an optional exponent --- --- The result is returned as a pair of a double-precision floating --- point value and the remaining input, or @Nothing@ should no parse --- be found. --- --- For example, to sum a file of floating point numbers, one per line, --- --- > import qualified Data.ByteString.Char8 as S --- > import qualified Data.ByteString.Unsafe as S --- > import Data.ByteString.Lex.Double --- > --- > main = print . go 0 =<< S.getContents --- > where --- > go n s = case readDouble s of --- > Nothing -> n --- > Just (k,rest) -> go (n+k) (S.tail rest) --- -readDouble :: ByteString -> Maybe (Double, ByteString) -readDouble str = case alexScan (AlexInput '\n' str) 0 of - AlexEOF -> Nothing - AlexError _ -> Nothing - AlexToken (AlexInput _ rest) n _ -> - case strtod (B.unsafeTake n str) of d -> d `seq` Just $! (d , rest) - ----------------------------------------------------------------- --- | Bare bones, unsafe wrapper for C's @strtod(3)@. This provides --- a non-copying direct parsing of Double values from a ByteString. --- It uses @strtod@ directly on the bytestring buffer. @strtod@ --- requires the string to be null terminated, or for a guarantee --- that parsing will find a floating point value before the end of --- the string. --- -unsafeReadDouble :: ByteString -> Maybe (Double, ByteString) -{-# INLINE unsafeReadDouble #-} -unsafeReadDouble b - | B.null b = Nothing - | otherwise = inlinePerformIO $ - alloca $ \resptr -> - B.unsafeUseAsCString b $ \ptr -> do -- copy just the bytes we want to parse --- resetErrno - d <- c_strtod ptr resptr -- --- err <- getErrno - newPtr <- peek resptr - return $! case d of - 0 | newPtr == ptr -> Nothing --- _ | err == eRANGE -> Nothing -- adds 10% overhead - _ | otherwise -> - let rest = B.unsafeDrop (newPtr `minusPtr` ptr) b - z = realToFrac d - in z `seq` rest `seq` Just $! (z, rest) - -} diff --git a/src/Data/ByteString/Lex/Fractional.hs b/src/Data/ByteString/Lex/Fractional.hs new file mode 100644 --- /dev/null +++ b/src/Data/ByteString/Lex/Fractional.hs @@ -0,0 +1,468 @@ +{-# OPTIONS_GHC -Wall -fwarn-tabs #-} +{-# LANGUAGE ScopedTypeVariables #-} +---------------------------------------------------------------- +-- 2015.06.05 +-- | +-- Module : Data.ByteString.Lex.Fractional +-- Copyright : Copyright (c) 2015 wren gayle romano +-- License : BSD2 +-- Maintainer : wren@community.haskell.org +-- Stability : provisional +-- Portability : Haskell98 + ScopedTypeVariables +-- +-- Functions for parsing and producing 'Fractional' values from\/to +-- 'ByteString's based on the \"Char8\" encoding. That is, we assume +-- an ASCII-compatible encoding of alphanumeric characters. +-- +-- /Since: 0.5.0/ +---------------------------------------------------------------- +module Data.ByteString.Lex.Fractional + ( + -- * General combinators + readSigned + -- packSigned + -- * Decimal conversions + , readDecimal + -- packDecimal + -- TODO: asDecimal -- this will be really hard to make efficient... + -- * Hexadecimal conversions + , readHexadecimal + -- packHexadecimal + -- asHexadecimal + -- * Octal conversions + , readOctal + -- packOctal + -- asOctal -- this will be really hard to make efficient... + -- * Exponential conversions + , readExponential + -- packExponential + -- asExponential + -- * Precision-limited conversions + , decimalPrecision + , readDecimalLimited + , readExponentialLimited + ) where + +import Data.ByteString (ByteString) +import qualified Data.ByteString as BS +import qualified Data.ByteString.Unsafe as BSU +import Data.Word (Word8) +import qualified Data.ByteString.Lex.Integral as I +import Data.ByteString.Lex.Integral (readSigned) +import Data.ByteString.Lex.Internal (numDecimalDigits) + +---------------------------------------------------------------- +---------------------------------------------------------------- + +-- | A helper function to ensure consistent strictness. +-- TODO: should we really be this strict? +justPair :: a -> b -> Maybe (a,b) +{-# INLINE justPair #-} +justPair x y + | x `seq` y `seq` False = undefined + | otherwise = Just (x,y) + +pair :: a -> b -> (a,b) +{-# INLINE pair #-} +pair x y + | x `seq` y `seq` False = undefined + | otherwise = (x,y) + + +-- NOTE: We use 'fromInteger' everywhere instead of 'fromIntegral' +-- in order to fix the types of the calls to 'I.readDecimal', etc. +-- This is always correct, but for some result types there are other +-- intermediate types which may be faster. + +{-# INLINE isNotPeriod #-} +isNotPeriod :: Word8 -> Bool +isNotPeriod w = w /= 0x2E + +{-# INLINE isNotE #-} +isNotE :: Word8 -> Bool +isNotE w = w /= 0x65 && w /= 0x45 + +{-# INLINE isDecimal #-} +isDecimal :: Word8 -> Bool +isDecimal w = 0x39 >= w && w >= 0x30 + +{-# INLINE isDecimalZero #-} +isDecimalZero :: Word8 -> Bool +isDecimalZero w = w == 0x30 + +---------------------------------------------------------------- +----- Decimal + +-- | Read an unsigned\/non-negative fractional value in ASCII decimal +-- format; that is, anything matching the regex @\\d+(\\.\\d+)?@. +-- Returns @Nothing@ if there is no such number at the beginning +-- of the string, otherwise returns @Just@ the number read and the +-- remainder of the string. +-- +-- N.B., see 'readDecimalLimited' if your fractional type has limited +-- precision and you expect your inputs to have greater precision +-- than can be represented. Even for types with unlimited precision +-- (e.g., 'Rational'), you may want to check out 'readDecimalLimited'. +readDecimal :: (Fractional a) => ByteString -> Maybe (a, ByteString) +{-# SPECIALIZE readDecimal :: + ByteString -> Maybe (Float, ByteString), + ByteString -> Maybe (Double, ByteString), + ByteString -> Maybe (Rational, ByteString) #-} +readDecimal xs = + case I.readDecimal xs of + Nothing -> Nothing + Just (whole, ys) -> + case BS.uncons ys of + Nothing -> justPair (fromInteger whole) BS.empty + Just (y0,ys0) + | isNotPeriod y0 -> justPair (fromInteger whole) ys + | otherwise -> + case I.readDecimal ys0 of + Nothing -> justPair (fromInteger whole) ys + Just (part, zs) -> + let base = 10 ^ (BS.length ys - 1 - BS.length zs) + frac = fromInteger whole + (fromInteger part / base) + in justPair frac zs + + +---------------------------------------------------------------- +-- If and only if(!) we have Real, then we can use 'toRational'... +-- Similarly, only if we have RealFloat can we use 'decodeFloat'... + +-- TODO: +-- Convert a non-negative fractional number into an (unsigned) +-- ASCII decimal string. Returns @Nothing@ on negative inputs. +-- packDecimal :: (Fractional a) => a -> Maybe ByteString + + +---------------------------------------------------------------- +---------------------------------------------------------------- +----- Hexadecimal + +-- | Read a non-negative integral value in ASCII hexadecimal format. +-- Returns @Nothing@ if there is no integer at the beginning of the +-- string, otherwise returns @Just@ the integer read and the remainder +-- of the string. +-- +-- This function does not recognize the various hexadecimal sigils +-- like \"0x\", but because there are so many different variants, +-- those are best handled by helper functions which then use this +-- function for the actual numerical parsing. This function recognizes +-- both upper-case, lower-case, and mixed-case hexadecimal. +readHexadecimal :: (Fractional a) => ByteString -> Maybe (a, ByteString) +{-# SPECIALIZE readHexadecimal :: + ByteString -> Maybe (Float, ByteString), + ByteString -> Maybe (Double, ByteString), + ByteString -> Maybe (Rational, ByteString) #-} +readHexadecimal xs = + case I.readHexadecimal xs of + Nothing -> Nothing + Just (n, xs') -> justPair (fromInteger n) xs' + + +-- TODO: +-- Convert a non-negative integer into a lower-case ASCII hexadecimal +-- string. Returns @Nothing@ on negative inputs. +-- packHexadecimal :: (Fractional a) => a -> Maybe ByteString + + +---------------------------------------------------------------- +---------------------------------------------------------------- +----- Octal + +-- | Read a non-negative integral value in ASCII octal format. +-- Returns @Nothing@ if there is no integer at the beginning of the +-- string, otherwise returns @Just@ the integer read and the remainder +-- of the string. +-- +-- This function does not recognize the various octal sigils like +-- \"0o\", but because there are different variants, those are best +-- handled by helper functions which then use this function for the +-- actual numerical parsing. +readOctal :: (Fractional a) => ByteString -> Maybe (a, ByteString) +{-# SPECIALIZE readOctal :: + ByteString -> Maybe (Float, ByteString), + ByteString -> Maybe (Double, ByteString), + ByteString -> Maybe (Rational, ByteString) #-} +readOctal xs = + case I.readOctal xs of + Nothing -> Nothing + Just (n, xs') -> justPair (fromInteger n) xs' + +-- TODO: +-- Convert a non-negative integer into an ASCII octal string. +-- Returns @Nothing@ on negative inputs. +-- packOctal :: (Fractional a) => a -> Maybe ByteString + + +---------------------------------------------------------------- +---------------------------------------------------------------- +----- Exponential + +-- | Read an unsigned\/non-negative fractional value in ASCII +-- exponential format; that is, anything matching the regex +-- @\\d+(\\.\\d+)?([eE][\\+\\-]?\\d+)?@. Returns @Nothing@ if there +-- is no such number at the beginning of the string, otherwise +-- returns @Just@ the number read and the remainder of the string. +-- +-- N.B., the current implementation assumes the exponent is small +-- enough to fit into an 'Int'. This gives a significant performance +-- increase for @a ~ Float@ and @a ~ Double@ and agrees with the +-- 'RealFloat' class which has 'exponent' returning an 'Int'. If +-- you need a larger exponent, contact the maintainer. +-- +-- N.B., see 'readExponentialLimited' if your fractional type has +-- limited precision and you expect your inputs to have greater +-- precision than can be represented. Even for types with unlimited +-- precision, you may want to check out 'readExponentialLimited'. +readExponential :: (Fractional a) => ByteString -> Maybe (a, ByteString) +{-# SPECIALIZE readExponential :: + ByteString -> Maybe (Float, ByteString), + ByteString -> Maybe (Double, ByteString), + ByteString -> Maybe (Rational, ByteString) #-} +readExponential xs = + case readDecimal xs of + Nothing -> Nothing + Just (frac, ys) -> + case BS.uncons ys of + Nothing -> justPair frac BS.empty + Just (y0,ys0) + | isNotE y0 -> justPair frac ys + | otherwise -> + -- HACK: monomorphizing @e::Int@ for performance! + case readSigned I.readDecimal ys0 of + Nothing -> justPair frac ys + Just (ex,zs) -> justPair (frac * (10 ^^ (ex::Int))) zs + + +---------------------------------------------------------------- +---------------------------------------------------------------- +----- Limited + + +-- | A representation of unsigned fractional numbers decomposed +-- into a significand\/mantissa and a decimal exponent. This allows +-- efficient scaling by decimal exponents (cf., 'scaleDF'). +-- +-- TODO: the first component should be some @a@-specific intermediate +-- representation, as defined by a fundep or typefamily! We use +-- 'Integer' which is sufficient for all cases, but it'd be better +-- to use @Word24@ for 'Float', @Word53@ for 'Double', and @a@ for +-- @'Ratio' a@. +data DecimalFraction a = DF !Integer {-# UNPACK #-}!Int +-- BUG: Can't unpack integers... + + +-- | A helpful smart constructor. +fractionDF :: Integer -> Int -> Integer -> DecimalFraction a +{-# INLINE fractionDF #-} +fractionDF whole scale part = + DF (whole * (10 ^ scale) + part) (negate scale) + -- TODO: use an unsafe variant of (^) which has an assertion instead of a runtime check? + + +-- | Extract the fractional number encoded in the record. +-- +-- > fromDF (DF frac scale) = fromIntegral frac * (10 ^^ scale) +fromDF :: Fractional a => DecimalFraction a -> a +{-# INLINE fromDF #-} +fromDF (DF frac scale) + -- Avoid possibility of returning NaN + -- TODO: really, ought to check @fromInteger frac == 0@... + | frac == 0 = 0 + -- Avoid throwing an error due to @negate minBound == minBound@ + | scale == minBound = fromInteger frac * (10 ^^ toInteger scale) + -- Now we're safe for the default implementation + | otherwise = fromInteger frac * (10 ^^ scale) + -- TODO: manually implement (^^) so that we get @_ / (10^ _)@ + -- instead of @_ * recip (10^ _)@ for negative exponents? + + +-- | Scale a decimal fraction by some power of 10. +scaleDF :: DecimalFraction a -> Int -> DecimalFraction a +{-# INLINE scaleDF #-} +scaleDF (DF frac scale) scale' = DF frac (scale + scale') + + +-- TODO: is there a way to avoid ScopedTypeVariables without losing +-- the fact that this is a constant function? +-- +-- TODO: try looking at core again to see if @n@ gets completely +-- optimized away or not. If not, is there a way to help make that +-- happen without using TH? +-- +-- | Return the 'RealFloat' type's inherent decimal precision +-- limitation. This is the number of decimal digits in @floatRadix +-- proxy ^ floatDigits proxy@. +decimalPrecision :: forall proxy a. RealFloat a => proxy a -> Int +{-# INLINE decimalPrecision #-} +decimalPrecision = + let proxy = undefined :: a + n = numDecimalDigits (floatRadix proxy ^ floatDigits proxy) + in n `seq` \_ -> n + + +-- TODO: for the isDecimalZero instance, use 'BS.breakByte' where +-- possible; or design our own similar... +-- +-- | Drop while the predicate is true, and return the number of +-- bytes dropped. +lengthDropWhile :: (Word8 -> Bool) -> ByteString -> (Int, ByteString) +{-# INLINE lengthDropWhile #-} +lengthDropWhile p xs = + let ys = BS.dropWhile p xs + in (BS.length xs - BS.length ys, ys) + {- + -- TODO: benchmark + let len = BS.length (BS.takeWhile p xs) + in (len, BS.drop len xs) + + case BS.break (not . p) xs of + (ys,zs) -> (BS.length ys, zs) + -} + + +-- | A variant of 'readDecimal' which only reads up to some limited +-- precision. The first argument gives the number of decimal digits +-- at which to limit the precision. +-- +-- For types with inherently limited precision (e.g., 'Float' and +-- 'Double'), when you pass in the precision limit (cf., +-- 'decimalPrecision') this is far more efficient than 'readDecimal'. +-- However, passing in a precision limit which is greater than the +-- type's inherent limitation will degrate performance compared to +-- 'readDecimal'. +-- +-- For types with unlimited precision (e.g., 'Rational') this may +-- still be far more efficient than 'readDecimal' (it is for +-- 'Rational', in fact). The reason being that it delays the scaling +-- the significand\/mantissa by the exponent, thus allowing you to +-- further adjust the exponent before computing the final value +-- (e.g., as in 'readExponentialLimited'). This avoids the need to +-- renormalize intermediate results, and allows faster computation +-- of the scaling factor by doing it all at once. +readDecimalLimited :: (Fractional a) => Int -> ByteString -> Maybe (a, ByteString) +{-# INLINE readDecimalLimited #-} +readDecimalLimited p xs = + case readDecimalLimited_ p xs of + Nothing -> Nothing + Just (df,ys) -> justPair (fromDF df) ys + + +readDecimalLimited_ :: (Fractional a) => Int -> ByteString -> Maybe (DecimalFraction a, ByteString) +{-# SPECIALIZE readDecimalLimited_ :: + Int -> ByteString -> Maybe (DecimalFraction Float, ByteString), + Int -> ByteString -> Maybe (DecimalFraction Double, ByteString), + Int -> ByteString -> Maybe (DecimalFraction Rational, ByteString) #-} +readDecimalLimited_ = start + where + -- All calls to 'I.readDecimal' are monomorphized at 'Integer', + -- as specified by what 'DF' needs. + + -- TODO: verify this is ~inferred~ strict in both @p@ and @xs@ + -- without the guard trick or BangPatterns + start p xs + | p `seq` xs `seq` False = undefined + | otherwise = + case lengthDropWhile isDecimalZero xs of + (0, _) -> readWholePart p xs + (_, ys) -> + case BS.uncons ys of + Nothing -> justPair (DF 0 0) BS.empty + Just (y0,ys0) + | isDecimal y0 -> readWholePart p ys + | isNotPeriod y0 -> justPair (DF 0 0) ys + | otherwise -> + case lengthDropWhile isDecimalZero ys0 of + (0, _) -> readFractionPart p 0 ys + (scale, zs) -> afterDroppingZeroes p scale zs + + afterDroppingZeroes p scale xs = + let ys = BS.take p xs in + case I.readDecimal ys of + Nothing -> justPair (DF 0 0) xs + Just (part, ys') -> + let scale' = scale + BS.length xs - BS.length ys' + in justPair (DF part (negate scale')) + (BS.dropWhile isDecimal ys') + + readWholePart p xs = + let ys = BS.take p xs in + case I.readDecimal ys of + Nothing -> Nothing + Just (whole, ys') + | BS.null ys' -> + case lengthDropWhile isDecimal (BS.drop p xs) of + (scale, zs) -> + justPair (DF whole scale) (dropFractionPart zs) + | otherwise -> + let len = BS.length ys - BS.length ys' + -- N.B., @xs' == ys' `BS.append` BS.drop p xs@ + xs' = BS.drop len xs + in + -- N.B., @BS.null xs'@ is impossible. Were it to + -- happen then returning @pair (DF whole 0) BS.empty@ + -- is consistent with the branch where we drop the + -- fraction part (the original input is less than + -- the original @p@ long); however, reaching this + -- branch ia that input would be a control-flow + -- error. + if isNotPeriod (BSU.unsafeHead xs') + then justPair (DF whole 0) xs' + else readFractionPart (p-len) whole xs' + + dropFractionPart xs = + case BS.uncons xs of + Nothing -> BS.empty -- == xs + Just (x0,xs0) + | isNotPeriod x0 -> xs + | otherwise -> + case BS.uncons xs0 of + Nothing -> BS.singleton 0x2E -- == xs + Just (x1,xs1) + | isDecimal x1 -> BS.dropWhile isDecimal xs1 + | otherwise -> xs + + -- NOTES: @BS.null xs@ is impossible as it begins with a period; + -- see the call sites. If @not (BS.null ys')@ then the @BS.dropWhile + -- isDecimal@ is a noop; but there's no reason to branch on + -- testing for that. The @+1@ in @BS.drop (1+scale)@ is for the + -- 'BSU.unsafeTail' in @ys@. + readFractionPart p whole xs = + let ys = BS.take p (BSU.unsafeTail xs) in + case I.readDecimal ys of + Nothing -> justPair (DF whole 0) xs + Just (part, ys') -> + let scale = BS.length ys - BS.length ys' + in justPair (fractionDF whole scale part) + (BS.dropWhile isDecimal (BS.drop (1+scale) xs)) + + +-- | A variant of 'readExponential' which only reads up to some limited +-- precision. The first argument gives the number of decimal digits +-- at which to limit the precision. See 'readDecimalLimited' for +-- more discussion of the performance benefits of using this function. +readExponentialLimited :: (Fractional a) => Int -> ByteString -> Maybe (a, ByteString) +{-# SPECIALIZE readExponentialLimited :: + Int -> ByteString -> Maybe (Float, ByteString), + Int -> ByteString -> Maybe (Double, ByteString), + Int -> ByteString -> Maybe (Rational, ByteString) #-} +readExponentialLimited = start + where + start p xs = + case readDecimalLimited_ p xs of + Nothing -> Nothing + Just (df,xs') -> Just $! readExponentPart df xs' + + readExponentPart df xs + | BS.null xs = pair (fromDF df) BS.empty + | isNotE (BSU.unsafeHead xs) = pair (fromDF df) xs + | otherwise = + -- HACK: monomorphizing at 'Int' + -- TODO: how to handle too-large exponents? + case readSigned I.readDecimal (BSU.unsafeTail xs) of + Nothing -> pair (fromDF df) xs + Just (scale, xs') -> pair (fromDF $ scaleDF df scale) xs' + +---------------------------------------------------------------- +----------------------------------------------------------- fin. diff --git a/src/Data/ByteString/Lex/Integral.hs b/src/Data/ByteString/Lex/Integral.hs --- a/src/Data/ByteString/Lex/Integral.hs +++ b/src/Data/ByteString/Lex/Integral.hs @@ -4,7 +4,7 @@ -- | -- Module : Data.ByteString.Lex.Integral -- Copyright : Copyright (c) 2010--2015 wren gayle romano --- License : BSD3 +-- License : BSD2 -- Maintainer : wren@community.haskell.org -- Stability : provisional -- Portability : Haskell98 @@ -12,6 +12,8 @@ -- Functions for parsing and producing 'Integral' values from\/to -- 'ByteString's based on the \"Char8\" encoding. That is, we assume -- an ASCII-compatible encoding of alphanumeric characters. +-- +-- /Since: 0.3.0/ ---------------------------------------------------------------- module Data.ByteString.Lex.Integral ( @@ -44,6 +46,7 @@ import Foreign.Ptr (Ptr, plusPtr) import qualified Foreign.ForeignPtr as FFI (withForeignPtr) import Foreign.Storable (peek, poke) +import Data.ByteString.Lex.Internal ---------------------------------------------------------------- ----- General @@ -54,7 +57,7 @@ -- provide both signed and unsigned versions of the -- {read,pack}{Decimal,Octal,Hex} functions... - +-- TODO: move to somewhere more general, shared by both Integral and Fractional -- | Adjust a reading function to recognize an optional leading -- sign. As with the other functions, we assume an ASCII-compatible -- encoding of the sign characters. @@ -113,7 +116,7 @@ -- call 'fromIntegral' to perform the conversion at the end. However, -- doing this will make your code succeptible to overflow bugs if -- the target type is larger than @Int@. -readDecimal :: Integral a => ByteString -> Maybe (a, ByteString) +readDecimal :: (Integral a) => ByteString -> Maybe (a, ByteString) {-# SPECIALIZE readDecimal :: ByteString -> Maybe (Int, ByteString), ByteString -> Maybe (Int8, ByteString), @@ -132,7 +135,7 @@ {-# INLINE isDecimal #-} isDecimal w = 0x39 >= w && w >= 0x30 - toDigit :: Integral a => Word8 -> a + toDigit :: (Integral a) => Word8 -> a {-# INLINE toDigit #-} toDigit w = fromIntegral (w - 0x30) @@ -141,7 +144,7 @@ addDigit n w = n * 10 + toDigit w -- TODO: should we explicitly drop all leading zeros before we jump into the unrolled loop? - start :: Integral a => ByteString -> Maybe (a, ByteString) + start :: (Integral a) => ByteString -> Maybe (a, ByteString) start xs | BS.null xs = Nothing | otherwise = @@ -149,7 +152,7 @@ w | isDecimal w -> Just $ loop0 (toDigit w) (BSU.unsafeTail xs) | otherwise -> Nothing - loop0 :: Integral a => a -> ByteString -> (a, ByteString) + loop0 :: (Integral a) => a -> ByteString -> (a, ByteString) loop0 m xs | m `seq` xs `seq` False = undefined | BS.null xs = (m, BS.empty) @@ -159,7 +162,7 @@ | otherwise -> (m, xs) loop1, loop2, loop3, loop4, loop5, loop6, loop7, loop8 - :: Integral a => a -> Int -> ByteString -> (a, ByteString) + :: (Integral a) => a -> Int -> ByteString -> (a, ByteString) loop1 m n xs | m `seq` n `seq` xs `seq` False = undefined | BS.null xs = (m*10 + fromIntegral n, BS.empty) @@ -225,7 +228,9 @@ -- the string, and returns @0@ instead of @Nothing@. This is twice -- as fast for 'Int64' on 32-bit systems, but has identical performance -- to 'readDecimal' for all other types and architectures. -readDecimal_ :: Integral a => ByteString -> a +-- +-- /Since: 0.4.0/ +readDecimal_ :: (Integral a) => ByteString -> a {-# SPECIALIZE readDecimal_ :: ByteString -> Int, ByteString -> Int8, @@ -244,7 +249,7 @@ {-# INLINE isDecimal #-} isDecimal w = 0x39 >= w && w >= 0x30 - toDigit :: Integral a => Word8 -> a + toDigit :: (Integral a) => Word8 -> a {-# INLINE toDigit #-} toDigit w = fromIntegral (w - 0x30) @@ -259,7 +264,7 @@ w | isDecimal w -> loop0 (toDigit w) (BSU.unsafeTail xs) | otherwise -> 0 - loop0 :: Integral a => a -> ByteString -> a + loop0 :: (Integral a) => a -> ByteString -> a loop0 m xs | m `seq` xs `seq` False = undefined | BS.null xs = m @@ -269,7 +274,7 @@ | otherwise -> m loop1, loop2, loop3, loop4, loop5, loop6, loop7, loop8 - :: Integral a => a -> Int -> ByteString -> a + :: (Integral a) => a -> Int -> ByteString -> a loop1 m n xs | m `seq` n `seq` xs `seq` False = undefined | BS.null xs = m*10 + fromIntegral n @@ -697,127 +702,6 @@ _asOctal_overflow = "asOctal: cannot create buffer larger than (maxBound::Int)" -- -} - ----------------------------------------------------------------- ----------------------------------------------------------------- ------ Integral logarithms - --- TODO: cf. integer-gmp:GHC.Integer.Logarithms made available in version 0.3.0.0 (ships with GHC 7.2.1). --- - - --- This implementation is derived from --- --- modified to use 'quot' instead of 'div', to ensure strictness, --- and using more guard notation (but this last one's compiled --- away). See @./test/bench/BenchNumDigits.hs@ for other implementation --- choices. --- --- | @numDigits b n@ computes the number of base-@b@ digits required --- to represent the number @n@. N.B., this implementation is unsafe --- and will throw errors if the base is @(<= 1)@, or if the number --- is negative. If the base happens to be a power of 2, then see --- 'numTwoPowerDigits' for a more efficient implementation. --- --- We must be careful about the input types here. When using small --- unsigned types or very large values, the repeated squaring can --- overflow causing the function to loop. (E.g., the fourth squaring --- of 10 overflows 32-bits (==1874919424) which is greater than the --- third squaring. For 64-bit, the 5th squaring overflows, but it's --- negative so will be caught.) Forcing the type to Integer ensures --- correct behavior, but makes it substantially slower. - -numDigits :: Integer -> Integer -> Int -{-# INLINE numDigits #-} -numDigits b0 n0 - | b0 <= 1 = error (_numDigits ++ _nonpositiveBase) - | n0 < 0 = error (_numDigits ++ _negativeNumber) - -- BUG: need to check n0 to be sure we won't overflow Int - | otherwise = 1 + fst (ilog b0 n0) - where - ilog b n - | n < b = (0, n) - | r < b = ((,) $! 2*e) r - | otherwise = ((,) $! 2*e+1) $! (r `quot` b) - where - (e, r) = ilog (b*b) n - - --- | Compute the number of base-@2^p@ digits required to represent a --- number @n@. N.B., this implementation is unsafe and will throw --- errors if the base power is non-positive, or if the number is --- negative. For bases which are not a power of 2, see 'numDigits' --- for a more general implementation. -numTwoPowerDigits :: (Integral a, Bits a) => Int -> a -> Int -{-# INLINE numTwoPowerDigits #-} -numTwoPowerDigits p n0 - | p <= 0 = error (_numTwoPowerDigits ++ _nonpositiveBase) - | n0 < 0 = error (_numTwoPowerDigits ++ _negativeNumber) - | n0 == 0 = 1 - -- BUG: need to check n0 to be sure we won't overflow Int - | otherwise = go 0 n0 - where - go d n - | d `seq` n `seq` False = undefined - | n > 0 = go (d+1) (n `shiftR` p) - | otherwise = d - - --- This implementation is from: --- --- --- | Compute the number of base-@10@ digits required to represent --- a number @n@. N.B., this implementation is unsafe and will throw --- errors if the number is negative. -numDecimalDigits :: (Integral a) => a -> Int -{-# INLINE numDecimalDigits #-} -numDecimalDigits n0 - | n0 < 0 = error (_numDecimalDigits ++ _negativeNumber) - -- Unfortunately this causes significant (1.2x) slowdown since - -- GHC can't see it will always fail for types other than Integer... - | n0 > limit = numDigits 10 (toInteger n0) - | otherwise = go 1 (fromIntegral n0 :: Word64) - where - limit = fromIntegral (maxBound :: Word64) - - fin n bound = if n >= bound then 1 else 0 - go k n - | k `seq` False = undefined -- For strictness analysis - | n < 10 = k - | n < 100 = k + 1 - | n < 1000 = k + 2 - | n < 1000000000000 = - k + if n < 100000000 - then if n < 1000000 - then if n < 10000 - then 3 - else 4 + fin n 100000 - else 6 + fin n 10000000 - else if n < 10000000000 - then 8 + fin n 1000000000 - else 10 + fin n 100000000000 - | otherwise = go (k + 12) (n `quot` 1000000000000) - - -_numDigits :: String -_numDigits = "numDigits" -{-# NOINLINE _numDigits #-} - -_numTwoPowerDigits :: String -_numTwoPowerDigits = "numTwoPowerDigits" -{-# NOINLINE _numTwoPowerDigits #-} - -_numDecimalDigits :: String -_numDecimalDigits = "numDecimalDigits" -{-# NOINLINE _numDecimalDigits #-} - -_nonpositiveBase :: String -_nonpositiveBase = ": base must be greater than one" -{-# NOINLINE _nonpositiveBase #-} - -_negativeNumber :: String -_negativeNumber = ": number must be non-negative" -{-# NOINLINE _negativeNumber #-} ---------------------------------------------------------------- ----------------------------------------------------------- fin. diff --git a/src/Data/ByteString/Lex/Internal.hs b/src/Data/ByteString/Lex/Internal.hs --- a/src/Data/ByteString/Lex/Internal.hs +++ b/src/Data/ByteString/Lex/Internal.hs @@ -1,34 +1,147 @@ {-# OPTIONS_GHC -Wall -fwarn-tabs #-} -{-# LANGUAGE ForeignFunctionInterface #-} ---------------------------------------------------------------- --- 2012.01.25 +-- 2015.06.05 -- | -- Module : Data.ByteString.Lex.Internal --- Copyright : Copyright (c) 2008--2011 Don Stewart. --- License : BSD2/MIT +-- Copyright : Copyright (c) 2010--2015 wren gayle romano +-- License : BSD2 -- Maintainer : wren@community.haskell.org --- Stability : stable --- Portability : Haskell98 + FFI +-- Stability : provisional +-- Portability : Haskell98 -- --- Efficiently parse floating point literals from a 'ByteString'. +-- Some functions we want to share across the other modules without actually exposing them to the user. ---------------------------------------------------------------- +module Data.ByteString.Lex.Internal + ( + -- * Integral logarithms + numDigits + , numTwoPowerDigits + , numDecimalDigits + ) where -module Data.ByteString.Lex.Internal (strtod, c_strtod) where +import Data.Word (Word64) +import Data.Bits (Bits(shiftR)) -import qualified Data.ByteString.Internal as BSI (inlinePerformIO) -import qualified Data.ByteString as BS -import Foreign.C.String (CString) -import Foreign.Ptr (Ptr, nullPtr) ---------------------------------------------------------------- +---------------------------------------------------------------- +----- Integral logarithms --- | Safe, minimal copy of substring identified by Alex. -strtod :: BS.ByteString -> Double -{-# INLINE strtod #-} -strtod b = - BSI.inlinePerformIO . BS.useAsCString b $ \ptr -> c_strtod ptr nullPtr +-- TODO: cf. integer-gmp:GHC.Integer.Logarithms made available in version 0.3.0.0 (ships with GHC 7.2.1). +-- -foreign import ccall unsafe "stdlib.h strtod" - c_strtod :: CString -> Ptr CString -> IO Double + +-- This implementation is derived from +-- +-- modified to use 'quot' instead of 'div', to ensure strictness, +-- and using more guard notation (but this last one's compiled +-- away). See @./test/bench/BenchNumDigits.hs@ for other implementation +-- choices. +-- +-- | @numDigits b n@ computes the number of base-@b@ digits required +-- to represent the number @n@. N.B., this implementation is unsafe +-- and will throw errors if the base is @(<= 1)@, or if the number +-- is negative. If the base happens to be a power of 2, then see +-- 'numTwoPowerDigits' for a more efficient implementation. +-- +-- We must be careful about the input types here. When using small +-- unsigned types or very large values, the repeated squaring can +-- overflow causing the function to loop. (E.g., the fourth squaring +-- of 10 overflows 32-bits (==1874919424) which is greater than the +-- third squaring. For 64-bit, the 5th squaring overflows, but it's +-- negative so will be caught.) Forcing the type to Integer ensures +-- correct behavior, but makes it substantially slower. + +numDigits :: Integer -> Integer -> Int +{-# INLINE numDigits #-} +numDigits b0 n0 + | b0 <= 1 = error (_numDigits ++ _nonpositiveBase) + | n0 < 0 = error (_numDigits ++ _negativeNumber) + -- BUG: need to check n0 to be sure we won't overflow Int + | otherwise = 1 + fst (ilog b0 n0) + where + ilog b n + | n < b = (0, n) + | r < b = ((,) $! 2*e) r + | otherwise = ((,) $! 2*e+1) $! (r `quot` b) + where + (e, r) = ilog (b*b) n + + +-- | Compute the number of base-@2^p@ digits required to represent a +-- number @n@. N.B., this implementation is unsafe and will throw +-- errors if the base power is non-positive, or if the number is +-- negative. For bases which are not a power of 2, see 'numDigits' +-- for a more general implementation. +numTwoPowerDigits :: (Integral a, Bits a) => Int -> a -> Int +{-# INLINE numTwoPowerDigits #-} +numTwoPowerDigits p n0 + | p <= 0 = error (_numTwoPowerDigits ++ _nonpositiveBase) + | n0 < 0 = error (_numTwoPowerDigits ++ _negativeNumber) + | n0 == 0 = 1 + -- BUG: need to check n0 to be sure we won't overflow Int + | otherwise = go 0 n0 + where + go d n + | d `seq` n `seq` False = undefined + | n > 0 = go (d+1) (n `shiftR` p) + | otherwise = d + + +-- This implementation is from: +-- +-- +-- | Compute the number of base-@10@ digits required to represent +-- a number @n@. N.B., this implementation is unsafe and will throw +-- errors if the number is negative. +numDecimalDigits :: (Integral a) => a -> Int +{-# INLINE numDecimalDigits #-} +numDecimalDigits n0 + | n0 < 0 = error (_numDecimalDigits ++ _negativeNumber) + -- Unfortunately this causes significant (1.2x) slowdown since + -- GHC can't see it will always fail for types other than Integer... + | n0 > limit = numDigits 10 (toInteger n0) + | otherwise = go 1 (fromIntegral n0 :: Word64) + where + limit = fromIntegral (maxBound :: Word64) + + fin n bound = if n >= bound then 1 else 0 + go k n + | k `seq` False = undefined -- For strictness analysis + | n < 10 = k + | n < 100 = k + 1 + | n < 1000 = k + 2 + | n < 1000000000000 = + k + if n < 100000000 + then if n < 1000000 + then if n < 10000 + then 3 + else 4 + fin n 100000 + else 6 + fin n 10000000 + else if n < 10000000000 + then 8 + fin n 1000000000 + else 10 + fin n 100000000000 + | otherwise = go (k + 12) (n `quot` 1000000000000) + + +_numDigits :: String +_numDigits = "numDigits" +{-# NOINLINE _numDigits #-} + +_numTwoPowerDigits :: String +_numTwoPowerDigits = "numTwoPowerDigits" +{-# NOINLINE _numTwoPowerDigits #-} + +_numDecimalDigits :: String +_numDecimalDigits = "numDecimalDigits" +{-# NOINLINE _numDecimalDigits #-} + +_nonpositiveBase :: String +_nonpositiveBase = ": base must be greater than one" +{-# NOINLINE _nonpositiveBase #-} + +_negativeNumber :: String +_negativeNumber = ": number must be non-negative" +{-# NOINLINE _negativeNumber #-} ---------------------------------------------------------------- ----------------------------------------------------------- fin. diff --git a/src/Data/ByteString/Lex/Lazy/Double.x b/src/Data/ByteString/Lex/Lazy/Double.x deleted file mode 100644 --- a/src/Data/ByteString/Lex/Lazy/Double.x +++ /dev/null @@ -1,91 +0,0 @@ -{ --- Turn off some common warnings about Alex-generated code. --- {-# OPTIONS_GHC -Wall -fno-warn-tabs -fno-warn-missing-signatures #-} ----------------------------------------------------------------- --- 2012.01.25 --- | --- Module : Data.ByteString.Lex.Lazy.Double --- Copyright : Copyright (c) 2008--2011 Don Stewart --- License : BSD2/MIT --- Maintainer : wren@community.haskell.org --- Stability : stable --- Portability : Haskell98 --- --- Efficiently parse floating point literals from a 'ByteString'. ----------------------------------------------------------------- - -module Data.ByteString.Lex.Lazy.Double (readDouble) where - -import qualified Data.ByteString.Lazy as LB -import qualified Data.ByteString as SB -import Data.ByteString.Lex.Internal (strtod) ----------------------------------------------------------------- -} - -%wrapper "basic-bytestring" - -$space = [\ \t\xa0] -$digit = 0-9 -$octit = 0-7 -$hexit = [$digit A-F a-f] - -@sign = [\-\+] -@decimal = $digit+ -@octal = $octit+ -@hexadecimal = $hexit+ -@exponent = [eE] [\-\+]? @decimal - -@number = @decimal - | @decimal \. @decimal @exponent? - | @decimal @exponent - | 0[oO] @octal - | 0[xX] @hexadecimal - -lex :- - -@sign? @number { strtod . strict } - -{ - --- | Parse the initial portion of the ByteString as a Double precision --- floating point value. The expected form of the numeric literal --- is given by: --- --- * An optional '+' or '-' sign --- --- * Decimal digits, OR --- --- * 0 [oO] and a sequence of octal digits, OR --- --- * 0 [xX] and a sequence of hexadecimal digits, OR --- --- * An optional decimal point, followed by a sequence of decimal digits, --- --- * And an optional exponent --- --- The result is returned as a pair of a double-precision floating --- point value and the remaining input, or @Nothing@ should no parse --- be found. --- --- For example, to sum a file of floating point numbers, one per line, --- --- > import qualified Data.ByteString.Char8 as S --- > import qualified Data.ByteString.Unsafe as S --- > import Data.ByteString.Lex.Double --- > --- > main = print . go 0 =<< S.getContents --- > where --- > go n s = case readDouble s of --- > Nothing -> n --- > Just (k,rest) -> go (n+k) (S.tail rest) --- -readDouble :: LB.ByteString -> Maybe (Double, LB.ByteString) -readDouble str = case alexScan ('\n', str) 0 of - AlexEOF -> Nothing - AlexError _ -> Nothing - AlexToken (_, rest) n _ -> - case strtod . strict . LB.take (fromIntegral n) $ str of - d -> Just $! (d , rest) - -strict = SB.concat . LB.toChunks -}