mrkkrp/megaparsec
1
1
Fork 0
mirror of https://github.com/mrkkrp/megaparsec.git synced 2024-11-24 12:04:23 +03:00
Code Issues Projects Releases Wiki Activity

move core data type over to CPS

Browse Source
This commit is contained in:
Antoine Latter 2009-03-02 00:20:00 +00:00
parent 200492f57c
commit a98a3ccbca
2 changed files with 196 additions and 194 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

389
Text/Parsec/Prim.hs
View File

@ -46,8 +46,8 @@ sysUnExpectError msg pos = Error (newErrorMessage (SysUnExpect msg) pos)
unexpected :: (Stream s m t) => String -> ParsecT s u m a unexpected :: (Stream s m t) => String -> ParsecT s u m a
unexpected msg unexpected msg
= ParsecT $ \s -> return $ Empty $ return $ = ParsecT $ \s _ _ _ eerr ->
Error (newErrorMessage (UnExpect msg) (statePos s)) eerr $ newErrorMessage (UnExpect msg) (statePos s)
-- | ParserT monad transformer and Parser type -- | ParserT monad transformer and Parser type
@ -56,8 +56,37 @@ unexpected msg
-- If this is undesirable, simply used a data type like @data Box a = Box a@ and -- If this is undesirable, simply used a data type like @data Box a = Box a@ and
-- the state type @Box YourStateType@ to add a level of indirection. -- the state type @Box YourStateType@ to add a level of indirection.
data ParsecT s u m a newtype ParsecT s u m a
= ParsecT { runParsecT :: State s u -> m (Consumed (m (Reply s u a))) } = ParsecT {unParser :: forall b .
State s u
-> (a -> State s u -> ParseError -> m b) -- consumed ok
-> (ParseError -> m b) -- consumed err
-> (a -> State s u -> ParseError -> m b) -- empty ok
-> (ParseError -> m b) -- empty err
-> m b
}
runParsecT :: Monad m => ParsecT s u m a -> State s u -> m (Consumed (m (Reply s u a)))
runParsecT p s = unParser p s cok cerr eok eerr
where cok a s' err = return . Consumed . return $ Ok a s' err
cerr err = return . Consumed . return $ Error err
eok a s' err = return . Empty . return $ Ok a s' err
eerr err = return . Empty . return $ Error err
mkPT :: Monad m => (State s u -> m (Consumed (m (Reply s u a)))) -> ParsecT s u m a
mkPT k = ParsecT $ \s cok cerr eok eerr -> do
cons <- k s
case cons of
Consumed mrep -> do
rep <- mrep
case rep of
Ok x s' err -> cok x s' err
Error err -> cerr err
Empty mrep -> do
rep <- mrep
case rep of
Ok x s' err -> eok x s' err
Error err -> eerr err
type Parsec s u = ParsecT s u Identity type Parsec s u = ParsecT s u Identity
@ -81,22 +110,23 @@ instance Functor (Reply s u) where
fmap f (Ok x s e) = Ok (f x) s e fmap f (Ok x s e) = Ok (f x) s e
fmap _ (Error e) = Error e -- XXX fmap _ (Error e) = Error e -- XXX
instance (Monad m) => Functor (ParsecT s u m) where instance Functor (ParsecT s u m) where
fmap f p = parsecMap f p fmap f p = parsecMap f p
parsecMap :: (Monad m) => (a -> b) -> ParsecT s u m a -> ParsecT s u m b parsecMap :: (a -> b) -> ParsecT s u m a -> ParsecT s u m b
parsecMap f p parsecMap f p
= ParsecT $ \s -> liftM (fmap (liftM (fmap f))) (runParsecT p s) = ParsecT $ \s cok cerr eok eerr ->
unParser p s (cok . f) cerr (eok . f) eerr
instance (Monad m) => Applicative.Applicative (ParsecT s u m) where instance Applicative.Applicative (ParsecT s u m) where
pure = return pure = return
(<*>) = ap -- TODO: Can this be optimized? (<*>) = ap -- TODO: Can this be optimized?
instance (Monad m) => Applicative.Alternative (ParsecT s u m) where instance Applicative.Alternative (ParsecT s u m) where
empty = mzero empty = mzero
(<|>) = mplus (<|>) = mplus
instance (Monad m) => Monad (ParsecT s u m) where instance Monad (ParsecT s u m) where
return x = parserReturn x return x = parserReturn x
p >>= f = parserBind p f p >>= f = parserBind p f
fail msg = parserFail msg fail msg = parserFail msg
@ -106,7 +136,7 @@ instance (MonadIO m) => MonadIO (ParsecT s u m) where
instance (MonadReader r m) => MonadReader r (ParsecT s u m) where instance (MonadReader r m) => MonadReader r (ParsecT s u m) where
ask = lift ask ask = lift ask
local f p = ParsecT $ \s -> local f (runParsecT p s) local f p = mkPT $ \s -> local f (runParsecT p s)
-- I'm presuming the user might want a separate, non-backtracking -- I'm presuming the user might want a separate, non-backtracking
-- state aside from the Parsec user state. -- state aside from the Parsec user state.
@ -115,56 +145,61 @@ instance (MonadState s m) => MonadState s (ParsecT s' u m) where
put = lift . put put = lift . put
instance (MonadCont m) => MonadCont (ParsecT s u m) where instance (MonadCont m) => MonadCont (ParsecT s u m) where
callCC f = ParsecT $ \s -> callCC f = mkPT $ \s ->
callCC $ \c -> callCC $ \c ->
runParsecT (f (\a -> ParsecT $ \s' -> c (pack s' a))) s runParsecT (f (\a -> mkPT $ \s' -> c (pack s' a))) s
where pack s a= Empty $ return (Ok a s (unknownError s)) where pack s a= Empty $ return (Ok a s (unknownError s))
instance (MonadError e m) => MonadError e (ParsecT s u m) where instance (MonadError e m) => MonadError e (ParsecT s u m) where
throwError = lift . throwError throwError = lift . throwError
p `catchError` h = ParsecT $ \s -> p `catchError` h = mkPT $ \s ->
runParsecT p s `catchError` \e -> runParsecT p s `catchError` \e ->
runParsecT (h e) s runParsecT (h e) s
parserReturn :: (Monad m) => a -> ParsecT s u m a parserReturn :: a -> ParsecT s u m a
parserReturn x parserReturn x
= ParsecT $ \s -> return $ Empty $ return (Ok x s (unknownError s)) = ParsecT $ \s _ _ eok _ ->
eok x s (unknownError s)
parserBind :: (Monad m) parserBind :: ParsecT s u m a -> (a -> ParsecT s u m b) -> ParsecT s u m b
=> ParsecT s u m a -> (a -> ParsecT s u m b) -> ParsecT s u m b {-# INLINE parserBind #-}
parserBind m k
= ParsecT $ \s cok cerr eok eerr ->
let
-- consumed-okay case for m
mcok x s err =
let
-- if (k x) consumes, those go straigt up
pcok = cok
pcerr = cerr
-- if (k x) doesn't consume input, but is okay,
-- we still return in the consumed continuation
peok = cok
parserBind p f -- if (k x) doesn't consume input, but errors,
= ParsecT $ \s -> do -- TODO: This was \s@(State _ u _) ??? -- we return the error in the 'consumed-error'
res1 <- runParsecT p s -- continuation
case res1 of peerr err' = cerr (mergeError err err')
in unParser (k x) s pcok pcerr peok peerr
Empty mReply1 -- empty-ok case for m
-> do reply1 <- mReply1 meok x s err =
case reply1 of let
Ok x s' err1 -> do -- in these cases, (k x) can return as empty
res2 <- runParsecT (f x) s' pcok = cok
case res2 of peok = eok
Empty mReply2 pcerr = cerr
-> do reply2 <- mReply2 peerr err' = eerr (mergeError err err')
return $ Empty $ in unParser (k x) s pcok pcerr peok peerr
return $ mergeErrorReply err1 reply2 -- consumed-error case for m
other mcerr = cerr
-> do return $ other
Error err1 -> return $ Empty $ return $ Error err1
Consumed mReply1 -- empty-error case for m
-> do reply1 <- mReply1 meerr = eerr
return $ Consumed $ -- `early' returning
case reply1 of in unParser m s mcok mcerr meok meerr
Ok x s' err1 -> do
res2 <- runParsecT (f x) s'
case res2 of
Empty mReply2
-> do reply2 <- mReply2
return $ mergeErrorReply err1 reply2
Consumed reply2 -> reply2
Error err1 -> return $ Error err1
mergeErrorReply :: ParseError -> Reply s u a -> Reply s u a mergeErrorReply :: ParseError -> Reply s u a -> Reply s u a
@ -173,12 +208,12 @@ mergeErrorReply err1 reply -- XXX where to put it?
Ok x state err2 -> Ok x state (mergeError err1 err2) Ok x state err2 -> Ok x state (mergeError err1 err2)
Error err2 -> Error (mergeError err1 err2) Error err2 -> Error (mergeError err1 err2)
parserFail :: (Monad m) => String -> ParsecT s u m a parserFail :: String -> ParsecT s u m a
parserFail msg parserFail msg
= ParsecT $ \s -> return $ Empty $ return $ = ParsecT $ \s _ _ _ eerr ->
Error (newErrorMessage (Message msg) (statePos s)) eerr $ newErrorMessage (Message msg) (statePos s)
instance (Monad m) => MonadPlus (ParsecT s u m) where instance MonadPlus (ParsecT s u m) where
mzero = parserZero mzero = parserZero
mplus p1 p2 = parserPlus p1 p2 mplus p1 p2 = parserPlus p1 p2
@ -186,34 +221,27 @@ instance (Monad m) => MonadPlus (ParsecT s u m) where
-- equal to the 'mzero' member of the 'MonadPlus' class and to the 'Control.Applicative.empty' member -- equal to the 'mzero' member of the 'MonadPlus' class and to the 'Control.Applicative.empty' member
-- of the 'Control.Applicative.Applicative' class. -- of the 'Control.Applicative.Applicative' class.
parserZero :: (Monad m) => ParsecT s u m a parserZero :: ParsecT s u m a
parserZero parserZero
= ParsecT $ \s -> return $ Empty $ return $ Error (unknownError s) = ParsecT $ \s _ _ _ eerr ->
eerr $ unknownError s
parserPlus :: (Monad m) parserPlus :: ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
=> ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a {-# INLINE parserPlus #-}
parserPlus (ParsecT p1) (ParsecT p2) parserPlus m n
= ParsecT $ \s -> do = ParsecT $ \s cok cerr eok eerr ->
c1 <- p1 s let
case c1 of meerr err =
Empty mReply1 let
-> do r1 <- mReply1 neok y s' err' = eok y s' (mergeError err err')
case r1 of neerr err' = eerr $ mergeError err err'
Error err -> do in unParser n s cok cerr neok neerr
c2 <- p2 s in unParser m s cok cerr eok meerr
case c2 of
Empty mReply2
-> do reply2 <- mReply2
return $ Empty $ return (mergeErrorReply err reply2)
consumed
-> return $ consumed
other -> return $ Empty $ return $ other
other -> return $ other
instance MonadTrans (ParsecT s u) where instance MonadTrans (ParsecT s u) where
lift amb = ParsecT $ \s -> do lift amb = ParsecT $ \s _ _ eok _ -> do
a <- amb a <- amb
return $ Empty $ return $ Ok a s (unknownError s) eok a s $ unknownError s
infix 0 <?> infix 0 <?>
infixr 1 <|> infixr 1 <|>
@ -230,8 +258,7 @@ infixr 1 <|>
-- combinator, the message would be like '...: expecting \"let\" or -- combinator, the message would be like '...: expecting \"let\" or
-- letter', which is less friendly. -- letter', which is less friendly.
(<?>) :: (Monad m) (<?>) :: (ParsecT s u m a) -> String -> (ParsecT s u m a)
=> (ParsecT s u m a) -> String -> (ParsecT s u m a)
p <?> msg = label p msg p <?> msg = label p msg
-- | This combinator implements choice. The parser @p \<|> q@ first -- | This combinator implements choice. The parser @p \<|> q@ first
@ -246,34 +273,29 @@ p <?> msg = label p msg
-- implementation of the parser combinators and the generation of good -- implementation of the parser combinators and the generation of good
-- error messages. -- error messages.
(<|>) :: (Monad m) (<|>) :: (ParsecT s u m a) -> (ParsecT s u m a) -> (ParsecT s u m a)
=> (ParsecT s u m a) -> (ParsecT s u m a) -> (ParsecT s u m a)
p1 <|> p2 = mplus p1 p2 p1 <|> p2 = mplus p1 p2
label :: (Monad m) => ParsecT s u m a -> String -> ParsecT s u m a label :: ParsecT s u m a -> String -> ParsecT s u m a
label p msg label p msg
= labels p [msg] = labels p [msg]
labels :: (Monad m) => ParsecT s u m a -> [String] -> ParsecT s u m a labels :: ParsecT s u m a -> [String] -> ParsecT s u m a
labels p msgs labels p msgs =
= ParsecT $ \s -> do ParsecT $ \s cok cerr eok eerr ->
r <- runParsecT p s let eok' x s' error = eok x s' $ if errorIsUnknown error
case r of then error
Empty mReply -> do else setExpectErrors error msgs
reply <- mReply eerr' err = eerr $ setExpectErrors err msgs
return $ Empty $ case reply of
Error err in unParser p s cok cerr eok' eerr'
-> return $ Error (setExpectErrors err msgs)
Ok x s' err where
| errorIsUnknown err -> return $ reply setExpectErrors err [] = setErrorMessage (Expect "") err
| otherwise -> return (Ok x s' (setExpectErrors err msgs)) setExpectErrors err [msg] = setErrorMessage (Expect msg) err
other -> return $ other setExpectErrors err (msg:msgs)
where = foldr (\msg' err' -> addErrorMessage (Expect msg') err')
setExpectErrors err [] = setErrorMessage (Expect "") err (setErrorMessage (Expect msg) err) msgs
setExpectErrors err [msg] = setErrorMessage (Expect msg) err
setExpectErrors err (msg:msgs)
= foldr (\msg' err' -> addErrorMessage (Expect msg') err')
(setErrorMessage (Expect msg) err) msgs
-- TODO: There should be a stronger statement that can be made about this -- TODO: There should be a stronger statement that can be made about this
@ -293,32 +315,37 @@ tokens :: (Stream s m t, Eq t)
-> (SourcePos -> [t] -> SourcePos) -> (SourcePos -> [t] -> SourcePos)
-> [t] -- List of tokens to parse -> [t] -- List of tokens to parse
-> ParsecT s u m [t] -> ParsecT s u m [t]
{-# INLINE tokens #-}
tokens _ _ [] tokens _ _ []
= ParsecT $ \s -> return $ Empty $ return $ Ok [] s (unknownError s) = ParsecT $ \s _ _ eok _ ->
eok [] s $ unknownError s
tokens showTokens nextposs tts@(tok:toks) tokens showTokens nextposs tts@(tok:toks)
= ParsecT $ \(State input pos u) -> = ParsecT $ \(State input pos u) cok cerr eok eerr ->
let let
errEof = return $ Error (setErrorMessage (Expect (showTokens tts)) errEof = (setErrorMessage (Expect (showTokens tts))
(newErrorMessage (SysUnExpect "") pos)) (newErrorMessage (SysUnExpect "") pos))
errExpect x = return $ Error (setErrorMessage (Expect (showTokens tts))
(newErrorMessage (SysUnExpect (showTokens [x])) pos)) errExpect x = (setErrorMessage (Expect (showTokens tts))
walk [] rs = return (ok rs) (newErrorMessage (SysUnExpect (showTokens [x])) pos))
walk [] rs = ok rs
walk (t:ts) rs = do walk (t:ts) rs = do
sr <- uncons rs sr <- uncons rs
case sr of case sr of
Nothing -> errEof Nothing -> cerr $ errEof
Just (x,xs) | t == x -> walk ts xs Just (x,xs) | t == x -> walk ts xs
| otherwise -> errExpect x | otherwise -> cerr $ errExpect x
ok rs = let pos' = nextposs pos tts ok rs = let pos' = nextposs pos tts
s' = State rs pos' u s' = State rs pos' u
in Ok tts s' (newErrorUnknown pos') in cok tts s' (newErrorUnknown pos')
in do in do
sr <- uncons input sr <- uncons input
return $ case sr of case sr of
Nothing -> Empty $ errEof Nothing -> eerr $ errEof
Just (x,xs) Just (x,xs)
| tok == x -> Consumed $ walk toks xs | tok == x -> walk toks xs
| otherwise -> Empty $ errExpect x | otherwise -> eerr $ errExpect x
-- | The parser @try p@ behaves like parser @p@, except that it -- | The parser @try p@ behaves like parser @p@, except that it
-- pretends that it hasn't consumed any input when an error occurs. -- pretends that it hasn't consumed any input when an error occurs.
@ -351,17 +378,11 @@ tokens showTokens nextposs tts@(tok:toks)
-- > letExpr = do{ try (string "let"); ... } -- > letExpr = do{ try (string "let"); ... }
-- > identifier = many1 letter -- > identifier = many1 letter
try :: (Stream s m t) => ParsecT s u m a -> ParsecT s u m a try :: ParsecT s u m a -> ParsecT s u m a
try (ParsecT p) try p =
= ParsecT $ \s@(State _ pos _) -> do ParsecT $ \s@(State _ pos _) cok _ eok eerr ->
res <- p s let pcerr parseError = eerr $ setErrorPos pos parseError
case res of in unParser p s cok pcerr eok eerr
Consumed rep -> do r <- rep
case r of
Error err -> return $ Empty $ return $ Error
(setErrorPos pos err)
ok -> return $ Consumed $ return $ ok
empty -> return $ empty
-- | The parser @token showTok posFromTok testTok@ accepts a token @t@ -- | The parser @token showTok posFromTok testTok@ accepts a token @t@
-- with result @x@ when the function @testTok t@ returns @'Just' x@. The -- with result @x@ when the function @testTok t@ returns @'Just' x@. The
@ -413,6 +434,7 @@ tokenPrim :: (Stream s m t)
-> (SourcePos -> t -> s -> SourcePos) -- ^ Next position calculating function. -> (SourcePos -> t -> s -> SourcePos) -- ^ Next position calculating function.
-> (t -> Maybe a) -- ^ Matching function for the token to parse. -> (t -> Maybe a) -- ^ Matching function for the token to parse.
-> ParsecT s u m a -> ParsecT s u m a
{-# INLINE tokenPrim #-}
tokenPrim showToken nextpos test = tokenPrimEx showToken nextpos Nothing test tokenPrim showToken nextpos test = tokenPrimEx showToken nextpos Nothing test
tokenPrimEx :: (Stream s m t) tokenPrimEx :: (Stream s m t)
@ -421,37 +443,35 @@ tokenPrimEx :: (Stream s m t)
-> Maybe (SourcePos -> t -> s -> u -> u) -> Maybe (SourcePos -> t -> s -> u -> u)
-> (t -> Maybe a) -> (t -> Maybe a)
-> ParsecT s u m a -> ParsecT s u m a
tokenPrimEx showToken nextpos mbNextState test {-# INLINE tokenPrimEx #-}
= case mbNextState of tokenPrimEx showToken nextpos Nothing test
Nothing = ParsecT $ \(State input pos user) cok cerr eok eerr -> do
-> ParsecT $ \(State input pos user) -> do r <- uncons input
r <- uncons input case r of
case r of Nothing -> eerr $ unexpectError "" pos
Nothing -> return $ Empty $ return (sysUnExpectError "" pos) Just (c,cs)
Just (c,cs) -> case test c of
-> case test c of Just x -> let newpos = nextpos pos c cs
Just x -> let newpos = nextpos pos c cs newstate = State cs newpos user
newstate = State cs newpos user in seq newpos $ seq newstate $
in seq newpos $ seq newstate $ cok x newstate (newErrorUnknown newpos)
return $ Consumed $ return $ Nothing -> eerr $ unexpectError (showToken c) pos
(Ok x newstate (newErrorUnknown newpos)) tokenPrimEx showToken nextpos (Just nextState) test
Nothing -> return $ Empty $ return $ = ParsecT $ \(State input pos user) cok cerr eok eerr -> do
(sysUnExpectError (showToken c) pos) r <- uncons input
Just nextState case r of
-> ParsecT $ \(State input pos user) -> do Nothing -> eerr $ unexpectError "" pos
r <- uncons input Just (c,cs)
case r of -> case test c of
Nothing -> return $ Empty $ return (sysUnExpectError "" pos) Just x -> let newpos = nextpos pos c cs
Just (c,cs) newUser = nextState pos c cs user
-> case test c of newstate = State cs newpos newUser
Just x -> let newpos = nextpos pos c cs in seq newpos $ seq newstate $
newuser = nextState pos c cs user cok x newstate $ newErrorUnknown newpos
newstate = State cs newpos newuser Nothing -> eerr $ unexpectError (showToken c) pos
in seq newpos $ seq newstate $
return $ Consumed $ return $ unexpectError msg pos = newErrorMessage (SysUnExpect msg) pos
(Ok x newstate (newErrorUnknown newpos))
Nothing -> return $ Empty $ return $
(sysUnExpectError (showToken c) pos)
-- | @many p@ applies the parser @p@ /zero/ or more times. Returns a -- | @many p@ applies the parser @p@ /zero/ or more times. Returns a
-- list of the returned values of @p@. -- list of the returned values of @p@.
@ -461,7 +481,7 @@ tokenPrimEx showToken nextpos mbNextState test
-- > ; return (c:cs) -- > ; return (c:cs)
-- > } -- > }
many :: (Stream s m t) => ParsecT s u m a -> ParsecT s u m [a] many :: ParsecT s u m a -> ParsecT s u m [a]
many p many p
= do xs <- manyAccum (:) p = do xs <- manyAccum (:) p
return (reverse xs) return (reverse xs)
@ -471,44 +491,25 @@ many p
-- --
-- > spaces = skipMany space -- > spaces = skipMany space
skipMany :: (Stream s m t) => ParsecT s u m a -> ParsecT s u m () skipMany :: ParsecT s u m a -> ParsecT s u m ()
skipMany p skipMany p
= do manyAccum (\_ _ -> []) p = do manyAccum (\_ _ -> []) p
return () return ()
manyAccum :: (Stream s m t) manyAccum :: (a -> [a] -> [a])
=> (a -> [a] -> [a])
-> ParsecT s u m a -> ParsecT s u m a
-> ParsecT s u m [a] -> ParsecT s u m [a]
manyAccum accum p manyAccum acc p =
= ParsecT $ \s -> ParsecT $ \s cok cerr _eok eerr ->
let walk xs state mr let walk xs x s' err =
= do r <- mr unParser p s'
case r of (seq xs $ walk $ acc x xs) -- consumed-ok
Empty mReply cerr -- consumed-err
-> do reply <- mReply manyErr -- empty-ok
case reply of (\e -> cok xs s' e) -- empty-err
Error err -> return $ Ok xs state err in unParser p s (walk []) cerr manyErr (\e -> cok [] s e)
_ -> error "Text.Parsec.Prim.many: combinator 'many' is applied to a parser that accepts an empty string."
Consumed mReply manyErr = error "Text.ParserCombinators.Parsec.Prim.many: combinator 'many' is applied to a parser that accepts an empty string."
-> do reply <- mReply
case reply of
Error err
-> return $ Error err
Ok x s' _err
-> let ys = accum x xs
in seq ys (walk ys s' (runParsecT p s'))
in do r <- runParsecT p s
case r of
Empty mReply
-> do reply <- mReply
case reply of
Ok _ _ _
-> error "Text.ParserCombinators.Parsec.Prim.many: combinator 'many' is applied to a parser that accepts an empty string."
Error err
-> return $ Empty $ return (Ok [] s err)
consumed
-> return $ Consumed $ walk [] s (return consumed)
-- < Running a parser: monadic (runPT) and pure (runP) -- < Running a parser: monadic (runPT) and pure (runP)
@ -627,11 +628,11 @@ setParserState st = updateParserState (const st)
-- | @updateParserState f@ applies function @f@ to the parser state. -- | @updateParserState f@ applies function @f@ to the parser state.
updateParserState :: (Monad m) updateParserState :: (State s u -> State s u) -> ParsecT s u m (State s u)
=> (State s u -> State s u) -> ParsecT s u m (State s u) updateParserState f =
updateParserState f ParsecT $ \s _ _ eok _ ->
= ParsecT $ \s -> let s' = f s let s' = f s
in return $ Empty $ return (Ok s' s' (unknownError s')) in eok s' s' $ unknownError s'
-- < User state combinators -- < User state combinators

1
Text/Parsec/String.hs
View File

@ -25,6 +25,7 @@ import Text.Parsec.Prim
instance (Monad m) => Stream [tok] m tok where instance (Monad m) => Stream [tok] m tok where
uncons [] = return $ Nothing uncons [] = return $ Nothing
uncons (t:ts) = return $ Just (t,ts) uncons (t:ts) = return $ Just (t,ts)
{-# INLINE uncons #-}
type Parser = Parsec String () type Parser = Parsec String ()
type GenParser tok st = Parsec [tok] st type GenParser tok st = Parsec [tok] st