polyparse-1.0: docs/haddock/src/Text/ParserCombinators/HuttonMeijerWallace.html
<pre><font color=Cyan>{</font><font color=Blue>-----------------------------------------------------------------------------</font>
A LIBRARY OF MONADIC PARSER COMBINATORS
<font color=Magenta>29</font>th July <font color=Magenta>1996</font>
Graham Hutton Erik Meijer
University <font color=Green><u>of</u></font> Nottingham University <font color=Green><u>of</u></font> Utrecht
This Haskell <font color=Magenta>1.3</font> script defines a library <font color=Green><u>of</u></font> parser combinators<font color=Cyan>,</font> and is taken
<a name="from"></a>from sections <font color=Magenta>1</font><font color=Blue>-</font><font color=Magenta>6</font> <font color=Green><u>of</u></font> our article <font color=Magenta>"Monadic Parser Combinators"</font><font color=Cyan>.</font> Some changes
<a name="to"></a>to the library have been made <font color=Green><u>in</u></font> the move from Gofer to Haskell<font color=Red><b>:</b></font>
<font color=Cyan>*</font> Do notation is used <font color=Green><u>in</u></font> place <font color=Green><u>of</u></font> monad comprehension notation<font color=Cyan>;</font>
<font color=Cyan>*</font> The parser datatype is defined using <font color=Magenta>"newtype"</font><font color=Cyan>,</font> to avoid the overhead
<font color=Green><u>of</u></font> tagging and untagging parsers with the P constructor<font color=Cyan>.</font>
<font color=Blue>------------------------------------------------------------------------------</font>
<font color=Cyan>**</font> Extended to allow a symbol table<font color=Cyan>/</font>state to be threaded through the monad<font color=Cyan>.</font>
<font color=Cyan>**</font> Extended to allow a parameterised token <font color=Green><u>type</u></font><font color=Cyan>,</font> rather than just strings<font color=Cyan>.</font>
<font color=Cyan>**</font> Extended to allow error<font color=Blue>-</font>reporting<font color=Cyan>.</font>
<font color=Cyan>(</font>Extensions<font color=Red><b>:</b></font> <font color=Magenta>1998</font><font color=Blue>-</font><font color=Magenta>2000</font> Malcolm<font color=Cyan>.</font>Wallace<font color=Red>@</font>cs<font color=Cyan>.</font>york<font color=Cyan>.</font>ac<font color=Cyan>.</font>uk<font color=Cyan>)</font>
<a name="------------------------------------------------------------------------------}"></a><font color=Cyan>(</font>More extensions<font color=Red><b>:</b></font> <font color=Magenta>2004</font> gk<font color=Blue>-</font>haskell<font color=Red>@</font>ninebynine<font color=Cyan>.</font>org<font color=Cyan>)</font>
<font color=Cyan>------------------------------------------------------------------------------}</font>
<font color=Blue>-- | This library of monadic parser combinators is based on the ones</font>
<font color=Blue>-- defined by Graham Hutton and Erik Meijer. It has been extended by</font>
<font color=Blue>-- Malcolm Wallace to use an abstract token type (no longer just a</font>
<font color=Blue>-- string) as input, and to incorporate a State Transformer monad, useful</font>
<font color=Blue>-- for symbol tables, macros, and so on. Basic facilities for error</font>
<font color=Blue>-- reporting have also been added, and later extended by Graham Klyne</font>
<font color=Blue>-- to return the errors through an @Either@ type, rather than just</font>
<font color=Blue>-- calling @error@.</font>
<font color=Green><u>module</u></font> Text<font color=Cyan>.</font>ParserCombinators<font color=Cyan>.</font>HuttonMeijerWallace
<font color=Cyan>(</font>
<font color=Blue>-- * The parser monad</font>
Parser<font color=Cyan>(</font><font color=Red>..</font><font color=Cyan>)</font>
<font color=Blue>-- * Primitive parser combinators</font>
<font color=Cyan>,</font> item<font color=Cyan>,</font> eof<font color=Cyan>,</font> papply<font color=Cyan>,</font> papply'
<font color=Blue>-- * Derived combinators</font>
<font color=Cyan>,</font> <font color=Cyan>(</font><font color=Cyan>+++</font><font color=Cyan>)</font><font color=Cyan>,</font> <font color=Blue>{-sat,-}</font> tok<font color=Cyan>,</font> nottok<font color=Cyan>,</font> many<font color=Cyan>,</font> many1
<font color=Cyan>,</font> sepby<font color=Cyan>,</font> sepby1<font color=Cyan>,</font> chainl<font color=Cyan>,</font> chainl1<font color=Cyan>,</font> chainr<font color=Cyan>,</font> chainr1<font color=Cyan>,</font> ops<font color=Cyan>,</font> bracket
<font color=Cyan>,</font> toEOF
<font color=Blue>-- * Error handling</font>
<font color=Cyan>,</font> elserror
<font color=Blue>-- * State handling</font>
<font color=Cyan>,</font> stupd<font color=Cyan>,</font> stquery<font color=Cyan>,</font> stget
<font color=Blue>-- * Re-parsing</font>
<font color=Cyan>,</font> reparse
<font color=Cyan>)</font> <font color=Green><u>where</u></font>
<font color=Green><u>import</u></font> Char
<font color=Green><u>import</u></font> Monad
<font color=Green><u>infixr</u></font> <font color=Magenta>5</font> <font color=Cyan>+++</font>
<font color=Blue>--- The parser monad ---------------------------------------------------------</font>
<a name="ParseResult"></a><font color=Green><u>type</u></font> ParseResult s t e a <font color=Red>=</font> Either e <font color=Red>[</font><font color=Cyan>(</font>a<font color=Cyan>,</font>s<font color=Cyan>,</font><font color=Red>[</font>Either e t<font color=Red>]</font><font color=Cyan>)</font><font color=Red>]</font>
<font color=Green><u>newtype</u></font> Parser s t e a <font color=Red>=</font> P <font color=Cyan>(</font> s <font color=Red>-></font> <font color=Red>[</font>Either e t<font color=Red>]</font> <font color=Red>-></font> ParseResult s t e a <font color=Cyan>)</font>
<font color=Blue>-- ^ The parser type is parametrised on the types of the state @s@,</font>
<font color=Blue>-- the input tokens @t@, error-type @e@, and the result value @a@.</font>
<font color=Blue>-- The state and remaining input are threaded through the monad.</font>
<font color=Green><u>instance</u></font> Functor <font color=Cyan>(</font>Parser s t e<font color=Cyan>)</font> <font color=Green><u>where</u></font>
<font color=Blue>-- fmap :: (a -> b) -> (Parser s t e a -> Parser s t e b)</font>
fmap f <font color=Cyan>(</font>P p<font color=Cyan>)</font> <font color=Red>=</font> P <font color=Cyan>(</font><font color=Red>\</font>st inp <font color=Red>-></font> <font color=Green><u>case</u></font> p st inp <font color=Green><u>of</u></font>
Right res <font color=Red>-></font> Right <font color=Red>[</font><font color=Cyan>(</font>f v<font color=Cyan>,</font> s<font color=Cyan>,</font> out<font color=Cyan>)</font> <font color=Red>|</font> <font color=Cyan>(</font>v<font color=Cyan>,</font>s<font color=Cyan>,</font>out<font color=Cyan>)</font> <font color=Red><-</font> res<font color=Red>]</font>
Left err <font color=Red>-></font> Left err
<font color=Cyan>)</font>
<font color=Green><u>instance</u></font> Monad <font color=Cyan>(</font>Parser s t e<font color=Cyan>)</font> <font color=Green><u>where</u></font>
<font color=Blue>-- return :: a -> Parser s t e a</font>
return v <font color=Red>=</font> P <font color=Cyan>(</font><font color=Red>\</font>st inp <font color=Red>-></font> Right <font color=Red>[</font><font color=Cyan>(</font>v<font color=Cyan>,</font>st<font color=Cyan>,</font>inp<font color=Cyan>)</font><font color=Red>]</font><font color=Cyan>)</font>
<font color=Blue>-- >>= :: Parser s t e a -> (a -> Parser s t e b) -> Parser s t e b</font>
<font color=Cyan>(</font>P p<font color=Cyan>)</font> <font color=Cyan>>>=</font> f <font color=Red>=</font> P <font color=Cyan>(</font><font color=Red>\</font>st inp <font color=Red>-></font> <font color=Green><u>case</u></font> p st inp <font color=Green><u>of</u></font>
Right res <font color=Red>-></font> foldr joinresults <font color=Cyan>(</font>Right <font color=Red>[</font><font color=Red>]</font><font color=Cyan>)</font>
<font color=Red>[</font> papply' <font color=Cyan>(</font>f v<font color=Cyan>)</font> s out <font color=Red>|</font> <font color=Cyan>(</font>v<font color=Cyan>,</font>s<font color=Cyan>,</font>out<font color=Cyan>)</font> <font color=Red><-</font> res <font color=Red>]</font>
Left err <font color=Red>-></font> Left err
<font color=Cyan>)</font>
<font color=Blue>-- fail :: String -> Parser s t e a</font>
fail err <font color=Red>=</font> P <font color=Cyan>(</font><font color=Red>\</font>st inp <font color=Red>-></font> Right <font color=Red>[</font><font color=Red>]</font><font color=Cyan>)</font>
<font color=Blue>-- I know it's counterintuitive, but we want no-parse, not an error.</font>
<font color=Green><u>instance</u></font> MonadPlus <font color=Cyan>(</font>Parser s t e<font color=Cyan>)</font> <font color=Green><u>where</u></font>
<font color=Blue>-- mzero :: Parser s t e a</font>
mzero <font color=Red>=</font> P <font color=Cyan>(</font><font color=Red>\</font>st inp <font color=Red>-></font> Right <font color=Red>[</font><font color=Red>]</font><font color=Cyan>)</font>
<font color=Blue>-- mplus :: Parser s t e a -> Parser s t e a -> Parser s t e a</font>
<font color=Cyan>(</font>P p<font color=Cyan>)</font> <font color=Cyan>`mplus`</font> <font color=Cyan>(</font>P q<font color=Cyan>)</font> <font color=Red>=</font> P <font color=Cyan>(</font><font color=Red>\</font>st inp <font color=Red>-></font> joinresults <font color=Cyan>(</font>p st inp<font color=Cyan>)</font> <font color=Cyan>(</font>q st inp<font color=Cyan>)</font><font color=Cyan>)</font>
<font color=Blue>-- joinresults ensures that explicitly raised errors are dominant,</font>
<font color=Blue>-- provided no parse has yet been found. The commented out code is</font>
<font color=Blue>-- a slightly stricter specification of the real code.</font>
joinresults <font color=Red>::</font> ParseResult s t e a <font color=Red>-></font> ParseResult s t e a <font color=Red>-></font> ParseResult s t e a
<font color=Blue>{-
joinresults (Left p) (Left q) = Left p
joinresults (Left p) (Right _) = Left p
joinresults (Right []) (Left q) = Left q
joinresults (Right p) (Left q) = Right p
joinresults (Right p) (Right q) = Right (p++q)
-}</font>
<a name="joinresults"></a>joinresults <font color=Cyan>(</font>Left p<font color=Cyan>)</font> q <font color=Red>=</font> Left p
joinresults <font color=Cyan>(</font>Right <font color=Red>[</font><font color=Red>]</font><font color=Cyan>)</font> q <font color=Red>=</font> q
joinresults <font color=Cyan>(</font>Right p<font color=Cyan>)</font> q <font color=Red>=</font> Right <font color=Cyan>(</font>p<font color=Cyan>++</font> <font color=Green><u>case</u></font> q <font color=Green><u>of</u></font> Left <font color=Green><u>_</u></font> <font color=Red>-></font> <font color=Red>[</font><font color=Red>]</font>
Right r <font color=Red>-></font> r<font color=Cyan>)</font>
<font color=Blue>--- Primitive parser combinators ---------------------------------------------</font>
<font color=Blue>-- | Deliver the first remaining token.</font>
item <font color=Red>::</font> Parser s t e t
<a name="item"></a>item <font color=Red>=</font> P <font color=Cyan>(</font><font color=Red>\</font>st inp <font color=Red>-></font> <font color=Green><u>case</u></font> inp <font color=Green><u>of</u></font>
<font color=Red>[</font><font color=Red>]</font> <font color=Red>-></font> Right <font color=Red>[</font><font color=Red>]</font>
<font color=Cyan>(</font>Left e<font color=Red><b>:</b></font> <font color=Green><u>_</u></font><font color=Cyan>)</font> <font color=Red>-></font> Left e
<font color=Cyan>(</font>Right x<font color=Red><b>:</b></font> xs<font color=Cyan>)</font> <font color=Red>-></font> Right <font color=Red>[</font><font color=Cyan>(</font>x<font color=Cyan>,</font>st<font color=Cyan>,</font>xs<font color=Cyan>)</font><font color=Red>]</font>
<font color=Cyan>)</font>
<font color=Blue>-- | Fail if end of input is not reached</font>
eof <font color=Red>::</font> Show p <font color=Red>=></font> Parser s <font color=Cyan>(</font>p<font color=Cyan>,</font>t<font color=Cyan>)</font> String <font color=Cyan>(</font><font color=Cyan>)</font>
<a name="eof"></a>eof <font color=Red>=</font> P <font color=Cyan>(</font><font color=Red>\</font>st inp <font color=Red>-></font> <font color=Green><u>case</u></font> inp <font color=Green><u>of</u></font>
<font color=Red>[</font><font color=Red>]</font> <font color=Red>-></font> Right <font color=Red>[</font><font color=Cyan>(</font><font color=Cyan>(</font><font color=Cyan>)</font><font color=Cyan>,</font>st<font color=Cyan>,</font><font color=Red>[</font><font color=Red>]</font><font color=Cyan>)</font><font color=Red>]</font>
<font color=Cyan>(</font>Left e<font color=Red><b>:</b></font><font color=Green><u>_</u></font><font color=Cyan>)</font> <font color=Red>-></font> Left e
<font color=Cyan>(</font>Right <font color=Cyan>(</font>p<font color=Cyan>,</font><font color=Green><u>_</u></font><font color=Cyan>)</font><font color=Red><b>:</b></font><font color=Green><u>_</u></font><font color=Cyan>)</font> <font color=Red>-></font> Left <font color=Cyan>(</font><font color=Magenta>"End of input expected at "</font>
<font color=Cyan>++</font>show p<font color=Cyan>++</font><font color=Magenta>"\n but found text"</font><font color=Cyan>)</font>
<font color=Cyan>)</font>
<font color=Blue>{-
-- | Ensure the value delivered by the parser is evaluated to WHNF.
force :: Parser s t e a -> Parser s t e a
force (P p) = P (\st inp -> let Right xs = p st inp
h = head xs in
h `seq` Right (h: tail xs)
)
-- [[[GK]]] ^^^^^^
-- WHNF = Weak Head Normal Form, meaning that it has no top-level redex.
-- In this case, I think that means that the first element of the list
-- is fully evaluated.
--
-- NOTE: the original form of this function fails if there is no parse
-- result for p st inp (head xs fails if xs is null), so the modified
-- form can assume a Right value only.
--
-- Why is this needed?
-- It's not exported, and the only use of this I see is commented out.
---------------------------------------
-}</font>
<font color=Blue>-- | Deliver the first parse result only, eliminating any backtracking.</font>
first <font color=Red>::</font> Parser s t e a <font color=Red>-></font> Parser s t e a
<a name="first"></a>first <font color=Cyan>(</font>P p<font color=Cyan>)</font> <font color=Red>=</font> P <font color=Cyan>(</font><font color=Red>\</font>st inp <font color=Red>-></font> <font color=Green><u>case</u></font> p st inp <font color=Green><u>of</u></font>
Right <font color=Cyan>(</font>x<font color=Red><b>:</b></font>xs<font color=Cyan>)</font> <font color=Red>-></font> Right <font color=Red>[</font>x<font color=Red>]</font>
otherwise <font color=Red>-></font> otherwise
<font color=Cyan>)</font>
<font color=Blue>-- | Apply the parser to some real input, given an initial state value.</font>
<font color=Blue>-- If the parser fails, raise 'error' to halt the program.</font>
<font color=Blue>-- (This is the original exported behaviour - to allow the caller to</font>
<font color=Blue>-- deal with the error differently, see @papply'@.)</font>
papply <font color=Red>::</font> Parser s t String a <font color=Red>-></font> s <font color=Red>-></font> <font color=Red>[</font>Either String t<font color=Red>]</font>
<font color=Red>-></font> <font color=Red>[</font><font color=Cyan>(</font>a<font color=Cyan>,</font>s<font color=Cyan>,</font><font color=Red>[</font>Either String t<font color=Red>]</font><font color=Cyan>)</font><font color=Red>]</font>
<a name="papply"></a>papply <font color=Cyan>(</font>P p<font color=Cyan>)</font> st inp <font color=Red>=</font> either error id <font color=Cyan>(</font>p st inp<font color=Cyan>)</font>
<font color=Blue>-- | Apply the parser to some real input, given an initial state value.</font>
<font color=Blue>-- If the parser fails, return a diagnostic message to the caller.</font>
papply' <font color=Red>::</font> Parser s t e a <font color=Red>-></font> s <font color=Red>-></font> <font color=Red>[</font>Either e t<font color=Red>]</font>
<font color=Red>-></font> Either e <font color=Red>[</font><font color=Cyan>(</font>a<font color=Cyan>,</font>s<font color=Cyan>,</font><font color=Red>[</font>Either e t<font color=Red>]</font><font color=Cyan>)</font><font color=Red>]</font>
<a name="papply'"></a>papply' <font color=Cyan>(</font>P p<font color=Cyan>)</font> st inp <font color=Red>=</font> p st inp
<font color=Blue>--- Derived combinators ------------------------------------------------------</font>
<font color=Blue>-- | A choice between parsers. Keep only the first success.</font>
<a name="+++"></a><font color=Cyan>(</font><font color=Cyan>+++</font><font color=Cyan>)</font> <font color=Red>::</font> Parser s t e a <font color=Red>-></font> Parser s t e a <font color=Red>-></font> Parser s t e a
<a name="p"></a>p <font color=Cyan>+++</font> q <font color=Red>=</font> first <font color=Cyan>(</font>p <font color=Cyan>`mplus`</font> q<font color=Cyan>)</font>
<font color=Blue>-- | Deliver the first token if it satisfies a predicate.</font>
sat <font color=Red>::</font> <font color=Cyan>(</font>t <font color=Red>-></font> Bool<font color=Cyan>)</font> <font color=Red>-></font> Parser s <font color=Cyan>(</font>p<font color=Cyan>,</font>t<font color=Cyan>)</font> e t
<a name="sat"></a>sat p <font color=Red>=</font> <font color=Green><u>do</u></font> <font color=Cyan>{</font><font color=Cyan>(</font><font color=Green><u>_</u></font><font color=Cyan>,</font>x<font color=Cyan>)</font> <font color=Red><-</font> item<font color=Cyan>;</font> <font color=Green><u>if</u></font> p x <font color=Green><u>then</u></font> return x <font color=Green><u>else</u></font> mzero<font color=Cyan>}</font>
<font color=Blue>-- | Deliver the first token if it equals the argument.</font>
tok <font color=Red>::</font> Eq t <font color=Red>=></font> t <font color=Red>-></font> Parser s <font color=Cyan>(</font>p<font color=Cyan>,</font>t<font color=Cyan>)</font> e t
<a name="tok"></a>tok t <font color=Red>=</font> <font color=Green><u>do</u></font> <font color=Cyan>{</font><font color=Cyan>(</font><font color=Green><u>_</u></font><font color=Cyan>,</font>x<font color=Cyan>)</font> <font color=Red><-</font> item<font color=Cyan>;</font> <font color=Green><u>if</u></font> x<font color=Cyan>==</font>t <font color=Green><u>then</u></font> return t <font color=Green><u>else</u></font> mzero<font color=Cyan>}</font>
<font color=Blue>-- | Deliver the first token if it does not equal the argument.</font>
nottok <font color=Red>::</font> Eq t <font color=Red>=></font> <font color=Red>[</font>t<font color=Red>]</font> <font color=Red>-></font> Parser s <font color=Cyan>(</font>p<font color=Cyan>,</font>t<font color=Cyan>)</font> e t
<a name="nottok"></a>nottok ts <font color=Red>=</font> <font color=Green><u>do</u></font> <font color=Cyan>{</font><font color=Cyan>(</font><font color=Green><u>_</u></font><font color=Cyan>,</font>x<font color=Cyan>)</font> <font color=Red><-</font> item<font color=Cyan>;</font> <font color=Green><u>if</u></font> x <font color=Cyan>`notElem`</font> ts <font color=Green><u>then</u></font> return x
<font color=Green><u>else</u></font> mzero<font color=Cyan>}</font>
<font color=Blue>-- | Deliver zero or more values of @a@.</font>
many <font color=Red>::</font> Parser s t e a <font color=Red>-></font> Parser s t e <font color=Red>[</font>a<font color=Red>]</font>
<a name="many"></a>many p <font color=Red>=</font> many1 p <font color=Cyan>+++</font> return <font color=Red>[</font><font color=Red>]</font>
<font color=Blue>--many p = force (many1 p +++ return [])</font>
<font color=Blue>-- | Deliver one or more values of @a@.</font>
many1 <font color=Red>::</font> Parser s t e a <font color=Red>-></font> Parser s t e <font color=Red>[</font>a<font color=Red>]</font>
<a name="many1"></a>many1 p <font color=Red>=</font> <font color=Green><u>do</u></font> <font color=Cyan>{</font>x <font color=Red><-</font> p<font color=Cyan>;</font> xs <font color=Red><-</font> many p<font color=Cyan>;</font> return <font color=Cyan>(</font>x<font color=Red><b>:</b></font>xs<font color=Cyan>)</font><font color=Cyan>}</font>
<font color=Blue>-- | Deliver zero or more values of @a@ separated by @b@'s.</font>
sepby <font color=Red>::</font> Parser s t e a <font color=Red>-></font> Parser s t e b <font color=Red>-></font> Parser s t e <font color=Red>[</font>a<font color=Red>]</font>
<a name="sepby"></a>p <font color=Cyan>`sepby`</font> sep <font color=Red>=</font> <font color=Cyan>(</font>p <font color=Cyan>`sepby1`</font> sep<font color=Cyan>)</font> <font color=Cyan>+++</font> return <font color=Red>[</font><font color=Red>]</font>
<font color=Blue>-- | Deliver one or more values of @a@ separated by @b@'s.</font>
sepby1 <font color=Red>::</font> Parser s t e a <font color=Red>-></font> Parser s t e b <font color=Red>-></font> Parser s t e <font color=Red>[</font>a<font color=Red>]</font>
<a name="sepby1"></a>p <font color=Cyan>`sepby1`</font> sep <font color=Red>=</font> <font color=Green><u>do</u></font> <font color=Cyan>{</font>x <font color=Red><-</font> p<font color=Cyan>;</font> xs <font color=Red><-</font> many <font color=Cyan>(</font><font color=Green><u>do</u></font> <font color=Cyan>{</font>sep<font color=Cyan>;</font> p<font color=Cyan>}</font><font color=Cyan>)</font><font color=Cyan>;</font> return <font color=Cyan>(</font>x<font color=Red><b>:</b></font>xs<font color=Cyan>)</font><font color=Cyan>}</font>
chainl <font color=Red>::</font> Parser s t e a <font color=Red>-></font> Parser s t e <font color=Cyan>(</font>a<font color=Red>-></font>a<font color=Red>-></font>a<font color=Cyan>)</font> <font color=Red>-></font> a
<font color=Red>-></font> Parser s t e a
<a name="chainl"></a>chainl p op v <font color=Red>=</font> <font color=Cyan>(</font>p <font color=Cyan>`chainl1`</font> op<font color=Cyan>)</font> <font color=Cyan>+++</font> return v
chainl1 <font color=Red>::</font> Parser s t e a <font color=Red>-></font> Parser s t e <font color=Cyan>(</font>a<font color=Red>-></font>a<font color=Red>-></font>a<font color=Cyan>)</font> <font color=Red>-></font> Parser s t e a
<a name="chainl1"></a>p <font color=Cyan>`chainl1`</font> op <font color=Red>=</font> <font color=Green><u>do</u></font> <font color=Cyan>{</font>x <font color=Red><-</font> p<font color=Cyan>;</font> rest x<font color=Cyan>}</font>
<font color=Green><u>where</u></font>
rest x <font color=Red>=</font> <font color=Green><u>do</u></font> <font color=Cyan>{</font>f <font color=Red><-</font> op<font color=Cyan>;</font> y <font color=Red><-</font> p<font color=Cyan>;</font> rest <font color=Cyan>(</font>f x y<font color=Cyan>)</font><font color=Cyan>}</font>
<font color=Cyan>+++</font> return x
chainr <font color=Red>::</font> Parser s t e a <font color=Red>-></font> Parser s t e <font color=Cyan>(</font>a<font color=Red>-></font>a<font color=Red>-></font>a<font color=Cyan>)</font> <font color=Red>-></font> a
<font color=Red>-></font> Parser s t e a
<a name="chainr"></a>chainr p op v <font color=Red>=</font> <font color=Cyan>(</font>p <font color=Cyan>`chainr1`</font> op<font color=Cyan>)</font> <font color=Cyan>+++</font> return v
chainr1 <font color=Red>::</font> Parser s t e a <font color=Red>-></font> Parser s t e <font color=Cyan>(</font>a<font color=Red>-></font>a<font color=Red>-></font>a<font color=Cyan>)</font> <font color=Red>-></font> Parser s t e a
<a name="chainr1"></a>p <font color=Cyan>`chainr1`</font> op <font color=Red>=</font> <font color=Green><u>do</u></font> <font color=Cyan>{</font>x <font color=Red><-</font> p<font color=Cyan>;</font> rest x<font color=Cyan>}</font>
<font color=Green><u>where</u></font>
rest x <font color=Red>=</font> <font color=Green><u>do</u></font> <font color=Cyan>{</font> f <font color=Red><-</font> op
<font color=Cyan>;</font> y <font color=Red><-</font> p <font color=Cyan>`chainr1`</font> op
<font color=Cyan>;</font> return <font color=Cyan>(</font>f x y<font color=Cyan>)</font>
<font color=Cyan>}</font>
<font color=Cyan>+++</font> return x
ops <font color=Red>::</font> <font color=Red>[</font><font color=Cyan>(</font>Parser s t e a<font color=Cyan>,</font> b<font color=Cyan>)</font><font color=Red>]</font> <font color=Red>-></font> Parser s t e b
<a name="ops"></a>ops xs <font color=Red>=</font> foldr1 <font color=Cyan>(</font><font color=Cyan>+++</font><font color=Cyan>)</font> <font color=Red>[</font><font color=Green><u>do</u></font> <font color=Cyan>{</font>p<font color=Cyan>;</font> return op<font color=Cyan>}</font> <font color=Red>|</font> <font color=Cyan>(</font>p<font color=Cyan>,</font>op<font color=Cyan>)</font> <font color=Red><-</font> xs<font color=Red>]</font>
bracket <font color=Red>::</font> <font color=Cyan>(</font>Show p<font color=Cyan>,</font>Show t<font color=Cyan>)</font> <font color=Red>=></font>
Parser s <font color=Cyan>(</font>p<font color=Cyan>,</font>t<font color=Cyan>)</font> e a <font color=Red>-></font> Parser s <font color=Cyan>(</font>p<font color=Cyan>,</font>t<font color=Cyan>)</font> e b <font color=Red>-></font>
Parser s <font color=Cyan>(</font>p<font color=Cyan>,</font>t<font color=Cyan>)</font> e c <font color=Red>-></font> Parser s <font color=Cyan>(</font>p<font color=Cyan>,</font>t<font color=Cyan>)</font> e b
<a name="bracket"></a>bracket open p close <font color=Red>=</font> <font color=Green><u>do</u></font> <font color=Cyan>{</font> open
<font color=Cyan>;</font> x <font color=Red><-</font> p
<font color=Cyan>;</font> close <font color=Blue>-- `elserror` "improperly matched construct";</font>
<font color=Cyan>;</font> return x
<font color=Cyan>}</font>
<font color=Blue>-- | Accept a complete parse of the input only, no partial parses.</font>
toEOF <font color=Red>::</font> Show p <font color=Red>=></font>
Parser s <font color=Cyan>(</font>p<font color=Cyan>,</font>t<font color=Cyan>)</font> String a <font color=Red>-></font> Parser s <font color=Cyan>(</font>p<font color=Cyan>,</font>t<font color=Cyan>)</font> String a
<a name="toEOF"></a>toEOF p <font color=Red>=</font> <font color=Green><u>do</u></font> <font color=Cyan>{</font> x <font color=Red><-</font> p<font color=Cyan>;</font> eof<font color=Cyan>;</font> return x <font color=Cyan>}</font>
<font color=Blue>--- Error handling -----------------------------------------------------------</font>
<font color=Blue>-- | Return an error using the supplied diagnostic string, and a token type</font>
<font color=Blue>-- which includes position information.</font>
parseerror <font color=Red>::</font> <font color=Cyan>(</font>Show p<font color=Cyan>,</font>Show t<font color=Cyan>)</font> <font color=Red>=></font> String <font color=Red>-></font> Parser s <font color=Cyan>(</font>p<font color=Cyan>,</font>t<font color=Cyan>)</font> String a
<a name="parseerror"></a>parseerror err <font color=Red>=</font> P <font color=Cyan>(</font><font color=Red>\</font>st inp <font color=Red>-></font>
<font color=Green><u>case</u></font> inp <font color=Green><u>of</u></font>
<font color=Red>[</font><font color=Red>]</font> <font color=Red>-></font> Left <font color=Magenta>"Parse error: unexpected EOF\n"</font>
<font color=Cyan>(</font>Left e<font color=Red><b>:</b></font><font color=Green><u>_</u></font><font color=Cyan>)</font> <font color=Red>-></font> Left <font color=Cyan>(</font><font color=Magenta>"Lexical error: "</font><font color=Cyan>++</font>e<font color=Cyan>)</font>
<font color=Cyan>(</font>Right <font color=Cyan>(</font>p<font color=Cyan>,</font>t<font color=Cyan>)</font><font color=Red><b>:</b></font><font color=Green><u>_</u></font><font color=Cyan>)</font> <font color=Red>-></font>
Left <font color=Cyan>(</font><font color=Magenta>"Parse error: in "</font><font color=Cyan>++</font>show p<font color=Cyan>++</font><font color=Magenta>"\n "</font>
<font color=Cyan>++</font>err<font color=Cyan>++</font><font color=Magenta>"\n "</font><font color=Cyan>++</font><font color=Magenta>"Found "</font><font color=Cyan>++</font>show t<font color=Cyan>)</font>
<font color=Cyan>)</font>
<font color=Blue>-- | If the parser fails, generate an error message.</font>
elserror <font color=Red>::</font> <font color=Cyan>(</font>Show p<font color=Cyan>,</font>Show t<font color=Cyan>)</font> <font color=Red>=></font> Parser s <font color=Cyan>(</font>p<font color=Cyan>,</font>t<font color=Cyan>)</font> String a <font color=Red>-></font> String
<font color=Red>-></font> Parser s <font color=Cyan>(</font>p<font color=Cyan>,</font>t<font color=Cyan>)</font> String a
<a name="elserror"></a>p <font color=Cyan>`elserror`</font> s <font color=Red>=</font> p <font color=Cyan>+++</font> parseerror s
<font color=Blue>--- State handling -----------------------------------------------------------</font>
<font color=Blue>-- | Update the internal state.</font>
stupd <font color=Red>::</font> <font color=Cyan>(</font>s<font color=Red>-></font>s<font color=Cyan>)</font> <font color=Red>-></font> Parser s t e <font color=Cyan>(</font><font color=Cyan>)</font>
<a name="stupd"></a>stupd f <font color=Red>=</font> P <font color=Cyan>(</font><font color=Red>\</font>st inp<font color=Red>-></font> <font color=Blue>{-let newst = f st in newst `seq`-}</font>
Right <font color=Red>[</font><font color=Cyan>(</font><font color=Cyan>(</font><font color=Cyan>)</font><font color=Cyan>,</font> f st<font color=Cyan>,</font> inp<font color=Cyan>)</font><font color=Red>]</font><font color=Cyan>)</font>
<font color=Blue>-- | Query the internal state.</font>
stquery <font color=Red>::</font> <font color=Cyan>(</font>s<font color=Red>-></font>a<font color=Cyan>)</font> <font color=Red>-></font> Parser s t e a
<a name="stquery"></a>stquery f <font color=Red>=</font> P <font color=Cyan>(</font><font color=Red>\</font>st inp<font color=Red>-></font> Right <font color=Red>[</font><font color=Cyan>(</font>f st<font color=Cyan>,</font> st<font color=Cyan>,</font> inp<font color=Cyan>)</font><font color=Red>]</font><font color=Cyan>)</font>
<font color=Blue>-- | Deliver the entire internal state.</font>
stget <font color=Red>::</font> Parser s t e s
<a name="stget"></a>stget <font color=Red>=</font> P <font color=Cyan>(</font><font color=Red>\</font>st inp<font color=Red>-></font> Right <font color=Red>[</font><font color=Cyan>(</font>st<font color=Cyan>,</font> st<font color=Cyan>,</font> inp<font color=Cyan>)</font><font color=Red>]</font><font color=Cyan>)</font>
<font color=Blue>--- Push some tokens back onto the input stream and reparse ------------------</font>
<font color=Blue>-- | This is useful for recursively expanding macros. When the</font>
<font color=Blue>-- user-parser recognises a macro use, it can lookup the macro</font>
<font color=Blue>-- expansion from the parse state, lex it, and then stuff the</font>
<font color=Blue>-- lexed expansion back down into the parser.</font>
reparse <font color=Red>::</font> <font color=Red>[</font>Either e t<font color=Red>]</font> <font color=Red>-></font> Parser s t e <font color=Cyan>(</font><font color=Cyan>)</font>
<a name="reparse"></a>reparse ts <font color=Red>=</font> P <font color=Cyan>(</font><font color=Red>\</font>st inp<font color=Red>-></font> Right <font color=Red>[</font><font color=Cyan>(</font><font color=Cyan>(</font><font color=Cyan>)</font><font color=Cyan>,</font> st<font color=Cyan>,</font> ts<font color=Cyan>++</font>inp<font color=Cyan>)</font><font color=Red>]</font><font color=Cyan>)</font>
<font color=Blue>------------------------------------------------------------------------------</font>
</pre>