polyparse-1.1: docs/haddock/src/Text/ParserCombinators/HuttonMeijerWallace.html
<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 3.2 Final//EN">
<html>
<pre><a name="(line1)"></a><font color=Blue>{-----------------------------------------------------------------------------
<a name="(line2)"></a>
<a name="(line3)"></a> A LIBRARY OF MONADIC PARSER COMBINATORS
<a name="(line4)"></a>
<a name="(line5)"></a> 29th July 1996
<a name="(line6)"></a>
<a name="(line7)"></a> Graham Hutton Erik Meijer
<a name="(line8)"></a> University of Nottingham University of Utrecht
<a name="(line9)"></a>
<a name="(line10)"></a>This Haskell 1.3 script defines a library of parser combinators, and is taken
<a name="(line11)"></a>from sections 1-6 of our article "Monadic Parser Combinators". Some changes
<a name="(line12)"></a>to the library have been made in the move from Gofer to Haskell:
<a name="(line13)"></a>
<a name="(line14)"></a> * Do notation is used in place of monad comprehension notation;
<a name="(line15)"></a>
<a name="(line16)"></a> * The parser datatype is defined using "newtype", to avoid the overhead
<a name="(line17)"></a> of tagging and untagging parsers with the P constructor.
<a name="(line18)"></a>
<a name="(line19)"></a>------------------------------------------------------------------------------
<a name="(line20)"></a>** Extended to allow a symbol table/state to be threaded through the monad.
<a name="(line21)"></a>** Extended to allow a parameterised token type, rather than just strings.
<a name="(line22)"></a>** Extended to allow error-reporting.
<a name="(line23)"></a>
<a name="(line24)"></a>(Extensions: 1998-2000 Malcolm.Wallace@cs.york.ac.uk)
<a name="(line25)"></a>(More extensions: 2004 gk-haskell@ninebynine.org)
<a name="(line26)"></a>
<a name="(line27)"></a>------------------------------------------------------------------------------}</font>
<a name="(line28)"></a>
<a name="(line29)"></a><font color=Blue>-- | This library of monadic parser combinators is based on the ones</font>
<a name="(line30)"></a><font color=Blue>-- defined by Graham Hutton and Erik Meijer. It has been extended by</font>
<a name="(line31)"></a><font color=Blue>-- Malcolm Wallace to use an abstract token type (no longer just a</font>
<a name="(line32)"></a><font color=Blue>-- string) as input, and to incorporate state in the monad, useful</font>
<a name="(line33)"></a><font color=Blue>-- for symbol tables, macros, and so on. Basic facilities for error</font>
<a name="(line34)"></a><font color=Blue>-- reporting have also been added, and later extended by Graham Klyne</font>
<a name="(line35)"></a><font color=Blue>-- to return the errors through an @Either@ type, rather than just</font>
<a name="(line36)"></a><font color=Blue>-- calling @error@.</font>
<a name="(line37)"></a>
<a name="(line38)"></a><font color=Green><u>module</u></font> Text<font color=Cyan>.</font>ParserCombinators<font color=Cyan>.</font>HuttonMeijerWallace
<a name="(line39)"></a> <font color=Cyan>(</font>
<a name="(line40)"></a> <font color=Blue>-- * The parser monad</font>
<a name="(line41)"></a> Parser<font color=Cyan>(</font><font color=Red>..</font><font color=Cyan>)</font>
<a name="(line42)"></a> <font color=Blue>-- * Primitive parser combinators</font>
<a name="(line43)"></a> <font color=Cyan>,</font> item<font color=Cyan>,</font> eof<font color=Cyan>,</font> papply<font color=Cyan>,</font> papply'
<a name="(line44)"></a> <font color=Blue>-- * Derived combinators</font>
<a name="(line45)"></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="(line46)"></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="(line47)"></a> <font color=Cyan>,</font> toEOF
<a name="(line48)"></a> <font color=Blue>-- * Error handling</font>
<a name="(line49)"></a> <font color=Cyan>,</font> elserror
<a name="(line50)"></a> <font color=Blue>-- * State handling</font>
<a name="(line51)"></a> <font color=Cyan>,</font> stupd<font color=Cyan>,</font> stquery<font color=Cyan>,</font> stget
<a name="(line52)"></a> <font color=Blue>-- * Re-parsing</font>
<a name="(line53)"></a> <font color=Cyan>,</font> reparse
<a name="(line54)"></a> <font color=Cyan>)</font> <font color=Green><u>where</u></font>
<a name="(line55)"></a>
<a name="(line56)"></a><font color=Green><u>import</u></font> Char
<a name="(line57)"></a><font color=Green><u>import</u></font> Monad
<a name="(line58)"></a>
<a name="(line59)"></a><font color=Green><u>infixr</u></font> <font color=Magenta>5</font> <font color=Cyan>+++</font>
<a name="(line60)"></a>
<a name="(line61)"></a><font color=Blue>--- The parser monad ---------------------------------------------------------</font>
<a name="(line62)"></a>
<a name="(line63)"></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="(line64)"></a>
<a name="(line65)"></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>-></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>
<a name="(line66)"></a> <font color=Blue>-- ^ The parser type is parametrised on the types of the state @s@,</font>
<a name="(line67)"></a> <font color=Blue>-- the input tokens @t@, error-type @e@, and the result value @a@.</font>
<a name="(line68)"></a> <font color=Blue>-- The state and remaining input are threaded through the monad.</font>
<a name="(line69)"></a>
<a name="(line70)"></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="(line71)"></a> <font color=Blue>-- fmap :: (a -> b) -> (Parser s t e a -> Parser s t e b)</font>
<a name="(line72)"></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>-></font> <font color=Green><u>case</u></font> p st inp <font color=Green><u>of</u></font>
<a name="(line73)"></a> 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>
<a name="(line74)"></a> Left err <font color=Red>-></font> Left err
<a name="(line75)"></a> <font color=Cyan>)</font>
<a name="(line76)"></a>
<a name="(line77)"></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="(line78)"></a> <font color=Blue>-- return :: a -> Parser s t e a</font>
<a name="(line79)"></a> 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>
<a name="(line80)"></a> <font color=Blue>-- >>= :: Parser s t e a -> (a -> Parser s t e b) -> Parser s t e b</font>
<a name="(line81)"></a> <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>
<a name="(line82)"></a> Right res <font color=Red>-></font> foldr joinresults <font color=Cyan>(</font>Right []<font color=Cyan>)</font>
<a name="(line83)"></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><-</font> res <font color=Red>]</font>
<a name="(line84)"></a> Left err <font color=Red>-></font> Left err
<a name="(line85)"></a> <font color=Cyan>)</font>
<a name="(line86)"></a> <font color=Blue>-- fail :: String -> Parser s t e a</font>
<a name="(line87)"></a> fail err <font color=Red>=</font> P <font color=Cyan>(</font><font color=Red>\</font>st inp <font color=Red>-></font> Right []<font color=Cyan>)</font>
<a name="(line88)"></a> <font color=Blue>-- I know it's counterintuitive, but we want no-parse, not an error.</font>
<a name="(line89)"></a>
<a name="(line90)"></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="(line91)"></a> <font color=Blue>-- mzero :: Parser s t e a</font>
<a name="(line92)"></a> mzero <font color=Red>=</font> P <font color=Cyan>(</font><font color=Red>\</font>st inp <font color=Red>-></font> Right []<font color=Cyan>)</font>
<a name="(line93)"></a> <font color=Blue>-- mplus :: Parser s t e a -> Parser s t e a -> Parser s t e a</font>
<a name="(line94)"></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>-></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="(line95)"></a>
<a name="(line96)"></a><a name="joinresults"></a><font color=Blue>-- joinresults ensures that explicitly raised errors are dominant,</font>
<a name="(line97)"></a><font color=Blue>-- provided no parse has yet been found. The commented out code is</font>
<a name="(line98)"></a><font color=Blue>-- a slightly stricter specification of the real code.</font>
<a name="(line99)"></a>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
<a name="(line100)"></a><font color=Blue>{-
<a name="(line101)"></a>joinresults (Left p) (Left q) = Left p
<a name="(line102)"></a>joinresults (Left p) (Right _) = Left p
<a name="(line103)"></a>joinresults (Right []) (Left q) = Left q
<a name="(line104)"></a>joinresults (Right p) (Left q) = Right p
<a name="(line105)"></a>joinresults (Right p) (Right q) = Right (p++q)
<a name="(line106)"></a>-}</font>
<a name="(line107)"></a>joinresults <font color=Cyan>(</font>Left p<font color=Cyan>)</font> q <font color=Red>=</font> Left p
<a name="(line108)"></a>joinresults <font color=Cyan>(</font>Right []<font color=Cyan>)</font> q <font color=Red>=</font> q
<a name="(line109)"></a>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> []
<a name="(line110)"></a> Right r <font color=Red>-></font> r<font color=Cyan>)</font>
<a name="(line111)"></a>
<a name="(line112)"></a>
<a name="(line113)"></a><font color=Blue>--- Primitive parser combinators ---------------------------------------------</font>
<a name="(line114)"></a>
<a name="(line115)"></a><a name="item"></a><font color=Blue>-- | Deliver the first remaining token.</font>
<a name="(line116)"></a>item <font color=Red>::</font> Parser s t e t
<a name="(line117)"></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>
<a name="(line118)"></a> [] <font color=Red>-></font> Right []
<a name="(line119)"></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>-></font> Left e
<a name="(line120)"></a> <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>
<a name="(line121)"></a> <font color=Cyan>)</font>
<a name="(line122)"></a>
<a name="(line123)"></a><a name="eof"></a><font color=Blue>-- | Fail if end of input is not reached</font>
<a name="(line124)"></a>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 ()
<a name="(line125)"></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>
<a name="(line126)"></a> [] <font color=Red>-></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="(line127)"></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>-></font> Left e
<a name="(line128)"></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>-></font> Left <font color=Cyan>(</font><font color=Magenta>"End of input expected at "</font>
<a name="(line129)"></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="(line130)"></a> <font color=Cyan>)</font>
<a name="(line131)"></a>
<a name="(line132)"></a><font color=Blue>{-
<a name="(line133)"></a>-- | Ensure the value delivered by the parser is evaluated to WHNF.
<a name="(line134)"></a>force :: Parser s t e a -> Parser s t e a
<a name="(line135)"></a>force (P p) = P (\st inp -> let Right xs = p st inp
<a name="(line136)"></a> h = head xs in
<a name="(line137)"></a> h `seq` Right (h: tail xs)
<a name="(line138)"></a> )
<a name="(line139)"></a>-- [[[GK]]] ^^^^^^
<a name="(line140)"></a>-- WHNF = Weak Head Normal Form, meaning that it has no top-level redex.
<a name="(line141)"></a>-- In this case, I think that means that the first element of the list
<a name="(line142)"></a>-- is fully evaluated.
<a name="(line143)"></a>--
<a name="(line144)"></a>-- NOTE: the original form of this function fails if there is no parse
<a name="(line145)"></a>-- result for p st inp (head xs fails if xs is null), so the modified
<a name="(line146)"></a>-- form can assume a Right value only.
<a name="(line147)"></a>--
<a name="(line148)"></a>-- Why is this needed?
<a name="(line149)"></a>-- It's not exported, and the only use of this I see is commented out.
<a name="(line150)"></a>---------------------------------------
<a name="(line151)"></a>-}</font>
<a name="(line152)"></a>
<a name="(line153)"></a>
<a name="(line154)"></a><a name="first"></a><font color=Blue>-- | Deliver the first parse result only, eliminating any backtracking.</font>
<a name="(line155)"></a>first <font color=Red>::</font> Parser s t e a <font color=Red>-></font> Parser s t e a
<a name="(line156)"></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>
<a name="(line157)"></a> 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>
<a name="(line158)"></a> otherwise <font color=Red>-></font> otherwise
<a name="(line159)"></a> <font color=Cyan>)</font>
<a name="(line160)"></a>
<a name="(line161)"></a><a name="papply"></a><font color=Blue>-- | Apply the parser to some real input, given an initial state value.</font>
<a name="(line162)"></a><font color=Blue>-- If the parser fails, raise 'error' to halt the program.</font>
<a name="(line163)"></a><font color=Blue>-- (This is the original exported behaviour - to allow the caller to</font>
<a name="(line164)"></a><font color=Blue>-- deal with the error differently, see @papply'@.)</font>
<a name="(line165)"></a>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>
<a name="(line166)"></a> <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="(line167)"></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>
<a name="(line168)"></a>
<a name="(line169)"></a><a name="papply'"></a><font color=Blue>-- | Apply the parser to some real input, given an initial state value.</font>
<a name="(line170)"></a><font color=Blue>-- If the parser fails, return a diagnostic message to the caller.</font>
<a name="(line171)"></a>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>
<a name="(line172)"></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="(line173)"></a>papply' <font color=Cyan>(</font>P p<font color=Cyan>)</font> st inp <font color=Red>=</font> p st inp
<a name="(line174)"></a>
<a name="(line175)"></a><font color=Blue>--- Derived combinators ------------------------------------------------------</font>
<a name="(line176)"></a>
<a name="(line177)"></a><a name="+++"></a><font color=Blue>-- | A choice between parsers. Keep only the first success.</font>
<a name="(line178)"></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="(line179)"></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>
<a name="(line180)"></a>
<a name="(line181)"></a><a name="sat"></a><font color=Blue>-- | Deliver the first token if it satisfies a predicate.</font>
<a name="(line182)"></a>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="(line183)"></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>
<a name="(line184)"></a>
<a name="(line185)"></a><a name="tok"></a><font color=Blue>-- | Deliver the first token if it equals the argument.</font>
<a name="(line186)"></a>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="(line187)"></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>
<a name="(line188)"></a>
<a name="(line189)"></a><a name="nottok"></a><font color=Blue>-- | Deliver the first token if it does not equal the argument.</font>
<a name="(line190)"></a>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="(line191)"></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
<a name="(line192)"></a> <font color=Green><u>else</u></font> mzero<font color=Cyan>}</font>
<a name="(line193)"></a>
<a name="(line194)"></a><a name="many"></a><font color=Blue>-- | Deliver zero or more values of @a@.</font>
<a name="(line195)"></a>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="(line196)"></a>many p <font color=Red>=</font> many1 p <font color=Cyan>+++</font> return []
<a name="(line197)"></a><font color=Blue>--many p = force (many1 p +++ return [])</font>
<a name="(line198)"></a>
<a name="(line199)"></a><a name="many1"></a><font color=Blue>-- | Deliver one or more values of @a@.</font>
<a name="(line200)"></a>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="(line201)"></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>
<a name="(line202)"></a>
<a name="(line203)"></a><a name="sepby"></a><font color=Blue>-- | Deliver zero or more values of @a@ separated by @b@'s.</font>
<a name="(line204)"></a>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="(line205)"></a><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 []
<a name="(line206)"></a>
<a name="(line207)"></a><a name="sepby1"></a><font color=Blue>-- | Deliver one or more values of @a@ separated by @b@'s.</font>
<a name="(line208)"></a>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="(line209)"></a><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>
<a name="(line210)"></a>
<a name="(line211)"></a><a name="chainl"></a>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
<a name="(line212)"></a> <font color=Red>-></font> Parser s t e a
<a name="(line213)"></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
<a name="(line214)"></a>
<a name="(line215)"></a><a name="chainl1"></a>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="(line216)"></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>
<a name="(line217)"></a> <font color=Green><u>where</u></font>
<a name="(line218)"></a> 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>
<a name="(line219)"></a> <font color=Cyan>+++</font> return x
<a name="(line220)"></a>
<a name="(line221)"></a><a name="chainr"></a>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
<a name="(line222)"></a> <font color=Red>-></font> Parser s t e a
<a name="(line223)"></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
<a name="(line224)"></a>
<a name="(line225)"></a><a name="chainr1"></a>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="(line226)"></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>
<a name="(line227)"></a> <font color=Green><u>where</u></font>
<a name="(line228)"></a> rest x <font color=Red>=</font> <font color=Green><u>do</u></font> <font color=Cyan>{</font> f <font color=Red><-</font> op
<a name="(line229)"></a> <font color=Cyan>;</font> y <font color=Red><-</font> p <font color=Cyan>`chainr1`</font> op
<a name="(line230)"></a> <font color=Cyan>;</font> return <font color=Cyan>(</font>f x y<font color=Cyan>)</font>
<a name="(line231)"></a> <font color=Cyan>}</font>
<a name="(line232)"></a> <font color=Cyan>+++</font> return x
<a name="(line233)"></a>
<a name="(line234)"></a><a name="ops"></a>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="(line235)"></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>
<a name="(line236)"></a>
<a name="(line237)"></a><a name="bracket"></a>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>
<a name="(line238)"></a> 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>
<a name="(line239)"></a> 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="(line240)"></a>bracket open p close <font color=Red>=</font> <font color=Green><u>do</u></font> <font color=Cyan>{</font> open
<a name="(line241)"></a> <font color=Cyan>;</font> x <font color=Red><-</font> p
<a name="(line242)"></a> <font color=Cyan>;</font> close <font color=Blue>-- `elserror` "improperly matched construct";</font>
<a name="(line243)"></a> <font color=Cyan>;</font> return x
<a name="(line244)"></a> <font color=Cyan>}</font>
<a name="(line245)"></a>
<a name="(line246)"></a><a name="toEOF"></a><font color=Blue>-- | Accept a complete parse of the input only, no partial parses.</font>
<a name="(line247)"></a>toEOF <font color=Red>::</font> Show p <font color=Red>=></font>
<a name="(line248)"></a> 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="(line249)"></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>
<a name="(line250)"></a>
<a name="(line251)"></a>
<a name="(line252)"></a><font color=Blue>--- Error handling -----------------------------------------------------------</font>
<a name="(line253)"></a>
<a name="(line254)"></a><a name="parseerror"></a><font color=Blue>-- | Return an error using the supplied diagnostic string, and a token type</font>
<a name="(line255)"></a><font color=Blue>-- which includes position information.</font>
<a name="(line256)"></a>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="(line257)"></a>parseerror err <font color=Red>=</font> P <font color=Cyan>(</font><font color=Red>\</font>st inp <font color=Red>-></font>
<a name="(line258)"></a> <font color=Green><u>case</u></font> inp <font color=Green><u>of</u></font>
<a name="(line259)"></a> [] <font color=Red>-></font> Left <font color=Magenta>"Parse error: unexpected EOF\n"</font>
<a name="(line260)"></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>-></font> Left <font color=Cyan>(</font><font color=Magenta>"Lexical error: "</font><font color=Cyan>++</font>e<font color=Cyan>)</font>
<a name="(line261)"></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>-></font>
<a name="(line262)"></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="(line263)"></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="(line264)"></a> <font color=Cyan>)</font>
<a name="(line265)"></a>
<a name="(line266)"></a>
<a name="(line267)"></a><a name="elserror"></a><font color=Blue>-- | If the parser fails, generate an error message.</font>
<a name="(line268)"></a>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
<a name="(line269)"></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="(line270)"></a><a name="elserror"></a>p <font color=Cyan>`elserror`</font> s <font color=Red>=</font> p <font color=Cyan>+++</font> parseerror s
<a name="(line271)"></a>
<a name="(line272)"></a><font color=Blue>--- State handling -----------------------------------------------------------</font>
<a name="(line273)"></a>
<a name="(line274)"></a><a name="stupd"></a><font color=Blue>-- | Update the internal state.</font>
<a name="(line275)"></a>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 ()
<a name="(line276)"></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>
<a name="(line277)"></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="(line278)"></a>
<a name="(line279)"></a><a name="stquery"></a><font color=Blue>-- | Query the internal state.</font>
<a name="(line280)"></a>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="(line281)"></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>
<a name="(line282)"></a>
<a name="(line283)"></a><a name="stget"></a><font color=Blue>-- | Deliver the entire internal state.</font>
<a name="(line284)"></a>stget <font color=Red>::</font> Parser s t e s
<a name="(line285)"></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>
<a name="(line286)"></a>
<a name="(line287)"></a>
<a name="(line288)"></a><font color=Blue>--- Push some tokens back onto the input stream and reparse ------------------</font>
<a name="(line289)"></a>
<a name="(line290)"></a><a name="reparse"></a><font color=Blue>-- | This is useful for recursively expanding macros. When the</font>
<a name="(line291)"></a><font color=Blue>-- user-parser recognises a macro use, it can lookup the macro</font>
<a name="(line292)"></a><font color=Blue>-- expansion from the parse state, lex it, and then stuff the</font>
<a name="(line293)"></a><font color=Blue>-- lexed expansion back down into the parser.</font>
<a name="(line294)"></a>reparse <font color=Red>::</font> <font color=Red>[</font>Either e t<font color=Red>]</font> <font color=Red>-></font> Parser s t e ()
<a name="(line295)"></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> 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="(line296)"></a>
<a name="(line297)"></a><font color=Blue>------------------------------------------------------------------------------</font>
</pre>
</html>