Bryan O'Sullivan avatar Bryan O'Sullivan committed 7de1ded

Switch from backtracking by default to *not* backtracking.

This saves rather a lot of memory, and improves performance along
the way.

Comments (0)

Files changed (3)

Data/Attoparsec/Internal.hs

 import Data.Attoparsec.Combinator
 import Data.Attoparsec.FastSet (charClass, memberWord8)
 import Data.Attoparsec.Internal.Types
+import Data.Monoid (Monoid(..))
 import Data.Word (Word8)
 import Foreign.ForeignPtr (withForeignPtr)
 import Foreign.Ptr (castPtr, minusPtr, plusPtr)
 prompt i0 a0 _m0 kf ks = Partial $ \s ->
     if B.null s
     then kf i0 a0 Complete
-    else ks (I (unI i0 +++ s)) (A (unA a0 +++ s)) Incomplete
+    else ks (i0 `mappend` I s) (a0 `mappend` Added s) Incomplete
 
 -- | Immediately demand more input via a 'Partial' continuation
 -- result.
         noAdds i0 a0 m0 $ \i1 a1 m1 ->
             let kf' i2 a2 m2 = addS i0 a0 m0 i2 a2 m2 kf
             in runParser p i1 a1 m1 kf' ks
+  where noAdds i0 _a0 m0 f = f i0 mempty m0
+    
+addS :: Input -> Added -> More
+     -> Input -> Added -> More
+     -> (Input -> Added -> More -> r) -> r
+addS i0 a0 m0 _i1 a1 m1 f =
+    let !i = case a1 of
+               Dropped -> i0
+               Added s -> i0 `mappend` I s
+        !a = a0 `mappend` a1
+        !m = m0 `mappend` m1
+    in f i a m
+{-# INLINE addS #-}
 
 -- | The parser @satisfy p@ succeeds for any byte for which the
 -- predicate @p@ returns 'True'. Returns the byte that is actually
 
 -- | Run a parser.
 parse :: Parser a -> B.ByteString -> Result a
-parse m s = runParser m (I s) (A B.empty) Incomplete failK successK
+parse m s = runParser m (I s) mempty Incomplete failK successK
 {-# INLINE parse #-}
 
 -- | Run a parser that cannot be resupplied via a 'Partial' result.
 parseOnly :: Parser a -> B.ByteString -> Either String a
-parseOnly m s = case runParser m (I s) (A B.empty) Complete failK successK of
+parseOnly m s = case runParser m (I s) mempty Complete failK successK of
                   Fail _ _ err -> Left err
                   Done _ a     -> Right a
                   _            -> error "parseOnly: impossible error!"

Data/Attoparsec/Internal/Types.hs

     , Input(..)
     , Added(..)
     , More(..)
-    , addS
-    , noAdds
     , (+++)
     ) where
 
     {-# INLINE fmap #-}
 
 newtype Input = I {unI :: B.ByteString}
-newtype Added = A {unA :: B.ByteString}
+    deriving (Show)
+
+instance Monoid Input where
+    mempty              = I B.empty
+    mappend (I a) (I b) = I (a +++ b)
+
+data Added = Dropped
+           | Added B.ByteString
+             deriving (Show)
+
+instance Monoid Added where
+    mempty                      = Dropped
+    mappend a@Dropped _         = a
+    mappend a         Dropped   = a
+    mappend (Added a) (Added b) = Added (a +++ b)
 
 -- | The 'Parser' type is a monad.
 newtype Parser a = Parser {
 data More = Complete | Incomplete
             deriving (Eq, Show)
 
-addS :: Input -> Added -> More
-     -> Input -> Added -> More
-     -> (Input -> Added -> More -> r) -> r
-addS i0 a0 m0 _i1 a1 m1 f =
-    let !i = I (unI i0 +++ unA a1)
-        a  = A (unA a0 +++ unA a1)
-        !m = m0 <> m1
-    in f i a m
-  where
-    Complete <> _ = Complete
-    _ <> Complete = Complete
-    _ <> _        = Incomplete
-{-# INLINE addS #-}
+instance Monoid More where
+    mempty                    = Incomplete
+    mappend Complete _        = Complete
+    mappend _        Complete = Complete
+    mappend _        _        = Incomplete
 
 bindP :: Parser a -> (a -> Parser b) -> Parser b
 bindP m g =
     (>>=)  = bindP
     fail   = failDesc
 
-noAdds :: Input -> Added -> More
-       -> (Input -> Added -> More -> r) -> r
-noAdds i0 _a0 m0 f = f i0 (A B.empty) m0
-{-# INLINE noAdds #-}
-
 plus :: Parser a -> Parser a -> Parser a
 plus a b = Parser $ \i0 a0 m0 kf ks ->
-           let kf' i1 a1 m1 _ _ = addS i0 a0 m0 i1 a1 m1 $
-                                  \ i2 a2 m2 -> runParser b i2 a2 m2 kf ks
-           in  noAdds i0 a0 m0 $ \i2 a2 m2 -> runParser a i2 a2 m2 kf' ks
+           let kf' i1 a1 m1 _ _ = runParser b i1 a1 m1 kf ks
+           in  runParser a i0 a0 m0 kf' ks
 {-# INLINE plus #-}
 
 instance MonadPlus Parser where
 name:            attoparsec
-version:         0.8.6.1
+version:         0.9.0.0
 license:         BSD3
 license-file:    LICENSE
 category:        Text, Parsing
Tip: Filter by directory path e.g. /media app.js to search for public/media/app.js.
Tip: Use camelCasing e.g. ProjME to search for ProjectModifiedEvent.java.
Tip: Filter by extension type e.g. /repo .js to search for all .js files in the /repo directory.
Tip: Separate your search with spaces e.g. /ssh pom.xml to search for src/ssh/pom.xml.
Tip: Use ↑ and ↓ arrow keys to navigate and return to view the file.
Tip: You can also navigate files with Ctrl+j (next) and Ctrl+k (previous) and view the file with Ctrl+o.
Tip: You can also navigate files with Alt+j (next) and Alt+k (previous) and view the file with Alt+o.