Bryan O'Sullivan avatar Bryan O'Sullivan committed 0364dfc

Back out 7de1dedc8889, the dread backtrack-ectomy

Comments (0)

Files changed (2)

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 (i0 `mappend` I s) (a0 `mappend` Added s) Incomplete
+    else ks (I (unI i0 +++ s)) (A (unA a0 +++ 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) mempty Incomplete failK successK
+parse m s = runParser m (I s) (A B.empty) 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) mempty Complete failK successK of
+parseOnly m s = case runParser m (I s) (A B.empty) 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}
-    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)
+newtype Added = A {unA :: B.ByteString}
 
 -- | The 'Parser' type is a monad.
 newtype Parser a = Parser {
 data More = Complete | Incomplete
             deriving (Eq, Show)
 
-instance Monoid More where
-    mempty                    = Incomplete
-    mappend Complete _        = Complete
-    mappend _        Complete = Complete
-    mappend _        _        = Incomplete
+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 #-}
 
 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 _ _ = runParser b i1 a1 m1 kf ks
-           in  runParser a 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
 {-# INLINE plus #-}
 
 instance MonadPlus Parser where
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.