Commits

wren romano committed b7e5b7d Merge

Merged with upstream

Comments (0)

Files changed (5)

Data/Attoparsec.hs

 --   monad transformer.
 --
 -- * Attoparsec is specialised to deal only with strict 'B.ByteString'
---   input.  Efficiency concernts rule out both lists and lazy
+--   input.  Efficiency concerns rule out both lists and lazy
 --   bytestrings.  The usual use for lazy bytestrings would be to
 --   allow consumption of very large input without a large footprint.
 --   For this need, Attoparsec's incremental input provides an

Data/Attoparsec/Char8.hs

-{-# LANGUAGE FlexibleInstances #-}
+{-# LANGUAGE BangPatterns, FlexibleInstances #-}
 {-# OPTIONS_GHC -fno-warn-orphans #-}
 
 -- |
 import Data.Attoparsec.Number (Number(..))
 import Data.Bits (Bits, (.|.), shiftL)
 import Data.ByteString.Internal (c2w, w2c)
+import Data.Int (Int8, Int16, Int32, Int64)
 import Data.Ratio ((%))
 import Data.String (IsString(..))
-import Data.Word (Word8)
+import Data.Word (Word8, Word16, Word32, Word64, Word)
 import Prelude hiding (takeWhile)
 import qualified Data.Attoparsec as A
 import qualified Data.Attoparsec.Internal as I
 --
 -- This parser does not accept a leading @\"0x\"@ string.
 hexadecimal :: (Integral a, Bits a) => Parser a
-{-# SPECIALISE hexadecimal :: Parser Int #-}
 hexadecimal = B8.foldl' step 0 `fmap` I.takeWhile1 isHexDigit
   where
     isHexDigit w = (w >= 48 && w <= 57) ||
     step a w | w >= 48 && w <= 57  = (a `shiftL` 4) .|. fromIntegral (w - 48)
              | w >= 97             = (a `shiftL` 4) .|. fromIntegral (w - 87)
              | otherwise           = (a `shiftL` 4) .|. fromIntegral (w - 55)
+{-# SPECIALISE hexadecimal :: Parser Int #-}
+{-# SPECIALISE hexadecimal :: Parser Int8 #-}
+{-# SPECIALISE hexadecimal :: Parser Int16 #-}
+{-# SPECIALISE hexadecimal :: Parser Int32 #-}
+{-# SPECIALISE hexadecimal :: Parser Int64 #-}
+{-# SPECIALISE hexadecimal :: Parser Integer #-}
+{-# SPECIALISE hexadecimal :: Parser Word #-}
+{-# SPECIALISE hexadecimal :: Parser Word8 #-}
+{-# SPECIALISE hexadecimal :: Parser Word16 #-}
+{-# SPECIALISE hexadecimal :: Parser Word32 #-}
+{-# SPECIALISE hexadecimal :: Parser Word64 #-}
 
 -- | Parse and decode an unsigned decimal number.
 decimal :: Integral a => Parser a
-{-# SPECIALISE decimal :: Parser Int #-}
-{-# SPECIALISE decimal :: Parser Integer #-}
 decimal = B8.foldl' step 0 `fmap` I.takeWhile1 isDig
   where isDig w  = w >= 48 && w <= 57
         step a w = a * 10 + fromIntegral (w - 48)
+{-# SPECIALISE decimal :: Parser Int #-}
+{-# SPECIALISE decimal :: Parser Int8 #-}
+{-# SPECIALISE decimal :: Parser Int16 #-}
+{-# SPECIALISE decimal :: Parser Int32 #-}
+{-# SPECIALISE decimal :: Parser Int64 #-}
+{-# SPECIALISE decimal :: Parser Integer #-}
+{-# SPECIALISE decimal :: Parser Word #-}
+{-# SPECIALISE decimal :: Parser Word8 #-}
+{-# SPECIALISE decimal :: Parser Word16 #-}
+{-# SPECIALISE decimal :: Parser Word32 #-}
+{-# SPECIALISE decimal :: Parser Word64 #-}
 
 -- | Parse a number with an optional leading @\'+\'@ or @\'-\'@ sign
 -- character.
 signed :: Num a => Parser a -> Parser a
 {-# SPECIALISE signed :: Parser Int -> Parser Int #-}
+{-# SPECIALISE signed :: Parser Int8 -> Parser Int8 #-}
+{-# SPECIALISE signed :: Parser Int16 -> Parser Int16 #-}
+{-# SPECIALISE signed :: Parser Int32 -> Parser Int32 #-}
+{-# SPECIALISE signed :: Parser Int64 -> Parser Int64 #-}
+{-# SPECIALISE signed :: Parser Integer -> Parser Integer #-}
 signed p = (negate <$> (char8 '-' *> p))
        <|> (char8 '+' *> p)
        <|> p
 
-data T = T !Integer !Int
-
 -- | Parse a rational number.
 --
 -- This parser accepts an optional leading sign character, followed by
 -- >rational "3e"    == Done 3.0 "e"
 rational :: Fractional a => Parser a
 {-# SPECIALIZE rational :: Parser Double #-}
+{-# SPECIALIZE rational :: Parser Float #-}
+{-# SPECIALIZE rational :: Parser Rational #-}
 rational = floaty $ \real frac fracDenom -> fromRational $
                      real % 1 + frac % fracDenom
 
          else D (asDouble real frac fracDenom)
 {-# INLINE number #-}
 
+data T = T !Integer !Int
+
 floaty :: Fractional a => (Integer -> Integer -> Integer -> a) -> Parser a
 {-# INLINE floaty #-}
 floaty f = do
   let minus = 45
       plus  = 43
-  sign <- I.satisfy (\c -> c == minus || c == plus) <|> return plus
+  !positive <- ((== plus) <$> I.satisfy (\c -> c == minus || c == plus)) <|>
+               return True
   real <- decimal
   let tryFraction = do
         let dot = 46
         _ <- I.satisfy (==dot)
         ds <- I.takeWhile isDigit_w8
-        case (case I.parse decimal ds of
-                I.Partial k -> k B.empty
-                r           -> r) of
-          I.Done _ n -> return $ T n (B.length ds)
-          _          -> fail "no digits after decimal"
+        case I.parseOnly decimal ds of
+                Right n -> return $ T n (B.length ds)
+                _       -> fail "no digits after decimal"
   T fraction fracDigits <- tryFraction <|> return (T 0 0)
   let littleE = 101
       bigE    = 69
           else if power == 0
                then f real fraction (10 ^ fracDigits)
                else f real fraction (10 ^ fracDigits) * (10 ^^ power)
-  return $ if sign == plus
+  return $ if positive
            then n
            else -n
-  

Data/Attoparsec/Internal.hs

     ) where
 
 import Control.Applicative (Alternative(..), Applicative(..), (<$>))
+import Control.DeepSeq (NFData(rnf))
 import Control.Monad (MonadPlus(..), when)
 import Data.Attoparsec.Combinator
 import Data.Attoparsec.FastSet (charClass, memberWord8)
 import Data.Monoid (Monoid(..))
 import Data.Word (Word8)
 import Foreign.ForeignPtr (withForeignPtr)
-import Foreign.Ptr (castPtr, plusPtr)
-import Foreign.Storable (Storable(peek, sizeOf), peekByteOff)
+import Foreign.Ptr (castPtr, minusPtr, plusPtr)
+import Foreign.Storable (Storable(peek, sizeOf))
 import Prelude hiding (getChar, take, takeWhile)
 import System.IO.Unsafe (unsafePerformIO)
 import qualified Data.ByteString as B8
     show (Partial _)       = "Partial _"
     show (Done bs r)       = "Done " ++ show bs ++ " " ++ show r
 
+instance (NFData r) => NFData (Result r) where
+    rnf (Fail _ _ _) = ()
+    rnf (Partial _)  = ()
+    rnf (Done _ r)   = rnf r
+    {-# INLINE rnf #-}
+
 fmapR :: (a -> b) -> Result a -> Result b
 fmapR _ (Fail st stk msg) = Fail st stk msg
 fmapR f (Partial k)       = Partial (fmapR f . k)
 takeWith :: Int -> (B.ByteString -> Bool) -> Parser B.ByteString
 takeWith n p = do
   s <- ensure n
-  let (h,t) = B.splitAt n s
+  let h = B.unsafeTake n s
+      t = B.unsafeDrop n s
   if p h
     then put t >> return h
     else failDesc "takeWith"
 takeLazyByteString :: Parser L.ByteString
 takeLazyByteString = L.fromChunks `fmap` takeRest
 
+data T s = T {-# UNPACK #-} !Int s
+
 -- | A stateful scanner.  The predicate consumes and transforms a
 -- state argument, and each transformed state is passed to successive
 -- invocations of the predicate on each byte of the input until one
  where
   go acc s1 = do
     let scanner (B.PS fp off len) =
-          withForeignPtr fp $ \ptr -> do
-            let inner !i !s | i == off+len = done (i-off) s
-                            | otherwise = do
-                                        w <- peekByteOff ptr i
-                                        case p s w of
-                                          Just s' -> inner (i+1) s'
-                                          Nothing -> done (i-off) s
-                done !i !s = return (B.PS fp off i, B.PS fp (off+i) (len-i),s)
-            inner off s1
-    (h,t,s') <- (unsafePerformIO . scanner) <$> get
+          withForeignPtr fp $ \ptr0 -> do
+            let start = ptr0 `plusPtr` off
+                end   = start `plusPtr` len
+                inner ptr !s
+                  | ptr < end = do
+                    w <- peek ptr
+                    case p s w of
+                      Just s' -> inner (ptr `plusPtr` 1) s'
+                      _       -> done (ptr `minusPtr` start) s
+                  | otherwise = done (ptr `minusPtr` start) s
+                done !i !s = return (T i s)
+            inner start s1
+    bs <- get
+    let T i s' = unsafePerformIO $ scanner bs
+        h = B.unsafeTake i bs
+        t = B.unsafeDrop i bs
     put t
     if B.null t
       then do

Data/Attoparsec/Number.hs

       Number(..)
     ) where
 
+import Control.DeepSeq (NFData(rnf))
 import Data.Data (Data)
 import Data.Function (on)
 import Data.Typeable (Typeable)
     show (I a) = show a
     show (D a) = show a
 
+instance NFData Number where
+    rnf (I _) = ()
+    rnf (D _) = ()
+    {-# INLINE rnf #-}
+
 binop :: (Integer -> Integer -> a) -> (Double -> Double -> a)
       -> Number -> Number -> a
 binop _ d (D a) (D b) = d a b
   else
     build-depends: base < 2.0
 
+  build-depends: deepseq
+
   extensions:      CPP
   exposed-modules: Data.Attoparsec
                    Data.Attoparsec.Char8