import Control.Monad.State.Strict
import qualified Data.ByteString.Lazy as Lazy (ByteString)
import qualified Data.ByteString.Lazy.Char8 as B hiding (ByteString)
+import qualified Data.Foldable as Fold
+import qualified Data.Sequence as Seq
+import Data.Sequence (Seq, (|>))
-- |@'Parser' a@ is obviously a parser which parses and returns @a@.
newtype Parser a = Parser {
satisfy :: (Char -> Bool) -> Parser Char
-satisfy f = f `seq`
- do c <- anyChar
- if f $! c then
- return c
- else
- failP
+satisfy !f
+ = do c <- anyChar
+ if f c then
+ return c
+ else
+ failP
char :: Char -> Parser Char
-char c = c `seq` satisfy (== c)
+char !c = satisfy (== c)
string :: String -> Parser String
-string str = str `seq`
- do mapM_ char str
- return str
+string !str = str `seq`
+ do mapM_ char str
+ return str
infixr 0 <|>
IllegalInput -> do put saved -- 状態を復歸
runParser g
ReachedEOF -> if pstIsEOFFatal saved then
- return ReachedEOF
+ do put saved
+ return ReachedEOF
else
do put saved
runParser g
notFollowedBy :: Parser a -> Parser ()
-notFollowedBy p
- = p `seq`
- Parser $! do saved <- get -- 状態を保存
+notFollowedBy !p
+ = Parser $! do saved <- get -- 状態を保存
result <- runParser p
case result of
Success _ -> do put saved -- 状態を復歸
failP
-many :: Parser a -> Parser [a]
-many p = p `seq`
- do x <- p
- xs <- many p
- return (x:xs)
- <|>
- return []
+many :: forall a. Parser a -> Parser [a]
+many !p = Parser $!
+ do state <- get
+ let (# result, state' #) = many' state Seq.empty
+ put state'
+ return result
+ where
+ many' :: ParserState -> Seq a -> (# ParserResult [a], ParserState #)
+ many' !st !soFar
+ = case runState (runParser p) st of
+ (Success a, st') -> many' st' (soFar |> a)
+ (IllegalInput, _) -> (# Success (Fold.toList soFar), st #)
+ (ReachedEOF , _) -> if pstIsEOFFatal st then
+ (# ReachedEOF, st #)
+ else
+ (# Success (Fold.toList soFar), st #)
many1 :: Parser a -> Parser [a]
-many1 p = p `seq`
- do x <- p
- xs <- many p
- return (x:xs)
+many1 !p = do x <- p
+ xs <- many p
+ return (x:xs)
count :: Int -> Parser a -> Parser [a]
-count 0 _ = return []
-count n p = n `seq` p `seq`
- do x <- p
- xs <- count (n-1) p
- return (x:xs)
+count !n !p = Parser $! count' n p Seq.empty
+
+-- This implementation is rather ugly but we need to make it
+-- tail-recursive to avoid stack overflow.
+count' :: Int -> Parser a -> Seq a -> State ParserState (ParserResult [a])
+count' 0 _ !soFar = return $! Success $! Fold.toList soFar
+count' !n !p !soFar = do saved <- get
+ result <- runParser p
+ case result of
+ Success a -> count' (n-1) p (soFar |> a)
+ IllegalInput -> do put saved
+ return IllegalInput
+ ReachedEOF -> do put saved
+ return ReachedEOF
+
-- def may be a _|_
option :: a -> Parser a -> Parser a