Commits

Bryan O'Sullivan committed 2d95f56

Use MonadPlus and liftM2' for strict combinators

  • Participants
  • Parent commits 991ca29

Comments (0)

Files changed (1)

Data/Attoparsec/Combinator.hs

 
 import Control.Applicative (Alternative(..), Applicative(..), empty, liftA2,
                             (<|>), (*>), (<$>))
+import Control.Monad (MonadPlus(..))
 #if !MIN_VERSION_base(4,2,0)
 import Control.Applicative (many)
 #endif
 {-# SPECIALIZE option :: a -> Z.Parser a -> Z.Parser a #-}
 #endif
 
+-- | A version of 'liftM2' that is strict in the result of its first
+-- action.
+liftM2' :: (Monad m) => (a -> b -> c) -> m a -> m b -> m c
+liftM2' f a b = do
+  !x <- a
+  y <- b
+  return (f x y)
+{-# INLINE liftM2' #-}
+
 -- | @many' p@ applies the action @p@ /zero/ or more times. Returns a
 -- list of the returned values of @p@. The value returned by @p@ is
 -- forced to WHNF.
 --
 -- >  word  = many' letter
-many' :: (Alternative f, Monad f) => f a -> f [a]
+many' :: (MonadPlus m) => m a -> m [a]
 many' p = many_p
-  where many_p = some_p <|> pure []
-        some_p = do
-            !a <- p
-            as <- many_p
-            return (a : as)
+  where many_p = some_p `mplus` return []
+        some_p = liftM2' (:) p many_p
 {-# INLINE many' #-}
 
 -- | @many1 p@ applies the action @p@ /one/ or more times. Returns a
 -- forced to WHNF.
 --
 -- >  word  = many1' letter
-many1' :: (Alternative f, Monad f) => f a -> f [a]
-many1' p = do
-    !a <- p
-    as <- many' p
-    return (a : as)
+many1' :: (MonadPlus m) => m a -> m [a]
+many1' p = liftM2' (:) p (many' p)
 {-# INLINE many1' #-}
 
 -- | @sepBy p sep@ applies /zero/ or more occurrences of @p@, separated
 -- returned by @p@ is forced to WHNF.
 --
 -- > commaSep p  = p `sepBy'` (symbol ",")
-sepBy' :: (Alternative f, Monad f) => f a -> f s -> f [a]
-sepBy' p s = scan <|> pure []
-  where
-    scan = do
-        !a <- p
-        as <- (s *> sepBy1' p s) <|> pure []
-        return (a : as)
+sepBy' :: (MonadPlus m) => m a -> m s -> m [a]
+sepBy' p s = scan `mplus` return []
+  where scan = liftM2' (:) p ((s >> sepBy1' p s) `mplus` return [])
 #if __GLASGOW_HASKELL__ >= 700
 {-# SPECIALIZE sepBy' :: Parser ByteString a -> Parser ByteString s
                       -> Parser ByteString [a] #-}
 -- returned by @p@ is forced to WHNF.
 --
 -- > commaSep p  = p `sepBy1'` (symbol ",")
-sepBy1' :: (Alternative f, Monad f) => f a -> f s -> f [a]
+sepBy1' :: (MonadPlus m) => m a -> m s -> m [a]
 sepBy1' p s = scan
-    where scan = do !a <- p
-                    as <- (s *> scan) <|> pure []
-                    return (a : as)
+    where scan = liftM2' (:) p ((s >> scan) `mplus` return [])
 #if __GLASGOW_HASKELL__ >= 700
 {-# SPECIALIZE sepBy1' :: Parser ByteString a -> Parser ByteString s
                        -> Parser ByteString [a] #-}
 -- Note the overlapping parsers @anyChar@ and @string \"<!--\"@, and
 -- therefore the use of the 'try' combinator. The value returned by @p@
 -- is forced to WHNF.
-manyTill' :: (Alternative f, Monad f) => f a -> f b -> f [a]
+manyTill' :: (MonadPlus m) => m a -> m b -> m [a]
 manyTill' p end = scan
-    where scan = (end *> pure []) <|> scan'
-          scan' = do
-              !a <- p
-              as <- scan
-              return (a : as)
+    where scan = (end >> return []) `mplus` liftM2' (:) p scan
 #if __GLASGOW_HASKELL__ >= 700
 {-# SPECIALIZE manyTill' :: Parser ByteString a -> Parser ByteString b
                          -> Parser ByteString [a] #-}