packages feed

polyparse-1.2: docs/haddock/src/Text/ParserCombinators/HuttonMeijerWallace.html

<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 3.2 Final//EN">
<html>
<head>
<!-- Generated by HsColour, http://www.cs.york.ac.uk/fp/darcs/hscolour/ -->
<title>src/Text/ParserCombinators/HuttonMeijerWallace.hs</title>
</head>
<body>
<pre><a name="line-1"></a><font color=Blue>{-----------------------------------------------------------------------------
<a name="line-2"></a>
<a name="line-3"></a>                 A LIBRARY OF MONADIC PARSER COMBINATORS
<a name="line-4"></a>
<a name="line-5"></a>                              29th July 1996
<a name="line-6"></a>
<a name="line-7"></a>                 Graham Hutton               Erik Meijer
<a name="line-8"></a>            University of Nottingham    University of Utrecht
<a name="line-9"></a>
<a name="line-10"></a>This Haskell 1.3 script defines a library of parser combinators, and is taken
<a name="line-11"></a>from sections 1-6 of our article "Monadic Parser Combinators".  Some changes
<a name="line-12"></a>to the library have been made in the move from Gofer to Haskell:
<a name="line-13"></a>
<a name="line-14"></a>   * Do notation is used in place of monad comprehension notation;
<a name="line-15"></a>
<a name="line-16"></a>   * The parser datatype is defined using "newtype", to avoid the overhead
<a name="line-17"></a>     of tagging and untagging parsers with the P constructor.
<a name="line-18"></a>
<a name="line-19"></a>------------------------------------------------------------------------------
<a name="line-20"></a>** Extended to allow a symbol table/state to be threaded through the monad.
<a name="line-21"></a>** Extended to allow a parameterised token type, rather than just strings.
<a name="line-22"></a>** Extended to allow error-reporting.
<a name="line-23"></a>
<a name="line-24"></a>(Extensions: 1998-2000 Malcolm.Wallace@cs.york.ac.uk)
<a name="line-25"></a>(More extensions: 2004 gk-haskell@ninebynine.org)
<a name="line-26"></a>
<a name="line-27"></a>------------------------------------------------------------------------------}</font>
<a name="line-28"></a>
<a name="line-29"></a><font color=Blue>-- | This library of monadic parser combinators is based on the ones</font>
<a name="line-30"></a><font color=Blue>--   defined by Graham Hutton and Erik Meijer.  It has been extended by</font>
<a name="line-31"></a><font color=Blue>--   Malcolm Wallace to use an abstract token type (no longer just a</font>
<a name="line-32"></a><font color=Blue>--   string) as input, and to incorporate state in the monad, useful</font>
<a name="line-33"></a><font color=Blue>--   for symbol tables, macros, and so on.  Basic facilities for error</font>
<a name="line-34"></a><font color=Blue>--   reporting have also been added, and later extended by Graham Klyne</font>
<a name="line-35"></a><font color=Blue>--   to return the errors through an @Either@ type, rather than just</font>
<a name="line-36"></a><font color=Blue>--   calling @error@.</font>
<a name="line-37"></a>
<a name="line-38"></a><font color=Green><u>module</u></font> Text<font color=Cyan>.</font>ParserCombinators<font color=Cyan>.</font>HuttonMeijerWallace
<a name="line-39"></a>  <font color=Cyan>(</font>
<a name="line-40"></a>  <font color=Blue>-- * The parser monad</font>
<a name="line-41"></a>    Parser<font color=Cyan>(</font><font color=Red>..</font><font color=Cyan>)</font>
<a name="line-42"></a>  <font color=Blue>-- * Primitive parser combinators</font>
<a name="line-43"></a>  <font color=Cyan>,</font> item<font color=Cyan>,</font> eof<font color=Cyan>,</font> papply<font color=Cyan>,</font> papply'
<a name="line-44"></a>  <font color=Blue>-- * Derived combinators</font>
<a name="line-45"></a>  <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
<a name="line-46"></a>  <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
<a name="line-47"></a>  <font color=Cyan>,</font> toEOF
<a name="line-48"></a>  <font color=Blue>-- * Error handling</font>
<a name="line-49"></a>  <font color=Cyan>,</font> elserror
<a name="line-50"></a>  <font color=Blue>-- * State handling</font>
<a name="line-51"></a>  <font color=Cyan>,</font> stupd<font color=Cyan>,</font> stquery<font color=Cyan>,</font> stget
<a name="line-52"></a>  <font color=Blue>-- * Re-parsing</font>
<a name="line-53"></a>  <font color=Cyan>,</font> reparse
<a name="line-54"></a>  <font color=Cyan>)</font> <font color=Green><u>where</u></font>
<a name="line-55"></a>
<a name="line-56"></a><font color=Green><u>import</u></font> Char
<a name="line-57"></a><font color=Green><u>import</u></font> Monad
<a name="line-58"></a>
<a name="line-59"></a><font color=Green><u>infixr</u></font> <font color=Magenta>5</font> <font color=Cyan>+++</font>
<a name="line-60"></a>
<a name="line-61"></a><font color=Blue>--- The parser monad ---------------------------------------------------------</font>
<a name="line-62"></a>
<a name="line-63"></a><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>
<a name="line-64"></a>
<a name="line-65"></a><a name="Parser"></a><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>-&gt;</font> <font color=Red>[</font>Either e t<font color=Red>]</font> <font color=Red>-&gt;</font> ParseResult s t e a <font color=Cyan>)</font>
<a name="line-66"></a>    <font color=Blue>-- ^ The parser type is parametrised on the types of the state @s@,</font>
<a name="line-67"></a>    <font color=Blue>--   the input tokens @t@, error-type @e@, and the result value @a@.</font>
<a name="line-68"></a>    <font color=Blue>--   The state and remaining input are threaded through the monad.</font>
<a name="line-69"></a>
<a name="line-70"></a><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>
<a name="line-71"></a>   <font color=Blue>-- fmap        :: (a -&gt; b) -&gt; (Parser s t e a -&gt; Parser s t e b)</font>
<a name="line-72"></a>   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>-&gt;</font> <font color=Green><u>case</u></font> p st inp <font color=Green><u>of</u></font>
<a name="line-73"></a>                        Right res <font color=Red>-&gt;</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>&lt;-</font> res<font color=Red>]</font>
<a name="line-74"></a>                        Left err  <font color=Red>-&gt;</font> Left err
<a name="line-75"></a>                       <font color=Cyan>)</font>
<a name="line-76"></a>
<a name="line-77"></a><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>
<a name="line-78"></a>   <font color=Blue>-- return      :: a -&gt; Parser s t e a</font>
<a name="line-79"></a>   return v        <font color=Red>=</font> P <font color=Cyan>(</font><font color=Red>\</font>st inp <font color=Red>-&gt;</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>
<a name="line-80"></a>   <font color=Blue>-- &gt;&gt;=         :: Parser s t e a -&gt; (a -&gt; Parser s t e b) -&gt; Parser s t e b</font>
<a name="line-81"></a>   <font color=Cyan>(</font>P p<font color=Cyan>)</font> <font color=Cyan>&gt;&gt;=</font> f     <font color=Red>=</font> P <font color=Cyan>(</font><font color=Red>\</font>st inp <font color=Red>-&gt;</font> <font color=Green><u>case</u></font> p st inp <font color=Green><u>of</u></font>
<a name="line-82"></a>                        Right res <font color=Red>-&gt;</font> foldr joinresults <font color=Cyan>(</font>Right []<font color=Cyan>)</font>
<a name="line-83"></a>                            <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>&lt;-</font> res <font color=Red>]</font>
<a name="line-84"></a>                        Left err  <font color=Red>-&gt;</font> Left err
<a name="line-85"></a>                       <font color=Cyan>)</font>
<a name="line-86"></a>   <font color=Blue>-- fail        :: String -&gt; Parser s t e a</font>
<a name="line-87"></a>   fail err        <font color=Red>=</font> P <font color=Cyan>(</font><font color=Red>\</font>st inp <font color=Red>-&gt;</font> Right []<font color=Cyan>)</font>
<a name="line-88"></a>  <font color=Blue>-- I know it's counterintuitive, but we want no-parse, not an error.</font>
<a name="line-89"></a>
<a name="line-90"></a><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>
<a name="line-91"></a>   <font color=Blue>-- mzero       :: Parser s t e a</font>
<a name="line-92"></a>   mzero           <font color=Red>=</font> P <font color=Cyan>(</font><font color=Red>\</font>st inp <font color=Red>-&gt;</font> Right []<font color=Cyan>)</font>
<a name="line-93"></a>   <font color=Blue>-- mplus       :: Parser s t e a -&gt; Parser s t e a -&gt; Parser s t e a</font>
<a name="line-94"></a>   <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>-&gt;</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>
<a name="line-95"></a>
<a name="line-96"></a><a name="joinresults"></a><font color=Blue>-- joinresults ensures that explicitly raised errors are dominant,</font>
<a name="line-97"></a><font color=Blue>-- provided no parse has yet been found.  The commented out code is</font>
<a name="line-98"></a><font color=Blue>-- a slightly stricter specification of the real code.</font>
<a name="line-99"></a><font color=Blue>joinresults</font> <font color=Red>::</font> ParseResult s t e a <font color=Red>-&gt;</font> ParseResult s t e a <font color=Red>-&gt;</font> ParseResult s t e a
<a name="line-100"></a><font color=Blue>{-
<a name="line-101"></a>joinresults (Left  p)  (Left  q)  = Left  p
<a name="line-102"></a>joinresults (Left  p)  (Right _)  = Left  p
<a name="line-103"></a>joinresults (Right []) (Left  q)  = Left  q
<a name="line-104"></a>joinresults (Right p)  (Left  q)  = Right p
<a name="line-105"></a>joinresults (Right p)  (Right q)  = Right (p++q)
<a name="line-106"></a>-}</font>
<a name="line-107"></a><font color=Blue>joinresults</font> <font color=Cyan>(</font>Left  p<font color=Cyan>)</font>  q  <font color=Red>=</font> Left p
<a name="line-108"></a><font color=Blue>joinresults</font> <font color=Cyan>(</font>Right []<font color=Cyan>)</font> q  <font color=Red>=</font> q
<a name="line-109"></a><font color=Blue>joinresults</font> <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>-&gt;</font> []
<a name="line-110"></a>                                                 Right r <font color=Red>-&gt;</font> r<font color=Cyan>)</font>
<a name="line-111"></a>
<a name="line-112"></a>
<a name="line-113"></a><font color=Blue>--- Primitive parser combinators ---------------------------------------------</font>
<a name="line-114"></a>
<a name="line-115"></a><a name="item"></a><font color=Blue>-- | Deliver the first remaining token.</font>
<a name="line-116"></a><font color=Blue>item</font>              <font color=Red>::</font> Parser s t e t
<a name="line-117"></a><font color=Blue>item</font>               <font color=Red>=</font> P <font color=Cyan>(</font><font color=Red>\</font>st inp <font color=Red>-&gt;</font> <font color=Green><u>case</u></font> inp <font color=Green><u>of</u></font>
<a name="line-118"></a>                        []            <font color=Red>-&gt;</font> Right []
<a name="line-119"></a>                        <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>-&gt;</font> Left e
<a name="line-120"></a>                        <font color=Cyan>(</font>Right x<font color=Red><b>:</b></font> xs<font color=Cyan>)</font> <font color=Red>-&gt;</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>
<a name="line-121"></a>                       <font color=Cyan>)</font>
<a name="line-122"></a>
<a name="line-123"></a><a name="eof"></a><font color=Blue>-- | Fail if end of input is not reached</font>
<a name="line-124"></a><font color=Blue>eof</font>               <font color=Red>::</font> Show p <font color=Red>=&gt;</font> Parser s <font color=Cyan>(</font>p<font color=Cyan>,</font>t<font color=Cyan>)</font> String ()
<a name="line-125"></a><font color=Blue>eof</font>                <font color=Red>=</font> P <font color=Cyan>(</font><font color=Red>\</font>st inp <font color=Red>-&gt;</font> <font color=Green><u>case</u></font> inp <font color=Green><u>of</u></font>
<a name="line-126"></a>                        []         <font color=Red>-&gt;</font> Right <font color=Red>[</font><font color=Cyan>(</font>()<font color=Cyan>,</font>st<font color=Cyan>,</font>[]<font color=Cyan>)</font><font color=Red>]</font>
<a name="line-127"></a>                        <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>-&gt;</font> Left e
<a name="line-128"></a>                        <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>-&gt;</font> Left <font color=Cyan>(</font><font color=Magenta>"End of input expected at "</font>
<a name="line-129"></a>                                                 <font color=Cyan>++</font>show p<font color=Cyan>++</font><font color=Magenta>"\n  but found text"</font><font color=Cyan>)</font>
<a name="line-130"></a>                       <font color=Cyan>)</font>
<a name="line-131"></a>
<a name="line-132"></a><font color=Blue>{-
<a name="line-133"></a>-- | Ensure the value delivered by the parser is evaluated to WHNF.
<a name="line-134"></a>force             :: Parser s t e a -&gt; Parser s t e a
<a name="line-135"></a>force (P p)        = P (\st inp -&gt; let Right xs = p st inp
<a name="line-136"></a>                                       h = head xs in
<a name="line-137"></a>                                   h `seq` Right (h: tail xs)
<a name="line-138"></a>                       )
<a name="line-139"></a>--  [[[GK]]]  ^^^^^^
<a name="line-140"></a>--  WHNF = Weak Head Normal Form, meaning that it has no top-level redex.
<a name="line-141"></a>--  In this case, I think that means that the first element of the list
<a name="line-142"></a>--  is fully evaluated.
<a name="line-143"></a>--
<a name="line-144"></a>--  NOTE:  the original form of this function fails if there is no parse
<a name="line-145"></a>--  result for p st inp (head xs fails if xs is null), so the modified
<a name="line-146"></a>--  form can assume a Right value only.
<a name="line-147"></a>--
<a name="line-148"></a>--  Why is this needed?
<a name="line-149"></a>--  It's not exported, and the only use of this I see is commented out.
<a name="line-150"></a>---------------------------------------
<a name="line-151"></a>-}</font>
<a name="line-152"></a>
<a name="line-153"></a>
<a name="line-154"></a><a name="first"></a><font color=Blue>-- | Deliver the first parse result only, eliminating any backtracking.</font>
<a name="line-155"></a><font color=Blue>first</font>             <font color=Red>::</font> Parser s t e a <font color=Red>-&gt;</font> Parser s t e a
<a name="line-156"></a><font color=Blue>first</font> <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>-&gt;</font> <font color=Green><u>case</u></font> p st inp <font color=Green><u>of</u></font>
<a name="line-157"></a>                                   Right <font color=Cyan>(</font>x<font color=Red><b>:</b></font>xs<font color=Cyan>)</font> <font color=Red>-&gt;</font> Right <font color=Red>[</font>x<font color=Red>]</font>
<a name="line-158"></a>                                   otherwise    <font color=Red>-&gt;</font> otherwise
<a name="line-159"></a>                       <font color=Cyan>)</font>
<a name="line-160"></a>
<a name="line-161"></a><a name="papply"></a><font color=Blue>-- | Apply the parser to some real input, given an initial state value.</font>
<a name="line-162"></a><font color=Blue>--   If the parser fails, raise 'error' to halt the program.</font>
<a name="line-163"></a><font color=Blue>--   (This is the original exported behaviour - to allow the caller to</font>
<a name="line-164"></a><font color=Blue>--   deal with the error differently, see @papply'@.)</font>
<a name="line-165"></a><font color=Blue>papply</font>            <font color=Red>::</font> Parser s t String a <font color=Red>-&gt;</font> s <font color=Red>-&gt;</font> <font color=Red>[</font>Either String t<font color=Red>]</font>
<a name="line-166"></a>                                              <font color=Red>-&gt;</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="line-167"></a><font color=Blue>papply</font> <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>
<a name="line-168"></a>
<a name="line-169"></a><a name="papply'"></a><font color=Blue>-- | Apply the parser to some real input, given an initial state value.</font>
<a name="line-170"></a><font color=Blue>--   If the parser fails, return a diagnostic message to the caller.</font>
<a name="line-171"></a><font color=Blue>papply'</font>           <font color=Red>::</font> Parser s t e a <font color=Red>-&gt;</font> s <font color=Red>-&gt;</font> <font color=Red>[</font>Either e t<font color=Red>]</font>
<a name="line-172"></a>                                         <font color=Red>-&gt;</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="line-173"></a><font color=Blue>papply'</font> <font color=Cyan>(</font>P p<font color=Cyan>)</font> st inp <font color=Red>=</font> p st inp
<a name="line-174"></a>
<a name="line-175"></a><font color=Blue>--- Derived combinators ------------------------------------------------------</font>
<a name="line-176"></a>
<a name="line-177"></a><a name="+++"></a><font color=Blue>-- | A choice between parsers.  Keep only the first success.</font>
<a name="line-178"></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>-&gt;</font> Parser s t e a <font color=Red>-&gt;</font> Parser s t e a
<a name="line-179"></a><a name="p"></a><font color=Blue>p</font> <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>
<a name="line-180"></a>
<a name="line-181"></a><a name="sat"></a><font color=Blue>-- | Deliver the first token if it satisfies a predicate.</font>
<a name="line-182"></a><font color=Blue>sat</font>               <font color=Red>::</font> <font color=Cyan>(</font>t <font color=Red>-&gt;</font> Bool<font color=Cyan>)</font> <font color=Red>-&gt;</font> Parser s <font color=Cyan>(</font>p<font color=Cyan>,</font>t<font color=Cyan>)</font> e t
<a name="line-183"></a><font color=Blue>sat</font> 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>&lt;-</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>
<a name="line-184"></a>
<a name="line-185"></a><a name="tok"></a><font color=Blue>-- | Deliver the first token if it equals the argument.</font>
<a name="line-186"></a><font color=Blue>tok</font>               <font color=Red>::</font> Eq t <font color=Red>=&gt;</font> t <font color=Red>-&gt;</font> Parser s <font color=Cyan>(</font>p<font color=Cyan>,</font>t<font color=Cyan>)</font> e t
<a name="line-187"></a><font color=Blue>tok</font> 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>&lt;-</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>
<a name="line-188"></a>
<a name="line-189"></a><a name="nottok"></a><font color=Blue>-- | Deliver the first token if it does not equal the argument.</font>
<a name="line-190"></a><font color=Blue>nottok</font>            <font color=Red>::</font> Eq t <font color=Red>=&gt;</font> <font color=Red>[</font>t<font color=Red>]</font> <font color=Red>-&gt;</font> Parser s <font color=Cyan>(</font>p<font color=Cyan>,</font>t<font color=Cyan>)</font> e t
<a name="line-191"></a><font color=Blue>nottok</font> 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>&lt;-</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
<a name="line-192"></a>                                        <font color=Green><u>else</u></font> mzero<font color=Cyan>}</font>
<a name="line-193"></a>
<a name="line-194"></a><a name="many"></a><font color=Blue>-- | Deliver zero or more values of @a@.</font>
<a name="line-195"></a><font color=Blue>many</font>              <font color=Red>::</font> Parser s t e a <font color=Red>-&gt;</font> Parser s t e <font color=Red>[</font>a<font color=Red>]</font>
<a name="line-196"></a><font color=Blue>many</font> p             <font color=Red>=</font> many1 p <font color=Cyan>+++</font> return []
<a name="line-197"></a><font color=Blue>--many p           = force (many1 p +++ return [])</font>
<a name="line-198"></a>
<a name="line-199"></a><a name="many1"></a><font color=Blue>-- | Deliver one or more values of @a@.</font>
<a name="line-200"></a><font color=Blue>many1</font>             <font color=Red>::</font> Parser s t e a <font color=Red>-&gt;</font> Parser s t e <font color=Red>[</font>a<font color=Red>]</font>
<a name="line-201"></a><font color=Blue>many1</font> p            <font color=Red>=</font> <font color=Green><u>do</u></font> <font color=Cyan>{</font>x <font color=Red>&lt;-</font> p<font color=Cyan>;</font> xs <font color=Red>&lt;-</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>
<a name="line-202"></a>
<a name="line-203"></a><a name="sepby"></a><font color=Blue>-- | Deliver zero or more values of @a@ separated by @b@'s.</font>
<a name="line-204"></a><font color=Blue>sepby</font>             <font color=Red>::</font> Parser s t e a <font color=Red>-&gt;</font> Parser s t e b <font color=Red>-&gt;</font> Parser s t e <font color=Red>[</font>a<font color=Red>]</font>
<a name="line-205"></a><a name="sepby"></a><font color=Blue>p</font> <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 []
<a name="line-206"></a>
<a name="line-207"></a><a name="sepby1"></a><font color=Blue>-- | Deliver one or more values of @a@ separated by @b@'s.</font>
<a name="line-208"></a><font color=Blue>sepby1</font>            <font color=Red>::</font> Parser s t e a <font color=Red>-&gt;</font> Parser s t e b <font color=Red>-&gt;</font> Parser s t e <font color=Red>[</font>a<font color=Red>]</font>
<a name="line-209"></a><a name="sepby1"></a><font color=Blue>p</font> <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>&lt;-</font> p<font color=Cyan>;</font> xs <font color=Red>&lt;-</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>
<a name="line-210"></a>
<a name="line-211"></a><a name="chainl"></a><font color=Blue>chainl</font>            <font color=Red>::</font> Parser s t e a <font color=Red>-&gt;</font> Parser s t e <font color=Cyan>(</font>a<font color=Red>-&gt;</font>a<font color=Red>-&gt;</font>a<font color=Cyan>)</font> <font color=Red>-&gt;</font> a
<a name="line-212"></a>                                                              <font color=Red>-&gt;</font> Parser s t e a
<a name="line-213"></a><font color=Blue>chainl</font> 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
<a name="line-214"></a>
<a name="line-215"></a><a name="chainl1"></a><font color=Blue>chainl1</font>           <font color=Red>::</font> Parser s t e a <font color=Red>-&gt;</font> Parser s t e <font color=Cyan>(</font>a<font color=Red>-&gt;</font>a<font color=Red>-&gt;</font>a<font color=Cyan>)</font> <font color=Red>-&gt;</font> Parser s t e a
<a name="line-216"></a><a name="chainl1"></a><font color=Blue>p</font> <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>&lt;-</font> p<font color=Cyan>;</font> rest x<font color=Cyan>}</font>
<a name="line-217"></a>                     <font color=Green><u>where</u></font>
<a name="line-218"></a>                        rest x <font color=Red>=</font> <font color=Green><u>do</u></font> <font color=Cyan>{</font>f <font color=Red>&lt;-</font> op<font color=Cyan>;</font> y <font color=Red>&lt;-</font> p<font color=Cyan>;</font> rest <font color=Cyan>(</font>f x y<font color=Cyan>)</font><font color=Cyan>}</font>
<a name="line-219"></a>                                 <font color=Cyan>+++</font> return x
<a name="line-220"></a>
<a name="line-221"></a><a name="chainr"></a><font color=Blue>chainr</font>            <font color=Red>::</font> Parser s t e a <font color=Red>-&gt;</font> Parser s t e <font color=Cyan>(</font>a<font color=Red>-&gt;</font>a<font color=Red>-&gt;</font>a<font color=Cyan>)</font> <font color=Red>-&gt;</font> a
<a name="line-222"></a>                                                              <font color=Red>-&gt;</font> Parser s t e a
<a name="line-223"></a><font color=Blue>chainr</font> 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
<a name="line-224"></a>
<a name="line-225"></a><a name="chainr1"></a><font color=Blue>chainr1</font>           <font color=Red>::</font> Parser s t e a <font color=Red>-&gt;</font> Parser s t e <font color=Cyan>(</font>a<font color=Red>-&gt;</font>a<font color=Red>-&gt;</font>a<font color=Cyan>)</font> <font color=Red>-&gt;</font> Parser s t e a
<a name="line-226"></a><a name="chainr1"></a><font color=Blue>p</font> <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>&lt;-</font> p<font color=Cyan>;</font> rest x<font color=Cyan>}</font>
<a name="line-227"></a>                     <font color=Green><u>where</u></font>
<a name="line-228"></a>                        rest x <font color=Red>=</font> <font color=Green><u>do</u></font> <font color=Cyan>{</font> f <font color=Red>&lt;-</font> op
<a name="line-229"></a>                                    <font color=Cyan>;</font> y <font color=Red>&lt;-</font> p <font color=Cyan>`chainr1`</font> op
<a name="line-230"></a>                                    <font color=Cyan>;</font> return <font color=Cyan>(</font>f x y<font color=Cyan>)</font>
<a name="line-231"></a>                                    <font color=Cyan>}</font>
<a name="line-232"></a>                                 <font color=Cyan>+++</font> return x
<a name="line-233"></a>
<a name="line-234"></a><a name="ops"></a><font color=Blue>ops</font>               <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>-&gt;</font> Parser s t e b
<a name="line-235"></a><font color=Blue>ops</font> 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>&lt;-</font> xs<font color=Red>]</font>
<a name="line-236"></a>
<a name="line-237"></a><a name="bracket"></a><font color=Blue>bracket</font>           <font color=Red>::</font> <font color=Cyan>(</font>Show p<font color=Cyan>,</font>Show t<font color=Cyan>)</font> <font color=Red>=&gt;</font>
<a name="line-238"></a>                     Parser s <font color=Cyan>(</font>p<font color=Cyan>,</font>t<font color=Cyan>)</font> e a <font color=Red>-&gt;</font> Parser s <font color=Cyan>(</font>p<font color=Cyan>,</font>t<font color=Cyan>)</font> e b <font color=Red>-&gt;</font>
<a name="line-239"></a>                               Parser s <font color=Cyan>(</font>p<font color=Cyan>,</font>t<font color=Cyan>)</font> e c <font color=Red>-&gt;</font> Parser s <font color=Cyan>(</font>p<font color=Cyan>,</font>t<font color=Cyan>)</font> e b
<a name="line-240"></a><font color=Blue>bracket</font> open p close <font color=Red>=</font> <font color=Green><u>do</u></font> <font color=Cyan>{</font> open
<a name="line-241"></a>                          <font color=Cyan>;</font> x <font color=Red>&lt;-</font> p
<a name="line-242"></a>                          <font color=Cyan>;</font> close <font color=Blue>-- `elserror` "improperly matched construct";</font>
<a name="line-243"></a>                          <font color=Cyan>;</font> return x
<a name="line-244"></a>                          <font color=Cyan>}</font>
<a name="line-245"></a>
<a name="line-246"></a><a name="toEOF"></a><font color=Blue>-- | Accept a complete parse of the input only, no partial parses.</font>
<a name="line-247"></a><font color=Blue>toEOF</font>             <font color=Red>::</font> Show p <font color=Red>=&gt;</font>
<a name="line-248"></a>                     Parser s <font color=Cyan>(</font>p<font color=Cyan>,</font>t<font color=Cyan>)</font> String a <font color=Red>-&gt;</font> Parser s <font color=Cyan>(</font>p<font color=Cyan>,</font>t<font color=Cyan>)</font> String a
<a name="line-249"></a><font color=Blue>toEOF</font> p            <font color=Red>=</font> <font color=Green><u>do</u></font> <font color=Cyan>{</font> x <font color=Red>&lt;-</font> p<font color=Cyan>;</font> eof<font color=Cyan>;</font> return x <font color=Cyan>}</font>
<a name="line-250"></a>
<a name="line-251"></a>
<a name="line-252"></a><font color=Blue>--- Error handling -----------------------------------------------------------</font>
<a name="line-253"></a>
<a name="line-254"></a><a name="parseerror"></a><font color=Blue>-- | Return an error using the supplied diagnostic string, and a token type</font>
<a name="line-255"></a><font color=Blue>--   which includes position information.</font>
<a name="line-256"></a><font color=Blue>parseerror</font> <font color=Red>::</font> <font color=Cyan>(</font>Show p<font color=Cyan>,</font>Show t<font color=Cyan>)</font> <font color=Red>=&gt;</font> String <font color=Red>-&gt;</font> Parser s <font color=Cyan>(</font>p<font color=Cyan>,</font>t<font color=Cyan>)</font> String a
<a name="line-257"></a><font color=Blue>parseerror</font> err <font color=Red>=</font> P <font color=Cyan>(</font><font color=Red>\</font>st inp <font color=Red>-&gt;</font>
<a name="line-258"></a>                         <font color=Green><u>case</u></font> inp <font color=Green><u>of</u></font>
<a name="line-259"></a>                           [] <font color=Red>-&gt;</font> Left <font color=Magenta>"Parse error: unexpected EOF\n"</font>
<a name="line-260"></a>                           <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>-&gt;</font> Left <font color=Cyan>(</font><font color=Magenta>"Lexical error:  "</font><font color=Cyan>++</font>e<font color=Cyan>)</font>
<a name="line-261"></a>                           <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>-&gt;</font>
<a name="line-262"></a>                                 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>
<a name="line-263"></a>                                       <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>
<a name="line-264"></a>                   <font color=Cyan>)</font>
<a name="line-265"></a>
<a name="line-266"></a>
<a name="line-267"></a><a name="elserror"></a><font color=Blue>-- | If the parser fails, generate an error message.</font>
<a name="line-268"></a><font color=Blue>elserror</font>          <font color=Red>::</font> <font color=Cyan>(</font>Show p<font color=Cyan>,</font>Show t<font color=Cyan>)</font> <font color=Red>=&gt;</font> Parser s <font color=Cyan>(</font>p<font color=Cyan>,</font>t<font color=Cyan>)</font> String a <font color=Red>-&gt;</font> String
<a name="line-269"></a>                                        <font color=Red>-&gt;</font> Parser s <font color=Cyan>(</font>p<font color=Cyan>,</font>t<font color=Cyan>)</font> String a
<a name="line-270"></a><a name="elserror"></a><font color=Blue>p</font> <font color=Cyan>`elserror`</font> s     <font color=Red>=</font> p <font color=Cyan>+++</font> parseerror s
<a name="line-271"></a>
<a name="line-272"></a><font color=Blue>--- State handling -----------------------------------------------------------</font>
<a name="line-273"></a>
<a name="line-274"></a><a name="stupd"></a><font color=Blue>-- | Update the internal state.</font>
<a name="line-275"></a><font color=Blue>stupd</font>      <font color=Red>::</font> <font color=Cyan>(</font>s<font color=Red>-&gt;</font>s<font color=Cyan>)</font> <font color=Red>-&gt;</font> Parser s t e ()
<a name="line-276"></a><font color=Blue>stupd</font> f     <font color=Red>=</font> P <font color=Cyan>(</font><font color=Red>\</font>st inp<font color=Red>-&gt;</font> <font color=Blue>{-let newst = f st in newst `seq`-}</font>
<a name="line-277"></a>                           Right <font color=Red>[</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>
<a name="line-278"></a>
<a name="line-279"></a><a name="stquery"></a><font color=Blue>-- | Query the internal state.</font>
<a name="line-280"></a><font color=Blue>stquery</font>    <font color=Red>::</font> <font color=Cyan>(</font>s<font color=Red>-&gt;</font>a<font color=Cyan>)</font> <font color=Red>-&gt;</font> Parser s t e a
<a name="line-281"></a><font color=Blue>stquery</font> f   <font color=Red>=</font> P <font color=Cyan>(</font><font color=Red>\</font>st inp<font color=Red>-&gt;</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>
<a name="line-282"></a>
<a name="line-283"></a><a name="stget"></a><font color=Blue>-- | Deliver the entire internal state.</font>
<a name="line-284"></a><font color=Blue>stget</font>      <font color=Red>::</font> Parser s t e s
<a name="line-285"></a><font color=Blue>stget</font>       <font color=Red>=</font> P <font color=Cyan>(</font><font color=Red>\</font>st inp<font color=Red>-&gt;</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>
<a name="line-286"></a>
<a name="line-287"></a>
<a name="line-288"></a><font color=Blue>--- Push some tokens back onto the input stream and reparse ------------------</font>
<a name="line-289"></a>
<a name="line-290"></a><a name="reparse"></a><font color=Blue>-- | This is useful for recursively expanding macros.  When the</font>
<a name="line-291"></a><font color=Blue>--   user-parser recognises a macro use, it can lookup the macro</font>
<a name="line-292"></a><font color=Blue>--   expansion from the parse state, lex it, and then stuff the</font>
<a name="line-293"></a><font color=Blue>--   lexed expansion back down into the parser.</font>
<a name="line-294"></a><font color=Blue>reparse</font>    <font color=Red>::</font> <font color=Red>[</font>Either e t<font color=Red>]</font> <font color=Red>-&gt;</font> Parser s t e ()
<a name="line-295"></a><font color=Blue>reparse</font> ts  <font color=Red>=</font> P <font color=Cyan>(</font><font color=Red>\</font>st inp<font color=Red>-&gt;</font> Right <font color=Red>[</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>
<a name="line-296"></a>
<a name="line-297"></a><font color=Blue>------------------------------------------------------------------------------</font>
</pre>
</body>
</html>