Thanks Daniel!<br>Things are getting more in shape, yet I still can not fully comprehend the expression:<br><br>((p &gt;*&gt; pList p) `build` (uncurry (:)))<br><br>where<br><br>&nbsp;(&gt;*&gt;) :: Parse a b -&gt; Parse a c -&gt; Parse a (b, c)
<br>&nbsp;(&gt;*&gt;) p1 p2 inp = [((x,y), rem2) |(x, rem1) &lt;- p1 inp, (y, rem2) &lt;- p2 rem1]<br><br>&nbsp;build :: Parse a b -&gt; (b -&gt; c) -&gt; Parse a c<br>&nbsp;build p f inp = [ (f x, rem) | (x, rem) &lt;- p inp]<br><br>So in fact recursive application:
<br><br>p &gt;*&gt; pList p<br><br>should unfold in something like:<br><br>((p &gt;*&gt; p) &gt;*&gt; p) &gt;*&gt; p ...<br><br>and *all*&nbsp; iterations of <br><br>p &gt;*&gt; pList p<br><br>will be done *before* &#39;build&#39; will be applied?
<br><br>Correct?<br><br>Thanks,<br>Dima<br><br><div><span class="gmail_quote">On 3/26/07, <b class="gmail_sendername">Daniel Fischer</b> &lt;<a href="mailto:daniel.is.fischer@web.de">daniel.is.fischer@web.de</a>&gt; wrote:
</span><blockquote class="gmail_quote" style="border-left: 1px solid rgb(204, 204, 204); margin: 0pt 0pt 0pt 0.8ex; padding-left: 1ex;">&gt; -----Ursprüngliche Nachricht-----<br>&gt; Von: &quot;Dmitri O.Kondratiev&quot; &lt;
<a href="mailto:dokondr@gmail.com">dokondr@gmail.com</a>&gt;<br>&gt; Gesendet: 26.03.07 16:44:12<br>&gt; An: <a href="mailto:haskell-cafe@haskell.org">haskell-cafe@haskell.org</a><br>&gt; Betreff: [Haskell-cafe] Newbie: a parser for a list of objects?
<br><br>&gt; Please see my questions inside comments {-- --} :<br>&gt; Thanks!<br>&gt;<br>&gt; ---<br>&gt; module Parser where<br>&gt;<br>&gt; import Data.Char<br>&gt;<br>&gt; type Parse a b = [a] -&gt; [(b, [a])]<br>&gt;
<br>&gt; {--<br>&gt; Newbie: a parser for a list of objects?<br>&gt;<br>&gt; I am working with the section&nbsp;&nbsp;17.5 &quot;Case study: parsing expressions&quot; of the book &quot;Haskell The Craft of Functional Programming&quot;, where a parser for a list of objects is defined.
<br>&gt; I called this function pList in order to avoid confusion with &#39;list&#39; as a term for data structure.<br>&gt;<br>&gt; Please help me to understand how pList works (please, see the rest of the code at the end of this message):
<br>&gt; --}<br>&gt;<br>&gt; pList :: Parse a b -&gt; Parse a [b]<br>&gt; pList p = (succeed []) `alt`<br>&gt;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;((p &gt;*&gt; pList p) `build` (uncurry (:)))<br>&gt;<br>&gt;<br>&gt; {--<br>&gt; First of all, I don&#39;t quite understand why there must be a choice (&#39;alt&#39;) between the function (&#39;succeed&#39;) that always returns an empty list and the other part? This results in adding [] to the front, why?
<br>&gt;<br><br>Well, if the parser p doesn&#39;t succeed, we don&#39;t want the whole thing to fail. And p will (almost certainly) fail when the end of input is reached.<br>So without the alternative &#39;succeed []&#39;, we&#39;d get
<br><br>pL1 dig &quot;12&quot;&nbsp;&nbsp;= [((&#39;1&#39;:y),rem) | (y,rem) &lt;- pL1 dig &quot;2&quot;]<br>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; = [((&#39;1&#39;:y),rem) | (y,rem) &lt;- [((&#39;2&#39;:z),rem2) | (z,rem2) &lt;- pL1 dig &quot;&quot;]]
<br>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; = [((&#39;1&#39;:y),rem) | (y,rem) &lt;- [((&#39;2&#39;:z),rem2) | (z,rem2) &lt;- []]<br>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; = [((&#39;1&#39;:y),rem) | (y,rem) &lt;- []]<br>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; = []<br><br>because dig &quot;&quot; = []
<br><br>&gt; I thought that &#39;simplified&#39; version of pList should still work fine. Trying to prove this I wrote :<br>&gt; --}<br>&gt;<br>&gt; pL1 :: Parse a b -&gt; Parse a [b]<br>&gt; pL1 p = (p &gt;*&gt; pL1 p) `build` (uncurry (:))
<br>&gt;<br>&gt; {--<br>&gt; Which, as expected, does not work correctly - just gives an empty list [] -&nbsp;&nbsp;but I don&#39;t understand why:<br><br>because the parser eventually fails when the end of input is reached.<br>&gt;
<br>&gt; *Parser&gt; t1 &quot;12345&quot;<br>&gt; []<br>&gt; *Parser&gt;<br>&gt;<br>&gt; Also, I don&#39;t understand why the textbook version of pList gives this result:<br>&gt;<br>&gt; *Parser&gt; test &quot;12345&quot;
<br>&gt; [(&quot;&quot;,&quot;12345&quot;),(&quot;1&quot;,&quot;2345&quot;),(&quot;12&quot;,&quot;345&quot;),(&quot;123&quot;,&quot;45&quot;),(&quot;1234&quot;,&quot;5&quot;),(&quot;12345&quot;,&quot;&quot;)]<br><br>That&#39;s because of the order of alt&#39;s arguments:
<br><br>(succeed [] `alt` p) inp = [([],inp)] ++ (p inp)<br><br>with pList p = ((p &gt;*&gt; pList p) `build` (uncurry (:))) `alt` succeed []<br>the resulting list woulde be reversed.<br><br>&gt;<br>&gt; *Parser&gt;<br>&gt;
<br>&gt; In particular, I don&#39;t understand where the first element (&quot;&quot;,&quot;12345&quot;) of the resulting list comes from?<br>&gt;<br>&gt; I am trying to figure out how pList recursively unfolds. To my mind operators in the expression:
<br>&gt;<br>&gt;<br>&gt; (succeed []) `alt`((p &gt;*&gt; pList p) `build` (uncurry (:)))<br>&gt;<br>&gt; has the following execution order:<br>&gt; 1)&nbsp;&nbsp;&gt;*&gt;<br>&gt; 2) &#39;build&#39;<br>&gt; 3) &#39;alt&#39;<br>&gt;
<br>No, the first argument of alt gets evaluated first, because (p1 `alt` p2) inp = (p1 inp) ++ (p2 inp), thus we need p1 inp first.<br>Then we see we haven&#39;t hit bottom, so we need the second argument of (++) (resp. alt).
<br>So next we need to evaluate p, then pList p, combine the results of those with the second argument of build, uncurry (:).<br><br>&gt; It seems that operation &gt;*&gt; should be done as many times as many elements the input list has. Right?
<br>&gt;<br><br>Unfortunately not. Let&#39;s stay with pList dig. Say your input starts with n digits.<br>From the example above you can conjecture that length (pList dig inp) == (n+1).<br>Now in the outermost (dig &gt;*&gt; pList dig) branch, you apply (pList dig) to an input beginning with (n-1) digits, returning a list of length n,
<br>to each element of this list you adjoin the first digit, resulting in n + (n-1) + ... + 1 = n*(n+1)/2 applications of (&gt;*&gt;).<br>(Lesson: you need an exclusive choice, using the second parser only if the first one fails and a maximal munch combinator in your library, too)
<br><br>&gt;<br>&gt; Signature:<br>&gt;<br>&gt; (&gt;*&gt;) :: Parse a b -&gt; Parse a c -&gt; Parse a (b, c)<br>&gt;<br>&gt; implies that second argument of the expression:<br>&gt;<br>&gt; p &gt;*&gt; pList p<br>&gt;<br>
&gt; should be of type &#39;Parse a c&#39; but in this application it is of type &#39;Parse a b -&gt; Parse a [b]&#39;<br>&gt;<br>c is [b], so p &gt;*&gt; pList p has type Parse a (b,[b]), then<br>(p &gt;*&gt; pList p) `build` (uncurry (:)) has type Parse a [b]
<br><br>&gt; How can that be?<br>&gt; How recursion termination conditinon is expressed in pList?<br><br>recursion terminates when p fails.<br><br>HTH,<br>Daniel<br><br>&gt; --}<br>&gt;<br>&gt; none :: Parse a b<br>&gt; none inp = []
<br>&gt;<br>&gt; succeed :: b -&gt; Parse a b<br>&gt; succeed val inp = [(val, inp)]<br>&gt;<br>&gt; suc:: b -&gt; [a] -&gt; [(b, [a])]<br>&gt;<br>&gt; suc val inp = [(val, inp)]<br>&gt;<br>&gt; spot :: (a -&gt; Bool) -&gt; Parse a a
<br>&gt; spot p [] = []<br>&gt; spot p (x:xs)<br>&gt;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;| p x = [(x, xs)]<br>&gt;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;| otherwise = []<br>&gt;<br>&gt; alt :: Parse a b -&gt; Parse a b -&gt; Parse a b<br>&gt; alt p1 p2 inp = p1 inp ++ p2 inp<br>&gt;<br>
&gt; bracket = spot (==&#39;(&#39;)<br>&gt; dash = spot (== &#39;-&#39;)<br>&gt; dig = spot isDigit<br>&gt; alpha = spot isAlpha<br>&gt;<br>&gt; infixr 5 &gt;*&gt;<br>&gt;<br>&gt; (&gt;*&gt;) :: Parse a b -&gt; Parse a c -&gt; Parse a (b, c)
<br>&gt;<br>&gt; (&gt;*&gt;) p1 p2 inp = [((x,y), rem2) |(x, rem1) &lt;- p1 inp, (y, rem2) &lt;- p2 rem1]<br>&gt;<br>&gt; build :: Parse a b -&gt; (b -&gt; c) -&gt; Parse a c<br>&gt; build p f inp = [ (f x, rem) | (x, rem) &lt;- p inp]
<br>&gt;<br>&gt; test = pList dig<br>&gt; t1 = pL1 dig<br>&gt;<br>&gt;<br>&gt; -----------------------------------------------------------------<br><br><br></blockquote></div><br>