bytestringparser 0.2.1 → 0.2.2

raw patch · 3 files changed

+111/−53 lines, 3 filesPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

API changes (from Hackage documentation)

Files

• bytestringparser.cabal +2/−2
• src/Text/ParserCombinators/ByteStringParser.hs +37/−34
• src/Text/ParserCombinators/ByteStringParser/FastSet.hs +72/−17

@@ -1,5 +1,5 @@ name:            bytestringparser-version:         0.2.1+version:         0.2.2 license:         BSD3 license-file:    LICENSE category:        Text, Parsing@@ -29,4 +29,4 @@   exposed-modules: Text.ParserCombinators.ByteStringParser                    Text.ParserCombinators.ByteStringParser.FastSet   hs-source-dirs:  src-  ghc-options:     -O2 -Wall -Werror+  ghc-options:     -O2 -Wall -Werror -funbox-strict-fields

@@ -24,7 +24,6 @@     , parseTest      -- * Combinators-    , succeed     , (<?>)      -- * Things vaguely like those in @Parsec.Combinator@ (and @Parsec.Prim@)@@ -70,6 +69,7 @@  import Control.Applicative (Alternative(..), Applicative(..), (<$>), (<*), (*>)) import Control.Monad (MonadPlus(..), ap, liftM2)+import Control.Monad.Fix (MonadFix(..)) import qualified Data.ByteString.Char8 as SB import qualified Data.ByteString.Lazy.Char8 as LB import qualified Data.ByteString.Lazy.Internal as LB@@ -80,17 +80,10 @@  type ParseError = String --- * Parser Monad- data S = S {-# UNPACK #-} !SB.ByteString            LB.ByteString            {-# UNPACK #-} !Int64 -mkState :: LB.ByteString -> Int64 -> S-mkState s = case s of-              LB.Empty -> S SB.empty s-              LB.Chunk x xs -> S x xs- newtype Parser a = Parser {       unParser :: S -> Either (LB.ByteString, [String]) (a, S)     }@@ -102,11 +95,6 @@               Right (a, s') -> Right (f a, s')               Left err -> Left err -(+:) :: SB.ByteString -> LB.ByteString -> LB.ByteString-sb +: lb | SB.null sb = lb-         | otherwise = LB.Chunk sb lb-{-# INLINE (+:) #-}- instance Monad Parser where     return a = Parser $ \s -> Right (a, s)     m >>= f = Parser $ \s ->@@ -115,6 +103,13 @@                 Left (s', msgs) -> Left (s', msgs)     fail err = Parser $ \(S sb lb _) -> Left (sb +: lb, [err]) +instance MonadFix Parser where+    mfix f = Parser $ \s ->+             let r = case r of+                       Right (a, _) -> unParser (f a) s+                       err -> err+             in r+ zero :: Parser a zero = Parser $ \(S sb lb _) -> Left (sb +: lb, []) {-# INLINE zero #-}@@ -134,7 +129,6 @@     mzero = zero     mplus = plus -#ifdef APPLICATIVE_IN_BASE instance Applicative Parser where     pure = return     (<*>) = ap@@ -142,12 +136,19 @@ instance Alternative Parser where     empty = zero     (<|>) = plus-#endif --- | Always succeed.-succeed :: a -> Parser a-succeed = return+mkState :: LB.ByteString -> Int64 -> S+mkState s = case s of+              LB.Empty -> S SB.empty s+              LB.Chunk x xs -> S x xs +-- | Turn our chunked representation back into a normal lazy+-- ByteString.+(+:) :: SB.ByteString -> LB.ByteString -> LB.ByteString+sb +: lb | SB.null sb = lb+         | otherwise = LB.Chunk sb lb+{-# INLINE (+:) #-}+ infix 0 <?>  -- | Name the parser.@@ -233,23 +234,23 @@ -- | Satisfy a literal string. string :: LB.ByteString -> Parser LB.ByteString string s = Parser $ \(S sb lb n) ->-               let bs = sb +: lb-                   l = LB.length s-                   (h, t) = LB.splitAt l bs-               in if s == h-                  then Right (s, mkState t (n + l))-                  else Left (bs, [])+           let bs = sb +: lb+               l = LB.length s+               (h, t) = LB.splitAt l bs+           in if s == h+              then Right (s, mkState t (n + l))+              else Left (bs, []) {-# INLINE string #-}  -- | Satisfy a literal string, ignoring case. stringCI :: LB.ByteString -> Parser LB.ByteString stringCI s = Parser $ \(S sb lb n) ->-               let bs = sb +: lb-                   l = LB.length s-                   (h, t) = LB.splitAt l bs-               in if ls == LB.map toLower h-                  then Right (s, mkState t (n + l))-                  else Left (bs, [])+             let bs = sb +: lb+                 l = LB.length s+                 (h, t) = LB.splitAt l bs+             in if ls == LB.map toLower h+                then Right (s, mkState t (n + l))+                else Left (bs, [])     where ls = LB.map toLower s {-# INLINE stringCI #-} @@ -298,7 +299,7 @@ takeWhile1 p = Parser $ \s@(S sb lb n) ->                let (h, t) = SB.span p sb                in if SB.null t-                  then case unParser (nextChunk >> takeWhile p) s of+                  then case unParser (nextChunk *> takeWhile p) s of                          Left err -> Left err                          Right (xs, s') ->                              let bs = h +: xs@@ -367,11 +368,11 @@            Left (e, bs) -> Left (e, bs)  parseAt :: Parser a -> LB.ByteString -> Int64-        -> (LB.ByteString, Either ParseError a)+        -> (LB.ByteString, Either ParseError (a, Int64)) parseAt p bs n =      case unParser p (mkState bs n) of       Left (bs', msg) -> (bs', Left $ showError msg)-      Right (a, S sb lb _) -> (sb +: lb, Right a)+      Right (a, S sb lb n') -> (sb +: lb, Right (a, n'))     where       showError [msg] = "Parser error, expected:\n" ++ msg ++ "\n"       showError msgs = "Parser error, expected one of:\n" ++ unlines msgs@@ -379,7 +380,9 @@ -- | Run a parser. parse :: Parser a -> LB.ByteString       -> (LB.ByteString, Either ParseError a)-parse p bs = parseAt p bs 0+parse p bs = case parseAt p bs 0 of+               (bs', Right (a, _)) -> (bs', Right a)+               (bs', Left err) -> (bs', Left err)  parseTest :: (Show a) => Parser a -> LB.ByteString -> IO () parseTest p s =

@@ -1,3 +1,5 @@+{-# LANGUAGE BangPatterns #-}+ ----------------------------------------------------------------------------- -- | -- Module      :  Text.ParserCombinators.ByteStringParser.FastSet@@ -13,29 +15,82 @@ ----------------------------------------------------------------------------- module Text.ParserCombinators.ByteStringParser.FastSet     (+    -- * Data type       FastSet+    -- * Construction     , set+    -- * Lookup     , member+    , member8+    -- * Debugging+    , fromSet     ) where -import Data.ByteString.Char8 as SB-import Data.ByteString.Internal as SB-import Data.ByteString.Unsafe as SB+import qualified Data.ByteString as B+-- import Data.ByteString.Char8 (pack)+import qualified Data.ByteString.Internal as I+import qualified Data.ByteString.Unsafe as U+import Data.Word (Word8)+import Foreign.Storable (peekByteOff, pokeByteOff) -newtype FastSet = FastSet SB.ByteString-    deriving (Eq, Ord, Show)+data FastSet = Sorted { fromSet :: {-# UNPACK #-} !B.ByteString }+             | Table  { fromSet :: {-# UNPACK #-} !B.ByteString }+    deriving (Eq, Ord) -set :: SB.ByteString -> FastSet-set = FastSet . SB.sort+instance Show FastSet where+    show (Sorted s) = "FastSet " ++ show s+    show (Table t)  = "FastSet " ++ fromTable t +-- | The lower bound on the size of a lookup table.  We choose this to+-- balance table density against performance.+tableCutoff :: Int+tableCutoff = 32++-- | Create a character set.+set :: B.ByteString -> FastSet+set s | B.length s < tableCutoff = Sorted . B.sort $ s+      | otherwise                = Table . mkTable $ s++-- | Check the table for membership. member :: Char -> FastSet -> Bool-member c (FastSet s) = search 0 (SB.length s - 1)-    where w = SB.c2w c-          search lo hi | hi < lo = False-                       | otherwise =-                           let mid = (lo + hi) `div` 2-                               cur = SB.unsafeIndex s mid-                           in case compare cur w of-                                GT -> search lo (mid - 1)-                                LT -> search (mid + 1) hi-                                _ -> True+member c = member8 (I.c2w c)++-- | Check the table for membership.+member8 :: Word8 -> FastSet -> Bool+member8 w (Table t)  = U.unsafeIndex t (fromIntegral w) == entry+member8 w (Sorted s) = search 0 (B.length s - 1)+    where search !lo !hi+              | hi < lo = False+              | otherwise =+                  let mid = (lo + hi) `div` 2+                  in case compare w (U.unsafeIndex s mid) of+                       GT -> search lo (mid - 1)+                       LT -> search (mid + 1) hi+                       _ -> True++-- | The value in a table that indicates that a character is not+-- present.  We avoid NUL to make the table representation printable.+noEntry :: Word8+noEntry = 0x5f++-- | The value in a table that indicates that a character is present.+-- We use a printable character for readability.+entry :: Word8+entry = 0x21++mkTable :: B.ByteString -> B.ByteString+mkTable s = I.unsafeCreate 256 $ \t -> do+            I.memset t noEntry 256+            U.unsafeUseAsCStringLen s $ \(p, l) ->+              let loop n | n == l = return ()+                         | otherwise = do+                    c <- peekByteOff p n :: IO Word8+                    pokeByteOff t (fromIntegral c) entry+                    loop (n + 1)+              in loop 0++-- | Turn the table representation into a string, for debugging.+fromTable :: B.ByteString -> String+fromTable = snd . B.foldr go (0xff, [])+    where go c (!n, cs) | c == noEntry = (n - 1, cs)+                        | otherwise    = (n - 1, I.w2c n:cs)