lhs2tex-1.21: src/Parser.lhs
%-------------------------------= --------------------------------------------
\subsection{Deterministic parser}
%-------------------------------= --------------------------------------------
%if codeOnly || showModuleHeader
> module Parser ( Parser, run, satisfy, lit, lits, wrap, nonnull, eof )
> where
>
> import Control.Applicative
> import Control.Monad ( MonadPlus(..), ap, mfilter )
%endif
Deterministische Mini-Parser.
%if style == math
%format (MkParser (p)) = p
%format (unParser (p)) = p
%else
> unParser :: Parser tok a -> [tok] -> Maybe (a, [tok])
> unParser (MkParser p) = p
%endif
> newtype Parser tok a = MkParser ([tok] -> Maybe (a, [tok]))
>
> run :: Parser tok a -> [tok] -> Maybe a
> run (MkParser p) inp = fmap fst (p inp)
>
> instance Functor (Parser tok) where
> fmap f m = m >>= \a -> return (f a)
> instance Monad (Parser tok) where
> return a = MkParser (\inp -> Just (a, inp))
> m >>= k = MkParser (\inp -> case unParser m inp of
> Nothing -> Nothing
> Just (a, rest) -> unParser (k a) rest)
> instance MonadPlus (Parser tok) where
> mzero = MkParser (\_inp -> Nothing)
> m `mplus` n = MkParser (\inp -> unParser m inp `mplus` unParser n inp)
> instance Applicative (Parser tok) where
> pure = return
> (<*>) = ap
> instance Alternative (Parser tok) where
> empty = mzero
> (<|>) = mplus
>
> satisfy :: (tok -> Bool) -> Parser tok tok
> satisfy p = MkParser (\inp -> case inp of
> a : rest | p a -> Just (a, rest)
> _ -> Nothing)
>
> lit :: (Eq tok) => tok -> Parser tok tok
> lit c = satisfy (== c)
ks, 06.09.2003: Adding eof that accepts succeeds only at the end of input.
> eof :: Parser tok ()
> eof = MkParser (\inp -> case inp of
> [] -> Just ((),[])
> _ -> Nothing)
|lits s| corresponds to |mapM_ lit_ s|.
> lits :: (Eq tok) => [tok] -> Parser tok ()
> lits s = MkParser (\inp -> case splitAt (length s) inp of
> (s', rest) | s == s' -> Just ((), rest)
> _ -> Nothing)
\Todo{Better name for |wrap|.}
> wrap :: ([tok] -> (a, [tok])) -> Parser tok a
> wrap f = MkParser (\inp -> Just (f inp))
>
> nonnull :: ([tok] -> ([a], [tok])) -> Parser tok [a]
> nonnull f = mfilter (not . null) (wrap f)
%if False
> {-
> lit_ :: (Eq tok) => tok -> Parser tok ()
> lit_ c = MkParser (\inp -> case inp of
> c' : rest | c == c' -> Just ((), rest)
> _ -> Nothing)
> nonnull_ f = MkParser (\inp -> case f inp of
> res@((_ : _) ,_) -> Just res
> _ -> Nothing)
> -}
%endif