tag:blogger.com,1999:blog-14455456510315733012024-03-12T18:59:33.901-07:00Ambassador to the ComputersMostly OCaml.Jake Donhamhttp://www.blogger.com/profile/04768087689799941690noreply@blogger.comBlogger27125tag:blogger.com,1999:blog-1445545651031573301.post-73260076862889408582011-06-08T20:41:00.000-07:002011-06-08T21:11:30.331-07:00Logic programming in Scala, part 3: unification and state<p>In this post I want to build on the backtracking logic monad we covered <a href='/2011/04/logic-programming-in-scala-part-2.html'>last time</a> by adding <em>unification</em>, yielding an embedded DSL for Prolog-style logic programming.</p>
<b>Prolog</b>
<p>Here is a small Prolog example, the rough equivalent of <code>List.contains</code> in Scala:</p>
<div class='highlight'><pre><code class='prolog'> <span class='nf'>member</span><span class='p'>(</span><span class='nv'>X</span><span class='p'>,</span> <span class='p'>[</span><span class='nv'>X</span><span class='p'>|</span><span class='nv'>T</span><span class='p'>]).</span>
<span class='nf'>member</span><span class='p'>(</span><span class='nv'>X</span><span class='p'>,</span> <span class='p'>[</span><span class='k'>_</span><span class='p'>|</span><span class='nv'>T</span><span class='p'>])</span> <span class='p'>:-</span> <span class='nf'>member</span><span class='p'>(</span><span class='nv'>X</span><span class='p'>,</span> <span class='nv'>T</span><span class='p'>).</span>
</code></pre>
</div>
<p><code>Member</code> doesn’t return a boolean; instead it succeeds or fails (in the same way as the logic monad). The <em>goal</em> <code>member(1, [1,2,3])</code> succeeds; the goal <code>member(4, [1,2,3])</code> fails. (What happens for <code>member(1, [1,1,3])</code>?)</p>
<p>A Prolog <em>predicate</em> is defined by one or more <em>clauses</em> (each ending in a period), made up of a <em>head</em> (the predicate and arguments before the <code>:-</code>) and zero or more <em>subgoals</em> (goals after the <code>:-</code>, separated by commas; if there are no subgoals the <code>:-</code> is omitted). To solve a goal, we <em>unify</em> it (match it) with each clause head, then solve each subgoal in the clause. If a subgoal fails we backtrack and try the next matching head; if there is no matching head the goal fails. A goal may succeed more than once.</p>
<p>For <code>member</code> we have two clauses: the first says that <code>member</code> succeeds if <code>X</code> is the head of the list (<code>[X|T]</code> is the same as <code>x::t</code> in Scala); the second says that <code>member</code> succeeds if <code>X</code> is a member of the tail of the list, regardless of the head. There is no clause where the list is empty (written <code>[]</code>); a goal with an empty list fails since there is no matching clause head.</p>
<p>Prolog unification is more expressive than pattern matching as found in Scala, OCaml, etc. Both sides of a unification may contain variables; unification attempts to instantiate them so that the two sides are equal. Variables are instantiated by <em>terms</em>, which themselves may contain variables; unification finds the most general instantiation which makes the sides equal.</p>
<p>As a small example of this expressivity, we can run <code>member</code> “backwards”: the goal <code>member(X, [1,2,3])</code> succeeds once for each element of the list, with <code>X</code> bound to the element.</p>
<p>There is much more on Prolog and logic programming in <a href='http://www.cs.cmu.edu/~fp/courses/lp/lectures/lp-all.pdf'>Frank Pfenning’s course notes</a>, which I recommend highly.</p>
<b>Unification</b>
<p>For each type we want to use in unification we’ll define a corresponding type of terms, which have the same structure as the underlying type but can also contain variables. These aren’t Scala variables (which of course can’t be stored in a data structure) but “existential variables”, or <em>evars</em>. Evars are just tags; computations will carry an <em>environment</em> mapping evars to terms, which may be updated after a successful unification.</p>
<div class='highlight'><pre><code class='scala'><span class='k'>import</span> <span class='nn'>scala.collection.immutable.</span><span class='o'>{</span><span class='nc'>Map</span><span class='o'>,</span><span class='nc'>HashMap</span><span class='o'>}</span>
<span class='k'>class</span> <span class='nc'>Evar</span><span class='o'>[</span><span class='kt'>A</span><span class='o'>](</span><span class='k'>val</span> <span class='n'>name</span><span class='k'>:</span> <span class='kt'>String</span><span class='o'>)</span>
<span class='k'>object</span> <span class='nc'>Evar</span> <span class='o'>{</span> <span class='k'>def</span> <span class='n'>apply</span><span class='o'>[</span><span class='kt'>A</span><span class='o'>](</span><span class='n'>name</span><span class='k'>:</span> <span class='kt'>String</span><span class='o'>)</span> <span class='k'>=</span> <span class='k'>new</span> <span class='nc'>Evar</span><span class='o'>[</span><span class='kt'>A</span><span class='o'>](</span><span class='n'>name</span><span class='o'>)</span> <span class='o'>}</span>
<span class='k'>trait</span> <span class='nc'>Term</span><span class='o'>[</span><span class='kt'>A</span><span class='o'>]</span> <span class='o'>{</span>
<span class='c1'>// invariant: on call to unify, this and t have e substituted</span>
<span class='k'>def</span> <span class='n'>unify</span><span class='o'>(</span><span class='n'>e</span><span class='k'>:</span> <span class='kt'>Env</span><span class='o'>,</span> <span class='n'>t</span><span class='k'>:</span> <span class='kt'>Term</span><span class='o'>[</span><span class='kt'>A</span><span class='o'>])</span><span class='k'>:</span> <span class='kt'>Option</span><span class='o'>[</span><span class='kt'>Env</span><span class='o'>]</span>
<span class='k'>def</span> <span class='n'>occurs</span><span class='o'>[</span><span class='kt'>B</span><span class='o'>](</span><span class='n'>v</span><span class='k'>:</span> <span class='kt'>Evar</span><span class='o'>[</span><span class='kt'>B</span><span class='o'>])</span><span class='k'>:</span> <span class='kt'>Boolean</span>
<span class='k'>def</span> <span class='n'>subst</span><span class='o'>(</span><span class='n'>e</span><span class='k'>:</span> <span class='kt'>Env</span><span class='o'>)</span><span class='k'>:</span> <span class='kt'>Term</span><span class='o'>[</span><span class='kt'>A</span><span class='o'>]</span>
<span class='k'>def</span> <span class='n'>ground</span><span class='k'>:</span> <span class='kt'>A</span>
<span class='o'>}</span>
</code></pre>
</div>
<p>The important property of an evar is that it is distinct from every other evar; the name attached to it is just a label. An evar is indexed by a phantom type indicating the underlying type of terms which may be bound to it.</p>
<p>A term is indexed by its underlying type. So <code>Int</code> becomes <code>Term[Int]</code>, <code>String</code> becomes <code>Term[String]</code>, and so on; an evar of type <code>Evar[A]</code> may only be bound to a term of type <code>Term[A]</code>. (Prolog is dynamically typed, but this statically-typed treatment of evars and terms fits better with Scala.)</p>
<p>The <code>unify</code> method unifies a term with another term of the same type, taking an environment and returning an updated environment (or <code>None</code> if the unification fails). <code>Occurs</code> checks if an evar occurs in a term (as we will see this is used to prevent circular bindings). <code>Subst</code> substitutes the variables in a term with their bindings in an environment, and <code>ground</code> returns the underlying Scala value represented by the term (provided the term contains no evars).</p>
<div class='highlight'><pre><code class='scala'><span class='k'>class</span> <span class='nc'>Env</span><span class='o'>(</span><span class='n'>m</span><span class='k'>:</span> <span class='kt'>Map</span><span class='o'>[</span><span class='kt'>Evar</span><span class='o'>[</span><span class='kt'>Any</span><span class='o'>]</span>,<span class='kt'>Term</span><span class='o'>[</span><span class='kt'>Any</span><span class='o'>]])</span> <span class='o'>{</span>
<span class='k'>def</span> <span class='n'>apply</span><span class='o'>[</span><span class='kt'>A</span><span class='o'>](</span><span class='n'>v</span><span class='k'>:</span> <span class='kt'>Evar</span><span class='o'>[</span><span class='kt'>A</span><span class='o'>])</span> <span class='k'>=</span>
<span class='n'>m</span><span class='o'>(</span><span class='n'>v</span><span class='o'>.</span><span class='n'>asInstanceOf</span><span class='o'>[</span><span class='kt'>Evar</span><span class='o'>[</span><span class='kt'>Any</span><span class='o'>]]).</span><span class='n'>asInstanceOf</span><span class='o'>[</span><span class='kt'>Term</span><span class='o'>[</span><span class='kt'>A</span><span class='o'>]]</span>
<span class='k'>def</span> <span class='n'>get</span><span class='o'>[</span><span class='kt'>A</span><span class='o'>](</span><span class='n'>v</span><span class='k'>:</span> <span class='kt'>Evar</span><span class='o'>[</span><span class='kt'>A</span><span class='o'>])</span><span class='k'>:</span> <span class='kt'>Option</span><span class='o'>[</span><span class='kt'>Term</span><span class='o'>[</span><span class='kt'>A</span><span class='o'>]]</span> <span class='k'>=</span>
<span class='n'>m</span><span class='o'>.</span><span class='n'>get</span><span class='o'>(</span><span class='n'>v</span><span class='o'>.</span><span class='n'>asInstanceOf</span><span class='o'>[</span><span class='kt'>Evar</span><span class='o'>[</span><span class='kt'>Any</span><span class='o'>]]).</span><span class='n'>asInstanceOf</span><span class='o'>[</span><span class='kt'>Option</span><span class='o'>[</span><span class='kt'>Term</span><span class='o'>[</span><span class='kt'>A</span><span class='o'>]]]</span>
<span class='k'>def</span> <span class='n'>updated</span><span class='o'>[</span><span class='kt'>A</span><span class='o'>](</span><span class='n'>v</span><span class='k'>:</span> <span class='kt'>Evar</span><span class='o'>[</span><span class='kt'>A</span><span class='o'>],</span> <span class='n'>t</span><span class='k'>:</span> <span class='kt'>Term</span><span class='o'>[</span><span class='kt'>A</span><span class='o'>])</span><span class='k'>:</span> <span class='kt'>Env</span> <span class='o'>=</span> <span class='o'>{</span>
<span class='k'>val</span> <span class='n'>v2</span> <span class='k'>=</span> <span class='n'>v</span><span class='o'>.</span><span class='n'>asInstanceOf</span><span class='o'>[</span><span class='kt'>Evar</span><span class='o'>[</span><span class='kt'>Any</span><span class='o'>]]</span>
<span class='k'>val</span> <span class='n'>t2</span> <span class='k'>=</span> <span class='n'>t</span><span class='o'>.</span><span class='n'>asInstanceOf</span><span class='o'>[</span><span class='kt'>Term</span><span class='o'>[</span><span class='kt'>Any</span><span class='o'>]]</span>
<span class='k'>val</span> <span class='n'>e2</span> <span class='k'>=</span> <span class='nc'>Env</span><span class='o'>(</span><span class='nc'>Map</span><span class='o'>(</span><span class='n'>v2</span> <span class='o'>-></span> <span class='n'>t2</span><span class='o'>))</span>
<span class='k'>val</span> <span class='n'>m2</span> <span class='k'>=</span> <span class='n'>m</span><span class='o'>.</span><span class='n'>mapValues</span><span class='o'>(</span><span class='n'>_</span><span class='o'>.</span><span class='n'>subst</span><span class='o'>(</span><span class='n'>e2</span><span class='o'>))</span>
<span class='nc'>Env</span><span class='o'>(</span><span class='n'>m2</span><span class='o'>.</span><span class='n'>updated</span><span class='o'>(</span><span class='n'>v2</span><span class='o'>,</span> <span class='n'>t2</span><span class='o'>))</span>
<span class='o'>}</span>
<span class='o'>}</span>
<span class='k'>object</span> <span class='nc'>Env</span> <span class='o'>{</span>
<span class='k'>def</span> <span class='n'>apply</span><span class='o'>(</span><span class='n'>m</span><span class='k'>:</span> <span class='kt'>Map</span><span class='o'>[</span><span class='kt'>Evar</span><span class='o'>[</span><span class='kt'>Any</span><span class='o'>]</span>,<span class='kt'>Term</span><span class='o'>[</span><span class='kt'>Any</span><span class='o'>]])</span> <span class='k'>=</span> <span class='k'>new</span> <span class='nc'>Env</span><span class='o'>(</span><span class='n'>m</span><span class='o'>)</span>
<span class='k'>def</span> <span class='n'>empty</span> <span class='k'>=</span> <span class='k'>new</span> <span class='nc'>Env</span><span class='o'>(</span><span class='nc'>HashMap</span><span class='o'>())</span>
<span class='o'>}</span>
</code></pre>
</div>
<p>An environment is just a map from evars to terms. Because we need to store evars and terms of different types in the same environment, we cast them to and from <code>Any</code>; this is safe because of the phantom type on <code>Evar</code>. For simplicity we maintain the invariant that the term bound to each evar is already substituted by the rest of the environment.</p>
<div class='highlight'><pre><code class='scala'><span class='k'>case</span> <span class='k'>class</span> <span class='nc'>VarTerm</span><span class='o'>[</span><span class='kt'>A</span><span class='o'>](</span><span class='n'>v</span><span class='k'>:</span> <span class='kt'>Evar</span><span class='o'>[</span><span class='kt'>A</span><span class='o'>])</span> <span class='k'>extends</span> <span class='nc'>Term</span><span class='o'>[</span><span class='kt'>A</span><span class='o'>]</span> <span class='o'>{</span>
<span class='k'>def</span> <span class='n'>unify</span><span class='o'>(</span><span class='n'>e</span><span class='k'>:</span> <span class='kt'>Env</span><span class='o'>,</span> <span class='n'>t</span><span class='k'>:</span> <span class='kt'>Term</span><span class='o'>[</span><span class='kt'>A</span><span class='o'>])</span> <span class='k'>=</span>
<span class='n'>t</span> <span class='k'>match</span> <span class='o'>{</span>
<span class='k'>case</span> <span class='nc'>VarTerm</span><span class='o'>(</span><span class='n'>v2</span><span class='o'>)</span> <span class='k'>if</span> <span class='o'>(</span><span class='n'>v2</span> <span class='o'>==</span> <span class='n'>v</span><span class='o'>)</span> <span class='k'>=></span> <span class='nc'>Some</span><span class='o'>(</span><span class='n'>e</span><span class='o'>)</span>
<span class='k'>case</span> <span class='k'>_</span> <span class='k'>=></span>
<span class='k'>if</span> <span class='o'>(</span><span class='n'>t</span><span class='o'>.</span><span class='n'>occurs</span><span class='o'>(</span><span class='n'>v</span><span class='o'>))</span> <span class='nc'>None</span>
<span class='k'>else</span> <span class='nc'>Some</span><span class='o'>(</span><span class='n'>e</span><span class='o'>.</span><span class='n'>updated</span><span class='o'>(</span><span class='n'>v</span><span class='o'>,</span> <span class='n'>t</span><span class='o'>))</span>
<span class='o'>}</span>
<span class='k'>def</span> <span class='n'>occurs</span><span class='o'>[</span><span class='kt'>B</span><span class='o'>](</span><span class='n'>v2</span><span class='k'>:</span> <span class='kt'>Evar</span><span class='o'>[</span><span class='kt'>B</span><span class='o'>])</span> <span class='k'>=</span> <span class='n'>v2</span> <span class='o'>==</span> <span class='n'>v</span>
<span class='k'>def</span> <span class='n'>subst</span><span class='o'>(</span><span class='n'>e</span><span class='k'>:</span> <span class='kt'>Env</span><span class='o'>)</span> <span class='k'>=</span>
<span class='n'>e</span><span class='o'>.</span><span class='n'>get</span><span class='o'>(</span><span class='n'>v</span><span class='o'>)</span> <span class='k'>match</span> <span class='o'>{</span>
<span class='k'>case</span> <span class='nc'>Some</span><span class='o'>(</span><span class='n'>t</span><span class='o'>)</span> <span class='k'>=></span> <span class='n'>t</span>
<span class='k'>case</span> <span class='nc'>None</span> <span class='k'>=></span> <span class='k'>this</span>
<span class='o'>}</span>
<span class='k'>def</span> <span class='n'>ground</span> <span class='k'>=</span>
<span class='k'>throw</span> <span class='k'>new</span> <span class='nc'>IllegalArgumentException</span><span class='o'>(</span><span class='s'>"not ground"</span><span class='o'>)</span>
<span class='k'>override</span> <span class='k'>def</span> <span class='n'>toString</span> <span class='k'>=</span> <span class='o'>{</span> <span class='n'>v</span><span class='o'>.</span><span class='n'>name</span> <span class='o'>}</span>
<span class='o'>}</span>
</code></pre>
</div>
<p>The <code>VarTerm</code> class represents terms consisting of an evar. To unify a <code>VarTerm</code> with another <code>VarTerm</code> containing the same evar, we just return the environment unchanged (since there is no new information). Otherwise we check that the evar doesn’t appear in the term (since a unification <code>x =:= List(x)</code> would create a circular term) then return the updated environment.</p>
<p>To substitute a <code>VarTerm</code> we return the term bound to the evar in the environment if one exists, otherwise the unsubstituted <code>VarTerm</code>. A <code>VarTerm</code> is never ground (we assume <code>ground</code> is called only on terms which are already substituted by the environment).</p>
<div class='highlight'><pre><code class='scala'><span class='k'>case</span> <span class='k'>class</span> <span class='nc'>LitTerm</span><span class='o'>[</span><span class='kt'>A</span><span class='o'>](</span><span class='n'>a</span><span class='k'>:</span> <span class='kt'>A</span><span class='o'>)</span> <span class='k'>extends</span> <span class='nc'>Term</span><span class='o'>[</span><span class='kt'>A</span><span class='o'>]</span> <span class='o'>{</span>
<span class='k'>def</span> <span class='n'>unify</span><span class='o'>(</span><span class='n'>e</span><span class='k'>:</span> <span class='kt'>Env</span><span class='o'>,</span> <span class='n'>t</span><span class='k'>:</span> <span class='kt'>Term</span><span class='o'>[</span><span class='kt'>A</span><span class='o'>])</span> <span class='k'>=</span>
<span class='n'>t</span> <span class='k'>match</span> <span class='o'>{</span>
<span class='k'>case</span> <span class='nc'>LitTerm</span><span class='o'>(</span><span class='n'>a2</span><span class='o'>)</span> <span class='k'>=></span> <span class='k'>if</span> <span class='o'>(</span><span class='n'>a</span> <span class='o'>==</span> <span class='n'>a2</span><span class='o'>)</span> <span class='nc'>Some</span><span class='o'>(</span><span class='n'>e</span><span class='o'>)</span> <span class='k'>else</span> <span class='nc'>None</span>
<span class='k'>case</span> <span class='n'>_:</span> <span class='nc'>VarTerm</span><span class='o'>[</span><span class='k'>_</span><span class='o'>]</span> <span class='k'>=></span> <span class='n'>t</span><span class='o'>.</span><span class='n'>unify</span><span class='o'>(</span><span class='n'>e</span><span class='o'>,</span> <span class='k'>this</span><span class='o'>)</span>
<span class='k'>case</span> <span class='k'>_</span> <span class='k'>=></span> <span class='nc'>None</span>
<span class='o'>}</span>
<span class='k'>def</span> <span class='n'>occurs</span><span class='o'>[</span><span class='kt'>B</span><span class='o'>](</span><span class='n'>v</span><span class='k'>:</span> <span class='kt'>Evar</span><span class='o'>[</span><span class='kt'>B</span><span class='o'>])</span> <span class='k'>=</span> <span class='kc'>false</span>
<span class='k'>def</span> <span class='n'>subst</span><span class='o'>(</span><span class='n'>e</span><span class='k'>:</span> <span class='kt'>Env</span><span class='o'>)</span> <span class='k'>=</span> <span class='k'>this</span>
<span class='k'>def</span> <span class='n'>ground</span> <span class='k'>=</span> <span class='n'>a</span>
<span class='k'>override</span> <span class='k'>def</span> <span class='n'>toString</span> <span class='k'>=</span> <span class='o'>{</span> <span class='n'>a</span><span class='o'>.</span><span class='n'>toString</span> <span class='o'>}</span>
<span class='o'>}</span>
</code></pre>
</div>
<p><code>LitTerm</code> represents terms of literal Scala values. A <code>LitTerm</code> unifies with another <code>LitTerm</code> containing an equal value, but that adds nothing to the environment. Then we have two cases which we need for every term type—to unify with a <code>VarTerm</code> call <code>unify</code> back on it; otherwise fail.</p>
<div class='highlight'><pre><code class='scala'><span class='k'>case</span> <span class='k'>class</span> <span class='nc'>NilTerm</span><span class='o'>[</span><span class='kt'>A</span><span class='o'>]()</span> <span class='k'>extends</span> <span class='nc'>Term</span><span class='o'>[</span><span class='kt'>List</span><span class='o'>[</span><span class='kt'>A</span><span class='o'>]]</span> <span class='o'>{</span>
<span class='k'>def</span> <span class='n'>unify</span><span class='o'>(</span><span class='n'>e</span><span class='k'>:</span> <span class='kt'>Env</span><span class='o'>,</span> <span class='n'>t</span><span class='k'>:</span> <span class='kt'>Term</span><span class='o'>[</span><span class='kt'>List</span><span class='o'>[</span><span class='kt'>A</span><span class='o'>]])</span> <span class='k'>=</span>
<span class='n'>t</span> <span class='k'>match</span> <span class='o'>{</span>
<span class='k'>case</span> <span class='nc'>NilTerm</span><span class='o'>()</span> <span class='k'>=></span> <span class='nc'>Some</span><span class='o'>(</span><span class='n'>e</span><span class='o'>)</span>
<span class='k'>case</span> <span class='n'>_:</span> <span class='nc'>VarTerm</span><span class='o'>[</span><span class='k'>_</span><span class='o'>]</span> <span class='k'>=></span> <span class='n'>t</span><span class='o'>.</span><span class='n'>unify</span><span class='o'>(</span><span class='n'>e</span><span class='o'>,</span> <span class='k'>this</span><span class='o'>)</span>
<span class='k'>case</span> <span class='k'>_</span> <span class='k'>=></span> <span class='nc'>None</span>
<span class='o'>}</span>
<span class='k'>def</span> <span class='n'>occurs</span><span class='o'>[</span><span class='kt'>B</span><span class='o'>](</span><span class='n'>v</span><span class='k'>:</span> <span class='kt'>Evar</span><span class='o'>[</span><span class='kt'>B</span><span class='o'>])</span> <span class='k'>=</span> <span class='kc'>false</span>
<span class='k'>def</span> <span class='n'>subst</span><span class='o'>(</span><span class='n'>e</span><span class='k'>:</span> <span class='kt'>Env</span><span class='o'>)</span> <span class='k'>=</span> <span class='k'>this</span>
<span class='k'>def</span> <span class='n'>ground</span> <span class='k'>=</span> <span class='nc'>Nil</span>
<span class='k'>override</span> <span class='k'>def</span> <span class='n'>toString</span> <span class='k'>=</span> <span class='o'>{</span> <span class='nc'>Nil</span><span class='o'>.</span><span class='n'>toString</span> <span class='o'>}</span>
<span class='o'>}</span>
<span class='k'>case</span> <span class='k'>class</span> <span class='nc'>ConsTerm</span><span class='o'>[</span><span class='kt'>A</span><span class='o'>](</span><span class='n'>hd</span><span class='k'>:</span> <span class='kt'>Term</span><span class='o'>[</span><span class='kt'>A</span><span class='o'>],</span> <span class='n'>tl</span><span class='k'>:</span> <span class='kt'>Term</span><span class='o'>[</span><span class='kt'>List</span><span class='o'>[</span><span class='kt'>A</span><span class='o'>]])</span>
<span class='k'>extends</span> <span class='nc'>Term</span><span class='o'>[</span><span class='kt'>List</span><span class='o'>[</span><span class='kt'>A</span><span class='o'>]]</span>
<span class='o'>{</span>
<span class='k'>def</span> <span class='n'>unify</span><span class='o'>(</span><span class='n'>e</span><span class='k'>:</span> <span class='kt'>Env</span><span class='o'>,</span> <span class='n'>t</span><span class='k'>:</span> <span class='kt'>Term</span><span class='o'>[</span><span class='kt'>List</span><span class='o'>[</span><span class='kt'>A</span><span class='o'>]])</span> <span class='k'>=</span>
<span class='n'>t</span> <span class='k'>match</span> <span class='o'>{</span>
<span class='k'>case</span> <span class='nc'>ConsTerm</span><span class='o'>(</span><span class='n'>hd2</span><span class='o'>,</span> <span class='n'>tl2</span><span class='o'>)</span> <span class='k'>=></span>
<span class='k'>for</span> <span class='o'>{</span>
<span class='n'>e1</span> <span class='k'><-</span> <span class='n'>hd</span><span class='o'>.</span><span class='n'>unify</span><span class='o'>(</span><span class='n'>e</span><span class='o'>,</span> <span class='n'>hd2</span><span class='o'>)</span>
<span class='n'>e2</span> <span class='k'><-</span> <span class='n'>tl</span><span class='o'>.</span><span class='n'>subst</span><span class='o'>(</span><span class='n'>e1</span><span class='o'>).</span><span class='n'>unify</span><span class='o'>(</span><span class='n'>e1</span><span class='o'>,</span> <span class='n'>tl2</span><span class='o'>.</span><span class='n'>subst</span><span class='o'>(</span><span class='n'>e1</span><span class='o'>))</span>
<span class='o'>}</span> <span class='k'>yield</span> <span class='n'>e2</span>
<span class='k'>case</span> <span class='n'>_:</span> <span class='nc'>VarTerm</span><span class='o'>[</span><span class='k'>_</span><span class='o'>]</span> <span class='k'>=></span> <span class='n'>t</span><span class='o'>.</span><span class='n'>unify</span><span class='o'>(</span><span class='n'>e</span><span class='o'>,</span> <span class='k'>this</span><span class='o'>)</span>
<span class='k'>case</span> <span class='k'>_</span> <span class='k'>=></span> <span class='nc'>None</span>
<span class='o'>}</span>
<span class='k'>def</span> <span class='n'>occurs</span><span class='o'>[</span><span class='kt'>C</span><span class='o'>](</span><span class='n'>v</span><span class='k'>:</span> <span class='kt'>Evar</span><span class='o'>[</span><span class='kt'>C</span><span class='o'>])</span> <span class='k'>=</span> <span class='n'>hd</span><span class='o'>.</span><span class='n'>occurs</span><span class='o'>(</span><span class='n'>v</span><span class='o'>)</span> <span class='o'>||</span> <span class='n'>tl</span><span class='o'>.</span><span class='n'>occurs</span><span class='o'>(</span><span class='n'>v</span><span class='o'>)</span>
<span class='k'>def</span> <span class='n'>subst</span><span class='o'>(</span><span class='n'>e</span><span class='k'>:</span> <span class='kt'>Env</span><span class='o'>)</span> <span class='k'>=</span> <span class='nc'>ConsTerm</span><span class='o'>(</span><span class='n'>hd</span><span class='o'>.</span><span class='n'>subst</span><span class='o'>(</span><span class='n'>e</span><span class='o'>),</span> <span class='n'>tl</span><span class='o'>.</span><span class='n'>subst</span><span class='o'>(</span><span class='n'>e</span><span class='o'>))</span>
<span class='k'>def</span> <span class='n'>ground</span> <span class='k'>=</span> <span class='n'>hd</span><span class='o'>.</span><span class='n'>ground</span> <span class='o'>::</span> <span class='n'>tl</span><span class='o'>.</span><span class='n'>ground</span>
<span class='k'>override</span> <span class='k'>def</span> <span class='n'>toString</span> <span class='k'>=</span> <span class='o'>{</span> <span class='n'>hd</span><span class='o'>.</span><span class='n'>toString</span> <span class='o'>+</span> <span class='s'>" :: "</span> <span class='o'>+</span> <span class='n'>tl</span><span class='o'>.</span><span class='n'>toString</span> <span class='o'>}</span>
<span class='o'>}</span>
</code></pre>
</div>
<p><code>NilTerm</code> and <code>ConsTerm</code> represent the <code>Nil</code> and <code>::</code> constructors for lists. <code>Nil</code> is sort of like a literal, so the methods for <code>NilTerm</code> are similar to those for <code>LitTerm</code>. For <code>ConsTerm</code> we unify by unifying the heads and tails, calling <code>subst</code> on the tails since unifying the heads may have added bindings to the environment. (Here it’s convenient to use a for-comprehension on the <code>Option[Env]</code> type since either unification may fail.) Similarly we implement <code>occurs</code>, <code>subst</code>, and <code>ground</code> by calling them on the head and tail.</p>
<div class='highlight'><pre><code class='scala'><span class='k'>object</span> <span class='nc'>Term</span> <span class='o'>{</span>
<span class='k'>implicit</span> <span class='k'>def</span> <span class='n'>var2Term</span><span class='o'>[</span><span class='kt'>A</span><span class='o'>](</span><span class='n'>v</span><span class='k'>:</span> <span class='kt'>Evar</span><span class='o'>[</span><span class='kt'>A</span><span class='o'>])</span><span class='k'>:</span> <span class='kt'>Term</span><span class='o'>[</span><span class='kt'>A</span><span class='o'>]</span> <span class='k'>=</span> <span class='nc'>VarTerm</span><span class='o'>(</span><span class='n'>v</span><span class='o'>)</span>
<span class='c1'>//implicit def lit2term[A](a: A): Term[A] = LitTerm(a)</span>
<span class='k'>implicit</span> <span class='k'>def</span> <span class='n'>int2Term</span><span class='o'>(</span><span class='n'>a</span><span class='k'>:</span> <span class='kt'>Int</span><span class='o'>)</span><span class='k'>:</span> <span class='kt'>Term</span><span class='o'>[</span><span class='kt'>Int</span><span class='o'>]</span> <span class='k'>=</span> <span class='nc'>LitTerm</span><span class='o'>(</span><span class='n'>a</span><span class='o'>)</span>
<span class='k'>implicit</span> <span class='k'>def</span> <span class='n'>list2Term</span><span class='o'>[</span><span class='kt'>A</span><span class='o'>](</span><span class='n'>l</span><span class='k'>:</span> <span class='kt'>List</span><span class='o'>[</span><span class='kt'>Term</span><span class='o'>[</span><span class='kt'>A</span><span class='o'>]])</span><span class='k'>:</span> <span class='kt'>Term</span><span class='o'>[</span><span class='kt'>List</span><span class='o'>[</span><span class='kt'>A</span><span class='o'>]]</span> <span class='k'>=</span>
<span class='n'>l</span> <span class='k'>match</span> <span class='o'>{</span>
<span class='k'>case</span> <span class='nc'>Nil</span> <span class='k'>=></span> <span class='nc'>NilTerm</span><span class='o'>[</span><span class='kt'>A</span><span class='o'>]</span>
<span class='k'>case</span> <span class='n'>hd</span> <span class='o'>::</span> <span class='n'>tl</span> <span class='k'>=></span> <span class='nc'>ConsTerm</span><span class='o'>(</span><span class='n'>hd</span><span class='o'>,</span> <span class='n'>list2Term</span><span class='o'>(</span><span class='n'>tl</span><span class='o'>))</span>
<span class='o'>}</span>
<span class='o'>}</span>
</code></pre>
</div>
<p>Finally we have some implicit conversions to make it a little easier to build <code>Term</code> values. The <code>lit2term</code> conversion turned out to be a bad idea; in particular you don’t want a <code>LitTerm[List[A]]</code> since it doesn’t unify with a <code>ConsTerm[A]</code> or <code>NilTerm[A]</code>.</p>
<b>State</b>
<p>In order to combine unification with backtracking, we need to keep track of the environment along each branch of the tree of choices. We don’t want the environments from different branches to interfere, so it’s convenient to use a purely functional environment representation; we pass the current environment down the tree as computation proceeds. However, we can hide this state passing in the monad interface:</p>
<div class='highlight'><pre><code class='scala'><span class='k'>trait</span> <span class='nc'>LogicState</span> <span class='o'>{</span> <span class='n'>L</span> <span class='k'>=></span>
<span class='k'>type</span> <span class='kt'>T</span><span class='o'>[</span><span class='kt'>S</span>,<span class='kt'>A</span><span class='o'>]</span>
<span class='c1'>// as before</span>
<span class='k'>def</span> <span class='n'>split</span><span class='o'>[</span><span class='kt'>S</span>,<span class='kt'>A</span><span class='o'>](</span><span class='n'>s</span><span class='k'>:</span> <span class='kt'>S</span><span class='o'>,</span> <span class='n'>t</span><span class='k'>:</span> <span class='kt'>T</span><span class='o'>[</span><span class='kt'>S</span>,<span class='kt'>A</span><span class='o'>])</span><span class='k'>:</span> <span class='kt'>Option</span><span class='o'>[(</span><span class='kt'>S</span>,<span class='kt'>A</span>,<span class='kt'>T</span><span class='o'>[</span><span class='kt'>S</span>,<span class='kt'>A</span><span class='o'>])]</span>
<span class='k'>def</span> <span class='n'>get</span><span class='o'>[</span><span class='kt'>S</span><span class='o'>]</span><span class='k'>:</span> <span class='kt'>T</span><span class='o'>[</span><span class='kt'>S</span>,<span class='kt'>S</span><span class='o'>]</span>
<span class='k'>def</span> <span class='n'>set</span><span class='o'>[</span><span class='kt'>S</span><span class='o'>](</span><span class='n'>s</span><span class='k'>:</span> <span class='kt'>S</span><span class='o'>)</span><span class='k'>:</span> <span class='kt'>T</span><span class='o'>[</span><span class='kt'>S</span>, <span class='kt'>Unit</span><span class='o'>]</span>
<span class='k'>case</span> <span class='k'>class</span> <span class='nc'>Syntax</span><span class='o'>[</span><span class='kt'>S</span>,<span class='kt'>A</span><span class='o'>](</span><span class='n'>t</span><span class='k'>:</span> <span class='kt'>T</span><span class='o'>[</span><span class='kt'>S</span>,<span class='kt'>A</span><span class='o'>])</span> <span class='o'>{</span>
<span class='c1'>// as before</span>
<span class='k'>def</span> <span class='o'>&[</span><span class='kt'>B</span><span class='o'>](</span><span class='n'>t2</span><span class='k'>:</span> <span class='o'>=></span> <span class='n'>T</span><span class='o'>[</span><span class='kt'>S</span>,<span class='kt'>B</span><span class='o'>])</span><span class='k'>:</span> <span class='kt'>T</span><span class='o'>[</span><span class='kt'>S</span>,<span class='kt'>B</span><span class='o'>]</span> <span class='k'>=</span> <span class='n'>L</span><span class='o'>.</span><span class='n'>bind</span><span class='o'>(</span><span class='n'>t</span><span class='o'>,</span> <span class='o'>{</span> <span class='n'>_:</span> <span class='n'>A</span> <span class='k'>=></span> <span class='n'>t2</span> <span class='o'>})</span>
<span class='o'>}</span>
<span class='o'>}</span>
</code></pre>
</div>
<p><code>LogicState</code> is mostly the same as <code>Logic</code>, except that the type of choices has an extra parameter for the type of the state. The <code>get</code> and <code>set</code> functions get and set the current state. To <code>split</code> we need an initial state to get things started, and each result includes an updated state. Finally we add the syntax <code>&</code> to sequence two computations, ignoring the value of the first. We’ll use this to sequence goals, since we care only about the updated environment.</p>
<p>The simplest implementation of <code>LogicState</code> builds on <code>Logic</code>:</p>
<div class='highlight'><pre><code class='scala'><span class='k'>trait</span> <span class='nc'>LogicStateT</span> <span class='k'>extends</span> <span class='nc'>LogicState</span> <span class='o'>{</span>
<span class='k'>val</span> <span class='nc'>Logic</span><span class='k'>:</span> <span class='kt'>Logic</span>
<span class='k'>type</span> <span class='kt'>T</span><span class='o'>[</span><span class='kt'>S</span>,<span class='kt'>A</span><span class='o'>]</span> <span class='k'>=</span> <span class='n'>S</span> <span class='k'>=></span> <span class='nc'>Logic</span><span class='o'>.</span><span class='n'>T</span><span class='o'>[(</span><span class='kt'>S</span>, <span class='kt'>A</span><span class='o'>)]</span>
</code></pre>
</div>
<p>We embed state-passing in a <code>Logic.T</code> as a function from an initial state to a choice of alternatives, where each alternative includes an updated state along with its value.</p>
<div class='highlight'><pre><code class='scala'> <span class='k'>def</span> <span class='n'>fail</span><span class='o'>[</span><span class='kt'>S</span>,<span class='kt'>A</span><span class='o'>]</span> <span class='k'>=</span> <span class='o'>{</span> <span class='n'>s</span><span class='k'>:</span> <span class='kt'>S</span> <span class='o'>=></span> <span class='nc'>Logic</span><span class='o'>.</span><span class='n'>fail</span> <span class='o'>}</span>
<span class='k'>def</span> <span class='n'>unit</span><span class='o'>[</span><span class='kt'>S</span>,<span class='kt'>A</span><span class='o'>](</span><span class='n'>a</span><span class='k'>:</span> <span class='kt'>A</span><span class='o'>)</span> <span class='k'>=</span> <span class='o'>{</span> <span class='n'>s</span><span class='k'>:</span> <span class='kt'>S</span> <span class='o'>=></span> <span class='nc'>Logic</span><span class='o'>.</span><span class='n'>unit</span><span class='o'>((</span><span class='n'>s</span><span class='o'>,</span> <span class='n'>a</span><span class='o'>))</span> <span class='o'>}</span>
<span class='k'>def</span> <span class='n'>or</span><span class='o'>[</span><span class='kt'>S</span>,<span class='kt'>A</span><span class='o'>](</span><span class='n'>t1</span><span class='k'>:</span> <span class='kt'>T</span><span class='o'>[</span><span class='kt'>S</span>,<span class='kt'>A</span><span class='o'>],</span> <span class='n'>t2</span><span class='k'>:</span> <span class='o'>=></span> <span class='n'>T</span><span class='o'>[</span><span class='kt'>S</span>,<span class='kt'>A</span><span class='o'>])</span> <span class='k'>=</span>
<span class='o'>{</span> <span class='n'>s</span><span class='k'>:</span> <span class='kt'>S</span> <span class='o'>=></span> <span class='nc'>Logic</span><span class='o'>.</span><span class='n'>or</span><span class='o'>(</span><span class='n'>t1</span><span class='o'>(</span><span class='n'>s</span><span class='o'>),</span> <span class='n'>t2</span><span class='o'>(</span><span class='n'>s</span><span class='o'>))</span> <span class='o'>}</span>
<span class='k'>def</span> <span class='n'>bind</span><span class='o'>[</span><span class='kt'>S</span>,<span class='kt'>A</span>,<span class='kt'>B</span><span class='o'>](</span><span class='n'>t</span><span class='k'>:</span> <span class='kt'>T</span><span class='o'>[</span><span class='kt'>S</span>,<span class='kt'>A</span><span class='o'>],</span> <span class='n'>f</span><span class='k'>:</span> <span class='kt'>A</span> <span class='o'>=></span> <span class='n'>T</span><span class='o'>[</span><span class='kt'>S</span>,<span class='kt'>B</span><span class='o'>])</span> <span class='k'>=</span> <span class='o'>{</span>
<span class='k'>val</span> <span class='n'>f2</span><span class='k'>:</span> <span class='o'>((</span><span class='kt'>S</span><span class='o'>,</span><span class='kt'>A</span><span class='o'>))</span> <span class='k'>=></span> <span class='nc'>Logic</span><span class='o'>.</span><span class='n'>T</span><span class='o'>[(</span><span class='kt'>S</span>,<span class='kt'>B</span><span class='o'>)]</span> <span class='k'>=</span> <span class='o'>{</span> <span class='k'>case</span> <span class='o'>(</span><span class='n'>s</span><span class='o'>,</span> <span class='n'>a</span><span class='o'>)</span> <span class='k'>=></span> <span class='n'>f</span><span class='o'>(</span><span class='n'>a</span><span class='o'>)(</span><span class='n'>s</span><span class='o'>)</span> <span class='o'>}</span>
<span class='o'>{</span> <span class='n'>s</span><span class='k'>:</span> <span class='kt'>S</span> <span class='o'>=></span> <span class='nc'>Logic</span><span class='o'>.</span><span class='n'>bind</span><span class='o'>(</span><span class='n'>t</span><span class='o'>(</span><span class='n'>s</span><span class='o'>),</span> <span class='n'>f2</span><span class='o'>)</span> <span class='o'>}</span>
<span class='o'>}</span>
<span class='k'>def</span> <span class='n'>apply</span><span class='o'>[</span><span class='kt'>S</span>,<span class='kt'>A</span>,<span class='kt'>B</span><span class='o'>](</span><span class='n'>t</span><span class='k'>:</span> <span class='kt'>T</span><span class='o'>[</span><span class='kt'>S</span>,<span class='kt'>A</span><span class='o'>],</span> <span class='n'>f</span><span class='k'>:</span> <span class='kt'>A</span> <span class='o'>=></span> <span class='n'>B</span><span class='o'>)</span> <span class='k'>=</span> <span class='o'>{</span>
<span class='k'>val</span> <span class='n'>f2</span><span class='k'>:</span> <span class='o'>((</span><span class='kt'>S</span><span class='o'>,</span><span class='kt'>A</span><span class='o'>))</span> <span class='k'>=></span> <span class='o'>((</span><span class='n'>S</span><span class='o'>,</span><span class='n'>B</span><span class='o'>))</span> <span class='k'>=</span> <span class='o'>{</span> <span class='k'>case</span> <span class='o'>(</span><span class='n'>s</span><span class='o'>,</span> <span class='n'>a</span><span class='o'>)</span> <span class='k'>=></span> <span class='o'>(</span><span class='n'>s</span><span class='o'>,</span> <span class='n'>f</span><span class='o'>(</span><span class='n'>a</span><span class='o'>))</span> <span class='o'>}</span>
<span class='o'>{</span> <span class='n'>s</span><span class='k'>:</span> <span class='kt'>S</span> <span class='o'>=></span> <span class='nc'>Logic</span><span class='o'>.</span><span class='n'>apply</span><span class='o'>(</span><span class='n'>t</span><span class='o'>(</span><span class='n'>s</span><span class='o'>),</span> <span class='n'>f2</span><span class='o'>)</span> <span class='o'>}</span>
<span class='o'>}</span>
<span class='k'>def</span> <span class='n'>filter</span><span class='o'>[</span><span class='kt'>S</span>,<span class='kt'>A</span><span class='o'>](</span><span class='n'>t</span><span class='k'>:</span> <span class='kt'>T</span><span class='o'>[</span><span class='kt'>S</span>,<span class='kt'>A</span><span class='o'>],</span> <span class='n'>p</span><span class='k'>:</span> <span class='kt'>A</span> <span class='o'>=></span> <span class='nc'>Boolean</span><span class='o'>)</span> <span class='k'>=</span> <span class='o'>{</span>
<span class='k'>val</span> <span class='n'>p2</span><span class='k'>:</span> <span class='o'>((</span><span class='kt'>S</span><span class='o'>,</span><span class='kt'>A</span><span class='o'>))</span> <span class='k'>=></span> <span class='nc'>Boolean</span> <span class='k'>=</span> <span class='o'>{</span> <span class='k'>case</span> <span class='o'>(</span><span class='n'>_</span><span class='o'>,</span> <span class='n'>a</span><span class='o'>)</span> <span class='k'>=></span> <span class='n'>p</span><span class='o'>(</span><span class='n'>a</span><span class='o'>)</span> <span class='o'>}</span>
<span class='o'>{</span> <span class='n'>s</span><span class='k'>:</span> <span class='kt'>S</span> <span class='o'>=></span> <span class='nc'>Logic</span><span class='o'>.</span><span class='n'>filter</span><span class='o'>(</span><span class='n'>t</span><span class='o'>(</span><span class='n'>s</span><span class='o'>),</span> <span class='n'>p2</span><span class='o'>)</span> <span class='o'>}</span>
<span class='o'>}</span>
</code></pre>
</div>
<p>All of these operations pass the state through unchanged. Note that <code>or</code> passes the same state to both alternatives—different branches of the tree cannot interfere with one another’s state.</p>
<div class='highlight'><pre><code class='scala'> <span class='k'>def</span> <span class='n'>split</span><span class='o'>[</span><span class='kt'>S</span>,<span class='kt'>A</span><span class='o'>](</span><span class='n'>s</span><span class='k'>:</span> <span class='kt'>S</span><span class='o'>,</span> <span class='n'>t</span><span class='k'>:</span> <span class='kt'>T</span><span class='o'>[</span><span class='kt'>S</span>,<span class='kt'>A</span><span class='o'>])</span> <span class='k'>=</span> <span class='o'>{</span>
<span class='nc'>Logic</span><span class='o'>.</span><span class='n'>split</span><span class='o'>(</span><span class='n'>t</span><span class='o'>(</span><span class='n'>s</span><span class='o'>))</span> <span class='k'>match</span> <span class='o'>{</span>
<span class='k'>case</span> <span class='nc'>None</span> <span class='k'>=></span> <span class='nc'>None</span>
<span class='k'>case</span> <span class='nc'>Some</span><span class='o'>(((</span><span class='n'>s</span><span class='o'>,</span> <span class='n'>a</span><span class='o'>),</span> <span class='n'>t</span><span class='o'>))</span> <span class='k'>=></span> <span class='nc'>Some</span><span class='o'>((</span><span class='n'>s</span><span class='o'>,</span> <span class='n'>a</span><span class='o'>,</span> <span class='o'>{</span> <span class='k'>_</span> <span class='k'>=></span> <span class='n'>t</span> <span class='o'>}))</span>
<span class='o'>}</span>
<span class='o'>}</span>
<span class='k'>def</span> <span class='n'>get</span><span class='o'>[</span><span class='kt'>S</span><span class='o'>]</span> <span class='k'>=</span> <span class='o'>{</span> <span class='n'>s</span><span class='k'>:</span> <span class='kt'>S</span> <span class='o'>=></span> <span class='nc'>Logic</span><span class='o'>.</span><span class='n'>unit</span><span class='o'>((</span><span class='n'>s</span><span class='o'>,</span><span class='n'>s</span><span class='o'>))</span> <span class='o'>}</span>
<span class='k'>def</span> <span class='n'>set</span><span class='o'>[</span><span class='kt'>S</span><span class='o'>](</span><span class='n'>s</span><span class='k'>:</span> <span class='kt'>S</span><span class='o'>)</span> <span class='k'>=</span> <span class='o'>{</span> <span class='n'>_:</span> <span class='n'>S</span> <span class='k'>=></span> <span class='nc'>Logic</span><span class='o'>.</span><span class='n'>unit</span><span class='o'>((</span><span class='n'>s</span><span class='o'>,()))</span> <span class='o'>}</span>
<span class='o'>}</span>
</code></pre>
</div>
<p>In <code>split</code> we pass the given state to the underlying <code>Logic.T</code>, and for each alternative we unpack the pair of state and value. The choice of remaining alternatives <code>t</code> encapsulates the current state, so when we return it we ignore the input state. In <code>get</code> and <code>set</code> we return and replace the current state.</p>
<p>Another approach is to pass state explicitly through <code>LogicSFK</code>:</p>
<div class='highlight'><pre><code class='scala'><span class='k'>object</span> <span class='nc'>LogicStateSFK</span> <span class='k'>extends</span> <span class='nc'>LogicState</span> <span class='o'>{</span>
<span class='k'>type</span> <span class='kt'>FK</span><span class='o'>[</span><span class='kt'>R</span><span class='o'>]</span> <span class='k'>=</span> <span class='o'>()</span> <span class='k'>=></span> <span class='n'>R</span>
<span class='k'>type</span> <span class='kt'>SK</span><span class='o'>[</span><span class='kt'>S</span>,<span class='kt'>A</span>,<span class='kt'>R</span><span class='o'>]</span> <span class='k'>=</span> <span class='o'>(</span><span class='n'>S</span><span class='o'>,</span> <span class='n'>A</span><span class='o'>,</span> <span class='nc'>FK</span><span class='o'>[</span><span class='kt'>R</span><span class='o'>])</span> <span class='k'>=></span> <span class='n'>R</span>
<span class='k'>trait</span> <span class='nc'>T</span><span class='o'>[</span><span class='kt'>S</span>,<span class='kt'>A</span><span class='o'>]</span> <span class='o'>{</span> <span class='k'>def</span> <span class='n'>apply</span><span class='o'>[</span><span class='kt'>R</span><span class='o'>](</span><span class='n'>s</span><span class='k'>:</span> <span class='kt'>S</span><span class='o'>,</span> <span class='n'>sk</span><span class='k'>:</span> <span class='kt'>SK</span><span class='o'>[</span><span class='kt'>S</span>,<span class='kt'>A</span>,<span class='kt'>R</span><span class='o'>],</span> <span class='n'>fk</span><span class='k'>:</span> <span class='kt'>FK</span><span class='o'>[</span><span class='kt'>R</span><span class='o'>])</span><span class='k'>:</span> <span class='kt'>R</span> <span class='o'>}</span>
</code></pre>
</div>
<p>This is not really any different from <code>LogicStateT</code> applied to <code>LogicSFK</code>—we have just uncurried the state argument. We can take the same path as last time and defunctionalize this into a tail-recursive implementation (see the <a href='https://github.com/jaked/ambassadortothecomputers.blogspot.com/tree/master/_code/scala-logic'>full code</a>) although <code>LogicStateT</code> applied to <code>LogicSFKDefuncTailrec</code> inherits tail-recursiveness from the underlying <code>Logic</code> monad.</p>
<b>Scrolog</b>
<p>Finally we can put the pieces together into a Prolog-like embedded DSL:</p>
<div class='highlight'><pre><code class='scala'><span class='k'>trait</span> <span class='nc'>Scrolog</span> <span class='o'>{</span>
<span class='k'>val</span> <span class='nc'>LogicState</span><span class='k'>:</span> <span class='kt'>LogicState</span>
<span class='k'>import</span> <span class='nn'>LogicState._</span>
<span class='k'>type</span> <span class='kt'>G</span> <span class='o'>=</span> <span class='n'>T</span><span class='o'>[</span><span class='kt'>Env</span>,<span class='kt'>Unit</span><span class='o'>]</span>
</code></pre>
</div>
<p>From our point of view, a goal is a stateful choice among alternatives, where we don’t care about the value returned, only the environment.</p>
<div class='highlight'><pre><code class='scala'> <span class='k'>class</span> <span class='nc'>TermSyntax</span><span class='o'>[</span><span class='kt'>A</span><span class='o'>](</span><span class='n'>t</span><span class='k'>:</span> <span class='kt'>Term</span><span class='o'>[</span><span class='kt'>A</span><span class='o'>])</span> <span class='o'>{</span>
<span class='k'>def</span> <span class='o'>=:=(</span><span class='n'>t2</span><span class='k'>:</span> <span class='kt'>Term</span><span class='o'>[</span><span class='kt'>A</span><span class='o'>])</span><span class='k'>:</span> <span class='kt'>G</span> <span class='o'>=</span>
<span class='k'>for</span> <span class='o'>{</span>
<span class='n'>env</span> <span class='k'><-</span> <span class='n'>get</span>
<span class='n'>env2</span> <span class='k'><-</span> <span class='o'>{</span>
<span class='n'>t</span><span class='o'>.</span><span class='n'>subst</span><span class='o'>(</span><span class='n'>env</span><span class='o'>).</span><span class='n'>unify</span><span class='o'>(</span><span class='n'>env</span><span class='o'>,</span> <span class='n'>t2</span><span class='o'>.</span><span class='n'>subst</span><span class='o'>(</span><span class='n'>env</span><span class='o'>))</span> <span class='k'>match</span> <span class='o'>{</span>
<span class='k'>case</span> <span class='nc'>None</span> <span class='k'>=></span> <span class='n'>fail</span><span class='o'>[</span><span class='kt'>Env</span>,<span class='kt'>Unit</span><span class='o'>]</span>
<span class='k'>case</span> <span class='nc'>Some</span><span class='o'>(</span><span class='n'>e</span><span class='o'>)</span> <span class='k'>=></span> <span class='n'>set</span><span class='o'>(</span><span class='n'>e</span><span class='o'>)</span>
<span class='o'>}</span>
<span class='o'>}</span>
<span class='o'>}</span> <span class='k'>yield</span> <span class='n'>env2</span>
<span class='o'>}</span>
<span class='k'>implicit</span> <span class='k'>def</span> <span class='n'>termSyntax</span><span class='o'>[</span><span class='kt'>A</span><span class='o'>](</span><span class='n'>t</span><span class='k'>:</span> <span class='kt'>Term</span><span class='o'>[</span><span class='kt'>A</span><span class='o'>])</span> <span class='k'>=</span> <span class='k'>new</span> <span class='nc'>TermSyntax</span><span class='o'>(</span><span class='n'>t</span><span class='o'>)</span>
<span class='k'>implicit</span> <span class='k'>def</span> <span class='n'>syntax</span><span class='o'>[</span><span class='kt'>A</span><span class='o'>](</span><span class='n'>t</span><span class='k'>:</span> <span class='kt'>G</span><span class='o'>)</span> <span class='k'>=</span> <span class='nc'>LogicState</span><span class='o'>.</span><span class='n'>syntax</span><span class='o'>(</span><span class='n'>t</span><span class='o'>)</span>
</code></pre>
</div>
<p>We connect term unification to the stateful logic monad with a wrapper class defining a <code>=:=</code> operator. To unify terms in the monad, we get the current environment, substitute it into the two terms (to satisfy the invariant above), then call <code>unify</code>; if it fails we fail the computation, else we set the new state.</p>
<div class='highlight'><pre><code class='scala'> <span class='k'>def</span> <span class='n'>run</span><span class='o'>[</span><span class='kt'>A</span><span class='o'>](</span><span class='n'>t</span><span class='k'>:</span> <span class='kt'>G</span><span class='o'>,</span> <span class='n'>n</span><span class='k'>:</span> <span class='kt'>Int</span><span class='o'>,</span> <span class='n'>tm</span><span class='k'>:</span> <span class='kt'>Term</span><span class='o'>[</span><span class='kt'>A</span><span class='o'>])</span><span class='k'>:</span> <span class='kt'>List</span><span class='o'>[</span><span class='kt'>Term</span><span class='o'>[</span><span class='kt'>A</span><span class='o'>]]</span> <span class='k'>=</span>
<span class='nc'>LogicState</span><span class='o'>.</span><span class='n'>run</span><span class='o'>(</span><span class='nc'>Env</span><span class='o'>.</span><span class='n'>empty</span><span class='o'>,</span> <span class='n'>t</span><span class='o'>,</span> <span class='n'>n</span><span class='o'>)</span>
<span class='o'>.</span><span class='n'>map</span><span class='o'>({</span> <span class='k'>case</span> <span class='o'>(</span><span class='n'>e</span><span class='o'>,</span> <span class='n'>_</span><span class='o'>)</span> <span class='k'>=></span> <span class='n'>tm</span><span class='o'>.</span><span class='n'>subst</span><span class='o'>(</span><span class='n'>e</span><span class='o'>)</span> <span class='o'>})</span>
<span class='o'>}</span>
</code></pre>
</div>
<p>The <code>run</code> function solves a goal, taking as arguments the goal, the maximum number of solutions to find, and a term to be evaluated in the environment of each solution.</p>
<b>Examples</b>
<p>First we need to set up Scrolog:</p>
<div class='highlight'><pre><code class='scala'><span class='k'>val</span> <span class='nc'>Scrolog</span> <span class='k'>=</span>
<span class='k'>new</span> <span class='nc'>Scrolog</span> <span class='o'>{</span> <span class='k'>val</span> <span class='nc'>LogicState</span> <span class='k'>=</span>
<span class='k'>new</span> <span class='nc'>LogicStateT</span> <span class='o'>{</span> <span class='k'>val</span> <span class='nc'>Logic</span> <span class='k'>=</span> <span class='nc'>LogicSFKDefuncTailrec</span> <span class='o'>}</span>
<span class='o'>}</span>
<span class='k'>import</span> <span class='nn'>Scrolog._</span>
</code></pre>
</div>
<p>Here is a translation of the <code>member</code> predicate:</p>
<div class='highlight'><pre><code class='scala'> <span class='k'>def</span> <span class='n'>member</span><span class='o'>[</span><span class='kt'>A</span><span class='o'>](</span><span class='n'>x</span><span class='k'>:</span> <span class='kt'>Term</span><span class='o'>[</span><span class='kt'>A</span><span class='o'>],</span> <span class='n'>l</span><span class='k'>:</span> <span class='kt'>Term</span><span class='o'>[</span><span class='kt'>List</span><span class='o'>[</span><span class='kt'>A</span><span class='o'>]])</span><span class='k'>:</span> <span class='kt'>G</span> <span class='o'>=</span> <span class='o'>{</span>
<span class='k'>val</span> <span class='n'>hd</span> <span class='k'>=</span> <span class='nc'>Evar</span><span class='o'>[</span><span class='kt'>A</span><span class='o'>](</span><span class='s'>"hd"</span><span class='o'>);</span> <span class='k'>val</span> <span class='n'>tl</span> <span class='k'>=</span> <span class='nc'>Evar</span><span class='o'>[</span><span class='kt'>List</span><span class='o'>[</span><span class='kt'>A</span><span class='o'>]](</span><span class='s'>"tl"</span><span class='o'>)</span>
<span class='nc'>ConsTerm</span><span class='o'>(</span><span class='n'>x</span><span class='o'>,</span> <span class='n'>tl</span><span class='o'>)</span> <span class='o'>=:=</span> <span class='n'>l</span> <span class='o'>|</span>
<span class='o'>(</span><span class='nc'>ConsTerm</span><span class='o'>(</span><span class='n'>hd</span><span class='o'>,</span> <span class='n'>tl</span><span class='o'>)</span> <span class='o'>=:=</span> <span class='n'>l</span> <span class='o'>&</span> <span class='n'>member</span><span class='o'>(</span><span class='n'>x</span><span class='o'>,</span> <span class='n'>tl</span><span class='o'>))</span>
<span class='o'>}</span>
</code></pre>
</div>
<p>We implement predicates by functions, and goals by function calls. To implement matching the clause head, we explicitly unify the input arguments against each clause head, and combine the clauses with <code>|</code>. Subgoals are sequenced with <code>&</code>. Finally, we must create local evars explicitly, since they are fresh for each call (just as local variables are in Scala).</p>
<p>Finally we can run the goal above:</p>
<div class='highlight'><pre><code class='scala'><span class='n'>scala</span><span class='o'>></span> <span class='k'>val</span> <span class='n'>x</span> <span class='k'>=</span> <span class='nc'>Evar</span><span class='o'>[</span><span class='kt'>Int</span><span class='o'>](</span><span class='s'>"x"</span><span class='o'>)</span>
<span class='n'>scala</span><span class='o'>></span> <span class='n'>run</span><span class='o'>(</span><span class='n'>member</span><span class='o'>(</span><span class='n'>x</span><span class='o'>,</span> <span class='nc'>List</span><span class='o'>[</span><span class='kt'>Term</span><span class='o'>[</span><span class='kt'>Int</span><span class='o'>]](</span><span class='mi'>1</span><span class='o'>,</span> <span class='mi'>2</span><span class='o'>,</span> <span class='mi'>3</span><span class='o'>)),</span> <span class='mi'>3</span><span class='o'>,</span> <span class='n'>x</span><span class='o'>)</span>
<span class='n'>res6</span><span class='k'>:</span> <span class='kt'>List</span><span class='o'>[</span><span class='kt'>Term</span><span class='o'>[</span><span class='kt'>Int</span><span class='o'>]]</span> <span class='k'>=</span> <span class='nc'>List</span><span class='o'>(</span><span class='mi'>1</span><span class='o'>,</span> <span class='mi'>2</span><span class='o'>,</span> <span class='mi'>3</span><span class='o'>)</span>
</code></pre>
</div>
<p>As another example, we can implement addition over unary natural numbers. In Prolog this would be</p>
<div class='highlight'><pre><code class='prolog'> <span class='nf'>sum</span><span class='p'>(</span><span class='s-Atom'>z</span><span class='p'>,</span> <span class='nv'>N</span><span class='p'>,</span> <span class='nv'>N</span><span class='p'>).</span>
<span class='nf'>sum</span><span class='p'>(</span><span class='nf'>s</span><span class='p'>(</span><span class='nv'>M</span><span class='p'>),</span> <span class='nv'>N</span><span class='p'>,</span> <span class='nf'>s</span><span class='p'>(</span><span class='nv'>P</span><span class='p'>))</span> <span class='p'>:-</span> <span class='nf'>sum</span><span class='p'>(</span><span class='nv'>M</span><span class='p'>,</span> <span class='nv'>N</span><span class='p'>,</span> <span class='nv'>P</span><span class='p'>).</span>
</code></pre>
</div>
<p>In Prolog we can just invent symbols like <code>s</code> and <code>z</code>; in Scala we need first to define a type of natural numbers, then terms over that type:</p>
<div class='highlight'><pre><code class='scala'> <span class='k'>sealed</span> <span class='k'>trait</span> <span class='nc'>Nat</span>
<span class='k'>case</span> <span class='k'>object</span> <span class='nc'>Z</span> <span class='k'>extends</span> <span class='nc'>Nat</span>
<span class='k'>case</span> <span class='k'>class</span> <span class='nc'>S</span><span class='o'>(</span><span class='n'>n</span><span class='k'>:</span> <span class='kt'>Nat</span><span class='o'>)</span> <span class='k'>extends</span> <span class='nc'>Nat</span>
<span class='k'>case</span> <span class='k'>object</span> <span class='nc'>ZTerm</span> <span class='k'>extends</span> <span class='nc'>Term</span><span class='o'>[</span><span class='kt'>Nat</span><span class='o'>]</span> <span class='o'>{</span>
<span class='c1'>// like NilTerm</span>
<span class='k'>case</span> <span class='k'>class</span> <span class='nc'>STerm</span><span class='o'>(</span><span class='n'>n</span><span class='k'>:</span> <span class='kt'>Term</span><span class='o'>[</span><span class='kt'>Nat</span><span class='o'>])</span> <span class='k'>extends</span> <span class='nc'>Term</span><span class='o'>[</span><span class='kt'>Nat</span><span class='o'>]</span> <span class='o'>{</span>
<span class='c1'>// like ConsTerm</span>
</code></pre>
</div>
<p>Then we can define <code>sum</code>, again separating the clauses by <code>|</code> and explicitly unifying the clause heads:</p>
<div class='highlight'><pre><code class='scala'> <span class='k'>def</span> <span class='n'>sum</span><span class='o'>(</span><span class='n'>m</span><span class='k'>:</span> <span class='kt'>Term</span><span class='o'>[</span><span class='kt'>Nat</span><span class='o'>],</span> <span class='n'>n</span><span class='k'>:</span> <span class='kt'>Term</span><span class='o'>[</span><span class='kt'>Nat</span><span class='o'>],</span> <span class='n'>p</span><span class='k'>:</span> <span class='kt'>Term</span><span class='o'>[</span><span class='kt'>Nat</span><span class='o'>])</span><span class='k'>:</span> <span class='kt'>G</span> <span class='o'>=</span> <span class='o'>{</span>
<span class='k'>val</span> <span class='n'>m2</span> <span class='k'>=</span> <span class='nc'>Evar</span><span class='o'>[</span><span class='kt'>Nat</span><span class='o'>](</span><span class='s'>"m"</span><span class='o'>);</span> <span class='k'>val</span> <span class='n'>p2</span> <span class='k'>=</span> <span class='nc'>Evar</span><span class='o'>[</span><span class='kt'>Nat</span><span class='o'>](</span><span class='s'>"p"</span><span class='o'>)</span>
<span class='o'>(</span><span class='n'>m</span> <span class='o'>=:=</span> <span class='n'>Z</span> <span class='o'>&</span> <span class='n'>n</span> <span class='o'>=:=</span> <span class='n'>p</span><span class='o'>)</span> <span class='o'>|</span>
<span class='o'>(</span><span class='n'>m</span> <span class='o'>=:=</span> <span class='nc'>STerm</span><span class='o'>(</span><span class='n'>m2</span><span class='o'>)</span> <span class='o'>&</span> <span class='n'>p</span> <span class='o'>=:=</span> <span class='nc'>STerm</span><span class='o'>(</span><span class='n'>p2</span><span class='o'>)</span> <span class='o'>&</span> <span class='n'>sum</span><span class='o'>(</span><span class='n'>m2</span><span class='o'>,</span> <span class='n'>n</span><span class='o'>,</span> <span class='n'>p2</span><span class='o'>))</span>
<span class='o'>}</span>
</code></pre>
</div>
<p>We can use <code>sum</code> to do addition:</p>
<div class='highlight'><pre><code class='scala'><span class='n'>scala</span><span class='o'>></span> <span class='k'>val</span> <span class='n'>x</span> <span class='k'>=</span> <span class='nc'>Evar</span><span class='o'>[</span><span class='kt'>Nat</span><span class='o'>](</span><span class='s'>"x"</span><span class='o'>);</span> <span class='k'>val</span> <span class='n'>y</span> <span class='k'>=</span> <span class='nc'>Evar</span><span class='o'>[</span><span class='kt'>Nat</span><span class='o'>](</span><span class='s'>"y"</span><span class='o'>)</span>
<span class='n'>scala</span><span class='o'>></span> <span class='n'>run</span><span class='o'>(</span><span class='n'>sum</span><span class='o'>(</span><span class='n'>S</span><span class='o'>(</span><span class='n'>Z</span><span class='o'>),</span> <span class='n'>S</span><span class='o'>(</span><span class='n'>S</span><span class='o'>(</span><span class='n'>Z</span><span class='o'>)),</span> <span class='n'>x</span><span class='o'>),</span> <span class='mi'>1</span><span class='o'>,</span> <span class='n'>x</span><span class='o'>)</span>
<span class='n'>res8</span><span class='k'>:</span> <span class='kt'>List</span><span class='o'>[</span><span class='kt'>Term</span><span class='o'>[</span><span class='kt'>Nat</span><span class='o'>]]</span> <span class='k'>=</span> <span class='nc'>List</span><span class='o'>(</span><span class='n'>S</span><span class='o'>(</span><span class='n'>S</span><span class='o'>(</span><span class='n'>S</span><span class='o'>(</span><span class='n'>Z</span><span class='o'>))))</span>
</code></pre>
</div>
<p>or subtraction:</p>
<div class='highlight'><pre><code class='scala'><span class='n'>scala</span><span class='o'>></span> <span class='n'>run</span><span class='o'>(</span><span class='n'>sum</span><span class='o'>(</span><span class='n'>x</span><span class='o'>,</span> <span class='n'>S</span><span class='o'>(</span><span class='n'>S</span><span class='o'>(</span><span class='n'>Z</span><span class='o'>)),</span> <span class='n'>S</span><span class='o'>(</span><span class='n'>S</span><span class='o'>(</span><span class='n'>S</span><span class='o'>(</span><span class='n'>Z</span><span class='o'>)))),</span> <span class='mi'>1</span><span class='o'>,</span> <span class='n'>x</span><span class='o'>)</span>
<span class='n'>res10</span><span class='k'>:</span> <span class='kt'>List</span><span class='o'>[</span><span class='kt'>Term</span><span class='o'>[</span><span class='kt'>Nat</span><span class='o'>]]</span> <span class='k'>=</span> <span class='nc'>List</span><span class='o'>(</span><span class='n'>S</span><span class='o'>(</span><span class='n'>Z</span><span class='o'>))</span>
<span class='n'>scala</span><span class='o'>></span> <span class='n'>run</span><span class='o'>(</span><span class='n'>sum</span><span class='o'>(</span><span class='n'>S</span><span class='o'>(</span><span class='n'>Z</span><span class='o'>),</span> <span class='n'>x</span><span class='o'>,</span> <span class='n'>S</span><span class='o'>(</span><span class='n'>S</span><span class='o'>(</span><span class='n'>S</span><span class='o'>(</span><span class='n'>Z</span><span class='o'>)))),</span> <span class='mi'>1</span><span class='o'>,</span> <span class='n'>x</span><span class='o'>)</span>
<span class='n'>res11</span><span class='k'>:</span> <span class='kt'>List</span><span class='o'>[</span><span class='kt'>Term</span><span class='o'>[</span><span class='kt'>Nat</span><span class='o'>]]</span> <span class='k'>=</span> <span class='nc'>List</span><span class='o'>(</span><span class='n'>S</span><span class='o'>(</span><span class='n'>S</span><span class='o'>(</span><span class='n'>Z</span><span class='o'>)))</span>
</code></pre>
</div>
<p>or even to find all the pairs of naturals which sum to 3:</p>
<div class='highlight'><pre><code class='scala'><span class='n'>scala</span><span class='o'>></span> <span class='n'>run</span><span class='o'>(</span><span class='n'>sum</span><span class='o'>(</span><span class='n'>x</span><span class='o'>,</span> <span class='n'>y</span><span class='o'>,</span> <span class='n'>S</span><span class='o'>(</span><span class='n'>S</span><span class='o'>(</span><span class='n'>S</span><span class='o'>(</span><span class='n'>Z</span><span class='o'>)))),</span> <span class='mi'>10</span><span class='o'>,</span> <span class='nc'>List</span><span class='o'>[</span><span class='kt'>Term</span><span class='o'>[</span><span class='kt'>Nat</span><span class='o'>]](</span><span class='n'>x</span><span class='o'>,</span> <span class='n'>y</span><span class='o'>))</span>
<span class='n'>res14</span><span class='k'>:</span> <span class='kt'>List</span><span class='o'>[</span><span class='kt'>Term</span><span class='o'>[</span><span class='kt'>List</span><span class='o'>[</span><span class='kt'>Nat</span><span class='o'>]]]</span> <span class='k'>=</span>
<span class='nc'>List</span><span class='o'>(</span><span class='n'>Z</span> <span class='o'>::</span> <span class='n'>S</span><span class='o'>(</span><span class='n'>S</span><span class='o'>(</span><span class='n'>S</span><span class='o'>(</span><span class='n'>Z</span><span class='o'>)))</span> <span class='o'>::</span> <span class='nc'>List</span><span class='o'>(),</span>
<span class='n'>S</span><span class='o'>(</span><span class='n'>Z</span><span class='o'>)</span> <span class='o'>::</span> <span class='n'>S</span><span class='o'>(</span><span class='n'>S</span><span class='o'>(</span><span class='n'>Z</span><span class='o'>))</span> <span class='o'>::</span> <span class='nc'>List</span><span class='o'>(),</span>
<span class='n'>S</span><span class='o'>(</span><span class='n'>S</span><span class='o'>(</span><span class='n'>Z</span><span class='o'>))</span> <span class='o'>::</span> <span class='n'>S</span><span class='o'>(</span><span class='n'>Z</span><span class='o'>)</span> <span class='o'>::</span> <span class='nc'>List</span><span class='o'>(),</span>
<span class='n'>S</span><span class='o'>(</span><span class='n'>S</span><span class='o'>(</span><span class='n'>S</span><span class='o'>(</span><span class='n'>Z</span><span class='o'>)))</span> <span class='o'>::</span> <span class='n'>Z</span> <span class='o'>::</span> <span class='nc'>List</span><span class='o'>())</span>
</code></pre>
</div>
<p>although the printing of <code>Term[List]</code> could be better.</p>
<p>This is only a small taste of the expressivity of Prolog-style logic programming. Again let me recommend <a href='http://www.cs.cmu.edu/~fp/courses/lp/lectures/lp-all.pdf'>Frank Pfenning’s course notes</a>, which explore the semantics of Prolog in a “definitional interpreters” style, by gradually refining an interpreter to expose more of the machinery of the language.</p>
<p>See the <a href='https://github.com/jaked/ambassadortothecomputers.blogspot.com/tree/master/_code/scala-logic'>full code</a>.</p>Jake Donhamhttp://www.blogger.com/profile/04768087689799941690noreply@blogger.com1tag:blogger.com,1999:blog-1445545651031573301.post-13095879499746707252011-04-29T22:07:00.000-07:002011-06-08T20:39:18.549-07:00Logic programming in Scala, part 2: backtracking<p>In the <a href='/2011/04/logic-programming-in-scala-part-1.html'>previous post</a> we saw how to write computations in a logic monad, where a “value” is a choice among alternatives, and operating on a value means operating on all the alternatives.</p>
<p>Our first implementation of the logic monad represents a choice among alternatives as a list, and operating on a value means running the operation for each alternative immediately (to produce a new list of alternatives). If we imagine alternatives as leaves of a tree (with <code>|</code> indicating branching), the first implementation explores the tree breadth-first.</p>
<p>This is OK for some problems, but we run into trouble when there are a large or infinite number of alternatives. For example, a choice among the natural numbers:</p>
<div class='highlight'><pre><code class='scala'><span class='n'>scala</span><span class='o'>></span> <span class='k'>import</span> <span class='nn'>LogicList._</span>
<span class='k'>import</span> <span class='nn'>LogicList._</span>
<span class='n'>scala</span><span class='o'>></span> <span class='k'>val</span> <span class='n'>nat</span><span class='k'>:</span> <span class='kt'>T</span><span class='o'>[</span><span class='kt'>Int</span><span class='o'>]</span> <span class='k'>=</span> <span class='n'>unit</span><span class='o'>(</span><span class='mi'>0</span><span class='o'>)</span> <span class='o'>|</span> <span class='n'>nat</span><span class='o'>.</span><span class='n'>map</span><span class='o'>(</span><span class='k'>_</span> <span class='o'>+</span> <span class='mi'>1</span><span class='o'>)</span>
<span class='n'>java</span><span class='o'>.</span><span class='n'>lang</span><span class='o'>.</span><span class='nc'>NullPointerException</span>
<span class='o'>...</span>
</code></pre>
</div>
<p>This goes wrong because even though the right-hand argument to <code>|</code> is by-name, we immediately try to use it, and fail because <code>nat</code> is not yet defined.</p>
<div class='highlight'><pre><code class='scala'><span class='n'>scala</span><span class='o'>></span> <span class='k'>def</span> <span class='n'>nat</span><span class='k'>:</span> <span class='kt'>T</span><span class='o'>[</span><span class='kt'>Int</span><span class='o'>]</span> <span class='k'>=</span> <span class='n'>unit</span><span class='o'>(</span><span class='mi'>0</span><span class='o'>)</span> <span class='o'>|</span> <span class='n'>nat</span><span class='o'>.</span><span class='n'>map</span><span class='o'>(</span><span class='k'>_</span> <span class='o'>+</span> <span class='mi'>1</span><span class='o'>)</span>
<span class='n'>nat</span><span class='k'>:</span> <span class='kt'>LogicList.T</span><span class='o'>[</span><span class='kt'>Int</span><span class='o'>]</span>
<span class='n'>scala</span><span class='o'>></span> <span class='n'>run</span><span class='o'>(</span><span class='n'>nat</span><span class='o'>,</span> <span class='mi'>10</span><span class='o'>)</span>
<span class='n'>java</span><span class='o'>.</span><span class='n'>lang</span><span class='o'>.</span><span class='nc'>StackOverflowError</span>
<span class='o'>...</span>
</code></pre>
</div>
<p>With <code>def</code> we can successfully define <code>nat</code>, because the right-hand side isn’t evaluated until <code>nat</code> is used in the call to <code>run</code>, but we overflow the stack trying to compute all the natural numbers.</p>
<p>Let’s repair this with a fancier implementation of the logic monad, translated from Kiselyov et al.’s <a href='http://okmij.org/ftp/Computation/LogicT.pdf'>Backtracking, Interleaving, and Terminating Monad Transformers</a>. This implementation will explore the tree depth-first.</p>
<b>Success and failure continuations</b>
<p>The idea is to represent a choice of alternatives by a function, which takes as arguments two functions: a <em>success continuation</em> and a <em>failure continuation</em>. The success continuation is just a function indicating what to do next with each alternative; the failure continuation is what to do next when there are no more alternatives.</p>
<p>For success, what we do next is either return the alternative (when we have reached a leaf of the tree), or perform some operation on it (possibly forming new branches rooted at the alternative). For failure, what we do next is back up to the last branch point and succeed with the next alternative. If there are no more alternatives at the previous branch point we back up again, and so on until we can succeed or finally run out of alternatives. In other words, we do depth-first search on the tree, except that the tree isn’t a materialized data structure—it’s created on the fly.</p>
<p>(In the jargon of logic programming, a branch point is called a “choice point”, and going back to an earlier choice point is called “backtracking”.)</p>
<div class='highlight'><pre><code class='scala'><span class='k'>object</span> <span class='nc'>LogicSFK</span> <span class='k'>extends</span> <span class='nc'>Logic</span> <span class='o'>{</span>
<span class='k'>type</span> <span class='kt'>FK</span><span class='o'>[</span><span class='kt'>R</span><span class='o'>]</span> <span class='k'>=</span> <span class='o'>()</span> <span class='k'>=></span> <span class='n'>R</span>
<span class='k'>type</span> <span class='kt'>SK</span><span class='o'>[</span><span class='kt'>A</span>,<span class='kt'>R</span><span class='o'>]</span> <span class='k'>=</span> <span class='o'>(</span><span class='n'>A</span><span class='o'>,</span> <span class='nc'>FK</span><span class='o'>[</span><span class='kt'>R</span><span class='o'>])</span> <span class='k'>=></span> <span class='n'>R</span>
<span class='k'>trait</span> <span class='nc'>T</span><span class='o'>[</span><span class='kt'>A</span><span class='o'>]</span> <span class='o'>{</span> <span class='k'>def</span> <span class='n'>apply</span><span class='o'>[</span><span class='kt'>R</span><span class='o'>](</span><span class='n'>sk</span><span class='k'>:</span> <span class='kt'>SK</span><span class='o'>[</span><span class='kt'>A</span>,<span class='kt'>R</span><span class='o'>],</span> <span class='n'>fk</span><span class='k'>:</span> <span class='kt'>FK</span><span class='o'>[</span><span class='kt'>R</span><span class='o'>])</span><span class='k'>:</span> <span class='kt'>R</span> <span class='o'>}</span>
</code></pre>
</div>
<p>The continuations can return a result of some arbitrary type <code>R</code>. This means that the function representing a choice has a “rank-2” polymorphic type—it takes functions which are themselves polymorphic—which is not directly representable in Scala. But we can encode it by making the representation function a method on a trait.</p>
<p>The success continuation takes a value of the underlying type (i.e. an alternative), and also a failure continuation, to call in case this branch of the tree eventually fails (by calling <code>fail</code>, or <code>filter</code> when no alternative satisfies the predicate). The failure continuation is also called to succeed with the next alternative after returning a leaf (see <code>split</code>).</p>
<div class='highlight'><pre><code class='scala'> <span class='k'>def</span> <span class='n'>fail</span><span class='o'>[</span><span class='kt'>A</span><span class='o'>]</span> <span class='k'>=</span>
<span class='k'>new</span> <span class='n'>T</span><span class='o'>[</span><span class='kt'>A</span><span class='o'>]</span> <span class='o'>{</span>
<span class='k'>def</span> <span class='n'>apply</span><span class='o'>[</span><span class='kt'>R</span><span class='o'>](</span><span class='n'>sk</span><span class='k'>:</span> <span class='kt'>SK</span><span class='o'>[</span><span class='kt'>A</span>,<span class='kt'>R</span><span class='o'>],</span> <span class='n'>fk</span><span class='k'>:</span> <span class='kt'>FK</span><span class='o'>[</span><span class='kt'>R</span><span class='o'>])</span> <span class='k'>=</span> <span class='n'>fk</span><span class='o'>()</span>
<span class='o'>}</span>
<span class='k'>def</span> <span class='n'>unit</span><span class='o'>[</span><span class='kt'>A</span><span class='o'>](</span><span class='n'>a</span><span class='k'>:</span> <span class='kt'>A</span><span class='o'>)</span> <span class='k'>=</span>
<span class='k'>new</span> <span class='n'>T</span><span class='o'>[</span><span class='kt'>A</span><span class='o'>]</span> <span class='o'>{</span>
<span class='k'>def</span> <span class='n'>apply</span><span class='o'>[</span><span class='kt'>R</span><span class='o'>](</span><span class='n'>sk</span><span class='k'>:</span> <span class='kt'>SK</span><span class='o'>[</span><span class='kt'>A</span>,<span class='kt'>R</span><span class='o'>],</span> <span class='n'>fk</span><span class='k'>:</span> <span class='kt'>FK</span><span class='o'>[</span><span class='kt'>R</span><span class='o'>])</span> <span class='k'>=</span> <span class='n'>sk</span><span class='o'>(</span><span class='n'>a</span><span class='o'>,</span> <span class='n'>fk</span><span class='o'>)</span>
<span class='o'>}</span>
</code></pre>
</div>
<p>To fail, just call the failure continuation. To succeed with one alternative, call the success continuation with the single alternative and the passed-in failure continuation—there are no more alternatives to try, so if this branch fails the <code>unit</code> fails.</p>
<div class='highlight'><pre><code class='scala'> <span class='k'>def</span> <span class='n'>or</span><span class='o'>[</span><span class='kt'>A</span><span class='o'>](</span><span class='n'>t1</span><span class='k'>:</span> <span class='kt'>T</span><span class='o'>[</span><span class='kt'>A</span><span class='o'>],</span> <span class='n'>t2</span><span class='k'>:</span> <span class='o'>=></span> <span class='n'>T</span><span class='o'>[</span><span class='kt'>A</span><span class='o'>])</span> <span class='k'>=</span>
<span class='k'>new</span> <span class='n'>T</span><span class='o'>[</span><span class='kt'>A</span><span class='o'>]</span> <span class='o'>{</span>
<span class='k'>def</span> <span class='n'>apply</span><span class='o'>[</span><span class='kt'>R</span><span class='o'>](</span><span class='n'>sk</span><span class='k'>:</span> <span class='kt'>SK</span><span class='o'>[</span><span class='kt'>A</span>,<span class='kt'>R</span><span class='o'>],</span> <span class='n'>fk</span><span class='k'>:</span> <span class='kt'>FK</span><span class='o'>[</span><span class='kt'>R</span><span class='o'>])</span> <span class='k'>=</span>
<span class='n'>t1</span><span class='o'>(</span><span class='n'>sk</span><span class='o'>,</span> <span class='o'>{</span> <span class='o'>()</span> <span class='k'>=></span> <span class='n'>t2</span><span class='o'>(</span><span class='n'>sk</span><span class='o'>,</span> <span class='n'>fk</span><span class='o'>)</span> <span class='o'>})</span>
<span class='o'>}</span>
</code></pre>
</div>
<p><code>Or</code> creates a choice point. We want to explore the alternatives in both <code>t1</code> and <code>t2</code>, so we pass the success continuation to <code>t1</code> (which calls it on each alternative); when <code>t1</code> is exhausted we pass the success continuation to <code>t2</code>; finally we fail with the caller’s failure continuation—that is, we backtrack.</p>
<div class='highlight'><pre><code class='scala'> <span class='k'>def</span> <span class='n'>bind</span><span class='o'>[</span><span class='kt'>A</span>,<span class='kt'>B</span><span class='o'>](</span><span class='n'>t</span><span class='k'>:</span> <span class='kt'>T</span><span class='o'>[</span><span class='kt'>A</span><span class='o'>],</span> <span class='n'>f</span><span class='k'>:</span> <span class='kt'>A</span> <span class='o'>=></span> <span class='n'>T</span><span class='o'>[</span><span class='kt'>B</span><span class='o'>])</span> <span class='k'>=</span>
<span class='k'>new</span> <span class='n'>T</span><span class='o'>[</span><span class='kt'>B</span><span class='o'>]</span> <span class='o'>{</span>
<span class='k'>def</span> <span class='n'>apply</span><span class='o'>[</span><span class='kt'>R</span><span class='o'>](</span><span class='n'>sk</span><span class='k'>:</span> <span class='kt'>SK</span><span class='o'>[</span><span class='kt'>B</span>,<span class='kt'>R</span><span class='o'>],</span> <span class='n'>fk</span><span class='k'>:</span> <span class='kt'>FK</span><span class='o'>[</span><span class='kt'>R</span><span class='o'>])</span> <span class='k'>=</span>
<span class='n'>t</span><span class='o'>(({</span> <span class='o'>(</span><span class='n'>a</span><span class='o'>,</span> <span class='n'>fk</span><span class='o'>)</span> <span class='k'>=></span> <span class='n'>f</span><span class='o'>(</span><span class='n'>a</span><span class='o'>)(</span><span class='n'>sk</span><span class='o'>,</span> <span class='n'>fk</span><span class='o'>)</span> <span class='o'>}</span><span class='k'>:</span> <span class='kt'>SK</span><span class='o'>[</span><span class='kt'>A</span>,<span class='kt'>R</span><span class='o'>]),</span> <span class='n'>fk</span><span class='o'>)</span>
<span class='o'>}</span>
<span class='k'>def</span> <span class='n'>apply</span><span class='o'>[</span><span class='kt'>A</span>,<span class='kt'>B</span><span class='o'>](</span><span class='n'>t</span><span class='k'>:</span> <span class='kt'>T</span><span class='o'>[</span><span class='kt'>A</span><span class='o'>],</span> <span class='n'>f</span><span class='k'>:</span> <span class='kt'>A</span> <span class='o'>=></span> <span class='n'>B</span><span class='o'>)</span> <span class='k'>=</span>
<span class='k'>new</span> <span class='n'>T</span><span class='o'>[</span><span class='kt'>B</span><span class='o'>]</span> <span class='o'>{</span>
<span class='k'>def</span> <span class='n'>apply</span><span class='o'>[</span><span class='kt'>R</span><span class='o'>](</span><span class='n'>sk</span><span class='k'>:</span> <span class='kt'>SK</span><span class='o'>[</span><span class='kt'>B</span>,<span class='kt'>R</span><span class='o'>],</span> <span class='n'>fk</span><span class='k'>:</span> <span class='kt'>FK</span><span class='o'>[</span><span class='kt'>R</span><span class='o'>])</span> <span class='k'>=</span>
<span class='n'>t</span><span class='o'>(({</span> <span class='o'>(</span><span class='n'>a</span><span class='o'>,</span> <span class='n'>fk</span><span class='o'>)</span> <span class='k'>=></span> <span class='n'>sk</span><span class='o'>(</span><span class='n'>f</span><span class='o'>(</span><span class='n'>a</span><span class='o'>),</span> <span class='n'>fk</span><span class='o'>)</span> <span class='o'>}</span><span class='k'>:</span> <span class='kt'>SK</span><span class='o'>[</span><span class='kt'>A</span>,<span class='kt'>R</span><span class='o'>]),</span> <span class='n'>fk</span><span class='o'>)</span>
<span class='o'>}</span>
</code></pre>
</div>
<p>For <code>bind</code> we extend each branch by calling <code>f</code> on the current leaf. To succeed we call <code>f</code> on the alternative <code>a</code>. Now <code>f(a)</code> returns a choice of alternatives, so we pass it the original success continuation (which says what to do next with alternatives resulting from the <code>bind</code>), and the failure continuation in force at the point <code>a</code> was generated (which succeeds with the next available alternative from <code>f(a)</code>).</p>
<p>For <code>apply</code> things are simpler, since <code>f(a)</code> returns a single value rather than a choice of alternatives: we succeed immediately with the returned value.</p>
<div class='highlight'><pre><code class='scala'> <span class='k'>def</span> <span class='n'>filter</span><span class='o'>[</span><span class='kt'>A</span><span class='o'>](</span><span class='n'>t</span><span class='k'>:</span> <span class='kt'>T</span><span class='o'>[</span><span class='kt'>A</span><span class='o'>],</span> <span class='n'>p</span><span class='k'>:</span> <span class='kt'>A</span> <span class='o'>=></span> <span class='nc'>Boolean</span><span class='o'>)</span> <span class='k'>=</span>
<span class='k'>new</span> <span class='n'>T</span><span class='o'>[</span><span class='kt'>A</span><span class='o'>]</span> <span class='o'>{</span>
<span class='k'>def</span> <span class='n'>apply</span><span class='o'>[</span><span class='kt'>R</span><span class='o'>](</span><span class='n'>sk</span><span class='k'>:</span> <span class='kt'>SK</span><span class='o'>[</span><span class='kt'>A</span>,<span class='kt'>R</span><span class='o'>],</span> <span class='n'>fk</span><span class='k'>:</span> <span class='kt'>FK</span><span class='o'>[</span><span class='kt'>R</span><span class='o'>])</span> <span class='k'>=</span> <span class='o'>{</span>
<span class='k'>val</span> <span class='n'>sk2</span><span class='k'>:</span> <span class='kt'>SK</span><span class='o'>[</span><span class='kt'>A</span>,<span class='kt'>R</span><span class='o'>]</span> <span class='k'>=</span>
<span class='o'>{</span> <span class='o'>(</span><span class='n'>a</span><span class='o'>,</span> <span class='n'>fk</span><span class='o'>)</span> <span class='k'>=></span> <span class='k'>if</span> <span class='o'>(</span><span class='n'>p</span><span class='o'>(</span><span class='n'>a</span><span class='o'>))</span> <span class='n'>sk</span><span class='o'>(</span><span class='n'>a</span><span class='o'>,</span> <span class='n'>fk</span><span class='o'>)</span> <span class='k'>else</span> <span class='n'>fk</span><span class='o'>()</span> <span class='o'>}</span>
<span class='n'>t</span><span class='o'>(</span><span class='n'>sk2</span><span class='o'>,</span> <span class='n'>fk</span><span class='o'>)</span>
<span class='o'>}</span>
<span class='o'>}</span>
</code></pre>
</div>
<p>To filter a choice of alternatives, each time we succeed with a value we see if it satisfies the predicate <code>p</code>; if it does, we succeed with that value (extending the branch), otherwise we fail (pruning the branch).</p>
<div class='highlight'><pre><code class='scala'> <span class='k'>def</span> <span class='n'>split</span><span class='o'>[</span><span class='kt'>A</span><span class='o'>](</span><span class='n'>t</span><span class='k'>:</span> <span class='kt'>T</span><span class='o'>[</span><span class='kt'>A</span><span class='o'>])</span> <span class='k'>=</span> <span class='o'>{</span>
<span class='k'>def</span> <span class='n'>unsplit</span><span class='o'>(</span><span class='n'>fk</span><span class='k'>:</span> <span class='kt'>FK</span><span class='o'>[</span><span class='kt'>Option</span><span class='o'>[(</span><span class='kt'>A</span>,<span class='kt'>T</span><span class='o'>[</span><span class='kt'>A</span><span class='o'>])]])</span><span class='k'>:</span> <span class='kt'>T</span><span class='o'>[</span><span class='kt'>A</span><span class='o'>]</span> <span class='k'>=</span>
<span class='n'>fk</span><span class='o'>()</span> <span class='k'>match</span> <span class='o'>{</span>
<span class='k'>case</span> <span class='nc'>None</span> <span class='k'>=></span> <span class='n'>fail</span>
<span class='k'>case</span> <span class='nc'>Some</span><span class='o'>((</span><span class='n'>a</span><span class='o'>,</span> <span class='n'>t</span><span class='o'>))</span> <span class='k'>=></span> <span class='n'>or</span><span class='o'>(</span><span class='n'>unit</span><span class='o'>(</span><span class='n'>a</span><span class='o'>),</span> <span class='n'>t</span><span class='o'>)</span>
<span class='o'>}</span>
<span class='k'>def</span> <span class='n'>sk</span> <span class='k'>:</span> <span class='kt'>SK</span><span class='o'>[</span><span class='kt'>A</span>,<span class='kt'>Option</span><span class='o'>[(</span><span class='kt'>A</span>,<span class='kt'>T</span><span class='o'>[</span><span class='kt'>A</span><span class='o'>])]]</span> <span class='k'>=</span>
<span class='o'>{</span> <span class='o'>(</span><span class='n'>a</span><span class='o'>,</span> <span class='n'>fk</span><span class='o'>)</span> <span class='k'>=></span> <span class='nc'>Some</span><span class='o'>((</span><span class='n'>a</span><span class='o'>,</span> <span class='n'>bind</span><span class='o'>(</span><span class='n'>unit</span><span class='o'>(</span><span class='n'>fk</span><span class='o'>),</span> <span class='n'>unsplit</span><span class='o'>)))</span> <span class='o'>}</span>
<span class='n'>t</span><span class='o'>(</span><span class='n'>sk</span><span class='o'>,</span> <span class='o'>{</span> <span class='o'>()</span> <span class='k'>=></span> <span class='nc'>None</span> <span class='o'>})</span>
<span class='o'>}</span>
<span class='o'>}</span>
</code></pre>
</div>
<p>The point of <code>split</code> is to pull a single alternative from a choice, returning along with it a choice of the remaining alternatives. In the list implementation we just returned the head and tail of the list. In this implementation, the alternatives are computed on demand; we want to be careful to do only as much computation as needed to pull the first alternative</p>
<p>The failure continuation we pass to <code>t</code> just returns <code>None</code> when there are no more alternatives. The success continuation <code>sk</code> returns the first alternative and a choice of the remaining alternatives (wrapped in <code>Some</code>).</p>
<p>The tricky part is the choice of remaining alternatives. We’re given the failure continuation <code>fk</code>; calling it calls <code>sk</code> on the next alternative, which ultimately returns <code>Some(a, t)</code> where <code>a</code> is the next alternative, or <code>None</code> if there are no more alternatives. We repackage this <code>Option</code> as a choice of alternatives with <code>unsplit</code>. So that we don’t call <code>fk</code> too soon, we call <code>unsplit</code> via <code>bind</code>, which defers the call until the resulting choice of alternatives is actually used.</p>
<p>Now we can write infinite choices:</p>
<div class='highlight'><pre><code class='scala'><span class='n'>scala</span><span class='o'>></span> <span class='k'>import</span> <span class='nn'>LogicSFK._</span>
<span class='k'>import</span> <span class='nn'>LogicSFK._</span>
<span class='n'>scala</span><span class='o'>></span> <span class='k'>val</span> <span class='n'>nat</span><span class='k'>:</span> <span class='kt'>T</span><span class='o'>[</span><span class='kt'>Int</span><span class='o'>]</span> <span class='k'>=</span> <span class='n'>unit</span><span class='o'>(</span><span class='mi'>0</span><span class='o'>)</span> <span class='o'>|</span> <span class='n'>nat</span><span class='o'>.</span><span class='n'>map</span><span class='o'>(</span><span class='k'>_</span> <span class='o'>+</span> <span class='mi'>1</span><span class='o'>)</span>
<span class='n'>nat</span><span class='k'>:</span> <span class='kt'>LogicSFK.T</span><span class='o'>[</span><span class='kt'>Int</span><span class='o'>]</span> <span class='k'>=</span> <span class='nc'>LogicSFK$$anon$3</span><span class='o'>@</span><span class='mi'>27</span><span class='n'>aea0c1</span>
<span class='n'>scala</span><span class='o'>></span> <span class='n'>run</span><span class='o'>(</span><span class='n'>nat</span><span class='o'>,</span> <span class='mi'>10</span><span class='o'>)</span>
<span class='n'>res1</span><span class='k'>:</span> <span class='kt'>List</span><span class='o'>[</span><span class='kt'>Int</span><span class='o'>]</span> <span class='k'>=</span> <span class='nc'>List</span><span class='o'>(</span><span class='mi'>0</span><span class='o'>,</span> <span class='mi'>1</span><span class='o'>,</span> <span class='mi'>2</span><span class='o'>,</span> <span class='mi'>3</span><span class='o'>,</span> <span class='mi'>4</span><span class='o'>,</span> <span class='mi'>5</span><span class='o'>,</span> <span class='mi'>6</span><span class='o'>,</span> <span class='mi'>7</span><span class='o'>,</span> <span class='mi'>8</span><span class='o'>,</span> <span class='mi'>9</span><span class='o'>)</span>
</code></pre>
</div>
<p>Well, this is a pretty complicated way to generate the natural numbers up to 10…</p>
<p>While <code>nat</code> looks like a lazy stream (as you might write in Haskell), no results are memoized (as they are in Haskell). To compute each successive number all the previous ones must be recomputed, and the running time of <code>run(nat, N)</code> is O(N<sup>2</sup>).</p>
<b>Defunctionalization</b>
<p>The code above is a fairly direct translation of the Haskell code from the paper. But its use of continuation-passing style doesn’t map well to Scala, because Scala doesn’t implement tail-call elimination (because the JVM doesn’t). Every call to a success or failure continuation adds a frame to the stack, even though all we ever do with the result is return it (i.e. the call is in <em>tail-position</em>), so the stack frame could be eliminated.</p>
<p>Surprisingly, we run out of memory before we run out of stack:</p>
<div class='highlight'><pre><code class='scala'><span class='n'>scala</span><span class='o'>></span> <span class='n'>run</span><span class='o'>(</span><span class='n'>nat</span><span class='o'>,</span> <span class='mi'>2000</span><span class='o'>)</span>
<span class='n'>java</span><span class='o'>.</span><span class='n'>lang</span><span class='o'>.</span><span class='nc'>OutOfMemoryError</span><span class='k'>:</span> <span class='kt'>Java</span> <span class='kt'>heap</span> <span class='kt'>space</span>
<span class='o'>...</span>
</code></pre>
</div>
<p>A little heap profiling shows that we’re using quadratic space as well as quadratic time. It turns out that the implementation of <code>Logic.run</code> (from the previous post) has a space leak. The call to <code>run</code> is not tail-recursive, so the stack frame hangs around, and although <code>t</code> is dead after <code>split(t)</code>, there’s still a reference to it on the stack.</p>
<p>We can rewrite <code>run</code> with an accumulator to be tail-recursive:</p>
<div class='highlight'><pre><code class='scala'> <span class='k'>def</span> <span class='n'>run</span><span class='o'>[</span><span class='kt'>A</span><span class='o'>](</span><span class='n'>t</span><span class='k'>:</span> <span class='kt'>T</span><span class='o'>[</span><span class='kt'>A</span><span class='o'>],</span> <span class='n'>n</span><span class='k'>:</span> <span class='kt'>Int</span><span class='o'>)</span><span class='k'>:</span> <span class='kt'>List</span><span class='o'>[</span><span class='kt'>A</span><span class='o'>]</span> <span class='k'>=</span> <span class='o'>{</span>
<span class='k'>def</span> <span class='n'>runAcc</span><span class='o'>(</span><span class='n'>t</span><span class='k'>:</span> <span class='kt'>T</span><span class='o'>[</span><span class='kt'>A</span><span class='o'>],</span> <span class='n'>n</span><span class='k'>:</span> <span class='kt'>Int</span><span class='o'>,</span> <span class='n'>acc</span><span class='k'>:</span> <span class='kt'>List</span><span class='o'>[</span><span class='kt'>A</span><span class='o'>])</span><span class='k'>:</span> <span class='kt'>List</span><span class='o'>[</span><span class='kt'>A</span><span class='o'>]</span> <span class='k'>=</span>
<span class='k'>if</span> <span class='o'>(</span><span class='n'>n</span> <span class='o'><=</span> <span class='mi'>0</span><span class='o'>)</span> <span class='n'>acc</span><span class='o'>.</span><span class='n'>reverse</span> <span class='k'>else</span>
<span class='n'>split</span><span class='o'>(</span><span class='n'>t</span><span class='o'>)</span> <span class='k'>match</span> <span class='o'>{</span>
<span class='k'>case</span> <span class='nc'>None</span> <span class='k'>=></span> <span class='n'>acc</span><span class='o'>.</span><span class='n'>reverse</span>
<span class='k'>case</span> <span class='nc'>Some</span><span class='o'>((</span><span class='n'>a</span><span class='o'>,</span> <span class='n'>t</span><span class='o'>))</span> <span class='k'>=></span> <span class='n'>runAcc</span><span class='o'>(</span><span class='n'>t</span><span class='o'>,</span> <span class='n'>n</span> <span class='o'>-</span> <span class='mi'>1</span><span class='o'>,</span> <span class='n'>a</span> <span class='o'>::</span> <span class='n'>acc</span><span class='o'>)</span>
<span class='o'>}</span>
<span class='n'>runAcc</span><span class='o'>(</span><span class='n'>t</span><span class='o'>,</span> <span class='n'>n</span><span class='o'>,</span> <span class='nc'>Nil</span><span class='o'>)</span>
<span class='o'>}</span>
</code></pre>
</div>
<p>Now <code>scalac</code> compiles <code>runAcc</code> as a loop, so there are no stack frames holding on to dead values of <code>t</code>, and we get the expected:</p>
<div class='highlight'><pre><code class='scala'><span class='n'>scala</span><span class='o'>></span> <span class='n'>run</span><span class='o'>(</span><span class='n'>nat</span><span class='o'>,</span> <span class='mi'>9000</span><span class='o'>)</span>
<span class='n'>java</span><span class='o'>.</span><span class='n'>lang</span><span class='o'>.</span><span class='nc'>StackOverflowError</span>
<span class='o'>...</span>
</code></pre>
</div>
<p>To address the stack overflow we turn to <em>defunctionalization</em>. The idea (from John Reynold’s classic paper <a href='http://citeseer.ist.psu.edu/viewdoc/download?doi=10.1.1.110.5892&rep=rep1&type=pdf'>Definitional Interpreters for Higher-Order Programming Languages</a>) is to replace functions and their applications with data constructors (we’ll use case classes) and an <code>apply</code> function, which matches the data constructor and does whatever the corresponding function body does. If a function captures variables, the data constructor must capture the same variables.</p>
<p>After defunctionalization we’re left with three mutually recursive <code>apply</code> functions (one for each of <code>T</code>, <code>FK</code>, and <code>SK</code>) where each recursive call is in tail position. In theory the compiler could transform these into code that takes only constant stack space (since they are local functions private to <code>split</code>). But in fact it will do so only for single recursive functions, so we will need to do this transformation by hand.</p>
<p>There is one hitch: the original code is not completely tail-recursive, because of <code>unsplit</code>, which calls a failure continuation then matches on the result. To fix this we need to add yet another continuation, which represents what to do after returning a result from a success or failure continuation.</p>
<div class='highlight'><pre><code class='scala'><span class='k'>object</span> <span class='nc'>LogicSFKDefunc</span> <span class='k'>extends</span> <span class='nc'>Logic</span> <span class='o'>{</span>
<span class='k'>type</span> <span class='kt'>O</span><span class='o'>[</span><span class='kt'>A</span><span class='o'>]</span> <span class='k'>=</span> <span class='nc'>Option</span><span class='o'>[(</span><span class='kt'>A</span>,<span class='kt'>T</span><span class='o'>[</span><span class='kt'>A</span><span class='o'>])]</span>
<span class='k'>sealed</span> <span class='k'>trait</span> <span class='nc'>T</span><span class='o'>[</span><span class='kt'>A</span><span class='o'>]</span>
<span class='nc'>case</span> <span class='k'>class</span> <span class='nc'>Fail</span><span class='o'>[</span><span class='kt'>A</span><span class='o'>]()</span> <span class='k'>extends</span> <span class='n'>T</span><span class='o'>[</span><span class='kt'>A</span><span class='o'>]</span>
<span class='k'>case</span> <span class='k'>class</span> <span class='nc'>Unit</span><span class='o'>[</span><span class='kt'>A</span><span class='o'>](</span><span class='n'>a</span><span class='k'>:</span> <span class='kt'>A</span><span class='o'>)</span> <span class='k'>extends</span> <span class='n'>T</span><span class='o'>[</span><span class='kt'>A</span><span class='o'>]</span>
<span class='k'>case</span> <span class='k'>class</span> <span class='nc'>Or</span><span class='o'>[</span><span class='kt'>A</span><span class='o'>](</span><span class='n'>t1</span><span class='k'>:</span> <span class='kt'>T</span><span class='o'>[</span><span class='kt'>A</span><span class='o'>],</span> <span class='n'>t2</span><span class='k'>:</span> <span class='o'>()</span> <span class='o'>=></span> <span class='n'>T</span><span class='o'>[</span><span class='kt'>A</span><span class='o'>])</span> <span class='k'>extends</span> <span class='n'>T</span><span class='o'>[</span><span class='kt'>A</span><span class='o'>]</span>
<span class='k'>case</span> <span class='k'>class</span> <span class='nc'>Bind</span><span class='o'>[</span><span class='kt'>A</span>,<span class='kt'>B</span><span class='o'>](</span><span class='n'>t</span><span class='k'>:</span> <span class='kt'>T</span><span class='o'>[</span><span class='kt'>A</span><span class='o'>],</span> <span class='n'>f</span><span class='k'>:</span> <span class='kt'>A</span> <span class='o'>=></span> <span class='n'>T</span><span class='o'>[</span><span class='kt'>B</span><span class='o'>])</span> <span class='k'>extends</span> <span class='n'>T</span><span class='o'>[</span><span class='kt'>B</span><span class='o'>]</span>
<span class='k'>case</span> <span class='k'>class</span> <span class='nc'>Apply</span><span class='o'>[</span><span class='kt'>A</span>,<span class='kt'>B</span><span class='o'>](</span><span class='n'>t</span><span class='k'>:</span> <span class='kt'>T</span><span class='o'>[</span><span class='kt'>A</span><span class='o'>],</span> <span class='n'>f</span><span class='k'>:</span> <span class='kt'>A</span> <span class='o'>=></span> <span class='n'>B</span><span class='o'>)</span> <span class='k'>extends</span> <span class='n'>T</span><span class='o'>[</span><span class='kt'>B</span><span class='o'>]</span>
<span class='k'>case</span> <span class='k'>class</span> <span class='nc'>Filter</span><span class='o'>[</span><span class='kt'>A</span><span class='o'>](</span><span class='n'>t</span><span class='k'>:</span> <span class='kt'>T</span><span class='o'>[</span><span class='kt'>A</span><span class='o'>],</span> <span class='n'>p</span><span class='k'>:</span> <span class='kt'>A</span> <span class='o'>=></span> <span class='nc'>Boolean</span><span class='o'>)</span> <span class='k'>extends</span> <span class='n'>T</span><span class='o'>[</span><span class='kt'>A</span><span class='o'>]</span>
<span class='k'>case</span> <span class='k'>class</span> <span class='nc'>Unsplit</span><span class='o'>[</span><span class='kt'>A</span><span class='o'>](</span><span class='n'>fk</span><span class='k'>:</span> <span class='kt'>FK</span><span class='o'>[</span><span class='kt'>O</span><span class='o'>[</span><span class='kt'>A</span><span class='o'>]])</span> <span class='k'>extends</span> <span class='n'>T</span><span class='o'>[</span><span class='kt'>A</span><span class='o'>]</span>
<span class='k'>def</span> <span class='n'>fail</span><span class='o'>[</span><span class='kt'>A</span><span class='o'>]</span> <span class='k'>=</span> <span class='nc'>Fail</span><span class='o'>()</span>
<span class='k'>def</span> <span class='n'>unit</span><span class='o'>[</span><span class='kt'>A</span><span class='o'>](</span><span class='n'>a</span><span class='k'>:</span> <span class='kt'>A</span><span class='o'>)</span> <span class='k'>=</span> <span class='nc'>Unit</span><span class='o'>(</span><span class='n'>a</span><span class='o'>)</span>
<span class='k'>def</span> <span class='n'>or</span><span class='o'>[</span><span class='kt'>A</span><span class='o'>](</span><span class='n'>t1</span><span class='k'>:</span> <span class='kt'>T</span><span class='o'>[</span><span class='kt'>A</span><span class='o'>],</span> <span class='n'>t2</span><span class='k'>:</span> <span class='o'>=></span> <span class='n'>T</span><span class='o'>[</span><span class='kt'>A</span><span class='o'>])</span> <span class='k'>=</span> <span class='nc'>Or</span><span class='o'>(</span><span class='n'>t1</span><span class='o'>,</span> <span class='o'>{</span> <span class='o'>()</span> <span class='k'>=></span> <span class='n'>t2</span> <span class='o'>})</span>
<span class='k'>def</span> <span class='n'>bind</span><span class='o'>[</span><span class='kt'>A</span>,<span class='kt'>B</span><span class='o'>](</span><span class='n'>t</span><span class='k'>:</span> <span class='kt'>T</span><span class='o'>[</span><span class='kt'>A</span><span class='o'>],</span> <span class='n'>f</span><span class='k'>:</span> <span class='kt'>A</span> <span class='o'>=></span> <span class='n'>T</span><span class='o'>[</span><span class='kt'>B</span><span class='o'>])</span> <span class='k'>=</span> <span class='nc'>Bind</span><span class='o'>(</span><span class='n'>t</span><span class='o'>,</span> <span class='n'>f</span><span class='o'>)</span>
<span class='k'>def</span> <span class='n'>apply</span><span class='o'>[</span><span class='kt'>A</span>,<span class='kt'>B</span><span class='o'>](</span><span class='n'>t</span><span class='k'>:</span> <span class='kt'>T</span><span class='o'>[</span><span class='kt'>A</span><span class='o'>],</span> <span class='n'>f</span><span class='k'>:</span> <span class='kt'>A</span> <span class='o'>=></span> <span class='n'>B</span><span class='o'>)</span> <span class='k'>=</span> <span class='nc'>Apply</span><span class='o'>(</span><span class='n'>t</span><span class='o'>,</span> <span class='n'>f</span><span class='o'>)</span>
<span class='k'>def</span> <span class='n'>filter</span><span class='o'>[</span><span class='kt'>A</span><span class='o'>](</span><span class='n'>t</span><span class='k'>:</span> <span class='kt'>T</span><span class='o'>[</span><span class='kt'>A</span><span class='o'>],</span> <span class='n'>p</span><span class='k'>:</span> <span class='kt'>A</span> <span class='o'>=></span> <span class='nc'>Boolean</span><span class='o'>)</span> <span class='k'>=</span> <span class='nc'>Filter</span><span class='o'>(</span><span class='n'>t</span><span class='o'>,</span> <span class='n'>p</span><span class='o'>)</span>
</code></pre>
</div>
<p>A choice of alternatives <code>T[A]</code> is now represented symbolically by case classes, and the functions which operate on choices just return the corresponding case. The cases capture the same variables that were captured in the original functions.</p>
<p>We have an additional case <code>Unsplit</code> which represents the <code>bind(unit(fk), unsplit)</code> combination from <code>split</code>. And we use <code>O[A]</code> as a convenient abbreviation.</p>
<div class='highlight'><pre><code class='scala'> <span class='k'>sealed</span> <span class='k'>trait</span> <span class='nc'>FK</span><span class='o'>[</span><span class='kt'>R</span><span class='o'>]</span>
<span class='nc'>case</span> <span class='k'>class</span> <span class='nc'>FKOr</span><span class='o'>[</span><span class='kt'>A</span>,<span class='kt'>R</span><span class='o'>](</span><span class='n'>t</span><span class='k'>:</span> <span class='o'>()</span> <span class='o'>=></span> <span class='n'>T</span><span class='o'>[</span><span class='kt'>A</span><span class='o'>],</span> <span class='n'>sk</span><span class='k'>:</span> <span class='kt'>SK</span><span class='o'>[</span><span class='kt'>A</span>,<span class='kt'>R</span><span class='o'>],</span> <span class='n'>fk</span><span class='k'>:</span> <span class='kt'>FK</span><span class='o'>[</span><span class='kt'>R</span><span class='o'>])</span>
<span class='k'>extends</span> <span class='nc'>FK</span><span class='o'>[</span><span class='kt'>R</span><span class='o'>]</span>
<span class='k'>case</span> <span class='k'>class</span> <span class='nc'>FKSplit</span><span class='o'>[</span><span class='kt'>R</span><span class='o'>](</span><span class='n'>r</span><span class='k'>:</span> <span class='kt'>R</span><span class='o'>)</span> <span class='k'>extends</span> <span class='nc'>FK</span><span class='o'>[</span><span class='kt'>R</span><span class='o'>]</span>
<span class='k'>sealed</span> <span class='k'>trait</span> <span class='nc'>SK</span><span class='o'>[</span><span class='kt'>A</span>,<span class='kt'>R</span><span class='o'>]</span>
<span class='nc'>case</span> <span class='k'>class</span> <span class='nc'>SKBind</span><span class='o'>[</span><span class='kt'>A</span>,<span class='kt'>B</span>,<span class='kt'>R</span><span class='o'>](</span><span class='n'>f</span><span class='k'>:</span> <span class='kt'>A</span> <span class='o'>=></span> <span class='n'>T</span><span class='o'>[</span><span class='kt'>B</span><span class='o'>],</span> <span class='n'>sk</span><span class='k'>:</span> <span class='kt'>SK</span><span class='o'>[</span><span class='kt'>B</span>,<span class='kt'>R</span><span class='o'>])</span>
<span class='k'>extends</span> <span class='nc'>SK</span><span class='o'>[</span><span class='kt'>A</span>,<span class='kt'>R</span><span class='o'>]</span>
<span class='k'>case</span> <span class='k'>class</span> <span class='nc'>SKApply</span><span class='o'>[</span><span class='kt'>A</span>,<span class='kt'>B</span>,<span class='kt'>R</span><span class='o'>](</span><span class='n'>f</span><span class='k'>:</span> <span class='kt'>A</span> <span class='o'>=></span> <span class='n'>B</span><span class='o'>,</span> <span class='n'>sk</span><span class='k'>:</span> <span class='kt'>SK</span><span class='o'>[</span><span class='kt'>B</span>,<span class='kt'>R</span><span class='o'>])</span>
<span class='k'>extends</span> <span class='nc'>SK</span><span class='o'>[</span><span class='kt'>A</span>,<span class='kt'>R</span><span class='o'>]</span>
<span class='k'>case</span> <span class='k'>class</span> <span class='nc'>SKFilter</span><span class='o'>[</span><span class='kt'>A</span>,<span class='kt'>R</span><span class='o'>](</span><span class='n'>p</span><span class='k'>:</span> <span class='kt'>A</span> <span class='o'>=></span> <span class='nc'>Boolean</span><span class='o'>,</span> <span class='n'>sk</span><span class='k'>:</span> <span class='kt'>SK</span><span class='o'>[</span><span class='kt'>A</span>,<span class='kt'>R</span><span class='o'>])</span>
<span class='k'>extends</span> <span class='nc'>SK</span><span class='o'>[</span><span class='kt'>A</span>,<span class='kt'>R</span><span class='o'>]</span>
<span class='k'>case</span> <span class='k'>class</span> <span class='nc'>SKSplit</span><span class='o'>[</span><span class='kt'>A</span>,<span class='kt'>R</span><span class='o'>](</span><span class='n'>r</span><span class='k'>:</span> <span class='o'>(</span><span class='kt'>A</span><span class='o'>,</span> <span class='kt'>FK</span><span class='o'>[</span><span class='kt'>R</span><span class='o'>])</span> <span class='k'>=></span> <span class='n'>R</span><span class='o'>)</span> <span class='k'>extends</span> <span class='nc'>SK</span><span class='o'>[</span><span class='kt'>A</span>,<span class='kt'>R</span><span class='o'>]</span>
<span class='k'>sealed</span> <span class='k'>trait</span> <span class='nc'>K</span><span class='o'>[</span><span class='kt'>R</span>,<span class='kt'>R2</span><span class='o'>]</span>
<span class='nc'>case</span> <span class='k'>class</span> <span class='nc'>KReturn</span><span class='o'>[</span><span class='kt'>R</span><span class='o'>]()</span> <span class='k'>extends</span> <span class='n'>K</span><span class='o'>[</span><span class='kt'>R</span>,<span class='kt'>R</span><span class='o'>]</span>
<span class='k'>case</span> <span class='k'>class</span> <span class='nc'>KUnsplit</span><span class='o'>[</span><span class='kt'>A</span>,<span class='kt'>R</span>,<span class='kt'>R2</span><span class='o'>](</span><span class='n'>sk</span><span class='k'>:</span> <span class='kt'>SK</span><span class='o'>[</span><span class='kt'>A</span>,<span class='kt'>R</span><span class='o'>],</span> <span class='n'>fk</span><span class='k'>:</span><span class='kt'>FK</span><span class='o'>[</span><span class='kt'>R</span><span class='o'>],</span> <span class='n'>k</span><span class='k'>:</span> <span class='kt'>K</span><span class='o'>[</span><span class='kt'>R</span>,<span class='kt'>R2</span><span class='o'>])</span>
<span class='k'>extends</span> <span class='n'>K</span><span class='o'>[</span><span class='kt'>O</span><span class='o'>[</span><span class='kt'>A</span><span class='o'>]</span>,<span class='kt'>R2</span><span class='o'>]</span>
</code></pre>
</div>
<p>Each case for <code>FK</code> (respectively <code>SK</code>) corresponds to a success (respectively failure) continuation function in the original code—it’s easy to match them up.</p>
<p>The <code>K</code> cases are for the new return continuation. They are defunctionalized from functions <code>R => R2</code>; we can either return a value directly, or match on whether it is <code>Some</code> or <code>None</code> as in <code>unsplit</code>. (If <code>K</code> is hard to understand you might try “refunctionalizing” it by replacing the cases with functions.)</p>
<p>We see that case classes are more powerful than variants in OCaml, without <a href='https://sites.google.com/site/ocamlgadt/'>GADTs</a> at least. Cases can have “input” type variables (appearing in arguments) which do not appear in the “output” (the type the case extends). When we match on the case these are treated as existentials. And the output type of a case can be more restrictive than type it extends; when we match on the case we can make more restrictive assumptions about types in that branch of the match. More on this in Emir, Odersky, and Williams’ <a href='http://citeseer.ist.psu.edu/viewdoc/download?doi=10.1.1.88.5295&rep=rep1&type=pdf'>Matching Objects with Patterns</a>.</p>
<div class='highlight'><pre><code class='scala'> <span class='k'>def</span> <span class='n'>split</span><span class='o'>[</span><span class='kt'>A</span><span class='o'>](</span><span class='n'>t</span><span class='k'>:</span> <span class='kt'>T</span><span class='o'>[</span><span class='kt'>A</span><span class='o'>])</span> <span class='k'>=</span> <span class='o'>{</span>
<span class='k'>def</span> <span class='n'>applyT</span><span class='o'>[</span><span class='kt'>A</span>,<span class='kt'>R</span>,<span class='kt'>R2</span><span class='o'>]</span>
<span class='o'>(</span><span class='n'>t</span><span class='k'>:</span> <span class='kt'>T</span><span class='o'>[</span><span class='kt'>A</span><span class='o'>],</span> <span class='n'>sk</span><span class='k'>:</span> <span class='kt'>SK</span><span class='o'>[</span><span class='kt'>A</span>,<span class='kt'>R</span><span class='o'>],</span> <span class='n'>fk</span><span class='k'>:</span> <span class='kt'>FK</span><span class='o'>[</span><span class='kt'>R</span><span class='o'>],</span> <span class='n'>k</span><span class='k'>:</span> <span class='kt'>K</span><span class='o'>[</span><span class='kt'>R</span>,<span class='kt'>R2</span><span class='o'>])</span><span class='k'>:</span> <span class='kt'>R2</span> <span class='o'>=</span>
<span class='n'>t</span> <span class='k'>match</span> <span class='o'>{</span>
<span class='k'>case</span> <span class='nc'>Fail</span><span class='o'>()</span> <span class='k'>=></span> <span class='n'>applyFK</span><span class='o'>(</span><span class='n'>fk</span><span class='o'>,</span> <span class='n'>k</span><span class='o'>)</span>
<span class='k'>case</span> <span class='nc'>Unit</span><span class='o'>(</span><span class='n'>a</span><span class='o'>)</span> <span class='k'>=></span> <span class='n'>applySK</span><span class='o'>(</span><span class='n'>sk</span><span class='o'>,</span> <span class='n'>a</span><span class='o'>,</span> <span class='n'>fk</span><span class='o'>,</span> <span class='n'>k</span><span class='o'>)</span>
<span class='k'>case</span> <span class='nc'>Or</span><span class='o'>(</span><span class='n'>t1</span><span class='o'>,</span> <span class='n'>t2</span><span class='o'>)</span> <span class='k'>=></span> <span class='n'>applyT</span><span class='o'>(</span><span class='n'>t1</span><span class='o'>,</span> <span class='n'>sk</span><span class='o'>,</span> <span class='nc'>FKOr</span><span class='o'>(</span><span class='n'>t2</span><span class='o'>,</span> <span class='n'>sk</span><span class='o'>,</span> <span class='n'>fk</span><span class='o'>),</span> <span class='n'>k</span><span class='o'>)</span>
<span class='k'>case</span> <span class='nc'>Bind</span><span class='o'>(</span><span class='n'>t</span><span class='o'>,</span> <span class='n'>f</span><span class='o'>)</span> <span class='k'>=></span> <span class='n'>applyT</span><span class='o'>(</span><span class='n'>t</span><span class='o'>,</span> <span class='nc'>SKBind</span><span class='o'>(</span><span class='n'>f</span><span class='o'>,</span> <span class='n'>sk</span><span class='o'>),</span> <span class='n'>fk</span><span class='o'>,</span> <span class='n'>k</span><span class='o'>)</span>
<span class='k'>case</span> <span class='nc'>Apply</span><span class='o'>(</span><span class='n'>t</span><span class='o'>,</span> <span class='n'>f</span><span class='o'>)</span> <span class='k'>=></span> <span class='n'>applyT</span><span class='o'>(</span><span class='n'>t</span><span class='o'>,</span> <span class='nc'>SKApply</span><span class='o'>(</span><span class='n'>f</span><span class='o'>,</span> <span class='n'>sk</span><span class='o'>),</span> <span class='n'>fk</span><span class='o'>,</span> <span class='n'>k</span><span class='o'>)</span>
<span class='k'>case</span> <span class='nc'>Filter</span><span class='o'>(</span><span class='n'>t</span><span class='o'>,</span> <span class='n'>p</span><span class='o'>)</span> <span class='k'>=></span> <span class='n'>applyT</span><span class='o'>(</span><span class='n'>t</span><span class='o'>,</span> <span class='nc'>SKFilter</span><span class='o'>(</span><span class='n'>p</span><span class='o'>,</span> <span class='n'>sk</span><span class='o'>),</span> <span class='n'>fk</span><span class='o'>,</span> <span class='n'>k</span><span class='o'>)</span>
<span class='k'>case</span> <span class='nc'>Unsplit</span><span class='o'>(</span><span class='n'>fk2</span><span class='o'>)</span> <span class='k'>=></span> <span class='n'>applyFK</span><span class='o'>(</span><span class='n'>fk2</span><span class='o'>,</span> <span class='nc'>KUnsplit</span><span class='o'>(</span><span class='n'>sk</span><span class='o'>,</span> <span class='n'>fk</span><span class='o'>,</span> <span class='n'>k</span><span class='o'>))</span>
<span class='o'>}</span>
<span class='k'>def</span> <span class='n'>applyFK</span><span class='o'>[</span><span class='kt'>R</span>,<span class='kt'>R2</span><span class='o'>](</span><span class='n'>fk</span><span class='k'>:</span> <span class='kt'>FK</span><span class='o'>[</span><span class='kt'>R</span><span class='o'>],</span> <span class='n'>k</span><span class='k'>:</span> <span class='kt'>K</span><span class='o'>[</span><span class='kt'>R</span>,<span class='kt'>R2</span><span class='o'>])</span><span class='k'>:</span> <span class='kt'>R2</span> <span class='o'>=</span>
<span class='n'>fk</span> <span class='k'>match</span> <span class='o'>{</span>
<span class='k'>case</span> <span class='nc'>FKOr</span><span class='o'>(</span><span class='n'>t</span><span class='o'>,</span> <span class='n'>sk</span><span class='o'>,</span> <span class='n'>fk</span><span class='o'>)</span> <span class='k'>=></span> <span class='n'>applyT</span><span class='o'>(</span><span class='n'>t</span><span class='o'>(),</span> <span class='n'>sk</span><span class='o'>,</span> <span class='n'>fk</span><span class='o'>,</span> <span class='n'>k</span><span class='o'>)</span>
<span class='k'>case</span> <span class='nc'>FKSplit</span><span class='o'>(</span><span class='n'>r</span><span class='o'>)</span> <span class='k'>=></span> <span class='n'>applyK</span><span class='o'>(</span><span class='n'>k</span><span class='o'>,</span> <span class='n'>r</span><span class='o'>)</span>
<span class='o'>}</span>
<span class='k'>def</span> <span class='n'>applySK</span><span class='o'>[</span><span class='kt'>A</span>,<span class='kt'>R</span>,<span class='kt'>R2</span><span class='o'>]</span>
<span class='o'>(</span><span class='n'>sk</span><span class='k'>:</span> <span class='kt'>SK</span><span class='o'>[</span><span class='kt'>A</span>,<span class='kt'>R</span><span class='o'>],</span> <span class='n'>a</span><span class='k'>:</span> <span class='kt'>A</span><span class='o'>,</span> <span class='n'>fk</span><span class='k'>:</span> <span class='kt'>FK</span><span class='o'>[</span><span class='kt'>R</span><span class='o'>],</span> <span class='n'>k</span><span class='k'>:</span> <span class='kt'>K</span><span class='o'>[</span><span class='kt'>R</span>,<span class='kt'>R2</span><span class='o'>])</span><span class='k'>:</span> <span class='kt'>R2</span> <span class='o'>=</span>
<span class='n'>sk</span> <span class='k'>match</span> <span class='o'>{</span>
<span class='k'>case</span> <span class='nc'>SKBind</span><span class='o'>(</span><span class='n'>f</span><span class='o'>,</span> <span class='n'>sk</span><span class='o'>)</span> <span class='k'>=></span> <span class='n'>applyT</span><span class='o'>(</span><span class='n'>f</span><span class='o'>(</span><span class='n'>a</span><span class='o'>),</span> <span class='n'>sk</span><span class='o'>,</span> <span class='n'>fk</span><span class='o'>,</span> <span class='n'>k</span><span class='o'>)</span>
<span class='k'>case</span> <span class='nc'>SKApply</span><span class='o'>(</span><span class='n'>f</span><span class='o'>,</span> <span class='n'>sk</span><span class='o'>)</span> <span class='k'>=></span> <span class='n'>applySK</span><span class='o'>(</span><span class='n'>sk</span><span class='o'>,</span> <span class='n'>f</span><span class='o'>(</span><span class='n'>a</span><span class='o'>),</span> <span class='n'>fk</span><span class='o'>,</span> <span class='n'>k</span><span class='o'>)</span>
<span class='k'>case</span> <span class='nc'>SKFilter</span><span class='o'>(</span><span class='n'>p</span><span class='o'>,</span> <span class='n'>sk</span><span class='o'>)</span> <span class='k'>=></span>
<span class='k'>if</span> <span class='o'>(</span><span class='n'>p</span><span class='o'>(</span><span class='n'>a</span><span class='o'>))</span> <span class='n'>applySK</span><span class='o'>(</span><span class='n'>sk</span><span class='o'>,</span> <span class='n'>a</span><span class='o'>,</span> <span class='n'>fk</span><span class='o'>,</span> <span class='n'>k</span><span class='o'>)</span> <span class='k'>else</span> <span class='n'>applyFK</span><span class='o'>(</span><span class='n'>fk</span><span class='o'>,</span> <span class='n'>k</span><span class='o'>)</span>
<span class='k'>case</span> <span class='nc'>SKSplit</span><span class='o'>(</span><span class='n'>rf</span><span class='o'>)</span> <span class='k'>=></span> <span class='n'>applyK</span><span class='o'>(</span><span class='n'>k</span><span class='o'>,</span> <span class='n'>rf</span><span class='o'>(</span><span class='n'>a</span><span class='o'>,</span> <span class='n'>fk</span><span class='o'>))</span>
<span class='o'>}</span>
</code></pre>
</div>
<p>Again, each of these cases corresponds directly to a function in the original code, and again it is easy to match them up (modulo the extra return continuation argument) to see that all we have done is separated the data part of the function (i.e. the captured variables) from the code part.</p>
<p>The exception is <code>Unsplit</code>, which again corresponds to <code>bind(unit(fk),
unsplit)</code>. To apply it, we apply <code>fk</code> (which collapses <code>unit(fk)</code>, <code>bind</code>, and the application of <code>fk</code> in <code>unsplit</code>) with <code>KUnsplit</code> as continuation, capturing <code>sk</code>, <code>fk</code>, and <code>k</code> (corresponding to their capture in the success continuation of <code>bind</code>).</p>
<div class='highlight'><pre><code class='scala'> <span class='k'>def</span> <span class='n'>applyK</span><span class='o'>[</span><span class='kt'>R</span>,<span class='kt'>R2</span><span class='o'>](</span><span class='n'>k</span><span class='k'>:</span> <span class='kt'>K</span><span class='o'>[</span><span class='kt'>R</span>,<span class='kt'>R2</span><span class='o'>],</span> <span class='n'>r</span><span class='k'>:</span> <span class='kt'>R</span><span class='o'>)</span><span class='k'>:</span> <span class='kt'>R2</span> <span class='o'>=</span>
<span class='n'>k</span> <span class='k'>match</span> <span class='o'>{</span>
<span class='k'>case</span> <span class='nc'>KReturn</span><span class='o'>()</span> <span class='k'>=></span> <span class='n'>r</span><span class='o'>.</span><span class='n'>asInstanceOf</span><span class='o'>[</span><span class='kt'>R2</span><span class='o'>]</span>
<span class='k'>case</span> <span class='nc'>KUnsplit</span><span class='o'>(</span><span class='n'>sk</span><span class='o'>,</span> <span class='n'>fk</span><span class='o'>,</span> <span class='n'>k</span><span class='o'>)</span> <span class='k'>=></span> <span class='o'>{</span>
<span class='n'>r</span> <span class='k'>match</span> <span class='o'>{</span>
<span class='k'>case</span> <span class='nc'>None</span> <span class='k'>=></span> <span class='n'>applyFK</span><span class='o'>(</span><span class='n'>fk</span><span class='o'>,</span> <span class='n'>k</span><span class='o'>)</span>
<span class='k'>case</span> <span class='nc'>Some</span><span class='o'>((</span><span class='n'>a</span><span class='o'>,</span> <span class='n'>t</span><span class='o'>))</span> <span class='k'>=></span> <span class='n'>applyT</span><span class='o'>(</span><span class='n'>or</span><span class='o'>(</span><span class='n'>unit</span><span class='o'>(</span><span class='n'>a</span><span class='o'>),</span> <span class='n'>t</span><span class='o'>),</span> <span class='n'>sk</span><span class='o'>,</span> <span class='n'>fk</span><span class='o'>,</span> <span class='n'>k</span><span class='o'>)</span>
<span class='o'>}</span>
<span class='o'>}</span>
<span class='o'>}</span>
</code></pre>
</div>
<p>For <code>KReturn</code> we just return the result. Although <code>KReturn</code> extends <code>K[R,R]</code>, Scala doesn’t deduce from this that <code>R</code> = <code>R2</code>, so we must coerce the result. For <code>KUnsplit</code> we do the same match as <code>unsplit</code>, then apply the resulting <code>T</code> (for the <code>None</code> case we call the failure continuation directly instead of applying <code>fail</code>). Here Scala deduces from the return type of <code>KUnsplit</code> that is safe to treat <code>r</code> as an <code>Option</code>.</p>
<div class='highlight'><pre><code class='scala'> <span class='n'>applyT</span><span class='o'>[</span><span class='kt'>A</span>,<span class='kt'>O</span><span class='o'>[</span><span class='kt'>A</span><span class='o'>]</span>,<span class='kt'>O</span><span class='o'>[</span><span class='kt'>A</span><span class='o'>]](</span>
<span class='n'>t</span><span class='o'>,</span>
<span class='nc'>SKSplit</span><span class='o'>((</span><span class='n'>a</span><span class='o'>,</span> <span class='n'>fk</span><span class='o'>)</span> <span class='k'>=></span> <span class='nc'>Some</span><span class='o'>((</span><span class='n'>a</span><span class='o'>,</span> <span class='nc'>Unsplit</span><span class='o'>(</span><span class='n'>fk</span><span class='o'>)))),</span>
<span class='nc'>FKSplit</span><span class='o'>(</span><span class='nc'>None</span><span class='o'>),</span>
<span class='nc'>KReturn</span><span class='o'>())</span>
<span class='o'>}</span>
<span class='o'>}</span>
</code></pre>
</div>
<p>Finally we apply the input <code>T</code> in correspondence to the original <code>split</code>.</p>
<b>Tail call elimination</b>
<p>(This section has been revised; you can see the original <a href='https://github.com/jaked/ambassadortothecomputers.blogspot.com/tree/ba9621fc48ff84e01d9f70d076cc912b8185729d'>here</a>.)</p>
<p>To eliminate the stack frames from tail calls, we next rewrite the four mutually-recursive functions into a single recursive function (which Scala compiles as a loop). To do this we have to abandon some type safety (but only in the implementation of the <code>Logic</code> monad; we’ll still present the same safe interface).</p>
<div class='highlight'><pre><code class='scala'><span class='k'>object</span> <span class='nc'>LogicSFKDefuncTailrec</span> <span class='k'>extends</span> <span class='nc'>Logic</span> <span class='o'>{</span>
<span class='k'>type</span> <span class='kt'>O</span><span class='o'>[</span><span class='kt'>A</span><span class='o'>]</span> <span class='k'>=</span> <span class='nc'>Option</span><span class='o'>[(</span><span class='kt'>A</span>,<span class='kt'>T</span><span class='o'>[</span><span class='kt'>A</span><span class='o'>])]</span>
<span class='k'>type</span> <span class='kt'>T</span><span class='o'>[</span><span class='kt'>A</span><span class='o'>]</span> <span class='k'>=</span> <span class='n'>I</span>
<span class='k'>sealed</span> <span class='k'>trait</span> <span class='nc'>I</span>
<span class='k'>case</span> <span class='k'>class</span> <span class='nc'>Fail</span><span class='o'>()</span> <span class='k'>extends</span> <span class='n'>I</span>
<span class='k'>case</span> <span class='k'>class</span> <span class='nc'>Unit</span><span class='o'>(</span><span class='n'>a</span><span class='k'>:</span> <span class='kt'>Any</span><span class='o'>)</span> <span class='k'>extends</span> <span class='n'>I</span>
<span class='k'>case</span> <span class='k'>class</span> <span class='nc'>Or</span><span class='o'>(</span><span class='n'>t1</span><span class='k'>:</span> <span class='kt'>I</span><span class='o'>,</span> <span class='n'>t2</span><span class='k'>:</span> <span class='o'>()</span> <span class='o'>=></span> <span class='n'>I</span><span class='o'>)</span> <span class='k'>extends</span> <span class='n'>I</span>
<span class='k'>case</span> <span class='k'>class</span> <span class='nc'>Bind</span><span class='o'>(</span><span class='n'>t</span><span class='k'>:</span> <span class='kt'>I</span><span class='o'>,</span> <span class='n'>f</span><span class='k'>:</span> <span class='kt'>Any</span> <span class='o'>=></span> <span class='n'>I</span><span class='o'>)</span> <span class='k'>extends</span> <span class='n'>I</span>
<span class='k'>case</span> <span class='k'>class</span> <span class='nc'>Apply</span><span class='o'>(</span><span class='n'>t</span><span class='k'>:</span> <span class='kt'>I</span><span class='o'>,</span> <span class='n'>f</span><span class='k'>:</span> <span class='kt'>Any</span> <span class='o'>=></span> <span class='nc'>Any</span><span class='o'>)</span> <span class='k'>extends</span> <span class='n'>I</span>
<span class='k'>case</span> <span class='k'>class</span> <span class='nc'>Filter</span><span class='o'>(</span><span class='n'>t</span><span class='k'>:</span> <span class='kt'>I</span><span class='o'>,</span> <span class='n'>p</span><span class='k'>:</span> <span class='kt'>Any</span> <span class='o'>=></span> <span class='nc'>Boolean</span><span class='o'>)</span> <span class='k'>extends</span> <span class='n'>I</span>
<span class='k'>case</span> <span class='k'>class</span> <span class='nc'>Unsplit</span><span class='o'>(</span><span class='n'>fk</span><span class='k'>:</span> <span class='kt'>I</span><span class='o'>)</span> <span class='k'>extends</span> <span class='n'>I</span>
<span class='k'>case</span> <span class='k'>class</span> <span class='nc'>FKOr</span><span class='o'>(</span><span class='n'>t</span><span class='k'>:</span> <span class='o'>()</span> <span class='o'>=></span> <span class='n'>I</span><span class='o'>,</span> <span class='n'>sk</span><span class='k'>:</span> <span class='kt'>I</span><span class='o'>,</span> <span class='n'>fk</span><span class='k'>:</span> <span class='kt'>I</span><span class='o'>)</span> <span class='k'>extends</span> <span class='n'>I</span>
<span class='k'>case</span> <span class='k'>class</span> <span class='nc'>FKSplit</span><span class='o'>(</span><span class='n'>r</span><span class='k'>:</span> <span class='kt'>O</span><span class='o'>[</span><span class='kt'>Any</span><span class='o'>])</span> <span class='k'>extends</span> <span class='n'>I</span>
<span class='k'>case</span> <span class='k'>class</span> <span class='nc'>SKBind</span><span class='o'>(</span><span class='n'>f</span><span class='k'>:</span> <span class='kt'>Any</span> <span class='o'>=></span> <span class='n'>I</span><span class='o'>,</span> <span class='n'>sk</span><span class='k'>:</span> <span class='kt'>I</span><span class='o'>)</span> <span class='k'>extends</span> <span class='n'>I</span>
<span class='k'>case</span> <span class='k'>class</span> <span class='nc'>SKApply</span><span class='o'>(</span><span class='n'>f</span><span class='k'>:</span> <span class='kt'>Any</span> <span class='o'>=></span> <span class='nc'>Any</span><span class='o'>,</span> <span class='n'>sk</span><span class='k'>:</span> <span class='kt'>I</span><span class='o'>)</span> <span class='k'>extends</span> <span class='n'>I</span>
<span class='k'>case</span> <span class='k'>class</span> <span class='nc'>SKFilter</span><span class='o'>(</span><span class='n'>p</span><span class='k'>:</span> <span class='kt'>Any</span> <span class='o'>=></span> <span class='nc'>Boolean</span><span class='o'>,</span> <span class='n'>sk</span><span class='k'>:</span> <span class='kt'>I</span><span class='o'>)</span> <span class='k'>extends</span> <span class='n'>I</span>
<span class='k'>case</span> <span class='k'>class</span> <span class='nc'>SKSplit</span><span class='o'>(</span><span class='n'>r</span><span class='k'>:</span> <span class='o'>(</span><span class='kt'>Any</span><span class='o'>,</span> <span class='kt'>I</span><span class='o'>)</span> <span class='k'>=></span> <span class='n'>O</span><span class='o'>[</span><span class='kt'>Any</span><span class='o'>])</span> <span class='k'>extends</span> <span class='n'>I</span>
<span class='k'>case</span> <span class='k'>object</span> <span class='nc'>KReturn</span> <span class='k'>extends</span> <span class='n'>I</span>
<span class='k'>case</span> <span class='k'>class</span> <span class='nc'>KUnsplit</span><span class='o'>(</span><span class='n'>sk</span><span class='k'>:</span> <span class='kt'>I</span><span class='o'>,</span> <span class='n'>fk</span><span class='k'>:</span> <span class='kt'>I</span><span class='o'>,</span> <span class='n'>k</span><span class='k'>:</span> <span class='kt'>I</span><span class='o'>)</span> <span class='k'>extends</span> <span class='n'>I</span>
</code></pre>
</div>
<p>This is all pretty much as before except that we erase all the type parameters. Having done so we can combine the four defunctionalized types into a single type <code>I</code> (for “instruction” perhaps), which will allow us to write a single recursive <code>apply</code> function. The type parameter in <code>T[A]</code> is then a <em>phantom type</em> since it does not appear on the right-hand side of the definition; it is used only to enforce constraints outside the module.</p>
<div class='highlight'><pre><code class='scala'> <span class='k'>def</span> <span class='n'>fail</span><span class='o'>[</span><span class='kt'>A</span><span class='o'>]</span><span class='k'>:</span> <span class='kt'>T</span><span class='o'>[</span><span class='kt'>A</span><span class='o'>]</span> <span class='k'>=</span> <span class='nc'>Fail</span><span class='o'>()</span>
<span class='k'>def</span> <span class='n'>unit</span><span class='o'>[</span><span class='kt'>A</span><span class='o'>](</span><span class='n'>a</span><span class='k'>:</span> <span class='kt'>A</span><span class='o'>)</span><span class='k'>:</span> <span class='kt'>T</span><span class='o'>[</span><span class='kt'>A</span><span class='o'>]</span> <span class='k'>=</span> <span class='nc'>Unit</span><span class='o'>(</span><span class='n'>a</span><span class='o'>)</span>
<span class='k'>def</span> <span class='n'>or</span><span class='o'>[</span><span class='kt'>A</span><span class='o'>](</span><span class='n'>t1</span><span class='k'>:</span> <span class='kt'>T</span><span class='o'>[</span><span class='kt'>A</span><span class='o'>],</span> <span class='n'>t2</span><span class='k'>:</span> <span class='o'>=></span> <span class='n'>T</span><span class='o'>[</span><span class='kt'>A</span><span class='o'>])</span><span class='k'>:</span> <span class='kt'>T</span><span class='o'>[</span><span class='kt'>A</span><span class='o'>]</span> <span class='k'>=</span> <span class='nc'>Or</span><span class='o'>(</span><span class='n'>t1</span><span class='o'>,</span> <span class='o'>{</span> <span class='o'>()</span> <span class='k'>=></span> <span class='n'>t2</span> <span class='o'>})</span>
<span class='k'>def</span> <span class='n'>bind</span><span class='o'>[</span><span class='kt'>A</span>,<span class='kt'>B</span><span class='o'>](</span><span class='n'>t</span><span class='k'>:</span> <span class='kt'>T</span><span class='o'>[</span><span class='kt'>A</span><span class='o'>],</span> <span class='n'>f</span><span class='k'>:</span> <span class='kt'>A</span> <span class='o'>=></span> <span class='n'>T</span><span class='o'>[</span><span class='kt'>B</span><span class='o'>])</span><span class='k'>:</span> <span class='kt'>T</span><span class='o'>[</span><span class='kt'>B</span><span class='o'>]</span> <span class='k'>=</span>
<span class='nc'>Bind</span><span class='o'>(</span><span class='n'>t</span><span class='o'>,</span> <span class='n'>f</span><span class='o'>.</span><span class='n'>asInstanceOf</span><span class='o'>[</span><span class='kt'>Any</span> <span class='k'>=></span> <span class='kt'>I</span><span class='o'>])</span>
<span class='k'>def</span> <span class='n'>apply</span><span class='o'>[</span><span class='kt'>A</span>,<span class='kt'>B</span><span class='o'>](</span><span class='n'>t</span><span class='k'>:</span> <span class='kt'>T</span><span class='o'>[</span><span class='kt'>A</span><span class='o'>],</span> <span class='n'>f</span><span class='k'>:</span> <span class='kt'>A</span> <span class='o'>=></span> <span class='n'>B</span><span class='o'>)</span><span class='k'>:</span> <span class='kt'>T</span><span class='o'>[</span><span class='kt'>B</span><span class='o'>]</span> <span class='k'>=</span>
<span class='nc'>Apply</span><span class='o'>(</span><span class='n'>t</span><span class='o'>,</span> <span class='n'>f</span><span class='o'>.</span><span class='n'>asInstanceOf</span><span class='o'>[</span><span class='kt'>Any</span> <span class='k'>=></span> <span class='kt'>I</span><span class='o'>])</span>
<span class='k'>def</span> <span class='n'>filter</span><span class='o'>[</span><span class='kt'>A</span><span class='o'>](</span><span class='n'>t</span><span class='k'>:</span> <span class='kt'>T</span><span class='o'>[</span><span class='kt'>A</span><span class='o'>],</span> <span class='n'>p</span><span class='k'>:</span> <span class='kt'>A</span> <span class='o'>=></span> <span class='nc'>Boolean</span><span class='o'>)</span><span class='k'>:</span> <span class='kt'>T</span><span class='o'>[</span><span class='kt'>A</span><span class='o'>]</span> <span class='k'>=</span>
<span class='nc'>Filter</span><span class='o'>(</span><span class='n'>t</span><span class='o'>,</span> <span class='n'>p</span><span class='o'>.</span><span class='n'>asInstanceOf</span><span class='o'>[</span><span class='kt'>Any</span> <span class='k'>=></span> <span class='kt'>Boolean</span><span class='o'>])</span>
</code></pre>
</div>
<p>The functions for building <code>T[A]</code> values are mostly the same. We have to cast passed-in functions since <code>Any</code> is not a subtype of arbitrary <code>A</code>. The return type annotations don’t seem necessary but I saw some strange type errors without them (possibly related to the phantom type?) when using the <code>Logic.Syntax</code> wrapper.</p>
<div class='highlight'><pre><code class='scala'><span class='k'>def</span> <span class='n'>split</span><span class='o'>[</span><span class='kt'>A</span><span class='o'>](</span><span class='n'>t</span><span class='k'>:</span> <span class='kt'>T</span><span class='o'>[</span><span class='kt'>A</span><span class='o'>])</span><span class='k'>:</span> <span class='kt'>O</span><span class='o'>[</span><span class='kt'>A</span><span class='o'>]</span> <span class='k'>=</span> <span class='o'>{</span>
<span class='k'>def</span> <span class='n'>apply</span><span class='o'>(</span><span class='n'>i</span><span class='k'>:</span> <span class='kt'>I</span><span class='o'>,</span> <span class='n'>a</span><span class='k'>:</span> <span class='kt'>Any</span><span class='o'>,</span> <span class='n'>r</span><span class='k'>:</span> <span class='kt'>O</span><span class='o'>[</span><span class='kt'>Any</span><span class='o'>],</span> <span class='n'>sk</span><span class='k'>:</span> <span class='kt'>I</span><span class='o'>,</span> <span class='n'>fk</span><span class='k'>:</span> <span class='kt'>I</span><span class='o'>,</span> <span class='n'>k</span><span class='k'>:</span> <span class='kt'>I</span><span class='o'>)</span><span class='k'>:</span> <span class='kt'>O</span><span class='o'>[</span><span class='kt'>Any</span><span class='o'>]</span> <span class='k'>=</span>
<span class='n'>i</span> <span class='k'>match</span> <span class='o'>{</span>
<span class='k'>case</span> <span class='nc'>Fail</span><span class='o'>()</span> <span class='k'>=></span> <span class='n'>apply</span><span class='o'>(</span><span class='n'>fk</span><span class='o'>,</span> <span class='kc'>null</span><span class='o'>,</span> <span class='kc'>null</span><span class='o'>,</span> <span class='kc'>null</span><span class='o'>,</span> <span class='kc'>null</span><span class='o'>,</span> <span class='n'>k</span><span class='o'>)</span>
<span class='k'>case</span> <span class='nc'>Unit</span><span class='o'>(</span><span class='n'>a</span><span class='o'>)</span> <span class='k'>=></span> <span class='n'>apply</span><span class='o'>(</span><span class='n'>sk</span><span class='o'>,</span> <span class='n'>a</span><span class='o'>,</span> <span class='kc'>null</span><span class='o'>,</span> <span class='kc'>null</span><span class='o'>,</span> <span class='n'>fk</span><span class='o'>,</span> <span class='n'>k</span><span class='o'>)</span>
<span class='k'>case</span> <span class='nc'>Or</span><span class='o'>(</span><span class='n'>t1</span><span class='o'>,</span> <span class='n'>t2</span><span class='o'>)</span> <span class='k'>=></span>
<span class='n'>apply</span><span class='o'>(</span><span class='n'>t1</span><span class='o'>,</span> <span class='kc'>null</span><span class='o'>,</span> <span class='kc'>null</span><span class='o'>,</span> <span class='n'>sk</span><span class='o'>,</span> <span class='nc'>FKOr</span><span class='o'>(</span><span class='n'>t2</span><span class='o'>,</span> <span class='n'>sk</span><span class='o'>,</span> <span class='n'>fk</span><span class='o'>),</span> <span class='n'>k</span><span class='o'>)</span>
<span class='k'>case</span> <span class='nc'>Bind</span><span class='o'>(</span><span class='n'>t</span><span class='o'>,</span> <span class='n'>f</span><span class='o'>)</span> <span class='k'>=></span>
<span class='n'>apply</span><span class='o'>(</span><span class='n'>t</span><span class='o'>,</span> <span class='kc'>null</span><span class='o'>,</span> <span class='kc'>null</span><span class='o'>,</span> <span class='nc'>SKBind</span><span class='o'>(</span><span class='n'>f</span><span class='o'>,</span> <span class='n'>sk</span><span class='o'>),</span> <span class='n'>fk</span><span class='o'>,</span> <span class='n'>k</span><span class='o'>)</span>
<span class='k'>case</span> <span class='nc'>Apply</span><span class='o'>(</span><span class='n'>t</span><span class='o'>,</span> <span class='n'>f</span><span class='o'>)</span> <span class='k'>=></span>
<span class='n'>apply</span><span class='o'>(</span><span class='n'>t</span><span class='o'>,</span> <span class='kc'>null</span><span class='o'>,</span> <span class='kc'>null</span><span class='o'>,</span> <span class='nc'>SKApply</span><span class='o'>(</span><span class='n'>f</span><span class='o'>,</span> <span class='n'>sk</span><span class='o'>),</span> <span class='n'>fk</span><span class='o'>,</span> <span class='n'>k</span><span class='o'>)</span>
<span class='k'>case</span> <span class='nc'>Filter</span><span class='o'>(</span><span class='n'>t</span><span class='o'>,</span> <span class='n'>p</span><span class='o'>)</span> <span class='k'>=></span>
<span class='n'>apply</span><span class='o'>(</span><span class='n'>t</span><span class='o'>,</span> <span class='kc'>null</span><span class='o'>,</span> <span class='kc'>null</span><span class='o'>,</span> <span class='nc'>SKFilter</span><span class='o'>(</span><span class='n'>p</span><span class='o'>,</span> <span class='n'>sk</span><span class='o'>),</span> <span class='n'>fk</span><span class='o'>,</span> <span class='n'>k</span><span class='o'>)</span>
<span class='k'>case</span> <span class='nc'>Unsplit</span><span class='o'>(</span><span class='n'>fk2</span><span class='o'>)</span> <span class='k'>=></span>
<span class='n'>apply</span><span class='o'>(</span><span class='n'>fk2</span><span class='o'>,</span> <span class='kc'>null</span><span class='o'>,</span> <span class='kc'>null</span><span class='o'>,</span> <span class='kc'>null</span><span class='o'>,</span> <span class='kc'>null</span><span class='o'>,</span> <span class='nc'>KUnsplit</span><span class='o'>(</span><span class='n'>sk</span><span class='o'>,</span> <span class='n'>fk</span><span class='o'>,</span> <span class='n'>k</span><span class='o'>))</span>
<span class='k'>case</span> <span class='nc'>FKOr</span><span class='o'>(</span><span class='n'>t</span><span class='o'>,</span> <span class='n'>sk</span><span class='o'>,</span> <span class='n'>fk</span><span class='o'>)</span> <span class='k'>=></span> <span class='n'>apply</span><span class='o'>(</span><span class='n'>t</span><span class='o'>(),</span> <span class='kc'>null</span><span class='o'>,</span> <span class='kc'>null</span><span class='o'>,</span> <span class='n'>sk</span><span class='o'>,</span> <span class='n'>fk</span><span class='o'>,</span> <span class='n'>k</span><span class='o'>)</span>
<span class='k'>case</span> <span class='nc'>FKSplit</span><span class='o'>(</span><span class='n'>r</span><span class='o'>)</span> <span class='k'>=></span> <span class='n'>apply</span><span class='o'>(</span><span class='n'>k</span><span class='o'>,</span> <span class='kc'>null</span><span class='o'>,</span> <span class='n'>r</span><span class='o'>,</span> <span class='kc'>null</span><span class='o'>,</span> <span class='kc'>null</span><span class='o'>,</span> <span class='kc'>null</span><span class='o'>)</span>
<span class='k'>case</span> <span class='nc'>SKBind</span><span class='o'>(</span><span class='n'>f</span><span class='o'>,</span> <span class='n'>sk</span><span class='o'>)</span> <span class='k'>=></span> <span class='n'>apply</span><span class='o'>(</span><span class='n'>f</span><span class='o'>(</span><span class='n'>a</span><span class='o'>),</span> <span class='kc'>null</span><span class='o'>,</span> <span class='kc'>null</span><span class='o'>,</span> <span class='n'>sk</span><span class='o'>,</span> <span class='n'>fk</span><span class='o'>,</span> <span class='n'>k</span><span class='o'>)</span>
<span class='k'>case</span> <span class='nc'>SKApply</span><span class='o'>(</span><span class='n'>f</span><span class='o'>,</span> <span class='n'>sk</span><span class='o'>)</span> <span class='k'>=></span> <span class='n'>apply</span><span class='o'>(</span><span class='n'>sk</span><span class='o'>,</span> <span class='n'>f</span><span class='o'>(</span><span class='n'>a</span><span class='o'>),</span> <span class='kc'>null</span><span class='o'>,</span> <span class='kc'>null</span><span class='o'>,</span> <span class='n'>fk</span><span class='o'>,</span> <span class='n'>k</span><span class='o'>)</span>
<span class='k'>case</span> <span class='nc'>SKFilter</span><span class='o'>(</span><span class='n'>p</span><span class='o'>,</span> <span class='n'>sk</span><span class='o'>)</span> <span class='k'>=></span>
<span class='k'>if</span> <span class='o'>(</span><span class='n'>p</span><span class='o'>(</span><span class='n'>a</span><span class='o'>))</span>
<span class='n'>apply</span><span class='o'>(</span><span class='n'>sk</span><span class='o'>,</span> <span class='n'>a</span><span class='o'>,</span> <span class='kc'>null</span><span class='o'>,</span> <span class='kc'>null</span><span class='o'>,</span> <span class='n'>fk</span><span class='o'>,</span> <span class='n'>k</span><span class='o'>)</span>
<span class='k'>else</span>
<span class='n'>apply</span><span class='o'>(</span><span class='n'>fk</span><span class='o'>,</span> <span class='kc'>null</span><span class='o'>,</span> <span class='kc'>null</span><span class='o'>,</span> <span class='kc'>null</span><span class='o'>,</span> <span class='kc'>null</span><span class='o'>,</span> <span class='n'>k</span><span class='o'>)</span>
<span class='k'>case</span> <span class='nc'>SKSplit</span><span class='o'>(</span><span class='n'>rf</span><span class='o'>)</span> <span class='k'>=></span>
<span class='n'>apply</span><span class='o'>(</span><span class='n'>k</span><span class='o'>,</span> <span class='kc'>null</span><span class='o'>,</span> <span class='n'>rf</span><span class='o'>(</span><span class='n'>a</span><span class='o'>,</span> <span class='n'>fk</span><span class='o'>),</span> <span class='kc'>null</span><span class='o'>,</span> <span class='kc'>null</span><span class='o'>,</span> <span class='kc'>null</span><span class='o'>)</span>
<span class='k'>case</span> <span class='nc'>KReturn</span> <span class='k'>=></span> <span class='n'>r</span>
<span class='k'>case</span> <span class='nc'>KUnsplit</span><span class='o'>(</span><span class='n'>sk</span><span class='o'>,</span> <span class='n'>fk</span><span class='o'>,</span> <span class='n'>k</span><span class='o'>)</span> <span class='k'>=></span> <span class='o'>{</span>
<span class='n'>r</span> <span class='k'>match</span> <span class='o'>{</span>
<span class='k'>case</span> <span class='nc'>None</span> <span class='k'>=></span> <span class='n'>apply</span><span class='o'>(</span><span class='n'>fk</span><span class='o'>,</span> <span class='kc'>null</span><span class='o'>,</span> <span class='kc'>null</span><span class='o'>,</span> <span class='kc'>null</span><span class='o'>,</span> <span class='kc'>null</span><span class='o'>,</span> <span class='n'>k</span><span class='o'>)</span>
<span class='k'>case</span> <span class='nc'>Some</span><span class='o'>((</span><span class='n'>a</span><span class='o'>,</span> <span class='n'>t</span><span class='o'>))</span> <span class='k'>=></span>
<span class='n'>apply</span><span class='o'>(</span><span class='n'>or</span><span class='o'>(</span><span class='n'>unit</span><span class='o'>(</span><span class='n'>a</span><span class='o'>),</span> <span class='n'>t</span><span class='o'>),</span> <span class='kc'>null</span><span class='o'>,</span> <span class='kc'>null</span><span class='o'>,</span> <span class='n'>sk</span><span class='o'>,</span> <span class='n'>fk</span><span class='o'>,</span> <span class='n'>k</span><span class='o'>)</span>
<span class='o'>}</span>
<span class='o'>}</span>
<span class='o'>}</span>
<span class='n'>apply</span><span class='o'>(</span><span class='n'>t</span><span class='o'>,</span>
<span class='kc'>null</span><span class='o'>,</span>
<span class='kc'>null</span><span class='o'>,</span>
<span class='nc'>SKSplit</span><span class='o'>((</span><span class='n'>a</span><span class='o'>,</span> <span class='n'>fk</span><span class='o'>)</span> <span class='k'>=></span> <span class='nc'>Some</span><span class='o'>((</span><span class='n'>a</span><span class='o'>,</span> <span class='nc'>Unsplit</span><span class='o'>(</span><span class='n'>fk</span><span class='o'>)))),</span>
<span class='nc'>FKSplit</span><span class='o'>(</span><span class='nc'>None</span><span class='o'>),</span>
<span class='nc'>KReturn</span><span class='o'>).</span><span class='n'>asInstanceOf</span><span class='o'>[</span><span class='kt'>O</span><span class='o'>[</span><span class='kt'>A</span><span class='o'>]]</span>
<span class='o'>}</span>
</code></pre>
</div>
<p>The original functions took varying arguments; the single function takes all the arguments which the original ones did. We pass <code>null</code> for unused arguments in each call, but otherwise the cases are the same as before.</p>
<p>Now we can evaluate <code>nat</code> to large N without running out of stack (but since the running time is quadratic it takes longer than I care to wait to complete):</p>
<div class='highlight'><pre><code class='scala'><span class='n'>scala</span><span class='o'>></span> <span class='n'>run</span><span class='o'>(</span><span class='n'>nat</span><span class='o'>,</span> <span class='mi'>100000</span><span class='o'>)</span>
<span class='o'>^</span><span class='n'>C</span>
</code></pre>
</div>
<p>See the complete code <a href='https://github.com/jaked/ambassadortothecomputers.blogspot.com/tree/master/_code/scala-logic'>here</a>.</p>
<p>Next time we’ll thread state through this backtracking logic monad, and use it to implement unification.</p>Jake Donhamhttp://www.blogger.com/profile/04768087689799941690noreply@blogger.com3tag:blogger.com,1999:blog-1445545651031573301.post-30204556802962880632011-04-06T22:03:00.000-07:002011-05-02T21:02:15.805-07:00Logic programming in Scala, part 1<p>I got a new job where I am hacking some Scala. I thought I would learn something by translating some functional code into Scala, and a friend had recently pointed me to Kiselyov et al.’s <a href='http://okmij.org/ftp/Computation/LogicT.pdf'>Backtracking, Interleaving, and Terminating Monad Transformers</a>, which provides a foundation for Prolog-style logic programming. Of course, a good translation should use the local idiom. So in this post (and the next) I want to explore an embedded domain-specific language for logic programming in Scala.</p>
<b>A search problem</b>
<p>Here is a problem I sometimes give in interviews:</p>
<blockquote>
<p>Four people need to cross a rickety bridge, which can hold only two people at a time. It’s a moonless night, so they need a light to cross; they have one flashlight with a battery which lasts 60 minutes. Each person crosses the bridge at a different speed: Alice takes 5 minutes, Bob takes 10, Candace takes 20 minutes, and Dave 25. How do they get across?</p>
</blockquote>
<p>I’m not interested in the answer—I’m interviewing programmers, not law school applicants—but rather in how to write a program to find the answer.</p>
<p>The basic shape of the solution is to represent the state of the world (where are the people, where is the flashlight, how much battery is left), write a function to compute from any particular state the set of possible next states, then search for an answer (a path from the start state to the final state) in the tree formed by applying the next state function transitively to the start state. (<a href='http://web.engr.oregonstate.edu/~erwig/papers/Zurg_JFP04.pdf'>Here is a paper</a> describing solutions in Prolog and Haskell.)</p>
<p>Here is a first solution in Scala:</p>
<div class='highlight'><pre><code class='scala'><span class='k'>object</span> <span class='nc'>Bridge0</span> <span class='o'>{</span>
<span class='k'>object</span> <span class='nc'>Person</span> <span class='k'>extends</span> <span class='nc'>Enumeration</span> <span class='o'>{</span>
<span class='k'>type</span> <span class='kt'>Person</span> <span class='o'>=</span> <span class='nc'>Value</span>
<span class='k'>val</span> <span class='nc'>Alice</span><span class='o'>,</span> <span class='nc'>Bob</span><span class='o'>,</span> <span class='nc'>Candace</span><span class='o'>,</span> <span class='nc'>Dave</span> <span class='k'>=</span> <span class='nc'>Value</span>
<span class='k'>val</span> <span class='n'>all</span> <span class='k'>=</span> <span class='nc'>List</span><span class='o'>(</span><span class='nc'>Alice</span><span class='o'>,</span> <span class='nc'>Bob</span><span class='o'>,</span> <span class='nc'>Candace</span><span class='o'>,</span> <span class='nc'>Dave</span><span class='o'>)</span> <span class='c1'>// values is broken</span>
<span class='o'>}</span>
<span class='k'>import</span> <span class='nn'>Person._</span>
<span class='k'>val</span> <span class='n'>times</span> <span class='k'>=</span> <span class='nc'>Map</span><span class='o'>(</span><span class='nc'>Alice</span> <span class='o'>-></span> <span class='mi'>5</span><span class='o'>,</span> <span class='nc'>Bob</span> <span class='o'>-></span> <span class='mi'>10</span><span class='o'>,</span> <span class='nc'>Candace</span> <span class='o'>-></span> <span class='mi'>20</span><span class='o'>,</span> <span class='nc'>Dave</span> <span class='o'>-></span> <span class='mi'>25</span><span class='o'>)</span>
<span class='k'>case</span> <span class='k'>class</span> <span class='nc'>State</span><span class='o'>(</span><span class='n'>left</span><span class='k'>:</span> <span class='kt'>List</span><span class='o'>[</span><span class='kt'>Person</span><span class='o'>],</span>
<span class='n'>lightOnLeft</span><span class='k'>:</span> <span class='kt'>Boolean</span><span class='o'>,</span>
<span class='n'>timeRemaining</span><span class='k'>:</span> <span class='kt'>Int</span><span class='o'>)</span>
</code></pre>
</div>
<p>We define an enumeration of people (the <code>Enumeration</code> class is a <a href='https://lampsvn.epfl.ch/trac/scala/ticket/3687'>bit broken</a> in Scala 2.8.1), a map of the time each takes to cross, and a case class to store the state of the world: the list of people on the left side of the bridge (the right side is just the complement); whether the flashlight is on the left; and how much time remains in the flashlight.</p>
<div class='highlight'><pre><code class='scala'> <span class='k'>def</span> <span class='n'>chooseTwo</span><span class='o'>(</span><span class='n'>list</span><span class='k'>:</span> <span class='kt'>List</span><span class='o'>[</span><span class='kt'>Person</span><span class='o'>])</span><span class='k'>:</span> <span class='kt'>List</span><span class='o'>[(</span><span class='kt'>Person</span>,<span class='kt'>Person</span><span class='o'>)]</span> <span class='k'>=</span> <span class='o'>{</span>
<span class='k'>val</span> <span class='n'>init</span><span class='k'>:</span> <span class='kt'>List</span><span class='o'>[(</span><span class='kt'>Person</span>, <span class='kt'>Person</span><span class='o'>)]</span> <span class='k'>=</span> <span class='nc'>Nil</span>
<span class='n'>list</span><span class='o'>.</span><span class='n'>foldLeft</span><span class='o'>(</span><span class='n'>init</span><span class='o'>)</span> <span class='o'>{</span> <span class='o'>(</span><span class='n'>pairs</span><span class='o'>,</span> <span class='n'>p1</span><span class='o'>)</span> <span class='k'>=></span>
<span class='n'>list</span><span class='o'>.</span><span class='n'>foldLeft</span><span class='o'>(</span><span class='n'>pairs</span><span class='o'>)</span> <span class='o'>{</span> <span class='o'>(</span><span class='n'>pairs</span><span class='o'>,</span> <span class='n'>p2</span><span class='o'>)</span> <span class='k'>=></span>
<span class='k'>if</span> <span class='o'>(</span><span class='n'>p1</span> <span class='o'><</span> <span class='n'>p2</span><span class='o'>)</span> <span class='o'>(</span><span class='n'>p1</span><span class='o'>,</span> <span class='n'>p2</span><span class='o'>)</span> <span class='o'>::</span> <span class='n'>pairs</span> <span class='k'>else</span> <span class='n'>pairs</span>
<span class='o'>}</span>
<span class='o'>}</span>
<span class='o'>}</span>
</code></pre>
</div>
<p>This function returns the list of pairs of people from the input list. We use <code>foldLeft</code> to do a double loop over the input list, accumulating pairs <code>(p1, p2)</code> where <code>p1 < p2</code>; this avoids returning <code>(Alice, Bob)</code> and also <code>(Bob, Alice)</code>. The use of <code>foldLeft</code> is rather OCamlish, and if you know Scala you will complain that <code>foldLeft</code> is not idiomatic—we will repair this shortly.</p>
<p>In Scala, <code>Nil</code> doesn’t have type <code>'a list</code> like in OCaml and Haskell, but rather <code>List[Nothing]</code>. The way local type inference works, the type variable in the type of <code>foldLeft</code> is instantiated with the type of the <code>init</code> argument, so you have to ascribe a type to <code>init</code> (or explicitly instantiate the type variable with <code>foldLeft[List[(Person,
Person)]]</code>) or else you get a type clash between <code>List[Nothing]</code> and <code>List[(Person, Person)]</code>.</p>
<div class='highlight'><pre><code class='scala'> <span class='k'>def</span> <span class='n'>next</span><span class='o'>(</span><span class='n'>state</span><span class='k'>:</span> <span class='kt'>State</span><span class='o'>)</span><span class='k'>:</span> <span class='kt'>List</span><span class='o'>[</span><span class='kt'>State</span><span class='o'>]</span> <span class='k'>=</span> <span class='o'>{</span>
<span class='k'>if</span> <span class='o'>(</span><span class='n'>state</span><span class='o'>.</span><span class='n'>lightOnLeft</span><span class='o'>)</span> <span class='o'>{</span>
<span class='k'>val</span> <span class='n'>init</span><span class='k'>:</span> <span class='kt'>List</span><span class='o'>[</span><span class='kt'>State</span><span class='o'>]</span> <span class='k'>=</span> <span class='nc'>Nil</span>
<span class='n'>chooseTwo</span><span class='o'>(</span><span class='n'>state</span><span class='o'>.</span><span class='n'>left</span><span class='o'>).</span><span class='n'>foldLeft</span><span class='o'>(</span><span class='n'>init</span><span class='o'>)</span> <span class='o'>{</span>
<span class='k'>case</span> <span class='o'>(</span><span class='n'>states</span><span class='o'>,</span> <span class='o'>(</span><span class='n'>p1</span><span class='o'>,</span> <span class='n'>p2</span><span class='o'>))</span> <span class='k'>=></span>
<span class='k'>val</span> <span class='n'>timeRemaining</span> <span class='k'>=</span>
<span class='n'>state</span><span class='o'>.</span><span class='n'>timeRemaining</span> <span class='o'>-</span> <span class='n'>math</span><span class='o'>.</span><span class='n'>max</span><span class='o'>(</span><span class='n'>times</span><span class='o'>(</span><span class='n'>p1</span><span class='o'>),</span> <span class='n'>times</span><span class='o'>(</span><span class='n'>p2</span><span class='o'>))</span>
<span class='k'>if</span> <span class='o'>(</span><span class='n'>timeRemaining</span> <span class='o'>>=</span> <span class='mi'>0</span><span class='o'>)</span> <span class='o'>{</span>
<span class='k'>val</span> <span class='n'>left</span> <span class='k'>=</span>
<span class='n'>state</span><span class='o'>.</span><span class='n'>left</span><span class='o'>.</span><span class='n'>filterNot</span> <span class='o'>{</span> <span class='n'>p</span> <span class='k'>=></span> <span class='n'>p</span> <span class='o'>==</span> <span class='n'>p1</span> <span class='o'>||</span> <span class='n'>p</span> <span class='o'>==</span> <span class='n'>p2</span> <span class='o'>}</span>
<span class='nc'>State</span><span class='o'>(</span><span class='n'>left</span><span class='o'>,</span> <span class='kc'>false</span><span class='o'>,</span> <span class='n'>timeRemaining</span><span class='o'>)</span> <span class='o'>::</span> <span class='n'>states</span>
<span class='o'>}</span>
<span class='k'>else</span>
<span class='n'>states</span>
<span class='o'>}</span>
<span class='o'>}</span> <span class='k'>else</span> <span class='o'>{</span>
<span class='k'>val</span> <span class='n'>right</span> <span class='k'>=</span> <span class='nc'>Person</span><span class='o'>.</span><span class='n'>all</span><span class='o'>.</span><span class='n'>filterNot</span><span class='o'>(</span><span class='n'>state</span><span class='o'>.</span><span class='n'>left</span><span class='o'>.</span><span class='n'>contains</span><span class='o'>)</span>
<span class='k'>val</span> <span class='n'>init</span><span class='k'>:</span> <span class='kt'>List</span><span class='o'>[</span><span class='kt'>State</span><span class='o'>]</span> <span class='k'>=</span> <span class='nc'>Nil</span>
<span class='n'>right</span><span class='o'>.</span><span class='n'>foldLeft</span><span class='o'>(</span><span class='n'>init</span><span class='o'>)</span> <span class='o'>{</span> <span class='o'>(</span><span class='n'>states</span><span class='o'>,</span> <span class='n'>p</span><span class='o'>)</span> <span class='k'>=></span>
<span class='k'>val</span> <span class='n'>timeRemaining</span> <span class='k'>=</span> <span class='n'>state</span><span class='o'>.</span><span class='n'>timeRemaining</span> <span class='o'>-</span> <span class='n'>times</span><span class='o'>(</span><span class='n'>p</span><span class='o'>)</span>
<span class='k'>if</span> <span class='o'>(</span><span class='n'>timeRemaining</span> <span class='o'>>=</span> <span class='mi'>0</span><span class='o'>)</span>
<span class='nc'>State</span><span class='o'>(</span><span class='n'>p</span> <span class='o'>::</span> <span class='n'>state</span><span class='o'>.</span><span class='n'>left</span><span class='o'>,</span> <span class='kc'>true</span><span class='o'>,</span> <span class='n'>timeRemaining</span><span class='o'>)</span> <span class='o'>::</span> <span class='n'>states</span>
<span class='k'>else</span>
<span class='n'>states</span>
<span class='o'>}</span>
<span class='o'>}</span>
<span class='o'>}</span>
</code></pre>
</div>
<p>Here we compute the set of successor states for a state. We make a heuristic simplification: when the flashlight is on the left (the side where everyone begins) we move two people from the left to the right; when it is on the right we move only one. I don’t have a proof that an answer must take this form, but I believe it, and it makes the code shorter.</p>
<p>So when the light is on the left we fold over all the pairs of people still on the left, compute the time remaining if they were to cross, and if it is not negative build a new state where they and the flashlight are moved to the right and the time remaining updated.</p>
<p>If the light is on the right we do the same in reverse, but choose only one person to move.</p>
<div class='highlight'><pre><code class='scala'> <span class='k'>def</span> <span class='n'>tree</span><span class='o'>(</span><span class='n'>path</span><span class='k'>:</span> <span class='kt'>List</span><span class='o'>[</span><span class='kt'>State</span><span class='o'>])</span><span class='k'>:</span> <span class='kt'>List</span><span class='o'>[</span><span class='kt'>List</span><span class='o'>[</span><span class='kt'>State</span><span class='o'>]]</span> <span class='k'>=</span>
<span class='n'>next</span><span class='o'>(</span><span class='n'>path</span><span class='o'>.</span><span class='n'>head</span><span class='o'>).</span>
<span class='n'>map</span><span class='o'>(</span><span class='n'>s</span> <span class='k'>=></span> <span class='n'>tree</span><span class='o'>(</span><span class='n'>s</span> <span class='o'>::</span> <span class='n'>path</span><span class='o'>)).</span>
<span class='n'>foldLeft</span><span class='o'>(</span><span class='nc'>List</span><span class='o'>(</span><span class='n'>path</span><span class='o'>))</span> <span class='o'>{</span> <span class='k'>_</span> <span class='o'>++</span> <span class='k'>_</span> <span class='o'>}</span>
<span class='k'>def</span> <span class='n'>search</span><span class='k'>:</span> <span class='kt'>List</span><span class='o'>[</span><span class='kt'>List</span><span class='o'>[</span><span class='kt'>State</span><span class='o'>]]</span> <span class='k'>=</span> <span class='o'>{</span>
<span class='k'>val</span> <span class='n'>start</span> <span class='k'>=</span> <span class='nc'>List</span><span class='o'>(</span><span class='nc'>State</span><span class='o'>(</span><span class='nc'>Person</span><span class='o'>.</span><span class='n'>all</span><span class='o'>,</span> <span class='kc'>true</span><span class='o'>,</span> <span class='mi'>60</span><span class='o'>))</span>
<span class='n'>tree</span><span class='o'>(</span><span class='n'>start</span><span class='o'>).</span><span class='n'>filter</span> <span class='o'>{</span> <span class='n'>_</span><span class='o'>.</span><span class='n'>head</span><span class='o'>.</span><span class='n'>left</span> <span class='o'>==</span> <span class='nc'>Nil</span> <span class='o'>}</span>
<span class='o'>}</span>
<span class='o'>}</span>
</code></pre>
</div>
<p>A list of successive states is a <em>path</em> (with the starting state at the end and the most recent state at the beginning); the state tree is a set of paths. The tree rooted at a path is the set of paths with the input path as a suffix. To compute this tree, we find the successor states of the head of the path, augment the path with each state in turn, recursively find the tree rooted at each augmented path, then append them all (including the input path).</p>
<p>Then to find an answer, we generate the state tree rooted at the path consisting only of the start state (everybody and the flashlight on the left, 60 minutes remaining on the light), then filter out the paths which end in a final state (everybody on the right).</p>
<b>For-comprehensions</b>
<p>To make the code above more idiomatic Scala (and more readable), we would of course use for-comprehensions, for example:</p>
<div class='highlight'><pre><code class='scala'> <span class='k'>def</span> <span class='n'>chooseTwo</span><span class='o'>(</span><span class='n'>list</span><span class='k'>:</span> <span class='kt'>List</span><span class='o'>[</span><span class='kt'>Person</span><span class='o'>])</span><span class='k'>:</span> <span class='kt'>List</span><span class='o'>[(</span><span class='kt'>Person</span>,<span class='kt'>Person</span><span class='o'>)]</span> <span class='k'>=</span>
<span class='k'>for</span> <span class='o'>{</span> <span class='n'>p1</span> <span class='k'><-</span> <span class='n'>list</span><span class='o'>;</span> <span class='n'>p2</span> <span class='k'><-</span> <span class='n'>list</span><span class='o'>;</span> <span class='k'>if</span> <span class='n'>p1</span> <span class='o'><</span> <span class='n'>p2</span> <span class='o'>}</span> <span class='k'>yield</span> <span class='o'>(</span><span class='n'>p1</span><span class='o'>,</span> <span class='n'>p2</span><span class='o'>)</span>
</code></pre>
</div>
<p>Just as before, we do a double loop over the input list, returning pairs where <code>p1 < p2</code>. (However, under the hood the result list is constructed by appending to a <code>ListBuffer</code> rather than with <code>::</code>, so the pairs are returned in the reverse order.)</p>
<p>The for-comprehension syntax isn’t specific to lists. It’s syntactic sugar which translates to method calls, so we can use it on any objects which implement the right methods. The methods we need are</p>
<div class='highlight'><pre><code class='scala'> <span class='k'>def</span> <span class='n'>filter</span><span class='o'>(</span><span class='n'>p</span><span class='k'>:</span> <span class='kt'>A</span> <span class='o'>=></span> <span class='nc'>Boolean</span><span class='o'>)</span><span class='k'>:</span> <span class='kt'>T</span><span class='o'>[</span><span class='kt'>A</span><span class='o'>]</span>
<span class='k'>def</span> <span class='n'>map</span><span class='o'>[</span><span class='kt'>B</span><span class='o'>](</span><span class='n'>f</span><span class='k'>:</span> <span class='kt'>A</span> <span class='o'>=></span> <span class='n'>B</span><span class='o'>)</span><span class='k'>:</span> <span class='kt'>T</span><span class='o'>[</span><span class='kt'>B</span><span class='o'>]</span>
<span class='k'>def</span> <span class='n'>flatMap</span><span class='o'>[</span><span class='kt'>B</span><span class='o'>](</span><span class='n'>f</span><span class='k'>:</span> <span class='kt'>A</span> <span class='o'>=></span> <span class='n'>T</span><span class='o'>[</span><span class='kt'>B</span><span class='o'>])</span><span class='k'>:</span> <span class='kt'>T</span><span class='o'>[</span><span class='kt'>B</span><span class='o'>]</span>
<span class='k'>def</span> <span class='n'>withFilter</span><span class='o'>(</span><span class='n'>p</span><span class='k'>:</span> <span class='kt'>A</span> <span class='o'>=></span> <span class='nc'>Boolean</span><span class='o'>)</span><span class='k'>:</span> <span class='kt'>T</span><span class='o'>[</span><span class='kt'>A</span><span class='o'>]</span>
</code></pre>
</div>
<p>where <code>T</code> is some type constructor, like <code>List</code>. For <code>List</code>, <code>filter</code> and <code>map</code> have their ordinary meaning, and <code>flatMap</code> is a <code>map</code> (where the result type must be a list) which concatenates the resulting lists (that is, it flattens the list of lists).</p>
<p><code>WithFilter</code> is like <code>filter</code> but should be implemented as a “virtual” filter for efficiency—for <code>List</code> it doesn’t build a new filtered list, but instead just keeps track of the filter function; this way multiple adjacent filters can be combined and the result produced with a single pass over the list.</p>
<p>The details of the translation are in the <a href='http://www.scala-lang.org/docu/files/ScalaReference.pdf'>Scala reference manual</a>, section 6.19. Roughly speaking, <code><-</code> becomes <code>flatMap</code>, <code>if</code> becomes <code>filter</code>, and <code>yield</code> becomes <code>map</code>. So another way to write <code>chooseTwo</code> is:</p>
<div class='highlight'><pre><code class='scala'> <span class='k'>def</span> <span class='n'>chooseTwo</span><span class='o'>(</span><span class='n'>list</span><span class='k'>:</span> <span class='kt'>List</span><span class='o'>[</span><span class='kt'>Person</span><span class='o'>])</span><span class='k'>:</span> <span class='kt'>List</span><span class='o'>[(</span><span class='kt'>Person</span>,<span class='kt'>Person</span><span class='o'>)]</span> <span class='k'>=</span>
<span class='n'>list</span><span class='o'>.</span><span class='n'>flatMap</span><span class='o'>(</span><span class='n'>p1</span> <span class='k'>=></span>
<span class='n'>list</span><span class='o'>.</span><span class='n'>filter</span><span class='o'>(</span><span class='n'>p2</span> <span class='k'>=></span> <span class='n'>p1</span> <span class='o'><</span> <span class='n'>p2</span><span class='o'>).</span><span class='n'>map</span><span class='o'>(</span><span class='n'>p2</span> <span class='k'>=></span> <span class='o'>(</span><span class='n'>p1</span><span class='o'>,</span> <span class='n'>p2</span><span class='o'>)))</span>
</code></pre>
</div><b>The logic monad</b>
<p>So far we have taken a concrete view of the choices that arise in searching the state tree, by representing a choice among alternatives as a list. For example, in the <code>chooseTwo</code> function we returned a list of alternative pairs. I want now to take a more abstract view, and define an abstract type <code>T[A]</code> to represent a choice among alternatives of type <code>A</code>, along with operations on the type, packaged into a trait:</p>
<div class='highlight'><pre><code class='scala'><span class='k'>trait</span> <span class='nc'>Logic</span> <span class='o'>{</span> <span class='n'>L</span> <span class='k'>=></span>
<span class='k'>type</span> <span class='kt'>T</span><span class='o'>[</span><span class='kt'>A</span><span class='o'>]</span>
<span class='k'>def</span> <span class='n'>fail</span><span class='o'>[</span><span class='kt'>A</span><span class='o'>]</span><span class='k'>:</span> <span class='kt'>T</span><span class='o'>[</span><span class='kt'>A</span><span class='o'>]</span>
<span class='k'>def</span> <span class='n'>unit</span><span class='o'>[</span><span class='kt'>A</span><span class='o'>](</span><span class='n'>a</span><span class='k'>:</span> <span class='kt'>A</span><span class='o'>)</span><span class='k'>:</span> <span class='kt'>T</span><span class='o'>[</span><span class='kt'>A</span><span class='o'>]</span>
<span class='k'>def</span> <span class='n'>or</span><span class='o'>[</span><span class='kt'>A</span><span class='o'>](</span><span class='n'>t1</span><span class='k'>:</span> <span class='kt'>T</span><span class='o'>[</span><span class='kt'>A</span><span class='o'>],</span> <span class='n'>t2</span><span class='k'>:</span> <span class='o'>=></span> <span class='n'>T</span><span class='o'>[</span><span class='kt'>A</span><span class='o'>])</span><span class='k'>:</span> <span class='kt'>T</span><span class='o'>[</span><span class='kt'>A</span><span class='o'>]</span>
<span class='k'>def</span> <span class='n'>apply</span><span class='o'>[</span><span class='kt'>A</span>,<span class='kt'>B</span><span class='o'>](</span><span class='n'>t</span><span class='k'>:</span> <span class='kt'>T</span><span class='o'>[</span><span class='kt'>A</span><span class='o'>],</span> <span class='n'>f</span><span class='k'>:</span> <span class='kt'>A</span> <span class='o'>=></span> <span class='n'>B</span><span class='o'>)</span><span class='k'>:</span> <span class='kt'>T</span><span class='o'>[</span><span class='kt'>B</span><span class='o'>]</span>
<span class='k'>def</span> <span class='n'>bind</span><span class='o'>[</span><span class='kt'>A</span>,<span class='kt'>B</span><span class='o'>](</span><span class='n'>t</span><span class='k'>:</span> <span class='kt'>T</span><span class='o'>[</span><span class='kt'>A</span><span class='o'>],</span> <span class='n'>f</span><span class='k'>:</span> <span class='kt'>A</span> <span class='o'>=></span> <span class='n'>T</span><span class='o'>[</span><span class='kt'>B</span><span class='o'>])</span><span class='k'>:</span> <span class='kt'>T</span><span class='o'>[</span><span class='kt'>B</span><span class='o'>]</span>
<span class='k'>def</span> <span class='n'>filter</span><span class='o'>[</span><span class='kt'>A</span><span class='o'>](</span><span class='n'>t</span><span class='k'>:</span> <span class='kt'>T</span><span class='o'>[</span><span class='kt'>A</span><span class='o'>],</span> <span class='n'>p</span><span class='k'>:</span> <span class='kt'>A</span> <span class='o'>=></span> <span class='nc'>Boolean</span><span class='o'>)</span><span class='k'>:</span> <span class='kt'>T</span><span class='o'>[</span><span class='kt'>A</span><span class='o'>]</span>
<span class='k'>def</span> <span class='n'>split</span><span class='o'>[</span><span class='kt'>A</span><span class='o'>](</span><span class='n'>t</span><span class='k'>:</span> <span class='kt'>T</span><span class='o'>[</span><span class='kt'>A</span><span class='o'>])</span><span class='k'>:</span> <span class='kt'>Option</span><span class='o'>[(</span><span class='kt'>A</span>,<span class='kt'>T</span><span class='o'>[</span><span class='kt'>A</span><span class='o'>])]</span>
</code></pre>
</div>
<p>A <code>fail</code> value is a choice among no alternatives. A <code>unit(a)</code> is a choice of a single alternative. The value <code>or(t1, t2)</code> is a choice among the alternatives represented by <code>t1</code> together with the alternatives represented by <code>t2</code>.</p>
<p>The meaning of <code>apply</code>ing a function to a choice of alternatives is a choice among the results of applying the function to each alternative; that is, if <code>t</code> represents a choice among <code>1</code>, <code>2</code>, and <code>3</code>, then <code>apply(t, f)</code> represents a choice among <code>f(1)</code>, <code>f(2)</code>, and <code>f(3)</code>.</p>
<p><code>Bind</code> is the same except the function returns a choice of alternatives, so we must combine all the alternatives in the result; that is, if <code>t</code> is a choice among <code>1</code>, <code>3</code>, and <code>5</code>, and <code>f</code> is <code>{ x => or(unit(x), unit(x + 1)) }</code>, then <code>bind(t, f)</code> is a choice among <code>1</code>, <code>2</code>, <code>3</code>, <code>4</code>, <code>5</code>, and <code>6</code>.</p>
<p>A <code>filter</code> of a choice of alternatives by a predicate is a choice among only the alternatives which pass the the predicate.</p>
<p>Finally, <code>split</code> is a function which returns the first alternative in a choice of alternatives (if there is at least one) along with a choice among the remaining alternatives.</p>
<div class='highlight'><pre><code class='scala'> <span class='k'>def</span> <span class='n'>or</span><span class='o'>[</span><span class='kt'>A</span><span class='o'>](</span><span class='n'>as</span><span class='k'>:</span> <span class='kt'>List</span><span class='o'>[</span><span class='kt'>A</span><span class='o'>])</span><span class='k'>:</span> <span class='kt'>T</span><span class='o'>[</span><span class='kt'>A</span><span class='o'>]</span> <span class='k'>=</span>
<span class='n'>as</span><span class='o'>.</span><span class='n'>foldRight</span><span class='o'>(</span><span class='n'>fail</span><span class='o'>[</span><span class='kt'>A</span><span class='o'>])((</span><span class='n'>a</span><span class='o'>,</span> <span class='n'>t</span><span class='o'>)</span> <span class='k'>=></span> <span class='n'>or</span><span class='o'>(</span><span class='n'>unit</span><span class='o'>(</span><span class='n'>a</span><span class='o'>),</span> <span class='n'>t</span><span class='o'>))</span>
<span class='k'>def</span> <span class='n'>run</span><span class='o'>[</span><span class='kt'>A</span><span class='o'>](</span><span class='n'>t</span><span class='k'>:</span> <span class='kt'>T</span><span class='o'>[</span><span class='kt'>A</span><span class='o'>],</span> <span class='n'>n</span><span class='k'>:</span> <span class='kt'>Int</span><span class='o'>)</span><span class='k'>:</span> <span class='kt'>List</span><span class='o'>[</span><span class='kt'>A</span><span class='o'>]</span> <span class='k'>=</span>
<span class='k'>if</span> <span class='o'>(</span><span class='n'>n</span> <span class='o'><=</span> <span class='mi'>0</span><span class='o'>)</span> <span class='nc'>Nil</span> <span class='k'>else</span>
<span class='n'>split</span><span class='o'>(</span><span class='n'>t</span><span class='o'>)</span> <span class='k'>match</span> <span class='o'>{</span>
<span class='k'>case</span> <span class='nc'>None</span> <span class='k'>=></span> <span class='nc'>Nil</span>
<span class='k'>case</span> <span class='nc'>Some</span><span class='o'>((</span><span class='n'>a</span><span class='o'>,</span> <span class='n'>t</span><span class='o'>))</span> <span class='k'>=></span> <span class='n'>a</span> <span class='o'>::</span> <span class='n'>run</span><span class='o'>(</span><span class='n'>t</span><span class='o'>,</span> <span class='n'>n</span> <span class='o'>-</span> <span class='mi'>1</span><span class='o'>)</span>
<span class='o'>}</span>
</code></pre>
</div>
<p>As a convenience, <code>or(as: List[A])</code> means a choice among the elements of <code>as</code>. And <code>run</code> returns a list of the first <code>n</code> alternatives in a choice, picking them off one by one with <code>split</code>; this is how we get answers out of a <code>T[A]</code>.</p>
<div class='highlight'><pre><code class='scala'> <span class='k'>case</span> <span class='k'>class</span> <span class='nc'>Syntax</span><span class='o'>[</span><span class='kt'>A</span><span class='o'>](</span><span class='n'>t</span><span class='k'>:</span> <span class='kt'>T</span><span class='o'>[</span><span class='kt'>A</span><span class='o'>])</span> <span class='o'>{</span>
<span class='k'>def</span> <span class='n'>map</span><span class='o'>[</span><span class='kt'>B</span><span class='o'>](</span><span class='n'>f</span><span class='k'>:</span> <span class='kt'>A</span> <span class='o'>=></span> <span class='n'>B</span><span class='o'>)</span><span class='k'>:</span> <span class='kt'>T</span><span class='o'>[</span><span class='kt'>B</span><span class='o'>]</span> <span class='k'>=</span> <span class='n'>L</span><span class='o'>.</span><span class='n'>apply</span><span class='o'>(</span><span class='n'>t</span><span class='o'>,</span> <span class='n'>f</span><span class='o'>)</span>
<span class='k'>def</span> <span class='n'>filter</span><span class='o'>(</span><span class='n'>p</span><span class='k'>:</span> <span class='kt'>A</span> <span class='o'>=></span> <span class='nc'>Boolean</span><span class='o'>)</span><span class='k'>:</span> <span class='kt'>T</span><span class='o'>[</span><span class='kt'>A</span><span class='o'>]</span> <span class='k'>=</span> <span class='n'>L</span><span class='o'>.</span><span class='n'>filter</span><span class='o'>(</span><span class='n'>t</span><span class='o'>,</span> <span class='n'>p</span><span class='o'>)</span>
<span class='k'>def</span> <span class='n'>flatMap</span><span class='o'>[</span><span class='kt'>B</span><span class='o'>](</span><span class='n'>f</span><span class='k'>:</span> <span class='kt'>A</span> <span class='o'>=></span> <span class='n'>T</span><span class='o'>[</span><span class='kt'>B</span><span class='o'>])</span><span class='k'>:</span> <span class='kt'>T</span><span class='o'>[</span><span class='kt'>B</span><span class='o'>]</span> <span class='k'>=</span> <span class='n'>L</span><span class='o'>.</span><span class='n'>bind</span><span class='o'>(</span><span class='n'>t</span><span class='o'>,</span> <span class='n'>f</span><span class='o'>)</span>
<span class='k'>def</span> <span class='n'>withFilter</span><span class='o'>(</span><span class='n'>p</span><span class='k'>:</span> <span class='kt'>A</span> <span class='o'>=></span> <span class='nc'>Boolean</span><span class='o'>)</span><span class='k'>:</span> <span class='kt'>T</span><span class='o'>[</span><span class='kt'>A</span><span class='o'>]</span> <span class='k'>=</span> <span class='n'>L</span><span class='o'>.</span><span class='n'>filter</span><span class='o'>(</span><span class='n'>t</span><span class='o'>,</span> <span class='n'>p</span><span class='o'>)</span>
<span class='k'>def</span> <span class='o'>|(</span><span class='n'>t2</span><span class='k'>:</span> <span class='o'>=></span> <span class='n'>T</span><span class='o'>[</span><span class='kt'>A</span><span class='o'>])</span><span class='k'>:</span> <span class='kt'>T</span><span class='o'>[</span><span class='kt'>A</span><span class='o'>]</span> <span class='k'>=</span> <span class='n'>L</span><span class='o'>.</span><span class='n'>or</span><span class='o'>(</span><span class='n'>t</span><span class='o'>,</span> <span class='n'>t2</span><span class='o'>)</span>
<span class='o'>}</span>
<span class='k'>implicit</span> <span class='k'>def</span> <span class='n'>syntax</span><span class='o'>[</span><span class='kt'>A</span><span class='o'>](</span><span class='n'>t</span><span class='k'>:</span> <span class='kt'>T</span><span class='o'>[</span><span class='kt'>A</span><span class='o'>])</span> <span class='k'>=</span> <span class='nc'>Syntax</span><span class='o'>(</span><span class='n'>t</span><span class='o'>)</span>
<span class='o'>}</span>
</code></pre>
</div>
<p>Here we hook into the for-comprehension notation, by wrapping values of type <code>T[A]</code> in an object with the methods we need (and <code>|</code> as an additional bit of syntactic sugar), which methods just delegate to the functions defined above. We arrange with an implicit conversion for these wrappers to spring into existence when we need them.</p>
<b>The bridge puzzle with the logic monad</b>
<p>Now we can rewrite the solution in terms of the <code>Logic</code> trait:</p>
<div class='highlight'><pre><code class='scala'><span class='k'>class</span> <span class='nc'>Bridge</span><span class='o'>(</span><span class='nc'>Logic</span><span class='k'>:</span> <span class='kt'>Logic</span><span class='o'>)</span> <span class='o'>{</span>
<span class='k'>import</span> <span class='nn'>Logic._</span>
</code></pre>
</div>
<p>We pass an implementation of the logic monad in, then open it so the implicit conversion is available (we can also use <code>T[A]</code> and the <code>Logic</code> functions without qualification).</p>
<p>The <code>Person</code>, <code>times</code>, and <code>State</code> definitions are as before.</p>
<div class='highlight'><pre><code class='scala'> <span class='k'>private</span> <span class='k'>def</span> <span class='n'>chooseTwo</span><span class='o'>(</span><span class='n'>list</span><span class='k'>:</span> <span class='kt'>List</span><span class='o'>[</span><span class='kt'>Person</span><span class='o'>])</span><span class='k'>:</span> <span class='kt'>T</span><span class='o'>[(</span><span class='kt'>Person</span>,<span class='kt'>Person</span><span class='o'>)]</span> <span class='k'>=</span>
<span class='k'>for</span> <span class='o'>{</span> <span class='n'>p1</span> <span class='k'><-</span> <span class='n'>or</span><span class='o'>(</span><span class='n'>list</span><span class='o'>);</span> <span class='n'>p2</span> <span class='k'><-</span> <span class='n'>or</span><span class='o'>(</span><span class='n'>list</span><span class='o'>);</span> <span class='k'>if</span> <span class='n'>p1</span> <span class='o'><</span> <span class='n'>p2</span> <span class='o'>}</span>
<span class='k'>yield</span> <span class='o'>(</span><span class='n'>p1</span><span class='o'>,</span> <span class='n'>p2</span><span class='o'>)</span>
</code></pre>
</div>
<p>As we saw, we can write <code>chooseTwo</code> more straightforwardly using a for-comprehension. In the previous version we punned on <code>list</code> as a concrete list and as a choice among alternatives; here we convert one to the other explicitly.</p>
<div class='highlight'><pre><code class='scala'> <span class='k'>private</span> <span class='k'>def</span> <span class='n'>next</span><span class='o'>(</span><span class='n'>state</span><span class='k'>:</span> <span class='kt'>State</span><span class='o'>)</span><span class='k'>:</span> <span class='kt'>T</span><span class='o'>[</span><span class='kt'>State</span><span class='o'>]</span> <span class='k'>=</span> <span class='o'>{</span>
<span class='k'>if</span> <span class='o'>(</span><span class='n'>state</span><span class='o'>.</span><span class='n'>lightOnLeft</span><span class='o'>)</span> <span class='o'>{</span>
<span class='k'>for</span> <span class='o'>{</span>
<span class='o'>(</span><span class='n'>p1</span><span class='o'>,</span> <span class='n'>p2</span><span class='o'>)</span> <span class='k'><-</span> <span class='n'>chooseTwo</span><span class='o'>(</span><span class='n'>state</span><span class='o'>.</span><span class='n'>left</span><span class='o'>)</span>
<span class='n'>timeRemaining</span> <span class='k'>=</span>
<span class='n'>state</span><span class='o'>.</span><span class='n'>timeRemaining</span> <span class='o'>-</span> <span class='n'>math</span><span class='o'>.</span><span class='n'>max</span><span class='o'>(</span><span class='n'>times</span><span class='o'>(</span><span class='n'>p1</span><span class='o'>),</span> <span class='n'>times</span><span class='o'>(</span><span class='n'>p2</span><span class='o'>))</span>
<span class='k'>if</span> <span class='n'>timeRemaining</span> <span class='o'>>=</span> <span class='mi'>0</span>
<span class='o'>}</span> <span class='k'>yield</span> <span class='o'>{</span>
<span class='k'>val</span> <span class='n'>left</span> <span class='k'>=</span>
<span class='n'>state</span><span class='o'>.</span><span class='n'>left</span><span class='o'>.</span><span class='n'>filterNot</span> <span class='o'>{</span> <span class='n'>p</span> <span class='k'>=></span> <span class='n'>p</span> <span class='o'>==</span> <span class='n'>p1</span> <span class='o'>||</span> <span class='n'>p</span> <span class='o'>==</span> <span class='n'>p2</span> <span class='o'>}</span>
<span class='nc'>State</span><span class='o'>(</span><span class='n'>left</span><span class='o'>,</span> <span class='kc'>false</span><span class='o'>,</span> <span class='n'>timeRemaining</span><span class='o'>)</span>
<span class='o'>}</span>
<span class='o'>}</span> <span class='k'>else</span> <span class='o'>{</span> <span class='c1'>// ...</span>
</code></pre>
</div>
<p>This is pretty much as before, except with for-comprehensions instead of <code>foldLeft</code> and explicit consing. (You can easily figure out the branch for the flashlight on the right.)</p>
<div class='highlight'><pre><code class='scala'> <span class='k'>private</span> <span class='k'>def</span> <span class='n'>tree</span><span class='o'>(</span><span class='n'>path</span><span class='k'>:</span> <span class='kt'>List</span><span class='o'>[</span><span class='kt'>State</span><span class='o'>])</span><span class='k'>:</span> <span class='kt'>T</span><span class='o'>[</span><span class='kt'>List</span><span class='o'>[</span><span class='kt'>State</span><span class='o'>]]</span> <span class='k'>=</span>
<span class='n'>unit</span><span class='o'>(</span><span class='n'>path</span><span class='o'>)</span> <span class='o'>|</span>
<span class='o'>(</span><span class='k'>for</span> <span class='o'>{</span>
<span class='n'>state</span> <span class='k'><-</span> <span class='n'>next</span><span class='o'>(</span><span class='n'>path</span><span class='o'>.</span><span class='n'>head</span><span class='o'>)</span>
<span class='n'>path</span> <span class='k'><-</span> <span class='n'>tree</span><span class='o'>(</span><span class='n'>state</span> <span class='o'>::</span> <span class='n'>path</span><span class='o'>)</span>
<span class='o'>}</span> <span class='k'>yield</span> <span class='n'>path</span><span class='o'>)</span>
<span class='k'>def</span> <span class='n'>search</span><span class='o'>(</span><span class='n'>n</span><span class='k'>:</span> <span class='kt'>Int</span><span class='o'>)</span><span class='k'>:</span> <span class='kt'>List</span><span class='o'>[</span><span class='kt'>List</span><span class='o'>[</span><span class='kt'>State</span><span class='o'>]]</span> <span class='k'>=</span> <span class='o'>{</span>
<span class='k'>val</span> <span class='n'>start</span> <span class='k'>=</span> <span class='nc'>List</span><span class='o'>(</span><span class='nc'>State</span><span class='o'>(</span><span class='nc'>Person</span><span class='o'>.</span><span class='n'>all</span><span class='o'>,</span> <span class='kc'>true</span><span class='o'>,</span> <span class='mi'>60</span><span class='o'>))</span>
<span class='k'>val</span> <span class='n'>t</span> <span class='k'>=</span>
<span class='k'>for</span> <span class='o'>{</span> <span class='n'>path</span> <span class='k'><-</span> <span class='n'>tree</span><span class='o'>(</span><span class='n'>start</span><span class='o'>);</span> <span class='k'>if</span> <span class='n'>path</span><span class='o'>.</span><span class='n'>head</span><span class='o'>.</span><span class='n'>left</span> <span class='o'>==</span> <span class='nc'>Nil</span> <span class='o'>}</span>
<span class='k'>yield</span> <span class='n'>path</span>
<span class='n'>run</span><span class='o'>(</span><span class='n'>t</span><span class='o'>,</span> <span class='n'>n</span><span class='o'>)</span>
<span class='o'>}</span>
<span class='o'>}</span>
</code></pre>
</div>
<p>In <code>tree</code> we use <code>|</code> to adjoin the input path (previously we gave it in the initial value of <code>foldLeft</code>). In <code>search</code> we need to actually run the <code>Logic.T[A]</code> value rather than returning it, because it’s an abstract type and can’t escape the module (see the Postscript for an alternative); this is why the other methods must be <code>private</code>.</p>
<b>Implementing the logic monad with lists</b>
<p>We can recover the original solution by implementing <code>Logic</code> with lists:</p>
<div class='highlight'><pre><code class='scala'><span class='k'>object</span> <span class='nc'>LogicList</span> <span class='k'>extends</span> <span class='nc'>Logic</span> <span class='o'>{</span>
<span class='k'>type</span> <span class='kt'>T</span><span class='o'>[</span><span class='kt'>A</span><span class='o'>]</span> <span class='k'>=</span> <span class='nc'>List</span><span class='o'>[</span><span class='kt'>A</span><span class='o'>]</span>
<span class='k'>def</span> <span class='n'>fail</span><span class='o'>[</span><span class='kt'>A</span><span class='o'>]</span> <span class='k'>=</span> <span class='nc'>Nil</span>
<span class='k'>def</span> <span class='n'>unit</span><span class='o'>[</span><span class='kt'>A</span><span class='o'>](</span><span class='n'>a</span><span class='k'>:</span> <span class='kt'>A</span><span class='o'>)</span> <span class='k'>=</span> <span class='n'>a</span> <span class='o'>::</span> <span class='nc'>Nil</span>
<span class='k'>def</span> <span class='n'>or</span><span class='o'>[</span><span class='kt'>A</span><span class='o'>](</span><span class='n'>t1</span><span class='k'>:</span> <span class='kt'>List</span><span class='o'>[</span><span class='kt'>A</span><span class='o'>],</span> <span class='n'>t2</span><span class='k'>:</span> <span class='o'>=></span> <span class='nc'>List</span><span class='o'>[</span><span class='kt'>A</span><span class='o'>])</span> <span class='k'>=</span> <span class='n'>t1</span> <span class='o'>:::</span> <span class='n'>t2</span>
<span class='k'>def</span> <span class='n'>apply</span><span class='o'>[</span><span class='kt'>A</span>,<span class='kt'>B</span><span class='o'>](</span><span class='n'>t</span><span class='k'>:</span> <span class='kt'>List</span><span class='o'>[</span><span class='kt'>A</span><span class='o'>],</span> <span class='n'>f</span><span class='k'>:</span> <span class='kt'>A</span> <span class='o'>=></span> <span class='n'>B</span><span class='o'>)</span> <span class='k'>=</span> <span class='n'>t</span><span class='o'>.</span><span class='n'>map</span><span class='o'>(</span><span class='n'>f</span><span class='o'>)</span>
<span class='k'>def</span> <span class='n'>bind</span><span class='o'>[</span><span class='kt'>A</span>,<span class='kt'>B</span><span class='o'>](</span><span class='n'>t</span><span class='k'>:</span> <span class='kt'>List</span><span class='o'>[</span><span class='kt'>A</span><span class='o'>],</span> <span class='n'>f</span><span class='k'>:</span> <span class='kt'>A</span> <span class='o'>=></span> <span class='nc'>List</span><span class='o'>[</span><span class='kt'>B</span><span class='o'>])</span> <span class='k'>=</span> <span class='n'>t</span><span class='o'>.</span><span class='n'>flatMap</span><span class='o'>(</span><span class='n'>f</span><span class='o'>)</span>
<span class='k'>def</span> <span class='n'>filter</span><span class='o'>[</span><span class='kt'>A</span><span class='o'>](</span><span class='n'>t</span><span class='k'>:</span> <span class='kt'>List</span><span class='o'>[</span><span class='kt'>A</span><span class='o'>],</span> <span class='n'>p</span><span class='k'>:</span> <span class='kt'>A</span> <span class='o'>=></span> <span class='nc'>Boolean</span><span class='o'>)</span> <span class='k'>=</span> <span class='n'>t</span><span class='o'>.</span><span class='n'>filter</span><span class='o'>(</span><span class='n'>p</span><span class='o'>)</span>
<span class='k'>def</span> <span class='n'>split</span><span class='o'>[</span><span class='kt'>A</span><span class='o'>](</span><span class='n'>t</span><span class='k'>:</span> <span class='kt'>List</span><span class='o'>[</span><span class='kt'>A</span><span class='o'>])</span> <span class='k'>=</span>
<span class='n'>t</span> <span class='k'>match</span> <span class='o'>{</span>
<span class='k'>case</span> <span class='nc'>Nil</span> <span class='k'>=></span> <span class='nc'>None</span>
<span class='k'>case</span> <span class='n'>h</span> <span class='o'>::</span> <span class='n'>t</span> <span class='k'>=></span> <span class='nc'>Some</span><span class='o'>(</span><span class='n'>h</span><span class='o'>,</span> <span class='n'>t</span><span class='o'>)</span>
<span class='o'>}</span>
<span class='o'>}</span>
</code></pre>
</div>
<p>A choice among alternatives is just a <code>List</code> of the alternatives, so the semantics we sketched above are realized in a very direct way.</p>
<p>The downside to the <code>List</code> implementation is that we compute all the alternatives, even if we only care about one of them. (In the bridge problem any path to the final state is a satisfactory answer, but our program computes all such paths, even if we pass an argument to <code>search</code> requesting only one answer.) We might even want to solve problems with an infinite number of solutions.</p>
<p>Next time we’ll repair this downside by implementing the backtracking monad from the paper by Kiselyov et al.</p>
<p>See the complete code <a href='https://github.com/jaked/ambassadortothecomputers.blogspot.com/tree/master/_code/scala-logic'>here</a>.</p>
<b>Postscript: modules in Scala</b>
<p>I got the idea of implementing the for-comprehension methods as an implict wrapper from Edward Kmett’s <a href='https://github.com/ekmett/functorial'>functorial</a> library. It’s nice that <code>T[A]</code> remains completely abstract, and the for-comprehension notation is just sugar. I also tried an implementation where <code>T[A]</code> is bounded by a trait containing the methods:</p>
<div class='highlight'><pre><code class='scala'><span class='k'>trait</span> <span class='nc'>Monadic</span><span class='o'>[</span><span class='kt'>T</span><span class='o'>[</span><span class='k'>_</span><span class='o'>]</span>, <span class='kt'>A</span><span class='o'>]</span> <span class='o'>{</span>
<span class='k'>def</span> <span class='n'>map</span><span class='o'>[</span><span class='kt'>B</span><span class='o'>](</span><span class='n'>f</span><span class='k'>:</span> <span class='kt'>A</span> <span class='o'>=></span> <span class='n'>B</span><span class='o'>)</span><span class='k'>:</span> <span class='kt'>T</span><span class='o'>[</span><span class='kt'>B</span><span class='o'>]</span>
<span class='k'>def</span> <span class='n'>filter</span><span class='o'>(</span><span class='n'>p</span><span class='k'>:</span> <span class='kt'>A</span> <span class='o'>=></span> <span class='nc'>Boolean</span><span class='o'>)</span><span class='k'>:</span> <span class='kt'>T</span><span class='o'>[</span><span class='kt'>A</span><span class='o'>]</span>
<span class='k'>def</span> <span class='n'>flatMap</span><span class='o'>[</span><span class='kt'>B</span><span class='o'>](</span><span class='n'>f</span><span class='k'>:</span> <span class='kt'>A</span> <span class='o'>=></span> <span class='n'>T</span><span class='o'>[</span><span class='kt'>B</span><span class='o'>])</span><span class='k'>:</span> <span class='kt'>T</span><span class='o'>[</span><span class='kt'>B</span><span class='o'>]</span>
<span class='k'>def</span> <span class='n'>withFilter</span><span class='o'>(</span><span class='n'>p</span><span class='k'>:</span> <span class='kt'>A</span> <span class='o'>=></span> <span class='nc'>Boolean</span><span class='o'>)</span><span class='k'>:</span> <span class='kt'>T</span><span class='o'>[</span><span class='kt'>A</span><span class='o'>]</span>
<span class='k'>def</span> <span class='o'>|(</span><span class='n'>t</span><span class='k'>:</span> <span class='o'>=></span> <span class='n'>T</span><span class='o'>[</span><span class='kt'>A</span><span class='o'>])</span><span class='k'>:</span> <span class='kt'>T</span><span class='o'>[</span><span class='kt'>A</span><span class='o'>]</span>
<span class='k'>def</span> <span class='n'>split</span><span class='k'>:</span> <span class='kt'>Option</span><span class='o'>[(</span><span class='kt'>A</span>,<span class='kt'>T</span><span class='o'>[</span><span class='kt'>A</span><span class='o'>])]</span>
<span class='o'>}</span>
<span class='k'>trait</span> <span class='nc'>Logic</span> <span class='o'>{</span>
<span class='k'>type</span> <span class='kt'>T</span><span class='o'>[</span><span class='kt'>A</span><span class='o'>]</span> <span class='k'><:</span> <span class='nc'>Monadic</span><span class='o'>[</span><span class='kt'>T</span>, <span class='kt'>A</span><span class='o'>]</span>
<span class='c1'>// no Syntax class needed</span>
</code></pre>
</div>
<p>This works too but the type system hackery is a bit ugly, and it constrains implementations of <code>Logic</code> more than is necessary.</p>
<p>Another design choice is whether <code>T[A]</code> is an abstract type (as I have it) or a type parameter of <code>Logic</code>:</p>
<div class='highlight'><pre><code class='scala'><span class='k'>trait</span> <span class='nc'>Logic</span><span class='o'>[</span><span class='kt'>T</span><span class='o'>[</span><span class='k'>_</span><span class='o'>]]</span> <span class='o'>{</span> <span class='n'>L</span> <span class='k'>=></span>
<span class='c1'>// no abstract type T[A] but otherwise as before</span>
<span class='o'>}</span>
</code></pre>
</div>
<p>Neither alternative provides the expressivity of OCaml modules (<em>but see addendum below</em>): with abstract types, consumers of <code>Logic</code> cannot return values of <code>T[A]</code> (as we saw above); with a type parameter, they can, but the type is no longer abstract.</p>
<p>In OCaml we would write</p>
<div class='highlight'><pre><code class='ocaml'><span class='k'>module</span> <span class='k'>type</span> <span class='nc'>Logic</span> <span class='o'>=</span>
<span class='k'>sig</span>
<span class='k'>type</span> <span class='k'>'</span><span class='n'>a</span> <span class='n'>t</span>
<span class='k'>val</span> <span class='kt'>unit</span> <span class='o'>:</span> <span class='k'>'</span><span class='n'>a</span> <span class='o'>-></span> <span class='k'>'</span><span class='n'>a</span> <span class='n'>t</span>
<span class='c'>(* and so on *)</span>
<span class='k'>end</span>
<span class='k'>module</span> <span class='nc'>Bridge</span><span class='o'>(</span><span class='nc'>L</span> <span class='o'>:</span> <span class='nc'>Logic</span><span class='o'>)</span> <span class='o'>=</span>
<span class='k'>struct</span>
<span class='k'>type</span> <span class='n'>state</span> <span class='o'>=</span> <span class='o'>...</span>
<span class='k'>val</span> <span class='n'>search</span> <span class='o'>:</span> <span class='n'>state</span> <span class='kt'>list</span> <span class='nn'>L</span><span class='p'>.</span><span class='n'>t</span>
<span class='k'>end</span>
</code></pre>
</div>
<p>and get both the abstract type and the ability to return values of the type.</p>
<p><em>Addendum</em></p>
<p>Jorge Ortiz points out in the comments that it is possible to keep <code>T[A]</code> abstract and also return its values from <code>Bridge</code>, by making the <code>Logic</code> argument a (public) <code>val</code>. We can then remove the <code>private</code>s, and write <code>search</code> as just:</p>
<div class='highlight'><pre><code class='scala'> <span class='k'>def</span> <span class='n'>search</span><span class='k'>:</span> <span class='kt'>T</span><span class='o'>[</span><span class='kt'>List</span><span class='o'>[</span><span class='kt'>State</span><span class='o'>]]</span> <span class='k'>=</span> <span class='o'>{</span>
<span class='k'>val</span> <span class='n'>start</span> <span class='k'>=</span> <span class='nc'>List</span><span class='o'>(</span><span class='nc'>State</span><span class='o'>(</span><span class='nc'>Person</span><span class='o'>.</span><span class='n'>all</span><span class='o'>,</span> <span class='kc'>true</span><span class='o'>,</span> <span class='mi'>60</span><span class='o'>))</span>
<span class='k'>for</span> <span class='o'>{</span> <span class='n'>path</span> <span class='k'><-</span> <span class='n'>tree</span><span class='o'>(</span><span class='n'>start</span><span class='o'>);</span> <span class='k'>if</span> <span class='n'>path</span><span class='o'>.</span><span class='n'>head</span><span class='o'>.</span><span class='n'>left</span> <span class='o'>==</span> <span class='nc'>Nil</span> <span class='o'>}</span>
<span class='k'>yield</span> <span class='n'>path</span>
<span class='o'>}</span>
</code></pre>
</div>
<p>instead of baking <code>run</code> into it. Now, if we write <code>val b = new Bridge(LogicList)</code> then <code>b.search</code> has type <code>b.Logic.T[List[b.State]]</code>, and we can call <code>b.Logic.run</code> to evaluate it.</p>
<p>This is only a modest improvement; what’s still missing, compared to the OCaml version, is the fact that <code>LogicList</code> and <code>b.Logic</code> are the same module. So we can’t call <code>LogicList.run(b.search)</code> directly. Worse, we can’t compose modules which use the same <code>Logic</code> implementation, because they each have their own incompatibly-typed <code>Logic</code> member.</p>
<p>I thought there might be a way out of this using singleton types—the idea is that a match of a value <code>v</code> against a typed pattern where the type is <code>w.type</code> succeeds when <code>v eq w</code> (section 8.2 in the reference manual). So we can define</p>
<div class='highlight'><pre><code class='scala'><span class='k'>def</span> <span class='n'>run</span><span class='o'>[</span><span class='kt'>A</span><span class='o'>](</span>
<span class='nc'>Logic</span><span class='k'>:</span> <span class='kt'>Logic</span><span class='o'>,</span>
<span class='n'>b</span><span class='k'>:</span> <span class='kt'>Bridge</span><span class='o'>,</span>
<span class='n'>t</span><span class='k'>:</span> <span class='kt'>b.Logic.T</span><span class='o'>[</span><span class='kt'>A</span><span class='o'>],</span>
<span class='n'>n</span><span class='k'>:</span> <span class='kt'>Int</span><span class='o'>)</span><span class='k'>:</span> <span class='kt'>List</span><span class='o'>[</span><span class='kt'>A</span><span class='o'>]</span> <span class='k'>=</span>
<span class='o'>{</span>
<span class='nc'>Logic</span> <span class='k'>match</span> <span class='o'>{</span>
<span class='k'>case</span> <span class='n'>l</span> <span class='k'>:</span> <span class='kt'>b.Logic.</span><span class='k'>type</span> <span class='o'>=></span> <span class='n'>l</span><span class='o'>.</span><span class='n'>run</span><span class='o'>(</span><span class='n'>t</span><span class='o'>,</span> <span class='n'>n</span><span class='o'>)</span>
<span class='o'>}</span>
<span class='o'>}</span>
</code></pre>
</div>
<p>which is accepted, but sadly</p>
<div class='highlight'><pre><code class='scala'><span class='n'>scala</span><span class='o'>></span> <span class='n'>run</span><span class='o'>[</span><span class='kt'>List</span><span class='o'>[</span><span class='kt'>b.State</span><span class='o'>]](</span><span class='nc'>LogicList</span><span class='o'>,</span> <span class='n'>b</span><span class='o'>,</span> <span class='n'>b</span><span class='o'>.</span><span class='n'>search</span><span class='o'>,</span> <span class='mi'>2</span><span class='o'>)</span>
<span class='o'><</span><span class='n'>console</span><span class='o'>>:</span><span class='mi'>8</span><span class='k'>:</span> <span class='kt'>error:</span> <span class='k'>type</span> <span class='kt'>mismatch</span><span class='o'>;</span>
<span class='n'>found</span> <span class='k'>:</span> <span class='kt'>b.Logic.T</span><span class='o'>[</span><span class='kt'>List</span><span class='o'>[</span><span class='kt'>b.State</span><span class='o'>]]</span>
<span class='n'>required</span><span class='k'>:</span> <span class='kt'>b.Logic.T</span><span class='o'>[</span><span class='kt'>List</span><span class='o'>[</span><span class='kt'>b.State</span><span class='o'>]]</span>
<span class='n'>run</span><span class='o'>[</span><span class='kt'>List</span><span class='o'>[</span><span class='kt'>b.State</span><span class='o'>]](</span><span class='nc'>LogicList</span><span class='o'>,</span> <span class='n'>b</span><span class='o'>,</span> <span class='n'>b</span><span class='o'>.</span><span class='n'>search</span><span class='o'>,</span> <span class='mi'>2</span><span class='o'>)</span>
<span class='o'>^</span>
</code></pre>
</div>
<p><em>Addendum addendum</em></p>
<p>Some further advice from Jorge Ortiz: the specific type of <code>Logic</code> (not just <code>Logic.type</code>) can be exposed outside <code>Bridge</code> either through polymorphism:</p>
<div class='highlight'><pre><code class='scala'><span class='k'>class</span> <span class='nc'>Bridge</span><span class='o'>[</span><span class='kt'>L</span> <span class='k'><:</span> <span class='kt'>Logic</span><span class='o'>](</span><span class='k'>val</span> <span class='nc'>Logic</span><span class='k'>:</span> <span class='kt'>L</span><span class='o'>)</span> <span class='o'>{</span>
<span class='o'>...</span>
<span class='o'>}</span>
<span class='k'>val</span> <span class='n'>b</span> <span class='k'>=</span> <span class='k'>new</span> <span class='nc'>Bridge</span><span class='o'>(</span><span class='nc'>LogicList</span><span class='o'>)</span>
</code></pre>
</div>
<p>or by defining an abstract value (this works the same if <code>Bridge</code> is a trait):</p>
<div class='highlight'><pre><code class='scala'><span class='k'>abstract</span> <span class='k'>class</span> <span class='nc'>Bridge</span> <span class='o'>{</span>
<span class='k'>val</span> <span class='nc'>Logic</span><span class='k'>:</span> <span class='kt'>Logic</span>
<span class='o'>...</span>
<span class='o'>}</span>
</code></pre>
</div>
<p>So we can compose uses of <code>T</code> but it remains abstract.</p>Jake Donhamhttp://www.blogger.com/profile/04768087689799941690noreply@blogger.com4tag:blogger.com,1999:blog-1445545651031573301.post-60319698336160182032010-11-24T20:58:00.000-08:002010-11-24T20:58:10.608-08:00Three uses for a binary heap<p>Lately I have been interviewing for jobs, so doing a lot of whiteboard programming, and <a href='http://en.wikipedia.org/wiki/Binary_heap'>binary heaps</a> keep arising in the solutions to these interview problems. There is nothing new or remarkable about these applications (binary heaps and their uses are covered in any undergraduate algorithms class), but I thought I would write them down because they are cute, and in the hope that they might be useful to someone else who (like me) gets by most days as a working programmer with no algorithm fancier than quicksort or binary search.</p>
<b>Binary heaps</b>
<p>Here’s a signature for a binary heap module <code>Heap</code>:</p>
<div class='highlight'><pre><code class='ocaml'><span class='k'>module</span> <span class='k'>type</span> <span class='nc'>OrderedType</span> <span class='o'>=</span>
<span class='k'>sig</span>
<span class='k'>type</span> <span class='n'>t</span>
<span class='k'>val</span> <span class='n'>compare</span> <span class='o'>:</span> <span class='n'>t</span> <span class='o'>-></span> <span class='n'>t</span> <span class='o'>-></span> <span class='kt'>int</span>
<span class='k'>end</span>
<span class='k'>module</span> <span class='k'>type</span> <span class='nc'>S</span> <span class='o'>=</span> <span class='k'>sig</span>
<span class='k'>type</span> <span class='n'>elt</span>
<span class='k'>type</span> <span class='n'>t</span>
<span class='k'>val</span> <span class='n'>make</span> <span class='o'>:</span> <span class='kt'>unit</span> <span class='o'>-></span> <span class='n'>t</span>
<span class='k'>val</span> <span class='n'>add</span> <span class='o'>:</span> <span class='n'>t</span> <span class='o'>-></span> <span class='n'>elt</span> <span class='o'>-></span> <span class='kt'>unit</span>
<span class='k'>val</span> <span class='n'>peek_min</span> <span class='o'>:</span> <span class='n'>t</span> <span class='o'>-></span> <span class='n'>elt</span> <span class='n'>option</span>
<span class='k'>val</span> <span class='n'>take_min</span> <span class='o'>:</span> <span class='n'>t</span> <span class='o'>-></span> <span class='n'>elt</span>
<span class='k'>val</span> <span class='n'>size</span> <span class='o'>:</span> <span class='n'>t</span> <span class='o'>-></span> <span class='kt'>int</span>
<span class='k'>end</span>
<span class='k'>module</span> <span class='nc'>Make</span> <span class='o'>(</span><span class='nc'>O</span> <span class='o'>:</span> <span class='nc'>OrderedType</span><span class='o'>)</span> <span class='o'>:</span> <span class='nc'>S</span> <span class='k'>with</span> <span class='k'>type</span> <span class='n'>elt</span> <span class='o'>=</span> <span class='nn'>O</span><span class='p'>.</span><span class='n'>t</span>
</code></pre>
</div>
<p>We start with a signature for ordered types (following the <code>Set</code> and <code>Map</code> modules in the standard library), so we can provide a type-specific comparison function.</p>
<p>From an ordered type we can make a heap which supports adding elements, peeking the smallest element (<code>None</code> if there are no elements) without removing it, removing and returning the smallest element (raising <code>Not_found</code> if the heap is empty), and returning the number of elements.</p>
<p>We’ll work out the asymptotic running times of the algorithms below, so it will be useful to know that the worst-case running time of the <code>add</code> and <code>take_min</code> functions is <code>O(log n)</code> where <code>n</code> is the number of elements in the heap.</p>
<b>Finding the k smallest elements in a list</b>
<p>Here’s a simple one. To find the smallest element in a list, we could sort the list then take the first element in the sorted list, at a cost of <code>O(log n)</code>. Or we could just take a pass over the list keeping a running minimum, at a cost of <code>O(n)</code>.</p>
<p>What if we want the <code>k</code> smallest elements? Again, we could sort the list, but if <code>k < n</code> we can do better by generalizing the single-pass solution. The idea is to keep the <code>k</code> smallest elements we’ve seen so far in a binary heap. For each element in the list we add it to the heap, then (if there were already <code>k</code> elements in the heap) remove the largest element in the heap, leaving the <code>k</code> smallest.</p>
<p>The running time is <code>O(n log k)</code> since we do an <code>add</code> and a <code>take_min</code> in a heap of size <code>k</code> for each of <code>n</code> elements in the list. Here’s the code:</p>
<div class='highlight'><pre><code class='ocaml'><span class='k'>let</span> <span class='n'>kmin</span> <span class='o'>(</span><span class='k'>type</span> <span class='n'>s</span><span class='o'>)</span> <span class='n'>k</span> <span class='n'>l</span> <span class='o'>=</span>
<span class='k'>let</span> <span class='k'>module</span> <span class='nc'>OT</span> <span class='o'>=</span> <span class='k'>struct</span>
<span class='k'>type</span> <span class='n'>t</span> <span class='o'>=</span> <span class='n'>s</span>
<span class='k'>let</span> <span class='n'>compare</span> <span class='n'>e1</span> <span class='n'>e2</span> <span class='o'>=</span> <span class='n'>compare</span> <span class='n'>e2</span> <span class='n'>e1</span>
<span class='k'>end</span> <span class='k'>in</span>
<span class='k'>let</span> <span class='k'>module</span> <span class='nc'>H</span> <span class='o'>=</span> <span class='nn'>Heap</span><span class='p'>.</span><span class='nc'>Make</span><span class='o'>(</span><span class='nc'>OT</span><span class='o'>)</span> <span class='k'>in</span>
<span class='k'>let</span> <span class='n'>h</span> <span class='o'>=</span> <span class='nn'>H</span><span class='p'>.</span><span class='n'>make</span> <span class='bp'>()</span> <span class='k'>in</span>
<span class='nn'>List</span><span class='p'>.</span><span class='n'>iter</span>
<span class='o'>(</span><span class='k'>fun</span> <span class='n'>e</span> <span class='o'>-></span>
<span class='nn'>H</span><span class='p'>.</span><span class='n'>add</span> <span class='n'>h</span> <span class='n'>e</span><span class='o'>;</span>
<span class='k'>if</span> <span class='nn'>H</span><span class='p'>.</span><span class='n'>size</span> <span class='n'>h</span> <span class='o'>></span> <span class='n'>k</span>
<span class='k'>then</span> <span class='n'>ignore</span> <span class='o'>(</span><span class='nn'>H</span><span class='p'>.</span><span class='n'>take_min</span> <span class='n'>h</span><span class='o'>))</span>
<span class='n'>l</span><span class='o'>;</span>
<span class='k'>let</span> <span class='k'>rec</span> <span class='n'>loop</span> <span class='n'>mins</span> <span class='o'>=</span>
<span class='k'>match</span> <span class='nn'>H</span><span class='p'>.</span><span class='n'>peek_min</span> <span class='n'>h</span> <span class='k'>with</span>
<span class='o'>|</span> <span class='nc'>None</span> <span class='o'>-></span> <span class='n'>mins</span>
<span class='o'>|</span> <span class='o'>_</span> <span class='o'>-></span> <span class='n'>loop</span> <span class='o'>(</span><span class='nn'>H</span><span class='p'>.</span><span class='n'>take_min</span> <span class='n'>h</span> <span class='o'>::</span> <span class='n'>mins</span><span class='o'>)</span> <span class='k'>in</span>
<span class='n'>loop</span> <span class='bp'>[]</span>
</code></pre>
</div>
<p>Here we make good use of OCaml 3.12’s new feature for <a href='http://caml.inria.fr/pub/docs/manual-ocaml/manual021.html#toc80'>explicitly naming type variables</a> in a polymorphic function to make a structure matching <code>OrderedType</code>. The heap has the same element type as the list, but we reverse the comparison since we want to remove the largest rather than smallest element from the heap in the loop. At the end of <code>kmin</code> we drain the heap to build a list of the <code>k</code> smallest elements.</p>
<b>Merging k lists</b>
<p>Suppose we want to merge <code>k</code> lists. We could merge them pairwise until there is only one list, but that would take <code>k - 1</code> passes, for a worst-case running time of <code>O(n * (k - 1))</code>. Instead we can merge them all in one pass, using a binary heap so we can find the next smallest element of <code>k</code> lists in <code>O(log k)</code> time, for a running time of <code>O(n
log k)</code>. Here’s the code:</p>
<div class='highlight'><pre><code class='ocaml'><span class='k'>let</span> <span class='n'>merge</span> <span class='o'>(</span><span class='k'>type</span> <span class='n'>s</span><span class='o'>)</span> <span class='n'>ls</span> <span class='o'>=</span>
<span class='k'>let</span> <span class='k'>module</span> <span class='nc'>OT</span> <span class='o'>=</span> <span class='k'>struct</span>
<span class='k'>type</span> <span class='n'>t</span> <span class='o'>=</span> <span class='n'>s</span> <span class='kt'>list</span>
<span class='k'>let</span> <span class='n'>compare</span> <span class='n'>e1</span> <span class='n'>e2</span> <span class='o'>=</span>
<span class='n'>compare</span> <span class='o'>(</span><span class='nn'>List</span><span class='p'>.</span><span class='n'>hd</span> <span class='n'>e1</span><span class='o'>)</span> <span class='o'>(</span><span class='nn'>List</span><span class='p'>.</span><span class='n'>hd</span> <span class='n'>e2</span><span class='o'>)</span>
<span class='k'>end</span> <span class='k'>in</span>
<span class='k'>let</span> <span class='k'>module</span> <span class='nc'>H</span> <span class='o'>=</span> <span class='nn'>Heap</span><span class='p'>.</span><span class='nc'>Make</span><span class='o'>(</span><span class='nc'>OT</span><span class='o'>)</span> <span class='k'>in</span>
<span class='k'>let</span> <span class='n'>h</span> <span class='o'>=</span> <span class='nn'>H</span><span class='p'>.</span><span class='n'>make</span> <span class='bp'>()</span> <span class='k'>in</span>
<span class='k'>let</span> <span class='n'>add</span> <span class='o'>=</span> <span class='k'>function</span>
<span class='o'>|</span> <span class='bp'>[]</span> <span class='o'>-></span> <span class='bp'>()</span>
<span class='o'>|</span> <span class='n'>l</span> <span class='o'>-></span> <span class='nn'>H</span><span class='p'>.</span><span class='n'>add</span> <span class='n'>h</span> <span class='n'>l</span> <span class='k'>in</span>
<span class='nn'>List</span><span class='p'>.</span><span class='n'>iter</span> <span class='n'>add</span> <span class='n'>ls</span><span class='o'>;</span>
<span class='k'>let</span> <span class='k'>rec</span> <span class='n'>loop</span> <span class='bp'>()</span> <span class='o'>=</span>
<span class='k'>match</span> <span class='nn'>H</span><span class='p'>.</span><span class='n'>peek_min</span> <span class='n'>h</span> <span class='k'>with</span>
<span class='o'>|</span> <span class='nc'>None</span> <span class='o'>-></span> <span class='bp'>[]</span>
<span class='o'>|</span> <span class='o'>_</span> <span class='o'>-></span>
<span class='k'>match</span> <span class='nn'>H</span><span class='p'>.</span><span class='n'>take_min</span> <span class='n'>h</span> <span class='k'>with</span>
<span class='o'>|</span> <span class='bp'>[]</span> <span class='o'>-></span> <span class='k'>assert</span> <span class='bp'>false</span>
<span class='o'>|</span> <span class='n'>m</span> <span class='o'>::</span> <span class='n'>t</span> <span class='o'>-></span>
<span class='n'>add</span> <span class='n'>t</span><span class='o'>;</span>
<span class='n'>m</span> <span class='o'>::</span> <span class='n'>loop</span> <span class='bp'>()</span> <span class='k'>in</span>
<span class='n'>loop</span> <span class='bp'>()</span>
</code></pre>
</div>
<p>We store the lists in the heap, and compare them by comparing their head element (we’re careful not to put an empty list in the heap). When we take the smallest list from the heap, its head becomes the next element in the output list, and we return its tail (if it is not empty) to the heap.</p>
<b>Computing a skyline</b>
<p>The next problem was told to me in terms of computing the skyline of a set of buildings. A building has a height and a starting and ending <code>x</code>-coordinate; buildings may overlap. The skyline of a set of buildings is a list of (<code>x</code>, <code>y</code>) pairs (in ascending <code>x</code> order), describing a sequence of horizontal line segments (each starting at (<code>x</code>, <code>y</code>) and ending at the subsequent <code>x</code>), such that at any <code>x</code> there is no space between the line segment and the tallest building. (Here’s <a href='http://stackoverflow.com/questions/1066234/the-skyline-problem'>another description</a> with diagrams.)</p>
<p>I googled a bit to see what this is useful for, and didn’t find much. One application is to extract a monophonic line from polyphonic music, where <code>x</code> is time and height is some metric on notes, like pitch or volume. It might be useful for searching data which is only intermittently applicable—say, to compute a schedule over time of the nearest open restaurant.</p>
<p>The algorithm scans the building start and end points in ascending <code>x</code> order, keeping the “active” buildings (those which overlap the current <code>x</code>) in a binary heap. The height of the skyline can only change at a building start or end point. We can determine the tallest building at a point by calling <code>peek_min</code> on the heap.</p>
<p>When we hit a start point we add the building to the heap; for an end point we do nothing (the heap has no operation to remove an element). So we may have inactive buildings in the heap. We remove them lazily—before checking the height of the highest building, we call <code>take_min</code> to remove any higher inactive buildings.</p>
<p>The worst-case running time is <code>O(n log n)</code>, since we do some heap operations for each building, and we might end up with all the buildings in the heap.</p>
<p>Here’s the code:</p>
<div class='highlight'><pre><code class='ocaml'><span class='k'>type</span> <span class='n'>building</span> <span class='o'>=</span> <span class='kt'>int</span> <span class='o'>*</span> <span class='kt'>int</span> <span class='o'>*</span> <span class='kt'>int</span> <span class='c'>(* x0, x1, h *)</span>
<span class='k'>let</span> <span class='n'>skyline</span> <span class='n'>bs</span> <span class='o'>=</span>
<span class='k'>let</span> <span class='k'>module</span> <span class='nc'>OT</span> <span class='o'>=</span> <span class='k'>struct</span>
<span class='k'>type</span> <span class='n'>t</span> <span class='o'>=</span> <span class='kt'>int</span> <span class='o'>*</span> <span class='n'>building</span>
<span class='k'>let</span> <span class='n'>compare</span> <span class='o'>(</span><span class='n'>x1</span><span class='o'>,</span> <span class='o'>_)</span> <span class='o'>(</span><span class='n'>x2</span><span class='o'>,</span> <span class='o'>_)</span> <span class='o'>=</span> <span class='n'>compare</span> <span class='n'>x1</span> <span class='n'>x2</span>
<span class='k'>end</span> <span class='k'>in</span>
<span class='k'>let</span> <span class='k'>module</span> <span class='nc'>Events</span> <span class='o'>=</span> <span class='nn'>Heap</span><span class='p'>.</span><span class='nc'>Make</span><span class='o'>(</span><span class='nc'>OT</span><span class='o'>)</span> <span class='k'>in</span>
<span class='k'>let</span> <span class='n'>events</span> <span class='o'>=</span> <span class='nn'>Events</span><span class='p'>.</span><span class='n'>make</span> <span class='bp'>()</span> <span class='k'>in</span>
<span class='nn'>List</span><span class='p'>.</span><span class='n'>iter</span>
<span class='o'>(</span><span class='k'>fun</span> <span class='o'>((</span><span class='n'>x0</span><span class='o'>,</span><span class='n'>x1</span><span class='o'>,_)</span> <span class='k'>as</span> <span class='n'>b</span><span class='o'>)</span> <span class='o'>-></span>
<span class='nn'>Events</span><span class='p'>.</span><span class='n'>add</span> <span class='n'>events</span> <span class='o'>(</span><span class='n'>x0</span><span class='o'>,</span> <span class='n'>b</span><span class='o'>);</span>
<span class='nn'>Events</span><span class='p'>.</span><span class='n'>add</span> <span class='n'>events</span> <span class='o'>(</span><span class='n'>x1</span><span class='o'>,</span> <span class='n'>b</span><span class='o'>))</span>
<span class='n'>bs</span><span class='o'>;</span>
<span class='k'>let</span> <span class='k'>module</span> <span class='nc'>OT</span> <span class='o'>=</span> <span class='k'>struct</span>
<span class='k'>type</span> <span class='n'>t</span> <span class='o'>=</span> <span class='n'>building</span>
<span class='k'>let</span> <span class='n'>compare</span> <span class='o'>(_,_,</span><span class='n'>h1</span><span class='o'>)</span> <span class='o'>(_,_,</span><span class='n'>h2</span><span class='o'>)</span> <span class='o'>=</span> <span class='n'>compare</span> <span class='n'>h2</span> <span class='n'>h1</span>
<span class='k'>end</span> <span class='k'>in</span>
<span class='k'>let</span> <span class='k'>module</span> <span class='nc'>Heights</span> <span class='o'>=</span> <span class='nn'>Heap</span><span class='p'>.</span><span class='nc'>Make</span><span class='o'>(</span><span class='nc'>OT</span><span class='o'>)</span> <span class='k'>in</span>
<span class='k'>let</span> <span class='n'>heights</span> <span class='o'>=</span> <span class='nn'>Heights</span><span class='p'>.</span><span class='n'>make</span> <span class='bp'>()</span> <span class='k'>in</span>
<span class='k'>let</span> <span class='k'>rec</span> <span class='n'>loop</span> <span class='n'>last</span> <span class='o'>=</span>
<span class='k'>match</span> <span class='nn'>Events</span><span class='p'>.</span><span class='n'>peek_min</span> <span class='n'>events</span> <span class='k'>with</span>
<span class='o'>|</span> <span class='nc'>None</span> <span class='o'>-></span> <span class='bp'>[]</span>
<span class='o'>|</span> <span class='o'>_</span> <span class='o'>-></span>
<span class='k'>let</span> <span class='o'>(</span><span class='n'>x</span><span class='o'>,</span> <span class='o'>(</span><span class='n'>x0</span><span class='o'>,_,</span><span class='n'>h</span> <span class='k'>as</span> <span class='n'>b</span><span class='o'>))</span> <span class='o'>=</span> <span class='nn'>Events</span><span class='p'>.</span><span class='n'>take_min</span> <span class='n'>events</span> <span class='k'>in</span>
<span class='k'>if</span> <span class='n'>x</span> <span class='o'>=</span> <span class='n'>x0</span> <span class='k'>then</span> <span class='nn'>Heights</span><span class='p'>.</span><span class='n'>add</span> <span class='n'>heights</span> <span class='n'>b</span><span class='o'>;</span>
<span class='k'>while</span> <span class='o'>(</span><span class='k'>match</span> <span class='nn'>Heights</span><span class='p'>.</span><span class='n'>peek_min</span> <span class='n'>heights</span> <span class='k'>with</span>
<span class='o'>|</span> <span class='nc'>Some</span> <span class='o'>(_,</span><span class='n'>x1</span><span class='o'>,_)</span> <span class='o'>-></span> <span class='n'>x1</span> <span class='o'><=</span> <span class='n'>x</span>
<span class='o'>|</span> <span class='o'>_</span> <span class='o'>-></span> <span class='bp'>false</span><span class='o'>)</span> <span class='k'>do</span>
<span class='n'>ignore</span> <span class='o'>(</span><span class='nn'>Heights</span><span class='p'>.</span><span class='n'>take_min</span> <span class='n'>heights</span><span class='o'>)</span>
<span class='k'>done</span><span class='o'>;</span>
<span class='k'>let</span> <span class='n'>h</span> <span class='o'>=</span>
<span class='k'>match</span> <span class='nn'>Heights</span><span class='p'>.</span><span class='n'>peek_min</span> <span class='n'>heights</span> <span class='k'>with</span>
<span class='o'>|</span> <span class='nc'>Some</span> <span class='o'>(_,_,</span><span class='n'>h</span><span class='o'>)</span> <span class='o'>-></span> <span class='n'>h</span>
<span class='o'>|</span> <span class='nc'>None</span> <span class='o'>-></span> <span class='mi'>0</span> <span class='k'>in</span>
<span class='k'>match</span> <span class='n'>last</span> <span class='k'>with</span>
<span class='o'>|</span> <span class='nc'>Some</span> <span class='n'>h'</span> <span class='k'>when</span> <span class='n'>h</span> <span class='o'>=</span> <span class='n'>h'</span> <span class='o'>-></span> <span class='n'>loop</span> <span class='n'>last</span>
<span class='o'>|</span> <span class='o'>_</span> <span class='o'>-></span> <span class='o'>(</span><span class='n'>x</span><span class='o'>,</span> <span class='n'>h</span><span class='o'>)</span> <span class='o'>::</span> <span class='n'>loop</span> <span class='o'>(</span><span class='nc'>Some</span> <span class='n'>h</span><span class='o'>)</span> <span class='k'>in</span>
<span class='n'>loop</span> <span class='nc'>None</span>
</code></pre>
</div>
<p>We use a second heap <code>events</code> to store the “events” (the start and end points of all the buildings), in order to process them in ascending <code>x</code> order. (This use is not dynamic—we do not add new elements to the heap while processing them—so we could just as well use another means of sorting the points.) In this heap we store the <code>x</code> coordinate and the building (we can tell whether we have a start or end point by comparing the <code>x</code> coordinate to the building’s start point), and compare elements by comparing just the <code>x</code> coordinates.</p>
<p>The main heap <code>heights</code> stores buildings, and we compare them by comparing heights (reversed, so <code>peek_min</code> peeks the tallest building). While there are still events, we add the building to <code>heights</code> if the event is a start point, clear out inactive buildings, then return the pair (<code>x</code>, <code>y</code>) where <code>x</code> is the point we’re processing and <code>y</code> is the height of the tallest active building. Additionally we filter out adjacent pairs with the same height; these can arise when a shorter building starts or ends while a taller building is active.</p>
<b>Implementing binary heaps</b>
<p>The following implementation is derived from the one in Daniel Bünzli’s <a href='http://erratique.ch/software/react'>React</a> library (edited a little bit for readability). The <a href='http://en.wikipedia.org/wiki/Binary_heap'>Wikipedia article on binary heaps</a> explains the standard technique well, so I won’t repeat it.</p>
<p>The only piece of trickiness is the use of <code>Obj.magic 0</code> for unused elements of the array, so we can grow it by doubling the size rather than adding a single element each time, and thereby amortize the cost of blitting the old array.</p>
<div class='highlight'><pre><code class='ocaml'><span class='k'>module</span> <span class='nc'>Make</span> <span class='o'>(</span><span class='nc'>O</span> <span class='o'>:</span> <span class='nc'>OrderedType</span><span class='o'>)</span> <span class='o'>:</span> <span class='nc'>S</span> <span class='k'>with</span> <span class='k'>type</span> <span class='n'>elt</span> <span class='o'>=</span> <span class='nn'>O</span><span class='p'>.</span><span class='n'>t</span> <span class='o'>=</span>
<span class='k'>struct</span>
<span class='k'>type</span> <span class='n'>elt</span> <span class='o'>=</span> <span class='nn'>O</span><span class='p'>.</span><span class='n'>t</span>
<span class='k'>type</span> <span class='n'>t</span> <span class='o'>=</span> <span class='o'>{</span> <span class='k'>mutable</span> <span class='n'>arr</span> <span class='o'>:</span> <span class='n'>elt</span> <span class='kt'>array</span><span class='o'>;</span> <span class='k'>mutable</span> <span class='n'>len</span> <span class='o'>:</span> <span class='kt'>int</span> <span class='o'>}</span>
<span class='k'>let</span> <span class='n'>make</span> <span class='bp'>()</span> <span class='o'>=</span> <span class='o'>{</span> <span class='n'>arr</span> <span class='o'>=</span> <span class='o'>[||];</span> <span class='n'>len</span> <span class='o'>=</span> <span class='mi'>0</span><span class='o'>;</span> <span class='o'>}</span>
<span class='k'>let</span> <span class='n'>compare</span> <span class='n'>h</span> <span class='n'>i1</span> <span class='n'>i2</span> <span class='o'>=</span> <span class='nn'>O</span><span class='p'>.</span><span class='n'>compare</span> <span class='n'>h</span><span class='o'>.</span><span class='n'>arr</span><span class='o'>.(</span><span class='n'>i1</span><span class='o'>)</span> <span class='n'>h</span><span class='o'>.</span><span class='n'>arr</span><span class='o'>.(</span><span class='n'>i2</span><span class='o'>)</span>
<span class='k'>let</span> <span class='n'>swap</span> <span class='n'>h</span> <span class='n'>i1</span> <span class='n'>i2</span> <span class='o'>=</span>
<span class='k'>let</span> <span class='n'>t</span> <span class='o'>=</span> <span class='n'>h</span><span class='o'>.</span><span class='n'>arr</span><span class='o'>.(</span><span class='n'>i1</span><span class='o'>)</span> <span class='k'>in</span>
<span class='n'>h</span><span class='o'>.</span><span class='n'>arr</span><span class='o'>.(</span><span class='n'>i1</span><span class='o'>)</span> <span class='o'><-</span> <span class='n'>h</span><span class='o'>.</span><span class='n'>arr</span><span class='o'>.(</span><span class='n'>i2</span><span class='o'>);</span>
<span class='n'>h</span><span class='o'>.</span><span class='n'>arr</span><span class='o'>.(</span><span class='n'>i2</span><span class='o'>)</span> <span class='o'><-</span> <span class='n'>t</span>
<span class='k'>let</span> <span class='k'>rec</span> <span class='n'>up</span> <span class='n'>h</span> <span class='n'>i</span> <span class='o'>=</span>
<span class='k'>if</span> <span class='n'>i</span> <span class='o'>=</span> <span class='mi'>0</span> <span class='k'>then</span> <span class='bp'>()</span>
<span class='k'>else</span>
<span class='k'>let</span> <span class='n'>p</span> <span class='o'>=</span> <span class='o'>(</span><span class='n'>i</span> <span class='o'>-</span> <span class='mi'>1</span><span class='o'>)</span> <span class='o'>/</span> <span class='mi'>2</span> <span class='k'>in</span>
<span class='k'>if</span> <span class='n'>compare</span> <span class='n'>h</span> <span class='n'>i</span> <span class='n'>p</span> <span class='o'><</span> <span class='mi'>0</span> <span class='k'>then</span> <span class='k'>begin</span>
<span class='n'>swap</span> <span class='n'>h</span> <span class='n'>i</span> <span class='n'>p</span><span class='o'>;</span>
<span class='n'>up</span> <span class='n'>h</span> <span class='n'>p</span>
<span class='k'>end</span>
<span class='k'>let</span> <span class='k'>rec</span> <span class='n'>down</span> <span class='n'>h</span> <span class='n'>i</span> <span class='o'>=</span>
<span class='k'>let</span> <span class='n'>l</span> <span class='o'>=</span> <span class='mi'>2</span> <span class='o'>*</span> <span class='n'>i</span> <span class='o'>+</span> <span class='mi'>1</span> <span class='k'>in</span>
<span class='k'>let</span> <span class='n'>r</span> <span class='o'>=</span> <span class='mi'>2</span> <span class='o'>*</span> <span class='n'>i</span> <span class='o'>+</span> <span class='mi'>2</span> <span class='k'>in</span>
<span class='k'>if</span> <span class='n'>l</span> <span class='o'>>=</span> <span class='n'>h</span><span class='o'>.</span><span class='n'>len</span> <span class='k'>then</span> <span class='bp'>()</span>
<span class='k'>else</span>
<span class='k'>let</span> <span class='n'>child</span> <span class='o'>=</span>
<span class='k'>if</span> <span class='n'>r</span> <span class='o'>>=</span> <span class='n'>h</span><span class='o'>.</span><span class='n'>len</span> <span class='k'>then</span> <span class='n'>l</span>
<span class='k'>else</span> <span class='k'>if</span> <span class='n'>compare</span> <span class='n'>h</span> <span class='n'>l</span> <span class='n'>r</span> <span class='o'><</span> <span class='mi'>0</span> <span class='k'>then</span> <span class='n'>l</span> <span class='k'>else</span> <span class='n'>r</span> <span class='k'>in</span>
<span class='k'>if</span> <span class='n'>compare</span> <span class='n'>h</span> <span class='n'>i</span> <span class='n'>child</span> <span class='o'>></span> <span class='mi'>0</span> <span class='k'>then</span> <span class='k'>begin</span>
<span class='n'>swap</span> <span class='n'>h</span> <span class='n'>i</span> <span class='n'>child</span><span class='o'>;</span>
<span class='n'>down</span> <span class='n'>h</span> <span class='n'>child</span>
<span class='k'>end</span>
<span class='k'>let</span> <span class='n'>add</span> <span class='n'>h</span> <span class='n'>e</span> <span class='o'>=</span>
<span class='k'>if</span> <span class='n'>h</span><span class='o'>.</span><span class='n'>len</span> <span class='o'>=</span> <span class='nn'>Array</span><span class='p'>.</span><span class='n'>length</span> <span class='n'>h</span><span class='o'>.</span><span class='n'>arr</span>
<span class='k'>then</span> <span class='k'>begin</span>
<span class='k'>let</span> <span class='n'>len</span> <span class='o'>=</span> <span class='mi'>2</span> <span class='o'>*</span> <span class='n'>h</span><span class='o'>.</span><span class='n'>len</span> <span class='o'>+</span> <span class='mi'>1</span> <span class='k'>in</span>
<span class='k'>let</span> <span class='n'>arr'</span> <span class='o'>=</span> <span class='nn'>Array</span><span class='p'>.</span><span class='n'>make</span> <span class='n'>len</span> <span class='o'>(</span><span class='nn'>Obj</span><span class='p'>.</span><span class='n'>magic</span> <span class='mi'>0</span><span class='o'>)</span> <span class='k'>in</span>
<span class='nn'>Array</span><span class='p'>.</span><span class='n'>blit</span> <span class='n'>h</span><span class='o'>.</span><span class='n'>arr</span> <span class='mi'>0</span> <span class='n'>arr'</span> <span class='mi'>0</span> <span class='n'>h</span><span class='o'>.</span><span class='n'>len</span><span class='o'>;</span>
<span class='n'>h</span><span class='o'>.</span><span class='n'>arr</span> <span class='o'><-</span> <span class='n'>arr'</span>
<span class='k'>end</span><span class='o'>;</span>
<span class='n'>h</span><span class='o'>.</span><span class='n'>arr</span><span class='o'>.(</span><span class='n'>h</span><span class='o'>.</span><span class='n'>len</span><span class='o'>)</span> <span class='o'><-</span> <span class='n'>e</span><span class='o'>;</span>
<span class='n'>up</span> <span class='n'>h</span> <span class='n'>h</span><span class='o'>.</span><span class='n'>len</span><span class='o'>;</span>
<span class='n'>h</span><span class='o'>.</span><span class='n'>len</span> <span class='o'><-</span> <span class='n'>h</span><span class='o'>.</span><span class='n'>len</span> <span class='o'>+</span> <span class='mi'>1</span>
<span class='k'>let</span> <span class='n'>peek_min</span> <span class='n'>h</span> <span class='o'>=</span>
<span class='k'>match</span> <span class='n'>h</span><span class='o'>.</span><span class='n'>len</span> <span class='k'>with</span>
<span class='o'>|</span> <span class='mi'>0</span> <span class='o'>-></span> <span class='nc'>None</span>
<span class='o'>|</span> <span class='o'>_</span> <span class='o'>-></span> <span class='nc'>Some</span> <span class='n'>h</span><span class='o'>.</span><span class='n'>arr</span><span class='o'>.(</span><span class='mi'>0</span><span class='o'>)</span>
<span class='k'>let</span> <span class='n'>take_min</span> <span class='n'>h</span> <span class='o'>=</span>
<span class='k'>match</span> <span class='n'>h</span><span class='o'>.</span><span class='n'>len</span> <span class='k'>with</span>
<span class='o'>|</span> <span class='mi'>0</span> <span class='o'>-></span> <span class='k'>raise</span> <span class='nc'>Not_found</span>
<span class='o'>|</span> <span class='mi'>1</span> <span class='o'>-></span>
<span class='k'>let</span> <span class='n'>m</span> <span class='o'>=</span> <span class='n'>h</span><span class='o'>.</span><span class='n'>arr</span><span class='o'>.(</span><span class='mi'>0</span><span class='o'>)</span> <span class='k'>in</span>
<span class='n'>h</span><span class='o'>.</span><span class='n'>arr</span><span class='o'>.(</span><span class='mi'>0</span><span class='o'>)</span> <span class='o'><-</span> <span class='o'>(</span><span class='nn'>Obj</span><span class='p'>.</span><span class='n'>magic</span> <span class='mi'>0</span><span class='o'>);</span>
<span class='n'>h</span><span class='o'>.</span><span class='n'>len</span> <span class='o'><-</span> <span class='mi'>0</span><span class='o'>;</span>
<span class='n'>m</span>
<span class='o'>|</span> <span class='n'>k</span> <span class='o'>-></span>
<span class='k'>let</span> <span class='n'>m</span> <span class='o'>=</span> <span class='n'>h</span><span class='o'>.</span><span class='n'>arr</span><span class='o'>.(</span><span class='mi'>0</span><span class='o'>)</span> <span class='k'>in</span>
<span class='k'>let</span> <span class='n'>k</span> <span class='o'>=</span> <span class='n'>k</span> <span class='o'>-</span> <span class='mi'>1</span> <span class='k'>in</span>
<span class='n'>h</span><span class='o'>.</span><span class='n'>arr</span><span class='o'>.(</span><span class='mi'>0</span><span class='o'>)</span> <span class='o'><-</span> <span class='n'>h</span><span class='o'>.</span><span class='n'>arr</span><span class='o'>.(</span><span class='n'>k</span><span class='o'>);</span>
<span class='n'>h</span><span class='o'>.</span><span class='n'>arr</span><span class='o'>.(</span><span class='n'>k</span><span class='o'>)</span> <span class='o'><-</span> <span class='o'>(</span><span class='nn'>Obj</span><span class='p'>.</span><span class='n'>magic</span> <span class='mi'>0</span><span class='o'>);</span>
<span class='n'>h</span><span class='o'>.</span><span class='n'>len</span> <span class='o'><-</span> <span class='n'>k</span><span class='o'>;</span>
<span class='n'>down</span> <span class='n'>h</span> <span class='mi'>0</span><span class='o'>;</span>
<span class='n'>m</span>
<span class='k'>let</span> <span class='n'>size</span> <span class='n'>h</span> <span class='o'>=</span> <span class='n'>h</span><span class='o'>.</span><span class='n'>len</span>
<span class='k'>end</span>
</code></pre>
</div>
<p>(Complete code is <a href='https://github.com/jaked/ambassadortothecomputers.blogspot.com/tree/master/_code/binary-heaps'>here</a>.)</p>Jake Donhamhttp://www.blogger.com/profile/04768087689799941690noreply@blogger.com0tag:blogger.com,1999:blog-1445545651031573301.post-23523347988980866382010-09-10T17:16:00.000-07:002010-09-13T10:55:05.949-07:00Reading Camlp4, part 11: syntax extensions<p>In this final (?) post in my series on Camlp4, I want at last to cover syntax extensions. A nontrivial syntax extension involves almost all the topics we have <a href='/p/reading-camlp4.html'>previously covered</a>, so it seems fitting that we treat them last.</p>
<b>Extending grammars</b>
<p>In the post on <a href='/2010/05/reading-camlp4-part-6-parsing.html'>parsing</a> we covered Camlp4 grammars but stopped short of explaining how to extend them. Well, this is not completely true: we used the <code>EXTEND</code> form to extend an empty grammar, and we can also use it to extend non-empty grammars. We saw a small example of this when implementing <a href='/2010/08/reading-camlp4-part-8-implementing.html'>quotations</a>, where we extended the JSON grammar with a new <code>json_eoi</code> entry (which refered to an entry in the original grammar). Rules and levels may also be added to existing entries, and rules may be deleted.</p>
<p>Let’s look at a complete syntax extension, which demonstrates modifying Camlp4’s OCaml grammar. The purpose of the extension is to change the precedence of the method call operator <code>#</code> to make “method chaining” read better. For example, if the <code>foo</code> method returns an object, you can write</p>
<div class='highlight'><pre><code class='ocaml'> <span class='n'>obj</span><span class='o'>#</span><span class='n'>foo</span> <span class='s2'>"bar"</span> <span class='o'>#</span><span class='n'>baz</span>
</code></pre>
</div>
<p>to call the <code>baz</code> method, rather than needing</p>
<div class='highlight'><pre><code class='ocaml'> <span class='o'>(</span><span class='n'>obj</span><span class='o'>#</span><span class='n'>foo</span> <span class='s2'>"bar"</span><span class='o'>)#</span><span class='n'>baz</span>
</code></pre>
</div>
<p>(I originally wrote this for use with the <a href='http://github.com/jaked/ocamljs/tree/master/src/jquery/'><code>jQuery</code> binding for <code>ocamljs</code></a>; method chaining is common with <code>jQuery</code>.)</p>
<p>Here is the extension:</p>
<div class='highlight'><pre><code class='ocaml'> <span class='k'>open</span> <span class='nc'>Camlp4</span>
<span class='k'>module</span> <span class='nc'>Id</span> <span class='o'>:</span> <span class='nn'>Sig</span><span class='p'>.</span><span class='nc'>Id</span> <span class='o'>=</span>
<span class='k'>struct</span>
<span class='k'>let</span> <span class='n'>name</span> <span class='o'>=</span> <span class='s2'>"pa_jquery"</span>
<span class='k'>let</span> <span class='n'>version</span> <span class='o'>=</span> <span class='s2'>"0.1"</span>
<span class='k'>end</span>
<span class='k'>module</span> <span class='nc'>Make</span> <span class='o'>(</span><span class='nc'>Syntax</span> <span class='o'>:</span> <span class='nn'>Sig</span><span class='p'>.</span><span class='nc'>Camlp4Syntax</span><span class='o'>)</span> <span class='o'>=</span>
<span class='k'>struct</span>
<span class='k'>open</span> <span class='nc'>Sig</span>
<span class='k'>include</span> <span class='nc'>Syntax</span>
<span class='nc'>DELETE_RULE</span> <span class='nc'>Gram</span> <span class='n'>expr</span><span class='o'>:</span> <span class='nc'>SELF</span><span class='o'>;</span> <span class='s2'>"#"</span><span class='o'>;</span> <span class='n'>label</span> <span class='nc'>END</span><span class='o'>;</span>
<span class='nc'>EXTEND</span> <span class='nc'>Gram</span>
<span class='n'>expr</span><span class='o'>:</span> <span class='nc'>BEFORE</span> <span class='s2'>"apply"</span>
<span class='o'>[</span> <span class='s2'>"#"</span> <span class='nc'>LEFTA</span>
<span class='o'>[</span> <span class='n'>e</span> <span class='o'>=</span> <span class='nc'>SELF</span><span class='o'>;</span> <span class='s2'>"#"</span><span class='o'>;</span> <span class='n'>lab</span> <span class='o'>=</span> <span class='n'>label</span> <span class='o'>-></span>
<span class='o'><:</span><span class='n'>expr</span><span class='o'><</span> <span class='o'>$</span><span class='n'>e</span><span class='o'>$</span> <span class='o'>#</span> <span class='o'>$</span><span class='n'>lab</span><span class='o'>$</span> <span class='o'>>></span> <span class='o'>]</span>
<span class='o'>];</span>
<span class='nc'>END</span>
<span class='k'>end</span>
<span class='k'>module</span> <span class='nc'>M</span> <span class='o'>=</span> <span class='nn'>Register</span><span class='p'>.</span><span class='nc'>OCamlSyntaxExtension</span><span class='o'>(</span><span class='nc'>Id</span><span class='o'>)(</span><span class='nc'>Make</span><span class='o'>)</span>
</code></pre>
</div>
<p>To make sense of a syntax extension it’s helpful to refer to <code>Camlp4OCamlRevisedParser.ml</code> (which defines the revised syntax grammar) and <code>Camlp4OCamlParser.ml</code> (which defines the original syntax as an extension of the revised syntax). There we see that the <code>#</code> operator is parsed in the <code>expr</code> entry, in a level called ”<code>.</code>” (which includes other dereferencing operators), and that this level appears below the <code>apply</code> level, which parses function application. Recall from the <a href='/2010/05/reading-camlp4-part-6-parsing.html'>parsing</a> post that operators in lower levels bind more tightly. So to get the effect we want, we need to move the <code>#</code> rule above the <code>apply</code> level in the grammar.</p>
<p>First we delete the rule from its original location: <code>DELETE_RULE</code> takes the grammar, the entry, and the symbols on the left-hand side of the rule, followed by <code>END</code>; you don’t have to say in what level it appears. Then we add the rule at a new location: we create a new level <code>#</code> containing the rule from the original grammar, and add it before the level named <code>apply</code>.</p>
<p>There are several ways to specify where a level is inserted: <code>BEFORE</code> <em>level</em> and <code>AFTER</code> <em>level</em> put it before or after some other level; <code>LEVEL</code> <em>level</em> adds rules to an existing level (you will be warned but not stopped from changing the label or associativity of the level); <code>FIRST</code> and <code>LAST</code> put the level before or after all other levels. If you don’t specify, rules are added to the topmost level in the entry. The resulting grammar works just as if you had given it all at once, making the insertions in the specified places. (However, it is not very clear from the code how ordering works when inserting rules into an existing level; it is perhaps best not to rely on the order of rules in a level anyway.)</p>
<p>Finally we register the extension. The <code>Make</code> argument to <code>OCamlSyntaxExtension</code> returns a <code>Sig.Camlp4Syntax</code> for some reason (in <code>Register.ml</code> it is just ignored) so we <code>include Syntax</code> to provide it.</p>
<p>(The complete code for this example is <a href='http://github.com/jaked/ambassadortothecomputers.blogspot.com/tree/master/_code/camlp4-syntax-extensions/pa_jquery'>here</a>.)</p>
<b>Transforming the AST</b>
<p>Let’s do a slightly more complicated example involving some transformation of the parsed AST. It often comes up that we want to <code>let</code>-bind the value of an expression to a name, trapping exceptions, then evaluate the body of the <code>let</code> outside the scope of the exception handler. This is a bit painful to write in stock OCaml; we can only straightforwardly express trapping exceptions in the whole <code>let</code> expression:</p>
<div class='highlight'><pre><code class='ocaml'> <span class='k'>try</span> <span class='k'>let</span> <span class='n'>x</span> <span class='o'>=</span> <span class='n'>e1</span> <span class='k'>in</span> <span class='n'>e2</span>
<span class='k'>with</span> <span class='n'>e</span> <span class='o'>-></span> <span class='n'>h</span>
</code></pre>
</div>
<p>A nice alternative is to use thunks to delay the evaluation of the body, doing it outside the scope of the <code>try</code>/<code>with</code>:</p>
<div class='highlight'><pre><code class='ocaml'> <span class='o'>(</span><span class='k'>try</span> <span class='k'>let</span> <span class='n'>x</span> <span class='o'>=</span> <span class='n'>e1</span> <span class='k'>in</span> <span class='k'>fun</span> <span class='bp'>()</span> <span class='o'>-></span> <span class='n'>e2</span>
<span class='k'>with</span> <span class='n'>e</span> <span class='o'>-></span> <span class='k'>fun</span> <span class='bp'>()</span> <span class='o'>-></span> <span class='n'>h</span><span class='o'>)</span><span class='bp'>()</span>
</code></pre>
</div>
<p>(We must thunkify the exception handler to make the types work out.) This is simple enough to do by hand, but let’s give it some syntactic sugar:</p>
<div class='highlight'><pre><code class='ocaml'> <span class='k'>let</span> <span class='k'>try</span> <span class='n'>x</span> <span class='o'>=</span> <span class='n'>e1</span> <span class='k'>in</span> <span class='n'>e2</span>
<span class='k'>with</span> <span class='n'>e</span> <span class='o'>-></span> <span class='n'>h</span>
</code></pre>
</div>
<p>which should expand to the thunkified version above. (The idea and syntax are taken from Martin Jambon’s <a href='http://martin.jambon.free.fr/micmatch.html'>micmatch</a> extension.)</p>
<p>Let’s look at the existing rules in <code>Camlp4OCamlRevisedParser.ml</code> for <code>let</code> and <code>try</code> to get an idea of how to parse the <code>let</code>/<code>try</code> form:</p>
<div class='highlight'><pre><code class='ocaml'> <span class='o'>[</span> <span class='s2'>"let"</span><span class='o'>;</span> <span class='n'>r</span> <span class='o'>=</span> <span class='n'>opt_rec</span><span class='o'>;</span> <span class='n'>bi</span> <span class='o'>=</span> <span class='n'>binding</span><span class='o'>;</span> <span class='s2'>"in"</span><span class='o'>;</span> <span class='n'>x</span> <span class='o'>=</span> <span class='nc'>SELF</span> <span class='o'>-></span>
<span class='o'><:</span><span class='n'>expr</span><span class='o'><</span> <span class='k'>let</span> <span class='o'>$</span><span class='k'>rec</span><span class='o'>:</span><span class='n'>r</span><span class='o'>$</span> <span class='o'>$</span><span class='n'>bi</span><span class='o'>$</span> <span class='k'>in</span> <span class='o'>$</span><span class='n'>x</span><span class='o'>$</span> <span class='o'>>></span>
<span class='o'>...</span>
<span class='o'>|</span> <span class='s2'>"try"</span><span class='o'>;</span> <span class='n'>e</span> <span class='o'>=</span> <span class='n'>sequence</span><span class='o'>;</span> <span class='s2'>"with"</span><span class='o'>;</span> <span class='n'>a</span> <span class='o'>=</span> <span class='n'>match_case</span> <span class='o'>-></span>
<span class='o'><:</span><span class='n'>expr</span><span class='o'><</span> <span class='k'>try</span> <span class='o'>$</span><span class='n'>mksequence'</span> <span class='o'>_</span><span class='n'>loc</span> <span class='n'>e</span><span class='o'>$</span> <span class='k'>with</span> <span class='o'>[</span> <span class='o'>$</span><span class='n'>a</span><span class='o'>$</span> <span class='o'>]</span> <span class='o'>>></span>
</code></pre>
</div>
<p>For <code>let</code>, the <code>opt_rec</code> entry parses an optional <code>rec</code> keyword (we see there is a special antiquotation for interpolating <code>rec</code>). <code>Binding</code> parses a group of bindings separated by <code>and</code>. <code>SELF</code> is just <code>expr</code>. For <code>try</code>, <code>sequence</code> is a sequence of expressions separated by <code>;</code>, and <code>match_case</code> is a group of match cases separated by <code>|</code>. (These entries are both a little different in the original syntax, to account for the different semicolon rules and the <code>[]</code> delimiters around the match cases.) Recall that <code>Camlp4OCamlRevisedParser.ml</code> uses the revised syntax quotations, so we have <code>[]</code> around the match cases. The call to <code>mksequence'</code> just wraps a <code>do {}</code> around a sequence if necessary; more on this below.</p>
<p>The parsing rule we want is a combination of these. Here is the extension:</p>
<div class='highlight'><pre><code class='ocaml'> <span class='nc'>EXTEND</span> <span class='nc'>Gram</span>
<span class='n'>expr</span><span class='o'>:</span> <span class='nc'>LEVEL</span> <span class='s2'>"top"</span> <span class='o'>[</span>
<span class='o'>[</span> <span class='s2'>"let"</span><span class='o'>;</span> <span class='s2'>"try"</span><span class='o'>;</span> <span class='n'>r</span> <span class='o'>=</span> <span class='n'>opt_rec</span><span class='o'>;</span> <span class='n'>bi</span> <span class='o'>=</span> <span class='n'>binding</span><span class='o'>;</span> <span class='s2'>"in"</span><span class='o'>;</span>
<span class='n'>e</span> <span class='o'>=</span> <span class='n'>sequence</span><span class='o'>;</span> <span class='s2'>"with"</span><span class='o'>;</span> <span class='n'>a</span> <span class='o'>=</span> <span class='n'>match_case</span> <span class='o'>-></span>
<span class='k'>let</span> <span class='n'>a</span> <span class='o'>=</span>
<span class='nn'>List</span><span class='p'>.</span><span class='n'>map</span>
<span class='o'>(</span><span class='k'>function</span>
<span class='o'>|</span> <span class='o'><:</span><span class='n'>match_case</span><span class='o'><</span> <span class='o'>$</span><span class='n'>p</span><span class='o'>$</span> <span class='k'>when</span> <span class='o'>$</span><span class='n'>w</span><span class='o'>$</span> <span class='o'>-></span> <span class='o'>$</span><span class='n'>e</span><span class='o'>$</span> <span class='o'>>></span> <span class='o'>-></span>
<span class='o'><:</span><span class='n'>match_case</span><span class='o'><</span>
<span class='o'>$</span><span class='n'>p</span><span class='o'>$</span> <span class='k'>when</span> <span class='o'>$</span><span class='n'>w</span><span class='o'>$</span> <span class='o'>-></span> <span class='k'>fun</span> <span class='bp'>()</span> <span class='o'>-></span> <span class='o'>$</span><span class='n'>e</span><span class='o'>$</span>
<span class='o'>>></span>
<span class='o'>|</span> <span class='n'>mc</span> <span class='o'>-></span> <span class='n'>mc</span><span class='o'>)</span>
<span class='o'>(</span><span class='nn'>Ast</span><span class='p'>.</span><span class='n'>list_of_match_case</span> <span class='n'>a</span> <span class='bp'>[]</span><span class='o'>)</span> <span class='k'>in</span>
<span class='o'><:</span><span class='n'>expr</span><span class='o'><</span>
<span class='o'>(</span><span class='k'>try</span> <span class='k'>let</span> <span class='o'>$</span><span class='k'>rec</span><span class='o'>:</span><span class='n'>r</span><span class='o'>$</span> <span class='o'>$</span><span class='n'>bi</span><span class='o'>$</span> <span class='k'>in</span> <span class='k'>fun</span> <span class='bp'>()</span> <span class='o'>-></span> <span class='k'>do</span> <span class='o'>{</span> <span class='o'>$</span><span class='n'>e</span><span class='o'>$</span> <span class='o'>}</span>
<span class='k'>with</span> <span class='o'>[</span> <span class='o'>$</span><span class='kt'>list</span><span class='o'>:</span><span class='n'>a</span><span class='o'>$</span> <span class='o'>])</span><span class='bp'>()</span>
<span class='o'>>></span>
<span class='o'>]</span>
<span class='o'>];</span>
<span class='nc'>END</span>
</code></pre>
</div>
<p>We put <code>rec</code> after <code>try</code> (following <code>micmatch</code>), which is a little weird <s>, but if we put it before we would need to look ahead to
disambiguate `let` from `let try`; once we parse `opt_rec` we are
committed to one rule or the other</s> ; instead we could start the rule <code>"let"; r = opt_rec; "try"</code>, which has no ambiguity with the ordinary <code>let</code> rule because the <code>"let"; opt_rec</code> prefix is factored out; the parser doesn’t choose between the rules until it tries to parse <code>try</code>. After <code>in</code> we parse <code>sequence</code> rather than <code>SELF</code>; this seems like a good choice because there is a <code>with</code> to end the sequence.</p>
<p>Now, to transform the AST, we map over the match cases. The <code>match_case</code> entry returns a list of cases separated by <code>Ast.McOr</code>; we call <code>list_of_match_case</code> to get an ordinary list. For each case, we match the pattern, <code>when</code> clause, and expression on the right-hand side (these are packaged in an <code>Ast.McArr</code>, where the <code>when</code> clause field is <code>Ast.ExNil</code> if there is no <code>when</code> clause), and return it with the expression thunkified. Then we return the whole <code>let</code> inside <code>try</code>, with the body sequence thunkified.</p>
<p>We have to add a <code>do {}</code> around the body, creating an <code>Ast.ExSeq</code> node, because that’s what is expected by <code>Camlp4Ast2OCamlAst.ml</code>—recall from the <a href='/2010/03/reading-camlp4-part-5-filters.html'>filters</a> post that the Camlp4 AST is translated to an OCaml AST and marshalled to the compiler. If we forget this (and “we” often forget these idiosyncrasies) then we get the error ”<code>expr; expr: not allowed here, use do {...} or [|...|] to surround them</code>”, which is pretty helpful as these errors go.</p>
<p>(The complete code for this example is <a href='http://github.com/jaked/ambassadortothecomputers.blogspot.com/tree/master/_code/camlp4-syntax-extensions/pa_let_try'>here</a>.)</p>
<b>Extending pattern matching</b>
<p>As a final example, let’s extend OCaml’s pattern syntax. In the <a href='/2010/08/reading-camlp4-part-9-implementing.html'>quotations</a> post we noted that JSON quotations in a pattern are not very useful, because we would usually like a pattern to match even if the fields of an object come in a different order or there are extra fields. To keep the code short let’s abstract the problem a little and consider matching association lists: if we write a match case</p>
<div class='highlight'><pre><code class='ocaml'> <span class='o'>|</span> <span class='n'>alist</span> <span class='o'>[</span> <span class='s2'>"foo"</span><span class='o'>,</span> <span class='n'>x</span><span class='o'>;</span> <span class='s2'>"bar"</span><span class='o'>,</span> <span class='n'>y</span> <span class='o'>]</span> <span class='o'>-></span> <span class='n'>e</span>
</code></pre>
</div>
<p>we would like it to match association lists with <code>"foo"</code> and <code>"bar"</code> keys, in any order, with any extra pairs in the list. Our translation looks like this:</p>
<div class='highlight'><pre><code class='ocaml'> <span class='o'>|</span> <span class='o'>__</span><span class='n'>pa_alist_patt_1</span> <span class='k'>when</span>
<span class='o'>(</span><span class='k'>match</span> <span class='o'>((</span><span class='k'>try</span> <span class='nc'>Some</span> <span class='o'>(</span><span class='nn'>List</span><span class='p'>.</span><span class='n'>assoc</span> <span class='s2'>"foo"</span> <span class='o'>__</span><span class='n'>pa_alist_patt_1</span><span class='o'>)</span>
<span class='k'>with</span> <span class='o'>|</span> <span class='nc'>Not_found</span> <span class='o'>-></span> <span class='nc'>None</span><span class='o'>),</span>
<span class='o'>(</span><span class='k'>try</span> <span class='nc'>Some</span> <span class='o'>(</span><span class='nn'>List</span><span class='p'>.</span><span class='n'>assoc</span> <span class='s2'>"bar"</span> <span class='o'>__</span><span class='n'>pa_alist_patt_1</span><span class='o'>)</span>
<span class='k'>with</span> <span class='o'>|</span> <span class='nc'>Not_found</span> <span class='o'>-></span> <span class='nc'>None</span><span class='o'>))</span>
<span class='k'>with</span>
<span class='o'>|</span> <span class='o'>(</span><span class='nc'>Some</span> <span class='n'>x</span><span class='o'>,</span> <span class='nc'>Some</span> <span class='n'>y</span><span class='o'>)</span> <span class='o'>-></span> <span class='bp'>true</span>
<span class='o'>|</span> <span class='o'>_</span> <span class='o'>-></span> <span class='bp'>false</span><span class='o'>)</span>
<span class='o'>-></span>
<span class='o'>(</span><span class='k'>match</span> <span class='o'>((</span><span class='k'>try</span> <span class='nc'>Some</span> <span class='o'>(</span><span class='nn'>List</span><span class='p'>.</span><span class='n'>assoc</span> <span class='s2'>"foo"</span> <span class='o'>__</span><span class='n'>pa_alist_patt_1</span><span class='o'>)</span>
<span class='k'>with</span> <span class='o'>|</span> <span class='nc'>Not_found</span> <span class='o'>-></span> <span class='nc'>None</span><span class='o'>),</span>
<span class='o'>(</span><span class='k'>try</span> <span class='nc'>Some</span> <span class='o'>(</span><span class='nn'>List</span><span class='p'>.</span><span class='n'>assoc</span> <span class='s2'>"bar"</span> <span class='o'>__</span><span class='n'>pa_alist_patt_1</span><span class='o'>)</span>
<span class='k'>with</span> <span class='o'>|</span> <span class='nc'>Not_found</span> <span class='o'>-></span> <span class='nc'>None</span><span class='o'>))</span>
<span class='k'>with</span>
<span class='o'>|</span> <span class='o'>(</span><span class='nc'>Some</span> <span class='n'>x</span><span class='o'>,</span> <span class='nc'>Some</span> <span class='n'>y</span><span class='o'>)</span> <span class='o'>-></span> <span class='n'>e</span>
<span class='o'>|</span> <span class='o'>_</span> <span class='o'>-></span> <span class='k'>assert</span> <span class='bp'>false</span><span class='o'>)</span>
</code></pre>
</div>
<p>This might seem overcomplicated, and it is true that we could simplify it for this case. But the built-in pattern syntax is complicated, and it is tricky handling all the cases to make things work smoothly; the strategy that produces the code above will handle some (but not all) of the complications. (We’ll consider some improvements below.)</p>
<p>The basic idea is that when we come to an <code>alist</code> we replace it with a new fresh name, then do further matching in a <code>when</code> clause, so if it fails we can continue to the next case by returning <code>false</code>. In the <code>when</code> clause we look up the keys, putting them in <code>option</code>s, then match on the <code>option</code>s; we handle nested patterns (to the right of a key) by embedding them in the <code>when</code> clause match. The <code>when</code> clause match also binds variables appearing in the original pattern, so they are available to the <code>when</code> clause of the original case (if there is one). Finally, we do the whole thing over again in the match case body to provide bindings to the original body.</p>
<p>In order to implement this we’ll use both a syntax extension and a filter. The reason is that we’d like to extend the <code>patt</code> entry, but to do the AST transformation we sketched above we need to transform <code>match_case</code>s. We could replace the <code>match_case</code> part of the parser as well but that seems needlessly hairy, and generally when writing a syntax extension we’d like to touch as little of the parser as possible so it interoperates well with other extensions.</p>
<p>First, here is the syntax extension:</p>
<div class='highlight'><pre><code class='ocaml'> <span class='nc'>EXTEND</span> <span class='nc'>Gram</span>
<span class='n'>patt</span><span class='o'>:</span> <span class='nc'>LEVEL</span> <span class='s2'>"simple"</span>
<span class='o'>[[</span>
<span class='s2'>"alist"</span><span class='o'>;</span> <span class='s2'>"["</span><span class='o'>;</span>
<span class='n'>l</span> <span class='o'>=</span>
<span class='nc'>LIST0</span>
<span class='o'>[</span> <span class='n'>e</span> <span class='o'>=</span> <span class='n'>expr</span> <span class='nc'>LEVEL</span> <span class='s2'>"simple"</span><span class='o'>;</span> <span class='s2'>","</span><span class='o'>;</span>
<span class='n'>p</span> <span class='o'>=</span> <span class='n'>patt</span> <span class='nc'>LEVEL</span> <span class='s2'>"simple"</span> <span class='o'>-></span>
<span class='nn'>Ast</span><span class='p'>.</span><span class='nc'>PaOlbi</span> <span class='o'>(_</span><span class='n'>loc</span><span class='o'>,</span> <span class='s2'>""</span><span class='o'>,</span> <span class='n'>p</span><span class='o'>,</span> <span class='n'>e</span><span class='o'>)</span> <span class='o'>]</span>
<span class='nc'>SEP</span> <span class='s2'>";"</span><span class='o'>;</span>
<span class='s2'>"]"</span> <span class='o'>-></span>
<span class='o'><:</span><span class='n'>patt</span><span class='o'><</span> <span class='o'>$</span><span class='n'>uid</span><span class='o'>:</span><span class='s2'>"alist"</span><span class='o'>$</span> <span class='o'>$</span><span class='nn'>Ast</span><span class='p'>.</span><span class='n'>paSem_of_list</span> <span class='n'>l</span><span class='o'>$</span> <span class='o'>>></span>
<span class='o'>]];</span>
<span class='nc'>END</span>
</code></pre>
</div>
<p>We extend the <code>simple</code> level of the <code>patt</code> entry, which parses primitive patterns. Inside <code>alist []</code> we parse a list of <code>expr</code> / <code>patt</code> pairs; we parse <code>expr</code> at the <code>simple</code> level or else it would parse the whole pair as an <code>expr</code>, and the same for <code>patt</code> just in case. Then we return the pair of expression and pattern in an <code>Ast.PaOlbi</code> (ordinarily used for optional argument defaults in function definitions). Why? Well, we need to return something of type <code>patt</code>, but we need somehow to get the <code>expr</code> to our filter, and this is the only <code>patt</code> constructor that holds an <code>expr</code>. (As an alternative we could parse a <code>patt</code> instead of an <code>expr</code>, but then we’d need to translate it to an <code>expr</code> at the point we use it.) Finally we return the list wrapped in a data constructor so we can recognize it easily in the filter; because it is lower-case, we can be sure that “alist” is not the identifier of a real data constructor.</p>
<p>Now let’s look at the filter. First, some helper functions:</p>
<div class='highlight'><pre><code class='ocaml'> <span class='k'>let</span> <span class='n'>fresh</span> <span class='o'>=</span>
<span class='k'>let</span> <span class='n'>id</span> <span class='o'>=</span> <span class='n'>ref</span> <span class='mi'>0</span> <span class='k'>in</span>
<span class='k'>fun</span> <span class='bp'>()</span> <span class='o'>-></span>
<span class='n'>incr</span> <span class='n'>id</span><span class='o'>;</span>
<span class='s2'>"__pa_alist_patt_"</span> <span class='o'>^</span> <span class='n'>string_of_int</span> <span class='o'>!</span><span class='n'>id</span>
<span class='k'>let</span> <span class='n'>expr_tup_of_list</span> <span class='o'>_</span><span class='n'>loc</span> <span class='o'>=</span> <span class='k'>function</span>
<span class='o'>|</span> <span class='bp'>[]</span> <span class='o'>-></span> <span class='o'><:</span><span class='n'>expr</span><span class='o'><</span> <span class='bp'>()</span> <span class='o'>>></span>
<span class='o'>|</span> <span class='o'>[</span> <span class='n'>v</span> <span class='o'>]</span> <span class='o'>-></span> <span class='n'>v</span>
<span class='o'>|</span> <span class='n'>vs</span> <span class='o'>-></span> <span class='o'><:</span><span class='n'>expr</span><span class='o'><</span> <span class='o'>$</span><span class='n'>tup</span><span class='o'>:</span><span class='nn'>Ast</span><span class='p'>.</span><span class='n'>exCom_of_list</span> <span class='n'>vs</span><span class='o'>$</span> <span class='o'>>></span>
<span class='k'>let</span> <span class='n'>patt_tup_of_list</span> <span class='o'>_</span><span class='n'>loc</span> <span class='o'>=</span> <span class='k'>function</span>
<span class='o'>|</span> <span class='bp'>[]</span> <span class='o'>-></span> <span class='o'><:</span><span class='n'>patt</span><span class='o'><</span> <span class='bp'>()</span> <span class='o'>>></span>
<span class='o'>|</span> <span class='o'>[</span> <span class='n'>p</span> <span class='o'>]</span> <span class='o'>-></span> <span class='n'>p</span>
<span class='o'>|</span> <span class='n'>ps</span> <span class='o'>-></span> <span class='o'><:</span><span class='n'>patt</span><span class='o'><</span> <span class='o'>$</span><span class='n'>tup</span><span class='o'>:</span><span class='nn'>Ast</span><span class='p'>.</span><span class='n'>paCom_of_list</span> <span class='n'>ps</span><span class='o'>$</span> <span class='o'>>></span>
</code></pre>
</div>
<p>We have a function to generate fresh names, a function to turn a list of expressions into a tuple, and a similar function for patterns. The reason we need these latter two is that a tuple with 0 or 1 elements is not allowed by <code>Camlp4Ast2OCamlAst.ml</code> (the empty “tuple” is actually a special identifier in the Camlp4 AST). Next, the main rewrite function:</p>
<div class='highlight'><pre><code class='ocaml'> <span class='k'>let</span> <span class='n'>rewrite</span> <span class='o'>_</span><span class='n'>loc</span> <span class='n'>p</span> <span class='n'>w</span> <span class='n'>e</span> <span class='o'>=</span>
<span class='k'>let</span> <span class='n'>k</span> <span class='o'>=</span> <span class='n'>ref</span> <span class='o'>(</span><span class='k'>fun</span> <span class='n'>s</span> <span class='n'>f</span> <span class='o'>-></span> <span class='n'>s</span><span class='o'>)</span> <span class='k'>in</span>
</code></pre>
</div>
<p>The function takes the parts of an <code>Ast.McArr</code> (that is, a match case). We’re going to map over the pattern <code>p</code>, building up a function <code>k</code> as we encounter nested <code>alist</code> forms. We want to generate the same matching code in the <code>when</code> clause and the body, so <code>k</code> is parameterized with an expression in case of success (the original <code>when</code> clause or the body) and in case of failure (<code>false</code> or <code>assert
false</code>). We will build <code>k</code> from the inside out, starting with a function that just returns the success expression.</p>
<div class='highlight'><pre><code class='ocaml'> <span class='k'>let</span> <span class='n'>map</span> <span class='o'>=</span>
<span class='k'>object</span>
<span class='k'>inherit</span> <span class='nn'>Ast</span><span class='p'>.</span><span class='n'>map</span> <span class='k'>as</span> <span class='n'>super</span>
<span class='k'>method</span> <span class='n'>patt</span> <span class='n'>p</span> <span class='o'>=</span>
<span class='k'>match</span> <span class='n'>super</span><span class='o'>#</span><span class='n'>patt</span> <span class='n'>p</span> <span class='k'>with</span>
<span class='o'>|</span> <span class='o'><:</span><span class='n'>patt</span><span class='o'><</span> <span class='o'>$</span><span class='n'>uid</span><span class='o'>:</span><span class='s2'>"alist"</span><span class='o'>$</span> <span class='o'>$</span><span class='n'>l</span><span class='o'>$</span> <span class='o'>>></span> <span class='o'>-></span>
<span class='k'>let</span> <span class='n'>id</span> <span class='o'>=</span> <span class='n'>fresh</span> <span class='bp'>()</span> <span class='k'>in</span>
<span class='k'>let</span> <span class='n'>l</span> <span class='o'>=</span>
<span class='nn'>List</span><span class='p'>.</span><span class='n'>map</span>
<span class='o'>(</span><span class='k'>function</span>
<span class='o'>|</span> <span class='nn'>Ast</span><span class='p'>.</span><span class='nc'>PaOlbi</span> <span class='o'>(_,</span> <span class='o'>_,</span> <span class='n'>p</span><span class='o'>,</span> <span class='n'>e</span><span class='o'>)</span> <span class='o'>-></span> <span class='n'>p</span><span class='o'>,</span> <span class='n'>e</span>
<span class='o'>|</span> <span class='o'>_</span> <span class='o'>-></span> <span class='k'>assert</span> <span class='bp'>false</span><span class='o'>)</span>
<span class='o'>(</span><span class='nn'>Ast</span><span class='p'>.</span><span class='n'>list_of_patt</span> <span class='n'>l</span> <span class='bp'>[]</span><span class='o'>)</span> <span class='k'>in</span>
<span class='k'>let</span> <span class='n'>vs</span> <span class='o'>=</span>
<span class='nn'>List</span><span class='p'>.</span><span class='n'>map</span>
<span class='o'>(</span><span class='k'>fun</span> <span class='o'>(_,</span> <span class='n'>e</span><span class='o'>)</span> <span class='o'>-></span>
<span class='o'><:</span><span class='n'>expr</span><span class='o'><</span>
<span class='k'>try</span> <span class='nc'>Some</span> <span class='o'>(</span><span class='nn'>List</span><span class='p'>.</span><span class='n'>assoc</span> <span class='o'>$</span><span class='n'>e</span><span class='o'>$</span> <span class='o'>$</span><span class='n'>lid</span><span class='o'>:</span><span class='n'>id</span><span class='o'>$)</span>
<span class='k'>with</span> <span class='nc'>Not_found</span> <span class='o'>-></span> <span class='nc'>None</span>
<span class='o'>>>)</span>
<span class='n'>l</span> <span class='k'>in</span>
<span class='k'>let</span> <span class='n'>ps</span> <span class='o'>=</span>
<span class='nn'>List</span><span class='p'>.</span><span class='n'>map</span>
<span class='o'>(</span><span class='k'>fun</span> <span class='o'>(</span><span class='n'>p</span><span class='o'>,</span> <span class='o'>_)</span> <span class='o'>-></span> <span class='o'><:</span><span class='n'>patt</span><span class='o'><</span> <span class='nc'>Some</span> <span class='o'>$</span><span class='n'>p</span><span class='o'>$</span> <span class='o'>>>)</span>
<span class='n'>l</span> <span class='k'>in</span>
<span class='k'>let</span> <span class='n'>k'</span> <span class='o'>=</span> <span class='o'>!</span><span class='n'>k</span> <span class='k'>in</span>
<span class='n'>k</span> <span class='o'>:=</span>
<span class='o'>(</span><span class='k'>fun</span> <span class='n'>s</span> <span class='n'>f</span> <span class='o'>-></span>
<span class='o'><:</span><span class='n'>expr</span><span class='o'><</span>
<span class='k'>match</span> <span class='o'>$</span><span class='n'>expr_tup_of_list</span> <span class='o'>_</span><span class='n'>loc</span> <span class='n'>vs</span><span class='o'>$</span> <span class='k'>with</span>
<span class='o'>|</span> <span class='o'>$</span><span class='n'>patt_tup_of_list</span> <span class='o'>_</span><span class='n'>loc</span> <span class='n'>ps</span><span class='o'>$</span> <span class='o'>-></span> <span class='o'>$</span><span class='n'>k'</span> <span class='n'>s</span> <span class='n'>f</span><span class='o'>$</span>
<span class='o'>|</span> <span class='o'>_</span> <span class='o'>-></span> <span class='o'>$</span><span class='n'>f</span><span class='o'>$</span>
<span class='o'>>>);</span>
<span class='o'><:</span><span class='n'>patt</span><span class='o'><</span> <span class='o'>$</span><span class='n'>lid</span><span class='o'>:</span><span class='n'>id</span><span class='o'>$</span> <span class='o'>>></span>
<span class='o'>|</span> <span class='n'>p</span> <span class='o'>-></span> <span class='n'>p</span>
<span class='k'>end</span> <span class='k'>in</span>
</code></pre>
</div>
<p>The <code>Ast.map</code> object provides methods to map each syntactic class of the AST, along with default implementations which return the node unchanged. We extend it to walk over the pattern, leaving it unchanged except when we come to our special <code>alist</code> constructor. In that case we generate a fresh name, which we return as the value of the function. Then we extract the <code>expr</code> / <code>patt</code> pairs and map them to <code>try Some (List.assoc ...</code> expressions and <code>Some</code> patterns. Finally we extend <code>k</code> by matching all the expressions against all the patterns; if the match succeeds we call the previous <code>k</code>, otherwise the failure expression. Since we build <code>k</code> from the inside out, we transform subpatterns first (by matching over <code>super#patt p</code>).</p>
<div class='highlight'><pre><code class='ocaml'> <span class='k'>let</span> <span class='n'>p</span> <span class='o'>=</span> <span class='n'>map</span><span class='o'>#</span><span class='n'>patt</span> <span class='n'>p</span> <span class='k'>in</span>
<span class='k'>let</span> <span class='n'>w</span> <span class='o'>=</span> <span class='k'>match</span> <span class='n'>w</span> <span class='k'>with</span> <span class='o'><:</span><span class='n'>expr</span><span class='o'><</span> <span class='o'>>></span> <span class='o'>-></span> <span class='o'><:</span><span class='n'>expr</span><span class='o'><</span> <span class='bp'>true</span> <span class='o'>>></span> <span class='o'>|</span> <span class='o'>_</span> <span class='o'>-></span> <span class='n'>w</span> <span class='k'>in</span>
<span class='k'>let</span> <span class='n'>w</span> <span class='o'>=</span> <span class='o'>!</span><span class='n'>k</span> <span class='n'>w</span> <span class='o'><:</span><span class='n'>expr</span><span class='o'><</span> <span class='bp'>false</span> <span class='o'>>></span> <span class='k'>in</span>
<span class='k'>let</span> <span class='n'>e</span> <span class='o'>=</span> <span class='o'>!</span><span class='n'>k</span> <span class='n'>e</span> <span class='o'><:</span><span class='n'>expr</span><span class='o'><</span> <span class='k'>assert</span> <span class='bp'>false</span> <span class='o'>>></span> <span class='k'>in</span>
<span class='o'><:</span><span class='n'>match_case</span><span class='o'><</span> <span class='o'>$</span><span class='n'>p</span><span class='o'>$</span> <span class='k'>when</span> <span class='o'>$</span><span class='n'>w</span><span class='o'>$</span> <span class='o'>-></span> <span class='o'>$</span><span class='n'>e</span><span class='o'>$</span> <span class='o'>>></span>
</code></pre>
</div>
<p>We call <code>map#patt</code> on <code>p</code> to replace special <code>alist</code> constructor nodes with fresh names and build up <code>k</code>, then call the resulting <code>k</code> on the <code>when</code> clause (if there is no <code>when</code> clause we replace it with <code>true</code>) and body, and finally return the result as a <code>match_case</code>, completing the rewrite function.</p>
<div class='highlight'><pre><code class='ocaml'> <span class='k'>let</span> <span class='n'>filter</span> <span class='o'>=</span>
<span class='k'>let</span> <span class='n'>map</span> <span class='o'>=</span>
<span class='k'>object</span>
<span class='k'>inherit</span> <span class='nn'>Ast</span><span class='p'>.</span><span class='n'>map</span> <span class='k'>as</span> <span class='n'>super</span>
<span class='k'>method</span> <span class='n'>match_case</span> <span class='n'>mc</span> <span class='o'>=</span>
<span class='k'>match</span> <span class='n'>super</span><span class='o'>#</span><span class='n'>match_case</span> <span class='n'>mc</span> <span class='k'>with</span>
<span class='o'>|</span> <span class='o'><:</span><span class='n'>match_case</span><span class='o'>@_</span><span class='n'>loc</span><span class='o'><</span> <span class='o'>$</span><span class='n'>p</span><span class='o'>$</span> <span class='k'>when</span> <span class='o'>$</span><span class='n'>w</span><span class='o'>$</span> <span class='o'>-></span> <span class='o'>$</span><span class='n'>e</span><span class='o'>$</span> <span class='o'>>></span> <span class='o'>-></span>
<span class='n'>rewrite</span> <span class='o'>_</span><span class='n'>loc</span> <span class='n'>p</span> <span class='n'>w</span> <span class='n'>e</span>
<span class='o'>|</span> <span class='n'>e</span> <span class='o'>-></span> <span class='n'>e</span>
<span class='k'>end</span> <span class='k'>in</span>
<span class='n'>map</span><span class='o'>#</span><span class='n'>str_item</span>
<span class='k'>let</span> <span class='o'>_</span> <span class='o'>=</span> <span class='nn'>AstFilters</span><span class='p'>.</span><span class='n'>register_str_item_filter</span> <span class='n'>filter</span>
</code></pre>
</div>
<p>We extend <code>Ast.map</code> again to call the rewrite function on each <code>match_case</code>, then register the resulting filter.</p>
<p>The code above handles <code>when</code> clauses and nested <code>alist</code> patterns, and interacts properly with ordinary OCaml patterns. However, it completely falls down on nested pattern alternatives. If we write</p>
<div class='highlight'><pre><code class='ocaml'><span class='k'>match</span> <span class='n'>x</span> <span class='k'>with</span>
<span class='o'>|</span> <span class='n'>alist</span> <span class='o'>[</span> <span class='s2'>"foo"</span><span class='o'>,</span> <span class='n'>f</span> <span class='o'>]</span>
<span class='o'>|</span> <span class='n'>alist</span> <span class='o'>[</span> <span class='s2'>"fooz"</span><span class='o'>,</span> <span class='n'>f</span> <span class='o'>]</span> <span class='o'>-></span> <span class='n'>e</span>
</code></pre>
</div>
<p>we get this mess:</p>
<div class='highlight'><pre><code class='ocaml'> <span class='o'>|</span> <span class='o'>__</span><span class='n'>pa_alist_patt_1</span> <span class='o'>|</span> <span class='o'>__</span><span class='n'>pa_alist_patt_2</span> <span class='k'>when</span>
<span class='o'>(</span><span class='k'>match</span> <span class='k'>try</span> <span class='nc'>Some</span> <span class='o'>(</span><span class='nn'>List</span><span class='p'>.</span><span class='n'>assoc</span> <span class='s2'>"fooz"</span> <span class='o'>__</span><span class='n'>pa_alist_patt_2</span><span class='o'>)</span>
<span class='k'>with</span> <span class='o'>|</span> <span class='nc'>Not_found</span> <span class='o'>-></span> <span class='nc'>None</span>
<span class='k'>with</span>
<span class='o'>|</span> <span class='nc'>Some</span> <span class='n'>f</span> <span class='o'>-></span>
<span class='o'>(</span><span class='k'>match</span> <span class='k'>try</span> <span class='nc'>Some</span> <span class='o'>(</span><span class='nn'>List</span><span class='p'>.</span><span class='n'>assoc</span> <span class='s2'>"foo"</span> <span class='o'>__</span><span class='n'>pa_alist_patt_1</span><span class='o'>)</span>
<span class='k'>with</span> <span class='o'>|</span> <span class='nc'>Not_found</span> <span class='o'>-></span> <span class='nc'>None</span>
<span class='k'>with</span>
<span class='o'>|</span> <span class='nc'>Some</span> <span class='n'>f</span> <span class='o'>-></span> <span class='bp'>true</span>
<span class='o'>|</span> <span class='o'>_</span> <span class='o'>-></span> <span class='bp'>false</span><span class='o'>)</span>
<span class='o'>|</span> <span class='o'>_</span> <span class='o'>-></span> <span class='bp'>false</span><span class='o'>)</span>
<span class='o'>-></span>
<span class='o'>...</span> <span class='c'>(* the same mess for the body *)</span>
</code></pre>
</div>
<p>The first problem is that both arms of an alternative must bind the same names, but we have replaced them with two different fresh names. The second problem is that we have blindly treated alternative <code>alist</code> patterns as being nested one inside the other. A solution to both these problems is to split nested alternatives into separate cases, at the cost of duplicating the <code>when</code> clause and body in each.</p>
<p>Jeremy Yallop’s <a href='http://code.google.com/p/ocaml-patterns'>patterns</a> framework (see <a href='http://github.com/jaked/patterns'>here</a> for an update that works with OCaml 3.12.0) allows multiple pattern extensions to coexist, and provides some common facilities to make them easier to write. In particular it splits nested alternatives into separate cases. Another deficiency in the code above is that it duplicates the match expression (built in <code>k</code>) in the <code>when</code> clause and body. This can be avoided by computing the body within the <code>when</code> clause, setting a reference, and dereferencing it in the body. However, the reference must be bound outside the <code>match_case</code> to be visible both in the <code>when</code> clause and the body, so this approach must transform each AST node that contains <code>match_case</code>s in order to bind the refs in the right place. The <code>patterns</code> framework handles this as well.</p>
<p>(The complete code for this example is <a href='http://github.com/jaked/ambassadortothecomputers.blogspot.com/tree/master/_code/camlp4-syntax-extensions/pa_alist_patt'>here</a>. A version using the <code>patterns</code> framework is <a href='http://github.com/jaked/patterns/blob/master/applications/alist/pa_alist.ml'>here</a>.)</p>Jake Donhamhttp://www.blogger.com/profile/04768087689799941690noreply@blogger.com1tag:blogger.com,1999:blog-1445545651031573301.post-17911200583895263172010-08-26T14:45:00.001-07:002010-08-26T14:45:59.626-07:00ocamljs 0.3<p>I am happy to announce version 0.3 of ocamljs. Ocamljs is a system for compiling OCaml to Javascript. It includes a Javascript back-end for the OCaml compiler, as well as several support libraries, such as bindings to the browser DOM. Ocamljs also works with <a href='http://jaked.github.com/orpc'>orpc</a> for RPC over HTTP, and <a href='http://jaked.github.com/froc'>froc</a> for functional reactive browser programming.</p>
<p>Changes since version 0.2 include:</p>
<ul>
<li>support for OCaml 3.11.x and 3.12.0</li>
<li>jQuery binding (contributed by Dave Benjamin)</li>
<li>full support for OCaml objects (interoperable with Javascript objects)</li>
<li>Lwt 2.x support</li>
<li>ocamllex and ocamlyacc support</li>
<li>better interoperability with Javascript</li>
<li>many small fixes and improvements</li>
</ul>
<p>Development of ocamljs has moved from Google Code to Github; see</p>
<ul>
<li>project page: <a href='http://github.com/jaked/ocamljs'>http://github.com/jaked/ocamljs</a></li>
<li>documentation: <a href='http://jaked.github.com/ocamljs'>http://jaked.github.com/ocamljs</a></li>
<li>downloads: <a href='http://github.com/jaked/ocamljs/downloads'>http://github.com/jaked/ocamljs/downloads</a></li>
</ul>
<b>Comparison to js_of_ocaml</b>
<p>Since I last did an <code>ocamljs</code> release, a new OCaml-to-Javascript system has arrived, <a href='http://ocsigen.org/js_of_ocaml/'><code>js_of_ocaml</code></a>. I want to say a little about how the two systems compare:</p>
<p><code>Ocamljs</code> is a back-end to the existing OCaml compiler; it translates the “lambda” intermediate language to Javascript. (This is also where the bytecode and native code back-ends connect to the common front-end.) <code>Js_of_ocaml</code> post-processes ordinary OCaml bytecode (compiled and linked with the ordinary OCaml bytecode compiler) into Javascript. With <code>ocamljs</code> you need a special installation of the compiler (and special support for <code>ocamlbuild</code> and <code>ocamlfind</code>), you need to recompile libraries, and you need the OCaml source to build it. With <code>js_of_ocaml</code> you don’t need any of this.</p>
<p>Since <code>ocamljs</code> recompiles libraries, it’s possible to special-case code for the Javascript build to take advantage of Javascript facilities. For example, <code>ocamljs</code> implements the <code>Buffer</code> module on top of Javascript arrays instead of strings, for better performance. Similarly, it implements <code>CamlinternalOO</code> to use Javascript method dispatch directly instead of layering OCaml method dispatch on top. <code>Js_of_ocaml</code> can’t do this (or at least it would be necessary to recognize the compiled bytecode and replace it with the special case).</p>
<p>Because <code>js_of_ocaml</code> works from bytecode, it can’t always know the type of values (at the bytecode level, <code>int</code>s, <code>bool</code>s, and <code>char</code>s all have the same representation, for example). This makes interoperating with native Javascript more difficult: you usually need conversion functions between the OCaml and Javascript representation of values when you call a Javascript function from OCaml. <code>Ocamljs</code> has more information to work with, and can represent OCaml bools as Javascript bools, for example, so you can usually call a Javascript function from OCaml without conversions.</p>
<p><code>Ocamljs</code> has a mixed representation of strings: literal strings and the result of <code>^</code>, <code>Buffer.contents</code>, and <code>Printf.sprintf</code> are all immutable Javascript strings; strings created with <code>String.create</code> are mutable strings implemented by Javascript arrays (with a <code>toString</code> method which returns the represented string). This is good for interoperability—you can usually pass a string directly to Javascript—but it doesn’t match regular OCaml’s semantics, and it can cause runtime failures (e.g. if you try to mutate an immutable string). <code>Js_of_ocaml</code> implements only mutable strings, so you need conversions when calling Javascript, but the semantics match regular OCaml.</p>
<p>With <code>ocamljs</code>, Javascript objects can be called from OCaml using the ordinary OCaml method-call syntax, and objects written in OCaml can be called using the ordinary Javascript syntax. With <code>js_of_ocaml</code>, a special syntax is needed to call Javascript objects, and OCaml objects can’t easily be called from Javascript. However, there is an advantage to having a special call syntax: with <code>ocamljs</code> it is not possible to partially apply calls to native Javascript methods, but this is not caught by the compiler, so there can be a runtime failure.</p>
<p><code>Ocamljs</code> supports inline Javascript, while <code>js_of_ocaml</code> does not. I think it might be possible for <code>js_of_ocaml</code> to do so using the same approach that <code>ocamljs</code> takes: use Camlp4 quotations to embed a syntax tree, then convert the syntax tree from its OCaml representation (as lambda code or bytecode) into Javascript. However, you would still need conversion functions between OCaml and Javascript values.</p>
<p>I haven’t compared the performance of the two systems. It seems like there must be a speed penalty to translating from bytecode compared to translating from lambda code. On the other hand, while <code>ocamljs</code> is very naive in its translation, <code>js_of_ocaml</code> makes several optimization passes. With many programs it doesn’t matter, since most of the time is spent in browser code. (For example, the <code>planet</code> example seems to run at the same speed in <a href='http://jaked.github.com/ocamljs/examples/dom/planet/'><code>ocamljs</code></a> and <a href='http://ocsigen.org/js_of_ocaml/planet/'><code>js_of_ocaml</code></a>.) It would be interesting to compare them on something computationally intensive like Andrej Bauer’s <a href='http://random-art.org/'>random-art.org</a>.</p>
<p><code>Js_of_ocaml</code> is more complete and careful in its implementation of OCaml (e.g. it supports <code>int64</code>s), and it generates much more compact code than <code>ocamljs</code>. I hope to close the gap in these areas, possibly by borrowing some code and good ideas from <code>js_of_ocaml</code>.</p>Jake Donhamhttp://www.blogger.com/profile/04768087689799941690noreply@blogger.com0tag:blogger.com,1999:blog-1445545651031573301.post-61340673862938512632010-08-20T17:50:00.000-07:002010-10-22T13:05:11.203-07:00Mixing monadic and direct-style code with delimited continuations<p>The <a href='http://ocsigen.org/lwt'>Lwt</a> library is a really nice way to write concurrent programs. A big downside, however, is that you can’t use direct-style libraries with it. Suppose we’re writing an XMPP server, and we want to parse XML as it arrives over a network connection, using Daniel Bünzli’s nice <a href='http://erratique.ch/software/xmlm'><code>xmlm</code></a> library. <code>Xmlm</code> can read from a <code>string</code>, or from a <code>Pervasives.in_channel</code>, or you can give it a function of type <code>(unit -> int)</code> to return the next character of input. But there is no way to have it read from an Lwt thread; that is, we can’t give it a function of type <code>(unit -> int Lwt.t)</code>, since it doesn’t know what do with an <code>Lwt.t</code>. To keep track of the parser state at the point the input blocks, the whole library would need to be rewritten in Lwt style (i.e. monadic style).</p>
<p>Now, Lwt does provide the <code>Lwt_preemptive</code> module, which gives you a way to spin off a preemptive thread (implemented as an ordinary OCaml thread) and wait for its result in the usual Lwt way with <code>bind</code>. This is useful, but has two drawbacks: preemptive threads are <em>preemptive</em>, so you’re back to traditional locking if you want to operate on shared data; and preemptive threads are <em>threads</em>, so they are much heavier than Lwt threads, and (continuing the XMPP hypothetical) it may not be feasible to use one per open connection.</p>
<b>Fibers</b>
<p>What we would really like is to be able spin off a cooperative, direct-style thread. The thread needs a way to block on Lwt threads, but when it blocks we need to be able to schedule another Lwt thread. As a cooperative thread it of course has exclusive access to the process state while it is running. A cooperative, direct-style thread is sometimes called a <em>coroutine</em> (although to me that word connotes a particular style of inter-thread communication as well, where values are yielded between coroutines), or a <em>fiber</em>.</p>
<p>Here’s an API for mixing Lwt threads with fibers:</p>
<div class='highlight'><pre><code class='ocaml'> <span class='k'>val</span> <span class='n'>start</span> <span class='o'>:</span> <span class='o'>(</span><span class='kt'>unit</span> <span class='o'>-></span> <span class='k'>'</span><span class='n'>a</span><span class='o'>)</span> <span class='o'>-></span> <span class='k'>'</span><span class='n'>a</span> <span class='nn'>Lwt</span><span class='p'>.</span><span class='n'>t</span>
<span class='k'>val</span> <span class='n'>await</span> <span class='o'>:</span> <span class='k'>'</span><span class='n'>a</span> <span class='nn'>Lwt</span><span class='p'>.</span><span class='n'>t</span> <span class='o'>-></span> <span class='k'>'</span><span class='n'>a</span>
</code></pre>
</div>
<p>The <code>start</code> function spins off a fiber, returning an Lwt thread which is woken with the result of the fiber once it completes. The <code>await</code> function (which may be called only from within a fiber) blocks on the result of an Lwt thread, allowing another Lwt thread to be scheduled while it is waiting.</p>
<p>With this API we could implement our XMPP server by calling <code>xmlm</code> from within a fiber, and passing it a function that <code>await</code>s the next character available on the network connection. But how do we implement it?</p>
<b>Delimited continuations</b>
<p><a href='http://okmij.org/ftp/'>Oleg Kiselyov</a>’s recent <a href='http://caml.inria.fr/pub/ml-archives/caml-list/2010/08/3567e58838e79cacc3441da7508d46fe.en.html'>announcement</a> of a native-code version of his <code>Delimcc</code> library for delimited continuations in OCaml reminded me of two things:</p>
<ol>
<li>I should find out what delimited continuations are.</li>
<li>They sound useful for implementing fibers.</li>
</ol>
<p>The paper describing the library, <a href='http://okmij.org/ftp/continuations/caml-shift.pdf'>Delimited Control in OCaml, Abstractly and Concretely</a>, has a pretty good overview of delimited continuations, and section 2 of <a href='http://citeseerx.ist.psu.edu/viewdoc/summary?doi=10.1.1.68.9352'>A Monadic Framework for Delimited Continuations</a> is helpful too.</p>
<p>The core API is small:</p>
<div class='highlight'><pre><code class='ocaml'> <span class='k'>type</span> <span class='k'>'</span><span class='n'>a</span> <span class='n'>prompt</span>
<span class='k'>type</span> <span class='o'>(</span><span class='k'>'</span><span class='n'>a</span><span class='o'>,</span><span class='k'>'</span><span class='n'>b</span><span class='o'>)</span> <span class='n'>subcont</span>
<span class='k'>val</span> <span class='n'>new_prompt</span> <span class='o'>:</span> <span class='kt'>unit</span> <span class='o'>-></span> <span class='k'>'</span><span class='n'>a</span> <span class='n'>prompt</span>
<span class='k'>val</span> <span class='n'>push_prompt</span> <span class='o'>:</span> <span class='k'>'</span><span class='n'>a</span> <span class='n'>prompt</span> <span class='o'>-></span> <span class='o'>(</span><span class='kt'>unit</span> <span class='o'>-></span> <span class='k'>'</span><span class='n'>a</span><span class='o'>)</span> <span class='o'>-></span> <span class='k'>'</span><span class='n'>a</span>
<span class='k'>val</span> <span class='n'>take_subcont</span> <span class='o'>:</span>
<span class='k'>'</span><span class='n'>b</span> <span class='n'>prompt</span> <span class='o'>-></span> <span class='o'>((</span><span class='k'>'</span><span class='n'>a</span><span class='o'>,</span><span class='k'>'</span><span class='n'>b</span><span class='o'>)</span> <span class='n'>subcont</span> <span class='o'>-></span> <span class='kt'>unit</span> <span class='o'>-></span> <span class='k'>'</span><span class='n'>b</span><span class='o'>)</span> <span class='o'>-></span> <span class='k'>'</span><span class='n'>a</span>
<span class='k'>val</span> <span class='n'>push_subcont</span> <span class='o'>:</span> <span class='o'>(</span><span class='k'>'</span><span class='n'>a</span><span class='o'>,</span><span class='k'>'</span><span class='n'>b</span><span class='o'>)</span> <span class='n'>subcont</span> <span class='o'>-></span> <span class='o'>(</span><span class='kt'>unit</span> <span class='o'>-></span> <span class='k'>'</span><span class='n'>a</span><span class='o'>)</span> <span class='o'>-></span> <span class='k'>'</span><span class='n'>b</span>
</code></pre>
</div>
<p>I find it easiest to think about these functions as operations on the stack. A prompt is an identifier used to mark a point on the stack (the stack can be marked more than once with the same prompt). The function <code>new_prompt</code> makes a new prompt which is not equal to any other prompt.</p>
<p>The call <code>push_prompt p f</code> marks the stack with <code>p</code> then runs <code>f</code>, so the stack, growing to the right, looks like</p>
<pre>
ABCDpEFGH
</pre>
<p>where <code>ABCD</code> are stack frames in the continuation of the call to <code>push_prompt</code>, and <code>EFGH</code> are frames created while running <code>f</code>. If <code>f</code> returns normally (that is, without calling <code>take_subcont</code>) then its return value is returned by <code>push_prompt</code>, and we are back to the original stack <code>ABCD</code>.</p>
<p>If <code>take_subcont p g</code> is called while running <code>f</code>, the stack fragment <code>EFGH</code> is packaged up as an <code>('a,'b) subcont</code> and passed to <code>g</code>. You can think of an <code>('a,'b) subcont</code> as a function of type <code>'a -> 'b</code>, where <code>'a</code> is the return type of the call to <code>take_subcont</code> and <code>'b</code> is the return type of the call to <code>push_prompt</code>. <code>Take_subcont</code> removes the fragment <code>pEFGH</code> from the stack, and there are some new frames <code>IJKL</code> from running <code>g</code>, so we have</p>
<pre>
ABCDIJKL
</pre>
<p>Now <code>g</code> can make use of the passed-in <code>subcont</code> using <code>push_subcont</code>. (Thinking of a <code>subcont</code> as a function, <code>push_subcont</code> is just a weird function application operator, which takes the argument as a thunk). Then the stack becomes</p>
<pre>
ABCDIJKLEFGH
</pre>
<p>Of course <code>g</code> can call the <code>subcont</code> as many times as you like.</p>
<p>A common pattern is to re-mark the stack with <code>push_prompt</code> before calling <code>push_subcont</code> (so <code>take_subcont</code> may be called again). There is an optimized version of this combination called <code>push_delim_subcont</code>, which produces the stack</p>
<pre>
ABCDIJKLpEFGH
</pre>
<p>The idea that a <code>subcont</code> is a kind of function is realized by <code>shift0</code>, which is like <code>take_subcont</code> except that instead of passing a <code>subcont</code> to <code>g</code> it passes an ordinary function. The passed function just wraps a call to <code>push_delim_subcont</code>. (It is <code>push_delim_subcont</code> rather than <code>push_subcont</code> for historical reasons I think—see the Monadic Framework paper for a comparison of various delimited continuation primitives.)</p>
<b>Implementing fibers</b>
<p>To implement fibers, we want <code>start f</code> to mark the stack, then run <code>f</code>; and <code>await t</code> to unwind the stack back to the mark, wait for <code>t</code> to complete, then restore the stack. Here is <code>start</code>:</p>
<div class='highlight'><pre><code class='ocaml'> <span class='k'>let</span> <span class='n'>active_prompt</span> <span class='o'>=</span> <span class='n'>ref</span> <span class='nc'>None</span>
<span class='k'>let</span> <span class='n'>start</span> <span class='n'>f</span> <span class='o'>=</span>
<span class='k'>let</span> <span class='n'>t</span><span class='o'>,</span> <span class='n'>u</span> <span class='o'>=</span> <span class='nn'>Lwt</span><span class='p'>.</span><span class='n'>wait</span> <span class='bp'>()</span> <span class='k'>in</span>
<span class='k'>let</span> <span class='n'>p</span> <span class='o'>=</span> <span class='nn'>Delimcc</span><span class='p'>.</span><span class='n'>new_prompt</span> <span class='bp'>()</span> <span class='k'>in</span>
<span class='n'>active_prompt</span> <span class='o'>:=</span> <span class='nc'>Some</span> <span class='n'>p</span><span class='o'>;</span>
<span class='nn'>Delimcc</span><span class='p'>.</span><span class='n'>push_prompt</span> <span class='n'>p</span> <span class='k'>begin</span> <span class='k'>fun</span> <span class='bp'>()</span> <span class='o'>-></span>
<span class='k'>let</span> <span class='n'>r</span> <span class='o'>=</span>
<span class='k'>try</span> <span class='nn'>Lwt</span><span class='p'>.</span><span class='nc'>Return</span> <span class='o'>(</span><span class='n'>f</span> <span class='bp'>()</span><span class='o'>)</span>
<span class='k'>with</span> <span class='n'>e</span> <span class='o'>-></span> <span class='nn'>Lwt</span><span class='p'>.</span><span class='nc'>Fail</span> <span class='n'>e</span> <span class='k'>in</span>
<span class='n'>active_prompt</span> <span class='o'>:=</span> <span class='nc'>None</span><span class='o'>;</span>
<span class='k'>match</span> <span class='n'>r</span> <span class='k'>with</span>
<span class='o'>|</span> <span class='nn'>Lwt</span><span class='p'>.</span><span class='nc'>Return</span> <span class='n'>v</span> <span class='o'>-></span> <span class='nn'>Lwt</span><span class='p'>.</span><span class='n'>wakeup</span> <span class='n'>u</span> <span class='n'>v</span>
<span class='o'>|</span> <span class='nn'>Lwt</span><span class='p'>.</span><span class='nc'>Fail</span> <span class='n'>e</span> <span class='o'>-></span> <span class='nn'>Lwt</span><span class='p'>.</span><span class='n'>wakeup_exn</span> <span class='n'>u</span> <span class='n'>e</span>
<span class='o'>|</span> <span class='nn'>Lwt</span><span class='p'>.</span><span class='nc'>Sleep</span> <span class='o'>-></span> <span class='k'>assert</span> <span class='bp'>false</span>
<span class='k'>end</span><span class='o'>;</span>
<span class='n'>t</span>
</code></pre>
</div>
<p>We make a sleeping Lwt thread, and store a new prompt in a global (this is OK because we won’t yield control to another Lwt thread before using it; of course this is not safe with OCaml threads). Then we mark the stack with <code>push_prompt</code> and run the fiber. (The <code>let r = ... match r with ...</code> is to avoid calling <code>Lwt.wakeup{,_exn}</code> in the scope of the <code>try</code>; we use <code>Lwt.state</code> as a handy type to store either a result or an exception.) If the fiber completes without calling <code>await</code> then all we do is wake up the Lwt thread with the returned value or exception.</p>
<p>Here is <code>await</code>:</p>
<div class='highlight'><pre><code class='ocaml'> <span class='k'>let</span> <span class='n'>await</span> <span class='n'>t</span> <span class='o'>=</span>
<span class='k'>let</span> <span class='n'>p</span> <span class='o'>=</span>
<span class='k'>match</span> <span class='o'>!</span><span class='n'>active_prompt</span> <span class='k'>with</span>
<span class='o'>|</span> <span class='nc'>None</span> <span class='o'>-></span> <span class='n'>failwith</span> <span class='s2'>"await called outside start"</span>
<span class='o'>|</span> <span class='nc'>Some</span> <span class='n'>p</span> <span class='o'>-></span> <span class='n'>p</span> <span class='k'>in</span>
<span class='n'>active_prompt</span> <span class='o'>:=</span> <span class='nc'>None</span><span class='o'>;</span>
<span class='k'>match</span> <span class='nn'>Lwt</span><span class='p'>.</span><span class='n'>poll</span> <span class='n'>t</span> <span class='k'>with</span>
<span class='o'>|</span> <span class='nc'>Some</span> <span class='n'>v</span> <span class='o'>-></span> <span class='n'>v</span>
<span class='o'>|</span> <span class='nc'>None</span> <span class='o'>-></span>
<span class='nn'>Delimcc</span><span class='p'>.</span><span class='n'>shift0</span> <span class='n'>p</span> <span class='k'>begin</span> <span class='k'>fun</span> <span class='n'>k</span> <span class='o'>-></span>
<span class='k'>let</span> <span class='n'>ready</span> <span class='o'>_</span> <span class='o'>=</span>
<span class='n'>active_prompt</span> <span class='o'>:=</span> <span class='nc'>Some</span> <span class='n'>p</span><span class='o'>;</span>
<span class='n'>k</span> <span class='bp'>()</span><span class='o'>;</span>
<span class='nn'>Lwt</span><span class='p'>.</span><span class='n'>return</span> <span class='bp'>()</span> <span class='k'>in</span>
<span class='n'>ignore</span> <span class='o'>(</span><span class='nn'>Lwt</span><span class='p'>.</span><span class='n'>try_bind</span> <span class='o'>(</span><span class='k'>fun</span> <span class='bp'>()</span> <span class='o'>-></span> <span class='n'>t</span><span class='o'>)</span> <span class='n'>ready</span> <span class='n'>ready</span><span class='o'>)</span>
<span class='k'>end</span><span class='o'>;</span>
<span class='k'>match</span> <span class='nn'>Lwt</span><span class='p'>.</span><span class='n'>poll</span> <span class='n'>t</span> <span class='k'>with</span>
<span class='o'>|</span> <span class='nc'>Some</span> <span class='n'>v</span> <span class='o'>-></span> <span class='n'>v</span>
<span class='o'>|</span> <span class='nc'>None</span> <span class='o'>-></span> <span class='k'>assert</span> <span class='bp'>false</span>
</code></pre>
</div>
<p>We first check to be sure that we are in the scope of <code>start</code>, and that <code>t</code> isn’t already completed (in which case we just return its result). If we actually need to wait for <code>t</code>, we call <code>shift0</code>, which capture the stack fragment back to the <code>push_prompt</code> call in <code>start</code> (this continuation includes the subsequent <code>match Lwt.poll t</code> and everything after the call to <code>await</code>), then <code>try_bind</code> so we can restore the stack fragment when <code>t</code> completes (whether by success or failure). When <code>t</code> completes, the <code>ready</code> function restores the global <code>active_prompt</code>, in case the fiber calls <code>await</code> again, then restores the stack by calling <code>k</code> (recall that this also re-marks the stack with <code>p</code>, which is needed if the fiber calls <code>await</code> again).</p>
<p>It’s pretty difficult to follow what’s going on here, so let’s try it with stacks. After calling <code>start</code> we have</p>
<pre>
ABCDpEFGH
</pre>
<p>where <code>ABCD</code> is the continuation of <code>push_prompt</code> in <code>start</code> (just the return of <code>t</code>) and <code>EFGH</code> are frames created by the thunk passed to <code>start</code>. Now, a call to <code>await</code> (on an uncompleted thread) calls <code>shift0</code>, which packs up <code>EFGH</code> as <code>k</code> and unwinds the stack to <code>p</code>. The function passed to <code>shift0</code> stores <code>k</code> in <code>ready</code> but doesn’t call it, and control returns to <code>start</code> (since the stack has been unwound).</p>
<p>The program continues normally until <code>t</code> completes. Now control is in <code>Lwt.run_waiters</code> running threads that were waiting on <code>t</code>; one of them is our <code>ready</code> function. When it is called, the stack is re-marked and <code>EFGH</code> is restored, so we have</p>
<pre>
QRSTpEFGH
</pre>
<p>where <code>QRST</code> is wherever we happen to be in the main program, ending in <code>Lwt.run_waiters</code>. Now, <code>EFGH</code> ends with the second call to <code>match Lwt.poll</code> in <code>await</code>, which returns the value of <code>t</code> and continues the thunk passed to <code>start</code>. The stack is now marked with <code>p</code> inside <code>Lwt.run_waiters</code>, so when <code>await</code> is called again control returns there.</p>
<b>Events vs. threads</b>
<p>We have seen that we can use fibers to write Lwt threads in direct style. Should we abandon Lwt’s monadic style entirely, and use Lwt only for its event handling?</p>
<p>First, how does each style perform? Every time a fiber blocks and resumes, we have to copy, unwind, and restore its entire stack. With Lwt threads, the “stack” is a bunch of linked closures in the heap, so we don’t need to do anything to block or resume. On the other hand, building and garbage-collecting the closures is more expensive than pushing and popping the stack. We can imagine that which style performs better depends on the thread: if it blocks infrequently enough, the amortized cost of copying and restoring the stack might be lower than the cost of building and garbage-collecting the closures. (We can also imagine that a different implementation of delimited continuations might change this tradeoff.)</p>
<p>Second, how does the code look? The paper <a href='http://www.stanford.edu/class/cs240/readings/usenix2002-fibers.pdf'>Cooperative Task Management without Manual Stack Management</a> considers this question in the context of the “events vs. threads” debate. Many of its points lose their force when translated to OCaml and Lwt—closures, the <code>>>=</code> operator, and Lwt’s syntax extension go a long way toward making Lwt code look like direct style—but some are still germane. In favor of fibers is that existing direct-style code need not be rewritten to work with Lwt (what motivated us in the first place). In favor of monadic style is that the type of a function reflects the possibility that it might block, yield control to another thread, and disturb state invariants.</p>
<b>Direct-style FRP</b>
<p>We could apply this idea, of replacing monadic style with direct style using delimited continuations, to other monads—in particular to the <a href='http://github.com/jaked/froc'><code>froc</code></a> library for functional reactive programming. (The Scala.React FRP library also uses delimited continuations to implement direct style; see <a href='http://lamp.epfl.ch/~imaier/pub/DeprecatingObserversTR2010.pdf'>Deprecating the Observer Pattern</a> for details.)</p>
<p>Here’s the API:</p>
<div class='highlight'><pre><code class='ocaml'> <span class='k'>val</span> <span class='n'>direct</span> <span class='o'>:</span> <span class='o'>(</span><span class='kt'>unit</span> <span class='o'>-></span> <span class='k'>'</span><span class='n'>a</span><span class='o'>)</span> <span class='o'>-></span> <span class='k'>'</span><span class='n'>a</span> <span class='nn'>Froc</span><span class='p'>.</span><span class='n'>behavior</span>
<span class='k'>val</span> <span class='n'>read</span> <span class='o'>:</span> <span class='k'>'</span><span class='n'>a</span> <span class='nn'>Froc</span><span class='p'>.</span><span class='n'>behavior</span> <span class='o'>-></span> <span class='k'>'</span><span class='n'>a</span>
</code></pre>
</div>
<p>Not surprisingly, it’s just the same as for Lwt, but with a different monad and different names (I don’t know if <code>direct</code> is quite right but it is better than <code>start</code>). There is already a function <code>Froc.sample</code> with the same type as <code>read</code>, but it has a different meaning: <code>sample</code> takes a snapshot of a behavior but creates no dependency on it.</p>
<p>The implementation is very similar as well:</p>
<div class='highlight'><pre><code class='ocaml'> <span class='k'>let</span> <span class='n'>active_prompt</span> <span class='o'>=</span> <span class='n'>ref</span> <span class='nc'>None</span>
<span class='k'>let</span> <span class='n'>direct</span> <span class='n'>f</span> <span class='o'>=</span>
<span class='k'>let</span> <span class='n'>t</span><span class='o'>,</span> <span class='n'>u</span> <span class='o'>=</span> <span class='nn'>Froc_ddg</span><span class='p'>.</span><span class='n'>make_changeable</span> <span class='bp'>()</span> <span class='k'>in</span>
<span class='k'>let</span> <span class='n'>p</span> <span class='o'>=</span> <span class='nn'>Delimcc</span><span class='p'>.</span><span class='n'>new_prompt</span> <span class='bp'>()</span> <span class='k'>in</span>
<span class='n'>active_prompt</span> <span class='o'>:=</span> <span class='nc'>Some</span> <span class='n'>p</span><span class='o'>;</span>
<span class='nn'>Delimcc</span><span class='p'>.</span><span class='n'>push_prompt</span> <span class='n'>p</span> <span class='k'>begin</span> <span class='k'>fun</span> <span class='bp'>()</span> <span class='o'>-></span>
<span class='k'>let</span> <span class='n'>r</span> <span class='o'>=</span>
<span class='k'>try</span> <span class='nn'>Froc_ddg</span><span class='p'>.</span><span class='nc'>Value</span> <span class='o'>(</span><span class='n'>f</span> <span class='bp'>()</span><span class='o'>)</span>
<span class='k'>with</span> <span class='n'>e</span> <span class='o'>-></span> <span class='nn'>Froc_ddg</span><span class='p'>.</span><span class='nc'>Fail</span> <span class='n'>e</span> <span class='k'>in</span>
<span class='n'>active_prompt</span> <span class='o'>:=</span> <span class='nc'>None</span><span class='o'>;</span>
<span class='nn'>Froc_ddg</span><span class='p'>.</span><span class='n'>write_result</span> <span class='n'>u</span> <span class='n'>r</span>
<span class='k'>end</span><span class='o'>;</span>
<span class='o'>(</span><span class='nn'>Obj</span><span class='p'>.</span><span class='n'>magic</span> <span class='n'>t</span> <span class='o'>:</span> <span class='o'>_</span> <span class='nn'>Froc</span><span class='p'>.</span><span class='n'>behavior</span><span class='o'>)</span>
</code></pre>
</div>
<p>This is essentially the same code as <code>start</code>, modulo the change of monad. However, some of the functions we need aren’t exported from <code>Froc</code>, so we need to use the underlying <code>Froc_ddg</code> module and magic the result at the end. <code>Froc_ddg.make_changeable</code> is the equivalent of <code>Lwt.wait</code>: it returns an “uninitialized” monadic value along with a writer for that value. We use <code>Froc_ddg.result</code> instead of <code>Lwt.state</code> to store a value or exception, and <code>Froc_ddg.write_result</code> instead of the pattern match and <code>Lwt.wakeup{,_exn}</code>.</p>
<div class='highlight'><pre><code class='ocaml'>
<span class='k'>let</span> <span class='n'>read</span> <span class='n'>t</span> <span class='o'>=</span>
<span class='k'>let</span> <span class='n'>p</span> <span class='o'>=</span>
<span class='k'>match</span> <span class='o'>!</span><span class='n'>active_prompt</span> <span class='k'>with</span>
<span class='o'>|</span> <span class='nc'>None</span> <span class='o'>-></span> <span class='n'>failwith</span> <span class='s2'>"read called outside direct"</span>
<span class='o'>|</span> <span class='nc'>Some</span> <span class='n'>p</span> <span class='o'>-></span> <span class='n'>p</span> <span class='k'>in</span>
<span class='n'>active_prompt</span> <span class='o'>:=</span> <span class='nc'>None</span><span class='o'>;</span>
<span class='nn'>Delimcc</span><span class='p'>.</span><span class='n'>shift0</span> <span class='n'>p</span> <span class='k'>begin</span> <span class='k'>fun</span> <span class='n'>k</span> <span class='o'>-></span>
<span class='nn'>Froc</span><span class='p'>.</span><span class='n'>notify_result_b</span> <span class='n'>t</span> <span class='k'>begin</span> <span class='k'>fun</span> <span class='o'>_</span> <span class='o'>-></span>
<span class='n'>active_prompt</span> <span class='o'>:=</span> <span class='nc'>Some</span> <span class='n'>p</span><span class='o'>;</span>
<span class='n'>k</span> <span class='bp'>()</span>
<span class='k'>end</span>
<span class='k'>end</span><span class='o'>;</span>
<span class='nn'>Froc</span><span class='p'>.</span><span class='n'>sample</span> <span class='n'>t</span>
</code></pre>
</div>
<p>And this is essentially the same code as <code>await</code>. A <code>Froc.behavior</code> always has a value, so we don’t poll it as we did with <code>Lwt.t</code>, but go straight to <code>shift0</code>. We have <code>Froc.try_bind</code> but it’s a little more compact to use use <code>notify_result_b</code>, which passes a <code>result</code>.</p>
<b>Monadic reflection</b>
<p>The similarity between these implementations suggests that we could use the same code to get a direct style version of any monad; we only need a way to create an uninitialized monadic value, then set it. The call to <code>Lwt.poll</code> in <code>await</code> is an optimization which we would have to forgo. (In both these examples we have a monad with failure, and <code>try_bind</code>, but we could do without it.)</p>
<p>A little googling turns up Andrzej Filinski’s paper <a href='http://www.diku.dk/hjemmesider/ansatte/andrzej/papers/RM-abstract.html'>Representing Monads</a>, which reaches the same conclusion, with a lot more rigor. In that work <code>start</code>/<code>direct</code> are called <code>reify</code>, and <code>await</code>/<code>read</code> are called <code>reflect</code>. <code>Reflect</code> is close to the implementations above, but in <code>reify</code> the paper marks the stack inside a function passed to <code>bind</code> rather than creating an uninitialized monadic value and later setting it.</p>
<p>This makes sense—inside <code>bind</code> an uninitialized monadic value is created, then set from the result of the function passed to <code>bind</code>. So we are partially duplicating <code>bind</code> in the code above. If we mark the stack in the right place we should be able to use <code>bind</code> directly. It is hard to see how to make the details work out, however, since <code>Lwt.bind</code> and <code>Froc.bind</code> each have some cases where uninitialized values are not created.</p>
<p>(You can find the complete code for Lwt fibers <a href='http://github.com/jaked/lwt-equeue/tree/master/src/lwt-fiber'>here</a> and direct-style <code>froc</code> <a href='http://github.com/jaked/froc/tree/master/src/froc-direct'>here</a>.)</p>
<p>(revised 10/22)</p>Jake Donhamhttp://www.blogger.com/profile/04768087689799941690noreply@blogger.com1tag:blogger.com,1999:blog-1445545651031573301.post-21400118438580862932010-08-13T12:16:00.000-07:002010-08-13T12:16:14.583-07:00Reading Camlp4, part 10: custom lexers<p>As a final modification to our running JSON quotation example, I want to repair a problem noted in the <a href='/2010/08/reading-camlp4-part-8-implementing.html'>first post</a>—that the default lexer does not match the <a href='http://www.ietf.org/rfc/rfc4627.txt'>JSON spec</a>—and in doing so demonstrate the use of custom lexers with Camlp4 grammars. We’ll parse UTF8-encoded Javascript using the <a href='http://www.cduce.org/download.html#side'>ulex</a> library.</p>
<p>To use a custom lexer, we need to pass a module matching the <code>Lexer</code> signature (in <code>camlp4/Camlp4/Sig.ml</code>) to <code>Camlp4.PreCast.MakeGram</code>. (Recall that we get back an empty grammar which we then extend with parser entries. ) Let’s look at the signature and its subsignatures, and our implementation of each:</p>
<b>Error</b><div class='highlight'><pre><code class='ocaml'> <span class='k'>module</span> <span class='k'>type</span> <span class='nc'>Error</span> <span class='o'>=</span> <span class='k'>sig</span>
<span class='k'>type</span> <span class='n'>t</span>
<span class='k'>exception</span> <span class='nc'>E</span> <span class='k'>of</span> <span class='n'>t</span>
<span class='k'>val</span> <span class='n'>to_string</span> <span class='o'>:</span> <span class='n'>t</span> <span class='o'>-></span> <span class='kt'>string</span>
<span class='k'>val</span> <span class='n'>print</span> <span class='o'>:</span> <span class='nn'>Format</span><span class='p'>.</span><span class='n'>formatter</span> <span class='o'>-></span> <span class='n'>t</span> <span class='o'>-></span> <span class='kt'>unit</span>
<span class='k'>end</span>
</code></pre>
</div>
<p>First we have a module for packaging up an exception so it can be handled generically (in particular it may be registered with <code>Camlp4.ErrorHandler</code> for common printing and handling). We have simple exception needs so we give a simple implementation:</p>
<div class='highlight'><pre><code class='ocaml'> <span class='k'>module</span> <span class='nc'>Error</span> <span class='o'>=</span>
<span class='k'>struct</span>
<span class='k'>type</span> <span class='n'>t</span> <span class='o'>=</span> <span class='kt'>string</span>
<span class='k'>exception</span> <span class='nc'>E</span> <span class='k'>of</span> <span class='kt'>string</span>
<span class='k'>let</span> <span class='n'>print</span> <span class='o'>=</span> <span class='nn'>Format</span><span class='p'>.</span><span class='n'>pp_print_string</span>
<span class='k'>let</span> <span class='n'>to_string</span> <span class='n'>x</span> <span class='o'>=</span> <span class='n'>x</span>
<span class='k'>end</span>
<span class='k'>let</span> <span class='o'>_</span> <span class='o'>=</span> <span class='k'>let</span> <span class='k'>module</span> <span class='nc'>M</span> <span class='o'>=</span> <span class='nn'>Camlp4</span><span class='p'>.</span><span class='nn'>ErrorHandler</span><span class='p'>.</span><span class='nc'>Register</span><span class='o'>(</span><span class='nc'>Error</span><span class='o'>)</span> <span class='k'>in</span> <span class='bp'>()</span>
</code></pre>
</div><b>Token</b>
<p>Next we have a module defining the tokens our lexer supports:</p>
<div class='highlight'><pre><code class='ocaml'> <span class='k'>module</span> <span class='k'>type</span> <span class='nc'>Token</span> <span class='o'>=</span> <span class='k'>sig</span>
<span class='k'>module</span> <span class='nc'>Loc</span> <span class='o'>:</span> <span class='nc'>Loc</span>
<span class='k'>type</span> <span class='n'>t</span>
<span class='k'>val</span> <span class='n'>to_string</span> <span class='o'>:</span> <span class='n'>t</span> <span class='o'>-></span> <span class='kt'>string</span>
<span class='k'>val</span> <span class='n'>print</span> <span class='o'>:</span> <span class='nn'>Format</span><span class='p'>.</span><span class='n'>formatter</span> <span class='o'>-></span> <span class='n'>t</span> <span class='o'>-></span> <span class='kt'>unit</span>
<span class='k'>val</span> <span class='n'>match_keyword</span> <span class='o'>:</span> <span class='kt'>string</span> <span class='o'>-></span> <span class='n'>t</span> <span class='o'>-></span> <span class='kt'>bool</span>
<span class='k'>val</span> <span class='n'>extract_string</span> <span class='o'>:</span> <span class='n'>t</span> <span class='o'>-></span> <span class='kt'>string</span>
<span class='k'>module</span> <span class='nc'>Filter</span> <span class='o'>:</span> <span class='o'>...</span> <span class='c'>(* see below *)</span>
<span class='k'>module</span> <span class='nc'>Error</span> <span class='o'>:</span> <span class='nc'>Error</span>
<span class='k'>end</span>
</code></pre>
</div>
<p>The type <code>t</code> represents a token. This can be anything we like (in particular it does not need to be a variant with arms <code>KEYWORD</code>, <code>EOI</code>, etc. although that is the conventional representation), so long as we provide the specified functions to convert it to a string, print it to a formatter, determine if it matches a string keyword (recall that we can use literal strings in grammars; this function is called to see if the next token matches a literal string), and extract a string representation of it (called when you bind a variable to a token in a grammar—e.g. <code>n = NUMBER</code>). Here’s our implementation:</p>
<div class='highlight'><pre><code class='ocaml'> <span class='k'>type</span> <span class='n'>token</span> <span class='o'>=</span>
<span class='o'>|</span> <span class='nc'>KEYWORD</span> <span class='k'>of</span> <span class='kt'>string</span>
<span class='o'>|</span> <span class='nc'>NUMBER</span> <span class='k'>of</span> <span class='kt'>string</span>
<span class='o'>|</span> <span class='nc'>STRING</span> <span class='k'>of</span> <span class='kt'>string</span>
<span class='o'>|</span> <span class='nc'>ANTIQUOT</span> <span class='k'>of</span> <span class='kt'>string</span> <span class='o'>*</span> <span class='kt'>string</span>
<span class='o'>|</span> <span class='nc'>EOI</span>
<span class='k'>module</span> <span class='nc'>Token</span> <span class='o'>=</span>
<span class='k'>struct</span>
<span class='k'>type</span> <span class='n'>t</span> <span class='o'>=</span> <span class='n'>token</span>
<span class='k'>let</span> <span class='n'>to_string</span> <span class='n'>t</span> <span class='o'>=</span>
<span class='k'>let</span> <span class='n'>sf</span> <span class='o'>=</span> <span class='nn'>Printf</span><span class='p'>.</span><span class='n'>sprintf</span> <span class='k'>in</span>
<span class='k'>match</span> <span class='n'>t</span> <span class='k'>with</span>
<span class='o'>|</span> <span class='nc'>KEYWORD</span> <span class='n'>s</span> <span class='o'>-></span> <span class='n'>sf</span> <span class='s2'>"KEYWORD %S"</span> <span class='n'>s</span>
<span class='o'>|</span> <span class='nc'>NUMBER</span> <span class='n'>s</span> <span class='o'>-></span> <span class='n'>sf</span> <span class='s2'>"NUMBER %s"</span> <span class='n'>s</span>
<span class='o'>|</span> <span class='nc'>STRING</span> <span class='n'>s</span> <span class='o'>-></span> <span class='n'>sf</span> <span class='s2'>"STRING </span><span class='se'>\"</span><span class='s2'>%s</span><span class='se'>\"</span><span class='s2'>"</span> <span class='n'>s</span>
<span class='o'>|</span> <span class='nc'>ANTIQUOT</span> <span class='o'>(</span><span class='n'>n</span><span class='o'>,</span> <span class='n'>s</span><span class='o'>)</span> <span class='o'>-></span> <span class='n'>sf</span> <span class='s2'>"ANTIQUOT %s: %S"</span> <span class='n'>n</span> <span class='n'>s</span>
<span class='o'>|</span> <span class='nc'>EOI</span> <span class='o'>-></span> <span class='n'>sf</span> <span class='s2'>"EOI"</span>
<span class='k'>let</span> <span class='n'>print</span> <span class='n'>ppf</span> <span class='n'>x</span> <span class='o'>=</span> <span class='nn'>Format</span><span class='p'>.</span><span class='n'>pp_print_string</span> <span class='n'>ppf</span> <span class='o'>(</span><span class='n'>to_string</span> <span class='n'>x</span><span class='o'>)</span>
<span class='k'>let</span> <span class='n'>match_keyword</span> <span class='n'>kwd</span> <span class='o'>=</span>
<span class='k'>function</span>
<span class='o'>|</span> <span class='nc'>KEYWORD</span> <span class='n'>kwd'</span> <span class='k'>when</span> <span class='n'>kwd</span> <span class='o'>=</span> <span class='n'>kwd'</span> <span class='o'>-></span> <span class='bp'>true</span>
<span class='o'>|</span> <span class='o'>_</span> <span class='o'>-></span> <span class='bp'>false</span>
<span class='k'>let</span> <span class='n'>extract_string</span> <span class='o'>=</span>
<span class='k'>function</span>
<span class='o'>|</span> <span class='nc'>KEYWORD</span> <span class='n'>s</span> <span class='o'>|</span> <span class='nc'>NUMBER</span> <span class='n'>s</span> <span class='o'>|</span> <span class='nc'>STRING</span> <span class='n'>s</span> <span class='o'>-></span> <span class='n'>s</span>
<span class='o'>|</span> <span class='n'>tok</span> <span class='o'>-></span>
<span class='n'>invalid_arg</span>
<span class='o'>(</span><span class='s2'>"Cannot extract a string from this token: "</span> <span class='o'>^</span>
<span class='n'>to_string</span> <span class='n'>tok</span><span class='o'>)</span>
<span class='k'>module</span> <span class='nc'>Loc</span> <span class='o'>=</span> <span class='nn'>Camlp4</span><span class='p'>.</span><span class='nn'>PreCast</span><span class='p'>.</span><span class='nc'>Loc</span>
<span class='k'>module</span> <span class='nc'>Error</span> <span class='o'>=</span> <span class='nc'>Error</span>
<span class='k'>module</span> <span class='nc'>Filter</span> <span class='o'>=</span> <span class='o'>...</span> <span class='c'>(* see below *)</span>
<span class='k'>end</span>
</code></pre>
</div>
<p>Not much to it. <code>KEYWORD</code> covers <code>true</code>, <code>false</code>, <code>null</code>, and punctuation; <code>NUMBER</code> and <code>STRING</code> are JSON numbers and strings; as we saw <a href='/2010/08/reading-camlp4-part-9-implementing.html'>last time</a> antiquotations are returned in <code>ANTIQUOT</code>; finally we signal the end of the input with <code>EOI</code>.</p>
<b>Filter</b><div class='highlight'><pre><code class='ocaml'> <span class='k'>module</span> <span class='nc'>Filter</span> <span class='o'>:</span> <span class='k'>sig</span>
<span class='k'>type</span> <span class='n'>token_filter</span> <span class='o'>=</span>
<span class='o'>(</span><span class='n'>t</span> <span class='o'>*</span> <span class='nn'>Loc</span><span class='p'>.</span><span class='n'>t</span><span class='o'>)</span> <span class='nn'>Stream</span><span class='p'>.</span><span class='n'>t</span> <span class='o'>-></span> <span class='o'>(</span><span class='n'>t</span> <span class='o'>*</span> <span class='nn'>Loc</span><span class='p'>.</span><span class='n'>t</span><span class='o'>)</span> <span class='nn'>Stream</span><span class='p'>.</span><span class='n'>t</span>
<span class='k'>type</span> <span class='n'>t</span>
<span class='k'>val</span> <span class='n'>mk</span> <span class='o'>:</span> <span class='o'>(</span><span class='kt'>string</span> <span class='o'>-></span> <span class='kt'>bool</span><span class='o'>)</span> <span class='o'>-></span> <span class='n'>t</span>
<span class='k'>val</span> <span class='n'>define_filter</span> <span class='o'>:</span> <span class='n'>t</span> <span class='o'>-></span> <span class='o'>(</span><span class='n'>token_filter</span> <span class='o'>-></span> <span class='n'>token_filter</span><span class='o'>)</span> <span class='o'>-></span> <span class='kt'>unit</span>
<span class='k'>val</span> <span class='n'>filter</span> <span class='o'>:</span> <span class='n'>t</span> <span class='o'>-></span> <span class='n'>token_filter</span>
<span class='k'>val</span> <span class='n'>keyword_added</span> <span class='o'>:</span> <span class='n'>t</span> <span class='o'>-></span> <span class='kt'>string</span> <span class='o'>-></span> <span class='kt'>bool</span> <span class='o'>-></span> <span class='kt'>unit</span>
<span class='k'>val</span> <span class='n'>keyword_removed</span> <span class='o'>:</span> <span class='n'>t</span> <span class='o'>-></span> <span class='kt'>string</span> <span class='o'>-></span> <span class='kt'>unit</span>
<span class='k'>end</span><span class='o'>;</span>
</code></pre>
</div>
<p>The <code>Filter</code> module provides filters over token streams. We don’t have a need for it in the JSON example, but it’s interesting to see how it is implemented in the default lexer and used in the OCaml parser. The argument to <code>mk</code> is a function indicating whether a string should be treated as a keyword (i.e. the literal string is used in the grammar), and the default lexer uses it to filter the token stream to convert identifiers into keywords. If we wanted the JSON parser to be extensible, we would need to take this into account; instead we’ll just stub out the functions:</p>
<div class='highlight'><pre><code class='ocaml'> <span class='k'>module</span> <span class='nc'>Filter</span> <span class='o'>=</span>
<span class='k'>struct</span>
<span class='k'>type</span> <span class='n'>token_filter</span> <span class='o'>=</span>
<span class='o'>(</span><span class='n'>t</span> <span class='o'>*</span> <span class='nn'>Loc</span><span class='p'>.</span><span class='n'>t</span><span class='o'>)</span> <span class='nn'>Stream</span><span class='p'>.</span><span class='n'>t</span> <span class='o'>-></span> <span class='o'>(</span><span class='n'>t</span> <span class='o'>*</span> <span class='nn'>Loc</span><span class='p'>.</span><span class='n'>t</span><span class='o'>)</span> <span class='nn'>Stream</span><span class='p'>.</span><span class='n'>t</span>
<span class='k'>type</span> <span class='n'>t</span> <span class='o'>=</span> <span class='kt'>unit</span>
<span class='k'>let</span> <span class='n'>mk</span> <span class='o'>_</span> <span class='o'>=</span> <span class='bp'>()</span>
<span class='k'>let</span> <span class='n'>filter</span> <span class='o'>_</span> <span class='n'>strm</span> <span class='o'>=</span> <span class='n'>strm</span>
<span class='k'>let</span> <span class='n'>define_filter</span> <span class='o'>_</span> <span class='o'>_</span> <span class='o'>=</span> <span class='bp'>()</span>
<span class='k'>let</span> <span class='n'>keyword_added</span> <span class='o'>_</span> <span class='o'>_</span> <span class='o'>_</span> <span class='o'>=</span> <span class='bp'>()</span>
<span class='k'>let</span> <span class='n'>keyword_removed</span> <span class='o'>_</span> <span class='o'>_</span> <span class='o'>=</span> <span class='bp'>()</span>
<span class='k'>end</span>
</code></pre>
</div><b>Lexer</b>
<p>Finally we have <code>Lexer</code>, which packages up the other modules and provides the actual lexing function. The lexing function takes an initial location and a character stream, and returns a stream of token and location pairs:</p>
<div class='highlight'><pre><code class='ocaml'><span class='k'>module</span> <span class='k'>type</span> <span class='nc'>Lexer</span> <span class='o'>=</span> <span class='k'>sig</span>
<span class='k'>module</span> <span class='nc'>Loc</span> <span class='o'>:</span> <span class='nc'>Loc</span>
<span class='k'>module</span> <span class='nc'>Token</span> <span class='o'>:</span> <span class='nc'>Token</span> <span class='k'>with</span> <span class='k'>module</span> <span class='nc'>Loc</span> <span class='o'>=</span> <span class='nc'>Loc</span>
<span class='k'>module</span> <span class='nc'>Error</span> <span class='o'>:</span> <span class='nc'>Error</span>
<span class='k'>val</span> <span class='n'>mk</span> <span class='o'>:</span>
<span class='kt'>unit</span> <span class='o'>-></span>
<span class='o'>(</span><span class='nn'>Loc</span><span class='p'>.</span><span class='n'>t</span> <span class='o'>-></span> <span class='kt'>char</span> <span class='nn'>Stream</span><span class='p'>.</span><span class='n'>t</span> <span class='o'>-></span> <span class='o'>(</span><span class='nn'>Token</span><span class='p'>.</span><span class='n'>t</span> <span class='o'>*</span> <span class='nn'>Loc</span><span class='p'>.</span><span class='n'>t</span><span class='o'>)</span> <span class='nn'>Stream</span><span class='p'>.</span><span class='n'>t</span><span class='o'>)</span>
<span class='k'>end</span>
</code></pre>
</div>
<p>I don’t want to go through the whole lexing function; it is not very interesting. But here is the main loop:</p>
<div class='highlight'><pre><code class='ocaml'><span class='k'>let</span> <span class='k'>rec</span> <span class='n'>token</span> <span class='n'>c</span> <span class='o'>=</span> <span class='n'>lexer</span>
<span class='o'>|</span> <span class='n'>eof</span> <span class='o'>-></span> <span class='nc'>EOI</span>
<span class='o'>|</span> <span class='n'>newline</span> <span class='o'>-></span> <span class='n'>next_line</span> <span class='n'>c</span><span class='o'>;</span> <span class='n'>token</span> <span class='n'>c</span> <span class='n'>c</span><span class='o'>.</span><span class='n'>lexbuf</span>
<span class='o'>|</span> <span class='n'>blank</span><span class='o'>+</span> <span class='o'>-></span> <span class='n'>token</span> <span class='n'>c</span> <span class='n'>c</span><span class='o'>.</span><span class='n'>lexbuf</span>
<span class='o'>|</span> <span class='sc'>'-'</span><span class='o'>?</span> <span class='o'>[</span><span class='sc'>'0'</span><span class='o'>-</span><span class='sc'>'9'</span><span class='o'>]+</span> <span class='o'>(</span><span class='sc'>'.'</span> <span class='o'>[</span><span class='sc'>'0'</span><span class='o'>-</span><span class='sc'>'9'</span><span class='o'>]*</span> <span class='o'>)?</span>
<span class='o'>((</span><span class='sc'>'e'</span><span class='o'>|</span><span class='sc'>'E'</span><span class='o'>)(</span><span class='sc'>'+'</span><span class='o'>|</span><span class='sc'>'-'</span><span class='o'>)?([</span><span class='sc'>'0'</span><span class='o'>-</span><span class='sc'>'9'</span><span class='o'>]+))?</span> <span class='o'>-></span>
<span class='nc'>NUMBER</span> <span class='o'>(</span><span class='nn'>L</span><span class='p'>.</span><span class='n'>utf8_lexeme</span> <span class='n'>c</span><span class='o'>.</span><span class='n'>lexbuf</span><span class='o'>)</span>
<span class='o'>|</span> <span class='o'>[</span> <span class='s2'>"{}[]:,"</span> <span class='o'>]</span> <span class='o'>|</span> <span class='s2'>"null"</span> <span class='o'>|</span> <span class='s2'>"true"</span> <span class='o'>|</span> <span class='s2'>"false"</span> <span class='o'>-></span>
<span class='nc'>KEYWORD</span> <span class='o'>(</span><span class='nn'>L</span><span class='p'>.</span><span class='n'>utf8_lexeme</span> <span class='n'>c</span><span class='o'>.</span><span class='n'>lexbuf</span><span class='o'>)</span>
<span class='o'>|</span> <span class='sc'>'"'</span> <span class='o'>-></span>
<span class='n'>set_start_loc</span> <span class='n'>c</span><span class='o'>;</span>
<span class='kt'>string</span> <span class='n'>c</span> <span class='n'>c</span><span class='o'>.</span><span class='n'>lexbuf</span><span class='o'>;</span>
<span class='nc'>STRING</span> <span class='o'>(</span><span class='n'>get_stored_string</span> <span class='n'>c</span><span class='o'>)</span>
<span class='o'>|</span> <span class='s2'>"$"</span> <span class='o'>-></span>
<span class='n'>set_start_loc</span> <span class='n'>c</span><span class='o'>;</span>
<span class='n'>c</span><span class='o'>.</span><span class='n'>enc</span> <span class='o'>:=</span> <span class='nn'>Ulexing</span><span class='p'>.</span><span class='nc'>Latin1</span><span class='o'>;</span>
<span class='k'>let</span> <span class='n'>aq</span> <span class='o'>=</span> <span class='n'>antiquot</span> <span class='n'>c</span> <span class='n'>lexbuf</span> <span class='k'>in</span>
<span class='n'>c</span><span class='o'>.</span><span class='n'>enc</span> <span class='o'>:=</span> <span class='nn'>Ulexing</span><span class='p'>.</span><span class='nc'>Utf8</span><span class='o'>;</span>
<span class='n'>aq</span>
<span class='o'>|</span> <span class='o'>_</span> <span class='o'>-></span> <span class='n'>illegal</span> <span class='n'>c</span>
</code></pre>
</div>
<p>The <code>lexer</code> syntax is an extension provided by <code>ulex</code>; the effect is similar to <code>ocamllex</code>. The lexer needs to keep track of the current location and return it along with the token (<code>next_line</code> advances the current location; <code>set_start_loc</code> is for when a token spans multiple <code>ulex</code> lexemes). The lexer also needs to parse antiquotations, taking into account nested quotations within them.</p>
<p>(I think it is not actually necessary to lex JSON as UTF8. The only place that non-ASCII characters can appear is in a string. To lex a string we just accumulate characters until we see a double-quote, which cannot appear as part of a multibyte character. So it would work just as well to accumulate bytes. I am no Unicode expert though. This example was extracted from the Javascript parser in <a href='http://github.com/jaked/ocamljs/tree/master/src/jslib/'>jslib</a>, where I think UTF8 must be taken into account.)</p>
<b>Hooking up the lexer</b>
<p>There are a handful of changes we need to make to call the custom lexer:</p>
<p>In <code>Jq_parser</code> we make the grammar with the custom lexer module, and open it so the token constructors are available; we also replace the <code>INT</code> and <code>FLOAT</code> cases with just <code>NUMBER</code>; for the other cases we used the same token constructor names as the default lexer so we don’t need to change anything.</p>
<div class='highlight'><pre><code class='ocaml'> <span class='k'>open</span> <span class='nc'>Jq_lexer</span>
<span class='k'>module</span> <span class='nc'>Gram</span> <span class='o'>=</span> <span class='nn'>Camlp4</span><span class='p'>.</span><span class='nn'>PreCast</span><span class='p'>.</span><span class='nc'>MakeGram</span><span class='o'>(</span><span class='nc'>Jq_lexer</span><span class='o'>)</span>
<span class='o'>...</span>
<span class='o'>|</span> <span class='n'>n</span> <span class='o'>=</span> <span class='nc'>NUMBER</span> <span class='o'>-></span> <span class='nc'>Jq_number</span> <span class='o'>(</span><span class='n'>float_of_string</span> <span class='n'>n</span><span class='o'>)</span>
</code></pre>
</div>
<p>In <code>Jq_quotations</code> we have <code>Camlp4.PreCast</code> open (so references to <code>Ast</code> in the <code><:expr< >></code> quotations resolve), so <code>EOI</code> is <code>Camlp4.PreCast.EOI</code>; we want <code>Jq_lexer.EOI</code>, so we need to write it explicitly:</p>
<div class='highlight'><pre><code class='ocaml'> <span class='n'>json_eoi</span><span class='o'>:</span> <span class='o'>[[</span> <span class='n'>x</span> <span class='o'>=</span> <span class='nn'>Jq_parser</span><span class='p'>.</span><span class='n'>json</span><span class='o'>;</span> <span class='o'>`</span><span class='nn'>Jq_lexer</span><span class='p'>.</span><span class='nc'>EOI</span> <span class='o'>-></span> <span class='n'>x</span> <span class='o'>]];</span>
</code></pre>
</div>
<p>(Recall that the backtick lets us match a constructor directly; for some reason we can’t module-qualify <code>EOI</code> without it.)</p>
<p>That’s it.</p>
<p>I want to finish off this series next time by covering grammar extension, with an example OCaml syntax extension.</p>
<p>(You can find the complete code for this example <a href='http://github.com/jaked/ambassadortothecomputers.blogspot.com/tree/master/_code/camlp4-custom-lexers'>here</a>.)</p>Jake Donhamhttp://www.blogger.com/profile/04768087689799941690noreply@blogger.com0tag:blogger.com,1999:blog-1445545651031573301.post-24000640250288659562010-08-05T17:55:00.000-07:002010-08-05T18:35:23.420-07:00Reading Camlp4, part 9: implementing antiquotations<p>In this post I want to complicate the JSON quotation library from the <a href='/2010/08/reading-camlp4-part-8-implementing.html'>previous post</a> by adding antiquotations.</p>
<b>AST with antiquotations</b>
<p>In order to support antiquotations we will need to make some changes to the AST. Here is the new AST type:</p>
<div class='highlight'><pre><code class='ocaml'> <span class='k'>type</span> <span class='n'>t</span> <span class='o'>=</span>
<span class='o'>...</span> <span class='c'>(* base types same as before *)</span>
<span class='o'>|</span> <span class='nc'>Jq_array</span> <span class='k'>of</span> <span class='n'>t</span>
<span class='o'>|</span> <span class='nc'>Jq_object</span> <span class='k'>of</span> <span class='n'>t</span>
<span class='o'>|</span> <span class='nc'>Jq_colon</span> <span class='k'>of</span> <span class='n'>t</span> <span class='o'>*</span> <span class='n'>t</span>
<span class='o'>|</span> <span class='nc'>Jq_comma</span> <span class='k'>of</span> <span class='n'>t</span> <span class='o'>*</span> <span class='n'>t</span>
<span class='o'>|</span> <span class='nc'>Jq_nil</span>
<span class='o'>|</span> <span class='nc'>Jq_Ant</span> <span class='k'>of</span> <span class='nn'>Loc</span><span class='p'>.</span><span class='n'>t</span> <span class='o'>*</span> <span class='kt'>string</span>
</code></pre>
</div>
<p>Let’s first consider <code>Jq_Ant</code>. Antiquotations <code>$tag:body$</code> are returned from the lexer as an <code>ANTIQUOT</code> token containing the (possibly empty) tag and the entire body (including nested quotations/antiquotations) as a string. In the parser, we deal only with the JSON AST, so we can’t really do anything with an antiquotation but return it to the caller (wrapped in a <code>Jq_Ant</code>).</p>
<p>The lifting functions generated by <code>Camlp4MetaGenerator</code> treat <code>Jq_Ant</code> (and any other constructor ending in <code>Ant</code>) specially: instead of</p>
<div class='highlight'><pre><code class='ocaml'> <span class='o'>|</span> <span class='nc'>Jq_Ant</span> <span class='o'>(</span><span class='n'>loc</span><span class='o'>,</span> <span class='n'>s</span><span class='o'>)</span> <span class='o'>-></span>
<span class='o'><:</span><span class='n'>expr</span><span class='o'><</span> <span class='nc'>Jq_Ant</span> <span class='o'>($</span><span class='n'>meta_loc</span> <span class='n'>loc</span><span class='o'>$,</span> <span class='o'>$</span><span class='n'>meta_string</span> <span class='n'>s</span><span class='o'>$)</span> <span class='o'>>></span>
</code></pre>
</div>
<p>they have</p>
<div class='highlight'><pre><code class='ocaml'> <span class='o'>|</span> <span class='nc'>Jq_Ant</span> <span class='o'>(</span><span class='n'>loc</span><span class='o'>,</span> <span class='n'>s</span><span class='o'>)</span> <span class='o'>-></span> <span class='nc'>ExAnt</span> <span class='o'>(</span><span class='n'>loc</span><span class='o'>,</span> <span class='n'>s</span><span class='o'>)</span>
</code></pre>
</div>
<p>Instead of lifting the constructor, they translate it directly to <code>ExAnt</code> (or <code>PaAnt</code>, depending on the context). We don’t otherwise have locations in our AST, but <code>Jq_Ant</code> must take a <code>Loc.t</code> argument because <code>ExAnt</code> does. Later, when we walk the OCaml AST expanding antiquotations, it will be convenient to have them as <code>ExAnt</code> nodes rather than lifted <code>Jq_Ant</code> nodes.</p>
<p>In addition to <code>Jq_Ant</code>, we have new <code>Jq_nil</code>, <code>Jq_comma</code>, and <code>Jq_colon</code> constructors, and we have replaced the lists in <code>Jq_array</code> and <code>Jq_object</code> with just <code>t</code>. The idea here is that in an antiquotation in an array, e.g.</p>
<div class='highlight'><pre><code class='ocaml'> <span class='o'><:</span><span class='n'>json</span><span class='o'><</span> <span class='o'>[</span> <span class='mi'>1</span><span class='o'>,</span> <span class='bp'>true</span><span class='o'>,</span> <span class='o'>$</span><span class='n'>x</span><span class='o'>$,</span> <span class='s2'>"foo"</span> <span class='o'>]</span> <span class='o'>>></span>
</code></pre>
</div>
<p>we would like to be able to substitute any number of elements (including zero) into the array in place of <code>x</code>. If <code>Jq_array</code> took a list, we could substitute exactly one element only. So instead we build a tree out of <code>Jq_comma</code> and <code>Jq_nil</code> constructors; at any point in the tree we can substitute zero (<code>Jq_nil</code>), one (any other <code>t</code> constructor), or more than one (a <code>Jq_comma</code> subtree) elements. We recover a list by taking the fringe of the final tree. (In the <code>Jq_ast</code> module there are functions <code>t_of_list</code> and <code>list_of_t</code> which convert between these representations.) For objects, we use <code>Jq_colon</code> to associate a name with a value, then build a tree of name/value pairs the same way.</p>
<p>While this AST meets the need, it is now possible to have ill-formed ASTs, e.g. a bare <code>Jq_nil</code>, or a <code>Jq_object</code> where the elements are not <code>Jq_colon</code> pairs, or where the first argument of <code>Jq_colon</code> is not a <code>Jq_string</code>. This is annoying, but it is hard to see how to avoid it without complicating the AST and making it more difficult to use antiquotations.</p>
<b>Parsing antiquotations</b>
<p>Here is the updated parser:</p>
<div class='highlight'><pre><code class='ocaml'> <span class='nc'>EXTEND</span> <span class='nc'>Gram</span>
<span class='n'>json</span><span class='o'>:</span> <span class='o'>[[</span>
<span class='o'>...</span> <span class='c'>(* base types same as before *)</span>
<span class='o'>|</span> <span class='o'>`</span><span class='nc'>ANTIQUOT</span>
<span class='o'>(</span><span class='s2'>""</span><span class='o'>|</span><span class='s2'>"bool"</span><span class='o'>|</span><span class='s2'>"int"</span><span class='o'>|</span><span class='s2'>"flo"</span><span class='o'>|</span><span class='s2'>"str"</span><span class='o'>|</span><span class='s2'>"list"</span><span class='o'>|</span><span class='s2'>"alist"</span> <span class='k'>as</span> <span class='n'>n</span><span class='o'>,</span> <span class='n'>s</span><span class='o'>)</span> <span class='o'>-></span>
<span class='nc'>Jq_Ant</span> <span class='o'>(_</span><span class='n'>loc</span><span class='o'>,</span> <span class='n'>n</span> <span class='o'>^</span> <span class='s2'>":"</span> <span class='o'>^</span> <span class='n'>s</span><span class='o'>)</span>
<span class='o'>|</span> <span class='s2'>"["</span><span class='o'>;</span> <span class='n'>es</span> <span class='o'>=</span> <span class='nc'>SELF</span><span class='o'>;</span> <span class='s2'>"]"</span> <span class='o'>-></span> <span class='nc'>Jq_array</span> <span class='n'>es</span>
<span class='o'>|</span> <span class='s2'>"{"</span><span class='o'>;</span> <span class='n'>kvs</span> <span class='o'>=</span> <span class='nc'>SELF</span><span class='o'>;</span> <span class='s2'>"}"</span> <span class='o'>-></span> <span class='nc'>Jq_object</span> <span class='n'>kvs</span>
<span class='o'>|</span> <span class='n'>e1</span> <span class='o'>=</span> <span class='nc'>SELF</span><span class='o'>;</span> <span class='s2'>","</span><span class='o'>;</span> <span class='n'>e2</span> <span class='o'>=</span> <span class='nc'>SELF</span> <span class='o'>-></span> <span class='nc'>Jq_comma</span> <span class='o'>(</span><span class='n'>e1</span><span class='o'>,</span> <span class='n'>e2</span><span class='o'>)</span>
<span class='o'>|</span> <span class='o'>-></span> <span class='nc'>Jq_nil</span>
<span class='o'>|</span> <span class='n'>e1</span> <span class='o'>=</span> <span class='nc'>SELF</span><span class='o'>;</span> <span class='s2'>":"</span><span class='o'>;</span> <span class='n'>e2</span> <span class='o'>=</span> <span class='nc'>SELF</span> <span class='o'>-></span> <span class='nc'>Jq_colon</span> <span class='o'>(</span><span class='n'>e1</span><span class='o'>,</span> <span class='n'>e2</span><span class='o'>)</span>
<span class='o'>]];</span>
<span class='nc'>END</span>
</code></pre>
</div>
<p>We want to support several kinds of antiquotations: For individual elements, <code>$x$</code> (where <code>x</code> is a <code>t</code>), or <code>$bool:x$</code>, <code>$int:x$</code>, <code>$flo:x$</code>, or <code>$str:x$</code> (where <code>x</code> is an OCaml <code>bool</code>, <code>int</code>, <code>float</code>, or <code>string</code>); for these latter cases we need to wrap <code>x</code> in the appropriate <code>t</code> constructor. For lists of elements, <code>$list:x$</code> where <code>x</code> is a <code>t list</code>, and <code>$alist:x$</code> where <code>x</code> is a <code>(string * t) list</code>; for these we need to convert <code>x</code> to the <code>Jq_comma</code> / <code>Jq_nil</code> representation above. But in the parser all we do is return a <code>Jq_Ant</code> containing the tag and body of the <code>ANTIQUOT</code> token. (We return it in a single string separated by <code>:</code> because only one string argument is provided in <code>ExAnt</code>.)</p>
<p>It is the parser which controls where antiquotations are allowed, by providing a case for <code>ANTIQUOT</code> in a particular entry, and which tags are allowed in an entry. In this example we have only one entry, so we allow any supported antiquotation anywhere a JSON expression is allowed, but you can see in the OCaml parsers that the acceptable antiquotations can be context-sensitive, and the interpretation of the same antiquotation can vary according to the context (e.g. different conversions may be needed).</p>
<p>For arrays and objects, we parse <code>SELF</code> in place of the list. The cases for <code>Jq_comma</code> and <code>Jq_nil</code> produce the tree representation, and the case for <code>Jq_colon</code> allows name/value pairs. Recall that a token or keyword is preferred over the empty string, so the <code>Jq_nil</code> case matches only when none of the others do. In particular, the quotation <code><:json< >></code> parses to <code>Jq_nil</code>.</p>
<p>We can see that not only is the AST rather free, but so is the parser: it will parse strings which are not well-formed JSON, like <code><:json< 1, 2 >></code> or <code><json:< "foo" : true >></code>. We lose safety, since a mistake may produce an ill-formed AST, but gain convenience, since we may want to substitute these fragments in antiquotations. As an alternative, we could have a more restrictive parser (e.g. no commas allowed at the <code>json</code> entry), and provide different quotations for different contexts (e.g. <code><:json_list< >></code>, allowing commas) for use with antiquotations. For this small language I think it is not worth it.</p>
<b>Expanding antiquotations</b>
<p>To expand antiquotations, we take a pass over the OCaml AST we got from lifting the JSON AST; look for <code>ExAst</code> nodes; parse them as OCaml; then apply the appropriate conversion according to the antiquotation tag. To walk the AST we extend the <code>Ast.map</code> object (generated with the <code>Camlp4FoldGenerator</code> filter) so we don’t need a bunch of boilerplate cases which return the AST unchanged. Here’s the code:</p>
<div class='highlight'><pre><code class='ocaml'> <span class='k'>module</span> <span class='nc'>AQ</span> <span class='o'>=</span> <span class='nn'>Syntax</span><span class='p'>.</span><span class='nc'>AntiquotSyntax</span>
<span class='k'>let</span> <span class='n'>destruct_aq</span> <span class='n'>s</span> <span class='o'>=</span>
<span class='k'>let</span> <span class='n'>pos</span> <span class='o'>=</span> <span class='nn'>String</span><span class='p'>.</span><span class='n'>index</span> <span class='n'>s</span> <span class='sc'>':'</span> <span class='k'>in</span>
<span class='k'>let</span> <span class='n'>len</span> <span class='o'>=</span> <span class='nn'>String</span><span class='p'>.</span><span class='n'>length</span> <span class='n'>s</span> <span class='k'>in</span>
<span class='k'>let</span> <span class='n'>name</span> <span class='o'>=</span> <span class='nn'>String</span><span class='p'>.</span><span class='n'>sub</span> <span class='n'>s</span> <span class='mi'>0</span> <span class='n'>pos</span>
<span class='ow'>and</span> <span class='n'>code</span> <span class='o'>=</span> <span class='nn'>String</span><span class='p'>.</span><span class='n'>sub</span> <span class='n'>s</span> <span class='o'>(</span><span class='n'>pos</span> <span class='o'>+</span> <span class='mi'>1</span><span class='o'>)</span> <span class='o'>(</span><span class='n'>len</span> <span class='o'>-</span> <span class='n'>pos</span> <span class='o'>-</span> <span class='mi'>1</span><span class='o'>)</span> <span class='k'>in</span>
<span class='n'>name</span><span class='o'>,</span> <span class='n'>code</span>
<span class='k'>let</span> <span class='n'>aq_expander</span> <span class='o'>=</span>
<span class='k'>object</span>
<span class='k'>inherit</span> <span class='nn'>Ast</span><span class='p'>.</span><span class='n'>map</span> <span class='k'>as</span> <span class='n'>super</span>
<span class='k'>method</span> <span class='n'>expr</span> <span class='o'>=</span>
<span class='k'>function</span>
<span class='o'>|</span> <span class='nn'>Ast</span><span class='p'>.</span><span class='nc'>ExAnt</span> <span class='o'>(_</span><span class='n'>loc</span><span class='o'>,</span> <span class='n'>s</span><span class='o'>)</span> <span class='o'>-></span>
<span class='k'>let</span> <span class='n'>n</span><span class='o'>,</span> <span class='n'>c</span> <span class='o'>=</span> <span class='n'>destruct_aq</span> <span class='n'>s</span> <span class='k'>in</span>
<span class='k'>let</span> <span class='n'>e</span> <span class='o'>=</span> <span class='nn'>AQ</span><span class='p'>.</span><span class='n'>parse_expr</span> <span class='o'>_</span><span class='n'>loc</span> <span class='n'>c</span> <span class='k'>in</span>
<span class='k'>begin</span> <span class='k'>match</span> <span class='n'>n</span> <span class='k'>with</span>
<span class='o'>|</span> <span class='s2'>"bool"</span> <span class='o'>-></span> <span class='o'><:</span><span class='n'>expr</span><span class='o'><</span> <span class='nn'>Jq_ast</span><span class='p'>.</span><span class='nc'>Jq_bool</span> <span class='o'>$</span><span class='n'>e</span><span class='o'>$</span> <span class='o'>>></span>
<span class='o'>|</span> <span class='s2'>"int"</span> <span class='o'>-></span>
<span class='o'><:</span><span class='n'>expr</span><span class='o'><</span> <span class='nn'>Jq_ast</span><span class='p'>.</span><span class='nc'>Jq_number</span> <span class='o'>(</span><span class='n'>float_of_int</span> <span class='o'>$</span><span class='n'>e</span><span class='o'>$)</span> <span class='o'>>></span>
<span class='o'>|</span> <span class='s2'>"flo"</span> <span class='o'>-></span> <span class='o'><:</span><span class='n'>expr</span><span class='o'><</span> <span class='nn'>Jq_ast</span><span class='p'>.</span><span class='nc'>Jq_number</span> <span class='o'>$</span><span class='n'>e</span><span class='o'>$</span> <span class='o'>>></span>
<span class='o'>|</span> <span class='s2'>"str"</span> <span class='o'>-></span> <span class='o'><:</span><span class='n'>expr</span><span class='o'><</span> <span class='nn'>Jq_ast</span><span class='p'>.</span><span class='nc'>Jq_string</span> <span class='o'>$</span><span class='n'>e</span><span class='o'>$</span> <span class='o'>>></span>
<span class='o'>|</span> <span class='s2'>"list"</span> <span class='o'>-></span> <span class='o'><:</span><span class='n'>expr</span><span class='o'><</span> <span class='nn'>Jq_ast</span><span class='p'>.</span><span class='n'>t_of_list</span> <span class='o'>$</span><span class='n'>e</span><span class='o'>$</span> <span class='o'>>></span>
<span class='o'>|</span> <span class='s2'>"alist"</span> <span class='o'>-></span>
<span class='o'><:</span><span class='n'>expr</span><span class='o'><</span>
<span class='nn'>Jq_ast</span><span class='p'>.</span><span class='n'>t_of_list</span>
<span class='o'>(</span><span class='nn'>List</span><span class='p'>.</span><span class='n'>map</span>
<span class='o'>(</span><span class='k'>fun</span> <span class='o'>(</span><span class='n'>k</span><span class='o'>,</span> <span class='n'>v</span><span class='o'>)</span> <span class='o'>-></span>
<span class='nn'>Jq_ast</span><span class='p'>.</span><span class='nc'>Jq_colon</span> <span class='o'>(</span><span class='nn'>Jq_ast</span><span class='p'>.</span><span class='nc'>Jq_string</span> <span class='n'>k</span><span class='o'>,</span> <span class='n'>v</span><span class='o'>))</span>
<span class='o'>$</span><span class='n'>e</span><span class='o'>$)</span>
<span class='o'>>></span>
<span class='o'>|</span> <span class='o'>_</span> <span class='o'>-></span> <span class='n'>e</span>
<span class='k'>end</span>
<span class='o'>|</span> <span class='n'>e</span> <span class='o'>-></span> <span class='n'>super</span><span class='o'>#</span><span class='n'>expr</span> <span class='n'>e</span>
<span class='k'>method</span> <span class='n'>patt</span> <span class='o'>=</span>
<span class='k'>function</span>
<span class='o'>|</span> <span class='nn'>Ast</span><span class='p'>.</span><span class='nc'>PaAnt</span> <span class='o'>(_</span><span class='n'>loc</span><span class='o'>,</span> <span class='n'>s</span><span class='o'>)</span> <span class='o'>-></span>
<span class='k'>let</span> <span class='o'>_,</span> <span class='n'>c</span> <span class='o'>=</span> <span class='n'>destruct_aq</span> <span class='n'>s</span> <span class='k'>in</span>
<span class='nn'>AQ</span><span class='p'>.</span><span class='n'>parse_patt</span> <span class='o'>_</span><span class='n'>loc</span> <span class='n'>c</span>
<span class='o'>|</span> <span class='n'>p</span> <span class='o'>-></span> <span class='n'>super</span><span class='o'>#</span><span class='n'>patt</span> <span class='n'>p</span>
<span class='k'>end</span>
</code></pre>
</div>
<p>When we find an antiquotation, we unpack the tag and contents (with <code>destruct_aq</code>), parse it using the host syntax (given by <code>Syntax.AntiquotSyntax</code> from <code>Camlp4.PreCast</code>, which might be either the original or revised syntax depending which modules are loaded), then insert conversions depending on the tag. Conversions don’t make sense in a pattern context, so for patterns we just return the parsed antiquotation.</p>
<p>Finally we hook into the quotation machinery, mostly as before:</p>
<div class='highlight'><pre><code class='ocaml'><span class='k'>let</span> <span class='n'>parse_quot_string</span> <span class='n'>loc</span> <span class='n'>s</span> <span class='o'>=</span>
<span class='k'>let</span> <span class='n'>q</span> <span class='o'>=</span> <span class='o'>!</span><span class='nn'>Camlp4_config</span><span class='p'>.</span><span class='n'>antiquotations</span> <span class='k'>in</span>
<span class='nn'>Camlp4_config</span><span class='p'>.</span><span class='n'>antiquotations</span> <span class='o'>:=</span> <span class='bp'>true</span><span class='o'>;</span>
<span class='k'>let</span> <span class='n'>res</span> <span class='o'>=</span> <span class='nn'>Jq_parser</span><span class='p'>.</span><span class='nn'>Gram</span><span class='p'>.</span><span class='n'>parse_string</span> <span class='n'>json_eoi</span> <span class='n'>loc</span> <span class='n'>s</span> <span class='k'>in</span>
<span class='nn'>Camlp4_config</span><span class='p'>.</span><span class='n'>antiquotations</span> <span class='o'>:=</span> <span class='n'>q</span><span class='o'>;</span>
<span class='n'>res</span>
<span class='k'>let</span> <span class='n'>expand_expr</span> <span class='n'>loc</span> <span class='o'>_</span> <span class='n'>s</span> <span class='o'>=</span>
<span class='k'>let</span> <span class='n'>ast</span> <span class='o'>=</span> <span class='n'>parse_quot_string</span> <span class='n'>loc</span> <span class='n'>s</span> <span class='k'>in</span>
<span class='k'>let</span> <span class='n'>meta_ast</span> <span class='o'>=</span> <span class='nn'>Jq_ast</span><span class='p'>.</span><span class='nn'>MetaExpr</span><span class='p'>.</span><span class='n'>meta_t</span> <span class='n'>loc</span> <span class='n'>ast</span> <span class='k'>in</span>
<span class='n'>aq_expander</span><span class='o'>#</span><span class='n'>expr</span> <span class='n'>meta_ast</span>
<span class='o'>;;</span>
<span class='nn'>Q</span><span class='p'>.</span><span class='n'>add</span> <span class='s2'>"json"</span> <span class='nn'>Q</span><span class='p'>.</span><span class='nn'>DynAst</span><span class='p'>.</span><span class='n'>expr_tag</span> <span class='n'>expand_expr</span><span class='o'>;</span>
</code></pre>
</div>
<p>Before parsing a quotation we set a flag, which is checked by the lexer, to allow antiquotations; the flag is initially false, so antiquotations appearing outside a quotation won’t be parsed. After lifting the JSON AST to an OCaml AST, we run the result through the antiquotation expander.</p>
<p>For concreteness, let’s follow the life of a quotation as it is parsed and expanded. Say we begin with</p>
<div class='highlight'><pre><code class='ocaml'> <span class='o'><:</span><span class='n'>json</span><span class='o'><</span> <span class='o'>[</span> <span class='mi'>1</span><span class='o'>,</span> <span class='o'>$</span><span class='kt'>int</span><span class='o'>:</span><span class='n'>x</span><span class='o'>$</span> <span class='o'>]</span> <span class='o'>>></span>
</code></pre>
</div>
<p>After parsing:</p>
<div class='highlight'><pre><code class='ocaml'> <span class='nc'>Jq_array</span> <span class='o'>(</span><span class='nc'>Jq_comma</span> <span class='o'>(</span><span class='nc'>Jq_number</span> <span class='mi'>1</span><span class='o'>.,</span> <span class='nc'>Jq_Ant</span> <span class='o'>(_</span><span class='n'>loc</span><span class='o'>,</span> <span class='s2'>"int:x"</span><span class='o'>)))</span>
</code></pre>
</div>
<p>After lifting:</p>
<div class='highlight'><pre><code class='ocaml'> <span class='o'><:</span><span class='n'>expr</span><span class='o'><</span>
<span class='nc'>Jq_array</span> <span class='o'>(</span><span class='nc'>Jq_comma</span> <span class='o'>(</span><span class='nc'>Jq_number</span> <span class='mi'>1</span><span class='o'>.,</span> <span class='o'>$</span><span class='nc'>ExAnt</span> <span class='o'>(_</span><span class='n'>loc</span><span class='o'>,</span> <span class='s2'>"int:x"</span><span class='o'>)$))</span>
<span class='o'>>></span>
</code></pre>
</div>
<p>After expanding:</p>
<div class='highlight'><pre><code class='ocaml'> <span class='o'><:</span><span class='n'>expr</span><span class='o'><</span>
<span class='nc'>Jq_array</span> <span class='o'>(</span><span class='nc'>Jq_comma</span> <span class='o'>(</span><span class='nc'>Jq_number</span> <span class='mi'>1</span><span class='o'>.,</span> <span class='nc'>Jq_number</span> <span class='o'>(</span><span class='n'>float_of_int</span> <span class='n'>x</span><span class='o'>)))</span>
<span class='o'>>></span>
</code></pre>
</div><b>Nested quotations</b>
<p>Let’s see that again with a nested quotation:</p>
<div class='highlight'><pre><code class='ocaml'> <span class='o'><:</span><span class='n'>json</span><span class='o'><</span> <span class='o'>$<:</span><span class='n'>json</span><span class='o'><</span> <span class='mi'>1</span> <span class='o'>>>$</span> <span class='o'>>></span>
</code></pre>
</div>
<p>After parsing:</p>
<div class='highlight'><pre><code class='ocaml'> <span class='nc'>Jq_Ant</span> <span class='o'>(_</span><span class='n'>loc</span><span class='o'>,</span> <span class='s2'>"<:json< 1 >>"</span><span class='o'>)</span>
</code></pre>
</div>
<p>After lifting:</p>
<div class='highlight'><pre><code class='ocaml'> <span class='nc'>ExAnt</span> <span class='o'>(_</span><span class='n'>loc</span><span class='o'>,</span> <span class='s2'>"<:json< 1 >>"</span><span class='o'>)</span>
</code></pre>
</div>
<p>After expanding (during which we parse and expand <code>"<:json< 1 >>"</code> to <code><:expr< Jq_number 1. >></code>):</p>
<div class='highlight'><pre><code class='ocaml'> <span class='o'><:</span><span class='n'>expr</span><span class='o'><</span> <span class='nc'>Jq_number</span> <span class='mi'>1</span><span class='o'>.</span> <span class='o'>>></span>
</code></pre>
</div>
<p>A wise man <a href='http://www.cs.yale.edu/quotes.html'>once said</a> “The string is a stark data structure and everywhere it is passed there is much duplication of process.” So it is with Camlp4 quotations: each nested quotation is re-parsed; each quotation implementation must deal with parsing host-language antiquotation strings; and the lexer for each implementation must lex antiquotations and nested quotations. (Since we used the default lexer we didn’t have to worry about this, but see the next post.) It would be nice to have more support from Camlp4. On the other hand, while what happens at runtime seems baroque, the code above is relatively straightforward, and since we work with strings we can use any parser technology we like.</p>
<p>It has not been much (marginal) trouble to handle quotations in pattern contexts, but they are not tremendously useful. The problem is that we normally don’t care about the order of the fields in a JSON object, or if there are extra fields; we would like to write</p>
<div class='highlight'><pre><code class='ocaml'> <span class='k'>match</span> <span class='n'>x</span> <span class='k'>with</span>
<span class='o'>|</span> <span class='o'><:</span><span class='n'>json</span><span class='o'><</span> <span class='o'>{</span>
<span class='s2'>"foo"</span> <span class='o'>:</span> <span class='o'>$</span><span class='n'>foo</span><span class='o'>$</span>
<span class='o'>}</span> <span class='o'>>></span> <span class='o'>-></span> <span class='o'>...</span> <span class='c'>(* do something with foo *)</span>
</code></pre>
</div>
<p>and have it work wherever the <code>foo</code> field is in the object. This is a more complicated job than just lifting the JSON AST. For an alternative approach to processing JSON using a list-comprehension syntax, see <a href='http://github.com/jaked/cufp-metaprogramming-tutorial/tree/master/ocaml/json_compr/'>json_compr</a>, an example I wrote for the upcoming <a href='http://cufp.org/conference/sessions/2010/camlp4-and-template-haskell'>metaprogramming tutorial at CUFP</a>. For a fancier JSON DSL (including the ability to induct a type description from a bunch of examples!), see Julien Verlauget’s <a href='http://github.com/pika/jsonpat'>jsonpat</a>. And for a framework to extend OCaml’s pattern-matching syntax, see Jeremy Yallop’s <a href='http://code.google.com/p/ocaml-patterns/'>ocaml-patterns</a>.</p>
<p>Next time we will see how to use a custom lexer with a Camlp4 grammar.</p>
<p>(You can find the complete code for this example <a href='http://github.com/jaked/ambassadortothecomputers.blogspot.com/tree/master/_code/camlp4-implementing-antiquotations'>here</a>.)</p>Jake Donhamhttp://www.blogger.com/profile/04768087689799941690noreply@blogger.com0tag:blogger.com,1999:blog-1445545651031573301.post-40584289303065770922010-08-03T16:47:00.000-07:002010-08-03T16:47:47.101-07:00Reading Camlp4, part 8: implementing quotations<p>The Camlp4 system of quotations and antiquotations is an awesome tool for <a href='/2009/01/reading-camlp4-part-2-quotations_04.html'>producing</a> and <a href='/2009/01/reading-camlp4-part-4-consuming-ocaml.html'>consuming</a> OCaml ASTs. In this post (and the following one) we will see how to provide this facility for other syntaxes and ASTs. Here we consider just quotations; we’ll add antiquotations in the following post.</p>
<b>An AST for JSON</b>
<p>Our running example will be a quotation expander for <a href='http://www.ietf.org/rfc/rfc4627.txt'>JSON</a>. Let’s begin with the JSON AST, in a module <code>Jq_ast</code>:</p>
<div class='highlight'><pre><code class='ocaml'> <span class='k'>type</span> <span class='n'>t</span> <span class='o'>=</span>
<span class='o'>|</span> <span class='nc'>Jq_null</span>
<span class='o'>|</span> <span class='nc'>Jq_bool</span> <span class='k'>of</span> <span class='kt'>bool</span>
<span class='o'>|</span> <span class='nc'>Jq_number</span> <span class='k'>of</span> <span class='kt'>float</span>
<span class='o'>|</span> <span class='nc'>Jq_string</span> <span class='k'>of</span> <span class='kt'>string</span>
<span class='o'>|</span> <span class='nc'>Jq_array</span> <span class='k'>of</span> <span class='n'>t</span> <span class='kt'>list</span>
<span class='o'>|</span> <span class='nc'>Jq_object</span> <span class='k'>of</span> <span class='o'>(</span><span class='kt'>string</span> <span class='o'>*</span> <span class='n'>t</span><span class='o'>)</span> <span class='kt'>list</span>
</code></pre>
</div>
<p>This is the same (modulo order and names) as <code>json_type</code> from the <a href='http://martin.jambon.free.fr/json-wheel.html'>json-wheel</a> library, but for various reasons we will not be able to use <code>json_type</code>. The <code>Jq_</code> prefix is for <code>json_quot</code>, the name of this little library.</p>
<b>Parsing JSON</b>
<p>We’ll use a Camlp4 <a href='/2010/05/reading-camlp4-part-6-parsing.html'>grammar</a> to parse JSON trees. It is not necessary to use Camlp4’s parsing facilities in order to implement quotations—ultimately we will need to provide just a function from strings to ASTs, so we could use <code>ocamlyacc</code> or what-have-you instead—but it is convenient. Here is the parser:</p>
<div class='highlight'><pre><code class='ocaml'> <span class='k'>open</span> <span class='nn'>Camlp4</span><span class='p'>.</span><span class='nc'>PreCast</span>
<span class='k'>open</span> <span class='nc'>Jq_ast</span>
<span class='k'>module</span> <span class='nc'>Gram</span> <span class='o'>=</span> <span class='nc'>MakeGram</span><span class='o'>(</span><span class='nc'>Lexer</span><span class='o'>)</span>
<span class='k'>let</span> <span class='n'>json</span> <span class='o'>=</span> <span class='nn'>Gram</span><span class='p'>.</span><span class='nn'>Entry</span><span class='p'>.</span><span class='n'>mk</span> <span class='s2'>"json"</span>
<span class='o'>;;</span>
<span class='nc'>EXTEND</span> <span class='nc'>Gram</span>
<span class='n'>json</span><span class='o'>:</span> <span class='o'>[[</span>
<span class='s2'>"null"</span> <span class='o'>-></span> <span class='nc'>Jq_null</span>
<span class='o'>|</span> <span class='s2'>"true"</span> <span class='o'>-></span> <span class='nc'>Jq_bool</span> <span class='bp'>true</span>
<span class='o'>|</span> <span class='s2'>"false"</span> <span class='o'>-></span> <span class='nc'>Jq_bool</span> <span class='bp'>false</span>
<span class='o'>|</span> <span class='n'>i</span> <span class='o'>=</span> <span class='nc'>INT</span> <span class='o'>-></span> <span class='nc'>Jq_number</span> <span class='o'>(</span><span class='n'>float_of_string</span> <span class='n'>i</span><span class='o'>)</span>
<span class='o'>|</span> <span class='n'>f</span> <span class='o'>=</span> <span class='nc'>FLOAT</span> <span class='o'>-></span> <span class='nc'>Jq_number</span> <span class='o'>(</span><span class='n'>float_of_string</span> <span class='n'>f</span><span class='o'>)</span>
<span class='o'>|</span> <span class='n'>s</span> <span class='o'>=</span> <span class='nc'>STRING</span> <span class='o'>-></span> <span class='nc'>Jq_string</span> <span class='n'>s</span>
<span class='o'>|</span> <span class='s2'>"["</span><span class='o'>;</span> <span class='n'>es</span> <span class='o'>=</span> <span class='nc'>LIST0</span> <span class='n'>json</span> <span class='nc'>SEP</span> <span class='s2'>","</span><span class='o'>;</span> <span class='s2'>"]"</span> <span class='o'>-></span> <span class='nc'>Jq_array</span> <span class='n'>es</span>
<span class='o'>|</span> <span class='s2'>"{"</span><span class='o'>;</span>
<span class='n'>kvs</span> <span class='o'>=</span>
<span class='nc'>LIST0</span>
<span class='o'>[</span> <span class='n'>s</span> <span class='o'>=</span> <span class='nc'>STRING</span><span class='o'>;</span> <span class='s2'>":"</span><span class='o'>;</span> <span class='n'>j</span> <span class='o'>=</span> <span class='n'>json</span> <span class='o'>-></span> <span class='o'>(</span><span class='n'>s</span><span class='o'>,</span> <span class='n'>j</span><span class='o'>)</span> <span class='o'>]</span>
<span class='nc'>SEP</span> <span class='s2'>","</span><span class='o'>;</span>
<span class='s2'>"}"</span> <span class='o'>-></span> <span class='nc'>Jq_object</span> <span class='n'>kvs</span>
<span class='o'>]];</span>
<span class='nc'>END</span>
</code></pre>
</div>
<p>We use the default Camlp4 lexer (with <code>MakeGram(Lexer)</code>); as we have seen, keywords mentioned in a Camlp4 grammar are added to the lexer, so we don’t need to do anything special to lex <code>null</code> etc. However, while JSON/Javascript has a single number type, the default lexer returns different tokens for <code>INT</code> and <code>FLOAT</code> numbers, so we convert each to <code>Jq_number</code>. In fact, these tokens (along with <code>STRING</code>) represent OCaml <a href='http://caml.inria.fr/pub/docs/manual-ocaml/lex.html#integer-literal'>integer</a>, <a href='http://caml.inria.fr/pub/docs/manual-ocaml/lex.html#float-literal'>float</a> and <a href='http://caml.inria.fr/pub/docs/manual-ocaml/lex.html#string-literal'>string</a> literals, which do not exactly match the corresponding JSON ones, but they are fairly close so let’s not worry about it for now; we’ll revisit the lexer in a later post.</p>
<p>The parser itself is pleasingly compact; we can make good use of the <code>LIST0</code> special symbol and an anonymous entry for parsing objects. Unfortunately things will get a little more complicated when we come to antiquotations.</p>
<b>Lifting the AST</b>
<p>Next we need to “lift” values of the JSON AST to values of the OCaml AST. What does “lift” mean, and why do we need to do it? The goal is to convert quotations in OCaml code, such as</p>
<div class='highlight'><pre><code class='ocaml'> <span class='k'>let</span> <span class='n'>x</span> <span class='o'>=</span> <span class='o'><:</span><span class='n'>json</span><span class='o'><</span> <span class='o'>[</span> <span class='mi'>1</span><span class='o'>,</span> <span class='s2'>"foo"</span><span class='o'>,</span> <span class='bp'>true</span> <span class='o'>]</span> <span class='o'>>></span>
</code></pre>
</div>
<p>into the equivalent</p>
<div class='highlight'><pre><code class='ocaml'> <span class='k'>let</span> <span class='n'>x</span> <span class='o'>=</span>
<span class='nn'>Jq_ast</span><span class='p'>.</span><span class='nc'>Jq_array</span> <span class='o'>[</span>
<span class='nn'>Jq_ast</span><span class='p'>.</span><span class='nc'>Jq_number</span> <span class='mi'>1</span><span class='o'>.;</span>
<span class='nn'>Jq_ast</span><span class='p'>.</span><span class='nc'>Jq_string</span> <span class='s2'>"foo"</span><span class='o'>;</span>
<span class='nn'>Jq_ast</span><span class='p'>.</span><span class='nc'>Jq_bool</span> <span class='bp'>true</span>
<span class='o'>]</span>
</code></pre>
</div>
<p>This is to happen as part of Camlp4 preprocessing, which produces an OCaml AST, so what we produce in place of the <code><:json< ... >></code> expression must be a fragment of OCaml AST. We have a parser which takes a valid JSON string to the JSON AST; what remains is to take a JSON AST value to the corresponding OCaml AST. So we need a function with cases something like:</p>
<div class='highlight'><pre><code class='ocaml'> <span class='o'>|</span> <span class='nc'>Jq_null</span> <span class='o'>-></span> <span class='o'><:</span><span class='n'>expr</span><span class='o'><</span> <span class='nc'>Jq_null</span> <span class='o'>>></span>
<span class='o'>|</span> <span class='nc'>Jq_number</span> <span class='n'>n</span> <span class='o'>-></span> <span class='o'><:</span><span class='n'>expr</span><span class='o'><</span> <span class='nc'>Jq_number</span> <span class='o'>$`</span><span class='n'>flo</span><span class='o'>:</span><span class='n'>n</span><span class='o'>$</span> <span class='o'>>></span>
<span class='o'>|</span> <span class='o'>...</span>
</code></pre>
</div>
<p>It is not such a big deal to hand-write this lifting function for a small AST like JSON, but it is arduous and error-prone for full-size ASTs. Fortunately Camlp4 has a filter which does it for us. Let’s first look at the signature of the <code>Jq_ast</code> module:</p>
<div class='highlight'><pre><code class='ocaml'> <span class='k'>open</span> <span class='nn'>Camlp4</span><span class='p'>.</span><span class='nc'>PreCast</span>
<span class='k'>type</span> <span class='n'>t</span> <span class='o'>=</span> <span class='o'>...</span> <span class='c'>(* as above *)</span>
<span class='k'>module</span> <span class='nc'>MetaExpr</span> <span class='o'>:</span>
<span class='k'>sig</span>
<span class='k'>val</span> <span class='n'>meta_t</span> <span class='o'>:</span> <span class='nn'>Ast</span><span class='p'>.</span><span class='n'>loc</span> <span class='o'>-></span> <span class='n'>t</span> <span class='o'>-></span> <span class='nn'>Ast</span><span class='p'>.</span><span class='n'>expr</span>
<span class='k'>end</span>
<span class='k'>module</span> <span class='nc'>MetaPatt</span> <span class='o'>:</span>
<span class='k'>sig</span>
<span class='k'>val</span> <span class='n'>meta_t</span> <span class='o'>:</span> <span class='nn'>Ast</span><span class='p'>.</span><span class='n'>loc</span> <span class='o'>-></span> <span class='n'>t</span> <span class='o'>-></span> <span class='nn'>Ast</span><span class='p'>.</span><span class='n'>patt</span>
<span class='k'>end</span>
</code></pre>
</div>
<p>The generated modules <code>MetaExpr</code> and <code>MetaPatt</code> provide functions to lift a JSON AST to either an OCaml <code>expr</code> (when the quotation appears as an expression) or <code>patt</code> (when it appears as a pattern). The <code>loc</code> arguments are inserted into the resulting OCaml AST so that compile errors have correct locations.</p>
<p>Now the implementation of <code>Jq_ast</code>:</p>
<div class='highlight'><pre><code class='ocaml'> <span class='k'>module</span> <span class='nc'>Jq_ast</span> <span class='o'>=</span>
<span class='k'>struct</span>
<span class='k'>type</span> <span class='kt'>float</span><span class='k'>'</span> <span class='o'>=</span> <span class='kt'>float</span>
<span class='k'>type</span> <span class='n'>t</span> <span class='o'>=</span> <span class='c'>(* almost as above *)</span>
<span class='o'>...</span>
<span class='o'>|</span> <span class='nc'>Jq_number</span> <span class='k'>of</span> <span class='kt'>float</span><span class='k'>'</span>
<span class='o'>...</span>
<span class='k'>end</span>
<span class='k'>include</span> <span class='nc'>Jq_ast</span>
<span class='k'>open</span> <span class='nn'>Camlp4</span><span class='p'>.</span><span class='nc'>PreCast</span> <span class='c'>(* for Ast refs in generated code *)</span>
<span class='k'>module</span> <span class='nc'>MetaExpr</span> <span class='o'>=</span>
<span class='k'>struct</span>
<span class='k'>let</span> <span class='n'>meta_float'</span> <span class='o'>_</span><span class='n'>loc</span> <span class='n'>f</span> <span class='o'>=</span> <span class='o'><:</span><span class='n'>expr</span><span class='o'><</span> <span class='o'>$`</span><span class='n'>flo</span><span class='o'>:</span><span class='n'>f</span><span class='o'>$</span> <span class='o'>>></span>
<span class='k'>include</span> <span class='nn'>Camlp4Filters</span><span class='p'>.</span><span class='nc'>MetaGeneratorExpr</span><span class='o'>(</span><span class='nc'>Jq_ast</span><span class='o'>)</span>
<span class='k'>end</span>
<span class='k'>module</span> <span class='nc'>MetaPatt</span> <span class='o'>=</span>
<span class='k'>struct</span>
<span class='k'>let</span> <span class='n'>meta_float'</span> <span class='o'>_</span><span class='n'>loc</span> <span class='n'>f</span> <span class='o'>=</span> <span class='o'><:</span><span class='n'>patt</span><span class='o'><</span> <span class='o'>$`</span><span class='n'>flo</span><span class='o'>:</span><span class='n'>f</span><span class='o'>$</span> <span class='o'>>></span>
<span class='k'>include</span> <span class='nn'>Camlp4Filters</span><span class='p'>.</span><span class='nc'>MetaGeneratorPatt</span><span class='o'>(</span><span class='nc'>Jq_ast</span><span class='o'>)</span>
<span class='k'>end</span>
</code></pre>
</div>
<p>The file needs the <code>Camlp4MetaGenerator</code> filter (the <code>camlp4.metagenerator</code> package with <code>findlib</code>). The main idea is that the calls to <code>Camlp4Filters.MetaGenerator{Expr,Patt}</code> are expanded into the lifting functions. But there are a couple of fussy details:</p>
<p>First: The argument module <code>Jq_ast</code> which we pass to the generators is used both on the left and right of the generated function; if you look at the generated code there are cases like:</p>
<div class='highlight'><pre><code class='ocaml'> <span class='o'>|</span> <span class='nn'>Jq_ast</span><span class='p'>.</span><span class='nc'>Jq_null</span> <span class='o'>-></span> <span class='o'><:</span><span class='n'>expr</span><span class='o'><</span> <span class='nn'>Jq_ast</span><span class='p'>.</span><span class='nc'>Jq_null</span> <span class='o'>>></span>
</code></pre>
</div>
<p>(The <code><:expr< .. >></code> is already expanded in the actual generated code.) We need the AST to be available qualified by the module <code>Jq_ast</code> both in the current file and also in code that uses the quotation. So we have a nested <code>Jq_ast</code> module (for local uses, on the left-hand side) which we <code>include</code> (for external uses, on the right-hand side).</p>
<p>Second: The generators scan all the types defined in the current module, then generate code from the last-appearing recursive bundle. (In this case the recursive bundle contains just <code>t</code>, but in general there can be more than one; mutually recursive lifting functions are generated.) There are some special cases for predefined types, and in particular for <code>float</code>; however, it seems to be wrong:</p>
<div class='highlight'><pre><code class='ocaml'> <span class='k'>let</span> <span class='n'>meta_float</span> <span class='o'>_</span><span class='n'>loc</span> <span class='n'>s</span> <span class='o'>=</span> <span class='nn'>Ast</span><span class='p'>.</span><span class='nc'>ExFlo</span> <span class='o'>(_</span><span class='n'>loc</span><span class='o'>,</span> <span class='n'>s</span><span class='o'>)</span>
</code></pre>
</div>
<p>The <code>ExFlo</code> constructor takes a string representing the float, but calls to this function are generated when you use <code>float</code> in your type. To work around this, we define the type <code>float'</code> (on its own rather than as part of the last-appearing recursive bundle, or else Camlp4 would generate a <code>meta_float'</code> that calls <code>meta_float</code>), and provide correct <code>meta_float'</code> functions. There is a similar bug with <code>meta_int</code>, but <code>meta_bool</code> is correct, so our <code>Jq_bool</code> case does not need fixing.</p>
<p>(It is interesting to contrast this approach of lifting the AST with how it is handled in Template Haskell using the “scrap your boilerplate” pattern; see Geoffrey Mainland’s paper <a href='http://www.eecs.harvard.edu/~mainland/publications/mainland07quasiquoting.pdf'>Why It’s Nice to be Quoted</a>.)</p>
<b>Quotations</b>
<p>Finally we can hook the parser and AST lifter into Camlp4’s quotation machinery, in the <code>Jq_quotations</code> module:</p>
<div class='highlight'><pre><code class='ocaml'> <span class='k'>open</span> <span class='nn'>Camlp4</span><span class='p'>.</span><span class='nc'>PreCast</span>
<span class='k'>module</span> <span class='nc'>Q</span> <span class='o'>=</span> <span class='nn'>Syntax</span><span class='p'>.</span><span class='nc'>Quotation</span>
<span class='k'>let</span> <span class='n'>json_eoi</span> <span class='o'>=</span> <span class='nn'>Jq_parser</span><span class='p'>.</span><span class='nn'>Gram</span><span class='p'>.</span><span class='nn'>Entry</span><span class='p'>.</span><span class='n'>mk</span> <span class='s2'>"json_eoi"</span>
<span class='nc'>EXTEND</span> <span class='nn'>Jq_parser</span><span class='p'>.</span><span class='nc'>Gram</span>
<span class='n'>json_eoi</span><span class='o'>:</span> <span class='o'>[[</span> <span class='n'>x</span> <span class='o'>=</span> <span class='nn'>Jq_parser</span><span class='p'>.</span><span class='n'>json</span><span class='o'>;</span> <span class='nc'>EOI</span> <span class='o'>-></span> <span class='n'>x</span> <span class='o'>]];</span>
<span class='nc'>END</span><span class='o'>;;</span>
<span class='k'>let</span> <span class='n'>parse_quot_string</span> <span class='n'>loc</span> <span class='n'>s</span> <span class='o'>=</span>
<span class='nn'>Jq_parser</span><span class='p'>.</span><span class='nn'>Gram</span><span class='p'>.</span><span class='n'>parse_string</span> <span class='n'>json_eoi</span> <span class='n'>loc</span> <span class='n'>s</span>
<span class='k'>let</span> <span class='n'>expand_expr</span> <span class='n'>loc</span> <span class='o'>_</span> <span class='n'>s</span> <span class='o'>=</span>
<span class='nn'>Jq_ast</span><span class='p'>.</span><span class='nn'>MetaExpr</span><span class='p'>.</span><span class='n'>meta_t</span> <span class='n'>loc</span> <span class='o'>(</span><span class='n'>parse_quot_string</span> <span class='n'>loc</span> <span class='n'>s</span><span class='o'>)</span>
<span class='k'>let</span> <span class='n'>expand_str_item</span> <span class='n'>loc</span> <span class='o'>_</span> <span class='n'>s</span> <span class='o'>=</span>
<span class='k'>let</span> <span class='n'>exp_ast</span> <span class='o'>=</span> <span class='n'>expand_expr</span> <span class='n'>loc</span> <span class='nc'>None</span> <span class='n'>s</span> <span class='k'>in</span>
<span class='o'><:</span><span class='n'>str_item</span><span class='o'>@</span><span class='n'>loc</span><span class='o'><</span> <span class='o'>$</span><span class='n'>exp</span><span class='o'>:</span><span class='n'>exp_ast</span><span class='o'>$</span> <span class='o'>>></span>
<span class='k'>let</span> <span class='n'>expand_patt</span> <span class='n'>loc</span> <span class='o'>_</span> <span class='n'>s</span> <span class='o'>=</span>
<span class='nn'>Jq_ast</span><span class='p'>.</span><span class='nn'>MetaPatt</span><span class='p'>.</span><span class='n'>meta_t</span> <span class='n'>loc</span> <span class='o'>(</span><span class='n'>parse_quot_string</span> <span class='n'>loc</span> <span class='n'>s</span><span class='o'>)</span>
<span class='o'>;;</span>
<span class='nn'>Q</span><span class='p'>.</span><span class='n'>add</span> <span class='s2'>"json"</span> <span class='nn'>Q</span><span class='p'>.</span><span class='nn'>DynAst</span><span class='p'>.</span><span class='n'>expr_tag</span> <span class='n'>expand_expr</span><span class='o'>;</span>
<span class='nn'>Q</span><span class='p'>.</span><span class='n'>add</span> <span class='s2'>"json"</span> <span class='nn'>Q</span><span class='p'>.</span><span class='nn'>DynAst</span><span class='p'>.</span><span class='n'>patt_tag</span> <span class='n'>expand_patt</span><span class='o'>;</span>
<span class='nn'>Q</span><span class='p'>.</span><span class='n'>add</span> <span class='s2'>"json"</span> <span class='nn'>Q</span><span class='p'>.</span><span class='nn'>DynAst</span><span class='p'>.</span><span class='n'>str_item_tag</span> <span class='n'>expand_str_item</span><span class='o'>;</span>
<span class='nn'>Q</span><span class='p'>.</span><span class='n'>default</span> <span class='o'>:=</span> <span class='s2'>"json"</span>
</code></pre>
</div>
<p>First, we make a new grammar entry <code>json_eoi</code> which parses a <code>json</code> expression followed by the end-of-input token <code>EOI</code>. Grammar entries ordinarily ignore the rest of the input after a successful parse. If we were to use the <code>json</code> entry directly, we would silently accept quotations with trailing garbage, and in particular incorrect quotations that happen to have a correct prefix, rather than alerting the user.</p>
<p>Then we register quotation expanders for the <code><:json< >></code> quotation in the <code>expr</code>, <code>patt</code>, and <code>str_item</code> contexts (<code>str_item</code> is useful because that is the context at the top level prompt), using <code>Syntax.Quotation.add</code>. All the expanders do is call the parser, then run the result through the appropriate lifting function.</p>
<p>Finally we set <code>json</code> as the default quotation, so we can just say <code><< >></code> for JSON quotations. This is perhaps a bit cheeky, since the user may want something else as the default quotation; whichever module is loaded last wins.</p>
<p>It is worth reflecting on how the quotation mechanism works in the OCaml parser: There is a lexer token for quotations, but no node in the OCaml AST, so everything must happen in the parser. When a quotation is lexed, its entire contents is returned as a string. (Nested quotations are matched in the lexer—see <code>quotation</code> and <code>antiquot</code> in <code>camlp4/Camlpl4/Struct/Lexer.mll</code>—without considering the embedded syntax; this makes the <code><<</code> and <code>>></code> tokens unusable in the embedded syntax.) The string is then expanded according to the table of registered expanders; expanders return a fragment of OCaml AST which is inserted into the parse tree.</p>
<p>You might have thought (as I did) that something fancy happens with quotations, e.g. Camlp4 switches to a different parser on the fly, then back to the original parser for antiquotations. But it is much simpler than that. At the same time, it is much more complicated than that, as we will see next time when we cover antiquotations (and in particular how nested antiquotations/quotations are handled).</p>
<p>(You can find the complete code <a href='http://github.com/jaked/ambassadortothecomputers.blogspot.com/tree/master/_code/camlp4-implementing-quotations'>here</a>, including a pretty-printer and integration with the top level; after building and installing you can say e.g.</p>
<div class='highlight'><pre><code class='ocaml'> <span class='o'>#</span> <span class='o'><<</span> <span class='o'>[</span> <span class='mi'>1</span><span class='o'>,</span> <span class='s2'>"foo"</span><span class='o'>,</span> <span class='bp'>true</span> <span class='o'>]</span> <span class='o'>>>;;</span>
<span class='o'>-</span> <span class='o'>:</span> <span class='nn'>Jq_ast</span><span class='p'>.</span><span class='n'>t</span> <span class='o'>=</span> <span class='o'>[</span> <span class='mi'>1</span><span class='o'>,</span> <span class='s2'>"foo"</span><span class='o'>,</span> <span class='bp'>true</span> <span class='o'>]</span>
</code></pre>
</div>
<p>although without antiquotations it is not very useful.)</p>Jake Donhamhttp://www.blogger.com/profile/04768087689799941690noreply@blogger.com0tag:blogger.com,1999:blog-1445545651031573301.post-910276573905387072010-07-27T11:01:00.000-07:002010-07-27T11:01:24.805-07:00Reading Camlp4, part 7: revised syntax<p>As we have seen, Camlp4 contains an alternative syntax for OCaml, the “revised” syntax, which attempts to correct some infelicities of the original syntax, and to make it easier to parse and pretty-print. Most (all?) of Camlp4 itself is written in this syntax.</p>
<p>While OCaml quotations may be written in either original or revised syntax, original syntax quotations are not as well-supported; there are AST constructions which are difficult or impossible to generate from original syntax quotations. (As I understand it, part of the motivation for the revised syntax was to provide more context, in the form of extra brackets etc., so that antiquotations work more smoothly.)</p>
<p>I have always felt that the revised syntax is a pointless idiosyncrasy, and that whatever value it might bring is offset by the mental clutter of working with two syntaxes (since most code is still written in the original syntax). So I have stuck with original syntax quotations in this series, and recommended that you fall back to AST constructors when quotations don’t work out. However, the situation with original syntax quotations seems to have gotten worse in the upcoming OCaml 3.12.0 release (see bugs <a href='http://caml.inria.fr/mantis/view.php?id=5080'>5080</a> and <a href='http://caml.inria.fr/mantis/view.php?id=5104'>5104</a>).</p>
<p>These bugs affected my <a href='http://github.com/jaked/orpc'>orpc</a> and <a href='http://github.com/jaked/ocamljs'>ocamljs</a> projects, and I decided to use revised syntax quotations rather than uglying up the code with AST constructors. This turned out to be not so bad, requiring only a few changes. Fortunately, you can choose for each source file which kind to use (in ocamlbuild you can give the <code>pkg_camlp4.quotations.o</code> or <code>pkg_camlp4.quotations.r</code> tags per file), so I left quotations in files that were unaffected or only lightly affected in the original syntax.</p>
<p>I don’t have anything new to say about the revised syntax, but I want to point out the following resources:</p>
<ul>
<li><a href='http://caml.inria.fr/pub/docs/tutorial-camlp4/tutorial005.html'>tutorial and rationale (old camlp4)</a></li>
<li><a href='http://caml.inria.fr/pub/docs/manual-camlp4/manual007.html'>reference (old camlp4)</a></li>
<li><a href='http://brion.inria.fr/gallium/index.php/Revised'>wiki page (new camlp4)</a></li>
</ul>
<p>The final word on the revised syntax is of course the parser itself, found in <code>Camlp4OCamlRevisedParser.ml</code>; you may find these <a href='http://ambassadortothecomputers.blogspot.com/2009/01/reading-camlp4-part-3-quotations-in.html'>earlier</a> <a href='http://ambassadortothecomputers.blogspot.com/2010/05/reading-camlp4-part-6-parsing.html'>posts</a> useful in making sense of it.</p>Jake Donhamhttp://www.blogger.com/profile/04768087689799941690noreply@blogger.com0tag:blogger.com,1999:blog-1445545651031573301.post-90958207930101743342010-05-19T21:22:00.000-07:002010-09-03T15:53:54.395-07:00Reading Camlp4, part 6: parsing<p>In this post I want to discuss Camlp4’s <em>stream parsers</em> and <em>grammars</em>. Since the OCaml parsers in Camlp4 (which we touched on <a href='http://ambassadortothecomputers.blogspot.com/2009/01/reading-camlp4-part-3-quotations-in.html'>previously</a>) use them, it’s necessary to understand them in order to write syntax extensions; independently, they are a nice alternative to <code>ocamlyacc</code> and other parser generators. Stream parsers and grammars are outlined for the old Camlp4 in the <a href='http://caml.inria.fr/pub/docs/tutorial-camlp4/'>tutorial</a> and <a href='http://caml.inria.fr/pub/docs/manual-camlp4/'>manual</a>, but some of the details have changed, and there are many aspects of grammars which are given only a glancing treatment in that material.</p>
<b>Streams and stream parsers</b>
<p>Parsers generated from Camlp4 grammars are built on stream parsers, so let’s start there. It will be easier to explain grammars with this background in hand, and we will see that it is sometimes useful to drop down to stream parsers when writing grammars.</p>
<p>A <em>stream</em> of type <code>'a Stream.t</code> is a sequence of elements of type <code>'a</code>. Elements of a stream are accessed sequentially; reading the first element of a stream has the side effect of advancing the stream to the next element. You can also peek ahead into a stream without advancing it. Camlp4 provides a syntax extension for working with streams, which expands to operations on the <a href='http://caml.inria.fr/pub/docs/manual-ocaml/libref/Stream.html'>Stream</a> module of the standard library.</p>
<p>There are various ways to make a stream but we’ll focus on consuming them; for testing you can make a literal stream with the syntax <code>[< '"foo"; '"bar"; '"baz" >]</code>—note the extra single-quotes. With the <code>parser</code> keyword we can write a function to consume a stream by pattern-matching over prefixes of the stream:</p>
<div class='highlight'><pre><code class='ocaml'><span class='k'>let</span> <span class='k'>rec</span> <span class='n'>p</span> <span class='o'>=</span> <span class='n'>parser</span>
<span class='o'>|</span> <span class='o'>[<</span> <span class='k'>'</span><span class='s2'>"foo"</span><span class='o'>;</span> <span class='k'>'</span><span class='n'>x</span><span class='o'>;</span> <span class='k'>'</span><span class='s2'>"bar"</span> <span class='o'>>]</span> <span class='o'>-></span> <span class='s2'>"foo-bar+"</span> <span class='o'>^</span> <span class='n'>x</span>
<span class='o'>|</span> <span class='o'>[<</span> <span class='k'>'</span><span class='s2'>"baz"</span><span class='o'>;</span> <span class='n'>y</span> <span class='o'>=</span> <span class='n'>p</span> <span class='o'>>]</span> <span class='o'>-></span> <span class='s2'>"baz+"</span> <span class='o'>^</span> <span class='n'>y</span>
</code></pre>
</div>
<p>The syntax <code>'"foo"</code> means match a value <code>"foo"</code>; <code>'x</code> means match any value, binding it to <code>x</code>, which can be used on the right-hand side of the match as usual; and <code>y = p</code> means call the parser <code>p</code> on the rest of the stream, binding the result to <code>y</code>. You probably get the rough idea, but let’s run it through Camlp4 to see exactly what’s happening:</p>
<div class='highlight'><pre><code class='ocaml'><span class='k'>let</span> <span class='k'>rec</span> <span class='n'>p</span> <span class='o'>(__</span><span class='n'>strm</span> <span class='o'>:</span> <span class='o'>_</span> <span class='nn'>Stream</span><span class='p'>.</span><span class='n'>t</span><span class='o'>)</span> <span class='o'>=</span>
<span class='k'>match</span> <span class='nn'>Stream</span><span class='p'>.</span><span class='n'>peek</span> <span class='o'>__</span><span class='n'>strm</span> <span class='k'>with</span>
<span class='o'>|</span> <span class='nc'>Some</span> <span class='s2'>"foo"</span> <span class='o'>-></span>
<span class='o'>(</span><span class='nn'>Stream</span><span class='p'>.</span><span class='n'>junk</span> <span class='o'>__</span><span class='n'>strm</span><span class='o'>;</span>
<span class='o'>(</span><span class='k'>match</span> <span class='nn'>Stream</span><span class='p'>.</span><span class='n'>peek</span> <span class='o'>__</span><span class='n'>strm</span> <span class='k'>with</span>
<span class='o'>|</span> <span class='nc'>Some</span> <span class='n'>x</span> <span class='o'>-></span>
<span class='o'>(</span><span class='nn'>Stream</span><span class='p'>.</span><span class='n'>junk</span> <span class='o'>__</span><span class='n'>strm</span><span class='o'>;</span>
<span class='o'>(</span><span class='k'>match</span> <span class='nn'>Stream</span><span class='p'>.</span><span class='n'>peek</span> <span class='o'>__</span><span class='n'>strm</span> <span class='k'>with</span>
<span class='o'>|</span> <span class='nc'>Some</span> <span class='s2'>"bar"</span> <span class='o'>-></span> <span class='o'>(</span><span class='nn'>Stream</span><span class='p'>.</span><span class='n'>junk</span> <span class='o'>__</span><span class='n'>strm</span><span class='o'>;</span> <span class='s2'>"foo-bar+"</span> <span class='o'>^</span> <span class='n'>x</span><span class='o'>)</span>
<span class='o'>|</span> <span class='o'>_</span> <span class='o'>-></span> <span class='k'>raise</span> <span class='o'>(</span><span class='nn'>Stream</span><span class='p'>.</span><span class='nc'>Error</span> <span class='s2'>""</span><span class='o'>)))</span>
<span class='o'>|</span> <span class='o'>_</span> <span class='o'>-></span> <span class='k'>raise</span> <span class='o'>(</span><span class='nn'>Stream</span><span class='p'>.</span><span class='nc'>Error</span> <span class='s2'>""</span><span class='o'>)))</span>
<span class='o'>|</span> <span class='nc'>Some</span> <span class='s2'>"baz"</span> <span class='o'>-></span>
<span class='o'>(</span><span class='nn'>Stream</span><span class='p'>.</span><span class='n'>junk</span> <span class='o'>__</span><span class='n'>strm</span><span class='o'>;</span>
<span class='k'>let</span> <span class='n'>y</span> <span class='o'>=</span>
<span class='o'>(</span><span class='k'>try</span> <span class='n'>p</span> <span class='o'>__</span><span class='n'>strm</span>
<span class='k'>with</span> <span class='o'>|</span> <span class='nn'>Stream</span><span class='p'>.</span><span class='nc'>Failure</span> <span class='o'>-></span> <span class='k'>raise</span> <span class='o'>(</span><span class='nn'>Stream</span><span class='p'>.</span><span class='nc'>Error</span> <span class='s2'>""</span><span class='o'>))</span>
<span class='k'>in</span> <span class='s2'>"baz+"</span> <span class='o'>^</span> <span class='n'>y</span><span class='o'>)</span>
<span class='o'>|</span> <span class='o'>_</span> <span class='o'>-></span> <span class='k'>raise</span> <span class='nn'>Stream</span><span class='p'>.</span><span class='nc'>Failure</span>
</code></pre>
</div>
<p>We can see that “parser” is perhaps a strong word for this construct; it’s really just a nested pattern match. The generated function <code>peek</code>s the next element in the stream, then <code>junk</code>s it once it finds a match (advancing the stream to the next element). If there’s no match on the first token, that’s a <code>Stream.Failure</code> (the stream is not advanced, giving us the opportunity to try another parser); but once we have matched the first token, a subsequent match failure is a <code>Stream.Error</code> (we have committed to a branch, and advanced the stream; if the parse fails now we can’t try another parser).</p>
<p>A call to another parser as the first element of the pattern is treated specially: for this input</p>
<div class='highlight'><pre><code class='ocaml'><span class='k'>let</span> <span class='k'>rec</span> <span class='n'>p</span> <span class='o'>=</span> <span class='n'>parser</span>
<span class='o'>|</span> <span class='o'>[<</span> <span class='n'>x</span> <span class='o'>=</span> <span class='n'>q</span> <span class='o'>>]</span> <span class='o'>-></span> <span class='n'>x</span>
<span class='o'>|</span> <span class='o'>[<</span> <span class='k'>'</span><span class='s2'>"bar"</span> <span class='o'>>]</span> <span class='o'>-></span> <span class='s2'>"bar"</span>
</code></pre>
</div>
<p>we get</p>
<div class='highlight'><pre><code class='ocaml'><span class='k'>let</span> <span class='k'>rec</span> <span class='n'>p</span> <span class='o'>(__</span><span class='n'>strm</span> <span class='o'>:</span> <span class='o'>_</span> <span class='nn'>Stream</span><span class='p'>.</span><span class='n'>t</span><span class='o'>)</span> <span class='o'>=</span>
<span class='k'>try</span> <span class='n'>q</span> <span class='o'>__</span><span class='n'>strm</span>
<span class='k'>with</span>
<span class='o'>|</span> <span class='nn'>Stream</span><span class='p'>.</span><span class='nc'>Failure</span> <span class='o'>-></span>
<span class='o'>(</span><span class='k'>match</span> <span class='nn'>Stream</span><span class='p'>.</span><span class='n'>peek</span> <span class='o'>__</span><span class='n'>strm</span> <span class='k'>with</span>
<span class='o'>|</span> <span class='nc'>Some</span> <span class='s2'>"bar"</span> <span class='o'>-></span> <span class='o'>(</span><span class='nn'>Stream</span><span class='p'>.</span><span class='n'>junk</span> <span class='o'>__</span><span class='n'>strm</span><span class='o'>;</span> <span class='s2'>"bar"</span><span class='o'>)</span>
<span class='o'>|</span> <span class='o'>_</span> <span class='o'>-></span> <span class='k'>raise</span> <span class='nn'>Stream</span><span class='p'>.</span><span class='nc'>Failure</span><span class='o'>)</span>
</code></pre>
</div>
<p>So there is a limited means of backtracking: if <code>q</code> fails with <code>Stream.Failure</code> (meaning that the stream has not been advanced) we try the next arm of the parser.</p>
<p>It’s easy to see what would happen if we were to use the same literal as the first element of more than one arm: the first one gets the match. Same if we were to make a recursive call (to the same parser) as the first element: we’d get an infinite loop, since it’s just a function call. So we can’t give arbitrary BNF-like grammars to <code>parser</code>. We could use it as a convenient way to hand-write a recursive-descent parser, but we won’t pursue that idea here. Instead, let’s turn to Camlp4’s grammars, which specify a recursive-descent parser using a BNF-like syntax.</p>
<b>Grammars</b>
<p>Here is a complete example of a grammar:</p>
<div class='highlight'><pre><code class='ocaml'><span class='k'>open</span> <span class='nn'>Camlp4</span><span class='p'>.</span><span class='nc'>PreCast</span>
<span class='k'>module</span> <span class='nc'>Gram</span> <span class='o'>=</span> <span class='nc'>MakeGram</span><span class='o'>(</span><span class='nc'>Lexer</span><span class='o'>)</span>
<span class='k'>let</span> <span class='n'>expr</span> <span class='o'>=</span> <span class='nn'>Gram</span><span class='p'>.</span><span class='nn'>Entry</span><span class='p'>.</span><span class='n'>mk</span> <span class='s2'>"expr"</span>
<span class='nc'>EXTEND</span> <span class='nc'>Gram</span>
<span class='n'>expr</span><span class='o'>:</span>
<span class='o'>[[</span>
<span class='s2'>"foo"</span><span class='o'>;</span> <span class='n'>x</span> <span class='o'>=</span> <span class='nc'>LIDENT</span><span class='o'>;</span> <span class='s2'>"bar"</span> <span class='o'>-></span> <span class='s2'>"foo-bar+"</span> <span class='o'>^</span> <span class='n'>x</span>
<span class='o'>|</span> <span class='s2'>"baz"</span><span class='o'>;</span> <span class='n'>y</span> <span class='o'>=</span> <span class='n'>expr</span> <span class='o'>-></span> <span class='s2'>"baz+"</span> <span class='o'>^</span> <span class='n'>y</span>
<span class='o'>]];</span>
<span class='nc'>END</span>
<span class='o'>;;</span>
<span class='k'>try</span>
<span class='n'>print_endline</span>
<span class='o'>(</span><span class='nn'>Gram</span><span class='p'>.</span><span class='n'>parse_string</span> <span class='n'>expr</span> <span class='nn'>Loc</span><span class='p'>.</span><span class='n'>ghost</span> <span class='nn'>Sys</span><span class='p'>.</span><span class='n'>argv</span><span class='o'>.(</span><span class='mi'>1</span><span class='o'>))</span>
<span class='k'>with</span> <span class='nn'>Loc</span><span class='p'>.</span><span class='nc'>Exc_located</span> <span class='o'>(_,</span> <span class='n'>x</span><span class='o'>)</span> <span class='o'>-></span> <span class='k'>raise</span> <span class='n'>x</span>
</code></pre>
</div>
<p>You can build it with the following command:</p>
<div class='highlight'><pre><code class='bash'>ocamlfind ocamlc <span class='se'>\</span>
-linkpkg -syntax camlp4o <span class='se'>\</span>
-package camlp4.extend -package camlp4.lib <span class='se'>\</span>
grammar1.ml -o grammar1
</code></pre>
</div>
<p>Let’s cover the infrastructure before investigating <code>EXTEND</code>. We have a grammar module <code>Gram</code> which we got from <code>Camlp4.PreCast</code>; this is an empty grammar using a default lexer. We have an <em>entry</em> (a grammar nonterminal) <code>expr</code>, which is an OCaml value. We can parse a string starting at an entry using <code>Gram.parse_string</code> (we have to pass it an initial location). We trap <code>Loc.Exc_located</code> (which attaches a location to exceptions raised in parsing) and re-raise the underlying exception so it gets printed. (In subsequent examples I will give just the <code>EXTEND</code> block.)</p>
<p>One way to approach <code>EXTEND</code> is to run the file through Camlp4 (<code>camlp4of</code> has the required syntax extension) to see what we get. This is fun, but the result does not yield much insight; it’s just a simple transformation of the input, passed to <code>Gram.extend</code>. This is the entry point to a pretty hairy bunch of code that generates a recursive descent parser from the value representing the grammar. Let’s take a different tack: <a href='http://caml.inria.fr/pub/docs/manual-camlp4/manual005.html'>RTFM</a>, then run some experiments to shine light in places where the fine manual is a bit dim.</p>
<p>First, what language is parsed by the grammar above? It looks pretty similar to the stream parser example. But what is <code>LIDENT</code>? The stream parser example works with a stream of strings. Here we are working with a stream of tokens, produced by the <code>Lexer</code> module; there is a variant defining the token types in <code>PreCast.mli</code>. The default lexer is OCaml-specific (but it’s often good enough for other purposes); a <code>LIDENT</code> is an OCaml lowercase identifier. A literal string (like <code>"foo"</code>) indicates a <code>KEYWORD</code> token; using it in a grammar registers the keyword with the lexer. So the grammar can parse strings like <code>foo quux bar</code> or <code>baz foo quux bar</code>, but not <code>foo bar bar</code>, since <code>bar</code> is a <code>KEYWORD</code> not a <code>LIDENT</code>.</p>
<p>Most tokens have associated strings; <code>x = LIDENT</code> puts the associated string in <code>x</code>. Keywords are given in double quotes (<code>x = KEYWORD</code> works, but I can’t think of a good use for it). You can also use pattern-matching syntax (e.g. <code>`LIDENT x</code>) to get at the actual token constructor, which may carry more than just a string.</p>
<p>You can try the example and see that the lexer takes care of whitespace and OCaml comments. You’ll also notice that the parser ignores extra tokens after a successful parse; to avoid it we need an <code>EOI</code> token to indicate the end of the input (but I haven’t bothered here).</p>
<b>Left-factoring</b>
<p>What happens if two rules start with the same token?</p>
<div class='highlight'><pre><code class='ocaml'><span class='nc'>EXTEND</span> <span class='nc'>Gram</span>
<span class='n'>expr</span><span class='o'>:</span>
<span class='o'>[[</span>
<span class='s2'>"foo"</span><span class='o'>;</span> <span class='s2'>"bar"</span> <span class='o'>-></span> <span class='s2'>"foo+bar"</span>
<span class='o'>|</span> <span class='s2'>"foo"</span><span class='o'>;</span> <span class='s2'>"baz"</span> <span class='o'>-></span> <span class='s2'>"foo+baz"</span>
<span class='o'>]];</span>
<span class='nc'>END</span>
</code></pre>
</div>
<p>If this were a stream parser, the first arm would always match when the next token is <code>foo</code>; if the subsequent token is <code>baz</code> then the parse fails. But with a grammar, the <em>rule</em>s (arms, for a grammar) are <em>left-factored</em>: when there is a common prefix of <em>symbol</em>s (a symbol is a keyword, token, or entry—and we will see some others later) among different rules, the parser doesn’t choose which rule to use until the common prefix has been parsed. You can think of a factored grammar as a tree, where the nodes are symbols and the leaves are <em>action</em>s (the right-hand side of a rule is the rule’s action); when a symbol distinguishes two rules, that’s a branching point. (In fact, this is how grammars are implemented: first the corresponding tree is generated, then the parser is generated from the tree.)</p>
<p>What if one rule is a prefix of another?</p>
<div class='highlight'><pre><code class='ocaml'><span class='nc'>EXTEND</span> <span class='nc'>Gram</span>
<span class='n'>expr</span><span class='o'>:</span>
<span class='o'>[[</span>
<span class='s2'>"foo"</span><span class='o'>;</span> <span class='s2'>"bar"</span> <span class='o'>-></span> <span class='s2'>"foo+bar"</span>
<span class='o'>|</span> <span class='s2'>"foo"</span><span class='o'>;</span> <span class='s2'>"bar"</span><span class='o'>;</span> <span class='s2'>"baz"</span> <span class='o'>-></span> <span class='s2'>"foo+bar+baz"</span>
<span class='o'>]];</span>
<span class='nc'>END</span>
</code></pre>
</div>
<p>In this case the parser is greedy: if the next token is <code>baz</code>, it uses the second rule, otherwise the first. To put it another way, a token or keyword is preferred over <em>epsilon</em>, the empty string (and this holds for other ways that a grammar can match epsilon—see below about special symbols).</p>
<p>What if two rules call the same entry?</p>
<div class='highlight'><pre><code class='ocaml'><span class='nc'>EXTEND</span> <span class='nc'>Gram</span>
<span class='nc'>GLOBAL</span><span class='o'>:</span> <span class='n'>expr</span><span class='o'>;</span>
<span class='n'>f</span><span class='o'>:</span> <span class='o'>[[</span> <span class='s2'>"quux"</span> <span class='o'>]];</span>
<span class='n'>expr</span><span class='o'>:</span>
<span class='o'>[[</span>
<span class='s2'>"foo"</span><span class='o'>;</span> <span class='n'>f</span><span class='o'>;</span> <span class='s2'>"bar"</span> <span class='o'>-></span> <span class='s2'>"foo+bar"</span>
<span class='o'>|</span> <span class='s2'>"foo"</span><span class='o'>;</span> <span class='n'>f</span><span class='o'>;</span> <span class='s2'>"baz"</span> <span class='o'>-></span> <span class='s2'>"foo+baz"</span>
<span class='o'>]];</span>
<span class='nc'>END</span>
</code></pre>
</div>
<p>First, what is this <code>GLOBAL</code>? By default, all entries are global, meaning that they must be pre-defined with <code>Gram.Entry.mk</code>. The <code>GLOBAL</code> declaration gives a list of entries which are global, and makes the rest local, so we don’t need to pre-define them, but we can’t refer to them outside the grammar. Second, note that we can call entries without binding the result to a variable, and that rules don’t need an action—in that case they return <code>()</code>. You can try it and see that factoring works on entries too. Maybe this is slightly surprising, if you’re thinking about the rules as parse-time alternatives, but factoring happens when the parser is built.</p>
<p>What about an entry vs. a token?</p>
<div class='highlight'><pre><code class='ocaml'><span class='nc'>EXTEND</span> <span class='nc'>Gram</span>
<span class='nc'>GLOBAL</span><span class='o'>:</span> <span class='n'>expr</span><span class='o'>;</span>
<span class='n'>f</span><span class='o'>:</span> <span class='o'>[[</span> <span class='s2'>"baz"</span> <span class='o'>]];</span>
<span class='n'>expr</span><span class='o'>:</span>
<span class='o'>[[</span>
<span class='s2'>"foo"</span><span class='o'>;</span> <span class='s2'>"bar"</span><span class='o'>;</span> <span class='n'>f</span> <span class='o'>-></span> <span class='s2'>"foo+bar"</span>
<span class='o'>|</span> <span class='s2'>"foo"</span><span class='o'>;</span> <span class='s2'>"bar"</span><span class='o'>;</span> <span class='s2'>"baz"</span> <span class='o'>-></span> <span class='s2'>"foo+bar+baz"</span>
<span class='o'>]];</span>
<span class='nc'>END</span>
</code></pre>
</div>
<p>Both rules parse the same language, but an explicit token or keyword trumps an entry or other symbol, so the second rule is used. You can try it and see that the order of the rules doesn’t matter.</p>
<p>What about two different entries?</p>
<div class='highlight'><pre><code class='ocaml'><span class='nc'>EXTEND</span> <span class='nc'>Gram</span>
<span class='nc'>GLOBAL</span><span class='o'>:</span> <span class='n'>expr</span><span class='o'>;</span>
<span class='n'>f1</span><span class='o'>:</span> <span class='o'>[[</span> <span class='s2'>"quux"</span> <span class='o'>]];</span>
<span class='n'>f2</span><span class='o'>:</span> <span class='o'>[[</span> <span class='s2'>"quux"</span> <span class='o'>]];</span>
<span class='n'>expr</span><span class='o'>:</span>
<span class='o'>[[</span>
<span class='s2'>"foo"</span><span class='o'>;</span> <span class='n'>f1</span><span class='o'>;</span> <span class='s2'>"bar"</span> <span class='o'>-></span> <span class='s2'>"foo+bar"</span>
<span class='o'>|</span> <span class='s2'>"foo"</span><span class='o'>;</span> <span class='n'>f2</span><span class='o'>;</span> <span class='s2'>"baz"</span> <span class='o'>-></span> <span class='s2'>"foo+baz"</span>
<span class='o'>]];</span>
<span class='nc'>END</span>
</code></pre>
</div>
<p>Factoring happens only within a rule, so the parser doesn’t know that <code>f1</code> and <code>f2</code> parse the same language. It commits to the first rule after parsing <code>foo</code>; if after parsing <code>quux</code> it then sees <code>baz</code>, it doesn’t backtrack and try the second rule, so the parse fails. If you switch the order of the rules, then <code>baz</code> succeeds but <code>bar</code> fails.</p>
<b>Local backtracking</b>
<p>Why have two identical entries in the previous example? If we make them different, something a little surprising happens:</p>
<div class='highlight'><pre><code class='ocaml'><span class='nc'>EXTEND</span> <span class='nc'>Gram</span>
<span class='nc'>GLOBAL</span><span class='o'>:</span> <span class='n'>expr</span><span class='o'>;</span>
<span class='n'>f1</span><span class='o'>:</span> <span class='o'>[[</span> <span class='s2'>"quux"</span> <span class='o'>]];</span>
<span class='n'>f2</span><span class='o'>:</span> <span class='o'>[[</span> <span class='s2'>"xyzzy"</span> <span class='o'>]];</span>
<span class='n'>expr</span><span class='o'>:</span>
<span class='o'>[[</span>
<span class='s2'>"foo"</span><span class='o'>;</span> <span class='n'>f1</span><span class='o'>;</span> <span class='s2'>"bar"</span> <span class='o'>-></span> <span class='s2'>"foo+bar"</span>
<span class='o'>|</span> <span class='s2'>"foo"</span><span class='o'>;</span> <span class='n'>f2</span><span class='o'>;</span> <span class='s2'>"baz"</span> <span class='o'>-></span> <span class='s2'>"foo+baz"</span>
<span class='o'>]];</span>
<span class='nc'>END</span>
</code></pre>
</div>
<p>Now we can parse both <code>foo quux bar</code> and <code>foo xyzzy baz</code>. How does this work? It takes a little digging into the implementation (which I will spare you) to see what’s happening: the <code>"foo"</code> keyword is factored into a common prefix, then we have a choice between <code>f1</code> and <code>f2</code>. A choice betwen entries generates a stream parser, with an arm for each entry which calls the entry’s parser. As we saw in the stream parsers sections, calling another parser in the first position of a match compiles to a limited form of backtracking. So in the example, if <code>f1</code> fails with <code>Stream.Failure</code> (which it does when the next token is not <code>quux</code>) then the parser tries to parse <code>f2</code> instead.</p>
<p>Local backtracking works only when the parser is at a branch point (e.g. a choice between two entries), and when the called entry does not itself commit and advance the stream (in which case <code>Stream.Error</code> is raised on a parse error instead of <code>Stream.Failure</code>). Here is an example that fails the first criterion:</p>
<div class='highlight'><pre><code class='ocaml'><span class='nc'>EXTEND</span> <span class='nc'>Gram</span>
<span class='nc'>GLOBAL</span><span class='o'>:</span> <span class='n'>expr</span><span class='o'>;</span>
<span class='n'>f1</span><span class='o'>:</span> <span class='o'>[[</span> <span class='s2'>"quux"</span> <span class='o'>]];</span>
<span class='n'>f2</span><span class='o'>:</span> <span class='o'>[[</span> <span class='s2'>"xyzzy"</span> <span class='o'>]];</span>
<span class='n'>g1</span><span class='o'>:</span> <span class='o'>[[</span> <span class='s2'>"plugh"</span> <span class='o'>]];</span>
<span class='n'>g2</span><span class='o'>:</span> <span class='o'>[[</span> <span class='s2'>"plugh"</span> <span class='o'>]];</span>
<span class='n'>expr</span><span class='o'>:</span>
<span class='o'>[[</span>
<span class='n'>g1</span><span class='o'>;</span> <span class='n'>f1</span> <span class='o'>-></span> <span class='s2'>"f1"</span>
<span class='o'>|</span> <span class='n'>g2</span><span class='o'>;</span> <span class='n'>f2</span> <span class='o'>-></span> <span class='s2'>"f2"</span>
<span class='o'>]];</span>
<span class='nc'>END</span>
</code></pre>
</div>
<p>After parsing <code>g1</code>, the parser has committed to the first rule, so it’s not possible to backtrack and try the second if <code>f1</code> fails.</p>
<p>Here’s an example that fails the second criterion:</p>
<div class='highlight'><pre><code class='ocaml'><span class='nc'>EXTEND</span> <span class='nc'>Gram</span>
<span class='nc'>GLOBAL</span><span class='o'>:</span> <span class='n'>expr</span><span class='o'>;</span>
<span class='n'>g</span><span class='o'>:</span> <span class='o'>[[</span> <span class='s2'>"plugh"</span> <span class='o'>]];</span>
<span class='n'>f1</span><span class='o'>:</span> <span class='o'>[[</span> <span class='n'>g</span><span class='o'>;</span> <span class='s2'>"quux"</span> <span class='o'>]];</span>
<span class='n'>f2</span><span class='o'>:</span> <span class='o'>[[</span> <span class='n'>g</span><span class='o'>;</span> <span class='s2'>"xyzzy"</span> <span class='o'>]];</span>
<span class='n'>expr</span><span class='o'>:</span>
<span class='o'>[[</span> <span class='n'>f1</span> <span class='o'>-></span> <span class='s2'>"f1"</span> <span class='o'>|</span> <span class='n'>f2</span> <span class='o'>-></span> <span class='s2'>"f2"</span> <span class='o'>]];</span>
<span class='nc'>END</span>
</code></pre>
</div>
<p>When <code>f1</code> is called, after parsing <code>g</code> the parser is committed to <code>f1</code>, so if the next token is not <code>quux</code> the parse fails rather than backtracking.</p>
<p>Local backtracking can be used to control parsing with explicit lookahead. We could repair the previous example as follows:</p>
<div class='highlight'><pre><code class='ocaml'><span class='k'>let</span> <span class='n'>test</span> <span class='o'>=</span>
<span class='nn'>Gram</span><span class='p'>.</span><span class='nn'>Entry</span><span class='p'>.</span><span class='n'>of_parser</span> <span class='s2'>"test"</span>
<span class='o'>(</span><span class='k'>fun</span> <span class='n'>strm</span> <span class='o'>-></span>
<span class='k'>match</span> <span class='nn'>Stream</span><span class='p'>.</span><span class='n'>npeek</span> <span class='mi'>2</span> <span class='n'>strm</span> <span class='k'>with</span>
<span class='o'>|</span> <span class='o'>[</span> <span class='o'>_;</span> <span class='nc'>KEYWORD</span> <span class='s2'>"xyzzy"</span><span class='o'>,</span> <span class='o'>_</span> <span class='o'>]</span> <span class='o'>-></span> <span class='k'>raise</span> <span class='nn'>Stream</span><span class='p'>.</span><span class='nc'>Failure</span>
<span class='o'>|</span> <span class='o'>_</span> <span class='o'>-></span> <span class='bp'>()</span><span class='o'>)</span>
<span class='nc'>EXTEND</span> <span class='nc'>Gram</span>
<span class='nc'>GLOBAL</span><span class='o'>:</span> <span class='n'>expr</span><span class='o'>;</span>
<span class='n'>g</span><span class='o'>:</span> <span class='o'>[[</span> <span class='s2'>"plugh"</span> <span class='o'>]];</span>
<span class='n'>f1</span><span class='o'>:</span> <span class='o'>[[</span> <span class='n'>g</span><span class='o'>;</span> <span class='s2'>"quux"</span> <span class='o'>]];</span>
<span class='n'>f2</span><span class='o'>:</span> <span class='o'>[[</span> <span class='n'>g</span><span class='o'>;</span> <span class='s2'>"xyzzy"</span> <span class='o'>]];</span>
<span class='n'>expr</span><span class='o'>:</span>
<span class='o'>[[</span> <span class='n'>test</span><span class='o'>;</span> <span class='n'>f1</span> <span class='o'>-></span> <span class='s2'>"f1"</span> <span class='o'>|</span> <span class='n'>f2</span> <span class='o'>-></span> <span class='s2'>"f2"</span> <span class='o'>]];</span>
<span class='nc'>END</span>
</code></pre>
</div>
<p>We create an entry from a stream parser with <code>Gram.Entry.of_parser</code>. This could do some useful parsing and return a value just like any other entry, but here we just want to cause a backtrack (by raising <code>Stream.Failure</code>) if the token <em>after</em> the next one is <code>xyzzy</code>. We can see it with <code>Stream.npeek 2</code>, which returns the next two tokens, but does not advance the stream. (The stream parser syntax is not useful here since it advances the stream on a match.) You can see several examples of this technique in <code>Camlp4OCamlParser.ml</code>.</p>
<p>We have seen that for stream parsers, a match of a sequence of literals compiles to a nested pattern match; as soon as the first literal matches, we’re committed to that arm. With grammars, however, a sequence of tokens (or keywords) is matched all at once: enough tokens are <code>peek</code>ed; if all match then the stream is advanced past all of them; if any fail to match, <code>Stream.Failure</code> is raised. So in the first example of this section, <code>f1</code> could be any sequence of tokens, and local backtracking would still work. Or it could be a sequence of tokens followed by some non-tokens; as long as the failure happens in the sequence of tokens, local backtracking would still work.</p>
<b>Self-calls</b>
<p>Consider the following grammar:</p>
<div class='highlight'><pre><code class='ocaml'><span class='nc'>EXTEND</span> <span class='nc'>Gram</span>
<span class='nc'>GLOBAL</span><span class='o'>:</span> <span class='n'>expr</span><span class='o'>;</span>
<span class='n'>b</span><span class='o'>:</span> <span class='o'>[[</span> <span class='s2'>"b"</span> <span class='o'>]];</span>
<span class='n'>expr</span><span class='o'>:</span>
<span class='o'>[[</span> <span class='n'>expr</span><span class='o'>;</span> <span class='s2'>"a"</span> <span class='o'>-></span> <span class='s2'>"a"</span> <span class='o'>|</span> <span class='n'>b</span> <span class='o'>-></span> <span class='s2'>"b"</span> <span class='o'>]];</span>
<span class='nc'>END</span>
</code></pre>
</div>
<p>We’ve seen that a choice of entries generates a stream parser with an arm for each entry, and also that a call to another parser in a stream parser match is just a function call. So it seems like the parser should go into a loop before parsing anything.</p>
<p>However, Camlp4 gives calls to the entry being defined (“self-calls”) special treatment. The rules of an entry actually generate two parsers, the “start” and “continue” parsers (these names are taken from the code). When a self-call appears as the first symbol of a rule, the rest of the rule goes into the continue parser; otherwise the whole rule goes into the start parser. An entry is parsed starting with the start parser; a successful parse is followed by the continue parser. So in the example, we first parse using just the second rule, to get things off the ground, then parse using just the first rule. If there are no start rules (that is, all rules begin with self-calls) the parser doesn’t loop, but it fails without parsing anything.</p>
<b>Levels and precedence</b>
<p>I am sorry to say that I have not been completely honest with you. I have made it seem like entries consist of a list of rules in double square brackets. In fact, entries are lists of <em>level</em>s, in single square brackets, and each level consists of a list of rules, also in single square brackets. So each of the examples so far has contained only a single level. Here is an example with multiple levels:</p>
<div class='highlight'><pre><code class='ocaml'><span class='nc'>EXTEND</span> <span class='nc'>Gram</span>
<span class='n'>expr</span><span class='o'>:</span>
<span class='o'>[</span> <span class='o'>[</span> <span class='n'>x</span> <span class='o'>=</span> <span class='n'>expr</span><span class='o'>;</span> <span class='s2'>"+"</span><span class='o'>;</span> <span class='n'>y</span> <span class='o'>=</span> <span class='n'>expr</span> <span class='o'>-></span> <span class='n'>x</span> <span class='o'>+</span> <span class='n'>y</span>
<span class='o'>|</span> <span class='n'>x</span> <span class='o'>=</span> <span class='n'>expr</span><span class='o'>;</span> <span class='s2'>"-"</span><span class='o'>;</span> <span class='n'>y</span> <span class='o'>=</span> <span class='n'>expr</span> <span class='o'>-></span> <span class='n'>x</span> <span class='o'>-</span> <span class='n'>y</span> <span class='o'>]</span>
<span class='o'>|</span> <span class='o'>[</span> <span class='n'>x</span> <span class='o'>=</span> <span class='n'>expr</span><span class='o'>;</span> <span class='s2'>"*"</span><span class='o'>;</span> <span class='n'>y</span> <span class='o'>=</span> <span class='n'>expr</span> <span class='o'>-></span> <span class='n'>x</span> <span class='o'>*</span> <span class='n'>y</span>
<span class='o'>|</span> <span class='n'>x</span> <span class='o'>=</span> <span class='n'>expr</span><span class='o'>;</span> <span class='s2'>"/"</span><span class='o'>;</span> <span class='n'>y</span> <span class='o'>=</span> <span class='n'>expr</span> <span class='o'>-></span> <span class='n'>x</span> <span class='o'>/</span> <span class='n'>y</span> <span class='o'>]</span>
<span class='o'>|</span> <span class='o'>[</span> <span class='n'>x</span> <span class='o'>=</span> <span class='nc'>INT</span> <span class='o'>-></span> <span class='n'>int_of_string</span> <span class='n'>x</span>
<span class='o'>|</span> <span class='s2'>"("</span><span class='o'>;</span> <span class='n'>e</span> <span class='o'>=</span> <span class='n'>expr</span><span class='o'>;</span> <span class='s2'>")"</span> <span class='o'>-></span> <span class='n'>e</span> <span class='o'>]</span> <span class='o'>];</span>
<span class='nc'>END</span>
</code></pre>
</div>
<p>(You’ll need a <code>string_of_int</code> to use this grammar with the earlier framework.) The idea with levels is that parsing begins at the topmost level; if no rule applies in the current level, then the next level down is tried. Furthermore, when making a self-call, call at the current level (or the following level; see below) rather than at the top. This gives a way to implement operator precedence: order the operators top to bottom from loosest- to tightest-binding.</p>
<p>Why does this work? The multi-level grammar is just a “stratified” grammar, with a little extra support from Camlp4; we could write it manually like this:</p>
<div class='highlight'><pre><code class='ocaml'><span class='nc'>EXTEND</span> <span class='nc'>Gram</span>
<span class='nc'>GLOBAL</span><span class='o'>:</span> <span class='n'>expr</span><span class='o'>;</span>
<span class='n'>add_expr</span><span class='o'>:</span>
<span class='o'>[[</span>
<span class='n'>x</span> <span class='o'>=</span> <span class='n'>add_expr</span><span class='o'>;</span> <span class='s2'>"+"</span><span class='o'>;</span> <span class='n'>y</span> <span class='o'>=</span> <span class='n'>mul_expr</span> <span class='o'>-></span> <span class='n'>x</span> <span class='o'>+</span> <span class='n'>y</span>
<span class='o'>|</span> <span class='n'>x</span> <span class='o'>=</span> <span class='n'>add_expr</span><span class='o'>;</span> <span class='s2'>"-"</span><span class='o'>;</span> <span class='n'>y</span> <span class='o'>=</span> <span class='n'>mul_expr</span> <span class='o'>-></span> <span class='n'>x</span> <span class='o'>-</span> <span class='n'>y</span>
<span class='o'>|</span> <span class='n'>x</span> <span class='o'>=</span> <span class='n'>mul_expr</span> <span class='o'>-></span> <span class='n'>x</span>
<span class='o'>]];</span>
<span class='n'>mul_expr</span><span class='o'>:</span>
<span class='o'>[[</span>
<span class='n'>x</span> <span class='o'>=</span> <span class='n'>mul_expr</span><span class='o'>;</span> <span class='s2'>"*"</span><span class='o'>;</span> <span class='n'>y</span> <span class='o'>=</span> <span class='n'>base_expr</span> <span class='o'>-></span> <span class='n'>x</span> <span class='o'>*</span> <span class='n'>y</span>
<span class='o'>|</span> <span class='n'>x</span> <span class='o'>=</span> <span class='n'>mul_expr</span><span class='o'>;</span> <span class='s2'>"/"</span><span class='o'>;</span> <span class='n'>y</span> <span class='o'>=</span> <span class='n'>base_expr</span> <span class='o'>-></span> <span class='n'>x</span> <span class='o'>/</span> <span class='n'>y</span>
<span class='o'>|</span> <span class='n'>x</span> <span class='o'>=</span> <span class='n'>base_expr</span> <span class='o'>-></span> <span class='n'>x</span>
<span class='o'>]];</span>
<span class='n'>base_expr</span><span class='o'>:</span>
<span class='o'>[[</span>
<span class='n'>x</span> <span class='o'>=</span> <span class='nc'>INT</span> <span class='o'>-></span> <span class='n'>int_of_string</span> <span class='n'>x</span>
<span class='o'>|</span> <span class='s2'>"("</span><span class='o'>;</span> <span class='n'>e</span> <span class='o'>=</span> <span class='n'>add_expr</span><span class='o'>;</span> <span class='s2'>")"</span> <span class='o'>-></span> <span class='n'>e</span>
<span class='o'>]];</span>
<span class='n'>expr</span><span class='o'>:</span> <span class='o'>[[</span> <span class='n'>add_expr</span> <span class='o'>]];</span>
<span class='nc'>END</span>
</code></pre>
</div>
<p>When parsing a <code>mul_expr</code>, for instance, we don’t want to parse an <code>add_expr</code> as a subexpression; <code>1 * 2 + 3</code> should not parse as <code>1 * (2 + 3)</code>. A stratified grammar just leaves out the rules for lower-precedence operators at each level. Why do we call <code>add_expr</code> on the left side of <code>+</code> but <code>mul_expr</code> on the right? This makes <code>+</code> left-associative; we parse <code>1 + 2 + 3</code> as <code>(1 + 2) + 3</code> since <code>add_expr</code> is a possibility only on the left. (For an ordinary recursive-descent parser we’d want right-associativity to prevent looping, although the special treatment of self-calls makes the left-associative version work here.)</p>
<p>Associativity works just the same with the multi-level grammar. By default, levels are left-associative: in the start parser (for a self-call as the first symbol of the rule), the self-call is made at the same level; in the continue parser, self-calls are made at the following level. For right-associativity it’s the reverse, and for non-associativity both start and continue parsers call the following level. The associativity of a level can be specified by prefixing it with the keywords <code>NONA</code>, <code>LEFTA</code>, or <code>RIGHTA</code>. (Either I don’t understand what non-associativity means, or <code>NONA</code> is broken; it seems to be the same as <code>LEFTA</code>.)</p>
<p>Levels may be labelled, and the level to call may be given explicitly. So another way to write the same grammar is:</p>
<div class='highlight'><pre><code class='ocaml'><span class='nc'>EXTEND</span> <span class='nc'>Gram</span>
<span class='n'>expr</span><span class='o'>:</span>
<span class='o'>[</span> <span class='s2'>"add"</span>
<span class='o'>[</span> <span class='n'>x</span> <span class='o'>=</span> <span class='n'>expr</span> <span class='nc'>LEVEL</span> <span class='s2'>"mul"</span><span class='o'>;</span> <span class='s2'>"+"</span><span class='o'>;</span> <span class='n'>y</span> <span class='o'>=</span> <span class='n'>expr</span> <span class='nc'>LEVEL</span> <span class='s2'>"add"</span> <span class='o'>-></span> <span class='n'>x</span> <span class='o'>+</span> <span class='n'>y</span>
<span class='o'>|</span> <span class='n'>x</span> <span class='o'>=</span> <span class='n'>expr</span> <span class='nc'>LEVEL</span> <span class='s2'>"mul"</span><span class='o'>;</span> <span class='s2'>"-"</span><span class='o'>;</span> <span class='n'>y</span> <span class='o'>=</span> <span class='n'>expr</span> <span class='nc'>LEVEL</span> <span class='s2'>"add"</span> <span class='o'>-></span> <span class='n'>x</span> <span class='o'>-</span> <span class='n'>y</span>
<span class='o'>|</span> <span class='n'>x</span> <span class='o'>=</span> <span class='n'>expr</span> <span class='nc'>LEVEL</span> <span class='s2'>"mul"</span> <span class='o'>-></span> <span class='n'>x</span> <span class='o'>]</span>
<span class='o'>|</span> <span class='s2'>"mul"</span>
<span class='o'>[</span> <span class='n'>x</span> <span class='o'>=</span> <span class='n'>expr</span> <span class='nc'>LEVEL</span> <span class='s2'>"base"</span><span class='o'>;</span> <span class='s2'>"*"</span><span class='o'>;</span> <span class='n'>y</span> <span class='o'>=</span> <span class='n'>expr</span> <span class='nc'>LEVEL</span> <span class='s2'>"mul"</span> <span class='o'>-></span> <span class='n'>x</span> <span class='o'>*</span> <span class='n'>y</span>
<span class='o'>|</span> <span class='n'>x</span> <span class='o'>=</span> <span class='n'>expr</span> <span class='nc'>LEVEL</span> <span class='s2'>"base"</span><span class='o'>;</span> <span class='s2'>"/"</span><span class='o'>;</span> <span class='n'>y</span> <span class='o'>=</span> <span class='n'>expr</span> <span class='nc'>LEVEL</span> <span class='s2'>"mul"</span> <span class='o'>-></span> <span class='n'>x</span> <span class='o'>/</span> <span class='n'>y</span>
<span class='o'>|</span> <span class='n'>x</span> <span class='o'>=</span> <span class='n'>expr</span> <span class='nc'>LEVEL</span> <span class='s2'>"base"</span> <span class='o'>-></span> <span class='n'>x</span> <span class='o'>]</span>
<span class='o'>|</span> <span class='s2'>"base"</span>
<span class='o'>[</span> <span class='n'>x</span> <span class='o'>=</span> <span class='nc'>INT</span> <span class='o'>-></span> <span class='n'>int_of_string</span> <span class='n'>x</span>
<span class='o'>|</span> <span class='s2'>"["</span><span class='o'>;</span> <span class='n'>e</span> <span class='o'>=</span> <span class='n'>expr</span><span class='o'>;</span> <span class='s2'>"]"</span> <span class='o'>-></span> <span class='n'>e</span> <span class='o'>]</span> <span class='o'>];</span>
<span class='nc'>END</span>
</code></pre>
</div>
<p>(Unfortunately, the left-associative version of this loops; explicitly specifying a level when calling an entry defeats the start / continue mechanism, since the call is not recognized as a self-call.) Calls to explicit levels can be used when calling other entries, too, not just for self calls. Level names are also useful for extending grammars, although we won’t cover that here.</p>
<b>Special symbols</b>
<p>There are several special symbols: <code>SELF</code> refers to the entry being defined (at the current or following level depending on the associativity and the position of the symbol in the rule, as above); <code>NEXT</code> refers to the entry being defined, at the following level regardless of associativity or position.</p>
<p>A list of zero or more items can be parsed with the syntax <code>LIST0</code> <em>elem</em>, where <em>elem</em> can be any other symbol. The return value has type <code>'a list</code> when <em>elem</em> has type <code>'a</code>. To parse separators between the elements use <code>LIST0</code> <em>elem</em> <code>SEP</code> <em>sep</em>; again <em>sep</em> can be any other symbol. <code>LIST1</code> means parse one or more items. An optional item can be parsed with <code>OPT</code> <em>elem</em>; the return value has type <code>'a
option</code>. (Both <code>LIST0</code> and <code>OPT</code> can match the empty string; see the note above about the treatment of epsilon.)</p>
<p>Finally, a nested set of rules may appear in a rule, and acts like an anonymous entry (but can have only one level). For example, the rule</p>
<div class='highlight'><pre><code class='ocaml'> <span class='n'>x</span> <span class='o'>=</span> <span class='n'>expr</span><span class='o'>;</span> <span class='o'>[</span><span class='s2'>"+"</span> <span class='o'>|</span> <span class='s2'>"plus"</span><span class='o'>];</span> <span class='n'>y</span> <span class='o'>=</span> <span class='n'>expr</span> <span class='o'>-></span> <span class='n'>x</span> <span class='o'>+</span> <span class='n'>y</span>
</code></pre>
</div>
<p>parses both <code>1 + 2</code> and <code>1 plus 2</code>.</p>
<p>Addendum: A new special symbol appeared in the 3.12.0 release, <code>TRY</code> <em>elem</em>, which provides non-local backtracking: a <code>Stream.Error</code> occurring in <em>elem</em> is converted to a <code>Stream.Failure</code>. (It works by running <em>elem</em> on an on-demand copy of the token stream; tokens are not consumed from the real token stream until <em>elem</em> succeeds.) <code>TRY</code> replaces most (all?) cases where you’d need to drop down to a stream parser for lookahead. So another way to fix the local backtracking example above is:</p>
<div class='highlight'><pre><code class='ocaml'><span class='nc'>EXTEND</span> <span class='nc'>Gram</span>
<span class='nc'>GLOBAL</span><span class='o'>:</span> <span class='n'>expr</span><span class='o'>;</span>
<span class='n'>g</span><span class='o'>:</span> <span class='o'>[[</span> <span class='s2'>"plugh"</span> <span class='o'>]];</span>
<span class='n'>f1</span><span class='o'>:</span> <span class='o'>[[</span> <span class='n'>g</span><span class='o'>;</span> <span class='s2'>"quux"</span> <span class='o'>]];</span>
<span class='n'>f2</span><span class='o'>:</span> <span class='o'>[[</span> <span class='n'>g</span><span class='o'>;</span> <span class='s2'>"xyzzy"</span> <span class='o'>]];</span>
<span class='n'>expr</span><span class='o'>:</span>
<span class='o'>[[</span> <span class='nc'>TRY</span> <span class='n'>f1</span> <span class='o'>-></span> <span class='s2'>"f1"</span> <span class='o'>|</span> <span class='n'>f2</span> <span class='o'>-></span> <span class='s2'>"f2"</span> <span class='o'>]];</span>
<span class='nc'>END</span>
</code></pre>
</div><hr />
<p>Almost the whole point of Camlp4 grammars is that they are extensible—you can add rules and levels to entries after the fact—so you can modify the OCaml parsers to make syntax extensions. But I am going to save that for a later post.</p>Jake Donhamhttp://www.blogger.com/profile/04768087689799941690noreply@blogger.com1tag:blogger.com,1999:blog-1445545651031573301.post-32406930881634983532010-05-07T10:47:00.001-07:002010-05-08T11:18:37.531-07:00How froc works<style>
.post img { border: none; }
</style>
<p>I am happy to announce the release of version 0.2 of the <code>froc</code> library for functional reactive programming in OCaml. There are a number of improvements:</p>
<ul>
<li>better event model: there is now a notion of simultaneous events, and behaviors and events can now be freely mixed</li>
<li><a href='http://ttic.uchicago.edu/~umut/projects/self-adjusting-computation/'>self-adjusting computation</a> is now supported via memo functions; needless recomputation can be avoided in some cases</li>
<li>faster priority queue and timeline data structures</li>
<li>behavior and event types split into co- and contra-variant views for subtyping</li>
<li>bug fixes and cleanup</li>
</ul>
<p>Development of <code>froc</code> has moved from Google Code to Github; see</p>
<ul>
<li><a href='http://github.com/jaked/froc'>project page</a></li>
<li><a href='http://jaked.github.com/froc'>documentation</a></li>
<li><a href='http://github.com/jaked/froc/downloads'>downloads</a></li>
</ul>
<p>Thanks to Ruy Ley-Wild for helpful discussion, and to Daniel Bünzli for helpful discussion and many good ideas in React.</p>
<p>I thought I would take this opportunity to explain how <code>froc</code> works, because it is interesting, and to help putative <code>froc</code> users use it effectively.</p>
<b>Dependency graphs</b>
<p>The main idea behind <code>froc</code> (and self-adjusting computation) is that we can think of an expression as implying a dependency graph, where each subexpression depends on its subexpressions, and ultimately on some input values. When the input values change, we can recompute the expression incrementally by recursively pushing changes to dependent subexpressions.</p>
<p>To be concrete, suppose we have this expression:</p>
<div class='highlight'><pre><code class='ocaml'> <span class='k'>let</span> <span class='n'>u</span> <span class='o'>=</span> <span class='n'>v</span> <span class='o'>/</span> <span class='n'>w</span> <span class='o'>+</span> <span class='n'>x</span> <span class='o'>*</span> <span class='n'>y</span> <span class='o'>+</span> <span class='n'>z</span>
</code></pre>
</div>
<p>Here is a dependency graph relating expressions to their subexpressions:</p>
<p><img src='https://blogger.googleusercontent.com/img/b/R29vZ2xl/AVvXsEhZ8wiiZpp7XSp-PZJZHqSR0JtpPNflIDWZcAQ4dqjpirfHeptk8kIP5hGXgiqa18IK8KjYNhPGolmPmRysCmjDD8PYNLusBoP7-M-SOg1tJ40m7uzujvao76P34FHY-kd2LSNbsBwP-uYL/s1600/how-froc-works-a.png' alt='' /></p>
<p>The edges aren’t directed, because we can think of dependencies as either demand-driven (to compute A, we need B), or change-driven (when B changes, we must recompute A).</p>
<p>Now suppose we do an initial evaluation of the expression with <code>v =
4</code>, <code>w = 2</code>, <code>x = 2</code>, <code>y = 3</code>, and <code>z = 1</code>. Then we have (giving labels to unlabelled nodes, and coloring the current value of each node green):</p>
<p><img src='https://blogger.googleusercontent.com/img/b/R29vZ2xl/AVvXsEhcuUF9-x8JZYxD65I1L86NkEMLAux3JZR6qC0Seu1UYTh_siGen4bGR-KNeCE7v8F0bPsfGR4ijigP5TywVl0k1CtfzzR7Ov7vE2GPyZ_NFY9s7_Jo13-mZcK59-HK9ljwOsqtZyrVljGJ/s1600/how-froc-works-b.png' alt='' /></p>
<p>If we set <code>z = 2</code>, we need only update <code>u</code> to <code>10</code>, since no other node depends on <code>z</code>. If we then set <code>v = 6</code>, we need to update <code>n0</code> to <code>3</code>, <code>n2</code> to <code>9</code> (since <code>n2</code> depends on <code>n0</code>), and <code>u</code> to <code>11</code>, but we don’t need to update <code>n1</code>. (This is the change-driven point of view.)</p>
<p>What if we set <code>z = 2</code> and <code>v = 6</code> simultaneously, then do the updates? We have to be careful to do them in the right order. If we updated <code>u</code> first (since it depends on <code>z</code>), we’d use a stale value for <code>n2</code>. We could require that we don’t update an expression until each of its dependencies has been updated (if necessary). Or we could respect the original evaluation order of the expressions, and say that we won’t update an expression until each expression that came before it has been updated.</p>
<p>In <code>froc</code> we take the second approach. Each expression is given a <em>timestamp</em> (not a wall-clock time, but an abstract ordered value) when it’s initially evaluated, and we re-evaluate the computation by running through a priority queue of stale expressions, ordered by timestamp. Here is the situation, with changed values in magenta, stale values in red, and timestamps in gray:</p>
<p><img src='https://blogger.googleusercontent.com/img/b/R29vZ2xl/AVvXsEjwlIm2ZZlvQSHl4VqrqKGp1L95m43OpYs5oyQHquApd1CP4zvw0PUS0DmO2Ve-zbARdsqcVbuk5bCjrVS8BcGVJgG-r7Sa565TrId_rwOcCfvzH5Qk-cqwwyQ3Cb59aD2qewBLbVZgGwvy/s1600/how-froc-works-c.png' alt='' /></p>
<p>If we update the stale nodes from their dependencies in timestamp order, we get the right answer. We will see how this approach gives us a way to handle <em>control dependencies</em>, where A does not depend on B, but A’s execution is controlled by B.</p>
<b>Library interface</b>
<p>The core of <code>froc</code> has the following (simplified) signature:</p>
<div class='highlight'><pre><code class='ocaml'> <span class='k'>type</span> <span class='k'>'</span><span class='n'>a</span> <span class='n'>t</span>
<span class='k'>val</span> <span class='n'>return</span> <span class='o'>:</span> <span class='k'>'</span><span class='n'>a</span> <span class='o'>-></span> <span class='k'>'</span><span class='n'>a</span> <span class='n'>t</span>
<span class='k'>val</span> <span class='n'>bind</span> <span class='o'>:</span> <span class='k'>'</span><span class='n'>a</span> <span class='n'>t</span> <span class='o'>-></span> <span class='o'>(</span><span class='k'>'</span><span class='n'>a</span> <span class='o'>-></span> <span class='k'>'</span><span class='n'>b</span> <span class='n'>t</span><span class='o'>)</span> <span class='o'>-></span> <span class='k'>'</span><span class='n'>b</span> <span class='n'>t</span>
</code></pre>
</div>
<p>The type <code>'a t</code> represents <em>changeable values</em> (or just <em>changeables</em>) of type <code>'a</code>; these are the nodes of the dependency graph. <code>Return</code> converts a regular value to a changeable value. <code>Bind</code> makes a new changeable as a dependent of an existing one; the function argument is the expression that computes the value from its dependency. We have <code>>>=</code> as an infix synonym for <code>bind</code>; there are also multi-argument versions (<code>bind2</code>, <code>bind3</code>, etc.) so a value can depend on more than one other value.</p>
<p>We could translate the expression from the previous section as:</p>
<div class='highlight'><pre><code class='ocaml'> <span class='k'>let</span> <span class='n'>n0</span> <span class='o'>=</span> <span class='n'>bind2</span> <span class='n'>v</span> <span class='n'>w</span> <span class='o'>(</span><span class='k'>fun</span> <span class='n'>v</span> <span class='n'>w</span> <span class='o'>-></span> <span class='n'>return</span> <span class='o'>(</span><span class='n'>v</span> <span class='o'>/</span> <span class='n'>w</span><span class='o'>))</span>
<span class='k'>let</span> <span class='n'>n1</span> <span class='o'>=</span> <span class='n'>bind2</span> <span class='n'>x</span> <span class='n'>y</span> <span class='o'>(</span><span class='k'>fun</span> <span class='n'>x</span> <span class='n'>y</span> <span class='o'>-></span> <span class='n'>return</span> <span class='o'>(</span><span class='n'>x</span> <span class='o'>*</span> <span class='n'>y</span><span class='o'>))</span>
<span class='k'>let</span> <span class='n'>n2</span> <span class='o'>=</span> <span class='n'>bind2</span> <span class='n'>n0</span> <span class='n'>n1</span> <span class='o'>(</span><span class='k'>fun</span> <span class='n'>n0</span> <span class='n'>n1</span> <span class='o'>-></span> <span class='n'>return</span> <span class='o'>(</span><span class='n'>n0</span> <span class='o'>+</span> <span class='n'>n1</span><span class='o'>))</span>
<span class='k'>let</span> <span class='n'>u</span> <span class='o'>=</span> <span class='n'>bind2</span> <span class='n'>n2</span> <span class='n'>z</span> <span class='o'>(</span><span class='k'>fun</span> <span class='n'>n2</span> <span class='n'>z</span> <span class='o'>-></span> <span class='n'>return</span> <span class='o'>(</span><span class='n'>n2</span> <span class='o'>+</span> <span class='n'>z</span><span class='o'>))</span>
</code></pre>
</div>
<p>There are some convenience functions in <code>froc</code> to make this more readable (these versions are also more efficient):</p>
<div class='highlight'><pre><code class='ocaml'> <span class='k'>val</span> <span class='n'>blift</span> <span class='o'>:</span> <span class='k'>'</span><span class='n'>a</span> <span class='n'>t</span> <span class='o'>-></span> <span class='o'>(</span><span class='k'>'</span><span class='n'>a</span> <span class='o'>-></span> <span class='k'>'</span><span class='n'>b</span><span class='o'>)</span> <span class='o'>-></span> <span class='k'>'</span><span class='n'>b</span> <span class='n'>t</span>
<span class='k'>val</span> <span class='n'>lift</span> <span class='o'>:</span> <span class='o'>(</span><span class='k'>'</span><span class='n'>a</span> <span class='o'>-></span> <span class='k'>'</span><span class='n'>b</span><span class='o'>)</span> <span class='o'>-></span> <span class='k'>'</span><span class='n'>a</span> <span class='n'>t</span> <span class='o'>-></span> <span class='k'>'</span><span class='n'>b</span> <span class='n'>t</span>
</code></pre>
</div>
<p><code>Blift</code> is like <code>bind</code> except that you don’t need the <code>return</code> at the end of the expression (below we’ll see cases where you actually need <code>bind</code>); <code>lift</code> is the same as <code>blift</code> but with the arguments swapped for partial application. So we could say</p>
<div class='highlight'><pre><code class='ocaml'> <span class='k'>let</span> <span class='n'>n0</span> <span class='o'>=</span> <span class='n'>blift2</span> <span class='n'>v</span> <span class='n'>w</span> <span class='o'>(</span><span class='k'>fun</span> <span class='n'>v</span> <span class='n'>w</span> <span class='o'>-></span> <span class='n'>v</span> <span class='o'>/</span> <span class='n'>w</span><span class='o'>)</span>
<span class='k'>let</span> <span class='n'>n1</span> <span class='o'>=</span> <span class='n'>blift2</span> <span class='n'>x</span> <span class='n'>y</span> <span class='o'>(</span><span class='k'>fun</span> <span class='n'>x</span> <span class='n'>y</span> <span class='o'>-></span> <span class='n'>x</span> <span class='o'>*</span> <span class='n'>y</span><span class='o'>)</span>
<span class='k'>let</span> <span class='n'>n2</span> <span class='o'>=</span> <span class='n'>blift2</span> <span class='n'>n0</span> <span class='n'>n1</span> <span class='o'>(</span><span class='k'>fun</span> <span class='n'>n0</span> <span class='n'>n1</span> <span class='o'>-></span> <span class='n'>n0</span> <span class='o'>+</span> <span class='n'>n1</span><span class='o'>)</span>
<span class='k'>let</span> <span class='n'>u</span> <span class='o'>=</span> <span class='n'>blift2</span> <span class='n'>n2</span> <span class='n'>z</span> <span class='o'>(</span><span class='k'>fun</span> <span class='n'>n2</span> <span class='n'>z</span> <span class='o'>-></span> <span class='n'>n2</span> <span class='o'>+</span> <span class='n'>z</span><span class='o'>)</span>
</code></pre>
</div>
<p>or even</p>
<div class='highlight'><pre><code class='ocaml'> <span class='k'>let</span> <span class='o'>(/)</span> <span class='o'>=</span> <span class='n'>lift2</span> <span class='o'>(/)</span>
<span class='k'>let</span> <span class='o'>(</span> <span class='o'>*</span> <span class='o'>)</span> <span class='o'>=</span> <span class='n'>lift2</span> <span class='o'>(</span> <span class='o'>*</span> <span class='o'>)</span>
<span class='k'>let</span> <span class='o'>(+)</span> <span class='o'>=</span> <span class='n'>lift2</span> <span class='o'>(+)</span>
<span class='k'>let</span> <span class='n'>u</span> <span class='o'>=</span> <span class='n'>v</span> <span class='o'>/</span> <span class='n'>w</span> <span class='o'>+</span> <span class='n'>x</span> <span class='o'>*</span> <span class='n'>y</span> <span class='o'>+</span> <span class='n'>z</span>
</code></pre>
</div>
<p>Now, there is no reason to break down expressions all the way—a node can have a more complicated expression, for example:</p>
<div class='highlight'><pre><code class='ocaml'> <span class='k'>let</span> <span class='n'>n0</span> <span class='o'>=</span> <span class='n'>blift2</span> <span class='n'>v</span> <span class='n'>w</span> <span class='o'>(</span><span class='k'>fun</span> <span class='n'>v</span> <span class='n'>w</span> <span class='o'>-></span> <span class='n'>v</span> <span class='o'>/</span> <span class='n'>w</span><span class='o'>)</span>
<span class='k'>let</span> <span class='n'>n2</span> <span class='o'>=</span> <span class='n'>blift3</span> <span class='n'>n0</span> <span class='n'>x</span> <span class='n'>y</span> <span class='o'>(</span><span class='k'>fun</span> <span class='n'>n0</span> <span class='n'>x</span> <span class='n'>y</span> <span class='o'>-></span> <span class='n'>n0</span> <span class='o'>+</span> <span class='n'>x</span> <span class='o'>*</span> <span class='n'>y</span><span class='o'>)</span>
<span class='k'>let</span> <span class='n'>u</span> <span class='o'>=</span> <span class='n'>blift2</span> <span class='n'>n2</span> <span class='n'>z</span> <span class='o'>(</span><span class='k'>fun</span> <span class='n'>n2</span> <span class='n'>z</span> <span class='o'>-></span> <span class='n'>n2</span> <span class='o'>+</span> <span class='n'>z</span><span class='o'>)</span>
</code></pre>
</div>
<p>There is time overhead in propagating dependencies, and space overhead in storing the dependency graph, so it’s useful to be able to control the granularity of recomputation by trading off computation over changeable values with computation over ordinary values.</p>
<b>Dynamic dependency graphs</b>
<p>Take this expression:</p>
<div class='highlight'><pre><code class='ocaml'> <span class='k'>let</span> <span class='n'>b</span> <span class='o'>=</span> <span class='n'>x</span> <span class='o'>=</span> <span class='mi'>0</span>
<span class='k'>let</span> <span class='n'>y</span> <span class='o'>=</span> <span class='k'>if</span> <span class='n'>b</span> <span class='k'>then</span> <span class='mi'>0</span> <span class='k'>else</span> <span class='mi'>100</span> <span class='o'>/</span> <span class='n'>x</span>
</code></pre>
</div>
<p>Here it is in <code>froc</code> form:</p>
<div class='highlight'><pre><code class='ocaml'> <span class='k'>let</span> <span class='n'>b</span> <span class='o'>=</span> <span class='n'>x</span> <span class='o'>>>=</span> <span class='k'>fun</span> <span class='n'>x</span> <span class='o'>-></span> <span class='n'>return</span> <span class='o'>(</span><span class='n'>x</span> <span class='o'>=</span> <span class='mi'>0</span><span class='o'>)</span>
<span class='k'>let</span> <span class='n'>n0</span> <span class='o'>=</span> <span class='n'>x</span> <span class='o'>>>=</span> <span class='k'>fun</span> <span class='n'>x</span> <span class='o'>-></span> <span class='n'>return</span> <span class='o'>(</span><span class='mi'>100</span> <span class='o'>/</span> <span class='n'>x</span><span class='o'>)</span>
<span class='k'>let</span> <span class='n'>y</span> <span class='o'>=</span> <span class='n'>bind2</span> <span class='n'>b</span> <span class='n'>n0</span> <span class='o'>(</span><span class='k'>fun</span> <span class='n'>b</span> <span class='n'>n0</span> <span class='o'>-></span> <span class='k'>if</span> <span class='n'>b</span> <span class='k'>then</span> <span class='n'>return</span> <span class='mi'>0</span> <span class='k'>else</span> <span class='n'>n0</span><span class='o'>)</span>
</code></pre>
</div>
<p>and its dependency graph, with timestamps:</p>
<p><img src='https://blogger.googleusercontent.com/img/b/R29vZ2xl/AVvXsEjXxieOYxPTN_QMww7_y4H64baHzPPzwFhZdO9qBrJLw3udV4Z2OcmcMyZRpQae0NQwdS_eDtgCYaVIJHNz6JfjxaPkbZjixcVk4ecTvZ3QSFyN21aAdRlTEUMLIXZXbYRFWkV5W7Ke9SXm/s1600/how-froc-works-d.png' alt='' /></p>
<p>(We begin to see why <code>bind</code> is sometimes necessary instead of <code>blift</code>—in order to return <code>n0</code> in the <code>else</code> branch, the function must return <code>'b t</code> rather than <code>'b</code>.)</p>
<p>Suppose we have an initial evaluation with <code>x = 10</code>, and we then set <code>x = 0</code>. If we blindly update <code>n0</code>, we get a <code>Division_by_zero</code> exception, although we get no such exception from the original code. Somehow we need to take into account the control dependency between <code>b</code> and <code>100 / x</code>, and compute <code>100 / x</code> only when <code>b</code> is false. This can be accomplished by putting it inside the <code>else</code> branch:</p>
<div class='highlight'><pre><code class='ocaml'> <span class='k'>let</span> <span class='n'>b</span> <span class='o'>=</span> <span class='n'>x</span> <span class='o'>>>=</span> <span class='k'>fun</span> <span class='n'>x</span> <span class='o'>-></span> <span class='n'>return</span> <span class='o'>(</span><span class='n'>x</span> <span class='o'>=</span> <span class='mi'>0</span><span class='o'>)</span>
<span class='k'>let</span> <span class='n'>y</span> <span class='o'>=</span> <span class='n'>b</span> <span class='o'>>>=</span> <span class='k'>fun</span> <span class='n'>b</span> <span class='o'>-></span> <span class='k'>if</span> <span class='n'>b</span> <span class='k'>then</span> <span class='n'>return</span> <span class='mi'>0</span>
<span class='k'>else</span> <span class='n'>x</span> <span class='o'>>>=</span> <span class='k'>fun</span> <span class='n'>x</span> <span class='o'>-></span> <span class='n'>return</span> <span class='o'>(</span><span class='mi'>100</span> <span class='o'>/</span> <span class='n'>x</span><span class='o'>)</span>
</code></pre>
</div>
<p>How does this work? <code>Froc</code> keeps track of the start and finish timestamps when running an expression, and associates dependencies with the timestamp when they are attacheed. When an expression is re-run, we detach all the dependencies between the start and finish timestamps. In this case, when <code>b</code> changes, we detach the dependent expression that divides by 0 before trying to run it.</p>
<p>Let’s walk through the initial run with <code>x = 10</code>: Here is the graph showing the timestamp ranges, and on the dependency edges, the timestamp when the dependency was attached:</p>
<p><img src='https://blogger.googleusercontent.com/img/b/R29vZ2xl/AVvXsEj2kIRCqOh3GldIuHrAYwxJ8LvKT6MqW7UXK6Q85orN23zeAkthEr_9VrWKOZcFvpZJ-Tc4mCh1w43wsiRpOw9vwrUeR9VLv4rUOgCefvjsuBrYlGlOHfrNNP8Id6xhpU_bIhzytJX15Y3L/s1600/how-froc-works-e.png' alt='' /></p>
<p>First we evaluate <code>b</code> (attaching it as a dependent of <code>x</code> at time <code>0</code>) to get <code>false</code>. Then we evaluate <code>y</code> (attaching it as a dependent of <code>b</code> at time <code>3</code>): we check <code>b</code> and evaluate <code>n0</code> to get <code>10</code> (attaching it as a dependent of <code>x</code> at time <code>5</code>). Notice that we have a dependency edge from <code>y</code> to <code>n0</code>. This is not a true dependency, since we don’t recompute <code>y</code> when <code>n0</code> changes; rather the value of <code>y</code> is a proxy for <code>n0</code>, so when <code>n0</code> changes we just forward the new value to <code>y</code>.</p>
<p>What happens if we set <code>x = 20</code>? Both <code>b</code> and <code>n0</code> are stale since they depend on <code>x</code>. We re-run expressions in order of their start timestamp, so we run <code>b</code> and get <code>false</code>. Since the value of <code>b</code> has not changed, <code>y</code> is not stale. Then we re-run <code>n0</code>, so its value (and the value of <code>y</code> by proxy) becomes <code>5</code>.</p>
<p>What happens if we set <code>x = 0</code>? We run <code>b</code> and get <code>true</code>. Now <code>y</code> is also stale, and it is next in timestamp order. We first detach all the dependencies in the timestamp range <code>4</code>-<code>9</code> from the previous run of <code>y</code>: the dependency of <code>n0</code> on <code>x</code> and the proxy dependency of <code>y</code> on <code>n0</code>. This time we take the <code>then</code> branch, so we get <code>0</code> without attaching any new dependencies. We are done; no <code>Division_by_zero</code> exception.</p>
<p>Now we can see why it’s important to handle updates in timestamp order: the value which decides a control flow point (e.g. the test of an <code>if</code>) is always evaluated before the control branches (the <code>then</code> and <code>else</code> branches), so we have the chance to fix up the dependency graph before the branches are updated.</p>
<b>Garbage collection and cleanup functions</b>
<p>A node points to its dependencies (so it can read their values when computing its value), and its dependencies point back to the node (so they can mark it stale when they change). This creates a problem for garbage collection: a node which becomes garbage (from the point of view of the library user) is still attached to its dependencies, taking up memory, and causing extra recomputation.</p>
<p>The implementation of dynamic dependency graphs helps with this problem: as we have seen, when an expression is re-run, the dependencies attached in the course of the previous run are detached, including any dependencies for nodes which have become garbage. Still, until the expression that created them is re-run, garbage nodes remain attached.</p>
<p>Some other FRP implementations use weak pointers to store a node’s dependents, to avoid hanging on to garbage nodes. Since <code>froc</code> is designed to work in browsers (using <a href='http://jaked.github.com/ocamljs'>ocamljs</a>), weak pointers aren’t an option because they aren’t supported in Javascript. But even in regular OCaml, there are reasons to eschew the use of weak pointers:</p>
<p>First, it’s useful to be able to set up changeable expressions which are used for their effect (say, updating the GUI) rather than their value; to do this with a system using weak pointers, you have to stash the expression somewhere so it won’t be GC’d. This is similar to the problem of GCing threads; it doesn’t make sense if the threads can have an effect.</p>
<p>Second, there are other resources which may need to be cleaned up in reaction to changes (say, GUI event handler registrations); weak pointers are no help here. <code>Froc</code> gives you a way to set cleanup functions during a computation, which are run when the computation is re-run, so you can clean up other resources.</p>
<p>With <code>froc</code> there are two options to be sure you don’t leak memory: you can call <code>init</code> to clean up the entire system, or you can use <code>bind</code> to control the lifetime of changeables: for instance, you could have a changeable <code>c</code> representing a counter, do a computation in the scope of a bind of <code>c</code> (you can just ignore the value), then increment the counter to clear out the previous computation.</p>
<p>In fact, there are situations where <code>froc</code> cleans up too quickly—when you want to hang on to a changeable after the expression that attached it is re-run. We’ll see shortly how to avoid this.</p>
<b>Memoizing the previous run</b>
<p>Here is the <code>List.map</code> function, translated to work over lists where the tail is changeable.</p>
<div class='highlight'><pre><code class='ocaml'> <span class='k'>type</span> <span class='k'>'</span><span class='n'>a</span> <span class='n'>lst</span> <span class='o'>=</span> <span class='nc'>Nil</span> <span class='o'>|</span> <span class='nc'>Cons</span> <span class='k'>of</span> <span class='k'>'</span><span class='n'>a</span> <span class='o'>*</span> <span class='k'>'</span><span class='n'>a</span> <span class='n'>lst</span> <span class='n'>t</span>
<span class='k'>let</span> <span class='k'>rec</span> <span class='n'>map</span> <span class='n'>f</span> <span class='n'>lst</span> <span class='o'>=</span>
<span class='n'>lst</span> <span class='o'>>>=</span> <span class='k'>function</span>
<span class='o'>|</span> <span class='nc'>Nil</span> <span class='o'>-></span> <span class='n'>return</span> <span class='nc'>Nil</span>
<span class='o'>|</span> <span class='nc'>Cons</span> <span class='o'>(</span><span class='n'>h</span><span class='o'>,</span> <span class='n'>t</span><span class='o'>)</span> <span class='o'>-></span>
<span class='k'>let</span> <span class='n'>t</span> <span class='o'>=</span> <span class='n'>map</span> <span class='n'>f</span> <span class='n'>t</span> <span class='k'>in</span>
<span class='n'>return</span> <span class='o'>(</span><span class='nc'>Cons</span> <span class='o'>(</span><span class='n'>f</span> <span class='n'>h</span><span class='o'>,</span> <span class='n'>t</span><span class='o'>))</span>
</code></pre>
</div>
<p>What happens if we run</p>
<div class='highlight'><pre><code class='ocaml'> <span class='n'>map</span> <span class='o'>(</span><span class='k'>fun</span> <span class='n'>x</span> <span class='o'>-></span> <span class='n'>x</span> <span class='o'>+</span> <span class='mi'>1</span><span class='o'>)</span> <span class='o'>[</span> <span class='mi'>1</span><span class='o'>;</span> <span class='mi'>2</span><span class='o'>;</span> <span class='mi'>3</span> <span class='o'>]</span>
</code></pre>
</div>
<p>? (I’m abusing the list syntax here to mean a changeable list with these elements.) Let’s see if we can fit the dependency graph on the page (abbreviating <code>Cons</code> and <code>Nil</code> and writing just <code>f</code> for the <code>function</code> expression):</p>
<p><img src='https://blogger.googleusercontent.com/img/b/R29vZ2xl/AVvXsEiDYfepOwFgLZaszFgQIT09SrwAI93aNjVYXDGETgcvW2GeDsLs8vN-cN-UrH43IeHe5IjbhmE6uSYCm1Ig1G-GGtgSTiGx7JVcIHMehbHKDj1L5CZu6vzDBwdt-kcBetTRLngRpGd-R6kq/s1600/how-froc-works-f.png' alt='' /></p>
<p>(The dependency edges on the right-hand side don’t mean that e.g. <code>f0</code> depends directly on <code>f1</code>, but rather that the value returned by <code>f0</code>—<code>Cons(2,f1)</code>—depends on <code>f1</code>. We don’t re-run <code>f0</code> when <code>f1</code> changes, or even update its value by proxy as we did in the previous section. But if <code>f1</code> is stale it must be updated before we can consider <code>f0</code> up-to-date.)</p>
<p>Notice how the timestamp ranges for the <code>function</code> expressions are nested each within the previous one. There is a control dependency at each recursive call: whether we make a deeper call depends on whether the argument list is <code>Nil</code>.</p>
<p>So if we change <code>t3</code>, just <code>f3</code> is stale. But if we change <code>t0</code>, we must re-run <code>f0</code>, <code>f1</code>, <code>f2</code>, and <code>f3</code>—that is, the whole computation—detaching all the dependencies, then reattaching them. This is kind of annoying; we do a lot of pointless work since nothing after the first element has changed.</p>
<p>If only some prefix of the list has changed, we’d like to be able to reuse the work we did in the previous run for the unchanged suffix. <code>Froc</code> addresses this need with <em>memo functions</em>. In a way similar to ordinary memoization, a memo function records a table of arguments and values when you call it. But in <code>froc</code> we only reuse values from the previous run, and only those from the timestamp range we’re re-running. We can define <code>map</code> as a memo function:</p>
<div class='highlight'><pre><code class='ocaml'> <span class='k'>let</span> <span class='n'>map</span> <span class='n'>f</span> <span class='n'>lst</span> <span class='o'>=</span>
<span class='k'>let</span> <span class='n'>memo</span> <span class='o'>=</span> <span class='n'>memo</span> <span class='bp'>()</span> <span class='k'>in</span>
<span class='k'>let</span> <span class='k'>rec</span> <span class='n'>map</span> <span class='n'>lst</span> <span class='o'>=</span>
<span class='n'>lst</span> <span class='o'>>>=</span> <span class='k'>function</span>
<span class='o'>|</span> <span class='nc'>Nil</span> <span class='o'>-></span> <span class='n'>return</span> <span class='nc'>Nil</span>
<span class='o'>|</span> <span class='nc'>Cons</span> <span class='o'>(</span><span class='n'>h</span><span class='o'>,</span> <span class='n'>t</span><span class='o'>)</span> <span class='o'>-></span>
<span class='k'>let</span> <span class='n'>t</span> <span class='o'>=</span> <span class='n'>memo</span> <span class='n'>map</span> <span class='n'>t</span> <span class='k'>in</span>
<span class='n'>return</span> <span class='o'>(</span><span class='nc'>Cons</span> <span class='o'>(</span><span class='n'>f</span> <span class='n'>h</span><span class='o'>,</span> <span class='n'>t</span><span class='o'>))</span> <span class='k'>in</span>
<span class='n'>memo</span> <span class='n'>map</span> <span class='n'>lst</span>
</code></pre>
</div>
<p>Here the <code>memo</code> call makes a new memo table. In the initial run we add a memo entry associating each list node (<code>t0</code>, <code>t1</code>, …) with its <code>map</code> (<code>f0</code>, <code>f1</code>, …). Now, suppose we change <code>t0</code>: <code>f0</code> is stale, so we update it. When we go to compute <code>map f t1</code> we get a memo hit returning <code>f1</code> (the computation of <code>f1</code> is contained in the timestamp range of <code>f0</code>, so it is a candidate for memo matching). <code>F1</code> is up-to-date so we return it as the value of <code>map f t1</code>.</p>
<p>There is a further wrinkle: suppose we change both <code>t0</code> and <code>t2</code>, leaving <code>t1</code> unchanged. As before, we get a memo hit on <code>t1</code> returning <code>f1</code>, but since <code>f2</code> is stale, so is <code>f1</code>. We must run the update queue until <code>f1</code> is up-to-date before we return it as the value of <code>map f t1</code>. Recall that we detach the dependencies of the computation we’re re-running; in order to update <code>f1</code> we just leave it attached to its dependencies and run the queue until the end of its timestamp range.</p>
<p>In general, there can be a complicated pattern of changed and unchanged data—we could change every other element in the list, for instance—so memoization and the update loop call one another recursively. From the timestamp point of view, however, we can think of it as a linear scan through time, alternating between updating stale computations and reusing ones which have not changed.</p>
<p>The memo function mechanism provides a way to keep changeables attached even after the expression that attached them is re-run. We just need to attach them from within a memo function, then look them up again on the next run, so they’re left attached to their dependencies. The <a href='http://jaked.github.com/froc/examples/froc-dom/quickhull'>quickhull</a> example (<a href='http://jaked.github.com/froc/examples/froc-dom/quickhull/quickhull.ml'>source</a>) demonstrates how this works.</p>
<b>Functional reactive programming and the event queue</b>
<p>Functional reactive programming works with two related types: <em>behavior</em>s are values that can change over time, but are defined at all times; <em>event</em>s are defined only at particular instants in time, possibly (but not necessarily) with a different value at each instant. (<em>Signal</em>s are events or behaviors when we don’t care which one.)</p>
<p>Events can be used to represent external events entering the system (like GUI clicks or keystrokes), and can also represent occurrences within the system, such as a collision between two moving objects. It is natural for events to be defined in terms of behaviors and vice versa. (In fact they can be directly interdefined with the <code>hold</code> and <code>changes</code> functions.)</p>
<p>In <code>froc</code>, behaviors are just another name for changeables. Events are implemented on top of changeables: they are just changeables with transient values. An incoming event sets the value of its underlying changeable; after changes have propagated through the dependency graph, the values of all the changeables which underlie events are removed (so they can be garbage collected).</p>
<p>Signals may be defined (mutually) recursively. For example, in the <a href='http://jaked.github.com/froc/examples/froc-dom/bounce'>bounce</a> example (<a href='http://jaked.github.com/froc/examples/froc-dom/bounce/bounce.ml'>source</a>), the position of the ball is a behavior defined in terms of its velocity, which is a behavior defined in terms of events indicating collisions with the walls and paddle, which are defined in terms of the ball’s position.</p>
<p><code>Froc</code> provides the <code>fix_b</code> and <code>fix_e</code> functions to define signals recursively. The definition of a signal can’t refer directly to its own current value, since it hasn’t been determined yet; instead it sees its value from the previous update cycle. When a recursively-defined signal produces a value, an event is queued to be processed in the next update cycle, so the signal can be updated based on its new current value. (If the signal doesn’t converge somehow this process loops.)</p>
<b>Related systems</b>
<p><code>Froc</code> is closely related to a few other FRP systems which are change-driven and written in an imperative, call-by-value language:</p>
<p><a href='http://www.cs.brown.edu/~greg/'>FrTime</a> is an FRP system for PLT Scheme. FrTime has a dependency graph and update queue mechanism similar to <code>froc</code>, but sorts stale nodes in dependency (“topological”) rather than timestamp order. There is a separate mechanism for handling control dependencies, using a dynamic scoping feature specific to PLT Scheme (“parameters”) to track dependencies attached in the course of evaluating an expression; in addition FrTime uses weak pointers to collect garbage nodes. There is no equivalent of <code>froc</code>’s memo functions. Reactivity in FrTime is implicit: you give an ordinary Scheme program, and the compiler turns each subexpression into a changeable value. There is no programmer control over the granularity of recomputation, but there is a compiler optimization (“lowering”) which recovers some performance by coalescing changeables.</p>
<p><a href='http://www.flapjax-lang.org/'>Flapjax</a> is a descendent of FrTime for Javascript. It implements the same dependency-ordered queue as FrTime, but there is no mechanism for control dependencies, and there are no weak pointers (since there are none in Javascript), so it is fairly easy to create memory leaks (although there is a special reference-counting mechanism in certain cases). Flapjax can be used as a library; it also has a compiler similar to FrTime’s, but since it doesn’t handle control dependencies, the semantics of compiled programs are not preserved (e.g. you can observe exceptions that don’t occur in the original program).</p>
<p><a href='http://erratique.ch/software/react'>React</a> is a library for OCaml, also based on a dependency-ordered queue, using weak pointers, without a mechanism for control dependencies.</p>
<b>Colophon</b>
<p>I used <a href='http://mlpost.lri.fr/'>Mlpost</a> to generate the dependency graph diagrams. It is very nice!</p>Jake Donhamhttp://www.blogger.com/profile/04768087689799941690noreply@blogger.com8tag:blogger.com,1999:blog-1445545651031573301.post-71857363167827094152010-04-02T19:18:00.000-07:002010-05-07T13:10:51.580-07:00orpc 0.3<p>I am happy to announce version 0.3 of <code>orpc</code>, a tool for generating RPC bindings from OCaml signatures. Orpc can generate ONC RPC stubs for use with <a href='http://projects.camlcity.org/projects/ocamlnet.html'>Ocamlnet</a> (in place of ocamlrpcgen), and it can also generate RPC over HTTP stubs for use with <a href='http://github.com/jaked/ocamljs'>ocamljs</a>. You can use most OCaml types in interfaces, as well as labelled and optional arguments.</p>
<p>Changes since version 0.2 include</p>
<ul>
<li>a way to use types defined outside the interface file, so you can use a type in more than one interface</li>
<li>support for polymorphic variants</li>
<li>a way to specify “abstract” interfaces that can be instantiated for synchronous, asynchronous, and Lwt clients and servers</li>
<li>bug fixes</li>
</ul>
<p>Development of <code>orpc</code> has moved from Google Code to Github; see</p>
<ul>
<li><a href='http://github.com/jaked/orpc'>project page</a></li>
<li><a href='http://jaked.github.com/orpc'>documentation</a></li>
<li><a href='http://github.com/jaked/orpc/downloads'>downloads</a></li>
</ul>
<p>Let me know what you think.</p>Jake Donhamhttp://www.blogger.com/profile/04768087689799941690noreply@blogger.com0tag:blogger.com,1999:blog-1445545651031573301.post-7900055044896992922010-03-27T18:19:00.001-07:002010-03-27T18:19:39.308-07:00Updated backtrace patch<p>I’ve updated my <a href='http://skydeck.com/blog/programming/stack-traces-in-ocaml'>backtrace</a> <a href='http://skydeck.com/blog/programming/more-stack-traces-in-ocaml'>patch</a> to work with OCaml 3.11.x as well as 3.10.x. The patch provides</p>
<ul>
<li>
<p>access to backtraces from within a program (this is already provided in stock 3.11.x)</p>
</li>
<li>
<p>backtraces for dynamically-loaded bytecode</p>
</li>
<li>
<p>backtraces in the (bytecode) toplevel</p>
</li>
</ul>
<p>In addition there are a few improvements since the last version:</p>
<ul>
<li>
<p>debugging events are allocated outside the heap, so memory use should be better with forking (on Linux at least, the data is shared on copy-on-write pages but the first GC causes the pages be copied)</p>
</li>
<li>
<p>fixed a bug that could cause spurious “unknown location” lines in the backtrace</p>
</li>
<li>
<p>a script to apply the patch (instead of the previous multi-step manual process)</p>
</li>
</ul>
<p>See <a href='http://github.com/jaked/ocaml-backtrace-patch'>ocaml-backtrace-patch</a> on Github or <a href='http://github.com/downloads/jaked/ocaml-backtrace-patch/ocaml-backtrace-patch-0.5.tar.gz'>download the tarball</a>.</p>Jake Donhamhttp://www.blogger.com/profile/04768087689799941690noreply@blogger.com0tag:blogger.com,1999:blog-1445545651031573301.post-58564747680215214722010-03-23T15:32:00.000-07:002010-03-23T15:32:08.179-07:00Inside OCaml objects<p>In the <a href='http://github.com/jaked/ocamljs'>ocamljs</a> project I wanted to implement the OCaml object system in a way that is interoperable with Javascript objects. Mainly I wanted to be able to call Javascript methods with the OCaml method call syntax, but it is also useful to write objects in OCaml which are callable in the usual way from Javascript.</p>
<p>I spent some time a few months ago figuring out how OCaml objects are put together in order to implement this (it is in the unreleased <code>ocamljs</code> trunk—new release coming soon I hope). I got a <a href='http://github.com/jaked/ocamljs/issues/issue/1'>bug report</a> against it the other day, and it turns out I don’t remember much of what I figured out. So I am going to figure it out again, and write it down, here in this very blog post!</p>
<p>Objects are implemented mostly in the <code>CamlinternalOO</code> library module, with a few compiler primitives for method invocation. The compiler generates <code>CamlinternalOO</code> calls to construct classes and objects. Our main tool for figuring out what is going on is to write a test program, dump out its lambda code with <code>-dlambda</code>, and read the <code>CamlinternalOO</code> source to see what it means. I will explain functions from <a href='http://caml.inria.fr/cgi-bin/viewcvs.cgi/ocaml/trunk/stdlib/camlinternalOO.ml?rev=8768'>camlinternalOO.ml</a> but not embed them in the post, so you may want it available for reference.</p>
<p>I have hand-translated (apologies for any errors) the lambda code back to pseudo-OCaml to make it more readable. The compiler-generated code works directly with the OCaml <a href='http://caml.inria.fr/pub/docs/manual-ocaml/manual032.html#toc129'>heap representation</a>, and generally doesn’t fit into the OCaml type system. Where the heap representation can be translated back to an OCaml value I do that; otherwise I write blocks with array notation, and atoms with integers. Finally I have used <code>OO</code> as an abbreviation for <code>CamlinternalOO</code>.</p>
<b>Immediate objects</b>
<p>Here is a first test program, defining an immediate object:</p>
<div class='highlight'><pre><code class='ocaml'><span class='k'>let</span> <span class='n'>p</span> <span class='o'>=</span>
<span class='k'>object</span>
<span class='k'>val</span> <span class='k'>mutable</span> <span class='n'>x</span> <span class='o'>=</span> <span class='mi'>0</span>
<span class='k'>method</span> <span class='n'>get_x</span> <span class='o'>=</span> <span class='n'>x</span>
<span class='k'>method</span> <span class='n'>move</span> <span class='n'>d</span> <span class='o'>=</span> <span class='n'>x</span> <span class='o'><-</span> <span class='n'>x</span> <span class='o'>+</span> <span class='n'>d</span>
<span class='k'>end</span>
</code></pre>
</div>
<p>And this is what it compiles to:</p>
<div class='highlight'><pre><code class='ocaml'><span class='k'>let</span> <span class='n'>shared</span> <span class='o'>=</span> <span class='o'>[|</span><span class='s2'>"move"</span><span class='o'>;</span><span class='s2'>"get_x"</span><span class='o'>|]</span>
<span class='k'>let</span> <span class='n'>p</span> <span class='o'>=</span>
<span class='k'>let</span> <span class='n'>clas</span> <span class='o'>=</span> <span class='nn'>OO</span><span class='p'>.</span><span class='n'>create_table</span> <span class='n'>shared</span> <span class='k'>in</span>
<span class='k'>let</span> <span class='n'>obj_init</span> <span class='o'>=</span>
<span class='k'>let</span> <span class='n'>ids</span> <span class='o'>=</span> <span class='nn'>OO</span><span class='p'>.</span><span class='n'>new_methods_variables</span> <span class='n'>clas</span> <span class='n'>shared</span> <span class='o'>[|</span><span class='s2'>"x"</span><span class='o'>|]</span> <span class='k'>in</span>
<span class='k'>let</span> <span class='n'>move</span> <span class='o'>=</span> <span class='n'>ids</span><span class='o'>.(</span><span class='mi'>0</span><span class='o'>)</span> <span class='k'>in</span>
<span class='k'>let</span> <span class='n'>get_x</span> <span class='o'>=</span> <span class='n'>ids</span><span class='o'>.(</span><span class='mi'>1</span><span class='o'>)</span> <span class='k'>in</span>
<span class='k'>let</span> <span class='n'>x</span> <span class='o'>=</span> <span class='n'>ids</span><span class='o'>.(</span><span class='mi'>2</span><span class='o'>)</span> <span class='k'>in</span>
<span class='nn'>OO</span><span class='p'>.</span><span class='n'>set_methods</span> <span class='n'>clas</span> <span class='o'>[|</span>
<span class='n'>get_x</span><span class='o'>;</span> <span class='nn'>OO</span><span class='p'>.</span><span class='nc'>GetVar</span><span class='o'>;</span> <span class='n'>x</span><span class='o'>;</span>
<span class='n'>move</span><span class='o'>;</span> <span class='o'>(</span><span class='k'>fun</span> <span class='n'>self</span> <span class='n'>d</span> <span class='o'>-></span> <span class='n'>self</span><span class='o'>.(</span><span class='n'>x</span><span class='o'>)</span> <span class='o'><-</span> <span class='n'>self</span><span class='o'>.(</span><span class='n'>x</span><span class='o'>)</span> <span class='o'>+</span> <span class='n'>d</span><span class='o'>);</span>
<span class='o'>|];</span>
<span class='o'>(</span><span class='k'>fun</span> <span class='n'>env</span> <span class='o'>-></span>
<span class='k'>let</span> <span class='n'>self</span> <span class='o'>=</span> <span class='nn'>OO</span><span class='p'>.</span><span class='n'>create_object_opt</span> <span class='mi'>0</span> <span class='n'>clas</span> <span class='k'>in</span>
<span class='n'>self</span><span class='o'>.(</span><span class='n'>x</span><span class='o'>)</span> <span class='o'><-</span> <span class='mi'>0</span><span class='o'>;</span>
<span class='n'>self</span><span class='o'>)</span> <span class='k'>in</span>
<span class='nn'>OO</span><span class='p'>.</span><span class='n'>init_class</span> <span class='n'>clas</span><span class='o'>;</span>
<span class='n'>obj_init</span> <span class='mi'>0</span>
</code></pre>
</div>
<p>An object has a class, created with <code>create_table</code> and filled in with <code>new_methods_variables</code>, <code>set_methods</code>, and <code>init_class</code>; the object itself is created by calling <code>create_object_opt</code> with the class as argument, then initializing the instance variable.</p>
<p>A table (the value representing a class) has the following fields (and some others we won’t cover):</p>
<div class='highlight'><pre><code class='ocaml'><span class='k'>type</span> <span class='n'>table</span> <span class='o'>=</span> <span class='o'>{</span>
<span class='k'>mutable</span> <span class='n'>size</span><span class='o'>:</span> <span class='kt'>int</span><span class='o'>;</span>
<span class='k'>mutable</span> <span class='n'>methods</span><span class='o'>:</span> <span class='n'>closure</span> <span class='kt'>array</span><span class='o'>;</span>
<span class='k'>mutable</span> <span class='n'>methods_by_name</span><span class='o'>:</span> <span class='n'>meths</span><span class='o'>;</span>
<span class='k'>mutable</span> <span class='n'>methods_by_label</span><span class='o'>:</span> <span class='n'>labs</span><span class='o'>;</span>
<span class='k'>mutable</span> <span class='n'>vars</span><span class='o'>:</span> <span class='n'>vars</span><span class='o'>;</span>
<span class='o'>}</span>
</code></pre>
</div>
<p>Each instance variable has a slot (its index in the block which represents the object); <code>vars</code> maps variable names to slots. The <code>size</code> field records the total number of slots (including internal slots, see below).</p>
<p>Each public method has a label, computed by hashing the method name. The <code>methods</code> field (used for method dispatch) holds each method of the class, with the label of the method at the following index (the type is misleading). Each method then has a slot (the index in <code>methods</code> of the method function); <code>methods_by_name</code> maps method names to slots, and the confusingly-named <code>methods_by_label</code> marks slots to whether it is occupied by a public method.</p>
<p>The <code>create_table</code> call assigns slots to methods, fills in the method labels in <code>methods</code>, and sets up <code>methods_by_name</code> and <code>methods_by_label</code>. The <code>new_methods_variables</code> call returns the slot of each public method and each instance variable in a block (which is unpacked into local variables).</p>
<p>The <code>set_methods</code> call sets up the method functions in <code>methods</code>. Its argument is a block containing alternating method slots and method descriptions (the description can take more than one item in the block). For some methods (e.g. <code>move</code>) the description is just an OCaml function (here you can see that <code>self</code> is passed as the first argument). For some the description is given by a value of the variant <code>OO.impl</code> along with some other arguments. For <code>get_x</code> it is <code>GetVar</code> followed by the slot for <code>x</code>. The actual function that gets the instance variable is generated by <code>set_methods</code>. As far as I understand it, the point of this is to reduce object code size by factoring out the common code from frequently occurring methods.</p>
<p>Finally <code>create_object_opt</code> allocates a block of <code>clas.size</code>, then fills in the first slot with the <code>methods</code> array of the class and the second with the object’s unique ID. (We will see below what the <code>_opt</code> part is about.)</p>
<b>Method calls</b>
<p>A public method call:</p>
<div class='highlight'><pre><code class='ocaml'><span class='n'>p</span><span class='o'>#</span><span class='n'>get_x</span>
</code></pre>
</div>
<p>compiles to:</p>
<div class='highlight'><pre><code class='ocaml'><span class='n'>send</span> <span class='n'>p</span> <span class='mi'>291546447</span>
</code></pre>
</div>
<p>where <code>send</code> is a built-in lambda term. The number is the method label. To understand how the method is applied we have to go a little deeper. In <code>bytegen.ml</code> there is a case for <code>Lsend</code> which generates the <code>Kgetpubmet</code> bytecode instruction to find the method function; the function is then applied like any other function. Next we look to the <code>GETPUBMET</code> case in <code>interp.c</code> to see how public methods are looked up in the <code>methods</code> block (stored in the first field of the object).</p>
<p>A couple details about <code>methods</code> we didn’t cover before: The first field contains the number of public methods. The second contains a bitmask used for method caching—briefly, it is enough bits to store offsets into <code>methods</code>. The rest of the block is method functions and labels as above, padded out so that the range of an offset masked by the bitmask does not overflow the block.</p>
<p>Returning to <code>GETPUBMET</code>, we first check to see if the method cache for this call site is valid. The method cache is an extra word at each call site which stores an offset into <code>methods</code> (but may be garbage—masking it takes care of this). If the method label at this offset matches the label we’re looking for, the associated method function is returned. Otherwise, we binary search <code>methods</code> to find the method label (methods are sorted in label order in <code>transclass.ml</code>), then store the offset in the cache and return the associated method function.</p>
<b>Classes</b>
<p>A class definition:</p>
<div class='highlight'><pre><code class='ocaml'><span class='k'>class</span> <span class='n'>point</span> <span class='o'>=</span>
<span class='k'>object</span>
<span class='k'>val</span> <span class='k'>mutable</span> <span class='n'>x</span> <span class='o'>=</span> <span class='mi'>0</span>
<span class='k'>method</span> <span class='n'>get_x</span> <span class='o'>=</span> <span class='n'>x</span>
<span class='k'>method</span> <span class='n'>move</span> <span class='n'>d</span> <span class='o'>=</span> <span class='n'>x</span> <span class='o'><-</span> <span class='n'>x</span> <span class='o'>+</span> <span class='n'>d</span>
<span class='k'>end</span>
<span class='k'>let</span> <span class='n'>p</span> <span class='o'>=</span> <span class='k'>new</span> <span class='n'>point</span>
</code></pre>
</div>
<p>compiles to:</p>
<div class='highlight'><pre><code class='ocaml'><span class='k'>let</span> <span class='n'>shared</span> <span class='o'>=</span> <span class='o'>[|</span><span class='s2'>"move"</span><span class='o'>;</span><span class='s2'>"get_x"</span><span class='o'>|]</span>
<span class='k'>let</span> <span class='n'>point</span> <span class='o'>=</span>
<span class='k'>let</span> <span class='n'>point_init</span> <span class='n'>clas</span> <span class='o'>=</span>
<span class='k'>let</span> <span class='n'>ids</span> <span class='o'>=</span> <span class='nn'>OO</span><span class='p'>.</span><span class='n'>new_methods_variables</span> <span class='n'>clas</span> <span class='n'>shared</span> <span class='o'>[|</span><span class='s2'>"x"</span><span class='o'>|]</span> <span class='k'>in</span>
<span class='k'>let</span> <span class='n'>move</span> <span class='o'>=</span> <span class='n'>ids</span><span class='o'>.(</span><span class='mi'>0</span><span class='o'>)</span> <span class='k'>in</span>
<span class='k'>let</span> <span class='n'>get_x</span> <span class='o'>=</span> <span class='n'>ids</span><span class='o'>.(</span><span class='mi'>1</span><span class='o'>)</span> <span class='k'>in</span>
<span class='k'>let</span> <span class='n'>x</span> <span class='o'>=</span> <span class='n'>ids</span><span class='o'>.(</span><span class='mi'>2</span><span class='o'>)</span> <span class='k'>in</span>
<span class='nn'>OO</span><span class='p'>.</span><span class='n'>set_methods</span> <span class='n'>clas</span> <span class='o'>[|</span>
<span class='n'>get_x</span><span class='o'>;</span> <span class='nn'>OO</span><span class='p'>.</span><span class='nc'>GetVar</span><span class='o'>;</span> <span class='n'>x</span><span class='o'>;</span>
<span class='n'>move</span><span class='o'>;</span> <span class='o'>(</span><span class='k'>fun</span> <span class='n'>self</span> <span class='n'>d</span> <span class='o'>-></span> <span class='n'>self</span><span class='o'>.(</span><span class='n'>x</span><span class='o'>)</span> <span class='o'><-</span> <span class='n'>self</span><span class='o'>.(</span><span class='n'>x</span><span class='o'>)</span> <span class='o'>+</span> <span class='n'>d</span><span class='o'>);</span>
<span class='o'>|];</span>
<span class='o'>(</span><span class='k'>fun</span> <span class='n'>env</span> <span class='n'>self</span> <span class='o'>-></span>
<span class='k'>let</span> <span class='n'>self</span> <span class='o'>=</span> <span class='nn'>OO</span><span class='p'>.</span><span class='n'>create_object_opt</span> <span class='n'>self</span> <span class='n'>clas</span> <span class='k'>in</span>
<span class='n'>self</span><span class='o'>.(</span><span class='n'>x</span><span class='o'>)</span> <span class='o'><-</span> <span class='mi'>0</span><span class='o'>;</span>
<span class='n'>self</span><span class='o'>)</span> <span class='k'>in</span>
<span class='nn'>OO</span><span class='p'>.</span><span class='n'>make_class</span> <span class='n'>shared</span> <span class='n'>point_init</span>
<span class='k'>let</span> <span class='n'>p</span> <span class='o'>=</span> <span class='o'>(</span><span class='n'>point</span><span class='o'>.(</span><span class='mi'>0</span><span class='o'>)</span> <span class='mi'>0</span><span class='o'>)</span>
</code></pre>
</div>
<p>This is similar to the immediate object code, except that the class constructor takes the class table as an argument rather than constructing it itself, and the object constructor takes <code>self</code> as an argument. We will see that class and object constructors are each chained up the inheritance hierarchy, and the tables / objects are passed up the chain. The <code>make_class</code> call calls <code>create_table</code> and <code>init_class</code> in the same way we saw in the immediate object case, and returns a tuple, of which the first component is the object constructor. So the <code>new</code> invocation calls the constructor.</p>
<b>Inheritance</b>
<p>A subclass definition:</p>
<div class='highlight'><pre><code class='ocaml'><span class='k'>class</span> <span class='n'>point</span> <span class='o'>=</span> <span class='o'>...</span> <span class='c'>(* as before *)</span>
<span class='k'>class</span> <span class='n'>point_sub</span> <span class='o'>=</span>
<span class='k'>object</span>
<span class='k'>inherit</span> <span class='n'>point</span>
<span class='k'>val</span> <span class='k'>mutable</span> <span class='n'>y</span> <span class='o'>=</span> <span class='mi'>0</span>
<span class='k'>method</span> <span class='n'>get_y</span> <span class='o'>=</span> <span class='n'>y</span>
<span class='k'>end</span>
</code></pre>
</div>
<p>compiles to:</p>
<div class='highlight'><pre><code class='ocaml'><span class='k'>let</span> <span class='n'>point</span> <span class='o'>=</span> <span class='o'>...</span> <span class='c'>(* as before *)</span>
<span class='k'>let</span> <span class='n'>point_sub</span> <span class='o'>=</span>
<span class='k'>let</span> <span class='n'>point_sub_init</span> <span class='n'>clas</span> <span class='o'>=</span>
<span class='k'>let</span> <span class='n'>ids</span> <span class='o'>=</span>
<span class='nn'>OO</span><span class='p'>.</span><span class='n'>new_methods_variables</span> <span class='n'>clas</span> <span class='o'>[|</span><span class='s2'>"get_y"</span><span class='o'>|]</span> <span class='o'>[|</span><span class='s2'>"y"</span><span class='o'>|]</span> <span class='k'>in</span>
<span class='k'>let</span> <span class='n'>get_y</span> <span class='o'>=</span> <span class='n'>ids</span><span class='o'>.(</span><span class='mi'>0</span><span class='o'>)</span> <span class='k'>in</span>
<span class='k'>let</span> <span class='n'>y</span> <span class='o'>=</span> <span class='n'>ids</span><span class='o'>.(</span><span class='mi'>1</span><span class='o'>)</span> <span class='k'>in</span>
<span class='k'>let</span> <span class='n'>inh</span> <span class='o'>=</span>
<span class='nn'>OO</span><span class='p'>.</span><span class='n'>inherits</span>
<span class='n'>clas</span> <span class='o'>[|</span><span class='s2'>"x"</span><span class='o'>|]</span> <span class='o'>[||]</span> <span class='o'>[|</span><span class='s2'>"get_x"</span><span class='o'>;</span><span class='s2'>"move"</span><span class='o'>|]</span> <span class='n'>point</span> <span class='bp'>true</span> <span class='k'>in</span>
<span class='k'>let</span> <span class='n'>obj_init</span> <span class='o'>=</span> <span class='n'>inh</span><span class='o'>.(</span><span class='mi'>0</span><span class='o'>)</span> <span class='k'>in</span>
<span class='nn'>OO</span><span class='p'>.</span><span class='n'>set_methods</span> <span class='n'>clas</span> <span class='o'>[|</span> <span class='n'>get_y</span><span class='o'>;</span> <span class='nc'>GetVar</span><span class='o'>;</span> <span class='n'>y</span> <span class='o'>|];</span>
<span class='o'>(</span><span class='k'>fun</span> <span class='n'>env</span> <span class='n'>self</span> <span class='o'>-></span>
<span class='k'>let</span> <span class='n'>self'</span> <span class='o'>=</span> <span class='nn'>OO</span><span class='p'>.</span><span class='n'>create_object_opt</span> <span class='n'>self</span> <span class='n'>clas</span> <span class='k'>in</span>
<span class='n'>obj_init</span> <span class='n'>self'</span><span class='o'>;</span>
<span class='n'>self'</span><span class='o'>.(</span><span class='n'>y</span><span class='o'>)</span> <span class='o'><-</span> <span class='mi'>0</span><span class='o'>;</span>
<span class='nn'>OO</span><span class='p'>.</span><span class='n'>run_initializers_opt</span> <span class='n'>self</span> <span class='n'>self'</span> <span class='n'>clas</span><span class='o'>)</span> <span class='k'>in</span>
<span class='nn'>OO</span><span class='p'>.</span><span class='n'>make_class</span> <span class='o'>[|</span><span class='s2'>"move"</span><span class='o'>;</span><span class='s2'>"get_x"</span><span class='o'>;</span><span class='s2'>"get_y"</span><span class='o'>|]</span> <span class='n'>point_sub_init</span>
</code></pre>
</div>
<p>The subclass is connected to its superclass through <code>inherits</code>, which calls the superclass constructor on the subclass (filling in <code>methods</code> with the superclass methods) and returns the superclass object constructor (and some other stuff). In the subclass object constructor, the superclass object constructor is called. (This is why the object is created optionally—the class on which <code>new</code> is invoked actually allocates the object; further superclass constructors just initialize instance variables.) In addition, we run any initializers, since some superclass may have them.</p>
<b>Self- and super-calls</b>
<p>A class with a self-call:</p>
<div class='highlight'><pre><code class='ocaml'><span class='k'>class</span> <span class='n'>point</span> <span class='o'>=</span>
<span class='k'>object</span> <span class='o'>(</span><span class='n'>s</span><span class='o'>)</span>
<span class='k'>val</span> <span class='k'>mutable</span> <span class='n'>x</span> <span class='o'>=</span> <span class='mi'>0</span>
<span class='k'>method</span> <span class='n'>get_x</span> <span class='o'>=</span> <span class='n'>x</span>
<span class='k'>method</span> <span class='n'>get_x5</span> <span class='o'>=</span> <span class='n'>s</span><span class='o'>#</span><span class='n'>get_x</span> <span class='o'>+</span> <span class='mi'>5</span>
<span class='k'>end</span>
</code></pre>
</div>
<p>becomes:</p>
<div class='highlight'><pre><code class='ocaml'><span class='k'>let</span> <span class='n'>point</span> <span class='o'>=</span>
<span class='k'>let</span> <span class='n'>point_init</span> <span class='n'>clas</span> <span class='o'>=</span>
<span class='o'>...</span> <span class='c'>(* as before *)</span>
<span class='nn'>OO</span><span class='p'>.</span><span class='n'>set_methods</span> <span class='n'>clas</span> <span class='o'>[|</span>
<span class='n'>get_x</span><span class='o'>;</span> <span class='nn'>OO</span><span class='p'>.</span><span class='nc'>GetVar</span><span class='o'>;</span> <span class='n'>x</span><span class='o'>;</span>
<span class='n'>get_x5</span><span class='o'>;</span> <span class='o'>(</span><span class='k'>fun</span> <span class='n'>self</span> <span class='o'>-></span> <span class='n'>sendself</span> <span class='n'>self</span> <span class='n'>get_x</span> <span class='o'>+</span> <span class='mi'>5</span><span class='o'>);</span>
<span class='o'>|]</span>
<span class='o'>...</span>
</code></pre>
</div>
<p>Here <code>sendself</code> is a form of <code>Lsend</code> for self-calls, where we know the method slot at compile time. Instead of generating the <code>Kgetpubmet</code> bytecode, it generates <code>Kgetmethod</code>, which just does an array reference to find the method.</p>
<p>A class with a super-call:</p>
<div class='highlight'><pre><code class='ocaml'><span class='k'>class</span> <span class='n'>point</span> <span class='o'>=</span> <span class='o'>...</span> <span class='c'>(* as before *)</span>
<span class='k'>class</span> <span class='n'>point_sub</span> <span class='o'>=</span>
<span class='k'>object</span>
<span class='k'>inherit</span> <span class='n'>point</span> <span class='k'>as</span> <span class='n'>super</span>
<span class='k'>method</span> <span class='n'>move1</span> <span class='n'>n</span> <span class='o'>=</span> <span class='n'>super</span><span class='o'>#</span><span class='n'>move</span> <span class='n'>n</span>
<span class='k'>end</span>
</code></pre>
</div>
<p>becomes:</p>
<div class='highlight'><pre><code class='ocaml'><span class='k'>let</span> <span class='n'>point</span> <span class='o'>=</span> <span class='o'>...</span> <span class='c'>(* as before *)</span>
<span class='k'>let</span> <span class='n'>point_sub</span> <span class='o'>=</span>
<span class='k'>let</span> <span class='n'>point_sub_init</span> <span class='n'>clas</span> <span class='o'>=</span>
<span class='o'>...</span>
<span class='k'>let</span> <span class='n'>inh</span> <span class='o'>=</span>
<span class='nn'>OO</span><span class='p'>.</span><span class='n'>inherits</span>
<span class='n'>clas</span> <span class='o'>[|</span><span class='s2'>"x"</span><span class='o'>|]</span> <span class='o'>[||]</span> <span class='o'>[|</span><span class='s2'>"get_x"</span><span class='o'>;</span><span class='s2'>"move"</span><span class='o'>|]</span> <span class='n'>point</span> <span class='bp'>true</span> <span class='k'>in</span>
<span class='k'>let</span> <span class='n'>move</span> <span class='o'>=</span> <span class='n'>inh</span><span class='o'>.(</span><span class='mi'>3</span><span class='o'>)</span> <span class='k'>in</span>
<span class='o'>...</span>
<span class='nn'>OO</span><span class='p'>.</span><span class='n'>set_methods</span> <span class='n'>clas</span> <span class='o'>[|</span>
<span class='n'>move1</span><span class='o'>;</span> <span class='o'>(</span><span class='k'>fun</span> <span class='n'>self</span> <span class='n'>n</span> <span class='o'>-></span> <span class='n'>move</span> <span class='n'>self</span> <span class='n'>n</span><span class='o'>)</span>
<span class='o'>|];</span>
<span class='o'>...</span>
</code></pre>
</div>
<p>In this case, we are able to look up the actual function for the super-call in the class constructor (returned from <code>inherits</code>), so the invocation is just a function application rather than a slot dereference.</p>
<p>I don’t totally understand why we don’t know the function for self calls. I think it is because the superclass constructor runs before the subclass constructor, so the slot is assigned (this happens before the class constructors are called) but the function hasn’t been filled in yet. Still it seems like the knot could somehow be tied at class construction time to avoid a runtime slot dereference.</p>
<b>ocamljs implementation</b>
<p>The main design goal is that we be able to call methods on ordinary Javascript objects with the OCaml method call syntax, simply by declaring a class type giving the signature of the object. So if you want to work with the browser DOM you can say:</p>
<div class='highlight'><pre><code class='ocaml'><span class='k'>class</span> <span class='k'>type</span> <span class='n'>document</span> <span class='o'>=</span>
<span class='k'>object</span>
<span class='k'>method</span> <span class='n'>getElementById</span> <span class='o'>:</span> <span class='kt'>string</span> <span class='o'>-></span> <span class='o'>#</span><span class='n'>element</span>
<span class='o'>...</span> <span class='c'>(* and so on *)</span>
<span class='k'>end</span>
</code></pre>
</div>
<p>for some appropriate <code>element</code> type (see <code>src/dom/dom.mli</code> in <code>ocamljs</code> for a full definition), and say:</p>
<div class='highlight'><pre><code class='ocaml'><span class='n'>document</span><span class='o'>#</span><span class='n'>getElementById</span> <span class='s2'>"content"</span>
</code></pre>
</div>
<p>to make the call.</p>
<p>These are always public method calls, so they use the <code>Lsend</code> lambda form. We don’t want to do method label dispatch, since Javascript already has dispatch by name, so first off we need to carry the name rather than the label in <code>Lsend</code>.</p>
<p>We have seen how <code>self</code> is passed as the first argument when methods are invoked. We can’t do that for an arbitrary Javascript function, but the function might use <code>this</code>, so we need to be sure that <code>this</code> points to the object.</p>
<p>There is no way to know at compile time whether a particular method invocation is on a regular Javascript object or an OCaml object. Maybe we could mark OCaml objects somehow and do a check at runtime, but I decided to stick with a single calling convention. So whatever OCaml objects compile to, they have to support the convention for regular Javascript objects—<code>foo#bar</code> compiles to <code>foo.bar</code>, with <code>this</code> set to <code>foo</code>.</p>
<p>As we have seen, self-calls are compiled to a slot lookup rather than a name lookup, so we also need to support indexing into <code>methods</code>.</p>
<p>So here’s the design: an OCaml object is represented by a Javascript object, with numbered slots containing the instance variables. There is a constructor for each class, with <code>prototype</code> set up so each method is accessible by name, and the whole <code>methods</code> block is accessible in a special field, so we can call by slot. (Since we don’t need method labels, <code>methods</code> just holds functions.)</p>
<p>The calling convention passes <code>self</code> in <code>this</code>, so we bind a local <code>self</code> variable to <code>this</code> on entry to each method. It doesn’t work to say <code>this</code> everywhere instead of <code>self</code>, because <code>this</code> in Javascript is a bit fragile. In particular, if you define and apply a local function (<code>ocamljs</code> does this frequently), <code>this</code> is null rather than the lexically-visible <code>this</code>.</p>
<p>For <code>sendself</code> we look up the function by slot in the special methods field. Finally, for super-calls, we know the function at class construction time. In this case the function is applied directly, but we need to take care to treat it as a method application rather than an ordinary function call, since the calling convention is different.</p>
<b>The bug</b>
<p>The OCaml compiler turns super-calls into function applications very early in compilation (during typechecking in <code>typecore.ml</code>). There is no difference in calling convention for regular OCaml, so it doesn’t matter that later phases don’t know that these function applications are super-calls. But in our case we have to carry this information forward to the point where we generate Javascript (in <code>jsgen.ml</code>). It is a little tricky without changing the “typedtree” intermediate language.</p>
<p>I had put in a hack to mark these applications with a special extra argument, and it worked fine for my test program, where the method had no arguments. I didn’t think through or test the case where the method has arguments though. I was able to fix it (I think!) with a different hack: super calls are compiled to self calls (that is, to <code>Texp_send</code> with <code>Tmeth_val</code>) but the identifier in <code>Tmeth_val</code> is marked with an unused bit to indicate that it binds a function rather than a slot, so we don’t need to dereference it.</p>
<hr /><b>Appendix: other features</b>
<p>It is interesting to see how the various features of the object system are implemented, but maybe not that interesting, so here they are as an appendix.</p>
<b>Constructor parameters</b>
<p>A class definition with a constructor parameter:</p>
<div class='highlight'><pre><code class='ocaml'><span class='k'>class</span> <span class='n'>point</span> <span class='n'>x_init</span> <span class='o'>=</span>
<span class='k'>object</span>
<span class='k'>val</span> <span class='k'>mutable</span> <span class='n'>x</span> <span class='o'>=</span> <span class='n'>x_init</span>
<span class='o'>...</span> <span class='c'>(* as before *)</span>
<span class='k'>end</span>
</code></pre>
</div>
<p>compiles to:</p>
<div class='highlight'><pre><code class='ocaml'><span class='k'>let</span> <span class='n'>point</span> <span class='o'>=</span>
<span class='k'>let</span> <span class='n'>point_init</span> <span class='n'>clas</span> <span class='o'>=</span>
<span class='o'>...</span> <span class='c'>(* as before *)</span>
<span class='o'>(</span><span class='k'>fun</span> <span class='n'>env</span> <span class='n'>self</span> <span class='n'>x_init</span> <span class='o'>-></span>
<span class='nn'>OO</span><span class='p'>.</span><span class='n'>create_object_opt</span> <span class='n'>self</span> <span class='n'>clas</span><span class='o'>;</span>
<span class='n'>self</span><span class='o'>.(</span><span class='n'>x</span><span class='o'>)</span> <span class='o'><-</span> <span class='n'>x_init</span><span class='o'>;</span>
<span class='n'>self</span><span class='o'>)</span> <span class='k'>in</span>
<span class='o'>...</span> <span class='c'>(* as before *)</span>
</code></pre>
</div>
<p>So the constructor parameter in the surface syntax just turns into a constructor parameter internally. (There is a slightly funny interaction between constructor parameters and <code>let</code>-bound expressions after <code>class</code> but before <code>object</code>: if there is no constructor parameter the <code>let</code> is evaluated at class construction, but if there is a parameter it is evaluated at object construction, whether or not it depends on the parameter.)</p>
<b>Virtual methods and instance variables</b>
<p>A class definition with a virtual method:</p>
<div class='highlight'><pre><code class='ocaml'><span class='k'>class</span> <span class='k'>virtual</span> <span class='n'>abs_point</span> <span class='o'>=</span>
<span class='k'>object</span>
<span class='k'>method</span> <span class='k'>virtual</span> <span class='n'>move</span> <span class='o'>:</span> <span class='kt'>int</span> <span class='o'>-></span> <span class='kt'>unit</span>
<span class='k'>end</span>
</code></pre>
</div>
<p>compiles to:</p>
<div class='highlight'><pre><code class='ocaml'><span class='k'>let</span> <span class='n'>abs_point</span> <span class='o'>=</span> <span class='o'>[|</span>
<span class='mi'>0</span><span class='o'>;</span>
<span class='o'>(</span><span class='k'>fun</span> <span class='n'>clas</span> <span class='o'>-></span>
<span class='k'>let</span> <span class='n'>move</span> <span class='o'>=</span> <span class='nn'>OO</span><span class='p'>.</span><span class='n'>get_method_label</span> <span class='n'>clas</span> <span class='s2'>"move"</span> <span class='k'>in</span>
<span class='o'>(</span><span class='k'>fun</span> <span class='n'>env</span> <span class='n'>self</span> <span class='o'>-></span>
<span class='nn'>OO</span><span class='p'>.</span><span class='n'>create_object_opt</span> <span class='n'>self</span> <span class='n'>clas</span><span class='o'>);</span>
<span class='mi'>0</span><span class='o'>;</span> <span class='mi'>0</span>
<span class='o'>|]</span>
</code></pre>
</div>
<p>Since a virtual class can’t be instantiated, there’s no need to create the class table with <code>make_class</code>; we just return the tuple that represents the class, containing the class and object constructor. (I don’t understand the call to <code>get_method_label</code>, since its value is unused; possibly it is called for its side effect, which is to register the method in the class table if it does not already exist.)</p>
<p>A subclass implementing the virtual method inherits from the virtual class in the usual way.</p>
<p>A class declaration with a virtual instance variable:</p>
<div class='highlight'><pre><code class='ocaml'><span class='k'>class</span> <span class='k'>virtual</span> <span class='n'>abs_point2</span> <span class='o'>=</span>
<span class='k'>object</span>
<span class='k'>val</span> <span class='k'>mutable</span> <span class='k'>virtual</span> <span class='n'>x</span> <span class='o'>:</span> <span class='kt'>int</span>
<span class='k'>method</span> <span class='n'>move</span> <span class='n'>d</span> <span class='o'>=</span> <span class='n'>x</span> <span class='o'><-</span> <span class='n'>x</span> <span class='o'>+</span> <span class='n'>d</span>
<span class='k'>end</span>
</code></pre>
</div>
<p>becomes:</p>
<div class='highlight'><pre><code class='ocaml'><span class='k'>let</span> <span class='n'>abs_point</span> <span class='o'>=</span> <span class='o'>[|</span>
<span class='mi'>0</span><span class='o'>;</span>
<span class='o'>(</span><span class='k'>fun</span> <span class='n'>clas</span>
<span class='k'>let</span> <span class='n'>ids</span> <span class='o'>=</span>
<span class='nn'>OO</span><span class='p'>.</span><span class='n'>new_methods_variables</span> <span class='o'>[|</span><span class='s2'>"move"</span><span class='o'>|]</span> <span class='o'>[|</span><span class='s2'>"x"</span><span class='o'>|]</span> <span class='k'>in</span>
<span class='o'>...</span> <span class='c'>(* as before *)</span><span class='o'>);</span>
<span class='mi'>0</span><span class='o'>;</span> <span class='mi'>0</span>
<span class='o'>|]</span>
</code></pre>
</div>
<p>Again, a subclass providing the instance variable inherits from the virtual class in the usual way. By the time <code>new_methods_variables</code> is called in the superclass, the subclass has registered a slot for the variable.</p>
<b>Private methods</b>
<p>A class definition with a private method:</p>
<div class='highlight'><pre><code class='ocaml'><span class='k'>class</span> <span class='n'>point</span> <span class='o'>=</span>
<span class='k'>object</span>
<span class='k'>val</span> <span class='k'>mutable</span> <span class='n'>x</span> <span class='o'>=</span> <span class='mi'>0</span>
<span class='k'>method</span> <span class='n'>get_x</span> <span class='o'>=</span> <span class='n'>x</span>
<span class='k'>method</span> <span class='k'>private</span> <span class='n'>move</span> <span class='n'>d</span> <span class='o'>=</span> <span class='n'>x</span> <span class='o'><-</span> <span class='n'>x</span> <span class='o'>+</span> <span class='n'>d</span>
<span class='k'>end</span>
</code></pre>
</div>
<p>compiles to:</p>
<div class='highlight'><pre><code class='ocaml'><span class='k'>let</span> <span class='n'>point</span> <span class='o'>=</span>
<span class='k'>let</span> <span class='n'>point_init</span> <span class='n'>clas</span> <span class='o'>=</span>
<span class='k'>let</span> <span class='n'>ids</span> <span class='o'>=</span>
<span class='nn'>OO</span><span class='p'>.</span><span class='n'>new_methods_variables</span> <span class='n'>clas</span> <span class='o'>[|</span><span class='s2'>"move"</span><span class='o'>;</span><span class='s2'>"get_x"</span><span class='o'>|]</span> <span class='o'>[|</span><span class='s2'>"x"</span><span class='o'>|]</span> <span class='k'>in</span>
<span class='o'>...</span> <span class='c'>(* as before *)</span>
<span class='nn'>OO</span><span class='p'>.</span><span class='n'>make_class</span> <span class='o'>[|</span><span class='s2'>"get_x"</span><span class='o'>|]</span> <span class='n'>point_init</span>
</code></pre>
</div>
<p>Everything is the same except that the private method is not listed in the public methods of the class. Since a private method is callable only from code in which the class of the object is statically known, there is no need for dispatch or a method label. The private method functions are stored in <code>methods</code> after the public methods and method labels.</p>
<p>If we expose a private method in a subclass:</p>
<div class='highlight'><pre><code class='ocaml'><span class='k'>class</span> <span class='n'>point</span> <span class='o'>=</span> <span class='o'>...</span> <span class='c'>(* as before *)</span>
<span class='k'>class</span> <span class='n'>point_sub</span> <span class='o'>=</span>
<span class='k'>object</span>
<span class='k'>inherit</span> <span class='n'>point</span>
<span class='k'>method</span> <span class='k'>virtual</span> <span class='n'>move</span> <span class='o'>:</span> <span class='o'>_</span>
<span class='k'>end</span>
</code></pre>
</div>
<p>we get:</p>
<div class='highlight'><pre><code class='ocaml'><span class='k'>let</span> <span class='n'>point</span> <span class='o'>=</span> <span class='o'>...</span> <span class='c'>(* as before *)</span>
<span class='k'>let</span> <span class='n'>point_sub</span> <span class='o'>=</span>
<span class='k'>let</span> <span class='n'>point_sub_init</span> <span class='n'>clas</span> <span class='o'>=</span> <span class='o'>...</span> <span class='c'>(* as before *)</span>
<span class='nn'>OO</span><span class='p'>.</span><span class='n'>make_class</span> <span class='o'>[|</span><span class='s2'>"move"</span><span class='o'>;</span><span class='s2'>"get_x"</span><span class='o'>|]</span> <span class='n'>point_sub_init</span>
</code></pre>
</div>
<p>Putting <code>"move"</code> in the call to <code>make_class</code> registers it as a public method, so later, when <code>set_method</code> is called for <code>move</code> in the superclass constructor, it puts the method and its label in <code>methods</code> for dispatch.</p>Jake Donhamhttp://www.blogger.com/profile/04768087689799941690noreply@blogger.com2tag:blogger.com,1999:blog-1445545651031573301.post-1221236016203696392010-03-02T18:09:00.000-08:002010-03-02T18:18:17.862-08:00Reading Camlp4, part 5: filters<p>Hey, long time no see!</p>
<p>It is high time to get back to Camlp4, so I would like to pick up the thread by covering Camlp4 <em>filters</em>. We have previously considered the parsing and pretty-printing facilities of Camlp4 separately. But of course the most common way to use Camlp4 is as a front-end to <code>ocamlc</code>, where it processes files by parsing them into an AST and pretty-printing them back to text (well, not quite—we will see below how the AST is passed to <code>ocamlc</code>). In between we can insert filters to transform the AST.</p>
<b>A simple filter</b>
<p>So let’s dive into an example: a filter for type definitions that generates <code>t_to_string</code> and <code>t_of_string</code> functions for a type <code>t</code>, a little like Haskell’s <code>deriving Show, Read</code>. To keep it simple we handle only variant types, and only those where all the arms have no data. Here goes:</p>
<div class='highlight'><pre><code class='ocaml'><span class='k'>module</span> <span class='nc'>Make</span> <span class='o'>(</span><span class='nc'>AstFilters</span> <span class='o'>:</span> <span class='nn'>Camlp4</span><span class='p'>.</span><span class='nn'>Sig</span><span class='p'>.</span><span class='nc'>AstFilters</span><span class='o'>)</span> <span class='o'>=</span>
<span class='k'>struct</span>
<span class='k'>open</span> <span class='nc'>AstFilters</span>
</code></pre>
</div>
<p>In order to hook into Camlp4’s plugin mechanism we define the filter as a functor. By opening <code>AstFilters</code> we get an <code>Ast</code> module in scope. Unfortunately this is not the same <code>Ast</code> we got previously from <code>Camlp4.PreCast</code> (although it has the same signature) so all our code that uses <code>Ast</code> (including all OCaml syntax quotations) needs to go inside the functor body.</p>
<div class='highlight'><pre><code class='ocaml'> <span class='k'>let</span> <span class='k'>rec</span> <span class='n'>filter</span> <span class='n'>si</span> <span class='o'>=</span>
<span class='k'>match</span> <span class='n'>wrap_str_item</span> <span class='n'>si</span> <span class='k'>with</span>
<span class='o'>|</span> <span class='o'><:</span><span class='n'>str_item</span><span class='o'><</span> <span class='k'>type</span> <span class='o'>$</span><span class='n'>lid</span><span class='o'>:</span><span class='n'>tid</span><span class='o'>$</span> <span class='o'>=</span> <span class='o'>$</span><span class='nn'>Ast</span><span class='p'>.</span><span class='nc'>TySum</span> <span class='o'>(_,</span> <span class='n'>ors</span><span class='o'>)$</span> <span class='o'>>></span> <span class='o'>-></span>
<span class='k'>begin</span>
<span class='k'>try</span>
<span class='k'>let</span> <span class='n'>cons</span> <span class='o'>=</span>
<span class='nn'>List</span><span class='p'>.</span><span class='n'>map</span>
<span class='o'>(</span><span class='k'>function</span>
<span class='o'>|</span> <span class='o'><:</span><span class='n'>ctyp</span><span class='o'><</span> <span class='o'>$</span><span class='n'>uid</span><span class='o'>:</span> <span class='n'>c</span><span class='o'>$</span> <span class='o'>>></span> <span class='o'>-></span> <span class='n'>c</span>
<span class='o'>|</span> <span class='o'>_</span> <span class='o'>-></span> <span class='k'>raise</span> <span class='nc'>Exit</span><span class='o'>)</span>
<span class='o'>(</span><span class='nn'>Ast</span><span class='p'>.</span><span class='n'>list_of_ctyp</span> <span class='n'>ors</span> <span class='bp'>[]</span><span class='o'>)</span> <span class='k'>in</span>
<span class='n'>to_of_string</span> <span class='n'>si</span> <span class='n'>tid</span> <span class='n'>cons</span>
<span class='k'>with</span> <span class='nc'>Exit</span> <span class='o'>-></span> <span class='n'>si</span>
<span class='k'>end</span>
<span class='o'>|</span> <span class='o'>_</span> <span class='o'>-></span> <span class='n'>si</span>
</code></pre>
</div>
<p>The <code>filter</code> function filters <code>Ast.str_item</code>s. (It is not actually recursive but we say <code>let rec</code> so we can define helper functions afterward). If a <code>str_item</code> has the right form we transform it by calling <code>to_of_string</code>, otherwise we return it unchanged. We match a sum type definition, then extract the constructor names (provided that they have no data) into a string list. (Recall that a <code>TySum</code> contains arms separated by <code>TyOr</code>; the call to <code>list_of_ctyp</code> converts that to a list of arms.)</p>
<div class='highlight'><pre><code class='ocaml'> <span class='ow'>and</span> <span class='n'>wrap_str_item</span> <span class='n'>si</span> <span class='o'>=</span>
<span class='k'>let</span> <span class='o'>_</span><span class='n'>loc</span> <span class='o'>=</span> <span class='nn'>Ast</span><span class='p'>.</span><span class='n'>loc_of_str_item</span> <span class='n'>si</span> <span class='k'>in</span>
<span class='o'><:</span><span class='n'>str_item</span><span class='o'><</span> <span class='o'>$</span><span class='n'>si</span><span class='o'>$</span> <span class='o'>>></span>
</code></pre>
</div>
<p>For some reason, <code><:str_item< $si$ >></code> wraps an extra <code>StSem</code> / <code>StNil</code> around <code>si</code>, so in order to use the quotation syntax on the left-hand side of a pattern match we need to do the same wrapping.</p>
<div class='highlight'><pre><code class='ocaml'> <span class='ow'>and</span> <span class='n'>to_of_string</span> <span class='n'>si</span> <span class='n'>tid</span> <span class='n'>cons</span> <span class='o'>=</span>
<span class='k'>let</span> <span class='o'>_</span><span class='n'>loc</span> <span class='o'>=</span> <span class='nn'>Ast</span><span class='p'>.</span><span class='n'>loc_of_str_item</span> <span class='n'>si</span> <span class='k'>in</span>
<span class='o'><:</span><span class='n'>str_item</span><span class='o'><</span>
<span class='o'>$</span><span class='n'>si</span><span class='o'>$;;</span>
<span class='o'>$</span><span class='n'>to_string</span> <span class='o'>_</span><span class='n'>loc</span> <span class='n'>tid</span> <span class='n'>cons</span><span class='o'>$;;</span>
<span class='o'>$</span><span class='n'>of_string</span> <span class='o'>_</span><span class='n'>loc</span> <span class='n'>tid</span> <span class='n'>cons</span><span class='o'>$;;</span>
<span class='o'>>></span>
</code></pre>
</div>
<p>This <code>str_item</code> replaces the original one in the output, so we include the original one in additional to new ones containing the <code>t_to_string</code> and <code>t_of_string</code> functions.</p>
<div class='highlight'><pre><code class='ocaml'> <span class='ow'>and</span> <span class='n'>to_string</span> <span class='o'>_</span><span class='n'>loc</span> <span class='n'>tid</span> <span class='n'>cons</span> <span class='o'>=</span>
<span class='o'><:</span><span class='n'>str_item</span><span class='o'><</span>
<span class='k'>let</span> <span class='o'>$</span><span class='n'>lid</span><span class='o'>:</span> <span class='n'>tid</span> <span class='o'>^</span> <span class='s2'>"_to_string"</span><span class='o'>$</span> <span class='o'>=</span> <span class='k'>function</span>
<span class='o'>$</span><span class='kt'>list</span><span class='o'>:</span>
<span class='nn'>List</span><span class='p'>.</span><span class='n'>map</span>
<span class='o'>(</span><span class='k'>fun</span> <span class='n'>c</span> <span class='o'>-></span> <span class='o'><:</span><span class='n'>match_case</span><span class='o'><</span> <span class='o'>$</span><span class='n'>uid</span><span class='o'>:</span> <span class='n'>c</span><span class='o'>$</span> <span class='o'>-></span> <span class='o'>$`</span><span class='n'>str</span><span class='o'>:</span> <span class='n'>c</span><span class='o'>$</span> <span class='o'>>>)</span>
<span class='n'>cons</span><span class='o'>$</span>
<span class='o'>>></span>
</code></pre>
</div>
<p>To convert a variant to a string, we match over its constructors and return the corresponding string.</p>
<div class='highlight'><pre><code class='ocaml'> <span class='ow'>and</span> <span class='n'>of_string</span> <span class='o'>_</span><span class='n'>loc</span> <span class='n'>tid</span> <span class='n'>cons</span> <span class='o'>=</span>
<span class='o'><:</span><span class='n'>str_item</span><span class='o'><</span>
<span class='k'>let</span> <span class='o'>$</span><span class='n'>lid</span><span class='o'>:</span> <span class='n'>tid</span> <span class='o'>^</span> <span class='s2'>"_of_string"</span><span class='o'>$</span> <span class='o'>=</span> <span class='k'>function</span>
<span class='o'>$</span><span class='kt'>list</span><span class='o'>:</span>
<span class='nn'>List</span><span class='p'>.</span><span class='n'>map</span>
<span class='o'>(</span><span class='k'>fun</span> <span class='n'>c</span> <span class='o'>-></span> <span class='o'><:</span><span class='n'>match_case</span><span class='o'><</span>
<span class='o'>$</span><span class='n'>tup</span><span class='o'>:</span> <span class='o'><:</span><span class='n'>patt</span><span class='o'><</span> <span class='o'>$`</span><span class='n'>str</span><span class='o'>:</span> <span class='n'>c</span><span class='o'>$</span> <span class='o'>>>$</span> <span class='o'>-></span> <span class='o'>$</span><span class='n'>uid</span><span class='o'>:</span> <span class='n'>c</span><span class='o'>$</span>
<span class='o'>>>)</span>
<span class='n'>cons</span><span class='o'>$</span>
<span class='o'>|</span> <span class='o'>_</span> <span class='o'>-></span> <span class='n'>invalid_arg</span> <span class='s2'>"bad string"</span>
<span class='o'>>></span>
</code></pre>
</div>
<p>To convert a string to a variant, we match over the corresponding string for each constructor and return the constructor; we also need a catchall for strings that match no constructor. (What is this <code>tup</code> and <code>patt</code> business? A contrived bug which we will fix below.)</p>
<div class='highlight'><pre><code class='ocaml'> <span class='o'>;;</span>
<span class='nn'>AstFilters</span><span class='p'>.</span><span class='n'>register_str_item_filter</span> <span class='k'>begin</span> <span class='k'>fun</span> <span class='n'>si</span> <span class='o'>-></span>
<span class='k'>let</span> <span class='o'>_</span><span class='n'>loc</span> <span class='o'>=</span> <span class='nn'>Ast</span><span class='p'>.</span><span class='n'>loc_of_str_item</span> <span class='n'>si</span> <span class='k'>in</span>
<span class='o'><:</span><span class='n'>str_item</span><span class='o'><</span>
<span class='o'>$</span><span class='kt'>list</span><span class='o'>:</span> <span class='nn'>List</span><span class='p'>.</span><span class='n'>map</span> <span class='n'>filter</span> <span class='o'>(</span><span class='nn'>Ast</span><span class='p'>.</span><span class='n'>list_of_str_item</span> <span class='n'>si</span> <span class='bp'>[]</span><span class='o'>)$</span>
<span class='o'>>></span>
<span class='k'>end</span>
</code></pre>
</div>
<p>Now we register our filter function with Camlp4. The input <code>str_item</code> may contain many <code>str_items</code>s separated by <code>StSem</code>, so we call <code>list_of_str_item</code> to get a list of individuals.</p>
<div class='highlight'><pre><code class='ocaml'><span class='k'>end</span>
<span class='k'>module</span> <span class='nc'>Id</span> <span class='o'>=</span>
<span class='k'>struct</span>
<span class='k'>let</span> <span class='n'>name</span> <span class='o'>=</span> <span class='s2'>"to_of_string"</span>
<span class='k'>let</span> <span class='n'>version</span> <span class='o'>=</span> <span class='s2'>"0.1"</span>
<span class='k'>end</span>
<span class='o'>;;</span>
<span class='k'>let</span> <span class='k'>module</span> <span class='nc'>M</span> <span class='o'>=</span> <span class='nn'>Camlp4</span><span class='p'>.</span><span class='nn'>Register</span><span class='p'>.</span><span class='nc'>AstFilter</span><span class='o'>(</span><span class='nc'>Id</span><span class='o'>)(</span><span class='nc'>Make</span><span class='o'>)</span> <span class='k'>in</span> <span class='bp'>()</span>
</code></pre>
</div>
<p>Finally we register the plugin with Camlp4. The functor application is just for its side effect, so the plugin is registered when its <code>.cmo</code> is loaded. We can compile the plugin with</p>
<div class='highlight'><pre><code class='bash'>ocamlfind ocamlc -package camlp4.quotations.o -syntax camlp4o <span class='se'>\</span>
-c to_of_string.ml
</code></pre>
</div>
<p>and run it on a file (containing <code>type t = Foo | Bar | Baz</code> or something) with</p>
<div class='highlight'><pre><code class='bash'>camlp4o to_of_string.cmo <span class='nb'>test</span>.ml
</code></pre>
</div><b>Ocamlc's AST</b>
<p>Looks pretty good, right? But something goes wrong when we try to use our plugin as a frontend for <code>ocamlc</code>:</p>
<div class='highlight'><pre><code class='bash'>ocamlc -pp <span class='s1'>'camlp4o ./to_of_string.cmo'</span> <span class='nb'>test</span>.ml
</code></pre>
</div>
<p>We get a preprocessor error, “singleton tuple pattern”. It turns out that Camlp4 passes the processed AST to <code>ocamlc</code> not by pretty-printing it to text, but by converting it to the AST type that <code>ocamlc</code> uses and marshalling it. This saves the time of reparsing it, and also passes along correct file locations (compare to <code>cpp</code>’s <code>#line</code> directives). However, as we have seen, the Camlp4 AST is pretty loose. When converting to an <code>ocamlc</code> AST, Camlp4 does some validity checks on the tree. What can be confusing is that an AST that fails these checks may look fine when pretty-printed.</p>
<p>Here the culprit is the line</p>
<div class='highlight'><pre><code class='ocaml'> <span class='o'>$</span><span class='n'>tup</span><span class='o'>:</span> <span class='o'><:</span><span class='n'>patt</span><span class='o'><</span> <span class='o'>$`</span><span class='n'>str</span><span class='o'>:</span> <span class='n'>c</span><span class='o'>$</span> <span class='o'>>>$</span> <span class='o'>-></span> <span class='o'>$</span><span class='n'>uid</span><span class='o'>:</span> <span class='n'>c</span><span class='o'>$</span>
</code></pre>
</div>
<p>which produces an invalid pattern consisting of a one-item tuple. When pretty-printed, though, the <code>tup</code> just turns into an extra set of parentheses, which <code>ocamlc</code> doesn’t mind. What we wanted was</p>
<div class='highlight'><pre><code class='ocaml'> <span class='o'>$`</span><span class='n'>str</span><span class='o'>:</span> <span class='n'>c</span><span class='o'>$</span> <span class='o'>-></span> <span class='o'>$</span><span class='n'>uid</span><span class='o'>:</span> <span class='n'>c</span><span class='o'>$</span>
</code></pre>
</div>
<p>This is a contrived example, but this kind of error is easy to make, and can be hard to debug, because looking at the pretty-printed output doesn’t tell you what’s wrong. One tactic is to run your code in the toplevel, which will print the constructors of the AST as usual. Another is to use a filter that comes with Camlp4 to “lift” the AST—that is, to generate the AST representing the original AST! Maybe it is easier to try it than to explain it:</p>
<div class='highlight'><pre><code class='bash'>camlp4o to_of_string.cmo -filter Camlp4AstLifter <span class='nb'>test</span>.ml
</code></pre>
</div>
<p>Now compare the result to the tree you get back from Camlp4’s parser for the code you <em>meant</em> to write, and you can probably spot your mistake.</p>
<p>(If you tried to redirect the <code>camlp4o</code> command to a file or pipe it through <code>less</code> you got some line noise—this is the marshalled <code>ocamlc</code> AST. By default Camlp4 checks whether its output is a TTY; if so it calls the pretty-printer, if not the <code>ocamlc</code> AST marshaller. To override this use the <code>-printer o</code> option, or <code>-printer r</code> for revised syntax.)</p>
<b>Other builtin filters</b>
<p>This <code>Camlp4AstLifter</code> is pretty useful. What else comes with Camlp4? There are several other filters in <code>camlp4/Camlp4Filters</code> which you can call with <code>-filter</code>:</p>
<ul>
<li>
<p><code>Camlp4FoldGenerator</code> generates visitor classes from datatypes. Try putting <code>class x = Camlp4MapGenerator.generated</code> after a type definition. The idea is that you can override methods of the visitor so you can do some transformation on a tree without having to write the boilerplate to walk the parts you don’t care about. In fact, this filter is used as part of the Camlp4 bootstrap to generate vistors for the AST; you can see the <code>map</code> and <code>fold</code> classes in <code>camlp4/Camlp4/Sig.ml</code>.</p>
</li>
<li>
<p><code>Camlp4MetaGenerator</code> generates lifting functions from a type definition—these functions are what <code>Camlp4AstLifter</code> uses to lift the AST, and it’s also how quotations are implemented. I’m planning to cover how to implement quotations / antiquotations (for a different language) in a future post, and <code>Camlp4MetaGenerator</code> will be crucial.</p>
</li>
<li>
<p><code>Camlp4LocationStripper</code> replaces all the locations in an AST with <code>Loc.ghost</code>. I don’t know what this is for, but it might be useful if you wanted to compare two ASTs and be insensitive to their locations.</p>
</li>
<li>
<p><code>Camlp4Profiler</code> inserts profiling code, in the form of function call counts. I haven’t tried it, and I’m not sure when you would want it in preference to gprof.</p>
</li>
<li>
<p><code>Camlp4TrashRemover</code> just filters out a module called <code>Camlp4Trash</code>. Such a module may be found in <code>camlp4/Camlp4/Struct/Camlp4Ast.mlast</code>; I think the idea is that the module is there in order to generate some stuff, but the module itself is not needed.</p>
</li>
<li>
<p><code>Camlp4MapGenerator</code> has been subsumed by <code>Camlp4FoldGenerator</code>.</p>
</li>
<li>
<p><code>Camlp4ExceptionTracer</code> seems to be a special-purpose tool to help debug Camlp4.</p>
</li>
</ul>
<p>OK, maybe not too much useful stuff here, but it is interesting to work out how Camlp4 is bootstrapped.</p>
<p>I think next time I will get into Camlp4’s extensible parsers, on the way toward syntax extensions.</p>
<b>Colophon</b>
<p>I wrote my previous posts in raw HTML, with highlighted code generated from a hightlighted Emacs buffer by <a href='http://fly.cc.fer.hr/~hniksic/emacs/htmlize.el'>htmlize.el</a>. Iterating on this setup was unutterably painful. This post was written using <a href='http://github.com/mojombo/jekyll'>jekyll</a> with a simple template to approximate the Blogspot formatting, mostly so I can check that lines of code aren’t too long. Jekyll is very nice: you can write text with <a href='http://maruku.rubyforge.org/'>Markdown</a>, and highlight code with <a href='http://pygments.org/'>Pygments</a>.</p>Jake Donhamhttp://www.blogger.com/profile/04768087689799941690noreply@blogger.com4tag:blogger.com,1999:blog-1445545651031573301.post-33536698089196082072009-05-27T20:28:00.000-07:002010-07-27T10:59:49.495-07:00Lwt and Concurrent ML<p>Programming concurrent systems with threads and locks is famously, even fabulously, error-prone. With Lwt's cooperative threads you don't have to worry so much about protecting data structures against concurrent modification, since your code runs atomically between <code>bind</code>s. Still, the standard concurrency primitives (mutexes, condition variables) are sometimes useful; but using them with Lwt is not much less painful than with preemptive threads. In this post I want to explore the combination of Lwt with the concurrency primitives of <a href="http://cml.cs.uchicago.edu/">Concurrent ML</a>. I hope to convince you that CML's primitives are easier to use, and a good match for Lwt.<br />
</p><b>Blocking queues in Lwt</b><br />
<p>I got started with Lwt when I was writing a work queue (as an Ocamlnet RPC service using <a href="http://code.google.com/p/orpc2/">orpc</a>). The server keeps a queue of jobs, and workers poll for a task via RPC. An RPC request turns into an Lwt thread; all these threads share the queue. If there's no job in the queue, a request blocks until one is available. So I needed a blocking queue, with the following signature:<br />
<pre><span class="htmlize-tuareg-font-lock-governing">type</span> <span class="htmlize-tuareg-font-lock-operator">'</span><span class="htmlize-type">a t</span>
<span class="htmlize-tuareg-font-lock-governing">val</span> <span class="htmlize-variable-name">create </span><span class="htmlize-tuareg-font-lock-operator">:</span> <span class="htmlize-type">unit </span><span class="htmlize-tuareg-font-lock-operator">-></span><span class="htmlize-type"> </span><span class="htmlize-tuareg-font-lock-operator">'</span><span class="htmlize-type">a t</span>
<span class="htmlize-tuareg-font-lock-governing">val</span> <span class="htmlize-variable-name">add </span><span class="htmlize-tuareg-font-lock-operator">:</span> <span class="htmlize-tuareg-font-lock-operator">'</span><span class="htmlize-type">a </span><span class="htmlize-tuareg-font-lock-operator">-></span><span class="htmlize-type"> </span><span class="htmlize-tuareg-font-lock-operator">'</span><span class="htmlize-type">a t </span><span class="htmlize-tuareg-font-lock-operator">-></span><span class="htmlize-type"> unit</span>
<span class="htmlize-tuareg-font-lock-governing">val</span> <span class="htmlize-variable-name">take </span><span class="htmlize-tuareg-font-lock-operator">:</span> <span class="htmlize-tuareg-font-lock-operator">'</span><span class="htmlize-type">a t </span><span class="htmlize-tuareg-font-lock-operator">-></span><span class="htmlize-type"> </span><span class="htmlize-tuareg-font-lock-operator">'</span><span class="htmlize-type">a Lwt.t</span>
</pre>The queue is unbounded, so you can <code>add</code> without blocking, but a <code>take</code> may block. (It's nice how in Lwt the possibility of blocking is revealed in the type). Here's the implementation: <pre><span class="htmlize-tuareg-font-lock-governing">type</span> <span class="htmlize-tuareg-font-lock-operator">'</span><span class="htmlize-type">a t </span><span class="htmlize-tuareg-font-lock-operator">=</span> <span class="htmlize-tuareg-font-lock-operator">{</span>
<span class="htmlize-variable-name">m</span> <span class="htmlize-tuareg-font-lock-operator">:</span> <span class="htmlize-type">Lwt_mutex.t</span><span class="htmlize-tuareg-font-lock-operator">;</span>
<span class="htmlize-variable-name">c</span> <span class="htmlize-tuareg-font-lock-operator">:</span> <span class="htmlize-type">Lwt_condition.t</span><span class="htmlize-tuareg-font-lock-operator">;</span>
<span class="htmlize-variable-name">q</span> <span class="htmlize-tuareg-font-lock-operator">:</span> <span class="htmlize-tuareg-font-lock-operator">'</span><span class="htmlize-type">a Queue.t</span><span class="htmlize-tuareg-font-lock-operator">;</span>
<span class="htmlize-tuareg-font-lock-operator">}</span>
<span class="htmlize-tuareg-font-lock-governing">let</span> <span class="htmlize-function-name">create</span><span class="htmlize-variable-name"> </span><span class="htmlize-tuareg-font-lock-operator">()</span><span class="htmlize-variable-name"> </span><span class="htmlize-tuareg-font-lock-operator">=</span> <span class="htmlize-tuareg-font-lock-operator">{</span>
m <span class="htmlize-tuareg-font-lock-operator">=</span> <span class="htmlize-type">Lwt_mutex</span>.create <span class="htmlize-tuareg-font-lock-operator">();</span>
c <span class="htmlize-tuareg-font-lock-operator">=</span> <span class="htmlize-type">Lwt_condition</span>.create <span class="htmlize-tuareg-font-lock-operator">();</span>
q <span class="htmlize-tuareg-font-lock-operator">=</span> <span class="htmlize-type">Queue</span>.create <span class="htmlize-tuareg-font-lock-operator">();</span>
<span class="htmlize-tuareg-font-lock-operator">}</span>
</pre>A queue is made up of a regular OCaml queue, a condition variable (signaled when there's something in the queue), and a mutex for use with the condition variable. (The <a href="http://code.google.com/p/orpc2/source/browse/trunk/src/lwt-equeue/lwt_condition.ml"><code>Lwt_condition</code></a> module is based on the <code>Condition</code> module of the standard OCaml threads library.) <pre><span class="htmlize-tuareg-font-lock-governing">let</span> <span class="htmlize-function-name">add</span><span class="htmlize-variable-name"> e t </span><span class="htmlize-tuareg-font-lock-operator">=</span>
<span class="htmlize-type">Queue</span>.add e t.q<span class="htmlize-tuareg-font-lock-operator">;</span>
<span class="htmlize-type">Lwt_condition</span>.signal t.c<span class="htmlize-tuareg-font-lock-operator"></span>
<span class="htmlize-tuareg-font-lock-governing">let</span> <span class="htmlize-function-name">take</span><span class="htmlize-variable-name"> t </span><span class="htmlize-tuareg-font-lock-operator">=</span>
<span class="htmlize-type">Lwt_mutex</span>.lock t.m <span class="htmlize-tuareg-font-lock-operator">>>=</span> <span class="htmlize-keyword">fun</span> <span class="htmlize-tuareg-font-lock-operator">()</span><span class="htmlize-variable-name"> </span><span class="htmlize-tuareg-font-lock-operator">-></span>
<span class="htmlize-keyword">if</span> <span class="htmlize-type">Queue</span>.is_empty t.q
<span class="htmlize-keyword">then</span> <span class="htmlize-type">Lwt_condition</span>.wait t.c t.m
<span class="htmlize-keyword">else</span> <span class="htmlize-type">Lwt</span>.return <span class="htmlize-tuareg-font-lock-operator">()</span> <span class="htmlize-tuareg-font-lock-operator">>>=</span> <span class="htmlize-keyword">fun</span> <span class="htmlize-tuareg-font-lock-operator">()</span><span class="htmlize-variable-name"> </span><span class="htmlize-tuareg-font-lock-operator">-></span>
<span class="htmlize-tuareg-font-lock-governing">let</span> <span class="htmlize-variable-name">e </span><span class="htmlize-tuareg-font-lock-operator">=</span> <span class="htmlize-type">Lwt</span>.return <span class="htmlize-tuareg-font-lock-operator">(</span><span class="htmlize-type">Queue</span>.take t.q<span class="htmlize-tuareg-font-lock-operator">)</span> <span class="htmlize-tuareg-font-lock-governing">in</span>
<span class="htmlize-type">Lwt_mutex</span>.unlock t.m<span class="htmlize-tuareg-font-lock-operator">;</span>
e
</pre>Since Lwt threads are cooperative we don't need to worry about concurrent access to the underlying queue. The role of the mutex here is only to ensure that when a thread blocked on the condition gets signaled, another thread can't take the element first.<br />
</p><b>Timeouts?</b><br />
<p>What if there are no entries in the queue for a while? Within a single process, no big deal, the thread can keep waiting forever. That doesn't seem like a good idea over a network connection; we should time out at some point and return a response indicating that no task is available. Here is a first attempt at taking an element from the queue with a timeout: <pre><span class="htmlize-type">Lwt</span>.choose <span class="htmlize-tuareg-font-lock-operator">[</span>
<span class="htmlize-type">Lwt_queue</span>.take q<span class="htmlize-tuareg-font-lock-operator">;</span>
<span class="htmlize-type">Lwt_unix</span>.sleep timeout <span class="htmlize-tuareg-font-lock-operator">>>=</span> <span class="htmlize-keyword">fun</span> <span class="htmlize-tuareg-font-lock-operator">()</span><span class="htmlize-variable-name"> </span><span class="htmlize-tuareg-font-lock-operator">-></span>
<span class="htmlize-type">Lwt</span>.fail <span class="htmlize-tuareg-font-lock-operator">(</span>Failure <span class="htmlize-string">"timeout"</span><span class="htmlize-tuareg-font-lock-operator">);</span>
<span class="htmlize-tuareg-font-lock-operator">]</span>
</pre>The <code>Lwt.choose</code> function "behaves as the first thread [...] to terminate". However, the other threads are still running after the first one terminates. It doesn't matter if the <code>sleep</code> is still running after the <code>take</code> completes, but if the <code>sleep</code> finishes first, then the <code>take</code> thread is still waiting to take an element from the queue. When an element becomes available, this thread takes it, and drops it on the floor (since the <code>choose</code> has already finished). And in general this sort of thing can happen whenever a thread you <code>choose</code> between has some effect; the effect still happens even if the thread is not chosen. A thread can block on only one condition at a time. In order to <code>take</code> an element with a timeout, we're forced to build timeouts into the queue, so we can get at the queue's condition variable. We add an optional argument to <code>take</code>: <pre><span class="htmlize-tuareg-font-lock-governing">val</span> <span class="htmlize-variable-name">take </span><span class="htmlize-tuareg-font-lock-operator">:</span> <span class="htmlize-tuareg-font-lock-operator">?</span><span class="htmlize-type">timeout</span><span class="htmlize-tuareg-font-lock-operator">:</span>float <span class="htmlize-tuareg-font-lock-operator">-></span> <span class="htmlize-tuareg-font-lock-operator">'</span>a t <span class="htmlize-tuareg-font-lock-operator">-></span> <span class="htmlize-tuareg-font-lock-operator">'</span>a <span class="htmlize-type">Lwt</span>.t
</pre>and modify the implementation: <pre><span class="htmlize-tuareg-font-lock-governing">let</span> <span class="htmlize-function-name">take</span><span class="htmlize-variable-name"> </span><span class="htmlize-tuareg-font-lock-operator">?(</span>timeout<span class="htmlize-tuareg-font-lock-operator">=(-</span>1.<span class="htmlize-tuareg-font-lock-operator">))</span> t <span class="htmlize-tuareg-font-lock-operator">=</span>
<span class="htmlize-tuareg-font-lock-governing">let</span> <span class="htmlize-variable-name">timed_out </span><span class="htmlize-tuareg-font-lock-operator">=</span> <span class="htmlize-tuareg-font-lock-operator">ref</span> <span class="htmlize-constant">false</span> <span class="htmlize-tuareg-font-lock-governing">in</span>
<span class="htmlize-keyword">if</span> timeout <span class="htmlize-tuareg-font-lock-operator">>=</span> 0.
<span class="htmlize-keyword">then</span>
<span class="htmlize-type">Lwt</span>.ignore_result
<span class="htmlize-tuareg-font-lock-operator">(</span><span class="htmlize-type">Lwt_unix</span>.sleep timeout <span class="htmlize-tuareg-font-lock-operator">>>=</span> <span class="htmlize-keyword">fun</span> <span class="htmlize-tuareg-font-lock-operator">()</span><span class="htmlize-variable-name"> </span><span class="htmlize-tuareg-font-lock-operator">-></span>
timed_out <span class="htmlize-tuareg-font-lock-operator">:=</span> <span class="htmlize-constant">true</span><span class="htmlize-tuareg-font-lock-operator">;</span>
<span class="htmlize-type">Lwt_condition</span>.broadcast t.c<span class="htmlize-tuareg-font-lock-operator">;</span>
<span class="htmlize-type">Lwt</span>.return <span class="htmlize-tuareg-font-lock-operator">());</span>
<span class="htmlize-type">Lwt_mutex</span>.lock t.m <span class="htmlize-tuareg-font-lock-operator">>>=</span> <span class="htmlize-keyword">fun</span> <span class="htmlize-tuareg-font-lock-operator">()</span><span class="htmlize-variable-name"> </span><span class="htmlize-tuareg-font-lock-operator">-></span>
<span class="htmlize-tuareg-font-lock-governing">let</span> <span class="htmlize-tuareg-font-lock-governing">rec</span> <span class="htmlize-function-name">while_empty</span><span class="htmlize-variable-name"> </span><span class="htmlize-tuareg-font-lock-operator">()</span><span class="htmlize-variable-name"> </span><span class="htmlize-tuareg-font-lock-operator">=</span>
<span class="htmlize-keyword">if</span> <span class="htmlize-tuareg-font-lock-operator">!</span>timed_out <span class="htmlize-keyword">then</span> <span class="htmlize-type">Lwt</span>.return <span class="htmlize-constant">false</span>
<span class="htmlize-keyword">else</span> <span class="htmlize-keyword">if</span> <span class="htmlize-tuareg-font-lock-operator">not</span> <span class="htmlize-tuareg-font-lock-operator">(</span><span class="htmlize-type">Queue</span>.is_empty t.q<span class="htmlize-tuareg-font-lock-operator">)</span> <span class="htmlize-keyword">then</span> <span class="htmlize-type">Lwt</span>.return <span class="htmlize-constant">true</span>
<span class="htmlize-keyword">else</span> <span class="htmlize-type">Lwt_condition</span>.wait t.c t.m <span class="htmlize-tuareg-font-lock-operator">>>=</span> while_empty <span class="htmlize-tuareg-font-lock-governing">in</span>
while_empty <span class="htmlize-tuareg-font-lock-operator">()</span> <span class="htmlize-tuareg-font-lock-operator">>>=</span> <span class="htmlize-keyword">fun</span> <span class="htmlize-variable-name">not_empty </span><span class="htmlize-tuareg-font-lock-operator">-></span>
<span class="htmlize-tuareg-font-lock-governing">let</span> <span class="htmlize-variable-name">e </span><span class="htmlize-tuareg-font-lock-operator">=</span> <span class="htmlize-keyword">if</span> not_empty <span class="htmlize-keyword">then</span> Some <span class="htmlize-tuareg-font-lock-operator">(</span><span class="htmlize-type">Queue</span>.take t.q<span class="htmlize-tuareg-font-lock-operator">)</span> <span class="htmlize-keyword">else</span> None <span class="htmlize-tuareg-font-lock-governing">in</span>
<span class="htmlize-type">Lwt_mutex</span>.unlock t.m<span class="htmlize-tuareg-font-lock-operator">;</span>
<span class="htmlize-type">Lwt_condition</span>.signal t.c<span class="htmlize-tuareg-font-lock-operator">;</span>
<span class="htmlize-keyword">match</span> e <span class="htmlize-keyword">with</span> Some e <span class="htmlize-tuareg-font-lock-operator">-></span> <span class="htmlize-type">Lwt</span>.return e <span class="htmlize-tuareg-font-lock-operator">|</span> _ <span class="htmlize-tuareg-font-lock-operator">-></span> <span class="htmlize-type">Lwt</span>.fail Timeout
</pre>In an auxilliary thread we wait for the timeout, then set a timeout flag for the main thread and broadcast the condition. It's important to use <code>broadcast</code>, which signals all waiting threads, instead of <code>signal</code>, which signals an arbitrary waiter, in order to be sure that we wake up the timed-out thread. But now it's possible for a thread to be signaled when neither the timeout has expired nor an element is available, so we must loop around waiting on the condition. And a <code>signal</code> from adding an element may be sent to a timed-out thread, so we need to <code>signal</code> another thread to avoid forgetting the added element. This is not very nice. First, the interface isn't modular. We've hard-coded a particular pair of events to wait for; what if we wanted to wait on two queues at once, or a queue and network socket? Second, the implementation is tricky to understand. We have to reason about how multiple threads, each potentially at a different point in the program, interact with the shared state.<br />
</p><b>Lwt_event</b><br />
<p>Concurrent ML provides a different set of primitives. It makes the notion of an <em>event</em>--something that may happen in the future, like a timeout or a condition becoming true--into an explicit datatype, so you can return it from a function, store it in a data structure, and so on: <pre><span class="htmlize-tuareg-font-lock-governing">type</span> <span class="htmlize-tuareg-font-lock-operator">'</span><span class="htmlize-type">a event</span>
</pre>When an event occurs, it carries a value of type <code>'a</code>. The act of <em>synchronizing</em> on (waiting for) an event is a separate function: <pre><span class="htmlize-tuareg-font-lock-governing">val</span> <span class="htmlize-variable-name">sync </span><span class="htmlize-tuareg-font-lock-operator">:</span> <span class="htmlize-tuareg-font-lock-operator">'</span><span class="htmlize-type">a event </span><span class="htmlize-tuareg-font-lock-operator">-></span><span class="htmlize-type"> </span><span class="htmlize-tuareg-font-lock-operator">'</span><span class="htmlize-type">a Lwt.t</span>
</pre>Of course it returns <code>Lwt.t</code> since it may block; the returned value is the value of the event occurrence. You can make an event that occurs when any of several events occurs, so a thread can wait on several events at once: <pre><span class="htmlize-tuareg-font-lock-governing">val</span> <span class="htmlize-variable-name">choose </span><span class="htmlize-tuareg-font-lock-operator">:</span> <span class="htmlize-tuareg-font-lock-operator">'</span><span class="htmlize-type">a event list </span><span class="htmlize-tuareg-font-lock-operator">-></span><span class="htmlize-type"> </span><span class="htmlize-tuareg-font-lock-operator">'</span><span class="htmlize-type">a event</span>
</pre>When one event occurs, the thread is no longer waiting on the other events (in contrast to <code>Lwt.choose</code>). Since synchronizing on a choice of events is a very common pattern, there's also <pre><span class="htmlize-tuareg-font-lock-governing">val</span> <span class="htmlize-variable-name">select </span><span class="htmlize-tuareg-font-lock-operator">:</span> <span class="htmlize-tuareg-font-lock-operator">'</span><span class="htmlize-type">a event list </span><span class="htmlize-tuareg-font-lock-operator">-></span><span class="htmlize-type"> </span><span class="htmlize-tuareg-font-lock-operator">'</span><span class="htmlize-type">a Lwt.t</span>
</pre>which is the same as <code>sync</code> of <code>choose</code>. Its meaning is very similar to <code>Unix.select</code>: block until one of the events occurs. A <em>channel</em> is sort of like a zero-length queue: both reader and writer must synchronize on the channel at the same time to pass a value from one to the other: <pre><span class="htmlize-tuareg-font-lock-governing">type</span> <span class="htmlize-tuareg-font-lock-operator">'</span><span class="htmlize-type">a channel</span>
<span class="htmlize-tuareg-font-lock-governing">val</span> <span class="htmlize-variable-name">new_channel </span><span class="htmlize-tuareg-font-lock-operator">:</span> <span class="htmlize-type">unit </span><span class="htmlize-tuareg-font-lock-operator">-></span><span class="htmlize-type"> </span><span class="htmlize-tuareg-font-lock-operator">'</span><span class="htmlize-type">a channel</span>
<span class="htmlize-tuareg-font-lock-governing">val</span> <span class="htmlize-variable-name">send </span><span class="htmlize-tuareg-font-lock-operator">:</span> <span class="htmlize-tuareg-font-lock-operator">'</span><span class="htmlize-type">a channel </span><span class="htmlize-tuareg-font-lock-operator">-></span><span class="htmlize-type"> </span><span class="htmlize-tuareg-font-lock-operator">'</span><span class="htmlize-type">a </span><span class="htmlize-tuareg-font-lock-operator">-></span><span class="htmlize-type"> unit event</span>
<span class="htmlize-tuareg-font-lock-governing">val</span> <span class="htmlize-variable-name">receive </span><span class="htmlize-tuareg-font-lock-operator">:</span> <span class="htmlize-tuareg-font-lock-operator">'</span><span class="htmlize-type">a channel </span><span class="htmlize-tuareg-font-lock-operator">-></span><span class="htmlize-type"> </span><span class="htmlize-tuareg-font-lock-operator">'</span><span class="htmlize-type">a event</span>
</pre>Both <code>send</code> and <code>receive</code> are blocking operations, so they return <code>event</code>s. Finally, there's a way to map the value of an event when it occurs: <pre><span class="htmlize-tuareg-font-lock-governing">val</span> <span class="htmlize-variable-name">wrap </span><span class="htmlize-tuareg-font-lock-operator">:</span> <span class="htmlize-tuareg-font-lock-operator">'</span><span class="htmlize-type">a event </span><span class="htmlize-tuareg-font-lock-operator">-></span><span class="htmlize-type"> </span><span class="htmlize-tuareg-font-lock-operator">('</span><span class="htmlize-type">a </span><span class="htmlize-tuareg-font-lock-operator">-></span><span class="htmlize-type"> </span><span class="htmlize-tuareg-font-lock-operator">'</span><span class="htmlize-type">b Lwt.t</span><span class="htmlize-tuareg-font-lock-operator">)</span><span class="htmlize-type"> </span><span class="htmlize-tuareg-font-lock-operator">-></span><span class="htmlize-type"> </span><span class="htmlize-tuareg-font-lock-operator">'</span><span class="htmlize-type">b event</span>
</pre>The event <code>wrap e f</code> occurs when <code>e</code> occurs, with value <code>f v</code> (where <code>v</code> is the value returned by the occurrence of <code>e</code>). (Here's the full <a href="http://code.google.com/p/orpc2/source/browse/trunk/src/lwt-equeue/lwt_event.mli">interface</a> of <code>Lwt_event</code>. There are events for Unix file descriptor operations in <a href="http://code.google.com/p/orpc2/source/browse/trunk/src/lwt-equeue/lwt_event_unix.mli"><code>Lwt_event_unix</code></a>.)<br />
</p><b>Blocking queues with Lwt_event</b><br />
<p>Now I want to reimplement blocking queues using these new primitives: <pre><span class="htmlize-tuareg-font-lock-governing">type</span> <span class="htmlize-tuareg-font-lock-operator">'</span><span class="htmlize-type">a t</span>
<span class="htmlize-tuareg-font-lock-governing">val</span> <span class="htmlize-variable-name">create </span><span class="htmlize-tuareg-font-lock-operator">:</span> <span class="htmlize-type">unit </span><span class="htmlize-tuareg-font-lock-operator">-></span><span class="htmlize-type"> </span><span class="htmlize-tuareg-font-lock-operator">'</span><span class="htmlize-type">a t</span>
<span class="htmlize-tuareg-font-lock-governing">val</span> <span class="htmlize-variable-name">add </span><span class="htmlize-tuareg-font-lock-operator">:</span> <span class="htmlize-tuareg-font-lock-operator">'</span><span class="htmlize-type">a </span><span class="htmlize-tuareg-font-lock-operator">-></span><span class="htmlize-type"> </span><span class="htmlize-tuareg-font-lock-operator">'</span><span class="htmlize-type">a t </span><span class="htmlize-tuareg-font-lock-operator">-></span><span class="htmlize-type"> unit Lwt.t</span>
<span class="htmlize-tuareg-font-lock-governing">val</span> <span class="htmlize-variable-name">take </span><span class="htmlize-tuareg-font-lock-operator">:</span> <span class="htmlize-tuareg-font-lock-operator">'</span><span class="htmlize-type">a t </span><span class="htmlize-tuareg-font-lock-operator">-></span><span class="htmlize-type"> </span><span class="htmlize-tuareg-font-lock-operator">'</span><span class="htmlize-type">a Lwt_event.event</span>
</pre>The interface is similar. As before, <code>take</code> is a blocking operation, but it returns an <code>event</code> instead of <code>Lwt.t</code> so we can combine it with other events using <code>choose</code>. The new <code>add</code> returns <code>Lwt.t</code>, but this is an artifact: a thread calling <code>add</code> won't actually block (we'll see why below). For this reason, <code>add</code> doesn't need to return <code>event</code>. <pre><span class="htmlize-tuareg-font-lock-governing">type</span> <span class="htmlize-tuareg-font-lock-operator">'</span><span class="htmlize-type">a t </span><span class="htmlize-tuareg-font-lock-operator">=</span> <span class="htmlize-tuareg-font-lock-operator">{</span>
<span class="htmlize-variable-name">inch</span><span class="htmlize-tuareg-font-lock-operator">:</span> <span class="htmlize-tuareg-font-lock-operator">'</span><span class="htmlize-type">a channel</span><span class="htmlize-tuareg-font-lock-operator">;</span>
<span class="htmlize-variable-name">ouch</span><span class="htmlize-tuareg-font-lock-operator">:</span> <span class="htmlize-tuareg-font-lock-operator">'</span><span class="htmlize-type">a channel</span><span class="htmlize-tuareg-font-lock-operator">;</span>
<span class="htmlize-tuareg-font-lock-operator">}</span>
<span class="htmlize-tuareg-font-lock-governing">let</span> <span class="htmlize-function-name">add</span><span class="htmlize-variable-name"> e t </span><span class="htmlize-tuareg-font-lock-operator">=</span> sync <span class="htmlize-tuareg-font-lock-operator">(</span>send t.inch e<span class="htmlize-tuareg-font-lock-operator">)</span>
<span class="htmlize-tuareg-font-lock-governing">let</span> <span class="htmlize-function-name">take</span><span class="htmlize-variable-name"> t </span><span class="htmlize-tuareg-font-lock-operator">=</span> receive t.ouch
</pre>A queue consists of two channels, one for adding items into the queue and one for taking them out. The functions implementing the external interface just send and receive on these channels. <pre><span class="htmlize-tuareg-font-lock-governing">let</span> <span class="htmlize-function-name">create</span><span class="htmlize-variable-name"> </span><span class="htmlize-tuareg-font-lock-operator">()</span><span class="htmlize-variable-name"> </span><span class="htmlize-tuareg-font-lock-operator">=</span>
<span class="htmlize-tuareg-font-lock-governing">let</span> <span class="htmlize-variable-name">q </span><span class="htmlize-tuareg-font-lock-operator">=</span> <span class="htmlize-type">Queue</span>.create <span class="htmlize-tuareg-font-lock-operator">()</span> <span class="htmlize-tuareg-font-lock-governing">in</span>
<span class="htmlize-tuareg-font-lock-governing">let</span> <span class="htmlize-variable-name">inch </span><span class="htmlize-tuareg-font-lock-operator">=</span> new_channel <span class="htmlize-tuareg-font-lock-operator">()</span> <span class="htmlize-tuareg-font-lock-governing">in</span>
<span class="htmlize-tuareg-font-lock-governing">let</span> <span class="htmlize-variable-name">ouch </span><span class="htmlize-tuareg-font-lock-operator">=</span> new_channel <span class="htmlize-tuareg-font-lock-operator">()</span> <span class="htmlize-tuareg-font-lock-governing">in</span>
</pre>To <code>create</code> a queue, we make the channels and the underlying queue (we don't need to store it in the record; it will be hidden in a closure). We're going to have an internal thread to manage the queue; next we need some events for it to interact with the channels:<br />
<pre> <span class="htmlize-tuareg-font-lock-governing">let</span> <span class="htmlize-variable-name">add </span><span class="htmlize-tuareg-font-lock-operator">=</span>
wrap <span class="htmlize-tuareg-font-lock-operator">(</span>receive inch<span class="htmlize-tuareg-font-lock-operator">)</span> <span class="htmlize-tuareg-font-lock-operator">(</span><span class="htmlize-keyword">fun</span> <span class="htmlize-variable-name">e </span><span class="htmlize-tuareg-font-lock-operator">-></span>
<span class="htmlize-type">Queue</span>.add e q<span class="htmlize-tuareg-font-lock-operator">;</span>
<span class="htmlize-type">Lwt</span>.return <span class="htmlize-tuareg-font-lock-operator">())</span> <span class="htmlize-tuareg-font-lock-governing">in</span>
<span class="htmlize-tuareg-font-lock-governing">let</span> <span class="htmlize-function-name">take</span><span class="htmlize-variable-name"> </span><span class="htmlize-tuareg-font-lock-operator">()</span><span class="htmlize-variable-name"> </span><span class="htmlize-tuareg-font-lock-operator">=</span>
wrap <span class="htmlize-tuareg-font-lock-operator">(</span>send ouch <span class="htmlize-tuareg-font-lock-operator">(</span><span class="htmlize-type">Queue</span>.peek q<span class="htmlize-tuareg-font-lock-operator">))</span> <span class="htmlize-tuareg-font-lock-operator">(</span><span class="htmlize-keyword">fun</span> <span class="htmlize-tuareg-font-lock-operator">()</span><span class="htmlize-variable-name"> </span><span class="htmlize-tuareg-font-lock-operator">-></span>
ignore <span class="htmlize-tuareg-font-lock-operator">(</span><span class="htmlize-type">Queue</span>.take q<span class="htmlize-tuareg-font-lock-operator">);</span>
<span class="htmlize-type">Lwt</span>.return <span class="htmlize-tuareg-font-lock-operator">())</span> <span class="htmlize-tuareg-font-lock-governing">in</span>
</pre>Here <code>add</code> receives an element from the input channel and adds it to the underlying queue; and <code>take</code> sends the top element of the queue on the output channel. Keep in mind that these events don't occur (and the function passed to <code>wrap</code> is not executed) until there's actually a thread synchronizing on the complementary event on the channel. We call <code>Queue.peek</code> in <code>take</code> because at the point that we offer to send an element on a channel, we have to come up with the element; but we don't want to take it off the underlying queue, because there might never be a thread synchronizing on the complementary event on the channel. (Maybe there should be a version of <code>send</code> that takes a thunk?)<br />
<pre> <span class="htmlize-tuareg-font-lock-governing">let</span> <span class="htmlize-tuareg-font-lock-governing">rec</span> <span class="htmlize-function-name">loop</span><span class="htmlize-variable-name"> </span><span class="htmlize-tuareg-font-lock-operator">()</span><span class="htmlize-variable-name"> </span><span class="htmlize-tuareg-font-lock-operator">=</span>
<span class="htmlize-tuareg-font-lock-governing">let</span> <span class="htmlize-variable-name">evs </span><span class="htmlize-tuareg-font-lock-operator">=</span>
<span class="htmlize-keyword">if</span> <span class="htmlize-type">Queue</span>.is_empty q
<span class="htmlize-keyword">then</span> <span class="htmlize-tuareg-font-lock-operator">[</span> add <span class="htmlize-tuareg-font-lock-operator">]</span>
<span class="htmlize-keyword">else</span> <span class="htmlize-tuareg-font-lock-operator">[</span> add<span class="htmlize-tuareg-font-lock-operator">;</span> take <span class="htmlize-tuareg-font-lock-operator">()</span> <span class="htmlize-tuareg-font-lock-operator">]</span> <span class="htmlize-tuareg-font-lock-governing">in</span>
select evs <span class="htmlize-tuareg-font-lock-operator">>>=</span> loop <span class="htmlize-tuareg-font-lock-governing">in</span>
ignore <span class="htmlize-tuareg-font-lock-operator">(</span>loop <span class="htmlize-tuareg-font-lock-operator">());</span>
<span class="htmlize-tuareg-font-lock-operator">{</span> inch <span class="htmlize-tuareg-font-lock-operator">=</span> inch<span class="htmlize-tuareg-font-lock-operator">;</span> ouch <span class="htmlize-tuareg-font-lock-operator">=</span> ouch <span class="htmlize-tuareg-font-lock-operator">}</span>
</pre>Here's the internal thread. If the queue is empty all we can do is wait for an element to be added; if not, we wait for an element to be added or taken. Now we can see why the <code>add</code> function of the external queue interface can't block: we always <code>select</code> the <code>add</code> event, so as soon as another thread wants to send an element on the input channel, the internal thread is available to receive it.<br />
</p><b>Timeouts!</b><br />
<p>Now, the punchline: we didn't build timeouts into the queue; still we can select between taking an element or timing out: <pre>select <span class="htmlize-tuareg-font-lock-operator">[</span>
<span class="htmlize-type">Lwt_event_queue</span>.take q<span class="htmlize-tuareg-font-lock-operator">;</span>
wrap <span class="htmlize-tuareg-font-lock-operator">(</span><span class="htmlize-type">Lwt_event_unix</span>.sleep timeout<span class="htmlize-tuareg-font-lock-operator">)</span>
<span class="htmlize-tuareg-font-lock-operator">(</span><span class="htmlize-keyword">fun</span> <span class="htmlize-tuareg-font-lock-operator">()</span><span class="htmlize-variable-name"> </span><span class="htmlize-tuareg-font-lock-operator">-></span> <span class="htmlize-type">Lwt</span>.fail <span class="htmlize-tuareg-font-lock-operator">(</span>Failure <span class="htmlize-string">"timeout"</span><span class="htmlize-tuareg-font-lock-operator">));</span>
<span class="htmlize-tuareg-font-lock-operator">]</span>
</pre>Much better. Moreover, I think this queue implementation is easier to reason about (once you're comfortable with the CML primitives), even compared to our first version (without timeouts). The difference is that only the internal thread touches the state of the queue--in fact it's the only thread for which the state is even in scope! We don't need to worry conditions and signaling; we just offer an element on the output channel when one is available. This is only an inkling of the power of CML; the book <a href="http://www.amazon.com/dp/0521714729">Concurrent Programming in ML</a> contains much more, including some large examples.</p>
<p>Why is this style of concurrency not more common? I think there are several reasons: First, idiomatic CML programming requires very lightweight threads (you don't want a native thread, or even an OCaml bytecode thread, for every queue). Second, the <code>wrap</code> combinator, essential for building complex events, requires higher-order functions, so there's no similarly concise translation into, say, Java. Finally, I think it's not widely appreciated that concurrent programming is useful without <em>parallel</em> programming. The mutex approach works fine for parallel programming, while CML has <a href="http://manticore.cs.uchicago.edu/papers/submitted09-parallel-cml.pdf">only</a> <a href="http://clip.dia.fi.upm.es/Conferences/DAMP08/papers/7.pdf">recently</a> been implemented in a parallel setting. None of these reasons applies to Lwt programming; Concurrent ML is a good fit with Lwt.</p>
<p>In an <a href="http://ambassadortothecomputers.blogspot.com/2009/02/equeue-compared-to-lwt.html">earlier post</a> I asserted (without much to back it up) that Ocamlnet's Equeue gives better low-level control over blocking than Lwt. The <code>Lwt_event</code> and <code>Lwt_event_unix</code> modules provide a similar degree of control, with a higher-level interface.</p>Jake Donhamhttp://www.blogger.com/profile/04768087689799941690noreply@blogger.com7tag:blogger.com,1999:blog-1445545651031573301.post-68534182398717563302009-05-11T21:51:00.000-07:002010-03-03T10:59:39.523-08:00Sudoku in ocamljs, part 3: functional reactive programming<p>In <a href="http://ambassadortothecomputers.blogspot.com/2009/04/sudoku-in-ocamljs-part-1-dom.html">part 1</a> and <a href="http://ambassadortothecomputers.blogspot.com/2009/05/sudoku-in-ocamljs-part-2-rpc-over-http.html">part 2</a> of this series, we made a simple Sudoku game and connected it to a game server. In this final installment I want to revisit how we check that a board satisfies the Sudoku rules. There's a small change to the UI: instead of a "Check" button, the board is checked continuously as the player enters numbers; any conflicts are highlighted as before. Here's the <a href="http://froc.googlecode.com/svn/examples/froc-dom/sudoku/index.html">final result</a>.<br />
</p><p>Let's review how we want checking to work: a cell is colored red if any other cell in the same row, column, or square (outlined in bold) contains the same number; otherwise the cell is colored white. Now take another look at the <code>check_board</code> function from <a href="http://ambassadortothecomputers.blogspot.com/2009/04/sudoku-in-ocamljs-part-1-dom.html">part 1</a>. Is it obvious that this code meets the specification? The function is essentially stateful, clearing all the cell colors then setting them red when it discovers a conflict. In fact, I had a bug in it related to state--I was clearing the background color in the <code>None</code> arm of <code>check_set</code>, so each checked constraint would overwrite the highlighting of the previous ones where they overlapped.<br />
</p><p>It would be easier to convince ourselves that we'd gotten it right if the code looked more like the specification. What we want is a function that maps each cell and its "adjacent" cells (the ones in the same row, column, or square) to a boolean (true if the cell is highlighted). Abstracting from the DOM details, suppose a cell is an <code>int option</code> and we have a function <code>adjacents i j</code> that returns a list of cells adjacent to the cell at (i, j). Then the check function is just: <pre><span class="htmlize-tuareg-font-lock-governing">let</span> <span class="htmlize-function-name">highlighted</span><span class="htmlize-variable-name"> cell i j </span><span class="htmlize-tuareg-font-lock-operator">=</span>
cell <span class="htmlize-tuareg-font-lock-operator"><></span> None <span class="htmlize-tuareg-font-lock-operator">&&</span> <span class="htmlize-type">List</span>.mem cell <span class="htmlize-tuareg-font-lock-operator">(</span>adjacents i j<span class="htmlize-tuareg-font-lock-operator">)</span>
</pre><p>So how do we hook this function into the UI? We could just call it for every cell, every time we get a change event for some cell. That seems like a lot of needless computation, since almost all the cells haven't changed. On the other hand, if we manually keep track of which cells might be affected by a change, our code is no longer obviously correct. It would be nice to have some kind of incremental update, like a spreadsheet.<br />
</p><p>This is where <em>functional reactive programming</em> comes in. The main idea is to write functions over <em>behaviors</em>, or values that can change. If you change an input to a function, the output (another behavior) is automatically recomputed. The dependency bookkeeping is taken care of by the framework; we'll use the <a href="http://code.google.com/p/froc/">froc</a> library.<br />
</p><p>It turns out to be convenient to give behaviors a monadic interface. So we have a type <code>'a behavior</code>; we turn a constant into a behavior with <code>return</code>, and we use a behavior with <code>bind</code>. We saw in <a href="http://ambassadortothecomputers.blogspot.com/2009/05/sudoku-in-ocamljs-part-2-rpc-over-http.html">part 2</a> that the monadic interface of Lwt enables blocking: since <code>bind</code> takes a function to apply to the result of a thread, the framework can wait until the thread has completed before applying it. With froc, the framework applies the function passed to <code>bind</code> whenever the bound behavior changes. With both Lwt and froc you can think of a computation as a collection of dependencies rather than a linear sequence.<br />
</p><p>There's another important piece of functional reactive programming: events. An <code>'a event</code> in froc is a channel over which values of type <code>'a</code> can be passed. You can connect froc events to DOM events to interact with the stateful world of the UI. The library includes several functions for working with events (e.g. mapping a function over an event stream) and in particular for mediating between behaviors and events, such as: <pre><span class="htmlize-tuareg-font-lock-governing">val</span> <span class="htmlize-variable-name">hold </span><span class="htmlize-tuareg-font-lock-operator">:</span> <span class="htmlize-tuareg-font-lock-operator">'</span>a <span class="htmlize-tuareg-font-lock-operator">-></span> <span class="htmlize-tuareg-font-lock-operator">'</span>a event <span class="htmlize-tuareg-font-lock-operator">-></span> <span class="htmlize-tuareg-font-lock-operator">'</span>a behavior
</pre>which takes an initial value and an event channel, and returns a behavior that begins at the initial value then changes to each successive value that's sent on the channel, and <pre><span class="htmlize-tuareg-font-lock-governing">val</span> <span class="htmlize-variable-name">changes </span><span class="htmlize-tuareg-font-lock-operator">:</span> <span class="htmlize-tuareg-font-lock-operator">'</span><span class="htmlize-type">a behavior </span><span class="htmlize-tuareg-font-lock-operator">-></span><span class="htmlize-type"> </span><span class="htmlize-tuareg-font-lock-operator">'</span><span class="htmlize-type">a event</span>
</pre>which takes a behavior and returns an event channel that has a value sent on it whenever the behavior changes.<br />
</p><p>This all probably seems a bit abstract, so let's dive into the example code: <pre><span class="htmlize-tuareg-font-lock-governing">module</span> <span class="htmlize-type">D </span><span class="htmlize-tuareg-font-lock-operator">=</span> Dom
<span class="htmlize-tuareg-font-lock-governing">let</span> <span class="htmlize-variable-name">d </span><span class="htmlize-tuareg-font-lock-operator">=</span> <span class="htmlize-type">D</span>.document
<span class="htmlize-tuareg-font-lock-governing">module</span> <span class="htmlize-type">F </span><span class="htmlize-tuareg-font-lock-operator">=</span> Froc
<span class="htmlize-tuareg-font-lock-governing">module</span> <span class="htmlize-type">Fd </span><span class="htmlize-tuareg-font-lock-operator">=</span> Froc_dom
<span class="htmlize-tuareg-font-lock-governing">let</span><span class="htmlize-variable-name"> </span><span class="htmlize-tuareg-font-lock-operator">(>>=)</span><span class="htmlize-variable-name"> </span><span class="htmlize-tuareg-font-lock-operator">=</span> <span class="htmlize-type">F</span>.<span class="htmlize-tuareg-font-lock-operator">(>>=)</span>
</pre>We set up some constants we'll need below. The <code>Froc</code> module contains the core FRP implementation, not tied to a particular UI toolkit; <code>Froc_dom</code> contains functions that are specific to DOM programming (with the <code>Dom</code> module we saw before). <pre><span class="htmlize-tuareg-font-lock-governing">let</span> <span class="htmlize-function-name">make_cell</span><span class="htmlize-variable-name"> </span><span class="htmlize-variable-name">v </span><span class="htmlize-tuareg-font-lock-operator">=</span>
<span class="htmlize-tuareg-font-lock-governing">let</span> <span class="htmlize-variable-name">ev </span><span class="htmlize-tuareg-font-lock-operator">=</span> <span class="htmlize-type">F</span>.make_event <span class="htmlize-tuareg-font-lock-operator">()</span> <span class="htmlize-tuareg-font-lock-governing">in</span>
<span class="htmlize-tuareg-font-lock-governing">let</span> <span class="htmlize-variable-name">cell </span><span class="htmlize-tuareg-font-lock-operator">=</span> <span class="htmlize-type">F</span>.hold v ev <span class="htmlize-tuareg-font-lock-governing">in</span>
<span class="htmlize-tuareg-font-lock-governing">let</span> <span class="htmlize-function-name">set</span><span class="htmlize-variable-name"> v </span><span class="htmlize-tuareg-font-lock-operator">=</span> <span class="htmlize-type">F</span>.send ev v <span class="htmlize-tuareg-font-lock-governing">in</span>
<span class="htmlize-tuareg-font-lock-operator">(</span>cell<span class="htmlize-tuareg-font-lock-operator">,</span> set<span class="htmlize-tuareg-font-lock-operator">)</span>
<span class="htmlize-tuareg-font-lock-governing">let</span> <span class="htmlize-function-name">notify_e</span><span class="htmlize-variable-name"> e f </span><span class="htmlize-tuareg-font-lock-operator">=</span>
<span class="htmlize-type">F</span>.notify_e e <span class="htmlize-tuareg-font-lock-operator">(</span><span class="htmlize-keyword">function</span>
<span class="htmlize-variable-name"> </span><span class="htmlize-tuareg-font-lock-operator">|</span> <span class="htmlize-type">F</span>.Fail _ <span class="htmlize-tuareg-font-lock-operator">-></span> <span class="htmlize-tuareg-font-lock-operator">()</span>
<span class="htmlize-tuareg-font-lock-operator">|</span> <span class="htmlize-type">F</span>.Value v <span class="htmlize-tuareg-font-lock-operator">-></span> f v<span class="htmlize-tuareg-font-lock-operator">)</span>
</pre>These are a couple of functions that really should be part of froc (and will be in the next version). The first makes a cell, which is a behavior (the <code>hold</code> of an event channel) along with a function to set its value (which sends the value on the channel). It's like a <code>ref</code> cell, but we can <code>bind</code> it so changes are propagated. We'll have one of these for each square on the Sudoku board, but it is a generally useful construct.<br />
</p><p>The second papers over a design error in the froc API: like with Lwt threads, a froc behavior or event value can be either a normal value or an exception (together, a <em>result</em>). The <code>notify_e</code> function sets a callback that's called when an event arrives on the channel, but most of the time we just want to ignore exceptional events. <pre><span class="htmlize-tuareg-font-lock-governing">let</span> <span class="htmlize-function-name">attach_input_value</span><span class="htmlize-variable-name"> i b </span><span class="htmlize-tuareg-font-lock-operator">=</span>
notify_e <span class="htmlize-tuareg-font-lock-operator">(</span><span class="htmlize-type">F</span>.changes b<span class="htmlize-tuareg-font-lock-operator">)</span> <span class="htmlize-tuareg-font-lock-operator">(</span><span class="htmlize-keyword">fun</span> <span class="htmlize-variable-name">v </span><span class="htmlize-tuareg-font-lock-operator">-></span> i<span class="htmlize-tuareg-font-lock-operator">#</span>_set_value v<span class="htmlize-tuareg-font-lock-operator">)</span>
<span class="htmlize-tuareg-font-lock-governing">let</span> <span class="htmlize-function-name">attach_backgroundColor</span><span class="htmlize-variable-name"> e b </span><span class="htmlize-tuareg-font-lock-operator">=</span>
notify_e
<span class="htmlize-tuareg-font-lock-operator">(</span><span class="htmlize-type">F</span>.changes b<span class="htmlize-tuareg-font-lock-operator">)</span>
<span class="htmlize-tuareg-font-lock-operator">(</span><span class="htmlize-keyword">fun</span> <span class="htmlize-variable-name">v </span><span class="htmlize-tuareg-font-lock-operator">-></span> e<span class="htmlize-tuareg-font-lock-operator">#</span>_get_style<span class="htmlize-tuareg-font-lock-operator">#</span>_set_backgroundColor v<span class="htmlize-tuareg-font-lock-operator">)</span>
</pre>These are functions that should be part of <code>Froc_dom</code>. To <em>attach</em> a DOM element to a behavior means to update the DOM element whenever the behavior changes. But there are lots of ways to update a DOM element, and <code>Froc_dom</code> doesn't include them all. (This design contrasts with that of <a href="http://www.flapjax-lang.org/">Flapjax</a>, where you work with behaviors whose value is an entire DOM element. It's certainly possible to do this in froc, but more tedious because of the types.) <pre><span class="htmlize-tuareg-font-lock-governing">let</span><span class="htmlize-variable-name"> </span><span class="htmlize-tuareg-font-lock-operator">(</span><span class="htmlize-variable-name">check_enabled</span><span class="htmlize-tuareg-font-lock-operator">,</span><span class="htmlize-variable-name"> set_check_enabled</span><span class="htmlize-tuareg-font-lock-operator">)</span><span class="htmlize-variable-name"> </span><span class="htmlize-tuareg-font-lock-operator">=</span> make_cell <span class="htmlize-constant">false</span>
</pre>Now we're in the application code. The <code>check_enabled</code> cell controls whether checking is turned on--we'll see below what this is for, as you may have noticed that there is no such switch in the actual UI. <pre><span class="htmlize-tuareg-font-lock-governing">let</span> <span class="htmlize-function-name">make_board</span><span class="htmlize-variable-name"> </span><span class="htmlize-tuareg-font-lock-operator">()</span><span class="htmlize-variable-name"> </span><span class="htmlize-tuareg-font-lock-operator">=</span>
<span class="htmlize-tuareg-font-lock-governing">let</span> <span class="htmlize-function-name">make_input</span><span class="htmlize-variable-name"> </span><span class="htmlize-tuareg-font-lock-operator">()</span><span class="htmlize-variable-name"> </span><span class="htmlize-tuareg-font-lock-operator">=</span>
<span class="htmlize-tuareg-font-lock-governing">let</span> <span class="htmlize-variable-name">input </span><span class="htmlize-tuareg-font-lock-operator">=</span> <span class="htmlize-tuareg-font-lock-operator">(</span>d<span class="htmlize-tuareg-font-lock-operator">#</span>createElement <span class="htmlize-string">"input"</span> <span class="htmlize-tuareg-font-lock-operator">:</span> <span class="htmlize-type">D.input</span><span class="htmlize-tuareg-font-lock-operator">)</span> <span class="htmlize-tuareg-font-lock-governing">in</span>
input<span class="htmlize-tuareg-font-lock-operator">#</span>setAttribute <span class="htmlize-string">"type"</span> <span class="htmlize-string">"text"</span><span class="htmlize-tuareg-font-lock-operator">;</span>
input<span class="htmlize-tuareg-font-lock-operator">#</span>_set_size 1<span class="htmlize-tuareg-font-lock-operator">;</span>
input<span class="htmlize-tuareg-font-lock-operator">#</span>_set_maxLength 1<span class="htmlize-tuareg-font-lock-operator">;</span>
<span class="htmlize-tuareg-font-lock-governing">let</span> <span class="htmlize-variable-name">style </span><span class="htmlize-tuareg-font-lock-operator">=</span> input<span class="htmlize-tuareg-font-lock-operator">#</span>_get_style <span class="htmlize-tuareg-font-lock-governing">in</span>
style<span class="htmlize-tuareg-font-lock-operator">#</span>_set_border <span class="htmlize-string">"none"</span><span class="htmlize-tuareg-font-lock-operator">;</span>
style<span class="htmlize-tuareg-font-lock-operator">#</span>_set_padding <span class="htmlize-string">"0px"</span><span class="htmlize-tuareg-font-lock-operator">;</span>
<span class="htmlize-tuareg-font-lock-governing">let</span><span class="htmlize-variable-name"> </span><span class="htmlize-tuareg-font-lock-operator">(</span><span class="htmlize-variable-name">cell</span><span class="htmlize-tuareg-font-lock-operator">,</span><span class="htmlize-variable-name"> set</span><span class="htmlize-tuareg-font-lock-operator">)</span><span class="htmlize-variable-name"> </span><span class="htmlize-tuareg-font-lock-operator">=</span> make_cell None <span class="htmlize-tuareg-font-lock-governing">in</span>
attach_input_value input
<span class="htmlize-tuareg-font-lock-operator">(</span>cell <span class="htmlize-tuareg-font-lock-operator">>>=</span> <span class="htmlize-keyword">function</span>
<span class="htmlize-variable-name"> </span><span class="htmlize-tuareg-font-lock-operator">|</span> None <span class="htmlize-tuareg-font-lock-operator">-></span> <span class="htmlize-type">F</span>.return <span class="htmlize-string">""</span>
<span class="htmlize-tuareg-font-lock-operator">|</span> Some v <span class="htmlize-tuareg-font-lock-operator">-></span> <span class="htmlize-type">F</span>.return <span class="htmlize-tuareg-font-lock-operator">(</span>string_of_int v<span class="htmlize-tuareg-font-lock-operator">));</span>
<span class="htmlize-tuareg-font-lock-governing">let</span> <span class="htmlize-variable-name">ev </span><span class="htmlize-tuareg-font-lock-operator">=</span>
<span class="htmlize-type">F</span>.map
<span class="htmlize-tuareg-font-lock-operator">(</span><span class="htmlize-keyword">function</span>
<span class="htmlize-variable-name"> </span><span class="htmlize-tuareg-font-lock-operator">|</span> <span class="htmlize-string">"1"</span> <span class="htmlize-tuareg-font-lock-operator">|</span> <span class="htmlize-string">"2"</span> <span class="htmlize-tuareg-font-lock-operator">|</span> <span class="htmlize-string">"3"</span> <span class="htmlize-tuareg-font-lock-operator">|</span> <span class="htmlize-string">"4"</span> <span class="htmlize-tuareg-font-lock-operator">|</span> <span class="htmlize-string">"5"</span>
<span class="htmlize-tuareg-font-lock-operator">|</span> <span class="htmlize-string">"6"</span> <span class="htmlize-tuareg-font-lock-operator">|</span> <span class="htmlize-string">"7"</span> <span class="htmlize-tuareg-font-lock-operator">|</span> <span class="htmlize-string">"8"</span> <span class="htmlize-tuareg-font-lock-operator">|</span> <span class="htmlize-string">"9"</span> <span class="htmlize-keyword">as</span> v <span class="htmlize-tuareg-font-lock-operator">-></span>
Some <span class="htmlize-tuareg-font-lock-operator"> (</span>int_of_string v<span class="htmlize-tuareg-font-lock-operator">)</span>
<span class="htmlize-tuareg-font-lock-operator">|</span> _ <span class="htmlize-tuareg-font-lock-operator">-></span> None<span class="htmlize-tuareg-font-lock-operator">)</span>
<span class="htmlize-tuareg-font-lock-operator">(</span><span class="htmlize-type">Fd</span>.input_value_e input<span class="htmlize-tuareg-font-lock-operator">)</span> <span class="htmlize-tuareg-font-lock-governing">in</span>
notify_e ev set<span class="htmlize-tuareg-font-lock-operator">;</span>
<span class="htmlize-tuareg-font-lock-operator">(</span>cell<span class="htmlize-tuareg-font-lock-operator">,</span> set<span class="htmlize-tuareg-font-lock-operator">,</span> input<span class="htmlize-tuareg-font-lock-operator">)</span> <span class="htmlize-tuareg-font-lock-governing">in</span>
</pre>Here we make the game board much as we did in <a href="http://ambassadortothecomputers.blogspot.com/2009/04/sudoku-in-ocamljs-part-1-dom.html">part 1</a>. The main difference is that instead of working directly with DOM input nodes, we connect each input to a cell of type <code>int option</code>. The <code>attach_input</code> call sets the value of the DOM input node whenever the cell changes, and the <code>notify_e</code> call sets the cell whenever the input node changes. (This doesn't loop, because <code>Fd.input_value_e</code> makes an event stream from the "onchange" events of the input, and "onchange" events are only sent when the user changes the input, not when it's changed from Javascript.) We take the stream of <code>string</code>s and map it into a stream of <code>int option</code>s, validating the string as we go.<br />
<pre> <span class="htmlize-tuareg-font-lock-governing">let</span> <span class="htmlize-variable-name">rows </span><span class="htmlize-tuareg-font-lock-operator">=</span>
<span class="htmlize-type">Array</span>.init 9 <span class="htmlize-tuareg-font-lock-operator">(</span><span class="htmlize-keyword">fun</span> <span class="htmlize-variable-name">i </span><span class="htmlize-tuareg-font-lock-operator">-></span>
<span class="htmlize-type">Array</span>.init 9 <span class="htmlize-tuareg-font-lock-operator">(</span><span class="htmlize-keyword">fun</span> <span class="htmlize-variable-name">j </span><span class="htmlize-tuareg-font-lock-operator">-></span>
make_input <span class="htmlize-tuareg-font-lock-operator">()))</span> <span class="htmlize-tuareg-font-lock-governing">in</span>
<span class="htmlize-tuareg-font-lock-governing">let</span> <span class="htmlize-function-name">adjacents</span><span class="htmlize-variable-name"> i j </span><span class="htmlize-tuareg-font-lock-operator">=</span>
<span class="htmlize-tuareg-font-lock-governing">let</span> <span class="htmlize-function-name">adj</span><span class="htmlize-variable-name"> i</span><span class="htmlize-tuareg-font-lock-operator">'</span><span class="htmlize-variable-name"> j</span><span class="htmlize-tuareg-font-lock-operator">'</span><span class="htmlize-variable-name"> </span><span class="htmlize-tuareg-font-lock-operator">=</span>
<span class="htmlize-tuareg-font-lock-operator">(</span>i<span class="htmlize-tuareg-font-lock-operator">'</span> <span class="htmlize-tuareg-font-lock-operator"><></span> i <span class="htmlize-tuareg-font-lock-operator">||</span> j<span class="htmlize-tuareg-font-lock-operator">'</span> <span class="htmlize-tuareg-font-lock-operator"><></span> j<span class="htmlize-tuareg-font-lock-operator">)</span> <span class="htmlize-tuareg-font-lock-operator">&&</span>
<span class="htmlize-tuareg-font-lock-operator">(</span>i<span class="htmlize-tuareg-font-lock-operator">'</span> <span class="htmlize-tuareg-font-lock-operator">=</span> i <span class="htmlize-tuareg-font-lock-operator">or</span> j<span class="htmlize-tuareg-font-lock-operator">'</span> <span class="htmlize-tuareg-font-lock-operator">=</span> j <span class="htmlize-tuareg-font-lock-operator">or</span>
<span class="htmlize-tuareg-font-lock-operator">(</span>i<span class="htmlize-tuareg-font-lock-operator">'</span> <span class="htmlize-tuareg-font-lock-operator">/</span> 3 <span class="htmlize-tuareg-font-lock-operator">=</span> i <span class="htmlize-tuareg-font-lock-operator">/</span> 3 <span class="htmlize-tuareg-font-lock-operator">&&</span> j<span class="htmlize-tuareg-font-lock-operator">'</span> <span class="htmlize-tuareg-font-lock-operator">/</span> 3 <span class="htmlize-tuareg-font-lock-operator">=</span> j <span class="htmlize-tuareg-font-lock-operator">/</span> 3<span class="htmlize-tuareg-font-lock-operator">))</span> <span class="htmlize-tuareg-font-lock-governing">in</span>
<span class="htmlize-tuareg-font-lock-governing">let</span> <span class="htmlize-tuareg-font-lock-governing">rec</span> <span class="htmlize-function-name">adjs</span><span class="htmlize-variable-name"> i</span><span class="htmlize-tuareg-font-lock-operator">'</span><span class="htmlize-variable-name"> j</span><span class="htmlize-tuareg-font-lock-operator">'</span><span class="htmlize-variable-name"> l </span><span class="htmlize-tuareg-font-lock-operator">=</span>
<span class="htmlize-keyword">match</span> i<span class="htmlize-tuareg-font-lock-operator">',</span> j<span class="htmlize-tuareg-font-lock-operator">'</span> <span class="htmlize-keyword">with</span>
<span class="htmlize-tuareg-font-lock-operator">|</span> 9<span class="htmlize-tuareg-font-lock-operator">,</span> _ <span class="htmlize-tuareg-font-lock-operator">-></span> l
<span class="htmlize-tuareg-font-lock-operator">|</span> _<span class="htmlize-tuareg-font-lock-operator">,</span> 9 <span class="htmlize-tuareg-font-lock-operator">-></span> adjs <span class="htmlize-tuareg-font-lock-operator">(</span>i<span class="htmlize-tuareg-font-lock-operator">'+</span>1<span class="htmlize-tuareg-font-lock-operator">)</span> 0 l
<span class="htmlize-tuareg-font-lock-operator">|</span> _<span class="htmlize-tuareg-font-lock-operator">,</span> _ <span class="htmlize-tuareg-font-lock-operator">-></span>
<span class="htmlize-tuareg-font-lock-governing">let</span> <span class="htmlize-variable-name">l </span><span class="htmlize-tuareg-font-lock-operator">=</span>
<span class="htmlize-keyword">if</span> adj i<span class="htmlize-tuareg-font-lock-operator">'</span> j<span class="htmlize-tuareg-font-lock-operator">'</span>
<span class="htmlize-keyword">then</span>
<span class="htmlize-tuareg-font-lock-governing">let</span><span class="htmlize-variable-name"> </span><span class="htmlize-tuareg-font-lock-operator">(</span><span class="htmlize-variable-name">cell</span><span class="htmlize-tuareg-font-lock-operator">,</span><span class="htmlize-variable-name">_</span><span class="htmlize-tuareg-font-lock-operator">,</span><span class="htmlize-variable-name">_</span><span class="htmlize-tuareg-font-lock-operator">)</span><span class="htmlize-variable-name"> </span><span class="htmlize-tuareg-font-lock-operator">=</span> rows.<span class="htmlize-tuareg-font-lock-operator">(</span>i<span class="htmlize-tuareg-font-lock-operator">')</span>.<span class="htmlize-tuareg-font-lock-operator">(</span>j<span class="htmlize-tuareg-font-lock-operator">')</span> <span class="htmlize-tuareg-font-lock-governing">in</span>
cell<span class="htmlize-tuareg-font-lock-operator">::</span>l
<span class="htmlize-keyword">else</span> l <span class="htmlize-tuareg-font-lock-governing">in</span>
adjs i<span class="htmlize-tuareg-font-lock-operator">'</span> <span class="htmlize-tuareg-font-lock-operator">(</span>j<span class="htmlize-tuareg-font-lock-operator">'+</span>1<span class="htmlize-tuareg-font-lock-operator">)</span> l <span class="htmlize-tuareg-font-lock-governing">in</span>
adjs 0 0 <span class="htmlize-tuareg-font-lock-operator">[]</span> <span class="htmlize-tuareg-font-lock-governing">in</span>
</pre>We make the game board as a matrix of inputs as before, but now each element of the matrix contains a cell (an <code>int option behavior</code>), the function to set that cell, and the actual DOM input element. Next we set up the rule-checking. The <code>adjacents</code> function returns a list of cells adjacent to the cell at <code>(i, j)</code> (adjacent in the sense we discussed above). All my bugs when I wrote this example were in this function, but it clearly embodies the specification we're trying to meet: a cell is adjacent to the current cell if it is not the same cell and is in the same row, column, or square. (The loop would be clearer if we had <code>Array.foldi</code>.)<br />
<pre> <span class="htmlize-type">ArrayLabels</span>.iteri rows <span class="htmlize-tuareg-font-lock-operator">~</span><span class="htmlize-variable-name">f</span><span class="htmlize-tuareg-font-lock-operator">:(</span><span class="htmlize-keyword">fun</span> <span class="htmlize-variable-name">i row </span><span class="htmlize-tuareg-font-lock-operator">-></span>
<span class="htmlize-type">ArrayLabels</span>.iteri row <span class="htmlize-tuareg-font-lock-operator">~</span><span class="htmlize-variable-name">f</span><span class="htmlize-tuareg-font-lock-operator">:(</span><span class="htmlize-keyword">fun</span> <span class="htmlize-variable-name">j </span><span class="htmlize-tuareg-font-lock-operator">(</span><span class="htmlize-variable-name">cell</span><span class="htmlize-tuareg-font-lock-operator">,</span><span class="htmlize-variable-name"> _</span><span class="htmlize-tuareg-font-lock-operator">,</span><span class="htmlize-variable-name"> input</span><span class="htmlize-tuareg-font-lock-operator">)</span><span class="htmlize-variable-name"> </span><span class="htmlize-tuareg-font-lock-operator">-></span>
<span class="htmlize-tuareg-font-lock-governing">let</span> <span class="htmlize-variable-name">adjs </span><span class="htmlize-tuareg-font-lock-operator">=</span> adjacents i j <span class="htmlize-tuareg-font-lock-governing">in</span>
attach_backgroundColor input
<span class="htmlize-tuareg-font-lock-operator">(</span>check_enabled <span class="htmlize-tuareg-font-lock-operator">>>=</span> <span class="htmlize-keyword">function</span>
<span class="htmlize-variable-name"> </span><span class="htmlize-tuareg-font-lock-operator">|</span> <span class="htmlize-constant">false</span> <span class="htmlize-tuareg-font-lock-operator">-></span> <span class="htmlize-type">F</span>.return <span class="htmlize-string">"#ffffff"</span>
<span class="htmlize-tuareg-font-lock-operator">|</span> <span class="htmlize-constant">true</span> <span class="htmlize-tuareg-font-lock-operator">-></span>
<span class="htmlize-type">F</span>.bindN adjs <span class="htmlize-tuareg-font-lock-operator">(</span><span class="htmlize-keyword">fun</span> <span class="htmlize-variable-name">adjs </span><span class="htmlize-tuareg-font-lock-operator">-></span>
cell <span class="htmlize-tuareg-font-lock-operator">>>=</span> <span class="htmlize-keyword">fun</span> <span class="htmlize-variable-name">v </span><span class="htmlize-tuareg-font-lock-operator">-></span>
<span class="htmlize-keyword">if</span> v <span class="htmlize-tuareg-font-lock-operator"><></span> None <span class="htmlize-tuareg-font-lock-operator">&&</span> <span class="htmlize-type">List</span>.mem v adjs
<span class="htmlize-keyword">then</span> <span class="htmlize-type">F</span>.return <span class="htmlize-string">"#ff0000"</span>
<span class="htmlize-keyword">else</span> <span class="htmlize-type">F</span>.return <span class="htmlize-string">"#ffffff"</span><span class="htmlize-tuareg-font-lock-operator">))));</span>
</pre>This is the functional reactive core of the program. For each square on the board we compute essentially the <code>highlighted</code> function above, but in monadic form (the <code>bindN</code> function binds a list of behaviors at once), and attach the result to the background color of the input node. Because the set of adjacent cells does not depend on the value of the cells, we can hoist its computation out of the reactive part so it won't be recomputed every time a cell changes (and since dependency on a behavior is captured in the type of a function, the fact that this typechecks tells us it is safe to do!).<br />
</p><p>That's it. The rest of the program is almost the same as before. (Here's the <a href="http://code.google.com/p/froc/source/browse/#svn/trunk/examples/froc-dom/sudoku">full code</a>.) The one important change has to do with <code>check_enabled</code>. In the reaction to cell changes, we consult <code>check_enabled</code>, returning the unhighlighted color when it's false. Since we do this before binding the cells, a change to a cell causes no recomputation when <code>check_enabled</code> is false. So we turn off <code>check_enabled</code> while loading a new game board, saving a lot of needless recomputation that otherwise makes it annoyingly slow.<br />
</p><p>It's interesting to compare functional reactive programming to the model-view-controller pattern. The point of MVC is to separate the changeable state (the model) from how it is displayed (the view). Although MVC is typically implemented with change events and state update, a view behaves as a pure function of the state (or can be made so by making the state of UI components explicit). So you could think of FRP as "automatic" MVC: you just write down dependencies (with <code>bind</code>) and the framework manages events and state update. For small examples this may not seem like a big win, but FRP takes care of some complexities that tend to swamp MVC apps: managing dynamic dependencies (registering and unregistering event handlers in response to events) and maintaining coherence (i.e. functional behavior) over different event orders.<br />
</p><p>I haven't yet written a serious application with froc, but so far I think it is awesome!<br />
</p>Jake Donhamhttp://www.blogger.com/profile/04768087689799941690noreply@blogger.com0tag:blogger.com,1999:blog-1445545651031573301.post-34904865358798123842009-05-03T22:35:00.000-07:002010-03-03T11:08:23.446-08:00Sudoku in ocamljs, part 2: RPC over HTTP<p><a href="http://ambassadortothecomputers.blogspot.com/2009/04/sudoku-in-ocamljs-part-1-dom.html">Last time</a> we made a simple user interface for Sudoku with the <code>Dom</code> module of <a href="http://code.google.com/p/ocamljs">ocamljs</a>. It isn't a very fun game though since there are no pre-filled numbers to constrain the board. So let's add a button to get a new game board; here's the <a href="http://orpc2.googlecode.com/svn/examples/sudoku/index.html">final result</a>.<br />
</p><p>I don't know much about <a href="http://en.wikipedia.org/wiki/Algorithmics_of_sudoku">generating Sudoku boards</a>, but it seems like it might be slow to do it in the browser, so we'll do it on the server, and communicate to the server with OCaml function calls using the RPC over HTTP support in <a href="http://code.google.com/p/orpc2">orpc</a>.<br />
</p><b>The 5-minute monad</b><br />
<p>But first I'm going to give you a brief introduction to <em>monads</em> (?!). Bear with me until I can explain why we need monads for Sudoku, or skip it if this is old hat to you. We'll transform the following fragment into monadic form: <pre><span class="htmlize-tuareg-font-lock-governing">let</span> <span class="htmlize-function-name">foo</span><span class="htmlize-variable-name"> </span><span class="htmlize-tuareg-font-lock-operator">()</span><span class="htmlize-variable-name"> </span><span class="htmlize-tuareg-font-lock-operator">=</span> 7 <span class="htmlize-tuareg-font-lock-governing">in</span>
bar <span class="htmlize-tuareg-font-lock-operator">(</span>foo <span class="htmlize-tuareg-font-lock-operator">())</span>
</pre>First put it in <em>named form</em> by <code>let</code>-binding the result of the nested function application: <pre><span class="htmlize-tuareg-font-lock-governing">let</span> <span class="htmlize-function-name">foo</span><span class="htmlize-variable-name"> </span><span class="htmlize-tuareg-font-lock-operator">()</span><span class="htmlize-variable-name"> </span><span class="htmlize-tuareg-font-lock-operator">=</span> 7 <span class="htmlize-tuareg-font-lock-governing">in</span>
<span class="htmlize-tuareg-font-lock-governing">let</span> <span class="htmlize-variable-name">f </span><span class="htmlize-tuareg-font-lock-operator">=</span> foo <span class="htmlize-tuareg-font-lock-operator">()</span> <span class="htmlize-tuareg-font-lock-governing">in</span>
bar f
</pre>Then introduce two new functions, <code>return</code> and <code>bind</code>: <pre><span class="htmlize-tuareg-font-lock-governing">let</span> <span class="htmlize-function-name">return</span><span class="htmlize-variable-name"> x </span><span class="htmlize-tuareg-font-lock-operator">=</span> x
<span class="htmlize-tuareg-font-lock-governing">let</span> <span class="htmlize-function-name">bind</span><span class="htmlize-variable-name"> x f </span><span class="htmlize-tuareg-font-lock-operator">=</span> f x
<span class="htmlize-tuareg-font-lock-governing">let</span> <span class="htmlize-function-name">foo</span><span class="htmlize-variable-name"> </span><span class="htmlize-tuareg-font-lock-operator">()</span><span class="htmlize-variable-name"> </span><span class="htmlize-tuareg-font-lock-operator">=</span> return 7 <span class="htmlize-tuareg-font-lock-governing">in</span>
bind <span class="htmlize-tuareg-font-lock-operator">(</span>foo <span class="htmlize-tuareg-font-lock-operator">())</span> <span class="htmlize-tuareg-font-lock-operator">(</span><span class="htmlize-keyword">fun</span> <span class="htmlize-variable-name">f </span><span class="htmlize-tuareg-font-lock-operator">-></span>
bar f<span class="htmlize-tuareg-font-lock-operator">)</span>
</pre>These functions are a bit mysterious (although the name "bind" is suggestive of <code>let</code>-binding), but we haven't changed the meaning of the fragment. Next we would like to enforce that the only way to use the result of <code>foo ()</code> is by calling <code>bind</code>. We can do that with an abstract type: <pre><span class="htmlize-tuareg-font-lock-governing">type</span> <span class="htmlize-tuareg-font-lock-operator">'</span><span class="htmlize-type">a t</span>
<span class="htmlize-tuareg-font-lock-governing">val</span> <span class="htmlize-variable-name">return </span><span class="htmlize-tuareg-font-lock-operator">:</span> <span class="htmlize-tuareg-font-lock-operator">'</span><span class="htmlize-type">a </span><span class="htmlize-tuareg-font-lock-operator">-></span><span class="htmlize-type"> </span><span class="htmlize-tuareg-font-lock-operator">'</span><span class="htmlize-type">a t</span>
<span class="htmlize-tuareg-font-lock-governing">val</span> <span class="htmlize-variable-name">bind </span><span class="htmlize-tuareg-font-lock-operator">:</span> <span class="htmlize-tuareg-font-lock-operator">'</span><span class="htmlize-type">a t </span><span class="htmlize-tuareg-font-lock-operator">-></span><span class="htmlize-type"> </span><span class="htmlize-tuareg-font-lock-operator">('</span><span class="htmlize-type">a </span><span class="htmlize-tuareg-font-lock-operator">-></span><span class="htmlize-type"> </span><span class="htmlize-tuareg-font-lock-operator">'</span><span class="htmlize-type">b t</span><span class="htmlize-tuareg-font-lock-operator">)</span><span class="htmlize-type"> </span><span class="htmlize-tuareg-font-lock-operator">-></span><span class="htmlize-type"> </span><span class="htmlize-tuareg-font-lock-operator">'</span><span class="htmlize-type">b t</span>
</pre>Taking <code>type 'a t = 'a</code>, the definitions of <code>return</code> and <code>bind</code> match this signature. So what have we accomplished? We've abstracted out the notion of <em>using the result of a computation</em>. It turns out that there are many useful structures matching this signature (and satisfying <a href="http://www.google.com/search?q=monad+laws">some equations</a>), called monads. It's convenient that they all match the same signature, in part because we can mechanically convert ordinary code into monadic code, as we've done here, or even use a <a href="http://www.cas.mcmaster.ca/~carette/pa_monad/">syntax extension</a> to do it for us.<br />
</p><b>Lightweight threads in Javascript</b><br />
<p>One such useful structure is the <a href="http://ocsigen.org/lwt">Lwt</a> library for cooperative threads. You can write Lwt-threaded code by taking ordinary threaded code and converting it to monadic style. In Lwt, <code>'a t</code> is the type of threads returning <code>'a</code>. Then <code>bind t f</code> calls <code>f</code> on the value of the thread <code>t</code> <em>once <code>t</code> has finished</em>, and <code>return x</code> is an already-finished thread with value <code>x</code>.<br />
</p><p>Lwt threads are cooperative: they run until they complete or block waiting on the result of another thread, but aren't ever preempted. It can be easier to reason about this kind of threading, because until you call <code>bind</code>, there's no possibility of another thread disturbing any state you're working on.<br />
</p><p>Lwt threads are a great match for Javascript, which doesn't have preemptive threads (although plugins like <a href="http://gears.google.com/">Google Gears</a> provide them), because they need no special support from the language except closures. Typically in Javascript you write a blocking computation as a series of callbacks. You're doing essentially the same thing with Lwt, but it's packaged up in a clean interface.<br />
</p><b>Orpc for RPC over HTTP</b><br />
<p>The reason we care about threads in Javascript is that we want to make a blocking RPC call to the server to retrieve a Sudoku game board, without hanging the browser. We'll use orpc to generate stubs for the client and server. In the client the call returns an Lwt thread, so you need to call <code>bind</code> to get the result. In the server it arrives as an ordinary procedure call.<br />
</p><p>To use orpc you write down the signature of the RPC interface, in <code>Lwt</code> and <code>Sync</code> forms for the client and server. Orpc checks that the two forms are compatible, and generates the stubs. Here's our interface (<a href="http://code.google.com/p/orpc2/source/browse/trunk/examples/sudoku/proto.ml">proto.ml</a>): <pre><span class="htmlize-tuareg-font-lock-governing">module</span> <span class="htmlize-tuareg-font-lock-governing">type</span> <span class="htmlize-type">Sync </span><span class="htmlize-tuareg-font-lock-operator">=</span>
<span class="htmlize-tuareg-font-lock-governing">sig</span>
<span class="htmlize-tuareg-font-lock-governing">val</span> <span class="htmlize-variable-name">get_board </span><span class="htmlize-tuareg-font-lock-operator">:</span> <span class="htmlize-type">unit </span><span class="htmlize-tuareg-font-lock-operator">-></span><span class="htmlize-type"> int option array array</span>
<span class="htmlize-tuareg-font-lock-governing">end</span>
<span class="htmlize-tuareg-font-lock-governing">module</span> <span class="htmlize-tuareg-font-lock-governing">type</span> <span class="htmlize-type">Lwt </span><span class="htmlize-tuareg-font-lock-operator">=</span>
<span class="htmlize-tuareg-font-lock-governing">sig</span>
<span class="htmlize-tuareg-font-lock-governing">val</span> <span class="htmlize-variable-name">get_board </span><span class="htmlize-tuareg-font-lock-operator">:</span> <span class="htmlize-type">unit </span><span class="htmlize-tuareg-font-lock-operator">-></span><span class="htmlize-type"> int option array array Lwt.t</span>
<span class="htmlize-tuareg-font-lock-governing">end</span>
</pre>The <code>get_board</code> function returns a 9x9 array, each cell of which may contain <code>None</code> or <code>Some k</code> where <code>k</code> is 1 to 9. We can't capture all these constraints in the type, but we get more static checking than if we were passing JSON or XML.<br />
</p><b>Generating the board</b><br />
<p>On the <a href="http://code.google.com/p/orpc2/source/browse/trunk/examples/sudoku/server.ml">server</a>, we implement a module that matches the <code>Sync</code> signature. (You can see that I didn't actually implement any Sudoku-generating code, but took some fixed examples from Gnome Sudoku.) Then there's some boilerplate to set up a Netplex HTTP server and register the module at the <code>/sudoku</code> path. It's pretty simple. The <code>Proto_js_srv</code> module contains stubs generated by orpc from <code>proto.ml</code>, and <code>Orpc_js_server</code> is part of the orpc library.<br />
</p><b>Using the board</b><br />
<p>The <a href="http://code.google.com/p/orpc2/source/browse/trunk/examples/sudoku/sudoku.ml">client</a> is mostly unchanged from last time. There's a new button, "New game", that makes the RPC call, then fills in the board from the result. <pre><span class="htmlize-tuareg-font-lock-governing">let</span><span class="htmlize-variable-name"> </span><span class="htmlize-tuareg-font-lock-operator">(>>=)</span><span class="htmlize-variable-name"> </span><span class="htmlize-tuareg-font-lock-operator">=</span> <span class="htmlize-type">Lwt</span>.<span class="htmlize-tuareg-font-lock-operator">(>>=)</span>
</pre>The <code>>>=</code> operator is another name for <code>bind</code>. If you aren't using <a href="http://www.cas.mcmaster.ca/~carette/pa_monad/">pa_monad</a> (which we aren't here), it makes a sequence of <code>bind</code>s easier to read. <pre><span class="htmlize-tuareg-font-lock-governing">module</span> <span class="htmlize-type">Server </span><span class="htmlize-tuareg-font-lock-operator">=</span>
<span class="htmlize-type">Proto_js_clnt</span>.Lwt<span class="htmlize-tuareg-font-lock-operator">(</span><span class="htmlize-tuareg-font-lock-governing">struct</span>
<span class="htmlize-tuareg-font-lock-governing">let</span> <span class="htmlize-function-name">with_client</span><span class="htmlize-variable-name"> f </span><span class="htmlize-tuareg-font-lock-operator">=</span> f <span class="htmlize-tuareg-font-lock-operator">(</span><span class="htmlize-type">Orpc_js_client</span>.create <span class="htmlize-string">"/sudoku"</span><span class="htmlize-tuareg-font-lock-operator">)</span>
<span class="htmlize-tuareg-font-lock-governing">end</span><span class="htmlize-tuareg-font-lock-operator">)</span>
</pre>This sets up the RPC interface, so calls on the <code>Server</code> module become RPC calls to the server. The <code>Proto_js_client</code> module contains stubs generated from <code>proto.ml</code>, and <code>Orpc_js_client</code> is part of the orpc library. (In the actual source you'll see that I faked this out in order to host the running example on Google Code--there's no way to run an OCaml server, so I randomly choose a canned response.) <pre><span class="htmlize-tuareg-font-lock-governing">let</span> <span class="htmlize-function-name">get_board</span><span class="htmlize-variable-name"> rows _ </span><span class="htmlize-tuareg-font-lock-operator">=</span>
ignore
<span class="htmlize-tuareg-font-lock-operator">(</span><span class="htmlize-type">Server</span>.get_board <span class="htmlize-tuareg-font-lock-operator">()</span> <span class="htmlize-tuareg-font-lock-operator">>>=</span> <span class="htmlize-keyword">fun</span> <span class="htmlize-variable-name">board </span><span class="htmlize-tuareg-font-lock-operator">-></span>
<span class="htmlize-keyword">for</span> i <span class="htmlize-tuareg-font-lock-operator">=</span> 0 <span class="htmlize-keyword">to</span> 8 <span class="htmlize-keyword">do</span>
<span class="htmlize-keyword">for</span> j <span class="htmlize-tuareg-font-lock-operator">=</span> 0 <span class="htmlize-keyword">to</span> 8 <span class="htmlize-keyword">do</span>
<span class="htmlize-tuareg-font-lock-governing">let</span> <span class="htmlize-variable-name">cell </span><span class="htmlize-tuareg-font-lock-operator">=</span> rows.<span class="htmlize-tuareg-font-lock-operator">(</span>i<span class="htmlize-tuareg-font-lock-operator">)</span>.<span class="htmlize-tuareg-font-lock-operator">(</span>j<span class="htmlize-tuareg-font-lock-operator">)</span> <span class="htmlize-tuareg-font-lock-governing">in</span>
<span class="htmlize-tuareg-font-lock-governing">let</span> <span class="htmlize-variable-name">style </span><span class="htmlize-tuareg-font-lock-operator">=</span> cell<span class="htmlize-tuareg-font-lock-operator">#</span>_get_style <span class="htmlize-tuareg-font-lock-governing">in</span>
style<span class="htmlize-tuareg-font-lock-operator">#</span>_set_backgroundColor <span class="htmlize-string">"#ffffff"</span><span class="htmlize-tuareg-font-lock-operator">;</span>
<span class="htmlize-keyword">match</span> board.<span class="htmlize-tuareg-font-lock-operator">(</span>i<span class="htmlize-tuareg-font-lock-operator">)</span>.<span class="htmlize-tuareg-font-lock-operator">(</span>j<span class="htmlize-tuareg-font-lock-operator">)</span> <span class="htmlize-keyword">with</span>
<span class="htmlize-tuareg-font-lock-operator">|</span> None <span class="htmlize-tuareg-font-lock-operator">-></span>
cell<span class="htmlize-tuareg-font-lock-operator">#</span>_set_value <span class="htmlize-string">""</span><span class="htmlize-tuareg-font-lock-operator">;</span>
cell<span class="htmlize-tuareg-font-lock-operator">#</span>_set_disabled <span class="htmlize-constant">false</span>
<span class="htmlize-tuareg-font-lock-operator">|</span> Some n <span class="htmlize-tuareg-font-lock-operator">-></span>
cell<span class="htmlize-tuareg-font-lock-operator">#</span>_set_value <span class="htmlize-tuareg-font-lock-operator">(</span>string_of_int n<span class="htmlize-tuareg-font-lock-operator">);</span>
cell<span class="htmlize-tuareg-font-lock-operator">#</span>_set_disabled <span class="htmlize-constant">true</span>
<span class="htmlize-keyword">done</span>
<span class="htmlize-keyword">done</span><span class="htmlize-tuareg-font-lock-operator">;</span>
<span class="htmlize-type">Lwt</span>.return <span class="htmlize-tuareg-font-lock-operator">());</span>
<span class="htmlize-constant">false</span>
</pre>This is the event handler for the "New game" button. We call <code>get_board</code>, <code>bind</code> the result, then fill in the board. If there's a number in a cell we disable the input box so the player can't change it. Here's the <a href="http://code.google.com/p/orpc2/source/browse/trunk/examples/sudoku">full code</a>.<br />
</p><p>Doing AJAX programming with orpc and Lwt really shows off the power of compiling OCaml to Javascript. While <a href="http://code.google.com/webtoolkit/">Google Web Toolkit</a> has a similar RPC mechanism (that generates stubs from Java interfaces), it's much clumsier to use, because you're still working at the level of callbacks rather than threads. Maybe you could translate Lwt to Java, but it would be painfully verbose without type inference.<br />
</p><p>This monad stuff will come in handy again next time, when we'll revisit the problem of checking the Sudoku constraints on the board, using <a href="http://code.google.com/p/froc">froc</a>.<br />
</p>Jake Donhamhttp://www.blogger.com/profile/04768087689799941690noreply@blogger.com0tag:blogger.com,1999:blog-1445545651031573301.post-45741219432077309512009-04-26T22:30:00.000-07:002010-03-03T11:15:26.230-08:00Sudoku in ocamljs, part 1: DOM programming<p>Let's make a Sudoku game with <a href="http://code.google.com/p/ocamljs">ocamljs</a> and the <a href="http://code.google.com/p/ocamljs/wiki/Dom"><code>Dom</code></a> library for programming the browser DOM. Like on the cooking shows, I have prepared the dish we're about to make beforehand; why don't you <a href="http://ocamljs.googlecode.com/svn/examples/dom/sudoku/index.html">taste it now</a>? OK, it is not yet Sudoku, lacking the important ingredient of some starting numbers to guide the game--we'll come back to that next time. <pre><span class="htmlize-tuareg-font-lock-governing">module</span> <span class="htmlize-type">D </span><span class="htmlize-tuareg-font-lock-operator">=</span> Dom
<span class="htmlize-tuareg-font-lock-governing">let</span> <span class="htmlize-variable-name">d </span><span class="htmlize-tuareg-font-lock-operator">=</span> <span class="htmlize-type">D</span>.document
</pre>We begin with some definitions. The <code>Dom</code> module includes class types for much of the standard browser DOM, using the ocamljs facility for <a href="http://code.google.com/p/ocamljs/wiki/Interfacing">interfacing with Javascript objects</a>. <code>Dom.document</code> is the browser document object. <pre><span class="htmlize-tuareg-font-lock-governing">let</span> <span class="htmlize-function-name">make_board</span><span class="htmlize-variable-name"> </span><span class="htmlize-tuareg-font-lock-operator">()</span><span class="htmlize-variable-name"> </span><span class="htmlize-tuareg-font-lock-operator">=</span>
<span class="htmlize-tuareg-font-lock-governing">let</span> <span class="htmlize-function-name">make_input</span><span class="htmlize-variable-name"> </span><span class="htmlize-tuareg-font-lock-operator">()</span><span class="htmlize-variable-name"> </span><span class="htmlize-tuareg-font-lock-operator">=</span>
<span class="htmlize-tuareg-font-lock-governing">let</span> <span class="htmlize-variable-name">input </span><span class="htmlize-tuareg-font-lock-operator">=</span> <span class="htmlize-tuareg-font-lock-operator">(</span>d<span class="htmlize-tuareg-font-lock-operator">#</span>createElement <span class="htmlize-string">"input"</span> <span class="htmlize-tuareg-font-lock-operator">:</span> <span class="htmlize-type">D.input</span><span class="htmlize-tuareg-font-lock-operator">)</span> <span class="htmlize-tuareg-font-lock-governing">in</span>
input<span class="htmlize-tuareg-font-lock-operator">#</span>setAttribute <span class="htmlize-string">"type"</span> <span class="htmlize-string">"text"</span><span class="htmlize-tuareg-font-lock-operator">;</span>
input<span class="htmlize-tuareg-font-lock-operator">#</span>_set_size 1<span class="htmlize-tuareg-font-lock-operator">;</span>
input<span class="htmlize-tuareg-font-lock-operator">#</span>_set_maxLength 1<span class="htmlize-tuareg-font-lock-operator">;</span>
<span class="htmlize-tuareg-font-lock-governing">let</span> <span class="htmlize-variable-name">style </span><span class="htmlize-tuareg-font-lock-operator">=</span> input<span class="htmlize-tuareg-font-lock-operator">#</span>_get_style <span class="htmlize-tuareg-font-lock-governing">in</span>
style<span class="htmlize-tuareg-font-lock-operator">#</span>_set_border <span class="htmlize-string">"none"</span><span class="htmlize-tuareg-font-lock-operator">;</span>
style<span class="htmlize-tuareg-font-lock-operator">#</span>_set_padding <span class="htmlize-string">"0px"</span><span class="htmlize-tuareg-font-lock-operator">;</span>
<span class="htmlize-tuareg-font-lock-governing">let</span> <span class="htmlize-function-name">enforce_digit</span><span class="htmlize-variable-name"> </span><span class="htmlize-tuareg-font-lock-operator">()</span><span class="htmlize-variable-name"> </span><span class="htmlize-tuareg-font-lock-operator">=</span>
<span class="htmlize-keyword">match</span> input<span class="htmlize-tuareg-font-lock-operator">#</span>_get_value <span class="htmlize-keyword">with</span>
<span class="htmlize-tuareg-font-lock-operator">|</span> <span class="htmlize-string">"1"</span> <span class="htmlize-tuareg-font-lock-operator">|</span> <span class="htmlize-string">"2"</span> <span class="htmlize-tuareg-font-lock-operator">|</span> <span class="htmlize-string">"3"</span> <span class="htmlize-tuareg-font-lock-operator">|</span> <span class="htmlize-string">"4"</span> <span class="htmlize-tuareg-font-lock-operator">|</span> <span class="htmlize-string">"5"</span>
<span class="htmlize-tuareg-font-lock-operator">|</span> <span class="htmlize-string">"6"</span> <span class="htmlize-tuareg-font-lock-operator">|</span> <span class="htmlize-string">"7"</span> <span class="htmlize-tuareg-font-lock-operator">|</span> <span class="htmlize-string">"8"</span> <span class="htmlize-tuareg-font-lock-operator">|</span> <span class="htmlize-string">"9"</span> <span class="htmlize-tuareg-font-lock-operator">-></span> <span class="htmlize-tuareg-font-lock-operator">()</span>
<span class="htmlize-tuareg-font-lock-operator">|</span> _ <span class="htmlize-tuareg-font-lock-operator">-></span> input<span class="htmlize-tuareg-font-lock-operator">#</span>_set_value <span class="htmlize-string">""</span> <span class="htmlize-tuareg-font-lock-governing">in</span>
input<span class="htmlize-tuareg-font-lock-operator">#</span>_set_onchange <span class="htmlize-tuareg-font-lock-operator">(</span><span class="htmlize-type">Ocamljs</span>.jsfun enforce_digit<span class="htmlize-tuareg-font-lock-operator">);</span>
input <span class="htmlize-tuareg-font-lock-governing">in</span>
</pre>We construct the Sudoku board in several steps. First, we make an input box for each square. Notice that you can call DOM methods (e.g. <code>createElement</code>) with OCaml object syntax. But what is the type of <code>createElement</code>? The type of the object you get back depends on the tag name you pass in; OCaml has no type for that. So <code>createElement</code> is declared to return <code>#element</code> (that is, a subclass of <code>element</code>). If you need only methods from <code>element</code> then you usually don't need to ascribe a more-specific type, but in this case we need an <code>input</code> node. (Static type checking with Javascript objects is therefore only advisory in some cases--if you ascribe the wrong type you can get a runtime error--but still better than nothing.)<br />
</p><p>We next set some attributes, properties, and styles on the input box. Properties are manipulated with specially-named methods: <code>foo#_get_bar</code> becomes <code>foo.bar</code> in Javascript, and <code>foo#_set_bar baz</code> becomes <code>foo.bar = baz</code>. Finally we add a validation function to enforce that the input box contains at most a single digit. To set the <code>onchange</code> handler, you need to wrap it in <code>Ocamljs.jsfun</code>, because the calling convention of an ocamljs function is different from that of plain Javascript function (to accomodate partial application and tail recursion).<br />
<pre> <span class="htmlize-tuareg-font-lock-governing">let</span> <span class="htmlize-function-name">make_td</span><span class="htmlize-variable-name"> i j input </span><span class="htmlize-tuareg-font-lock-operator">=</span>
<span class="htmlize-tuareg-font-lock-governing">let</span> <span class="htmlize-variable-name">td </span><span class="htmlize-tuareg-font-lock-operator">=</span> d<span class="htmlize-tuareg-font-lock-operator">#</span>createElement <span class="htmlize-string">"td"</span> <span class="htmlize-tuareg-font-lock-governing">in</span>
<span class="htmlize-tuareg-font-lock-governing">let</span> <span class="htmlize-variable-name">style </span><span class="htmlize-tuareg-font-lock-operator">=</span> td<span class="htmlize-tuareg-font-lock-operator">#</span>_get_style <span class="htmlize-tuareg-font-lock-governing">in</span>
style<span class="htmlize-tuareg-font-lock-operator">#</span>_set_borderStyle <span class="htmlize-string">"solid"</span><span class="htmlize-tuareg-font-lock-operator">;</span>
style<span class="htmlize-tuareg-font-lock-operator">#</span>_set_borderColor <span class="htmlize-string">"#000000"</span><span class="htmlize-tuareg-font-lock-operator">;</span>
<span class="htmlize-tuareg-font-lock-governing">let</span> <span class="htmlize-function-name">widths</span><span class="htmlize-variable-name"> </span><span class="htmlize-tuareg-font-lock-operator">=</span> <span class="htmlize-keyword">function</span>
<span class="htmlize-variable-name"> </span><span class="htmlize-tuareg-font-lock-operator">|</span> 0 <span class="htmlize-tuareg-font-lock-operator">-></span> 2<span class="htmlize-tuareg-font-lock-operator">,</span> 0 <span class="htmlize-tuareg-font-lock-operator">|</span> 2 <span class="htmlize-tuareg-font-lock-operator">-></span> 1<span class="htmlize-tuareg-font-lock-operator">,</span> 1 <span class="htmlize-tuareg-font-lock-operator">|</span> 3 <span class="htmlize-tuareg-font-lock-operator">-></span> 1<span class="htmlize-tuareg-font-lock-operator">,</span> 0
<span class="htmlize-tuareg-font-lock-operator">|</span> 5 <span class="htmlize-tuareg-font-lock-operator">-></span> 1<span class="htmlize-tuareg-font-lock-operator">,</span> 1 <span class="htmlize-tuareg-font-lock-operator">|</span> 6 <span class="htmlize-tuareg-font-lock-operator">-></span> 1<span class="htmlize-tuareg-font-lock-operator">,</span> 0 <span class="htmlize-tuareg-font-lock-operator">|</span> 8 <span class="htmlize-tuareg-font-lock-operator">-></span> 1<span class="htmlize-tuareg-font-lock-operator">,</span> 2
<span class="htmlize-tuareg-font-lock-operator">|</span> _ <span class="htmlize-tuareg-font-lock-operator">-></span> 1<span class="htmlize-tuareg-font-lock-operator">,</span> 0 <span class="htmlize-tuareg-font-lock-governing">in</span>
<span class="htmlize-tuareg-font-lock-governing">let</span><span class="htmlize-variable-name"> </span><span class="htmlize-tuareg-font-lock-operator">(</span><span class="htmlize-variable-name">top</span><span class="htmlize-tuareg-font-lock-operator">,</span><span class="htmlize-variable-name"> bottom</span><span class="htmlize-tuareg-font-lock-operator">)</span><span class="htmlize-variable-name"> </span><span class="htmlize-tuareg-font-lock-operator">=</span> widths i <span class="htmlize-tuareg-font-lock-governing">in</span>
<span class="htmlize-tuareg-font-lock-governing">let</span><span class="htmlize-variable-name"> </span><span class="htmlize-tuareg-font-lock-operator">(</span><span class="htmlize-variable-name">left</span><span class="htmlize-tuareg-font-lock-operator">,</span><span class="htmlize-variable-name"> right</span><span class="htmlize-tuareg-font-lock-operator">)</span><span class="htmlize-variable-name"> </span><span class="htmlize-tuareg-font-lock-operator">=</span> widths j <span class="htmlize-tuareg-font-lock-governing">in</span>
<span class="htmlize-tuareg-font-lock-governing">let</span> <span class="htmlize-function-name">px</span><span class="htmlize-variable-name"> k </span><span class="htmlize-tuareg-font-lock-operator">=</span> string_of_int k <span class="htmlize-tuareg-font-lock-operator">^</span> <span class="htmlize-string">"px"</span> <span class="htmlize-tuareg-font-lock-governing">in</span>
style<span class="htmlize-tuareg-font-lock-operator">#</span>_set_borderTopWidth <span class="htmlize-tuareg-font-lock-operator">(</span>px top<span class="htmlize-tuareg-font-lock-operator">);</span>
style<span class="htmlize-tuareg-font-lock-operator">#</span>_set_borderBottomWidth <span class="htmlize-tuareg-font-lock-operator">(</span>px bottom<span class="htmlize-tuareg-font-lock-operator">);</span>
style<span class="htmlize-tuareg-font-lock-operator">#</span>_set_borderLeftWidth <span class="htmlize-tuareg-font-lock-operator">(</span>px left<span class="htmlize-tuareg-font-lock-operator">);</span>
style<span class="htmlize-tuareg-font-lock-operator">#</span>_set_borderRightWidth <span class="htmlize-tuareg-font-lock-operator">(</span>px right<span class="htmlize-tuareg-font-lock-operator">);</span>
ignore <span class="htmlize-tuareg-font-lock-operator">(</span>td<span class="htmlize-tuareg-font-lock-operator">#</span>appendChild input<span class="htmlize-tuareg-font-lock-operator">);</span>
td <span class="htmlize-tuareg-font-lock-governing">in</span>
</pre>Next we make a table cell for each square, containing the input box, with borders according to its position in the grid. Here we don't ascribe a type to the result of <code>createElement</code> since we don't need any <code>td</code>-specific methods.<br />
<pre> <span class="htmlize-tuareg-font-lock-governing">let</span> <span class="htmlize-variable-name">rows </span><span class="htmlize-tuareg-font-lock-operator">=</span>
<span class="htmlize-type">Array</span>.init 9 <span class="htmlize-tuareg-font-lock-operator">(</span><span class="htmlize-keyword">fun</span> <span class="htmlize-variable-name">i </span><span class="htmlize-tuareg-font-lock-operator">-></span>
<span class="htmlize-type">Array</span>.init 9 <span class="htmlize-tuareg-font-lock-operator">(</span><span class="htmlize-keyword">fun</span> <span class="htmlize-variable-name">j </span><span class="htmlize-tuareg-font-lock-operator">-></span>
make_input <span class="htmlize-tuareg-font-lock-operator">()))</span> <span class="htmlize-tuareg-font-lock-governing">in</span>
<span class="htmlize-tuareg-font-lock-governing">let</span> <span class="htmlize-variable-name">table </span><span class="htmlize-tuareg-font-lock-operator">=</span> d<span class="htmlize-tuareg-font-lock-operator">#</span>createElement <span class="htmlize-string">"table"</span> <span class="htmlize-tuareg-font-lock-governing">in</span>
table<span class="htmlize-tuareg-font-lock-operator">#</span>setAttribute <span class="htmlize-string">"cellpadding"</span> <span class="htmlize-string">"0px"</span><span class="htmlize-tuareg-font-lock-operator">;</span>
table<span class="htmlize-tuareg-font-lock-operator">#</span>setAttribute <span class="htmlize-string">"cellspacing"</span> <span class="htmlize-string">"0px"</span><span class="htmlize-tuareg-font-lock-operator">;</span>
<span class="htmlize-tuareg-font-lock-governing">let</span> <span class="htmlize-variable-name">tbody </span><span class="htmlize-tuareg-font-lock-operator">=</span> d<span class="htmlize-tuareg-font-lock-operator">#</span>createElement <span class="htmlize-string">"tbody"</span> <span class="htmlize-tuareg-font-lock-governing">in</span>
ignore <span class="htmlize-tuareg-font-lock-operator">(</span>table<span class="htmlize-tuareg-font-lock-operator">#</span>appendChild tbody<span class="htmlize-tuareg-font-lock-operator">);</span>
<span class="htmlize-type">ArrayLabels</span>.iteri rows <span class="htmlize-tuareg-font-lock-operator">~</span><span class="htmlize-variable-name">f</span><span class="htmlize-tuareg-font-lock-operator">:(</span><span class="htmlize-keyword">fun</span> <span class="htmlize-variable-name">i row </span><span class="htmlize-tuareg-font-lock-operator">-></span>
<span class="htmlize-tuareg-font-lock-governing">let</span> <span class="htmlize-variable-name">tr </span><span class="htmlize-tuareg-font-lock-operator">=</span> d<span class="htmlize-tuareg-font-lock-operator">#</span>createElement <span class="htmlize-string">"tr"</span> <span class="htmlize-tuareg-font-lock-governing">in</span>
<span class="htmlize-type">ArrayLabels</span>.iteri row <span class="htmlize-tuareg-font-lock-operator">~</span><span class="htmlize-variable-name">f</span><span class="htmlize-tuareg-font-lock-operator">:(</span><span class="htmlize-keyword">fun</span> <span class="htmlize-variable-name">j cell </span><span class="htmlize-tuareg-font-lock-operator">-></span>
<span class="htmlize-tuareg-font-lock-governing">let</span> <span class="htmlize-variable-name">td </span><span class="htmlize-tuareg-font-lock-operator">=</span> make_td i j cell <span class="htmlize-tuareg-font-lock-governing">in</span>
ignore <span class="htmlize-tuareg-font-lock-operator">(</span>tr<span class="htmlize-tuareg-font-lock-operator">#</span>appendChild td<span class="htmlize-tuareg-font-lock-operator">));</span>
ignore <span class="htmlize-tuareg-font-lock-operator">(</span>tbody<span class="htmlize-tuareg-font-lock-operator">#</span>appendChild tr<span class="htmlize-tuareg-font-lock-operator">));</span>
<span class="htmlize-tuareg-font-lock-operator">(</span>rows<span class="htmlize-tuareg-font-lock-operator">,</span> table<span class="htmlize-tuareg-font-lock-operator">)</span>
</pre>Then we assemble the full board: make a 9 x 9 matrix of input boxes, make a table containing the input boxes, then return the matrix and table. Notice that we freely use the OCaml standard library. Here the <code>tbody</code> is necessary for IE; the <code>cellpadding</code> and <code>cellspacing</code> don't work in IE for some reason that I have not tracked down. This raises an important point: the <code>Dom</code> module is the thinnest possible wrapper over the actual DOM objects, and as such gives you no help with cross-browser compatibility. <pre><span class="htmlize-tuareg-font-lock-governing">let</span> <span class="htmlize-function-name">check_board</span><span class="htmlize-variable-name"> rows _ </span><span class="htmlize-tuareg-font-lock-operator">=</span>
<span class="htmlize-tuareg-font-lock-governing">let</span> <span class="htmlize-function-name">error</span><span class="htmlize-variable-name"> i j </span><span class="htmlize-tuareg-font-lock-operator">=</span>
<span class="htmlize-tuareg-font-lock-governing">let</span> <span class="htmlize-variable-name">cell </span><span class="htmlize-tuareg-font-lock-operator">=</span> rows.<span class="htmlize-tuareg-font-lock-operator">(</span>i<span class="htmlize-tuareg-font-lock-operator">)</span>.<span class="htmlize-tuareg-font-lock-operator">(</span>j<span class="htmlize-tuareg-font-lock-operator">)</span> <span class="htmlize-tuareg-font-lock-governing">in</span>
cell<span class="htmlize-tuareg-font-lock-operator">#</span>_get_style<span class="htmlize-tuareg-font-lock-operator">#</span>_set_backgroundColor <span class="htmlize-string">"#ff0000"</span> <span class="htmlize-tuareg-font-lock-governing">in</span>
<span class="htmlize-tuareg-font-lock-governing">let</span> <span class="htmlize-function-name">check_set</span><span class="htmlize-variable-name"> set </span><span class="htmlize-tuareg-font-lock-operator">=</span>
<span class="htmlize-tuareg-font-lock-governing">let</span> <span class="htmlize-variable-name">seen </span><span class="htmlize-tuareg-font-lock-operator">=</span> <span class="htmlize-type">Array</span>.make 9 None <span class="htmlize-tuareg-font-lock-governing">in</span>
<span class="htmlize-type">ArrayLabels</span>.iter set <span class="htmlize-tuareg-font-lock-operator">~</span><span class="htmlize-variable-name">f</span><span class="htmlize-tuareg-font-lock-operator">:(</span><span class="htmlize-keyword">fun</span> <span class="htmlize-tuareg-font-lock-operator">(</span><span class="htmlize-variable-name">i</span><span class="htmlize-tuareg-font-lock-operator">,</span><span class="htmlize-variable-name">j</span><span class="htmlize-tuareg-font-lock-operator">)</span><span class="htmlize-variable-name"> </span><span class="htmlize-tuareg-font-lock-operator">-></span>
<span class="htmlize-tuareg-font-lock-governing">let</span> <span class="htmlize-variable-name">cell </span><span class="htmlize-tuareg-font-lock-operator">=</span> rows.<span class="htmlize-tuareg-font-lock-operator">(</span>i<span class="htmlize-tuareg-font-lock-operator">)</span>.<span class="htmlize-tuareg-font-lock-operator">(</span>j<span class="htmlize-tuareg-font-lock-operator">)</span> <span class="htmlize-tuareg-font-lock-governing">in</span>
<span class="htmlize-keyword">match</span> cell<span class="htmlize-tuareg-font-lock-operator">#</span>_get_value <span class="htmlize-keyword">with</span>
<span class="htmlize-tuareg-font-lock-operator">|</span> "" <span class="htmlize-tuareg-font-lock-operator">-></span> <span class="htmlize-tuareg-font-lock-operator">()</span><span class="htmlize-string">
</span> <span class="htmlize-tuareg-font-lock-operator">|</span> v <span class="htmlize-tuareg-font-lock-operator">-></span>
<span class="htmlize-tuareg-font-lock-governing">let</span> <span class="htmlize-variable-name">n </span><span class="htmlize-tuareg-font-lock-operator">=</span> int_of_string v <span class="htmlize-tuareg-font-lock-governing">in</span>
<span class="htmlize-keyword">match</span> seen.<span class="htmlize-tuareg-font-lock-operator">(</span>n <span class="htmlize-tuareg-font-lock-operator">-</span> 1<span class="htmlize-tuareg-font-lock-operator">)</span> <span class="htmlize-keyword">with</span>
<span class="htmlize-tuareg-font-lock-operator">|</span> None <span class="htmlize-tuareg-font-lock-operator">-></span>
seen.<span class="htmlize-tuareg-font-lock-operator">(</span>n <span class="htmlize-tuareg-font-lock-operator">-</span> 1<span class="htmlize-tuareg-font-lock-operator">)</span> <span class="htmlize-tuareg-font-lock-operator"><-</span> Some <span class="htmlize-tuareg-font-lock-operator">(</span>i<span class="htmlize-tuareg-font-lock-operator">,</span>j<span class="htmlize-tuareg-font-lock-operator">)</span>
<span class="htmlize-tuareg-font-lock-operator">|</span> Some <span class="htmlize-tuareg-font-lock-operator">(</span>i<span class="htmlize-tuareg-font-lock-operator">',</span>j<span class="htmlize-tuareg-font-lock-operator">')</span> <span class="htmlize-tuareg-font-lock-operator">-></span>
error i j<span class="htmlize-tuareg-font-lock-operator">;</span>
error i<span class="htmlize-tuareg-font-lock-operator">'</span> j<span class="htmlize-tuareg-font-lock-operator">')</span> <span class="htmlize-tuareg-font-lock-governing">in</span>
<span class="htmlize-tuareg-font-lock-governing">let</span> <span class="htmlize-function-name">check_row</span><span class="htmlize-variable-name"> i </span><span class="htmlize-tuareg-font-lock-operator">=</span>
check_set <span class="htmlize-tuareg-font-lock-operator">(</span><span class="htmlize-type">Array</span>.init 9 <span class="htmlize-tuareg-font-lock-operator">(</span><span class="htmlize-keyword">fun</span> <span class="htmlize-variable-name">j </span><span class="htmlize-tuareg-font-lock-operator">-></span> <span class="htmlize-tuareg-font-lock-operator">(</span>i<span class="htmlize-tuareg-font-lock-operator">,</span>j<span class="htmlize-tuareg-font-lock-operator">)))</span> <span class="htmlize-tuareg-font-lock-governing">in</span>
<span class="htmlize-tuareg-font-lock-governing">let</span> <span class="htmlize-function-name">check_column</span><span class="htmlize-variable-name"> j </span><span class="htmlize-tuareg-font-lock-operator">=</span>
check_set <span class="htmlize-tuareg-font-lock-operator">(</span><span class="htmlize-type">Array</span>.init 9 <span class="htmlize-tuareg-font-lock-operator">(</span><span class="htmlize-keyword">fun</span> <span class="htmlize-variable-name">i </span><span class="htmlize-tuareg-font-lock-operator">-></span> <span class="htmlize-tuareg-font-lock-operator">(</span>i<span class="htmlize-tuareg-font-lock-operator">,</span>j<span class="htmlize-tuareg-font-lock-operator">)))</span> <span class="htmlize-tuareg-font-lock-governing">in</span>
<span class="htmlize-tuareg-font-lock-governing">let</span> <span class="htmlize-function-name">check_square</span><span class="htmlize-variable-name"> i j </span><span class="htmlize-tuareg-font-lock-operator">=</span>
<span class="htmlize-tuareg-font-lock-governing">let</span> <span class="htmlize-variable-name">set </span><span class="htmlize-tuareg-font-lock-operator">=</span> <span class="htmlize-type">Array</span>.init 9 <span class="htmlize-tuareg-font-lock-operator">(</span><span class="htmlize-keyword">fun</span> <span class="htmlize-variable-name">k </span><span class="htmlize-tuareg-font-lock-operator">-></span>
i <span class="htmlize-tuareg-font-lock-operator">*</span> 3 <span class="htmlize-tuareg-font-lock-operator">+</span> k <span class="htmlize-tuareg-font-lock-operator">mod</span> 3<span class="htmlize-tuareg-font-lock-operator">,</span> j <span class="htmlize-tuareg-font-lock-operator">*</span> 3 <span class="htmlize-tuareg-font-lock-operator">+</span> k <span class="htmlize-tuareg-font-lock-operator">/</span> 3<span class="htmlize-tuareg-font-lock-operator">)</span> <span class="htmlize-tuareg-font-lock-governing">in</span>
check_set set <span class="htmlize-tuareg-font-lock-governing">in</span>
<span class="htmlize-type">ArrayLabels</span>.iter rows <span class="htmlize-tuareg-font-lock-operator">~</span><span class="htmlize-variable-name">f</span><span class="htmlize-tuareg-font-lock-operator">:(</span><span class="htmlize-keyword">fun</span> <span class="htmlize-variable-name">row </span><span class="htmlize-tuareg-font-lock-operator">-></span>
<span class="htmlize-type">ArrayLabels</span>.iter row <span class="htmlize-tuareg-font-lock-operator">~</span><span class="htmlize-variable-name">f</span><span class="htmlize-tuareg-font-lock-operator">:(</span><span class="htmlize-keyword">fun</span> <span class="htmlize-variable-name">cell </span><span class="htmlize-tuareg-font-lock-operator">-></span>
cell<span class="htmlize-tuareg-font-lock-operator">#</span>_get_style<span class="htmlize-tuareg-font-lock-operator">#</span>_set_backgroundColor <span class="htmlize-string">"#ffffff"</span><span class="htmlize-tuareg-font-lock-operator">));</span>
<span class="htmlize-keyword">for</span> i <span class="htmlize-tuareg-font-lock-operator">=</span> 0 <span class="htmlize-keyword">to</span> 8 <span class="htmlize-keyword">do</span> check_row i <span class="htmlize-keyword">done</span><span class="htmlize-tuareg-font-lock-operator">;</span>
<span class="htmlize-keyword">for</span> j <span class="htmlize-tuareg-font-lock-operator">=</span> 0 <span class="htmlize-keyword">to</span> 8 <span class="htmlize-keyword">do</span> check_column j <span class="htmlize-keyword">done</span><span class="htmlize-tuareg-font-lock-operator">;</span>
<span class="htmlize-keyword">for</span> i <span class="htmlize-tuareg-font-lock-operator">=</span> 0 <span class="htmlize-keyword">to</span> 2 <span class="htmlize-keyword">do</span>
<span class="htmlize-keyword">for</span> j <span class="htmlize-tuareg-font-lock-operator">=</span> 0 <span class="htmlize-keyword">to</span> 2 <span class="htmlize-keyword">do</span>
check_square i j
<span class="htmlize-keyword">done</span>
<span class="htmlize-keyword">done</span><span class="htmlize-tuareg-font-lock-operator">;</span>
<span class="htmlize-constant">false</span>
</pre>Now we define a function to check that the Sudoku constraints are satisfied: that no row, column, or heavy-lined square has more than one occurrence of a digit. If more than one digit occurs then we color all occurrences red. The only ocamljs-specific parts here are getting the cell contents (with <code>_get_value</code>) and setting the background color style. However, it's worth noticing the algorithm: we imperatively clear the error states for all cells, then set error states as we check each constraint. I'll revisit this in a later post about functional reactive programming. <pre><span class="htmlize-tuareg-font-lock-governing">let</span> <span class="htmlize-function-name">onload</span><span class="htmlize-variable-name"> </span><span class="htmlize-tuareg-font-lock-operator">()</span><span class="htmlize-variable-name"> </span><span class="htmlize-tuareg-font-lock-operator">=</span>
<span class="htmlize-tuareg-font-lock-governing">let</span><span class="htmlize-variable-name"> </span><span class="htmlize-tuareg-font-lock-operator">(</span><span class="htmlize-variable-name">rows</span><span class="htmlize-tuareg-font-lock-operator">,</span><span class="htmlize-variable-name"> table</span><span class="htmlize-tuareg-font-lock-operator">)</span><span class="htmlize-variable-name"> </span><span class="htmlize-tuareg-font-lock-operator">=</span> make_board <span class="htmlize-tuareg-font-lock-operator">()</span> <span class="htmlize-tuareg-font-lock-governing">in</span>
<span class="htmlize-tuareg-font-lock-governing">let</span> <span class="htmlize-variable-name">check </span><span class="htmlize-tuareg-font-lock-operator">=</span> d<span class="htmlize-tuareg-font-lock-operator">#</span>getElementById <span class="htmlize-string">"check"</span> <span class="htmlize-tuareg-font-lock-governing">in</span>
check<span class="htmlize-tuareg-font-lock-operator">#</span>_set_onclick <span class="htmlize-tuareg-font-lock-operator">(</span><span class="htmlize-type">Ocamljs</span>.jsfun <span class="htmlize-tuareg-font-lock-operator">(</span>check_board rows<span class="htmlize-tuareg-font-lock-operator">));</span>
<span class="htmlize-tuareg-font-lock-governing">let</span> <span class="htmlize-variable-name">board </span><span class="htmlize-tuareg-font-lock-operator">=</span> d<span class="htmlize-tuareg-font-lock-operator">#</span>getElementById <span class="htmlize-string">"board"</span> <span class="htmlize-tuareg-font-lock-governing">in</span>
ignore <span class="htmlize-tuareg-font-lock-operator">(</span>board<span class="htmlize-tuareg-font-lock-operator">#</span>appendChild table<span class="htmlize-tuareg-font-lock-operator">)</span>
<span class="htmlize-tuareg-font-lock-operator">;;</span>
<span class="htmlize-type">D</span>.window<span class="htmlize-tuareg-font-lock-operator">#</span>_set_onload <span class="htmlize-tuareg-font-lock-operator">(</span><span class="htmlize-type">Ocamljs</span>.jsfun onload<span class="htmlize-tuareg-font-lock-operator">)</span>
</pre>Finally we put the pieces together: make the board, insert it into the DOM, call <code>check_board</code> when the Check button is clicked, and call this setup code once the document has been loaded. See the <a href="http://code.google.com/p/ocamljs/source/browse/#svn/trunk/examples/dom/sudoku">full source</a> for build files.<br />
</p><p>By writing this in OCaml rather than directly in Javascript, we've gained the assurance of static type checking; we get to use OCaml's syntax, pattern matching, and standard library; we have a <a href="http://math.andrej.com/2009/04/09/pythons-lambda-is-broken/">for loop that's not broken</a>. On the flip side we have to worry about type ascription and <code>Ocamljs.jsfun</code>. If you don't already think that OCaml is a better language than Javascript, this won't convince you. But perhaps the followup posts, in which I'll show how to use RPC over HTTP with <a href="http://code.google.com/p/orpc2/">orpc</a> and functional reactive programming with <a href="http://code.google.com/p/froc/">froc</a>, will tip the scales for you.<br />
</p>Jake Donhamhttp://www.blogger.com/profile/04768087689799941690noreply@blogger.com0tag:blogger.com,1999:blog-1445545651031573301.post-6943224683419536322009-04-23T10:28:00.000-07:002009-05-11T21:59:03.727-07:00Monadic functional reactive AJAX in OCamlYesterday I released three related projects which I've been working on for a long time:
<ul>
<li><a href="http://code.google.com/p/ocamljs"><b>ocamljs</b></a>, a Javascript backend for ocamlc, along with some libraries for web programming</li>
<li><a href="http://code.google.com/p/orpc2"><b>orpc</b></a>, a tool for generating RPC stubs from OCaml signatures, either ONC RPC for use with Ocamlnet's RPC implementation, or RPC over HTTP for use with ocamljs</li>
<li><a href="http://code.google.com/p/froc"><b>froc</b></a>, a library for functional reactive programming that works with ocamljs</li>
</ul>
The idea of all this is to build a platform for client-side web programming like <a href="http://code.google.com/webtoolkit/">Google Web Toolkit</a> (but better, of course :). There is still a lot of work to get there, but already we use ocamljs and orpc for production work at <a href="http://skydeck.com/">Skydeck</a>. In my next few posts I'll work through some examples using ocamljs, orpc, and froc:
<ul>
<li><a href="http://ambassadortothecomputers.blogspot.com/2009/04/sudoku-in-ocamljs-part-1-dom.html">part 1: DOM programming</a></li>
<li><a href="http://ambassadortothecomputers.blogspot.com/2009/05/sudoku-in-ocamljs-part-2-rpc-over-http.html">part 2: RPC over HTTP</a></li>
<li><a href="http://ambassadortothecomputers.blogspot.com/2009/05/sudoku-in-ocamljs-part-3-functional.html">part 3: functional reactive programming</a></li>
</ul>Jake Donhamhttp://www.blogger.com/profile/04768087689799941690noreply@blogger.com2tag:blogger.com,1999:blog-1445545651031573301.post-72679175509695663942009-02-09T23:43:00.000-08:002010-03-03T11:21:59.018-08:00Equeue compared to Lwt<p>I feel like taking a break from Camlp4, so in this post I'll take a look at two libraries for asynchronous networking programming in OCaml: <a href="http://projects.camlcity.org/projects/dl/ocamlnet-2.2.9/doc/html-main/Equeue_intro.html">Equeue</a> and <a href="http://www.ocsigen.org/lwt">Lwt</a>. Each provides cooperative multithreading and asynchronous access to networking calls; each has protocol implementations built on top of it (e.g. Nethttpd for Equeue and Ocsigen's HTTP implementation for of Lwt). So why would you want to use one over the other? Let's start with an overview of each.<br />
</p><b>Equeue</b><br />
<p>An Equeue <em>event system</em> comprises a queue of events and a set of event handlers. A running event system just pulls events off the queue and passes them to the event handlers. You can think of a group of related handlers as a thread (the thread is blocked until one of its handlers is called; when the handler returns the thread yields) but there is no particular data structure tying them together.<br />
</p><p>The <code>Unixqueue</code> module specializes Equeue to the case where the source of events is the Unix <code>select</code> call. It adds the idea of <em>resources</em>, which are operations that may cause an event. For example, the operation <code>Wait_in</code> on some file descriptor can cause the event <code>Input_arrived</code> for that descriptor. A resource also has an associated timeout (the <code>Timeout</code> event fires if the timeout is exceeded). <code>Unixqueue</code> also adds a way to group resources and handlers; a group can be removed from the event system with one call, so everything associated with a thread can be cleaned up at once.<br />
</p><p>On top of the low-level event queue mechanism, Equeue builds <em>engines</em>, which package up some event handlers and some internal state with a particular interface: <pre><span class="htmlize-tuareg-font-lock-governing">type</span> <span class="htmlize-tuareg-font-lock-operator">'</span><span class="htmlize-type">t engine_state </span><span class="htmlize-tuareg-font-lock-operator">=</span>
<span class="htmlize-tuareg-font-lock-operator">[</span> `Working <span class="htmlize-tuareg-font-lock-operator">of</span> int
<span class="htmlize-tuareg-font-lock-operator">|</span> `Done <span class="htmlize-tuareg-font-lock-operator">of</span> <span class="htmlize-tuareg-font-lock-operator">'</span>t
<span class="htmlize-tuareg-font-lock-operator">|</span> `Error <span class="htmlize-tuareg-font-lock-operator">of</span> exn
<span class="htmlize-tuareg-font-lock-operator">|</span> `Aborted
<span class="htmlize-tuareg-font-lock-operator">]</span>
<span class="htmlize-tuareg-font-lock-governing">class</span> <span class="htmlize-tuareg-font-lock-governing">type</span><span class="htmlize-variable-name"> </span><span class="htmlize-tuareg-font-lock-operator">[</span> <span class="htmlize-tuareg-font-lock-operator">'</span>t <span class="htmlize-tuareg-font-lock-operator">]</span> engine <span class="htmlize-tuareg-font-lock-operator">=</span> <span class="htmlize-tuareg-font-lock-governing">object</span>
<span class="htmlize-tuareg-font-lock-governing">method</span> <span class="htmlize-function-name">state</span><span class="htmlize-variable-name"> </span><span class="htmlize-tuareg-font-lock-operator">:</span> <span class="htmlize-tuareg-font-lock-operator">'</span><span class="htmlize-type">t engine_state</span>
<span class="htmlize-tuareg-font-lock-governing">method</span> <span class="htmlize-function-name">abort</span><span class="htmlize-variable-name"> </span><span class="htmlize-tuareg-font-lock-operator">:</span> <span class="htmlize-type">unit </span><span class="htmlize-tuareg-font-lock-operator">-></span><span class="htmlize-type"> unit</span>
<span class="htmlize-tuareg-font-lock-governing">method</span> <span class="htmlize-function-name">request_notification</span><span class="htmlize-variable-name"> </span><span class="htmlize-tuareg-font-lock-operator">:</span> <span class="htmlize-tuareg-font-lock-operator">(</span><span class="htmlize-type">unit </span><span class="htmlize-tuareg-font-lock-operator">-></span><span class="htmlize-type"> bool</span><span class="htmlize-tuareg-font-lock-operator">)</span><span class="htmlize-type"> </span><span class="htmlize-tuareg-font-lock-operator">-></span><span class="htmlize-type"> unit</span>
<span class="htmlize-tuareg-font-lock-governing">method</span> <span class="htmlize-function-name">event_system</span><span class="htmlize-variable-name"> </span><span class="htmlize-tuareg-font-lock-operator">:</span> <span class="htmlize-type">Unixqueue.event_system</span>
<span class="htmlize-tuareg-font-lock-governing">end</span>
</pre>An engine runs for a while, then finishes with some value, fails with an exception, or becomes aborted. Code that's interested in the result of an engine can use <code>request_notification</code> to find out when the state of the engine has changed.<br />
</p><p>Equeue provides a number of engines for networking tasks (such as connecting to a socket), and also for hooking engines together in various ways. Maybe the most interesting one (when comparing to Lwt at least) is: <pre><span class="htmlize-tuareg-font-lock-governing">class</span><span class="htmlize-variable-name"> </span><span class="htmlize-tuareg-font-lock-operator">['</span>a<span class="htmlize-tuareg-font-lock-operator">,</span> <span class="htmlize-tuareg-font-lock-operator">'</span>b<span class="htmlize-tuareg-font-lock-operator">]</span> <span class="htmlize-variable-name">seq_engine</span> <span class="htmlize-tuareg-font-lock-operator">:</span>
<span class="htmlize-tuareg-font-lock-operator">'</span>a <span class="htmlize-tuareg-font-lock-operator">#</span>engine <span class="htmlize-tuareg-font-lock-operator">-></span>
<span class="htmlize-tuareg-font-lock-operator">('</span>a <span class="htmlize-tuareg-font-lock-operator">-></span> <span class="htmlize-tuareg-font-lock-operator">'</span>b <span class="htmlize-tuareg-font-lock-operator">#</span>engine<span class="htmlize-tuareg-font-lock-operator">)</span> <span class="htmlize-tuareg-font-lock-operator">-></span>
<span class="htmlize-tuareg-font-lock-operator">['</span>b<span class="htmlize-tuareg-font-lock-operator">]</span> engine
</pre>which feeds the result of one engine into a function that creates another engine. Does this look familiar?<br />
</p><b>Lwt</b><br />
<p>Lwt provides no equivalent to Equeue's low-level event handling. But an Lwt thread is quite similar to an Equeue engine, in that it runs for a while then finishes successfully with a value or fails with an exception (there is no aborted state). However, the type <code>'a Lwt.t</code> of threads returning values of type <code>'a</code> is abstract; to implement your own thread you must build it out of the functions provided by Lwt. Here are some important ones: <pre><span class="htmlize-tuareg-font-lock-governing">val</span> <span class="htmlize-variable-name">return </span><span class="htmlize-tuareg-font-lock-operator">:</span> <span class="htmlize-tuareg-font-lock-operator">'</span><span class="htmlize-type">a </span><span class="htmlize-tuareg-font-lock-operator">-></span><span class="htmlize-type"> </span><span class="htmlize-tuareg-font-lock-operator">'</span><span class="htmlize-type">a t</span>
<span class="htmlize-tuareg-font-lock-governing">val</span> <span class="htmlize-variable-name">fail </span><span class="htmlize-tuareg-font-lock-operator">:</span> <span class="htmlize-type">exn </span><span class="htmlize-tuareg-font-lock-operator">-></span><span class="htmlize-type"> </span><span class="htmlize-tuareg-font-lock-operator">'</span><span class="htmlize-type">a t</span>
</pre>You create an already-terminated thread with a value or exception with <code>return</code> and <code>fail</code> respectively. (Equeue has <code>epsilon_engine</code> which does essentially the same thing.) <pre><span class="htmlize-tuareg-font-lock-governing">val</span> <span class="htmlize-variable-name">wait </span><span class="htmlize-tuareg-font-lock-operator">:</span> <span class="htmlize-type">unit </span><span class="htmlize-tuareg-font-lock-operator">-></span><span class="htmlize-type"> </span><span class="htmlize-tuareg-font-lock-operator">'</span><span class="htmlize-type">a t</span>
<span class="htmlize-tuareg-font-lock-governing">val</span> <span class="htmlize-variable-name">wakeup </span><span class="htmlize-tuareg-font-lock-operator">:</span> <span class="htmlize-tuareg-font-lock-operator">'</span><span class="htmlize-type">a t </span><span class="htmlize-tuareg-font-lock-operator">-></span><span class="htmlize-type"> </span><span class="htmlize-tuareg-font-lock-operator">'</span><span class="htmlize-type">a </span><span class="htmlize-tuareg-font-lock-operator">-></span><span class="htmlize-type"> unit</span>
<span class="htmlize-tuareg-font-lock-governing">val</span> <span class="htmlize-variable-name">wakeup_exn </span><span class="htmlize-tuareg-font-lock-operator">:</span> <span class="htmlize-tuareg-font-lock-operator">'</span><span class="htmlize-type">a t </span><span class="htmlize-tuareg-font-lock-operator">-></span><span class="htmlize-type"> exn </span><span class="htmlize-tuareg-font-lock-operator">-></span><span class="htmlize-type"> unit</span>
</pre>These functions give you a way to make threads that return only after some event occurs. A thread created with <code>wait</code> is blocked until woken either with a value or an exception. Any threads using its value block until it's woken. But how does a thread use another thread's value? <pre><span class="htmlize-tuareg-font-lock-governing">val</span> <span class="htmlize-variable-name">bind </span><span class="htmlize-tuareg-font-lock-operator">:</span> <span class="htmlize-tuareg-font-lock-operator">'</span><span class="htmlize-type">a t </span><span class="htmlize-tuareg-font-lock-operator">-></span><span class="htmlize-type"> </span><span class="htmlize-tuareg-font-lock-operator">('</span><span class="htmlize-type">a </span><span class="htmlize-tuareg-font-lock-operator">-></span><span class="htmlize-type"> </span><span class="htmlize-tuareg-font-lock-operator">'</span><span class="htmlize-type">b t</span><span class="htmlize-tuareg-font-lock-operator">)</span><span class="htmlize-type"> </span><span class="htmlize-tuareg-font-lock-operator">-></span><span class="htmlize-type"> </span><span class="htmlize-tuareg-font-lock-operator">'</span><span class="htmlize-type">b t</span>
</pre>This function feeds the result of one thread into a function that creates another thread, just like Equeue's <code>seq_engine</code> above. The important thing is that the value may not be available yet. In that case the function you give as the second argument is added to a notification list and called when the value arrives. This is similar to Equeue's <code>request_notification</code>, except that with Lwt notification is entirely under the hood: asking to be notified and getting the value of the thread are the same operation.<br />
</p><p>(Maybe you noticed that the type <code>Lwt.t</code> together with the functions <code>return</code> and <code>bind</code> form a monad. It would appear that the same is true of Equeue's <code>engine</code>, <code>epsilon_engine</code>, and <code>seq_engine</code>, although I haven't checked that they satisfy the monad laws.)<br />
</p><p>The <code>Lwt_unix</code> module provides a set of Unix I/O functions that match many of the ordinary ones in the <code>Unix</code> module, but return <code>Lwt.t</code> values (i.e. threads). In order to use the value you have to bind the thread, and possibly block until the value arrives.<br />
</p><b>Comparison</b><br />
<p>Lwt is a very beautiful library. The monadic interface encourages you to think about interacting threads in terms of values and dependencies, rather than states and callbacks. Lwt code can be very concise, and with the help of <a href="http://www.cas.mcmaster.ca/~carette/pa_monad/">pa_monad</a>, it can look pretty much just like straight-line code. Equeue engines require more machinery to implement (in particular, <code>request_notification</code>, although the <code>engine_mixin</code> class helps with that), and this increased overhead makes it less convenient to use threads in a fine-grained way.<br />
</p><p>Lwt is particularly nice with exception handling. In most cases, if a thread raises an exception it will be converted to a failing thread, rather than escaping the thread machinery (as would happen in an Equeue engine if you don't explicitly catch the exception). Unfortunately there are places this doesn't work (in order to support constant-space tail calls), which can be surprising.<br />
</p><p>Equeue, on the other hand, gives you much better low-level control. Lwt gives you the monadic equivalent of a blocking threads interface: you get a <code>read</code> call that blocks until data is ready. Equeue separates notification of events from the actual I/O operations, so if you want to do something other than read when data is ready you can. You can also remove a resource, to indicate that you're no longer interested in its events. With Lwt once a thread is waiting to read, it keeps waiting until data is ready or the channel is aborted (using <code>Lwt_unix.abort</code>). This covers the common case where you want to close the connection on a timeout, but more complicated things are harder. In addition, since you always care about timeouts when doing network programming, it's convenient that Equeue builds them into the resource interface.<br />
</p><p>Equeue may be more efficient in low-level ways: for instance, if you're going to repeatedly read a socket you can leave the resource and handler in the event system; in Lwt every <code>read</code> adds a new action (the Lwt equivalent of a handler). But I bet this doesn't matter almost all the time.<br />
</p><b>So which one?</b><br />
<p>Lwt definitely wins on clarity, simplicity, and concision for higher-level coding. Equeue wins if you need low-level control, or possibly if you need the absolute most performance.<br />
</p><p>Another factor, however, is that Equeue works with the rest of Ocamlnet, and in particular the ONC RPC implementation and the awesome Netplex server framework. For this reason I've adapted Lwt to run on top of Equeue, in the <a href="http://code.google.com/p/orpc2/source/browse/#svn/trunk/src/lwt-equeue">lwt-equeue</a> library that comes with <a href="http://code.google.com/p/orpc2/">orpc</a>. (I hope to do another orpc release soon with the latest version of lwt-equeue; in the meantime you can try the trunk version.) With lwt-equeue it's straightforward to mix Lwt and Equeue code, so you can use each when it's most appropriate.<br />
</p><p>(By the way, <a href="http://portal.acm.org/citation.cfm?id=1411304.1411307">Jérôme Vouillon's ML Workshop paper on Lwt</a> is really nice; it explains some tricky details of the implementation.)<br />
</p><p>Next time back to Camlp4.<br />
</p>Jake Donhamhttp://www.blogger.com/profile/04768087689799941690noreply@blogger.com0tag:blogger.com,1999:blog-1445545651031573301.post-23503144094251508142009-01-27T22:09:00.000-08:002010-03-02T18:09:53.800-08:00Reading Camlp4, part 4: consuming OCaml ASTsIt's easy to think of Camlp4 as just "defmacro on steroids"; that is, just a tool for syntax extension, but it is really a box of independently-useful tools. As we've seen, Camlp4 can be used purely for code generation; in this post I'll describe a tool that uses it purely for code consumption: a (minimal, broken) version of <a href="http://www.cs.ru.nl/~tews/otags/">otags</a>:
<pre>
<span class="htmlize-tuareg-font-lock-governing">open</span> <span class="htmlize-type">Camlp4.PreCast</span>
<span class="htmlize-tuareg-font-lock-governing">module</span> <span class="htmlize-type">M </span><span class="htmlize-tuareg-font-lock-operator">=</span> <span class="htmlize-type">Camlp4OCamlRevisedParser</span>.Make<span class="htmlize-tuareg-font-lock-operator">(</span>Syntax<span class="htmlize-tuareg-font-lock-operator">)</span>
<span class="htmlize-tuareg-font-lock-governing">module</span> <span class="htmlize-type">N </span><span class="htmlize-tuareg-font-lock-operator">=</span> <span class="htmlize-type">Camlp4OCamlParser</span>.Make<span class="htmlize-tuareg-font-lock-operator">(</span>Syntax<span class="htmlize-tuareg-font-lock-operator">)</span>
</pre>
We're going to call the OCaml parser directly. These functor applications are used only for their effect (which is to fill in an empty grammer with OCaml cases); ordinarily they would be called as part of Camlp4's dynamic loading process. Recall that the original syntax parser is an extension of the revised parser, so we need both, in this order.
<pre>
<span class="htmlize-tuareg-font-lock-governing">let</span> <span class="htmlize-variable-name">files </span><span class="htmlize-tuareg-font-lock-operator">=</span> <span class="htmlize-tuareg-font-lock-operator">ref</span> <span class="htmlize-tuareg-font-lock-operator">[]</span>
<span class="htmlize-tuareg-font-lock-governing">let</span> <span class="htmlize-tuareg-font-lock-governing">rec</span> <span class="htmlize-function-name">do_fn</span><span class="htmlize-variable-name"> fn </span><span class="htmlize-tuareg-font-lock-operator">=</span>
<span class="htmlize-tuareg-font-lock-governing">let</span> <span class="htmlize-variable-name">st </span><span class="htmlize-tuareg-font-lock-operator">=</span> <span class="htmlize-type">Stream</span>.of_channel <span class="htmlize-tuareg-font-lock-operator">(</span>open_in fn<span class="htmlize-tuareg-font-lock-operator">)</span> <span class="htmlize-tuareg-font-lock-governing">in</span>
<span class="htmlize-tuareg-font-lock-governing">let</span> <span class="htmlize-variable-name">str_item </span><span class="htmlize-tuareg-font-lock-operator">=</span> <span class="htmlize-type">Syntax</span>.parse_implem <span class="htmlize-tuareg-font-lock-operator">(</span><span class="htmlize-type">Loc</span>.mk fn<span class="htmlize-tuareg-font-lock-operator">)</span> st <span class="htmlize-tuareg-font-lock-governing">in</span>
<span class="htmlize-tuareg-font-lock-governing">let</span> <span class="htmlize-variable-name">str_items </span><span class="htmlize-tuareg-font-lock-operator">=</span> <span class="htmlize-type">Ast</span>.list_of_str_item str_item <span class="htmlize-tuareg-font-lock-operator">[]</span> <span class="htmlize-tuareg-font-lock-governing">in</span>
<span class="htmlize-tuareg-font-lock-governing">let</span> <span class="htmlize-variable-name">tags </span><span class="htmlize-tuareg-font-lock-operator">=</span> <span class="htmlize-type">List</span>.fold_right do_str_item str_items <span class="htmlize-tuareg-font-lock-operator">[]</span> <span class="htmlize-tuareg-font-lock-governing">in</span>
files <span class="htmlize-tuareg-font-lock-operator">:=</span> <span class="htmlize-tuareg-font-lock-operator">(</span>fn<span class="htmlize-tuareg-font-lock-operator">,</span> tags<span class="htmlize-tuareg-font-lock-operator">)::!</span>files
</pre>
We'll call <code>do_fn</code> for each filename on the command line. The <code>Syntax.parse_implem</code> function takes a <code>Loc.t</code> and a stream, and parses the stream into a <code>str_item</code>. (The initial <code>Loc.t</code> just provides the filename so later locations can refer to it, for error messages etc.) Now, recall that even though we got back a single <code>str_item</code>, it can contain several definitions (collected with <code>StSem</code>). We use <code>Ast.list_of_str_item</code> to get an ordinary list, then accumulate tags into <code>files</code>.
<pre>
<span class="htmlize-tuareg-font-lock-governing">and</span> <span class="htmlize-function-name">do_str_item</span><span class="htmlize-variable-name"> si tags </span><span class="htmlize-tuareg-font-lock-operator">=</span>
<span class="htmlize-keyword">match</span> si <span class="htmlize-keyword">with</span>
<span class="htmlize-comment">(* | <:str_item< let $rec:_$ $bindings$ >> -> *)</span>
<span class="htmlize-tuareg-font-lock-operator">|</span> <span class="htmlize-type">Ast</span>.StVal <span class="htmlize-tuareg-font-lock-operator">(</span>_<span class="htmlize-tuareg-font-lock-operator">,</span> _<span class="htmlize-tuareg-font-lock-operator">,</span> bindings<span class="htmlize-tuareg-font-lock-operator">)</span> <span class="htmlize-tuareg-font-lock-operator">-></span>
<span class="htmlize-tuareg-font-lock-governing">let</span> <span class="htmlize-variable-name">bindings </span><span class="htmlize-tuareg-font-lock-operator">=</span> <span class="htmlize-type">Ast</span>.list_of_binding bindings <span class="htmlize-tuareg-font-lock-operator">[]</span> <span class="htmlize-tuareg-font-lock-governing">in</span>
<span class="htmlize-type">List</span>.fold_right do_binding bindings tags
<span class="htmlize-tuareg-font-lock-operator">|</span> _ <span class="htmlize-tuareg-font-lock-operator">-></span> tags
</pre>
We'll only consider value bindings. The commented-out <code>str_item</code> quotation doesn't work (run it through Camlp4 to see why--I'm not sure where the extra <code>StSem</code>/<code>StNil</code> come from), so we fall back to an explicit constructor. (The <code>rec</code> antiquotation matches a flag controlling whether an <code>StVal</code> is a <code>let rec</code> or just a <code>let</code>; here we don't care.) Now we have an <code>Ast.binding</code>, which again can contain several bindings (collected with <code>BiAnd</code>) so we call <code>Ast.list_of_bindings</code>.
<pre>
<span class="htmlize-tuareg-font-lock-governing">and</span> <span class="htmlize-function-name">do_binding</span><span class="htmlize-variable-name"> bi tags </span><span class="htmlize-tuareg-font-lock-operator">=</span>
<span class="htmlize-keyword">match</span> bi <span class="htmlize-keyword">with</span>
<span class="htmlize-tuareg-font-lock-operator">|</span> <span class="htmlize-tuareg-font-lock-operator"><:</span><span class="htmlize-type">binding</span><span class="htmlize-tuareg-font-lock-operator">@</span>loc<span class="htmlize-tuareg-font-lock-operator"><</span> <span class="htmlize-tuareg-font-lock-operator">$</span>lid<span class="htmlize-tuareg-font-lock-operator">:</span><span class="htmlize-type">lid</span><span class="htmlize-tuareg-font-lock-operator">$</span><span class="htmlize-type"> </span><span class="htmlize-tuareg-font-lock-operator">=</span> <span class="htmlize-tuareg-font-lock-operator">$</span>_<span class="htmlize-tuareg-font-lock-operator">$</span> <span class="htmlize-tuareg-font-lock-operator">>></span> <span class="htmlize-tuareg-font-lock-operator">-></span>
<span class="htmlize-tuareg-font-lock-governing">let</span> <span class="htmlize-variable-name">line </span><span class="htmlize-tuareg-font-lock-operator">=</span> <span class="htmlize-type">Loc</span>.start_line loc <span class="htmlize-tuareg-font-lock-governing">in</span>
<span class="htmlize-tuareg-font-lock-governing">let</span> <span class="htmlize-variable-name">off </span><span class="htmlize-tuareg-font-lock-operator">=</span> <span class="htmlize-type">Loc</span>.start_off loc <span class="htmlize-tuareg-font-lock-governing">in</span>
<span class="htmlize-tuareg-font-lock-governing">let</span> <span class="htmlize-variable-name">pre </span><span class="htmlize-tuareg-font-lock-operator">=</span> <span class="htmlize-string">"let "</span> <span class="htmlize-tuareg-font-lock-operator">^</span> lid <span class="htmlize-tuareg-font-lock-governing">in</span>
<span class="htmlize-tuareg-font-lock-operator">(</span>pre<span class="htmlize-tuareg-font-lock-operator">,</span> lid<span class="htmlize-tuareg-font-lock-operator">,</span> line<span class="htmlize-tuareg-font-lock-operator">,</span> off<span class="htmlize-tuareg-font-lock-operator">)::</span>tags
<span class="htmlize-tuareg-font-lock-operator">|</span> _ <span class="htmlize-tuareg-font-lock-operator">-></span> tags
</pre>
We're going to generate an <code>etags</code>-format file, where each definition consists of a prefix of the line in the source, the tag itself, the line number, and the character offset. If you look in the parser you'll see that the left side of a binding can be any pattern (as you'd expect), but we only handle the case where it's a single identifier; the <code>lid</code> antiquotation extracts it as a string. The line number and character offset are easy to find from the location of the binding (see <a href="http://camlcvs.inria.fr/cgi-bin/cvsweb/~checkout~/ocaml/camlp4/Camlp4/Sig.ml?content-type=text%2Fplain">camlp4/Camlp4/Sig.ml</a> for the <code>Loc</code> functions), which we get with <code>@loc</code>. The prefix is problematic: the location of the binding does not include the <code>let</code> or <code>and</code> part, and anyway what we really want is everything from the beginning of the line. Doable but not so instructive of Camlp4, so we just tack on a <code>"let "</code> prefix (so this doesn't work for <code>and</code> or if there is whitespace).
<pre>
<span class="htmlize-tuareg-font-lock-governing">let</span> <span class="htmlize-function-name">print_tags</span><span class="htmlize-variable-name"> files </span><span class="htmlize-tuareg-font-lock-operator">=</span>
<span class="htmlize-tuareg-font-lock-governing">let</span> <span class="htmlize-variable-name">ch </span><span class="htmlize-tuareg-font-lock-operator">=</span> open_out <span class="htmlize-string">"TAGS"</span> <span class="htmlize-tuareg-font-lock-governing">in</span>
<span class="htmlize-type">ListLabels</span>.iter files <span class="htmlize-tuareg-font-lock-operator">~</span><span class="htmlize-variable-name">f</span><span class="htmlize-tuareg-font-lock-operator">:(</span><span class="htmlize-keyword">fun</span> <span class="htmlize-tuareg-font-lock-operator">(</span><span class="htmlize-variable-name">fn</span><span class="htmlize-tuareg-font-lock-operator">,</span><span class="htmlize-variable-name"> tags</span><span class="htmlize-tuareg-font-lock-operator">)</span><span class="htmlize-variable-name"> </span><span class="htmlize-tuareg-font-lock-operator">-></span>
<span class="htmlize-type">Printf</span>.fprintf ch <span class="htmlize-string">"\012\n%s,%d\n"</span> fn 0<span class="htmlize-tuareg-font-lock-operator">;</span>
<span class="htmlize-type">ListLabels</span>.iter tags <span class="htmlize-tuareg-font-lock-operator">~</span><span class="htmlize-variable-name">f</span><span class="htmlize-tuareg-font-lock-operator">:(</span><span class="htmlize-keyword">fun</span> <span class="htmlize-tuareg-font-lock-operator">(</span><span class="htmlize-variable-name">pre</span><span class="htmlize-tuareg-font-lock-operator">,</span><span class="htmlize-variable-name"> tag</span><span class="htmlize-tuareg-font-lock-operator">,</span><span class="htmlize-variable-name"> line</span><span class="htmlize-tuareg-font-lock-operator">,</span><span class="htmlize-variable-name"> off</span><span class="htmlize-tuareg-font-lock-operator">)</span><span class="htmlize-variable-name"> </span><span class="htmlize-tuareg-font-lock-operator">-></span>
<span class="htmlize-type">Printf</span>.fprintf ch <span class="htmlize-string">"%s\127%s\001%d,%d\n"</span> pre tag line off<span class="htmlize-tuareg-font-lock-operator">))</span>
</pre>
Generating the tags file is straightforward, following the description at the bottom of the <a href="http://www.cs.ru.nl/~tews/otags/README">otags README</a>. (The <code>0</code> is supposed to be the length of the tag data, but my Emacs doesn't seem to care.) We put the pieces together with <code>Arg</code>:
<pre>
<span class="htmlize-tuareg-font-lock-operator">;;</span>
<span class="htmlize-type">Arg</span>.parse <span class="htmlize-tuareg-font-lock-operator">[]</span> do_fn <span class="htmlize-string">"otags: fn1 [fn2 ...]"</span><span class="htmlize-tuareg-font-lock-operator">;</span>
print_tags <span class="htmlize-tuareg-font-lock-operator">!</span>files
</pre>
and finally, a Makefile:
<pre>
<span class="htmlize-makefile-targets">otags</span>: otags.ml
<span class="htmlize-pesche-tab"> </span><span class="htmlize-makefile-shell">ocamlc \
</span><span class="htmlize-pesche-tab"> </span> -pp camlp4of \
<span class="htmlize-pesche-tab"> </span> -o otags \
<span class="htmlize-pesche-tab"> </span> -I +camlp4 -I +camlp4/Camlp4Parsers \
<span class="htmlize-pesche-tab"> </span> dynlink.cma camlp4fulllib.cma otags.ml
</pre>
We could improve this in many ways (error-handling, patterns, types, etc.); clearly we can't replicate otags in a few dozen lines. But Camlp4 takes care of a lot of the hard work. Next time, maybe, an actual syntax extension.Jake Donhamhttp://www.blogger.com/profile/04768087689799941690noreply@blogger.com1tag:blogger.com,1999:blog-1445545651031573301.post-25607376145273184872009-01-22T14:18:00.000-08:002010-03-03T12:07:21.074-08:00Reading Camlp4, part 3: quotations in depth<p>(I set myself the goal of posting every week, but the <a href="http://skydeck.com/blog/announcements/yourcellphoneonline/">latest Skydeck release</a> has kept me busy, and it turned out I didn't understand the following as well as I thought.)<br />
</p><p>After seeing the examples of Camlp4 quotations in my <a href="http://ambassadortothecomputers.blogspot.com/2009/01/reading-camlp4-part-2-quotations_04.html">last post</a>, you may wonder: <ul><li>what are all the quotations (<code>str_item</code>, <code>ctyp</code>, etc.)?</li>
<li>what are all the antiquotations (<code>uid</code>, <code>`str</code>, etc.)?</li>
<li>which antiquotations are allowed where?</li>
</ul>To answer these questions, we're going to look at how quotations are implemented in Camlp4. We'll need to learn a little about Camlp4's extensible parsers, and look at the OCaml parser in Camlp4.<br />
</p><b>Parsing OCaml</b><br />
<p>A small complication is that there is more than one concrete syntax for OCaml in Camlp4: the <em>original</em> (i.e. normal OCaml syntax) and <em>revised</em> syntaxes. The original syntax parser is given as an extension of the revised syntax one. So we'll begin in <a href="http://camlcvs.inria.fr/cgi-bin/cvsweb/~checkout~/ocaml/camlp4/Camlp4Parsers/Camlp4OCamlRevisedParser.ml?content-type=text%2Fplain">camlp4/Camlp4Parsers/Camlp4OCamlRevisedParser.ml</a> (line 588 in the 3.10.2 source):<br />
<pre> <span class="htmlize-variable-name">expr</span><span class="htmlize-tuareg-font-lock-operator">:</span>
<span class="htmlize-tuareg-font-lock-operator">[</span> <span class="htmlize-string">"top"</span> RIGHTA
<span class="htmlize-tuareg-font-lock-operator">[</span> <span class="htmlize-comment">(* ... *)</span>
<span class="htmlize-tuareg-font-lock-operator">|</span> <span class="htmlize-string">"if"</span><span class="htmlize-tuareg-font-lock-operator">;</span> e1 <span class="htmlize-tuareg-font-lock-operator">=</span> SELF<span class="htmlize-tuareg-font-lock-operator">;</span> <span class="htmlize-string">"then"</span><span class="htmlize-tuareg-font-lock-operator">;</span> e2 <span class="htmlize-tuareg-font-lock-operator">=</span> SELF<span class="htmlize-tuareg-font-lock-operator">;</span> <span class="htmlize-string">"else"</span><span class="htmlize-tuareg-font-lock-operator">;</span> e3 <span class="htmlize-tuareg-font-lock-operator">=</span> SELF <span class="htmlize-tuareg-font-lock-operator">-></span>
<span class="htmlize-tuareg-font-lock-operator"><:</span><span class="htmlize-type">expr</span><span class="htmlize-tuareg-font-lock-operator"><</span> <span class="htmlize-keyword">if</span> <span class="htmlize-tuareg-font-lock-operator">$</span>e1<span class="htmlize-tuareg-font-lock-operator">$</span> <span class="htmlize-keyword">then</span> <span class="htmlize-tuareg-font-lock-operator">$</span>e2<span class="htmlize-tuareg-font-lock-operator">$</span> <span class="htmlize-keyword">else</span> <span class="htmlize-tuareg-font-lock-operator">$</span>e3<span class="htmlize-tuareg-font-lock-operator">$</span> <span class="htmlize-tuareg-font-lock-operator">>></span>
</pre>You can read the parser more or less as a BNF grammar. This code defines a nonterminal <code>expr</code> by giving a bunch of cases. The cases are grouped together into <em>levels</em>, which can be labeled and given an associativity (that's what <code>"top"</code> and <code>NONASSOC</code> are). Levels are used to indicate the precedence of operators, and also to provide hooks into the parser for extending it; for our purpose here you can skip over them.<br />
</p><p>You can read a case like a pattern match: match the stuff to the left of the arrow, return the stuff to the right. (What's being matched is a stream of tokens from the lexer.) A parser pattern can contain literal strings like <code>"if"</code>, backquoted data constructors like <code>`INT</code> (which can carry additional data), nonterminals, and some special keywords like <code>SELF</code>. You can bind variables using ordinary pattern-matching syntax within token literals, and use <code>x = y</code> syntax to bind the result of a call to a nonterminal.<br />
</p><p>The right side is a piece of AST representing what was parsed, and in most cases it is given <em>as a quotation</em>. This is pretty confusing, because often the left and right sides of a case look very similar, and you can't tell what AST node is produced. However, it gives us lots of examples of tricky quotations, and since we have already seen how to expand quotations we can deal with it. (If you're curious how Camlp4 is written using itself see <a href="http://camlcvs.inria.fr/cgi-bin/cvsweb/~checkout~/ocaml/camlp4/boot/">camlp4/boot</a>.)<br />
</p><p>Focusing on the <code>if</code> case: the keywords <code>if</code>, <code>then</code>, and <code>else</code> are parsed with an expression after each (at least we know that's the syntax of normal OCaml, and that gives a clue to what <code>SELF</code> means: parse the current nonterminal); the expressions are bound to a variables; then the pieces are put together into an <code>ExIfe</code> AST node.<br />
</p><p>(Some other special keywords you'll see are <code>OPT</code>, which makes the next item optional, and <code>LIST0</code>/<code>LIST1</code>, which parse a list of items separated by the token after <code>SEP</code>. <code>LIST1</code> means there must be at least one item.)<br />
</p><p>OCaml allows you to leave off the <code>else</code> part; where is the code for that? Turns out this is not allowed in revised syntax, and the original syntax overrides this part of the parser. Take a look at <a href="http://camlcvs.inria.fr/cgi-bin/cvsweb/~checkout~/ocaml/camlp4/Camlp4Parsers/Camlp4OCamlParser.ml?content-type=text%2Fplain">camlp4/Camlp4Parsers/Camlp4OCamlParser.ml</a> (line 292):<br />
<pre> <span class="htmlize-variable-name">expr</span><span class="htmlize-tuareg-font-lock-operator">:</span> <span class="htmlize-type">LEVEL </span><span class="htmlize-string">"top"</span>
<span class="htmlize-tuareg-font-lock-operator">[</span> <span class="htmlize-tuareg-font-lock-operator">[</span> <span class="htmlize-comment">(* ... *)</span>
<span class="htmlize-tuareg-font-lock-operator">|</span> <span class="htmlize-string">"if"</span><span class="htmlize-tuareg-font-lock-operator">;</span> e1 <span class="htmlize-tuareg-font-lock-operator">=</span> SELF<span class="htmlize-tuareg-font-lock-operator">;</span> <span class="htmlize-string">"then"</span><span class="htmlize-tuareg-font-lock-operator">;</span> e2 <span class="htmlize-tuareg-font-lock-operator">=</span> expr LEVEL <span class="htmlize-string">"top"</span><span class="htmlize-tuareg-font-lock-operator">;</span>
<span class="htmlize-string">"else"</span><span class="htmlize-tuareg-font-lock-operator">;</span> e3 <span class="htmlize-tuareg-font-lock-operator">=</span> expr LEVEL <span class="htmlize-string">"top"</span> <span class="htmlize-tuareg-font-lock-operator">-></span>
<span class="htmlize-tuareg-font-lock-operator"><:</span><span class="htmlize-type">expr</span><span class="htmlize-tuareg-font-lock-operator"><</span> <span class="htmlize-keyword">if</span> <span class="htmlize-tuareg-font-lock-operator">$</span>e1<span class="htmlize-tuareg-font-lock-operator">$</span> <span class="htmlize-keyword">then</span> <span class="htmlize-tuareg-font-lock-operator">$</span>e2<span class="htmlize-tuareg-font-lock-operator">$</span> <span class="htmlize-keyword">else</span> <span class="htmlize-tuareg-font-lock-operator">$</span>e3<span class="htmlize-tuareg-font-lock-operator">$</span> <span class="htmlize-tuareg-font-lock-operator">>></span>
<span class="htmlize-tuareg-font-lock-operator">|</span> <span class="htmlize-string">"if"</span><span class="htmlize-tuareg-font-lock-operator">;</span> e1 <span class="htmlize-tuareg-font-lock-operator">=</span> SELF<span class="htmlize-tuareg-font-lock-operator">;</span> <span class="htmlize-string">"then"</span><span class="htmlize-tuareg-font-lock-operator">;</span> e2 <span class="htmlize-tuareg-font-lock-operator">=</span> expr LEVEL <span class="htmlize-string">"top"</span> <span class="htmlize-tuareg-font-lock-operator">-></span>
<span class="htmlize-tuareg-font-lock-operator"><:</span><span class="htmlize-type">expr</span><span class="htmlize-tuareg-font-lock-operator"><</span> <span class="htmlize-keyword">if</span> <span class="htmlize-tuareg-font-lock-operator">$</span>e1<span class="htmlize-tuareg-font-lock-operator">$</span> <span class="htmlize-keyword">then</span> <span class="htmlize-tuareg-font-lock-operator">$</span>e2<span class="htmlize-tuareg-font-lock-operator">$</span> <span class="htmlize-keyword">else</span> <span class="htmlize-tuareg-font-lock-operator">()</span> <span class="htmlize-tuareg-font-lock-operator">>></span>
</pre>(Notice how the <code>expr</code> definition is qualified with the level in the revised grammar where it should slot in.)<br />
</p><b>Quotations and antiquotations</b><br />
<p>Hopefully that is enough about parsing to muddle through; let's move on to quotations. Here's another piece of the revised parser (line 670)--these are still cases of <code>expr</code>:<br />
<pre> <span class="htmlize-tuareg-font-lock-operator">[</span> `QUOTATION x <span class="htmlize-tuareg-font-lock-operator">-></span> <span class="htmlize-type">Quotation</span>.expand _loc x <span class="htmlize-type">Quotation</span>.<span class="htmlize-type">DynAst</span>.expr_tag
</pre>The <code>`QUOTATION</code> token contains a record including the body of the quotation and the tag. The record is passed off to the <code>Quotation</code> module to be expanded. The actual expansion happens in <a href="http://camlcvs.inria.fr/cgi-bin/cvsweb/~checkout~/ocaml/camlp4/Camlp4Parsers/Camlp4QuotationCommon.ml?content-type=text%2Fplain">camlp4/Camlp4Parsers/Camlp4QuotationCommon.ml</a>. Looking to the bottom of that file, there are several lines like:<br />
<pre> add_quotation <span class="htmlize-string">"sig_item"</span> sig_item_quot <span class="htmlize-type">ME</span>.meta_sig_item <span class="htmlize-type">MP</span>.meta_sig_item<span class="htmlize-tuareg-font-lock-operator">;</span>
</pre>This installs a quotation expander for the <code>sig_item</code> tag. The expander parses the quotation starting at the <code>sig_item_quot</code> nonterminal in the parser, then runs the result through the antiquotation expander (see below). (The last two arguments to <code>add_quotation</code> have to do with the context where a quotation appears: inside a pattern you get <code>PaFoo</code> nodes while inside an expression you get <code>ExBar</code> nodes.) So we can answer one of the questions posed at the beginning: what are all the quotation tags? We can see here that there is a quotation for each type in <a href="http://camlcvs.inria.fr/cgi-bin/cvsweb/~checkout~/ocaml/camlp4/Camlp4Parsers/?content-type=text%2Fplain">camlp4/Camlp4/Camlp4Ast.partial.ml</a>.<br />
</p><p>Now let's look at antiquotations, which are more complicated (line 671):<br />
<pre> <span class="htmlize-tuareg-font-lock-operator">|</span> `ANTIQUOT <span class="htmlize-tuareg-font-lock-operator">(</span><span class="htmlize-string">"exp"</span><span class="htmlize-tuareg-font-lock-operator">|</span><span class="htmlize-string">""</span><span class="htmlize-tuareg-font-lock-operator">|</span><span class="htmlize-string">"anti"</span> <span class="htmlize-keyword">as</span> n<span class="htmlize-tuareg-font-lock-operator">)</span> s <span class="htmlize-tuareg-font-lock-operator">-></span>
<span class="htmlize-tuareg-font-lock-operator"><:</span><span class="htmlize-type">expr</span><span class="htmlize-tuareg-font-lock-operator"><</span> <span class="htmlize-tuareg-font-lock-operator">$</span>anti<span class="htmlize-tuareg-font-lock-operator">:</span><span class="htmlize-type">mk_anti </span><span class="htmlize-tuareg-font-lock-operator">~</span><span class="htmlize-variable-name">c</span><span class="htmlize-tuareg-font-lock-operator">:</span><span class="htmlize-string">"expr"</span> n s<span class="htmlize-tuareg-font-lock-operator">$</span> <span class="htmlize-tuareg-font-lock-operator">>></span>
</pre>The <code>`ANTIQUOT</code> token contains the tag and the body again (and the parser can choose a case based on the tag). The <code>anti</code> antiquotation creates a special AST node to hold the body of the antiquotation; each type in the AST has a constructor (<code>ExAnt</code>, <code>TyAnt</code>, etc.) for this purpose. The <code>mk_anti</code> function adds another tag, which is not always the same as the one we parsed; the <code>~c</code> argument adds a suffix giving the context where the antiquotation appeared.<br />
</p><p>There are two places where antiquotations are interpreted. First, in <a href="http://camlcvs.inria.fr/cgi-bin/cvsweb/~checkout~/ocaml/camlp4/Camlp4Parsers/Camlp4QuotationCommon.ml?content-type=text%2Fplain">camlp4/Camlp4Parsers/Camlp4QuotationCommon.ml</a> (line 89):<br />
<pre> <span class="htmlize-tuareg-font-lock-operator">[</span> <span class="htmlize-string">"`int"</span> <span class="htmlize-tuareg-font-lock-operator">-></span> <span class="htmlize-tuareg-font-lock-operator"><:</span><span class="htmlize-type">expr</span><span class="htmlize-tuareg-font-lock-operator"><</span> string_of_int <span class="htmlize-tuareg-font-lock-operator">$</span>e<span class="htmlize-tuareg-font-lock-operator">$</span> <span class="htmlize-tuareg-font-lock-operator">>></span>
</pre>This is one of a bunch of cases in a map over the syntax tree. It handles antiquotations like <code><span class="htmlize-tuareg-font-lock-operator"><:</span><span class="htmlize-type">expr</span><span class="htmlize-tuareg-font-lock-operator"><</span> <span class="htmlize-tuareg-font-lock-operator">$</span>`<span class="htmlize-variable-name">int</span><span class="htmlize-tuareg-font-lock-operator">:</span><span class="htmlize-type">5</span><span class="htmlize-tuareg-font-lock-operator">$</span><span class="htmlize-type"> </span><span class="htmlize-tuareg-font-lock-operator">>></span></code>, which turns into an <code>ExInt</code>. You can also see cases here for the <code>anti</code> antiquotations, and some things to do with <code>list</code> antiquotations we haven't seen yet (more on this below).<br />
</p><p>Things that don't match these cases are handled when the AST is pretty-printed. Let's look at <a href="http://camlcvs.inria.fr/cgi-bin/cvsweb/~checkout~/ocaml/camlp4/Camlp4/Printers/OCaml.ml?content-type=text%2Fplain">camlp4/Camlp4/Printers/OCaml.ml</a> (line 510):<br />
<pre> <span class="htmlize-tuareg-font-lock-operator">|</span> <span class="htmlize-tuareg-font-lock-operator"><:</span><span class="htmlize-type">expr</span><span class="htmlize-tuareg-font-lock-operator"><</span> <span class="htmlize-tuareg-font-lock-operator">$</span>int<span class="htmlize-tuareg-font-lock-operator">:</span><span class="htmlize-type">s</span><span class="htmlize-tuareg-font-lock-operator">$</span><span class="htmlize-type"> </span><span class="htmlize-tuareg-font-lock-operator">>></span><span class="htmlize-type"> </span><span class="htmlize-tuareg-font-lock-operator">-></span><span class="htmlize-type"> o</span><span class="htmlize-tuareg-font-lock-operator">#</span>numeric f s <span class="htmlize-string">""</span>
</pre>This case handles antiquotations like <code><span class="htmlize-tuareg-font-lock-operator"><:</span><span class="htmlize-type">expr</span><span class="htmlize-tuareg-font-lock-operator"><</span> <span class="htmlize-tuareg-font-lock-operator">$</span>int<span class="htmlize-tuareg-font-lock-operator">:</span><span class="htmlize-string">"5"</span><span class="htmlize-tuareg-font-lock-operator">$</span> <span class="htmlize-tuareg-font-lock-operator">>></span></code>. Again, this produces an <code>ExInt</code>, but you give it a string instead of an int.<br />
</p><b>What we have learned</b><br />
<p>Teaching a person to fish is fine, unless that person starves while trying to finish their PhD in theoretical pescatology. But I hope that you can see how we might go about answering the remaining questions--what are all the antiquotations, and where are they allowed--by examining all the <code>`ANTIQUOT</code> cases in the parser and puzzling out where they get expanded.<br />
</p><p>Let's look at a particular example, by way of addressing the <a href="http://ambassadortothecomputers.blogspot.com/2009/01/reading-camlp4-part-2-quotations_04.html#comments">comment</a> Nicolas Pouillard (aka Ertai) made on the last post. He points out that the final <code>McOr</code> in <code>of_string</code> can go outside the antiquotation. How could we learn this from the Camlp4 code? Let's find where the antiquotation is expanded, starting at the point where the <code>function</code> keyword is parsed (<a href="http://camlcvs.inria.fr/cgi-bin/cvsweb/~checkout~/ocaml/camlp4/Camlp4Parsers/Camlp4OCamlParser.ml?content-type=text%2Fplain">Camlp4OCamlParser.ml</a> line 299):<br />
<pre> <span class="htmlize-tuareg-font-lock-operator">|</span> <span class="htmlize-string">"function"</span><span class="htmlize-tuareg-font-lock-operator">;</span> a <span class="htmlize-tuareg-font-lock-operator">=</span> match_case <span class="htmlize-tuareg-font-lock-operator">-></span>
<span class="htmlize-tuareg-font-lock-operator"><:</span><span class="htmlize-type">expr</span><span class="htmlize-tuareg-font-lock-operator"><</span> <span class="htmlize-keyword">fun</span><span class="htmlize-variable-name"> </span><span class="htmlize-tuareg-font-lock-operator">[</span> <span class="htmlize-tuareg-font-lock-operator">$</span>a<span class="htmlize-tuareg-font-lock-operator">$</span> <span class="htmlize-tuareg-font-lock-operator">]</span> <span class="htmlize-tuareg-font-lock-operator">>></span>
</pre>(the right side is revised syntax) which uses <code>match_case</code> (line 350):<br />
<pre> <span class="htmlize-variable-name">match_case</span><span class="htmlize-tuareg-font-lock-operator">:</span>
<span class="htmlize-tuareg-font-lock-operator">[</span> <span class="htmlize-tuareg-font-lock-operator">[</span> OPT <span class="htmlize-string">"|"</span><span class="htmlize-tuareg-font-lock-operator">;</span> l <span class="htmlize-tuareg-font-lock-operator">=</span> LIST1 match_case0 SEP <span class="htmlize-string">"|"</span> <span class="htmlize-tuareg-font-lock-operator">-></span> <span class="htmlize-type">Ast</span>.mcOr_of_list l <span class="htmlize-tuareg-font-lock-operator">]</span> <span class="htmlize-tuareg-font-lock-operator">]</span>
</pre>You might think that <code>match_case0</code> parses a single case, but let's check (<a href="http://camlcvs.inria.fr/cgi-bin/cvsweb/~checkout~/ocaml/camlp4/Camlp4Parsers/Camlp4OCamlRevisedParser.ml?content-type=text%2Fplain">Camlp4OCamlRevisedParser.ml</a> line 778):<br />
<pre> <span class="htmlize-variable-name">match_case0</span><span class="htmlize-tuareg-font-lock-operator">:</span>
<span class="htmlize-tuareg-font-lock-operator">[</span> <span class="htmlize-tuareg-font-lock-operator">[</span> `ANTIQUOT <span class="htmlize-tuareg-font-lock-operator">(</span><span class="htmlize-string">"match_case"</span><span class="htmlize-tuareg-font-lock-operator">|</span><span class="htmlize-string">"list"</span> <span class="htmlize-keyword">as</span> n<span class="htmlize-tuareg-font-lock-operator">)</span> s <span class="htmlize-tuareg-font-lock-operator">-></span>
<span class="htmlize-tuareg-font-lock-operator"><:</span><span class="htmlize-type">match_case</span><span class="htmlize-tuareg-font-lock-operator"><</span> <span class="htmlize-tuareg-font-lock-operator">$</span>anti<span class="htmlize-tuareg-font-lock-operator">:</span><span class="htmlize-type">mk_anti </span><span class="htmlize-tuareg-font-lock-operator">~</span><span class="htmlize-variable-name">c</span><span class="htmlize-tuareg-font-lock-operator">:</span><span class="htmlize-string">"match_case"</span> n s<span class="htmlize-tuareg-font-lock-operator">$</span> <span class="htmlize-tuareg-font-lock-operator">>></span>
<span class="htmlize-tuareg-font-lock-operator">|</span> `ANTIQUOT <span class="htmlize-tuareg-font-lock-operator">(</span><span class="htmlize-string">""</span><span class="htmlize-tuareg-font-lock-operator">|</span><span class="htmlize-string">"anti"</span> <span class="htmlize-keyword">as</span> n<span class="htmlize-tuareg-font-lock-operator">)</span> s <span class="htmlize-tuareg-font-lock-operator">-></span>
<span class="htmlize-tuareg-font-lock-operator"><:</span><span class="htmlize-type">match_case</span><span class="htmlize-tuareg-font-lock-operator"><</span> <span class="htmlize-tuareg-font-lock-operator">$</span>anti<span class="htmlize-tuareg-font-lock-operator">:</span><span class="htmlize-type">mk_anti </span><span class="htmlize-tuareg-font-lock-operator">~</span><span class="htmlize-variable-name">c</span><span class="htmlize-tuareg-font-lock-operator">:</span><span class="htmlize-string">"match_case"</span> n s<span class="htmlize-tuareg-font-lock-operator">$</span> <span class="htmlize-tuareg-font-lock-operator">>></span>
</pre>We're interested in the second case for the moment: here's the antiquotation with no tag used in <code>of_string</code>. So the list of cases is returned by <code>match_case0</code> (as an <code>McAnt</code> with <code>match_case</code> as its tag) and more cases can be parsed following it.<br />
</p><p>(Now we can see a justification for a puzzling design decision in the AST: instead of collecting match cases in a list, it collects them with <code>McOr</code> nodes. Many arrangements of <code>McOr</code> nodes correspond to the same list of cases. As the above possibility shows, this is useful: an antiquotation can return zero, one, or several match cases, and we don't have to worry about splicing them into the list. On the other hand, it makes consuming the AST a little more complicated.)<br />
</p><p>We can go one step further: if we use the <code>list</code> antiquotation, the first case in <code>match_case0</code> returns an antiquotation with tag <code>listmatch_case</code>, and we get the following expansion (<a href="http://camlcvs.inria.fr/cgi-bin/cvsweb/~checkout~/ocaml/camlp4/Camlp4Parsers/Camlp4QuotationCommon.ml?content-type=text%2Fplain">Camlp4QuotationCommon.ml</a> line 117):<br />
<pre> <span class="htmlize-tuareg-font-lock-operator">|</span> <span class="htmlize-string">"listmatch_case"</span> <span class="htmlize-tuareg-font-lock-operator">-></span> <span class="htmlize-tuareg-font-lock-operator"><:</span><span class="htmlize-type">expr</span><span class="htmlize-tuareg-font-lock-operator"><</span> <span class="htmlize-type">Ast</span>.mcOr_of_list <span class="htmlize-tuareg-font-lock-operator">$</span>e<span class="htmlize-tuareg-font-lock-operator">$</span> <span class="htmlize-tuareg-font-lock-operator">>></span>
</pre>So our final <code>of_string</code> becomes: <pre><span class="htmlize-tuareg-font-lock-governing">let</span> <span class="htmlize-function-name">of_string</span><span class="htmlize-variable-name"> </span><span class="htmlize-tuareg-font-lock-operator">=</span> <span class="htmlize-keyword">function</span>
<span class="htmlize-tuareg-font-lock-operator">$</span>list<span class="htmlize-tuareg-font-lock-operator">:</span>
<span class="htmlize-type">List</span>.map
<span class="htmlize-tuareg-font-lock-operator">(</span><span class="htmlize-keyword">fun</span> <span class="htmlize-variable-name">c </span><span class="htmlize-tuareg-font-lock-operator">-></span> <span class="htmlize-tuareg-font-lock-operator"><:</span><span class="htmlize-type">match_case</span><span class="htmlize-tuareg-font-lock-operator"><</span> <span class="htmlize-tuareg-font-lock-operator">$</span>`<span class="htmlize-variable-name">str</span><span class="htmlize-tuareg-font-lock-operator">:</span><span class="htmlize-type">c</span><span class="htmlize-tuareg-font-lock-operator">$</span><span class="htmlize-type"> </span><span class="htmlize-tuareg-font-lock-operator">-></span><span class="htmlize-type"> </span><span class="htmlize-tuareg-font-lock-operator">$</span><span class="htmlize-type">uid</span><span class="htmlize-tuareg-font-lock-operator">:</span>c<span class="htmlize-tuareg-font-lock-operator">$</span> <span class="htmlize-tuareg-font-lock-operator">>>)</span>
cons<span class="htmlize-tuareg-font-lock-operator">$</span>
<span class="htmlize-tuareg-font-lock-operator">|</span> _ <span class="htmlize-tuareg-font-lock-operator">-></span> invalid_arg <span class="htmlize-string">"bad string"</span>
</pre>Can we do something similar with the generation of the variant type? No, as it turns out. In the revised syntax, the arms of a variant are given inside square brackets, so we can say: <pre><span class="htmlize-tuareg-font-lock-governing">type</span> <span class="htmlize-type">t </span><span class="htmlize-tuareg-font-lock-operator">=</span> <span class="htmlize-tuareg-font-lock-operator">[</span> <span class="htmlize-tuareg-font-lock-operator">$</span>list<span class="htmlize-tuareg-font-lock-operator">:</span><span class="htmlize-type">List.map </span><span class="htmlize-tuareg-font-lock-operator">(</span><span class="htmlize-keyword">fun</span> <span class="htmlize-variable-name">c </span><span class="htmlize-tuareg-font-lock-operator">-></span> <span class="htmlize-tuareg-font-lock-operator"><:</span><span class="htmlize-type">ctyp</span><span class="htmlize-tuareg-font-lock-operator"><</span> <span class="htmlize-tuareg-font-lock-operator">$</span>uid<span class="htmlize-tuareg-font-lock-operator">:</span><span class="htmlize-type">c</span><span class="htmlize-tuareg-font-lock-operator">$</span><span class="htmlize-type"> </span><span class="htmlize-tuareg-font-lock-operator">>>)</span> cons<span class="htmlize-tuareg-font-lock-operator">$</span> <span class="htmlize-tuareg-font-lock-operator">]</span>
</pre>But in the original syntax, without at least one constructor to make clear that we're defining a variant, there's no context to interpret a list, and this is reflected in the parser, which doesn't allow a <code>list</code> antiquotation there. This kind of problem is apparently why the revised syntax was introduced.<br />
</p><p>So far I've talked only about generating OCaml code; next time I'll cover how to use Camlp4 to consume OCaml, and build a simple code analysis tool.<br />
</p>Jake Donhamhttp://www.blogger.com/profile/04768087689799941690noreply@blogger.com0