Move everything to old
authorLinux User <jim@localhost.members.linode.com>
Thu, 29 Jan 2015 20:17:01 +0000 (15:17 -0500)
committerLinux User <jim@localhost.members.linode.com>
Thu, 29 Jan 2015 20:17:01 +0000 (15:17 -0500)
112 files changed:
.gitignore
advanced_topics.mdwn [deleted file]
advanced_topics/monads_in_category_theory.mdwn [deleted file]
advanced_topics/version_4_lists.mdwn [deleted file]
applications.mdwn [deleted file]
assignment1.mdwn [deleted file]
assignment10.mdwn [deleted file]
assignment2.mdwn [deleted file]
assignment3.mdwn [deleted file]
assignment4.mdwn [deleted file]
assignment5.mdwn [deleted file]
assignment6.mdwn [deleted file]
assignment7.mdwn [deleted file]
assignment8.mdwn [deleted file]
assignment9.mdwn [deleted file]
assignment_3_evaluator.mdwn [deleted file]
code/calculator/calc1.ml [deleted file]
code/calculator/calc2.ml [deleted file]
code/calculator/calc3.ml [deleted file]
code/calculator/calc4.ml [deleted file]
code/calculator/calc5.ml [deleted file]
code/calculator/calc6.ml [deleted file]
code/calculator/calc7.ml [deleted file]
code/caml-lambda/lambda.ml [deleted file]
code/caml-lambda/q_lambda.ml [deleted file]
code/json2.js [deleted file]
code/lambda-test.js [deleted file]
code/lambda.js [deleted file]
code/monads.ml [deleted file]
code/parse.js [deleted file]
code/same-fringe.rkt [deleted file]
code/tokens.js [deleted file]
code/tree_monadize.ml [deleted file]
coreference-and-modality.pdf [deleted file]
coroutines_and_aborts.mdwn [deleted file]
cps.mdwn [deleted file]
cps_and_continuation_operators.mdwn [deleted file]
curry-howard.mdwn [deleted file]
damn.mdwn [deleted file]
evaluation_order.mdwn [deleted file]
family_tree_of_functional_programming_languages.mdwn [deleted file]
favicon.ico [deleted file]
from_list_zippers_to_continuations.mdwn [deleted file]
gitweb.css [deleted file]
hints/assignment_10_hint_1.mdwn [deleted file]
hints/assignment_10_hint_2.mdwn [deleted file]
hints/assignment_10_hint_3.mdwn [deleted file]
hints/assignment_10_hint_4.mdwn [deleted file]
hints/assignment_2_hint.mdwn [deleted file]
hints/assignment_4_answer_4.mdwn [deleted file]
hints/assignment_4_hint_1.mdwn [deleted file]
hints/assignment_4_hint_2.mdwn [deleted file]
hints/assignment_4_hint_3.mdwn [deleted file]
hints/assignment_4_hint_3_alternate_1.mdwn [deleted file]
hints/assignment_4_hint_3_alternate_2.mdwn [deleted file]
hints/assignment_4_hint_3_hint_1.mdwn [deleted file]
hints/assignment_5_hint_1.mdwn [deleted file]
hints/assignment_5_hint_2.mdwn [deleted file]
hints/assignment_6_commentary.mdwn [deleted file]
hints/assignment_6_hint_1.mdwn [deleted file]
hints/assignment_7_hint_1.mdwn [deleted file]
hints/assignment_7_hint_2.mdwn [deleted file]
hints/assignment_7_hint_3.mdwn [deleted file]
hints/assignment_7_hint_4.mdwn [deleted file]
hints/assignment_7_hint_5.mdwn [deleted file]
hints/assignment_7_hint_6.mdwn [deleted file]
hints/cps_hint_1.mdwn [deleted file]
hints/cps_hint_2.mdwn [deleted file]
hints/cps_hint_3.mdwn [deleted file]
hints/cps_hint_4.mdwn [deleted file]
how_to_get_the_programming_languages_running_on_your_computer.mdwn [deleted file]
implementing_trees.mdwn [deleted file]
index.iki [deleted file]
intensionality-monad.ml [deleted file]
lambda_evaluator.mdwn [deleted file]
lambda_library.mdwn [deleted file]
learning_ocaml.mdwn [deleted file]
learning_scheme.mdwn [deleted file]
list_monad_as_continuation_monad.mdwn [deleted file]
lists_and_numbers.mdwn [deleted file]
local.css [deleted file]
manipulating_trees_with_monads.mdwn [deleted file]
monad_library.mdwn [deleted file]
monad_transformers.mdwn [deleted file]
new_stuff.mdwn [deleted file]
offsite_reading.mdwn [deleted file]
older_announcements.mdwn [deleted file]
reader_monad_for_intensionality.mdwn [deleted file]
reader_monad_for_variable_binding.mdwn [deleted file]
sandbox.mdwn [deleted file]
schemersviewofmonads.ps [deleted file]
shan-quotation.pdf [deleted file]
state_monad_tutorial.mdwn [deleted file]
szabolcsi-87.pdf [deleted file]
szabolcsi-reflexive.jpg [deleted file]
translating_between_OCaml_Scheme_and_Haskell.mdwn [deleted file]
tree_and_list_zippers.mdwn [deleted file]
wadler-monads.pdf [deleted file]
week1.mdwn [deleted file]
week10.mdwn [deleted file]
week11.mdwn [deleted file]
week12.mdwn [deleted file]
week2.mdwn [deleted file]
week3.mdwn [deleted file]
week4.mdwn [deleted file]
week5.mdwn [deleted file]
week6.mdwn [deleted file]
week7.mdwn [deleted file]
week8.mdwn [deleted file]
week9.mdwn [deleted file]
y-combinator-fixed.jpg [deleted file]
y-combinator.jpg [deleted file]

index 04f5fd3..7623de5 100644 (file)
@@ -1,3 +1,4 @@
+/old
 /.ikiwiki
 /recentchanges
 .*.swp
diff --git a/advanced_topics.mdwn b/advanced_topics.mdwn
deleted file mode 100644 (file)
index 3f82880..0000000
+++ /dev/null
@@ -1,2 +0,0 @@
-##[[Version 4 lists]]##
-##[[Monads in Category Theory]]##
diff --git a/advanced_topics/monads_in_category_theory.mdwn b/advanced_topics/monads_in_category_theory.mdwn
deleted file mode 100644 (file)
index 0cdb5ab..0000000
+++ /dev/null
@@ -1,617 +0,0 @@
-Caveats
--------
-I really don't know much category theory. Just enough to put this
-together. Also, this really is "put together." I haven't yet found an
-authoritative source (that's accessible to a category theory beginner like
-myself) that discusses the correspondence between the category-theoretic and
-functional programming uses of these notions in enough detail to be sure that
-none of the pieces here is mistaken.
-In particular, it wasn't completely obvious how to map the polymorphism on the
-programming theory side into the category theory. The way I accomplished this
-may be more complex than it needs to be.
-Also I'm bothered by the fact that our `<=<` operation is only partly defined
-on our domain of natural transformations.
-There are three additional points below that I wonder whether may be too
-cavalier.
-But all considered, this does seem to
-me to be a reasonable way to put the pieces together. We very much welcome
-feedback from anyone who understands these issues better, and will make
-corrections.
-
-Thanks Wren Thornton for helpful comments on these notes (not yet incorporated).
-
-[This page](http://en.wikibooks.org/wiki/Haskell/Category_theory) was a helpful starting point.
-
-
-Monoids
--------
-A **monoid** is a structure <code>(S,&#8902;,z)</code> consisting of an associative binary operation <code>&#8902;</code> over some set `S`, which is closed under <code>&#8902;</code>, and which contains an identity element `z` for <code>&#8902;</code>. That is:
-
-
-<pre>
-       for all s1, s2, s3 in S:
-         (i) s1&#8902;s2 etc are also in S
-        (ii) (s1&#8902;s2)&#8902;s3 = s1&#8902;(s2&#8902;s3)
-       (iii) z&#8902;s1 = s1 = s1&#8902;z
-</pre>
-
-Some examples of monoids are:
-
-*      finite strings of an alphabet `A`, with <code>&#8902;</code> being concatenation and `z` being the empty string
-*      all functions <code>X&rarr;X</code> over a set `X`, with <code>&#8902;</code> being composition and `z` being the identity function over `X`
-*      the natural numbers with <code>&#8902;</code> being plus and `z` being 0 (in particular, this is a **commutative monoid**). If we use the integers, or the naturals mod n, instead of the naturals, then every element will have an inverse and so we have not merely a monoid but a **group**.
-*      if we let <code>&#8902;</code> be multiplication and `z` be 1, we get different monoids over the same sets as in the previous item.
-
-Categories
-----------
-A **category** is a generalization of a monoid. A category consists of a class of **elements**, and a class of **morphisms** between those elements. Morphisms are sometimes also called maps or arrows. They are something like functions (and as we'll see below, given a set of functions they'll determine a category). However, a single morphism only maps between a single source element and a single target element. Also, there can be multiple distinct morphisms between the same source and target, so the identity of a morphism goes beyond its "extension."
-
-When a morphism `f` in category <b>C</b> has source `C1` and target `C2`, we'll write <code>f:C1&rarr;C2</code>.
-
-To have a category, the elements and morphisms have to satisfy some constraints:
-
-<pre>
-         (i) the class of morphisms has to be closed under composition:
-             where f:C1&rarr;C2 and g:C2&rarr;C3, g &#8728; f is also a
-             morphism of the category, which maps C1&rarr;C3.
-
-        (ii) composition of morphisms has to be associative
-
-       (iii) every element X of the category has to have an identity
-             morphism 1<sub>X</sub>, which is such that for every morphism f:C1&rarr;C2:
-             1<sub>C2</sub> &#8728; f = f = f &#8728; 1<sub>C1</sub>
-</pre>
-
-These parallel the constraints for monoids. Note that there can be multiple distinct morphisms between an element `X` and itself; they need not all be identity morphisms. Indeed from (iii) it follows that each element can have only a single identity morphism.
-
-A good intuitive picture of a category is as a generalized directed graph, where the category elements are the graph's nodes, and there can be multiple directed edges between a given pair of nodes, and nodes can also have multiple directed edges to themselves. Morphisms correspond to directed paths of length &ge; 0 in the graph.
-
-
-Some examples of categories are:
-
-*      Categories whose elements are sets and whose morphisms are functions between those sets. Here the source and target of a function are its domain and range, so distinct functions sharing a domain and range (e.g., `sin` and `cos`) are distinct morphisms between the same source and target elements. The identity morphism for any element/set is just the identity function for that set.
-
-*      any monoid <code>(S,&#8902;,z)</code> generates a category with a single element `Q`; this `Q` need not have any relation to `S`. The members of `S` play the role of *morphisms* of this category, rather than its elements. All of these morphisms are understood to map `Q` to itself. The result of composing the morphism consisting of `s1` with the morphism `s2` is the morphism `s3`, where <code>s3=s1&#8902;s2</code>. The identity morphism for the (single) category element `Q` is the monoid's identity `z`.
-
-*      a **preorder** is a structure <code>(S, &le;)</code> consisting of a reflexive, transitive, binary relation on a set `S`. It need not be connected (that is, there may be members `s1`,`s2` of `S` such that neither <code>s1 &le; s2</code> nor <code>s2 &le; s1</code>). It need not be anti-symmetric (that is, there may be members `s1`,`s2` of `S` such that <code>s1 &le; s2</code> and <code>s2 &le; s1</code> but `s1` and `s2` are not identical). Some examples:
-
-       *       sentences ordered by logical implication ("p and p" implies and is implied by "p", but these sentences are not identical; so this illustrates a pre-order without anti-symmetry)
-       *       sets ordered by size (this illustrates it too)
-
-       Any pre-order <code>(S,&le;)</code> generates a category whose elements are the members of `S` and which has only a single morphism between any two elements `s1` and `s2`, iff <code>s1 &le; s2</code>.
-
-
-Functors
---------
-A **functor** is a "homomorphism", that is, a structure-preserving mapping, between categories. In particular, a functor `F` from category <b>C</b> to category <b>D</b> must:
-
-<pre>
-         (i) associate with every element C1 of <b>C</b> an element F(C1) of <b>D</b>
-
-        (ii) associate with every morphism f:C1&rarr;C2 of <b>C</b> a morphism F(f):F(C1)&rarr;F(C2) of <b>D</b>
-
-       (iii) "preserve identity", that is, for every element C1 of <b>C</b>:
-             F of C1's identity morphism in <b>C</b> must be the identity morphism of F(C1) in <b>D</b>:
-             F(1<sub>C1</sub>) = 1<sub>F(C1)</sub>.
-
-        (iv) "distribute over composition", that is for any morphisms f and g in <b>C</b>:
-             F(g &#8728; f) = F(g) &#8728; F(f)
-</pre>
-
-A functor that maps a category to itself is called an **endofunctor**. The (endo)functor that maps every element and morphism of <b>C</b> to itself is denoted `1C`.
-
-How functors compose: If `G` is a functor from category <b>C</b> to category <b>D</b>, and `K` is a functor from category <b>D</b> to category <b>E</b>, then `KG` is a functor which maps every element `C1` of <b>C</b> to element `K(G(C1))` of <b>E</b>, and maps every morphism `f` of <b>C</b> to morphism `K(G(f))` of <b>E</b>.
-
-I'll assert without proving that functor composition is associative.
-
-
-
-Natural Transformation
-----------------------
-So categories include elements and morphisms. Functors consist of mappings from the elements and morphisms of one category to those of another (or the same) category. **Natural transformations** are a third level of mappings, from one functor to another.
-
-Where `G` and `H` are functors from category <b>C</b> to category <b>D</b>, a natural transformation &eta; between `G` and `H` is a family of morphisms <code>&eta;[C1]:G(C1)&rarr;H(C1)</code> in <b>D</b> for each element `C1` of <b>C</b>. That is, <code>&eta;[C1]</code> has as source `C1`'s image under `G` in <b>D</b>, and as target `C1`'s image under `H` in <b>D</b>. The morphisms in this family must also satisfy the constraint:
-
-<pre>
-       for every morphism f:C1&rarr;C2 in <b>C</b>:
-       &eta;[C2] &#8728; G(f) = H(f) &#8728; &eta;[C1]
-</pre>
-
-That is, the morphism via `G(f)` from `G(C1)` to `G(C2)`, and then via <code>&eta;[C2]</code> to `H(C2)`, is identical to the morphism from `G(C1)` via <code>&eta;[C1]</code> to `H(C1)`, and then via `H(f)` from `H(C1)` to `H(C2)`.
-
-
-How natural transformations compose:
-
-Consider four categories <b>B</b>, <b>C</b>, <b>D</b>, and <b>E</b>. Let `F` be a functor from <b>B</b> to <b>C</b>; `G`, `H`, and `J` be functors from <b>C</b> to <b>D</b>; and `K` and `L` be functors from <b>D</b> to <b>E</b>. Let &eta; be a natural transformation from `G` to `H`; &phi; be a natural transformation from `H` to `J`; and &psi; be a natural transformation from `K` to `L`. Pictorally:
-
-<pre>
-       - <b>B</b> -+ +--- <b>C</b> --+ +---- <b>D</b> -----+ +-- <b>E</b> --
-                | |        | |            | |
-        F: ------> G: ------>     K: ------>
-                | |        | |  | &eta;       | |  | &psi;
-                | |        | |  v         | |  v
-                | |    H: ------>     L: ------>
-                | |        | |  | &phi;       | |
-                | |        | |  v         | |
-                | |    J: ------>         | |
-       -----+ +--------+ +------------+ +-------
-</pre>
-
-Then <code>(&eta; F)</code> is a natural transformation from the (composite) functor `GF` to the composite functor `HF`, such that where `B1` is an element of category <b>B</b>, <code>(&eta; F)[B1] = &eta;[F(B1)]</code>---that is, the morphism in <b>D</b> that <code>&eta;</code> assigns to the element `F(B1)` of <b>C</b>.
-
-And <code>(K &eta;)</code> is a natural transformation from the (composite) functor `KG` to the (composite) functor `KH`, such that where `C1` is an element of category <b>C</b>, <code>(K &eta;)[C1] = K(&eta;[C1])</code>---that is, the morphism in <b>E</b> that `K` assigns to the morphism <code>&eta;[C1]</code> of <b>D</b>.
-
-
-<code>(&phi; -v- &eta;)</code> is a natural transformation from `G` to `J`; this is known as a "vertical composition". For any morphism <code>f:C1&rarr;C2</code> in <b>C</b>:
-
-<pre>
-       &phi;[C2] &#8728; H(f) &#8728; &eta;[C1] = &phi;[C2] &#8728; H(f) &#8728; &eta;[C1]
-</pre>
-
-by naturalness of <code>&phi;</code>, is:
-
-<pre>
-       &phi;[C2] &#8728; H(f) &#8728; &eta;[C1] = J(f) &#8728; &phi;[C1] &#8728; &eta;[C1]
-</pre>
-
-by naturalness of <code>&eta;</code>, is:
-
-<pre>
-       &phi;[C2] &#8728; &eta;[C2] &#8728; G(f) = J(f) &#8728; &phi;[C1] &#8728; &eta;[C1]
-</pre>
-
-Hence, we can define <code>(&phi; -v- &eta;)[\_]</code> as: <code>&phi;[\_] &#8728; &eta;[\_]</code> and rely on it to satisfy the constraints for a natural transformation from `G` to `J`:
-
-<pre>
-       (&phi; -v- &eta;)[C2] &#8728; G(f) = J(f) &#8728; (&phi; -v- &eta;)[C1]
-</pre>
-
-An observation we'll rely on later: given the definitions of vertical composition and of how natural transformations compose with functors, it follows that:
-
-<pre>
-       ((&phi; -v- &eta;) F) = ((&phi; F) -v- (&eta; F))
-</pre>
-
-I'll assert without proving that vertical composition is associative and has an identity, which we'll call "the identity transformation."
-
-
-<code>(&psi; -h- &eta;)</code> is natural transformation from the (composite) functor `KG` to the (composite) functor `LH`; this is known as a "horizontal composition." It's trickier to define, but we won't be using it here. For reference:
-
-<pre>
-       (&phi; -h- &eta;)[C1]  =  L(&eta;[C1]) &#8728; &psi;[G(C1)]
-                                  =  &psi;[H(C1)] &#8728; K(&eta;[C1])
-</pre>
-
-Horizontal composition is also associative, and has the same identity as vertical composition.
-
-
-
-Monads
-------
-In earlier days, these were also called "triples."
-
-A **monad** is a structure consisting of an (endo)functor `M` from some category <b>C</b> to itself, along with some natural transformations, which we'll specify in a moment.
-
-Let `T` be a set of natural transformations <code>&phi;</code>, each being between some arbitrary endofunctor `F` on <b>C</b> and another functor which is the composite `MF'` of `M` and another arbitrary endofunctor `F'` on <b>C</b>. That is, for each element `C1` in <b>C</b>, <code>&phi;</code> assigns `C1` a morphism from element `F(C1)` to element `MF'(C1)`, satisfying the constraints detailed in the previous section. For different members of `T`, the relevant functors may differ; that is, <code>&phi;</code> is a transformation from functor `F` to `MF'`, <code>&gamma;</code> is a transformation from functor `G` to `MG'`, and none of `F`, `F'`, `G`, `G'` need be the same.
-
-One of the members of `T` will be designated the `unit` transformation for `M`, and it will be a transformation from the identity functor `1C` for <b>C</b> to `M(1C)`. So it will assign to `C1` a morphism from `C1` to `M(C1)`.
-
-We also need to designate for `M` a `join` transformation, which is a natural transformation from the (composite) functor `MM` to `M`.
-
-These two natural transformations have to satisfy some constraints ("the monad laws") which are most easily stated if we can introduce a defined notion.
-
-Let <code>&phi;</code> and <code>&gamma;</code> be members of `T`, that is they are natural transformations from `F` to `MF'` and from `G` to `MG'`, respectively. Let them be such that `F' = G`. Now <code>(M &gamma;)</code> will also be a natural transformation, formed by composing the functor `M` with the natural transformation <code>&gamma;</code>. Similarly, `(join G')` will be a natural transformation, formed by composing the natural transformation `join` with the functor `G'`; it will transform the functor `MMG'` to the functor `MG'`. Now take the vertical composition of the three natural transformations `(join G')`, <code>(M &gamma;)</code>, and <code>&phi;</code>, and abbreviate it as follows. Since composition is associative I don't specify the order of composition on the rhs.
-
-<pre>
-       &gamma; <=< &phi;  =def.  ((join G') -v- (M &gamma;) -v- &phi;)
-</pre>
-
-In other words, `<=<` is a binary operator that takes us from two members <code>&phi;</code> and <code>&gamma;</code> of `T` to a composite natural transformation. (In functional programming, at least, this is called the "Kleisli composition operator". Sometimes it's written <code>&phi; >=> &gamma;</code> where that's the same as <code>&gamma; &lt;=&lt; &phi;</code>.)
-
-<code>&phi;</code> is a transformation from `F` to `MF'`, where the latter = `MG`; <code>(M &gamma;)</code> is a transformation from `MG` to `MMG'`; and `(join G')` is a transformation from `MMG'` to `MG'`. So the composite <code>&gamma; &lt;=&lt; &phi;</code> will be a transformation from `F` to `MG'`, and so also eligible to be a member of `T`.
-
-Now we can specify the "monad laws" governing a monad as follows:
-
-<pre>  
-       (T, <=<, unit) constitute a monoid
-</pre>
-
-That's it. Well, there may be a wrinkle here. I don't know whether the definition of a monoid requires the operation to be defined for every pair in its set. In the present case, <code>&gamma; &lt;=&lt; &phi;</code> isn't fully defined on `T`, but only when <code>&phi;</code> is a transformation to some `MF'` and <code>&gamma;</code> is a transformation from `F'`. But wherever `<=<` is defined, the monoid laws must hold:
-
-<pre>
-           (i) &gamma; <=< &phi; is also in T
-
-          (ii) (&rho; <=< &gamma;) <=< &phi;  =  &rho; <=< (&gamma; <=< &phi;)
-
-       (iii.1) unit <=< &phi;  =  &phi;
-               (here &phi; has to be a natural transformation to M(1C))
-
-       (iii.2)                &rho;  =  &rho; <=< unit
-               (here &rho; has to be a natural transformation from 1C)
-</pre>
-
-If <code>&phi;</code> is a natural transformation from `F` to `M(1C)` and <code>&gamma;</code> is <code>(&phi; G')</code>, that is, a natural transformation from `FG'` to `MG'`, then we can extend (iii.1) as follows:
-
-<pre>
-       &gamma; = (&phi; G')
-         = ((unit <=< &phi;) G')
-         since unit is a natural transformation to M(1C), this is:
-         = (((join 1C) -v- (M unit) -v- &phi;) G')
-         = (((join 1C) G') -v- ((M unit) G') -v- (&phi; G'))
-         = ((join (1C G')) -v- (M (unit G')) -v- &gamma;)
-         = ((join G') -v- (M (unit G')) -v- &gamma;)
-         since (unit G') is a natural transformation to MG', this is:
-         = (unit G') <=< &gamma;
-</pre>
-
-where as we said <code>&gamma;</code> is a natural transformation from some `FG'` to `MG'`.
-
-Similarly, if <code>&rho;</code> is a natural transformation from `1C` to `MR'`, and <code>&gamma;</code> is <code>(&rho; G)</code>, that is, a natural transformation from `G` to `MR'G`, then we can extend (iii.2) as follows:
-
-<pre>
-       &gamma; = (&rho; G)
-         = ((&rho; <=< unit) G)
-         = since &rho; is a natural transformation to MR', this is:
-         = (((join R') -v- (M &rho;) -v- unit) G)
-         = (((join R') G) -v- ((M &rho;) G) -v- (unit G))
-         = ((join (R'G)) -v- (M (&rho; G)) -v- (unit G))
-         since &gamma; = (&rho; G) is a natural transformation to MR'G, this is:
-         = &gamma; <=< (unit G)
-</pre>
-
-where as we said <code>&gamma;</code> is a natural transformation from `G` to some `MR'G`.
-
-Summarizing then, the monad laws can be expressed as:
-
-<pre>
-       For all &rho;, &gamma;, &phi; in T for which &rho; <=< &gamma; and &gamma; <=< &phi; are defined:
-
-           (i) &gamma; <=< &phi; etc are also in T
-
-          (ii) (&rho; <=< &gamma;) <=< &phi;  =  &rho; <=< (&gamma; <=< &phi;)
-
-       (iii.1) (unit G') <=< &gamma;  =  &gamma;
-               whenever &gamma; is a natural transformation from some FG' to MG'
-
-       (iii.2)                     &gamma;  =  &gamma; <=< (unit G)
-               whenever &gamma; is a natural transformation from G to some MR'G
-</pre>
-
-
-
-Getting to the standard category-theory presentation of the monad laws
-----------------------------------------------------------------------
-In category theory, the monad laws are usually stated in terms of `unit` and `join` instead of `unit` and `<=<`.
-
-<!--
-       P2. every element C1 of a category <b>C</b> has an identity morphism 1<sub>C1</sub> such that for every morphism f:C1&rarr;C2 in <b>C</b>: 1<sub>C2</sub> &#8728; f = f = f &#8728; 1<sub>C1</sub>.
-       P3. functors "preserve identity", that is for every element C1 in F's source category: F(1<sub>C1</sub>) = 1<sub>F(C1)</sub>.
--->
-
-Let's remind ourselves of principles stated above:
-
-*      composition of morphisms, functors, and natural compositions is associative
-
-*      functors "distribute over composition", that is for any morphisms `f` and `g` in `F`'s source category: <code>F(g &#8728; f) = F(g) &#8728; F(f)</code>
-
-*      if <code>&eta;</code> is a natural transformation from `G` to `H`, then for every <code>f:C1&rarr;C2</code> in `G` and `H`'s source category <b>C</b>: <code>&eta;[C2] &#8728; G(f) = H(f) &#8728; &eta;[C1]</code>.
-
-*      <code>(&eta; F)[X] = &eta;[F(X)]</code> 
-
-*      <code>(K &eta;)[X] = K(&eta;[X])</code>
-
-*      <code>((&phi; -v- &eta;) F) = ((&phi; F) -v- (&eta; F))</code>
-
-Let's use the definitions of naturalness, and of composition of natural transformations, to establish two lemmas.
-
-
-Recall that `join` is a natural transformation from the (composite) functor `MM` to `M`. So for elements `C1` in <b>C</b>, `join[C1]` will be a morphism from `MM(C1)` to `M(C1)`. And for any morphism <code>f:C1&rarr;C2</code> in <b>C</b>:
-
-<pre>
-       (1) join[C2] &#8728; MM(f)  =  M(f) &#8728; join[C1]
-</pre>
-
-Next, let <code>&gamma;</code> be a transformation from `G` to `MG'`, and
- consider the composite transformation <code>((join MG') -v- (MM &gamma;))</code>.
-
-*      <code>&gamma;</code> assigns elements `C1` in <b>C</b> a morphism <code>&gamma;\*:G(C1) &rarr; MG'(C1)</code>. <code>(MM &gamma;)</code> is a transformation that instead assigns `C1` the morphism <code>MM(&gamma;\*)</code>.
-
-*      `(join MG')` is a transformation from `MM(MG')` to `M(MG')` that assigns `C1` the morphism `join[MG'(C1)]`.
-
-Composing them:
-
-<pre>
-       (2) ((join MG') -v- (MM &gamma;)) assigns to C1 the morphism join[MG'(C1)] &#8728; MM(&gamma;*).
-</pre>
-
-Next, consider the composite transformation <code>((M &gamma;) -v- (join G))</code>:
-
-<pre>
-       (3) ((M &gamma;) -v- (join G)) assigns to C1 the morphism M(&gamma;*) &#8728; join[G(C1)].
-</pre>
-
-So for every element `C1` of <b>C</b>:
-
-<pre>
-       ((join MG') -v- (MM &gamma;))[C1], by (2) is:
-       join[MG'(C1)] &#8728; MM(&gamma;*), which by (1), with f=&gamma;*:G(C1)&rarr;MG'(C1) is:
-       M(&gamma;*) &#8728; join[G(C1)], which by 3 is:
-       ((M &gamma;) -v- (join G))[C1]
-</pre>
-
-So our **(lemma 1)** is:
-
-<pre>
-       ((join MG') -v- (MM &gamma;))  =  ((M &gamma;) -v- (join G)),
-       where as we said &gamma; is a natural transformation from G to MG'.
-</pre>
-
-
-Next recall that `unit` is a natural transformation from `1C` to `M`. So for elements `C1` in <b>C</b>, `unit[C1]` will be a morphism from `C1` to `M(C1)`. And for any morphism <code>f:C1&rarr;C2</code> in <b>C</b>:
-
-<pre>
-       (4) unit[C2] &#8728; f = M(f) &#8728; unit[C1]
-</pre>
-
-Next, consider the composite transformation <code>((M &gamma;) -v- (unit G))</code>:
-
-<pre>
-       (5) ((M &gamma;) -v- (unit G)) assigns to C1 the morphism M(&gamma;*) &#8728; unit[G(C1)].
-</pre>
-
-Next, consider the composite transformation <code>((unit MG') -v- &gamma;)</code>:
-
-<pre>
-       (6) ((unit MG') -v- &gamma;) assigns to C1 the morphism unit[MG'(C1)] &#8728; &gamma;*.
-</pre>
-
-So for every element C1 of <b>C</b>:
-
-<pre>
-       ((M &gamma;) -v- (unit G))[C1], by (5) =
-       M(&gamma;*) &#8728; unit[G(C1)], which by (4), with f=&gamma;*:G(C1)&rarr;MG'(C1) is:
-       unit[MG'(C1)] &#8728; &gamma;*, which by (6) =
-       ((unit MG') -v- &gamma;)[C1]
-</pre>
-
-So our **(lemma 2)** is:
-
-<pre>
-       (((M &gamma;) -v- (unit G))  =  ((unit MG') -v- &gamma;)),
-       where as we said &gamma; is a natural transformation from G to MG'.
-</pre>
-
-
-Finally, we substitute <code>((join G') -v- (M &gamma;) -v- &phi;)</code> for <code>&gamma; &lt;=&lt; &phi;</code> in the monad laws. For simplicity, I'll omit the "-v-".
-
-<pre>
-       For all &rho;, &gamma;, &phi; in T,
-       where &phi; is a transformation from F to MF',
-       &gamma; is a transformation from G to MG',
-       &rho; is a transformation from R to MR',
-       and F'=G and G'=R:
-
-            (i) &gamma; <=< &phi; etc are also in T
-       ==>
-           (i') ((join G') (M &gamma;) &phi;) etc are also in T
-</pre>
-
-<pre>
-           (ii) (&rho; <=< &gamma;) <=< &phi;  =  &rho; <=< (&gamma; <=< &phi;)
-       ==>
-                    (&rho; <=< &gamma;) is a transformation from G to MR', so
-                        (&rho; <=< &gamma;) <=< &phi; becomes: ((join R') (M (&rho; <=< &gamma;)) &phi;)
-                                                       which is: ((join R') (M ((join R') (M &rho;) &gamma;)) &phi;)
-
-                        similarly, &rho; <=< (&gamma; <=< &phi;) is:
-                                                       ((join R') (M &rho;) ((join G') (M &gamma;) &phi;))
-
-                        substituting these into (ii), and helping ourselves to associativity on the rhs, we get:
-                ((join R') (M ((join R') (M &rho;) &gamma;)) &phi;) = ((join R') (M &rho;) (join G') (M &gamma;) &phi;)
-    
-                        which by the distributivity of functors over composition, and helping ourselves to associativity on the lhs, yields:
-                ((join R') (M join R') (MM &rho;) (M &gamma;) &phi;) = ((join R') (M &rho;) (join G') (M &gamma;) &phi;)
-  
-                        which by lemma 1, with &rho; a transformation from G' to MR', yields:
-                ((join R') (M join R') (MM &rho;) (M &gamma;) &phi;) = ((join R') (join MR') (MM &rho;) (M &gamma;) &phi;)
-
-                        [-- Are the next two steps too cavalier? --]
-
-                        which will be true for all &rho;, &gamma;, &phi; only when:
-                ((join R') (M join R')) = ((join R') (join MR')), for any R'
-
-                        which will in turn be true when:
-       (ii') (join (M join)) = (join (join M))
-</pre>
-
-<pre>
-        (iii.1) (unit G') <=< &gamma;  =  &gamma;
-                when &gamma; is a natural transformation from some FG' to MG'
-       ==>
-                        (unit G') is a transformation from G' to MG', so:
-                        (unit G') <=< &gamma; becomes: ((join G') (M (unit G')) &gamma;)
-                                             which is: ((join G') ((M unit) G') &gamma;)
-
-                        substituting in (iii.1), we get:
-                        ((join G') ((M unit) G') &gamma;) = &gamma;
-
-                        which is:
-                        (((join (M unit)) G') &gamma;) = &gamma;
-
-                        [-- Are the next two steps too cavalier? --]
-
-                        which will be true for all &gamma; just in case:
-                        for any G', ((join (M unit)) G') = the identity transformation
-
-                        which will in turn be true just in case:
-       (iii.1') (join (M unit)) = the identity transformation
-</pre>
-
-<pre>
-        (iii.2) &gamma;  =  &gamma; <=< (unit G)
-                when &gamma; is a natural transformation from G to some MR'G
-       ==>
-                        &gamma; <=< (unit G) becomes: ((join R'G) (M &gamma;) (unit G))
-                       
-                        substituting in (iii.2), we get:
-                        &gamma; = ((join R'G) (M &gamma;) (unit G))
-               
-                        which by lemma 2, yields:
-                        &gamma; = (((join R'G) ((unit MR'G) &gamma;)
-
-                        which is:
-                        &gamma; = (((join (unit M)) R'G) &gamma;)
-
-                        [-- Are the next two steps too cavalier? --]
-
-                         which will be true for all &gamma; just in case:
-                        for any R'G, ((join (unit M)) R'G) = the identity transformation
-
-                        which will in turn be true just in case:
-       (iii.2') (join (unit M)) = the identity transformation
-</pre>
-
-
-Collecting the results, our monad laws turn out in this format to be:
-
-<pre>
-       For all &rho;, &gamma;, &phi; in T,
-       where &phi; is a transformation from F to MF',
-       &gamma; is a transformation from G to MG',
-       &rho; is a transformation from R to MR',
-       and F'=G and G'=R:
-
-           (i') ((join G') (M &gamma;) &phi;) etc also in T
-
-          (ii') (join (M join)) = (join (join M))
-
-       (iii.1') (join (M unit)) = the identity transformation
-
-       (iii.2') (join (unit M)) = the identity transformation
-</pre>
-
-In category-theory presentations, you may see `unit` referred to as <code>&eta;</code>, and `join` referred to as <code>&mu;</code>. Also, instead of the monad `(M, unit, join)`, you may sometimes see discussion of the "Kleisli triple" `(M, unit, =<<)`. Alternatively, `=<<` may be called <code>&#8902;</code>. These are interdefinable (see below).
-
-
-Getting to the functional programming presentation of the monad laws
---------------------------------------------------------------------
-In functional programming, `unit` is sometimes called `return` and the monad laws are usually stated in terms of `unit`/`return` and an operation called `bind` which is interdefinable with `<=<` or with `join`.
-
-The base category <b>C</b> will have types as elements, and monadic functions as its morphisms. The source and target of a morphism will be the types of its argument and its result. (As always, there can be multiple distinct morphisms from the same source to the same target.)
-
-A monad `M` will consist of a mapping from types `'t` to types `M('t)`, and a mapping from functions <code>f:C1&rarr;C2</code> to functions <code>M(f):M(C1)&rarr;M(C2)</code>. This is also known as <code>lift<sub>M</sub> f</code> for `M`, and is pronounced "function f lifted into the monad M." For example, where `M` is the List monad, `M` maps every type `'t` into the type `'t list`, and maps every function <code>f:x&rarr;y</code> into the function that maps `[x1,x2...]` to `[y1,y2,...]`.
-
-
-In functional programming, instead of working with natural transformations we work with "monadic values" and polymorphic functions "into the monad."
-
-A "monadic value" is any member of a type `M('t)`, for any type `'t`. For example, any `int list` is a monadic value for the List monad. We can think of these monadic values as the result of applying some function `phi`, whose type is `F('t) -> M(F'('t))`. `'t` here is any collection of free type variables, and `F('t)` and `F'('t)` are types parameterized on `'t`. An example, with `M` being the List monad, `'t` being `('t1,'t2)`, `F('t1,'t2)` being `char * 't1 * 't2`, and `F'('t1,'t2)` being `int * 't1 * 't2`:
-
-<pre>
-       let phi = fun ((_:char), x, y) -> [(1,x,y),(2,x,y)]
-</pre>
-
-[-- I intentionally chose this polymorphic function because simpler ways of mapping the polymorphic monad operations from functional programming onto the category theory notions can't accommodate it. We have all the F, MF' (unit G') and so on in order to be able to be handle even phis like this. --]
-
-
-Now where `gamma` is another function of type <code>F'('t) -> M(G'('t))</code>, we define:
-
-<pre>
-       gamma =<< phi a  =def. ((join G') -v- (M gamma)) (phi a)
-                        = ((join G') -v- (M gamma) -v- phi) a
-                                        = (gamma <=< phi) a
-</pre>
-
-Hence:
-
-<pre>
-       gamma <=< phi = (fun a -> gamma =<< phi a)
-</pre>
-
-`gamma =<< phi a` is called the operation of "binding" the function gamma to the monadic value `phi a`, and is usually written as `phi a >>= gamma`.
-
-With these definitions, our monadic laws become:
-
-
-<pre>
-       Where phi is a polymorphic function of type F('t) -> M(F'('t))
-       gamma is a polymorphic function of type G('t) -> M(G'('t))
-       rho is a polymorphic function of type R('t) -> M(R'('t))
-       and F' = G and G' = R, 
-       and a ranges over values of type F('t),
-       and b ranges over values of type G('t),
-       and c ranges over values of type G'('t):
-
-             (i) &gamma; <=< &phi; is defined,
-                         and is a natural transformation from F to MG'
-       ==>
-               (i'') fun a -> gamma =<< phi a is defined,
-                         and is a function from type F('t) -> M(G'('t))
-</pre>
-
-<pre>
-            (ii) (&rho; <=< &gamma;) <=< &phi;  =  &rho; <=< (&gamma; <=< &phi;)
-       ==>
-                         (fun a -> (rho <=< gamma) =<< phi a)  =  (fun a -> rho =<< (gamma <=< phi) a)
-                         (fun a -> (fun b -> rho =<< gamma b) =<< phi a)  =
-                                                     (fun a -> rho =<< (gamma =<< phi a))
-
-          (ii'') (fun b -> rho =<< gamma b) =<< phi a  =  rho =<< (gamma =<< phi a)
-</pre>
-
-<pre>
-         (iii.1) (unit G') <=< &gamma;  =  &gamma;
-                 whenever &gamma; is a natural transformation from some FG' to MG'
-       ==>
-                         (unit G') <=< gamma  =  gamma
-                         whenever gamma is a function of type F(G'('t)) -> M(G'('t))
-
-                         (fun b -> (unit G') =<< gamma b)  =  gamma
-
-                         (unit G') =<< gamma b  =  gamma b
-
-                         Let return be a polymorphic function mapping arguments of any
-                         type 't to M('t). In particular, it maps arguments c of type
-                         G'('t) to the monadic value (unit G') c, of type M(G'('t)).
-
-       (iii.1'') return =<< gamma b  =  gamma b
-</pre>
-
-<pre>
-         (iii.2) &gamma;  =  &gamma; <=< (unit G)
-                 whenever &gamma; is a natural transformation from G to some MR'G
-       ==>
-                         gamma  =  gamma <=< (unit G)
-                         whenever gamma is a function of type G('t) -> M(R'(G('t)))
-
-                         gamma  =  (fun b -> gamma =<< (unit G) b)
-
-                         As above, return will map arguments b of type G('t) to the
-                         monadic value (unit G) b, of type M(G('t)).
-
-                         gamma  =  (fun b -> gamma =<< return b)
-
-       (iii.2'') gamma b  =  gamma =<< return b
-</pre>
-
-Summarizing (ii''), (iii.1''), (iii.2''), these are the monadic laws as usually stated in the functional programming literature:
-
-*      `(fun b -> rho =<< gamma b) =<< phi a  =  rho =<< (gamma =<< phi a)`
-
-       Usually written reversed, and with a monadic variable `u` standing in
-       for `phi a`:
-
-       `u >>= (fun b -> gamma b >>= rho)  =  (u >>= gamma) >>= rho`
-
-*      `return =<< gamma b  =  gamma b`
-
-       Usually written reversed, and with `u` standing in for `gamma b`:
-
-       `u >>= return  =  u`
-
-*      `gamma b  =  gamma =<< return b`
-
-       Usually written reversed:
-
-       `return b >>= gamma  =  gamma b`
-
diff --git a/advanced_topics/version_4_lists.mdwn b/advanced_topics/version_4_lists.mdwn
deleted file mode 100644 (file)
index 2016f15..0000000
+++ /dev/null
@@ -1,66 +0,0 @@
-#Version 4 lists: Efficiently extracting tails#
-
-Version 3 lists and Church numerals are lovely, because they have their recursive capacity built into their very bones. However, one disadvantage
-to them is that it's relatively inefficient to extract a list's tail, or get a
-number's predecessor. To get the tail of the list `[a;b;c;d;e]`, one will
-basically be performing some operation that builds up the tail afresh: at
-different stages, one will have built up `[e]`, then `[d;e]`, then `[c;d;e]`, and
-finally `[b;c;d;e]`. With short lists, this is no problem, but with longer lists
-it takes longer and longer. And it may waste more of your computer's memory
-than you'd like. Similarly for obtaining a number's predecessor.
-
-The v1 lists and numbers on the other hand, had the tail and the predecessor
-right there as an element, easy for the taking. The problem was just that the
-v1 lists and numbers didn't have recursive capacity built into them, in the
-way the v3 implementations do.
-
-A clever approach would marry these two strategies.
-
-Version 3 makes the list `[a;b;c;d;e]` look like this:
-
-       \f z. f a (f b (f c (f d (f e z))))
-
-or in other words:
-
-       \f z. f a <the result of folding f and z over the tail>
-
-Instead we could make it look like this:
-
-       \f z. f a <the tail itself> <the result of folding f and z over the tail>
-
-That is, now `f` is a function expecting *three* arguments: the head of the
-current list, the tail of the current list, and the result of continuing to
-fold `f` over the tail, with a given base value `z`.
-
-Call this a **version 4** list. The empty list can be the same as in v3:
-
-<pre><code>empty &equiv; \f z. z</code></pre>
-
-The list constructor would be:
-
-<pre><code>make_list &equiv; \h t. \f z. f h t (t f z)</code></pre>
-
-It differs from the version 3 `make_list` only in adding the extra argument
-`t` to the new, outer application of `f`.
-
-Similarly, `five` as a v3 or Church numeral looks like this:
-
-       \s z. s (s (s (s (s z))))
-
-or in other words:
-
-       \s z. s <the result of applying s to z (pred 5)-many times>
-
-Instead we could make it look like this:
-
-       \s z. s <pred 5> <the result of applying s to z (pred 5)-many times>
-
-That is, now `s` is a function expecting *two* arguments: the predecessor of the
-current number, and the result of continuing to apply `s` to the base value `z`
-predecessor-many times.
-
-Jim had the pleasure of "inventing" these implementations himself. However,
-unsurprisingly, he wasn't the first to do so. See for example [Oleg's report
-on P-numerals](http://okmij.org/ftp/Computation/lambda-calc.html#p-numerals).
-
-
diff --git a/applications.mdwn b/applications.mdwn
deleted file mode 100644 (file)
index aa18b9c..0000000
+++ /dev/null
@@ -1,34 +0,0 @@
-We mentioned a number of linguistic and philosophical applications of the tools that we'd be helping you learn in the seminar. (We really do mean "helping you learn," not "teaching you." You'll need to aggressively browse and experiment with the material yourself, or nothing we do in a few two-hour sessions will succeed in inducing mastery of it.)
-
-From linguistics
-----------------
-
-*       Generalized quantifiers are a special case of operating on continuations.  [[!wikipedia Richard_Montague]] analyzed all NPs, including, e.g., proper names, as sets of properties. 
- This gives names and quantificational NPs the same semantic type, which explain why we can coordinate them (*John and everyone*, *Mary or some graduate student*).  So instead of thinking of a name as refering to an individual, which then serves as the argument to a verb phrase, in the Generalized Quantifier conception, the name denotes a higher-order function that takes the verb phrase (its continuation) as an argument.  Montague only continuized
-one syntactic category (NPs), but a more systematic approach would continuize uniformly throughout the grammar.
-See [a paper by me (CB)](http://dx.doi.org/10.1023/A:1022183511876) for detailed discussion.
-
-*      Computing the meanings of expressions involving focus.  Consider the difference in meaning between *John only drinks Perrier*, with main sentence accent on *Perrier*, versus *John only DRINKs Perrier*.  Mats Rooth, in his 1995 dissertation, showed how to describe these meanings by having the focussed expression contribute a normal denotation and a focus alternative set denotation.  The focus alternative sets had to be propagated upwards through the compositional semantics.  One way to implement this idea is by means of delimited continuations, making use of operators similar to fcontrol and run proposed for a scheme-like language by Sitaram and other computer scienticsts.  See [another paper by CB](http://citeseerx.ist.psu.edu/viewdoc/download?doi=10.1.1.100.9748&rep=rep1&type=pdf).
-
-*       Generalized coordination, as proposed by Partee and Rooth in highly influential papers in the 1980s.  The idea is that the way that *John saw Mary or Bill* comes to mean *John saw Mary or John saw Bill* is by cloning the context of the direct object, feeding one of the clones *Mary*, feeding the other clone *Bill*, and disjoining the resulting propositions.  See either of the two papers mentioned in the previous two items for discussion.
-
-*       Anaphora, as in *Everyone's mother loves him* (which says that for every person x, x's mother loves x).  [A paper by CB and Chung-chieh Shan](http://dx.doi.org/10.1007/s10988-005-6580-7) discusses an implementation in terms of delimited continuations.  See also a different implementation in work of [Philippe de Groote](http://ecommons.library.cornell.edu/bitstream/1813/7577/4/salt16_degroote_1_16.pdf).
-
-*      As suggested in class, it is possible to think of the side effects of expressives such as *damn* in *John read the damn book* in terms of control operators such as call/cc in Scheme.
-At the end of the seminar we gave a demonstration of modeling [[damn]] using continuations...see the [summary](/damn) for more explanation and elaboration.  In the meantime, you can read a new paper about this idea [here](http://tinyurl.com/cbarker/barker-bernardi-shan-interaction.pdf)---comments welcome. 
-
-From philosophy
----------------
-
-*      the natural semantics for positive free logic is thought by some to have objectionable ontological commitments; Jim says that thought turns on not understanding the notion of a "union type", and conflating the folk notion of "naming" with the technical notion of semantic value. We'll discuss this in due course.
-
-*      those issues may bear on Russell's Gray's Elegy argument in "On Denoting"
-
-*      and on discussion of the difference between the meaning of "is beautiful" and "beauty," and the difference between the meaning of "that snow is white" and "the proposition that snow is white."
-
-*      the apparatus of monads, and techniques for statically representing the semantics of an imperatival language quite generally, are explicitly or implicitly invoked in dynamic semantics
-
-*      the semantics for mutation will enable us to make sense of a difference between numerical and qualitative identity---for purely mathematical objects!
-
-*      issues in that same neighborhood will help us better understand proposals like Kit Fine's that semantics is essentially coordinated, and that `R a a` and `R a b` can differ in interpretation even when `a` and `b` don't
-
diff --git a/assignment1.mdwn b/assignment1.mdwn
deleted file mode 100644 (file)
index fa02cb8..0000000
+++ /dev/null
@@ -1,152 +0,0 @@
-Reduction
----------
-
-Find "normal forms" for the following---that is, reduce them until no more reductions are possible. We'll write <code>&lambda;x</code> as `\x`.
-
-1. `(\x \y. y x) z`
-2. `(\x (x x)) z`
-3. `(\x (\x x)) z`
-4. `(\x (\z x)) z`
-5. `(\x (x (\y y))) (\z (z z))`
-6. `(\x (x x)) (\x (x x))`
-7. `(\x (x x x)) (\x (x x x))`
-
-
-Booleans
---------
-
-Recall our definitions of true and false.
-
->   **true** is defined to be `\t \f. t`  
->   **false** is defined to be `\t \f. f`
-
-In Racket, these can be defined like this:
-
-       (define true (lambda (t) (lambda (f) t)))
-       (define false (lambda (t) (lambda (f) f)))
-
-<OL start=8>
-<LI>Define a `neg` operator that negates `true` and `false`.
-
-Expected behavior: 
-
-    (((neg true) 10) 20)
-
-evaluates to 20, and 
-
-    (((neg false) 10) 20)
-
-evaluates to 10.
-
-<LI>Define an `and` operator.
-
-<LI>Define an `xor` operator. If you haven't seen this term before, here's a truth table:
-
-    true xor true = false
-    true xor false = true
-    false xor true = true
-    false xor false = false
-
-
-<LI>Inspired by our definition of boolean values, propose a data structure
-capable of representing one of the two values `black` or `white`. 
-If we have
-one of those values, call it a "black-or-white value", we should be able to
-write:
-
-       the-value if-black if-white
-
-(where `if-black` and `if-white` are anything), and get back one of `if-black` or
-`if-white`, depending on which of the black-or-white values we started with. Give
-a definition for each of `black` and `white`. (Do it in both lambda calculus
-and also in Racket.)
-
-<LI>Now propose a data structure capable of representing one of the three values
-`red` `green` or `blue`, based on the same model. (Do it in both lambda
-calculus and also in Racket.)
-</OL>
-
-
-
-Pairs
------
-
-Recall our definitions of ordered pairs.
-
->   the pair **(**x**,**y**)** is defined to be `\f. f x y`
-
-To extract the first element of a pair p, you write:
-
-       p (\fst \snd. fst)
-
-Here are some definitions in Racket:
-
-       (define make-pair (lambda (fst) (lambda (snd) (lambda (f) ((f fst) snd)))))
-       (define get-first (lambda (fst) (lambda (snd) fst)))
-       (define get-second (lambda (fst) (lambda (snd) snd)))
-
-Now we can write:
-
-       (define p ((make-pair 10) 20))
-       (p get-first)   ; will evaluate to 10
-       (p get-second)  ; will evaluate to 20
-
-If you're puzzled by having the pair to the left and the function that
-operates on it come second, think about why it's being done this way: the pair
-is a package that takes a function for operating on its elements *as an
-argument*, and returns *the result of* operating on its elements with that
-function. In other words, the pair is a higher-order function. (Consider the similarities between this definition of a pair and a generalized quantifier.)
-
-If you like, you can disguise what's going on like this:
-
-       (define lifted-get-first (lambda (p) (p get-first)))
-       (define lifted-get-second (lambda (p) (p get-second)))
-
-Now you can write:
-
-       (lifted-get-first p)
-
-instead of:
-
-       (p get-first)
-
-However, the latter is still what's going on under the hood. (Remark: `(lifted-f ((make-pair 10) 20))` stands to `(((make-pair 10) 20) f)` as `(((make-pair 10) 20) f)` stands to `((f 10) 20)`.)
-
-
-<OL start=13>
-<LI>Define a `swap` function that reverses the elements of a pair. Expected behavior:
-
-       (define p ((make-pair 10) 20))
-       ((p swap) get-first) ; evaluates to 20
-       ((p swap) get-second) ; evaluates to 10
-
-Write out the definition of `swap` in Racket.
-
-
-<LI>Define a `dup` function that duplicates its argument to form a pair
-whose elements are the same.
-Expected behavior:
-
-       ((dup 10) get-first) ; evaluates to 10
-       ((dup 10) get-second) ; evaluates to 10
-
-<LI>Define a `sixteen` function that makes
-sixteen copies of its argument (and stores them in a data structure of
-your choice).
-
-<LI>Inspired by our definition of ordered pairs, propose a data structure capable of representing ordered triples. That is,
-
-       (((make-triple M) N) P)
-
-should return an object that behaves in a reasonable way to serve as a triple. In addition to defining the `make-triple` function, you have to show how to extract elements of your triple. Write a `get-first-of-triple` function, that does for triples what `get-first` does for pairs. Also write `get-second-of-triple` and `get-third-of-triple` functions.
-
-<LI>Write a function `second-plus-third` that when given to your triple, returns the result of adding the second and third members of the triple.
-
-You can help yourself to the following definition:
-
-       (define add (lambda (x) (lambda (y) (+ x y))))
-
-<!-- Write a function that reverses the order of the elements in a list. [Only attempt this problem if you're feeling frisky, it's super hard unless you have lots of experience programming.]  -->
-
-</OL>
-
diff --git a/assignment10.mdwn b/assignment10.mdwn
deleted file mode 100644 (file)
index ba4df37..0000000
+++ /dev/null
@@ -1,179 +0,0 @@
-***Non-required but strongly suggested work***: Here are some
-additional homework problems that will consolidate your understanding
-of what we've covered in the last weeks of the seminar. Those who are
-taking the class for credit: since we're so late to post these, and
-they add up to a substantial chunk of thinking, we won't officially
-require you to do them, since we don't want to get into a bureaucratic
-bind if you've planned your next month in a way that would not permit
-you to get the work done.  But ***we strongly encourage*** you to work on
-the problem set: solving these problems will produce a qualitatively
-deeper understanding of continuations.  If you plan to do some or all
-of these problems, and would like us to take them into account in our
-evaluation of your work for the course, please let us know when to
-expect to see them.  (Up to the start of next term, which begins on 24
-January 2011, would be viable.)
-
-Of course, if you need help or want us to review your efforts, we'll be glad to discuss with you at any later point as well.
-
-
-1.     This problem is taken from _The Craft of Functional Programming_ by Simon Thompson, Addison-Wesley 1999 <http://www.cs.kent.ac.uk/people/staff/sjt/>:
-
-       >       Given an arbitrary tree, transform it to a
-       >       tree of integers in which the original elements are replaced by
-       >       natural numbers, starting from 0.  The same element has to be
-       >       replaced by the same number at every occurrence, and when we meet
-       >       an as-yet-unvisited element we have to find a "new" number to match
-       >       it with.
-
-
-       As Ken Shan points out, this is an instance of the algorithm
-       for converting name/year citations (like 'see Montague 1970')
-       to numerals corresponding to their position in the
-       bibliography ('see [24]').  Except that bibliographic numerals
-       don't start with zero.
-
-       Give some thought to efficiency: there are straightforward
-       solutions that involve traversing the tree once (in order to,
-       say, construct a suitable mapping from leafs to ints), then
-       traversing it again to do the conversion.  Can you find a
-       solution that traverses the tree exactly once, replacing each
-       leaf as soon as you see it?
-
-       You can assume that the tree is binary, leaf-labeled (no
-       labels on the internal nodes), and that the leafs are, say,
-       chars.
-
-       Here is [a hint](/hints/assignment_10_hint_1).
-
-       Consider a variation in which you must replace each leaf with
-       its number of occurrences in the tree.  Is there any way to do
-       that with a single traversal? (Here is [a hint](/hints/assignment_10_hint_2).)
-
-
-
-2.     Armed with your solution to problem 1, try this: you have as input a leaf-labeled, binary tree whose labels are strings. You also have as input an interpretation function from strings to meanings. Let the meanings of your strings be primitive elements, for instance:
-
-               type meaning = John | Bill | Sally | Zachariah | Swam | Likes | ...
-
-       If you want to get fancy and have different strings be interpreted to meanings of different types, go ahead. But that won't be essential to this problem. What is essential is that sometimes different strings might map onto the same meaning. For instance, both `"John"` and `"Hannes"` might map to `John`.
-
-       Your task is to return a tree with the same structure as the original tree, but with all string labels replaced with a pair of a meaning and an int. The meaning should be the meaning your interpretation function assigns to the string. Two leaves that get the same meaning should get the same int as well iff the leaves originally were labelled with the same string. So if `"John"` is replaced with `(John, 1)`, then `"Hannes"` should be replaced with `(John, j)` where `j` is an `int` other than `1`. We don't care whether you ever use the same `int`s for leafs with different associated meanings.
-
-       If you solve this, congratulations! You're most of the way to implementing a hyper-evaluative semantics, of the sort Jim discussed around Week 10.
-
-3.     Our notes on [[monad transformers]] give you most of the pieces you need to implement a StateT monad transformer. The only crucial piece that's missing is a definition for StateT's `elevate` function. Here are the earlier pieces repeated, together with that missing piece:
-
-               type 'a stateT(M) =
-                 store -> ('a * store) M;;
-               
-               let unit (a : 'a) : 'a stateT(M) =
-                 fun s -> M.unit (a, s);;
-                 (* can in general be defined as `fun a -> elevate (M.unit a)` *)
-               
-               let bind (u : 'a stateT(M)) (f : 'a -> 'b stateT(M)) : 'b stateT(M) =
-                 fun s -> M.bind (u s) (fun (a, s') -> f a s');;
-               
-               let elevate (m : 'a M) : 'a stateT(M) =
-                 fun s -> M.bind w (fun a -> M.unit (a, s));;
-
-       That won't compile in OCaml because we use the `M`s in a way that's intuitive but unrecognized by OCaml. What OCaml will recognize is more complex. Don't worry; you won't need to code a general implementation of StateT.
-
-       What we do want you to do is to implement StateT(List). That is, plug in the implementations of the List monad's type, unit, and bind into the preceding definitions. That will be a monad, consisting of an inner List monad with StateT packaging around it. Choose sensible names for the type, and unit, bind, and elevate functions of your StateT(List) monad.
-
-       You may want to write some operations for your List monad, such as:
-
-               either (u : 'a list) (v : 'a list) : 'a list
-               (* appends list v to list u *)
-               
-               foreach (u : 'a list) (v : 'a list) : 'a list
-               (* returns a list of lists, each member of which consists of u followed
-                 by a single member of v; there is one for each member of v *)
-
-       and so on. These are just suggestions; you decide which List operations you'll need. For each of these, use your StateT(List)'s `elevate` function to convert them into operations in your combined, State-around-List monad.
-
-       Now, go back to the GS&V assignment from [[assignment7]]. Does the monad you've now crafted enable you to code your implementation of that semantics more elegantly? You can begin by using a composite store of the same sort we used in the hints: a pair of an assignment function `r` and some `h` that associates pegs with entities.
-
-       Are the pegs and the `h` really essential to your solution? Or could you do everything with a store consisting of a single mapping from variables to entities? (You'd still be working with a State monad, but without the pegs.) Explain why or why not.
-
-4.     The next two exercises were taken from _The Little Schemer_ Chapter 8.
-
-       Suppose `lst` is a list of Scheme symbols (`'symbols 'are 'things 'written 'like 'this`; a list of them is `'(written like this)`). And suppose that the behavior of `(remove 'sym lst)` is to remove every occurrence of `'sym` from `lst`.
-
-       Now we define a function `remove-co` which has the following behavior. It accepts as arguments a symbol, a list, and a handler `k` (I wonder why we named it that). `remove-co` calls `k` with two arguments: first, a list of all the symbols in `lst` that aren't equal to `'sym`, and second, a list of all the symbols in `lst` that are equal to `'sym` (the handler might want to, for example, see what the length of the latter list is).
-
-       Here is a partial implementation. You should fill in the blanks. If you get stuck, you can consult the walkthough in _The Little Schemer_, or talk to us.
-
-               (define remove-co
-                 (lambda (a lst k)
-                   (cond
-                     ((null? lst)
-                      (k ___  ___))
-                     ((eq? (car lst) a)
-                      (remove-co a (cdr lst) (lambda (left right) ________)))
-                     (else
-                      (remove-co a (cdr lst) (lambda (left right) ________))))))
-
-       What would be a helper function you could supply as a `k` that would report `#t` iff the original `lst` contained more instances of some symbol than non-instances?
-
-       <!--
-               (define remove-co
-                 (lambda (a lst k)
-                   (cond
-                     ((null? lst)
-                      (k '() '()))
-                     ((eq? (car lst) a)
-                      (remove-co a (cdr lst) (lambda (left right) (k left (cons (car lst) right)))))
-                     (else
-                      (remove-co a (cdr lst) (lambda (left right) (k (cons (car lst) left) right)))))))
-       -->
-
-5.     Now we define a function `insert-co` which has the following behavior. It accepts as arguments three symbols, a list, and a handler. The first symbol is inserted before (to the left of) any occurrences in the list of the second symbol, and after (to the right of) any occurrences of the third symbol. The handler is then called with three arguments: the new list (with the insertions made), the number of "to-the-left" insertions that were made, and the number of "to-the-right" insertions that were made.
-
-       Here is a partial implementation. You should fill in the blanks. If you get stuck, you can consult the walkthough in _The Little Schemer_, or talk to us.
-
-               (define insert-co
-                 (lambda (new before after lst k)
-                   (cond
-                     ((null? lst)
-                      (k ___  ___ ___))
-                     ((eq? (car lst) before)
-                      (insert-co new before after (cdr lst) (lambda (new-lst lefts rights) ________)))
-                     ((eq? (car lst) after)
-                      (insert-co new before after (cdr lst) (lambda (new-lst lefts rights) ________)))
-                     (else
-                      (insert-co new before after (cdr lst) (lambda (new-lst lefts rights) ________))))))
-
-       <!--
-               (define insert-co
-                 (lambda (new before after lst k)
-                   (cond
-                     ((null? lst)
-                      (k '() 0 0))
-                     ((eq? (car lst) before)
-                      (insert-co new before after (cdr lst) (lambda (new-lst lefts rights) (k (cons new (cons before new-lst)) (succ lefts) rights))))
-                     ((eq? (car lst) after)
-                      (insert-co new before after (cdr lst) (lambda (new-lst lefts rights) (k (cons after (cons new new-lst)) lefts (succ rights)))))
-                     (else
-                      (insert-co new before after (cdr lst) (lambda (new-lst lefts rights) (k (cons (car lst) new-lst) lefts rights)))))))
-       -->
-
-
-6.     Go back to the "abSd" problem we presented in [[From List Zippers to Continuations]]. Consider the "tc" solution which uses
-explicitly passed continuations. Try to reimplement this using reset
-and shift instead of having an explicit `k` argument. This will likely
-be challenging but rewarding. The notes on [[CPS and Continuation Operators]], especially the examples at the end, should be helpful. We
-are of course also glad to help you out.
-
-    Consider adding a special symbol `'#'` (pronounced 'prompt') to the
-    mini-language such that
-
-    `"ab#cdSef"` ~~> `"abcdcdef"`
-
-    That is, the rule for `'S'` is to copy the preceding string, but
-    only up to the closest enclosing `'#'` symbol.
-
-7.     Can you reimplement your solution to [[assignment9]] using reset and shift?
-
-These are challenging questions, don't get frustrated if you get stuck, seek help.
-
-
diff --git a/assignment2.mdwn b/assignment2.mdwn
deleted file mode 100644 (file)
index 5d75a85..0000000
+++ /dev/null
@@ -1,142 +0,0 @@
-For these assignments, you'll probably want to use our [[lambda evaluator]] to check your work. This accepts any grammatical lambda expression and reduces it to normal form, when possible.
-
-
-More Lambda Practice
---------------------
-
-Insert all the implicit `( )`s and <code>&lambda;</code>s into the following abbreviated expressions:
-
-1.     `x x (x x x) x`
-2.     `v w (\x y. v x)`
-3.     `(\x y. x) u v`
-4.     `w (\x y z. x z (y z)) u v`
-
-Mark all occurrences of `x y` in the following terms:
-
-<OL start=5>
-<LI>`(\x y. x y) x y`
-<LI>`(\x y. x y) (x y)`
-<LI> `\x y. x y (x y)`
-</OL>
-
-Reduce to beta-normal forms:
-
-<OL start=8>
-<LI>`(\x. x (\y. y x)) (v w)`
-<LI>`(\x. x (\x. y x)) (v w)`
-<LI>`(\x. x (\y. y x)) (v x)`
-<LI>`(\x. x (\y. y x)) (v y)`
-
-<LI>`(\x y. x y y) u v`
-<LI>`(\x y. y x) (u v) z w`
-<LI>`(\x y. x) (\u u)`
-<LI>`(\x y z. x z (y z)) (\u v. u)`
-</OL>
-
-Combinatory Logic
------------------
-
-Reduce the following forms, if possible:
-
-<OL start=16>
-<LI> `Kxy`
-<LI> `KKxy`
-<LI> `KKKxy`
-<LI> `SKKxy`
-<LI> `SIII`
-<LI> `SII(SII)`
-
-<LI> Give Combinatory Logic combinators that behave like our boolean functions.
-  You'll need combinators for `true`, `false`, `neg`, `and`, `or`, and `xor`.
-</OL>
-
-Using the mapping specified in the lecture notes,
-translate the following lambda terms into combinatory logic:
-
-<OL start=23>
-<LI> `\x.x`
-<LI> `\xy.x`
-<LI> `\xy.y`
-<LI> `\xy.yx`
-<LI> `\x.xx`
-<LI> `\xyz.x(yz)`
-<LI> For each translation, how many I's are there?  Give a rule for 
-   describing what each I corresponds to in the original lambda term.
-</OL>
-
-Lists and Numbers
------------------
-
-We'll assume the "Version 3" implementation of lists and numbers throughout. So:
-
-<pre><code>zero &equiv; \s z. z
-succ &equiv; \n. \s z. s (n s z)
-iszero &equiv; \n. n (\x. false) true
-add &equiv; \m \n. m succ n
-mul &equiv; \m \n. \s. m (n s)</code></pre>
-
-And:
-
-<pre><code>empty &equiv; \f z. z
-make-list &equiv; \hd tl. \f z. f hd (tl f z)
-isempty &equiv; \lst. lst (\hd sofar. false) true
-extract-head &equiv; \lst. lst (\hd sofar. hd) junk</code></pre>
-
-The `junk` in `extract-head` is what you get back if you evaluate:
-
-       extract-head empty
-
-As we said, the predecessor and the extract-tail functions are harder to define. We'll just give you one implementation of these, so that you'll be able to test and evaluate lambda-expressions using them in Scheme or OCaml.
-
-<pre><code>predecesor &equiv; (\shift n. n shift (make-pair zero junk) get-second) (\pair. pair (\fst snd. make-pair (successor fst) fst))
-
-extract-tail &equiv; (\shift lst. lst shift (make-pair empty junk) get-second) (\hd pair. pair (\fst snd. make-pair (make-list hd fst) fst))</code></pre>
-
-The `junk` is what you get back if you evaluate:
-
-       predecessor zero
-
-       extract-tail empty
-
-Alternatively, we might reasonably declare the predecessor of zero to be zero (this is a common construal of the predecessor function in discrete math), and the tail of the empty list to be the empty list.
-
-For these exercises, assume that `LIST` is the result of evaluating:
-
-       (make-list a (make-list b (make-list c (make-list d (make-list e empty)))))
-
-
-<OL start=16>
-<LI>What would be the result of evaluating (see [[hints/Assignment 2 hint]] for a hint):
-
-       LIST make-list empty
-
-<LI>Based on your answer to question 16, how might you implement the **map** function? Expected behavior:
-
-       map f LIST <~~> (make-list (f a) (make-list (f b) (make-list (f c) (make-list (f d) (make-list (f e) empty)))))
-
-<LI>Based on your answer to question 16, how might you implement the **filter** function? The expected behavior is that:
-
-       filter f LIST
-
-should evaluate to a list containing just those of `a`, `b`, `c`, `d`, and `e` such that `f` applied to them evaluates to `true`.
-
-<LI>What goes wrong when we try to apply these techniques using the version 1 or version 2 implementation of lists?
-
-<LI>Our version 3 implementation of the numbers are usually called "Church numerals". If `m` is a Church numeral, then `m s z` applies the function `s` to the result of applying `s` to ... to `z`, for a total of *m* applications of `s`, where *m* is the number that `m` represents or encodes.
-
-Given the primitive arithmetic functions above, how would you implement the less-than-or-equal function? Here is the expected behavior, where `one` abbreviates `succ zero`, and `two` abbreviates `succ (succ zero)`.
-
-       less-than-or-equal zero zero ~~> true
-       less-than-or-equal zero one ~~> true
-       less-than-or-equal zero two ~~> true
-       less-than-or-equal one zero ~~> false
-       less-than-or-equal one one ~~> true
-       less-than-or-equal one two ~~> true
-       less-than-or-equal two zero ~~> false
-       less-than-or-equal two one ~~> false
-       less-than-or-equal two two ~~> true
-
-You'll need to make use of the predecessor function, but it's not essential to understand how the implementation we gave above works. You can treat it as a black box.
-</OL>
-
diff --git a/assignment3.mdwn b/assignment3.mdwn
deleted file mode 100644 (file)
index e240b73..0000000
+++ /dev/null
@@ -1,151 +0,0 @@
-Assignment 3
-------------
-
-Erratum corrected 11PM Sun 3 Oct: the following line
-
-       let tb = (make_list t12 (make_list t3 empty)) in
-
-originally read 
-
-       let tb = (make_list t12 t3) in
-
-This has been corrected below, and in the preloaded evaluator for 
-working on assignment 3, available here: [[assignment 3 evaluator]].
-
-<hr>
-
-Once again, the lambda evaluator will make working through this
-assignment much faster and more secure.
-
-#Writing recursive functions on version 1 style lists#
-
-Recall that version 1 style lists are constructed like this (see
-[[lists and numbers]]):
-
-       ; booleans
-       let true = \x y. x in
-       let false = \x y. y in
-       let and = \l r. l (r true false) false in
-
-       let make_pair = \f s g. g f s in
-       let get_fst = true in
-       let get_snd = false in
-       let empty = make_pair true junk in
-       let isempty = \x. x get_fst in
-       let make_list = \h t. make_pair false (make_pair h t) in
-       let head = \l. isempty l err (l get_snd get_fst) in
-       let tail = \l. isempty l err (l get_snd get_snd) in
-       
-       ; a list of numbers to experiment on
-       let mylist = make_list 1 (make_list 2 (make_list 3 empty)) in
-       
-       ; church numerals
-       let iszero = \n. n (\x. false) true in
-       let succ = \n s z. s (n s z) in
-       let add = \l r. l succ r in
-       let mul = \m n s. m (n s) in
-       let pred = (\shift n. n shift (make\_pair 0 0) get\_snd) (\p. p (\x y. make\_pair (succ x) x)) in
-       let leq = \m n. iszero(n pred m) in
-       let eq = \m n. and (leq m n)(leq n m) in
-       
-       ; a fixed-point combinator for defining recursive functions
-       let Y = \f. (\h. f (h h)) (\h. f (h h)) in
-       let length = Y (\length l. isempty l 0 (succ (length (tail l)))) in
-       let fold = Y (\f l g z. isempty l z (g (head l)(f (tail l) g z))) in
-       
-       eq 2 2 yes no
-
-
-Then `length mylist` evaluates to 3.
-
-1. What does `head (tail (tail mylist))` evaluate to?
-
-2. Using the `length` function as a model, and using the predecessor
-function, write a function that computes factorials.  (Recall that n!,
-the factorial of n, is n times the factorial of n-1.)
-
-       Warning: it takes a long time for my browser to compute factorials larger than 4!
-
-3. (Easy) Write a function `equal_length` that returns true just in case
-two lists have the same length.  That is,
-
-               equal_length mylist (make_list junk (make_list junk (make_list junk empty))) ~~> true
-
-               equal_length mylist (make_list junk (make_list junk empty))) ~~> false
-
-
-4. (Still easy) Now write the same function, but don't use the length
-function.
-
-5. In assignment 2, we discovered that version 3-type lists (the ones
-that
-work like Church numerals) made it much easier to define operations
-like `map` and `filter`.  But now that we have recursion in our
-toolbox,
-reasonable map and filter functions for version 1 lists are within our
-reach.  Give definitions for `map` and a `filter` for verson 1 type
-lists.
-
-#Computing with trees#
-
-Linguists analyze natural language expressions into trees.
-
-We'll need trees in future weeks, and tree structures provide good
-opportunities for learning how to write recursive functions.
-Making use of the resources we have at the moment, we can approximate
-trees as follows: instead of words, we'll use Church numerals.
-Then a tree will be a (version 1 type) list in which each element is
-itself a tree.  For simplicity, we'll adopt the convention that
-a tree of length 1 must contain a number as its only element.
-
-Then we have the following representations:
-
-<pre>
-   (a)           (b)             (c)
-    .
-   /|\            /\              /\
-  / | \          /\ 3            1 /\
-  1 2  3        1  2               2 3
-
-[[1];[2];[3]]  [[[1];[2]];[3]]   [[1];[[2];[3]]]
-</pre>
-
-Limitations of this scheme include the following: there is no easy way
-to label a constituent with a syntactic category (S or NP or VP,
-etc.), and there is no way to represent a tree in which a mother has a
-single daughter.
-
-When processing a tree, you can test for whether the tree contains
-only a numeral (in which case the tree is leaf node) by testing for
-whether the length of the list is less than or equal to 1.  This will
-be your base case for your recursive functions that operate on these
-trees.
-
-<OL start=6>
-<LI>Write a function that sums the values at the leaves in a tree.
-
-Expected behavior:
-
-       let t1 = (make_list 1 empty) in
-       let t2 = (make_list 2 empty) in
-       let t3 = (make_list 3 empty) in
-       let t12 = (make_list t1 (make_list t2 empty)) in
-       let t23 = (make_list t2 (make_list t3 empty)) in
-       let ta = (make_list t1 t23) in
-       let tb = (make_list t12 (make_list t3 empty)) in
-       let tc = (make_list t1 (make_list t23 empty)) in
-
-       sum-leaves t1 ~~> 1
-       sum-leaves t2 ~~> 2
-       sum-leaves t3 ~~> 3
-       sum-leaves t12 ~~> 3
-       sum-leaves t23 ~~> 5
-       sum-leaves ta ~~> 6
-       sum-leaves tb ~~> 6
-       sum-leaves tc ~~> 6
-
-
-<LI>Write a function that counts the number of leaves.
-
-</OL>
-
diff --git a/assignment4.mdwn b/assignment4.mdwn
deleted file mode 100644 (file)
index 9b7ec2c..0000000
+++ /dev/null
@@ -1,143 +0,0 @@
-#Reversing a list#
-
-<OL>
-<LI>How would you define an operation to reverse a list? (Don't peek at the
-[[lambda_library]]! Try to figure it out on your own.) Choose whichever
-implementation of list you like. Even then, there are various strategies you
-can use.
-
-(See [[hints/Assignment 4 hint 1]] if you need some hints.)
-</OL>
-
-
-#Comparing lists for equality#
-
-
-<OL start=2>
-<LI>Suppose you have two lists of integers, `left` and `right`. You want to
-determine whether those lists are equal: that is, whether they have all the
-same members in the same order. (Equality for the lists we're working with is
-*extensional*, or parasitic on the equality of their members, and the list
-structure. Later in the course we'll see lists which aren't extensional in this
-way.)
-
-How would you implement such a list comparison?
-
-(See [[hints/Assignment 4 hint 2]] if you need some hints.)
-</OL>
-
-
-#Enumerating the fringe of a leaf-labeled tree#
-
-First, read this: [[Implementing trees]]
-
-<OL start=3>
-<LI>Write an implementation of leaf-labeled trees. You can do something v3-like, or use the Y combinator, as you prefer.
-
-You'll need an operation `make_leaf` that turns a label into a new leaf. You'll
-need an operation `make_node` that takes two subtrees (perhaps leaves, perhaps
-other nodes) and joins them into a new tree. You'll need an operation `isleaf`
-that tells you whether a given tree is a leaf. And an operation `extract_label`
-that tells you what value is associated with a given leaf. And an operation
-`extract_left` that tells you what the left subtree is of a tree that isn't a
-leaf. (Presumably, `extract_right` will work similarly.)
-
-<LI>The **fringe** of a leaf-labeled tree is the list of values at its leaves,
-ordered from left to right. For example, the fringe of this tree:
-
-               .
-          / \
-         .   3
-        / \
-       1   2
-
-is `[1;2;3]`. And that is also the fringe of this tree:
-
-               .
-          / \
-         1   .
-            / \
-        2   3
-
-The two trees are different, but they have the same fringe. We're going to
-return later in the term to the problem of determining when two trees have the
-same fringe. For now, one straightforward way to determine this would be:
-enumerate the fringe of the first tree. That gives you a list. Enumerate the
-fringe of the second tree. That also gives you a list. Then compare the two
-lists to see if they're equal.
-
-Write the fringe-enumeration function. It should work on the
-implementation of trees you designed in the previous step.
-
-Then combine this with the list comparison function you wrote for question 2,
-to yield a same-fringe detector. (To use your list comparison function, you'll
-have to make sure you only use Church numerals as the labels of your leaves,
-though nothing enforces this self-discipline.)
-</OL>
-
-
-
-#Mutually-recursive functions#
-
-<OL start=5>
-<LI>(Challenging.) One way to define the function `even` is to have it hand off
-part of the work to another function `odd`:
-
-       let even = \x. iszero x
-                                       ; if x == 0 then result is
-                                       true
-                                       ; else result turns on whether x's pred is odd
-                                       (odd (pred x))
-
-At the same tme, though, it's natural to define `odd` in such a way that it
-hands off part of the work to `even`:
-
-       let odd = \x. iszero x
-                                       ; if x == 0 then result is
-                                       false
-                                       ; else result turns on whether x's pred is even
-                                       (even (pred x))
-
-Such a definition of `even` and `odd` is called **mutually recursive**. If you
-trace through the evaluation of some sample numerical arguments, you can see
-that eventually we'll always reach a base step. So the recursion should be
-perfectly well-grounded:
-
-       even 3
-       ~~> iszero 3 true (odd (pred 3))
-       ~~> odd 2
-       ~~> iszero 2 false (even (pred 2))
-       ~~> even 1
-       ~~> iszero 1 true (odd (pred 1))
-       ~~> odd 0
-       ~~> iszero 0 false (even (pred 0))
-       ~~> false
-
-But we don't yet know how to implement this kind of recursion in the lambda
-calculus.
-
-The fixed point operators we've been working with so far worked like this:
-
-       let X = Y T in
-       X <~~> T X
-
-Suppose we had a pair of fixed point operators, `Y1` and `Y2`, that operated on
-a *pair* of functions `T1` and `T2`, as follows:
-
-       let X1 = Y1 T1 T2 in
-       let X2 = Y2 T1 T2 in
-       X1 <~~> T1 X1 X2 and
-       X2 <~~> T2 X1 X2
-
-If we gave you such a `Y1` and `Y2`, how would you implement the above
-definitions of `even` and `odd`?
-
-                                       
-<LI>(More challenging.) Using our derivation of Y from the [Week3
-notes](/week3/#index4h2) as a model, construct a pair `Y1` and `Y2` that behave
-in the way described.
-
-(See [[hints/Assignment 4 hint 3]] if you need some hints.)
-
-</OL>
-
diff --git a/assignment5.mdwn b/assignment5.mdwn
deleted file mode 100644 (file)
index f402ec6..0000000
+++ /dev/null
@@ -1,252 +0,0 @@
-Assignment 5
-
-Types and OCaml
----------------
-
-0.     Recall that the S combinator is given by \x y z. x z (y z).
-       Give two different typings for this function in OCaml.
-       To get you started, here's one typing for K:
-
-               # let k (y:'a) (n:'b) = y;;
-               val k : 'a -> 'b -> 'a = [fun]
-               # k 1 true;;
-               - : int = 1
-
-
-1.     Which of the following expressions is well-typed in OCaml? For those that
-       are, give the type of the expression as a whole. For those that are not, why
-       not?
-
-               let rec f x = f x;;
-
-               let rec f x = f f;;
-
-               let rec f x = f x in f f;;
-
-               let rec f x = f x in f ();;
-
-               let rec f () = f f;;
-
-               let rec f () = f ();;
-
-               let rec f () = f () in f f;;
-
-               let rec f () = f () in f ();;
-
-2.     Throughout this problem, assume that we have
-
-               let rec blackhole x = blackhole x;;
-
-       All of the following are well-typed.
-       Which ones terminate?  What are the generalizations?
-
-               blackhole;;
-
-               blackhole ();;
-
-               fun () -> blackhole ();;
-
-               (fun () -> blackhole ()) ();;
-
-               if true then blackhole else blackhole;;
-
-               if false then blackhole else blackhole;;
-
-               if true then blackhole else blackhole ();;
-
-               if false then blackhole else blackhole ();;
-
-               if true then blackhole () else blackhole;;
-
-               if false then blackhole () else blackhole;;
-
-               if true then blackhole () else blackhole ();;
-
-               if false then blackhole () else blackhole ();;
-
-               let _ = blackhole in 2;;
-
-               let _ = blackhole () in 2;;
-
-3.     This problem is to begin thinking about controlling order of evaluation.
-The following expression is an attempt to make explicit the
-behavior of `if`-`then`-`else` explored in the previous question.
-The idea is to define an `if`-`then`-`else` expression using
-other expression types.  So assume that "yes" is any OCaml expression,
-and "no" is any other OCaml expression (of the same type as "yes"!),
-and that "bool" is any boolean.  Then we can try the following:
-"if bool then yes else no" should be equivalent to
-
-               let b = bool in
-               let y = yes in
-               let n = no in
-               match b with true -> y | false -> n
-
-       This almost works.  For instance,
-
-               if true then 1 else 2;;
-
-       evaluates to 1, and
-
-               let b = true in let y = 1 in let n = 2 in
-               match b with true -> y | false -> n;;
-
-       also evaluates to 1.  Likewise,
-
-               if false then 1 else 2;;
-
-       and
-
-               let b = false in let y = 1 in let n = 2 in
-               match b with true -> y | false -> n;;
-
-       both evaluate to 2.
-
-       However,
-
-               let rec blackhole x = blackhole x in
-               if true then blackhole else blackhole ();;
-
-       terminates, but
-
-               let rec blackhole x = blackhole x in
-               let b = true in
-               let y = blackhole in
-               let n = blackhole () in
-               match b with true -> y | false -> n;;
-
-       does not terminate.  Incidentally, `match bool with true -> yes |
-       false -> no;;` works as desired, but your assignment is to solve it
-       without using the magical evaluation order properties of either `if`
-       or of `match`.  That is, you must keep the `let` statements, though
-       you're allowed to adjust what `b`, `y`, and `n` get assigned to.
-
-       [[hints/assignment 5 hint 1]]
-
-Booleans, Church numerals, and v3 lists in OCaml
-------------------------------------------------
-
-(These questions adapted from web materials by Umut Acar. See
-<http://www.mpi-sws.org/~umut/>.)
-
-Let's think about the encodings of booleans, numerals and lists in System F,
-and get data-structures with the same form working in OCaml. (Of course, OCaml
-has *native* versions of these datas-structures: its `true`, `1`, and `[1;2;3]`.
-But the point of our exercise requires that we ignore those.)
-
-Recall from class System F, or the polymorphic λ-calculus.
-
-       types τ ::= c | 'a | τ1 → τ2 | ∀'a. τ
-       expressions e ::= x | λx:τ. e | e1 e2 | Λ'a. e | e [τ]
-
-The boolean type, and its two values, may be encoded as follows:
-
-       bool := ∀'a. 'a → 'a → 'a
-       true := Λ'a. λt:'a. λf :'a. t
-       false := Λ'a. λt:'a. λf :'a. f
-
-It's used like this:
-
-       b [τ] e1 e2
-
-where b is a boolean value, and τ is the shared type of e1 and e2.
-
-**Exercise**. How should we implement the following terms. Note that the result
-of applying them to the appropriate arguments should also give us a term of
-type bool.
-
-(a) the term not that takes an argument of type bool and computes its negation;
-(b) the term and that takes two arguments of type bool and computes their conjunction;
-(c) the term or that takes two arguments of type bool and computes their disjunction.
-
-
-The type nat (for "natural number") may be encoded as follows:
-
-       nat := ∀'a. 'a → ('a → 'a) → 'a
-       zero := Λ'a. λz:'a. λs:'a → 'a. z
-       succ := λn:nat. Λ'a. λz:'a. λs:'a → 'a. s (n ['a] z s)
-
-A nat n is defined by what it can do, which is to compute a function iterated n
-times. In the polymorphic encoding above, the result of that iteration can be
-any type 'a, as long as you have a base element z : 'a and a function s : 'a → 'a.
-
-**Exercise**: get booleans and Church numbers working in OCaml,
-including OCaml versions of bool, true, false, zero, iszero, succ, and pred.
-It's especially useful to do a version of pred, starting with one
-of the (untyped) versions available in the lambda library
-accessible from the main wiki page.  The point of the excercise
-is to do these things on your own, so avoid using the built-in
-OCaml booleans and integers.
-
-Consider the following list type:
-
-       type 'a list = Nil | Cons of 'a * 'a list
-
-We can encode τ lists, lists of elements of type τ as follows:
-
-       τ list := ∀'a. 'a → (τ → 'a → 'a) → 'a
-       nil τ := Λ'a. λn:'a. λc:τ → 'a → 'a. n
-       make_list τ := λh:τ. λt:τ list. Λ'a. λn:'a. λc:τ → 'a → 'a. c h (t ['a] n c)
-
-More generally, the polymorphic list type is:
-
-       list := ∀'b. ∀'a. 'a → ('b → 'a → 'a) → 'a
-
-As with nats, recursion is built into the datatype.
-
-We can write functions like map:
-
-       map : (σ → τ ) → σ list → τ list
-
-<!--
-               = λf :σ → τ. λl:σ list. l [τ list] nil τ (λx:σ. λy:τ list. make_list τ (f x) y
--->
-
-**Excercise** convert this function to OCaml. We've given you the type; you
-only need to give the term.
-
-Also give us the type and definition for a `head` function. Think about what
-value to give back if the argument is the empty list.  Ultimately, we might
-want to make use of our `'a option` technique, but for this assignment, just
-pick a strategy, no matter how clunky. 
-
-Be sure to test your proposals with simple lists. (You'll have to `make_list`
-the lists yourself; don't expect OCaml to magically translate between its
-native lists and the ones you buil.d)
-
-
-<!--
-Consider the following simple binary tree type:
-
-       type 'a tree = Leaf | Node of 'a tree * 'a * 'a tree
-
-**Excercise**
-Write a function `sum_leaves` that computes the sum of all the leaves in an int
-tree.
-
-Write a function `in_order` : τ tree → τ list that computes the in-order
-traversal of a binary tree. You may assume the above encoding of lists; define
-any auxiliary functions you need.
--->
-
-
-Baby monads
------------
-
-Read the material on dividing by zero/towards monads from <strike>the end of lecture
-notes for week 6</strike> the start of lecture notes for week 7, then write a function `lift'` that generalized the
-correspondence between + and `add'`: that is, `lift'` takes any two-place
-operation on integers and returns a version that takes arguments of type `int
-option` instead, returning a result of `int option`.  In other words, `lift'`
-will have type:
-
-       (int -> int -> int) -> (int option) -> (int option) -> (int option)
-
-so that `lift' (+) (Some 3) (Some 4)` will evalute to `Some 7`.
-Don't worry about why you need to put `+` inside of parentheses.
-You should make use of `bind'` in your definition of `lift'`:
-
-       let bind' (u: int option) (f: int -> (int option)) =
-               match u with None -> None | Some x -> f x;;
-
-
diff --git a/assignment6.mdwn b/assignment6.mdwn
deleted file mode 100644 (file)
index a31cbf8..0000000
+++ /dev/null
@@ -1,39 +0,0 @@
-1.  **Build a State monad.** Based on the division by zero monad,
-build a system that will evaluate arithmetic expressions.  Instead of
-returning a simple integer as a result, it will deliver the correct
-answer along with a count of the number of operations performed during
-the calculation.  That is, the desired behavior should be like this:
-
-                 # lift2 ( + ) (lift2 ( / ) (unit 20) (unit 2))
-                                  (lift2 ( * ) (unit 2) (unit 3)) 0;;
-                     - : int * int = (16, 3)
-
-    Here, `lift2` is the function that uses `bind` to prepare an ordinary
-arithmetic operator (such as addition `( + )`, division `( / )`, or
-multiplication `( * )`) to recieve objects from the counting monad as
-arguments.  The response of the interpreter says two things: that
-(20/2) + (2\*3) = 16, and that the computation took three arithmetic
-steps.  By the way, that zero at the end provides the monadic object
-with a starting point (0 relevant computations have occurred previous
-to the current computation).
-
-   Assume for the purposes of this excercise that no one ever tries to
-divide by zero (so there should be no int option types anywhere in
-your solution).
-
-     You'll need to define a computation monad type, unit, bind, and lift2.
-We encourage you to consider this hint: [[hints/Assignment 6 Hint 1]].
-
-       See our [commentary](/hints/assignment_6_commentary) on your solutions.
-
-
-2. Prove that your monad satisfies the monad laws.  First, give
-examples illustrating specific cases in which the monad laws are
-obeyed, then explain (briefly, not exhaustively) why the laws hold in
-general for your unit and bind operators.
-
-3. How would you extend your strategy if you wanted to count
-arithmetic operations, but you also wanted to be safe from division by
-zero?  This is a deep question: how should you combine two monads into
-a single system?  If you don't arrive at working code, you can still
-discuss the issues and design choices.
diff --git a/assignment7.mdwn b/assignment7.mdwn
deleted file mode 100644 (file)
index d6cb681..0000000
+++ /dev/null
@@ -1,25 +0,0 @@
-**The hints for problem 2 were being actively developed until Saturday morning. They're stable now. Remember you have a grace period until Sunday Nov. 28 to complete this homework.**
-
-1.     Make sure that your operation-counting monad from [[assignment6]] is working. Modify it so that instead of counting operations, it keeps track of the last remainder of any integer division. You can help yourself to the functions:
-
-               let div x y = x / y;;
-               let remainder x y = x mod y;;
-
-       Write a monadic operation that enables you to retrieve the last-saved remainder, at any arbitrary later point in the computation. For example, you want to be able to calculate expressions like this:
-
-               (((some_long_computation / 12) + 5) - most_recent_remainder) * 2 - same_most_recent_remainder + 1
-
-       The remainder here is retrieved later than (and in addition to) the division it's the remainder of. It's also retrieved more than once. Suppose a given remainder remains retrievable until the next division is performed.
-
-
-
-2.     For the next assignment, read the paper [Coreference and Modality](/coreference-and-modality.pdf). Your task will be to re-express the semantics they offer up to the middle of p. 16, in the terms we're now working with. You'll probably want to review [the lecture notes from this week's meeting](/week9).
-
-       Some advice:
-
-       *       You don't need to re-express the epistemic modality part of their semantics, just their treatment of extensional predicate logic. Though extra credit if you want to do the whole thing.
-
-       *       You'll want to use "implicitly represented" mutable variables, or a State monad.
-
-       *       Here are some [hints](/hints/assignment_7_hint_1).
-
diff --git a/assignment8.mdwn b/assignment8.mdwn
deleted file mode 100644 (file)
index f09556f..0000000
+++ /dev/null
@@ -1,135 +0,0 @@
-1.     Complete the definitions of `move_botleft` and `move_right_or_up` from the same-fringe solution in the [[week11]] notes. **Test your attempts** against some example trees to see if the resulting `make_fringe_enumerator` and `same_fringe` functions work as expected. Show us some of your tests.
-
-               type 'a tree = Leaf of 'a | Node of ('a tree * 'a tree)
-
-               type 'a starred_level = Root | Starring_Left of 'a starred_nonroot | Starring_Right of 'a starred_nonroot
-               and 'a starred_nonroot = { parent : 'a starred_level; sibling: 'a tree };;
-
-               type 'a zipper = { level : 'a starred_level; filler: 'a tree };;
-
-               let rec move_botleft (z : 'a zipper) : 'a zipper =
-                       (* returns z if the targetted node in z has no children *)
-                       (* else returns move_botleft (zipper which results from moving down from z to the leftmost child) *)
-                       _____
-                       (* YOU SUPPLY THE DEFINITION *)
-
-
-               let rec move_right_or_up (z : 'a zipper) : 'a zipper option =
-                       (* if it's possible to move right in z, returns Some (the result of doing so) *)
-                       (* else if it's not possible to move any further up in z, returns None *)
-                       (* else returns move_right_or_up (result of moving up in z) *)
-                       _____
-                       (* YOU SUPPLY THE DEFINITION *)
-
-
-               let new_zipper (t : 'a tree) : 'a zipper =
-                       {level = Root; filler = t}
-                       ;;
-
-       &nbsp;
-
-               let make_fringe_enumerator (t: 'a tree) =
-                       (* create a zipper targetting the botleft of t *)
-                       let zbotleft = move_botleft (new_zipper t)
-                       (* create a refcell initially pointing to zbotleft *)
-                       in let zcell = ref (Some zbotleft)
-                       (* construct the next_leaf function *)
-                       in let next_leaf () : 'a option =
-                               match !zcell with
-                               | Some z -> (
-                                       (* extract label of currently-targetted leaf *)
-                                       let Leaf current = z.filler
-                                       (* update zcell to point to next leaf, if there is one *)
-                                       in let () = zcell := match move_right_or_up z with
-                                               | None -> None
-                                               | Some z' -> Some (move_botleft z')
-                                       (* return saved label *)
-                                       in Some current
-                                   )
-                               | None -> (* we've finished enumerating the fringe *)
-                                       None
-                       (* return the next_leaf function *)
-                       in next_leaf
-                       ;;
-
-               let same_fringe (t1 : 'a tree) (t2 : 'a tree) : bool =
-                       let next1 = make_fringe_enumerator t1
-                       in let next2 = make_fringe_enumerator t2
-                       in let rec loop () : bool =
-                               match next1 (), next2 () with
-                               | Some a, Some b when a = b -> loop ()
-                               | None, None -> true
-                               | _ -> false
-                       in loop ()
-                       ;;
-
-
-2.     Here's another implementation of the same-fringe function, in Scheme. It's taken from <http://c2.com/cgi/wiki?SameFringeProblem>. It uses thunks to delay the evaluation of code that computes the tail of a list of a tree's fringe. It also involves passing "the rest of the enumeration of the fringe" as a thunk argument (`tail-thunk` below). Your assignment is to fill in the blanks in the code, **and also to supply comments to the code,** to explain what every significant piece is doing. Don't forget to supply the comments, this is an important part of the assignment.
-
-       This code uses Scheme's `cond` construct. That works like this;
-
-               (cond
-                       ((test1 argument argument) result1)
-                       ((test2 argument argument) result2)
-                       ((test3 argument argument) result3)
-                       (else result4))
-
-       is equivalent to:
-
-               (if (test1 argument argument)
-                       ; then
-                       result1
-                       ; else
-                       (if (test2 argument argument)
-                               ; then
-                               result2
-                               ; else
-                               (if (test3 argument argument)
-                                       ; then
-                                       result3
-                                       ; else
-                                       result4)))
-
-       Some other Scheme details:
-
-       *       `#t` is true and `#f` is false
-       *       `(lambda () ...)` constructs a thunk
-       *       there is no difference in meaning between `[...]` and `(...)`; we just sometimes use the square brackets for clarity
-       *       `'(1 . 2)` and `(cons 1 2)` are pairs (the same pair)
-       *       `(list)` and `'()` both evaluate to the empty list
-       *       `(null? lst)` tests whether `lst` is the empty list
-       *       non-empty lists are implemented as pairs whose second member is a list
-       *       `'()` `'(1)` `'(1 2)` `'(1 2 3)` are all lists
-       *       `(list)` `(list 1)` `(list 1 2)` `(list 1 2 3)` are the same lists as the preceding
-       *       `'(1 2 3)` and `(cons 1 '(2 3))` are both pairs and lists (the same list)
-       *       `(pair? lst)` tests whether `lst` is a pair; if `lst` is a non-empty list, it will also pass this test; if `lst` fails this test, it may be because `lst` is the empty list, or because it's not a list or pair at all
-       *       `(car lst)` extracts the first member of a pair / head of a list
-       *       `(cdr lst)` extracts the second member of a pair / tail of a list
-
-       Here is the implementation:
-
-               (define (lazy-flatten tree)
-                 (letrec ([helper (lambda (tree tail-thunk)
-                                 (cond
-                                   [(pair? tree)
-                                     (helper (car tree) (lambda () (helper _____ tail-thunk)))]
-                                   [else (cons tree tail-thunk)]))])
-                   (helper tree (lambda () _____))))
-               
-               (define (stream-equal? stream1 stream2)
-                 (cond
-                   [(and (null? stream1) (null? stream2)) _____]
-                   [(and (pair? stream1) (pair? stream2))
-                    (and (equal? (car stream1) (car stream2))
-                         _____)]
-                   [else #f]))
-               
-               (define (same-fringe? tree1 tree2)
-                 (stream-equal? (lazy-flatten tree1) (lazy-flatten tree2)))
-               
-               (define tree1 '(((1 . 2) . (3 . 4)) . (5 . 6)))
-               (define tree2 '(1 . (((2 . 3) . (4 . 5)) . 6)))
-               
-               (same-fringe? tree1 tree2)
-
-
diff --git a/assignment9.mdwn b/assignment9.mdwn
deleted file mode 100644 (file)
index 3ec13ae..0000000
+++ /dev/null
@@ -1,181 +0,0 @@
-Using continuations to solve the same-fringe problem
-----------------------------------------------------
-
-The problem
------------
-
-The problem, recall, is to take two trees and decide whether they have
-the same leaves in the same order.
-
-<pre>
- ta            tb          tc
- .             .           .
-_|__          _|__        _|__
-|  |          |  |        |  |
-1  .          .  3        1  .
-  _|__       _|__           _|__
-  |  |       |  |           |  |
-  2  3       1  2           3  2
-
-let ta = Node (Leaf 1, Node (Leaf 2, Leaf 3));;
-let tb = Node (Node (Leaf 1, Leaf 2), Leaf 3);;
-let tc = Node (Leaf 1, Node (Leaf 3, Leaf 2));;
-</pre>
-
-So `ta` and `tb` are different trees that have the same fringe, but
-`ta` and `tc` are not.
-
-We've seen two solutions to the same fringe problem so far.  
-The simplest solution is to map each tree to a list of its leaves,
-then compare the lists.  But because we will have computed the entire
-fringe before starting the comparison, if the fringes differ in an
-early position, we've wasted our time examining the rest of the trees.
-
-The second solution was to use tree zippers and mutable state to
-simulate coroutines (see [[coroutines and aborts]], and
-[[assignment8]]).  In that solution, we pulled the zipper on the first
-tree until we found the next leaf, then stored the zipper structure in
-a mutable variable while we turned our attention to the other tree.
-This solution is efficient: the zipper doesn't visit any leaves beyond
-the first mismatch.
-
-Since zippers are just continuations reified, we expect that the
-solution in terms of zippers can be reworked using continuations, and
-this is indeed the case.  Your assignment is to show how.
-
-The first step is to review your answer to [[assignment8]], and make
-sure you understand what is going on.
-
-
-Two strategies for solving the problem
---------------------------------------
-
-
-1.  Review the list-zipper/list-continuation example given in
-    class in [[from list zippers to continuations]]; then
-    figure out how to re-functionalize the zippers used in the zipper
-    solution.
-
-2.  Review how the continuation-flavored `tree_monadizer` managed to
-    map a tree to a list of its leaves, in [[manipulating trees with monads]].
-    Spend some time trying to understand exactly what it
-    does: compute the tree-to-list transformation for a tree with two
-    leaves, performing all beta reduction by hand using the
-    definitions for `continuation_bind`, `continuation_unit` and so on.
-    If you take this route, study the description of **streams** (a
-    particular kind of data structure) below.  The goal will be to
-    arrange for the continuation-flavored `tree_monadizer` to transform
-    a tree into a stream instead of into a list.  Once you've done
-    that, completing the same-fringe problem will be easy.
-
--------------------------------------
-
-Whichever method you choose, here are some goals to consider.
-
-1.  Make sure that your solution gives the right results on the trees
-given above (`ta`, `tb`, and `tc`).
-
-2.  Make sure your function works on trees that contain only a single
-leaf, as well as when the two trees have different numbers of leaves.
-
-3.  Figure out a way to prove that your solution satisfies the main
-requirement of the problem; in particular, that when the trees differ
-in an early position, your code does not waste time visiting the rest
-of the tree.  One way to do this is to add print statements to your
-functions so that every time you visit a leaf (say), a message is
-printed on the output. (In OCaml: `print_int 1` prints an `int`, `print_string "foo"` prints a `string`, `print_newline ()` prints a line break, and `print_endline "foo"` prints a string followed by a line break.) If two trees differ in the middle of their fringe, you should show that your solution prints debugging information for the first half of the fringe, but then stops.
-
-4.  What if you had some reason to believe that the trees you were
-going to compare were more likely to differ in the rightmost region?
-What would you have to change in your solution so that it worked from
-right to left?
-
-Streams
--------
-
-A stream is like a list in that it wraps a series of elements of a single type.
-It differs from a list in that the tail of the series is left uncomputed
-until needed.  We will turn the stream on and off by thunking it (see
-class notes for [[week6]] on thunks, as well as [[assignment5]]).
-
-    type 'a stream = End | Next of 'a * (unit -> 'a stream);;
-
-There is a special stream called `End` that represents a stream that
-contains no (more) elements, analogous to the empty list `[]`.
-Streams that are not empty contain a first object, paired with a
-thunked stream representing the rest of the series.  In order to get
-access to the next element in the stream, we must *force* the thunk by
-applying it to the unit.  Watch the behavior of this stream in detail.
-This stream delivers the natural numbers, in order: 1, 2, 3, ...
-
-<pre>
-# let rec make_int_stream i = Next (i, fun () -> make_int_stream (i + 1));;
-val make_int_stream : int -> int stream = [fun]
-
-# let int_stream = make_int_stream 1;;
-val int_stream : int stream = Next (1, [fun])         (* First element: 1 *)
-
-# let tail = match int_stream with Next (i, rest) -> rest;;      
-val tail : unit -> int stream = [fun]                 (* Tail: a thunk *)
-
-(* Force the thunk to compute the second element *)
-# tail ();;
-- : int stream = Next (2, [fun])                      (* Second element: 2 *)
-
-# match tail () with Next (_, rest) -> rest ();;
-- : int stream = Next (3, [fun])                      (* Third element: 3 *)
-</pre>
-
-You can think of `int_stream` as a functional object that provides
-access to an infinite sequence of integers, one at a time.  It's as if
-we had written `[1;2;...]` where `...` meant "continue for as long as
-some other process needs new integers".
-
-
-<!--
-With streams in hand, we need only rewrite our continuation tree
-monadizer so that instead of mapping trees to lists, it maps them to 
-streams.  Instead of 
-
-       # tree_monadize (fun a k -> a :: k a) t1 (fun t -> []);;
-       - : int list = [2; 3; 5; 7; 11]
-
-as above, we have 
-
-        # tree_monadize (fun i k -> Next (i, fun () -> k ())) t1 (fun _ -> End);;
-        - : int stream = Next (2, <fun>)
-
-We can see the first element in the stream, the first leaf (namely,
-2), but in order to see the next, we'll have to force a thunk.
-
-Then to complete the same-fringe function, we simply convert both
-trees into leaf-streams, then compare the streams element by element.
-The code is entirely routine, but for the sake of completeness, here it is:
-
-       let rec compare_streams stream1 stream2 =
-               match stream1, stream2 with 
-               | End, End -> true (* Done!  Fringes match. *)
-               | Next (next1, rest1), Next (next2, rest2) when next1 = next2 -> compare_streams (rest1 ()) (rest2 ())
-               | _ -> false;;
-
-       let same_fringe t1 t2 =
-         let stream1 = tree_monadize (fun i k -> Next (i, fun () -> k ())) t1 (fun _ -> End) in 
-         let stream2 = tree_monadize (fun i k -> Next (i, fun () -> k ())) t2 (fun _ -> End) in 
-         compare_streams stream1 stream2;;
-
-Notice the forcing of the thunks in the recursive call to
-`compare_streams`.  So indeed:
-
-       # same_fringe ta tb;;
-       - : bool = true
-       # same_fringe ta tc;;
-       - : bool = false
-
-Now, you might think that this implementation is a bit silly, since in
-order to convert the trees to leaf streams, our `tree_monadizer`
-function has to visit every node in the tree, so we'd have to traverse
-the entire tree at some point.  But you'd be wrong: part of what gets
-suspended in the thunking of the stream is the computation of the rest
-of the monadized tree.
-
--->
diff --git a/assignment_3_evaluator.mdwn b/assignment_3_evaluator.mdwn
deleted file mode 100644 (file)
index aba94f8..0000000
+++ /dev/null
@@ -1,135 +0,0 @@
-Here are the definitions pre-loaded for working on assignment 3:
-
-<textarea id="INPUT" style="border: 2px solid black; color: black; font-family: monospace; height: 3in; overflow: auto; padding: 0.5em; width: 100%;">
-; booleans
-let true = \x y. x in
-let false = \x y. y in
-let and = \l r. l (r true false) false in
-let or = \l r. l true r in
-;
-let make\_pair = \f s g. g f s in
-let get\_fst = true in
-let get\_snd = false in
-let empty = make\_pair true junk in
-let isempty = \x. x get\_fst in
-let make\_list = \h t. make\_pair false (make\_pair h t) in
-let head = \l. isempty l err (l get\_snd get\_fst) in
-let tail = \l. isempty l err (l get\_snd get\_snd) in
-;
-; a list of numbers to experiment on
-let mylist = make\_list 1 (make\_list 2 (make\_list 3 empty)) in
-;
-; church numerals
-let iszero = \n. n (\x. false) true in
-let succ = \n s z. s (n s z) in
-let add = \l r. l succ r in
-let mul = \m n s. m (n s) in
-let pred = (\shift n. n shift (make\_pair 0 0) get\_snd) (\p. p (\x y. make\_pair (succ x) x))  in
-let leq = \m n. iszero(n pred m) in
-let eq = \m n. and (leq m n)(leq n m) in
-;
-; a fixed-point combinator for defining recursive functions
-let Y = \f. (\h. f (h h)) (\h. f (h h)) in
-let length = Y (\length l. isempty l 0 (succ (length (tail l)))) in
-let fold = Y (\f l g z. isempty l z (g (head l)(f (tail l) g z))) in
-;
-; synonyms
-let makePair = make\_pair in
-let fst = get\_fst in
-let snd = get\_snd in
-let nil = empty in
-let isNil = isempty in
-let makeList = make\_list in
-let isZero = iszero in
-let mult = mul in
-;
-let t1 = (make\_list 1 empty) in
-let t2 = (make\_list 2 empty) in
-let t3 = (make\_list 3 empty) in
-let t12 = (make\_list t1 (make\_list t2 empty)) in
-let t23 = (make\_list t2 (make\_list t3 empty)) in
-let ta = (make\_list t1 t23) in
-let tb = (make\_list t12 (make\_list t3 empty)) in
-let tc = (make\_list t1 (make\_list t23 empty)) in
-;
-;sum-leaves t1 ; ~~> 1
-;sum-leaves t2 ; ~~> 2
-;sum-leaves t3 ; ~~> 3
-;sum-leaves t12 ; ~~> 3
-;sum-leaves t23 ; ~~> 5
-;sum-leaves ta ; ~~> 6
-;sum-leaves tb ; ~~> 6
-;sum-leaves tc ; ~~> 6 
-;
-; updated: added add, and fold for v1 lists; and defn of tb fixed
-; hint: 
-fold mylist add 0
-</textarea>
-
-<input id="PARSE" value="Normalize" type="button">
-<input id="ETA" type="checkbox">do eta-reductions too
-<noscript><p>You may not see it because you have JavaScript turned off. Uffff!</p></noscript>
-<script src="/code/lambda.js"></script>
-<script src="/code/tokens.js"></script>
-<script src="/code/parse.js"></script>
-<script src="/code/json2.js"></script>
-<pre id="OUTPUT">
-</pre>
-<script>
-/*jslint evil: true */
-
-/*members create, error, message, name, prototype, stringify, toSource,
-    toString, write
-*/
-
-/*global JSON, make_parse, parse, source, tree */
-
-// Make a new object that inherits members from an existing object.
-
-if (typeof Object.create !== 'function') {
-    Object.create = function (o) {
-        function F() {}
-        F.prototype = o;
-        return new F();
-    };
-}
-
-// Transform a token object into an exception object and throw it.
-
-Object.prototype.error = function (message, t) {
-    t = t || this;
-    t.name = "SyntaxError";
-    t.message = message;
-    throw t;
-};
-
-
-(function () {
-    var parse = make_parse();
-
-    function go(source) {
-        var string, tree, expr, eta;
-        try {
-            tree = parse(source);
- //           string = JSON.stringify(tree, ['key', 'name', 'message', 'value', 'arity', 'first', 'second', 'third', 'fourth'], 4);
-                       expr = tree.handler();
-            // string = JSON.stringify(expr, ['key', 'name', 'message', 'value', 'arity', 'first', 'second', 'tag', 'variable', 'left', 'right', 'bound', 'body' ], 4);
-//                     string = expr.to_string() + "\n\n~~>\n\n";
-                       string = '';
-                       eta = document.getElementById('ETA').checked;
-                       string = string + reduce(expr, eta, false).to_string();
-        } catch (e) {
-            string = JSON.stringify(e, ['name', 'message', 'from', 'to', 'key',
-                    'value', 'arity', 'first', 'second', 'third', 'fourth'], 4);
-        }
-        document.getElementById('OUTPUT').innerHTML = string
-            .replace(/&/g, '&amp;')
-            .replace(/[<]/g, '&lt;');
-    }
-
-    document.getElementById('PARSE').onclick = function (e) {
-        go(document.getElementById('INPUT').value);
-    };
-}());
-
-</script>
diff --git a/code/calculator/calc1.ml b/code/calculator/calc1.ml
deleted file mode 100644 (file)
index b0c5cea..0000000
+++ /dev/null
@@ -1,58 +0,0 @@
-(* calc1.ml: original calculator from Week7, enhanced with Booleans and Immutable Pairs *)
-
-    type term =
-      Intconstant of int
-    | Multiplication of (term * term)
-    | Addition of (term * term)
-    | Variable of char
-    | Let of (char * term * term)
-    | Iszero of term
-    | If of (term * term * term)
-    | Makepair of (term * term)
-    | First of term
-    ;;
-
-    type expressed_value = Int of int | Bool of bool | Pair of expressed_value * expressed_value;;
-    type bound_value = expressed_value;;
-    type assignment = (char * bound_value) list;;
-
-    let rec eval (t : term) (g : assignment) = match t with
-      Intconstant x -> Int x
-    | Multiplication (t1, t2) ->
-        (* we don't handle cases where the subterms don't evaluate to Ints *)
-        let Int i1 = eval t1 g
-        in let Int i2 = eval t2 g
-        (* Multiplication (t1, t2) should evaluate to an Int *)
-        in Int (i1 * i2)
-    | Addition (t1, t2) ->
-        let Int i1 = eval t1 g
-        in let Int i2 = eval t2 g
-        in Int (i1 + i2)
-    | Variable (var) ->
-        (* we don't handle cases where g doesn't bind var to any value *)
-        List.assoc var g
-    | Let (var_to_bind, t2, t3) ->
-        (* evaluate t3 under a new assignment where var_to_bind has been bound to
-           the result of evaluating t2 under the current assignment *)
-        let value2 = eval t2 g
-        in let g' = (var_to_bind, value2) :: g
-        in eval t3 g'
-    | Iszero (t1) ->
-        (* we don't handle cases where t1 doesn't evaluate to an Int *)
-        let Int i1 = eval t1 g
-        (* Iszero t1 should evaluate to a Bool *)
-        in Bool (i1 = 0)
-    | If (t1, t2, t3) ->
-        (* we don't handle cases where t1 doesn't evaluate to a boolean *)
-        let Bool b1 = eval t1 g
-        in if b1 then eval t2 g
-        else eval t3 g
-    | Makepair (t1, t2) ->
-        let value1 = eval t1 g
-        in let value2 = eval t2 g
-        in Pair (value1, value2)
-    | First (t1) ->
-        (* we don't handle cases where t1 doesn't evaluate to a Pair *)
-        let Pair (value1, value2) = eval t1 g
-        in value1
-    ;;
diff --git a/code/calculator/calc2.ml b/code/calculator/calc2.ml
deleted file mode 100644 (file)
index 521b81d..0000000
+++ /dev/null
@@ -1,68 +0,0 @@
-(* calc2.ml: calc1.ml enhanced with Function Values *)
-
-    type term =
-      Intconstant of int
-    | Multiplication of (term * term)
-    | Addition of (term * term)
-    | Variable of char
-    | Let of (char * term * term)
-    | Iszero of term
-    | If of (term * term * term)
-    | Makepair of (term * term)
-    | First of term
-    | Lambda of (char * term)
-    | Apply of (term * term)
-    ;;
-
-    type bound_value = expressed_value
-    and assignment = (char * bound_value) list
-    and expressed_value = Int of int | Bool of bool | Pair of expressed_value * expressed_value | Closure of char * term * assignment;;
-
-    let rec eval (t : term) (g : assignment) = match t with
-      Intconstant x -> Int x
-    | Multiplication (t1, t2) ->
-        (* we don't handle cases where the subterms don't evaluate to Ints *)
-        let Int i1 = eval t1 g
-        in let Int i2 = eval t2 g
-        (* Multiplication (t1, t2) should evaluate to an Int *)
-        in Int (i1 * i2)
-    | Addition (t1, t2) ->
-        let Int i1 = eval t1 g
-        in let Int i2 = eval t2 g
-        in Int (i1 + i2)
-    | Variable (var) ->
-        (* we don't handle cases where g doesn't bind var to any value *)
-        List.assoc var g
-    | Let (var_to_bind, t2, t3) ->
-        (* evaluate t3 under a new assignment where var_to_bind has been bound to
-           the result of evaluating t1 under the current assignment *)
-        let value2 = eval t2 g
-        in let g' = (var_to_bind, value2) :: g
-        in eval t3 g'
-    | Iszero (t1) ->
-        (* we don't handle cases where t1 doesn't evaluate to an Int *)
-        let Int i1 = eval t1 g
-        (* Iszero t1 should evaluate to a Bool *)
-        in Bool (i1 = 0)
-    | If (t1, t2, t3) ->
-        (* we don't handle cases where t1 doesn't evaluate to a boolean *)
-        let Bool b1 = eval t1 g
-        in if b1 then eval t2 g
-        else eval t3 g
-    | Makepair (t1, t2) ->
-        let value1 = eval t1 g
-        in let value2 = eval t2 g
-        in Pair (value1, value2)
-    | First (t1) ->
-        (* we don't handle cases where t1 doesn't evaluate to a Pair *)
-        let Pair (value1, value2) = eval t1 g
-        in value1
-    | Lambda (arg_var, t2) -> Closure (arg_var, t2, g)
-    | Apply (t1, t2) ->
-        (* we don't handle cases where t1 doesn't evaluate to a function value *)
-        let Closure (arg_var, body, savedg) = eval t1 g
-        in let value2 = eval t2 g
-        (* evaluate body under savedg, except with arg_var bound to value2 *)
-        in let savedg' = (arg_var, value2) :: savedg
-        in eval body savedg'
-    ;;
diff --git a/code/calculator/calc3.ml b/code/calculator/calc3.ml
deleted file mode 100644 (file)
index 523a6bb..0000000
+++ /dev/null
@@ -1,82 +0,0 @@
-(* calc3.ml: calc2.ml enhanced with Recursive Function Values *)
-
-    type term =
-      Intconstant of int
-    | Multiplication of (term * term)
-    | Addition of (term * term)
-    | Variable of char
-    | Let of (char * term * term)
-    | Iszero of term
-    | If of (term * term * term)
-    | Makepair of (term * term)
-    | First of term
-    | Lambda of (char * term)
-    | Apply of (term * term)
-    | Letrec of (char * term * term)
-    ;;
-
-    type bound_value = Nonrecursive of expressed_value | Recursive_Closure of char * char * term * assignment
-    and assignment = (char * bound_value) list
-    and expressed_value = Int of int | Bool of bool | Pair of expressed_value * expressed_value | Closure of char * term * assignment;;
-
-    let rec eval (t : term) (g : assignment) = match t with
-      Intconstant x -> Int x
-    | Multiplication (t1, t2) ->
-        (* we don't handle cases where the subterms don't evaluate to Ints *)
-        let Int i1 = eval t1 g
-        in let Int i2 = eval t2 g
-        (* Multiplication (t1, t2) should evaluate to an Int *)
-        in Int (i1 * i2)
-    | Addition (t1, t2) ->
-        let Int i1 = eval t1 g
-        in let Int i2 = eval t2 g
-        in Int (i1 + i2)
-    | Variable (var) -> (
-        (* we don't handle cases where g doesn't bind var to any value *)
-        match List.assoc var g with
-          | Nonrecursive value -> value
-          | Recursive_Closure (self_var, arg_var, body, savedg) as rec_closure ->
-              (* we update savedg to bind self_var to rec_closure here *)
-              let savedg' = (self_var, rec_closure) :: savedg
-              in Closure (arg_var, body, savedg')
-        )
-    | Let (var_to_bind, t2, t3) ->
-        (* evaluate t3 under a new assignment where var_to_bind has been bound to
-           the result of evaluating t2 under the current assignment *)
-        let value2 = eval t2 g
-        (* we have to wrap value2 in Nonrecursive *)
-        in let g' = (var_to_bind, Nonrecursive value2) :: g
-        in eval t3 g'
-    | Iszero (t1) ->
-        (* we don't handle cases where t1 doesn't evaluate to an Int *)
-        let Int i1 = eval t1 g
-        (* Iszero t1 should evaluate to a Bool *)
-        in Bool (i1 = 0)
-    | If (t1, t2, t3) ->
-        (* we don't handle cases where t1 doesn't evaluate to a boolean *)
-        let Bool b1 = eval t1 g
-        in if b1 then eval t2 g
-        else eval t3 g
-    | Makepair (t1, t2) ->
-        let value1 = eval t1 g
-        in let value2 = eval t2 g
-        in Pair (value1, value2)
-    | First (t1) ->
-        (* we don't handle cases where t1 doesn't evaluate to a Pair *)
-        let Pair (value1, value2) = eval t1 g
-        in value1
-    | Lambda (arg_var, t2) -> Closure (arg_var, t2, g)
-    | Apply (t1, t2) ->
-        (* we don't handle cases where t1 doesn't evaluate to a function value *)
-        let Closure (arg_var, body, savedg) = eval t1 g
-        in let value2 = eval t2 g
-        (* evaluate body under savedg, except with arg_var bound to Nonrecursive value2 *)
-        in let savedg' = (arg_var, Nonrecursive value2) :: savedg
-        in eval body savedg'
-    | Letrec (var_to_bind, t2, t3) ->
-        (* we don't handle cases where t2 doesn't evaluate to a function value *)
-        let Closure (arg_var, body, savedg) = eval t2 g
-        (* evaluate t3 under a new assignment where var_to_bind has been recursively bound to that function value *) 
-        in let g' = (var_to_bind, Recursive_Closure (var_to_bind, arg_var, body, savedg)) :: g
-        in eval t3 g'
-    ;;
diff --git a/code/calculator/calc4.ml b/code/calculator/calc4.ml
deleted file mode 100644 (file)
index 1343827..0000000
+++ /dev/null
@@ -1,118 +0,0 @@
-(* calc4.ml: calc3.ml enhanced with Mutable Cells *)
-
-    type term =
-      Intconstant of int
-    | Multiplication of (term * term)
-    | Addition of (term * term)
-    | Variable of char
-    | Let of (char * term * term)
-    | Iszero of term
-    | If of (term * term * term)
-    | Makepair of (term * term)
-    | First of term
-    | Lambda of (char * term)
-    | Apply of (term * term)
-    | Letrec of (char * term * term)
-    | Newref of term
-    | Deref of term
-    | Setref of (term * term)
-    ;;
-
-    type index = int;;
-
-    type bound_value = Nonrecursive of expressed_value | Recursive_Closure of char * char * term * assignment
-    and assignment = (char * bound_value) list
-    and expressed_value = Int of int | Bool of bool | Pair of expressed_value * expressed_value | Closure of char * term * assignment | Mutcell of index;;
-
-    type store = expressed_value list;;
-
-    let rec eval (t : term) (g : assignment) (s : store) = match t with
-      Intconstant x -> (Int x, s)
-    | Multiplication (t1, t2) ->
-        (* we don't handle cases where the subterms don't evaluate to Ints *)
-        let (Int i1, s') = eval t1 g s
-        in let (Int i2, s'') = eval t2 g s'
-        (* Multiplication (t1, t2) should evaluate to an Int *)
-        in (Int (i1 * i2), s'')
-    | Addition (t1, t2) ->
-        let (Int i1, s') = eval t1 g s
-        in let (Int i2, s'') = eval t2 g s'
-        in (Int (i1 + i2), s'')
-    | Variable (var) -> ((
-        (* we don't handle cases where g doesn't bind var to any value *)
-        match List.assoc var g with
-          | Nonrecursive value -> value
-          | Recursive_Closure (self_var, arg_var, body, savedg) as rec_closure ->
-              (* we update savedg to bind self_var to rec_closure here *)
-              let savedg' = (self_var, rec_closure) :: savedg
-              in Closure (arg_var, body, savedg')
-        ), s)
-    | Let (var_to_bind, t2, t3) ->
-        (* evaluate t3 under a new assignment where var_to_bind has been bound to
-           the result of evaluating t2 under the current assignment *)
-        let (value2, s') = eval t2 g s
-        (* we have to wrap value2 in Nonrecursive *)
-        in let g' = (var_to_bind, Nonrecursive value2) :: g
-        in eval t3 g' s'
-    | Iszero (t1) ->
-        (* we don't handle cases where t1 doesn't evaluate to an Int *)
-        let (Int i1, s') = eval t1 g s
-        (* Iszero t1 should evaluate to a Bool *)
-        in (Bool (i1 = 0), s')
-    | If (t1, t2, t3) ->
-        (* we don't handle cases where t1 doesn't evaluate to a boolean *)
-        let (Bool b1, s') = eval t1 g s
-        (* note we thread s' through only one of the then/else clauses *)
-        in if b1 then eval t2 g s'
-        else eval t3 g s'
-    | Makepair (t1, t2) ->
-        let (value1, s') = eval t1 g s
-        in let (value2, s'') = eval t2 g s'
-        in (Pair (value1, value2), s'')
-    | First (t1) ->
-        (* we don't handle cases where t1 doesn't evaluate to a Pair *)
-        let (Pair (value1, value2), s') = eval t1 g s
-        in (value1, s')
-    | Lambda (arg_var, t2) -> (Closure (arg_var, t2, g), s)
-    | Apply (t1, t2) ->
-        (* we don't handle cases where t1 doesn't evaluate to a function value *)
-        let (Closure (arg_var, body, savedg), s') = eval t1 g s
-        in let (value2, s'') = eval t2 g s'
-        (* evaluate body under savedg, except with arg_var bound to Nonrecursive value2 *)
-        in let savedg' = (arg_var, Nonrecursive value2) :: savedg
-        in eval body savedg' s''
-    | Letrec (var_to_bind, t2, t3) ->
-        (* we don't handle cases where t2 doesn't evaluate to a function value *)
-        let (Closure (arg_var, body, savedg), s') = eval t2 g s
-        (* evaluate t3 under a new assignment where var_to_bind has been recursively bound to that function value *) 
-        in let g' = (var_to_bind, Recursive_Closure (var_to_bind, arg_var, body, savedg)) :: g
-        in eval t3 g' s'
-    | Newref (t1) ->
-        let (value1, s') = eval t1 g s
-        (* note that s' may be different from s, if t1 itself contained any mutation operations *)
-        (* now we want to retrieve the next free index in s' *)
-        in let new_index = List.length s'
-        (* now we want to insert value1 there; the following is an easy but inefficient way to do it *)
-        in let s'' = List.append s' [value1]
-        (* now we return a pair of a wrapped new_index, and the new store *)
-        in (Mutcell new_index, s'')
-    | Deref (t1) ->
-        (* we don't handle cases where t1 doesn't evaluate to a Mutcell *)
-        let (Mutcell index1, s') = eval t1 g s
-        (* note that s' may be different from s, if t1 itself contained any mutation operations *)
-        in (List.nth s' index1, s')
-    | Setref (t1, t2) ->
-        (* we don't handle cases where t1 doesn't evaluate to a Mutcell *)
-        let (Mutcell index1, s') = eval t1 g s
-        (* note that s' may be different from s, if t1 itself contained any mutation operations *)
-        in let (value2, s'') = eval t2 g s'
-        (* now we create a list which is just like s'' except it has value2 in index1 *)
-        in let rec replace_nth lst m =
-            match lst with
-            | [] -> failwith "list too short"
-            | x::xs when m = 0 -> value2 :: xs
-            | x::xs -> x :: replace_nth xs (m - 1)
-        in let s''' = replace_nth s'' index1
-        (* we'll arbitrarily return Int 42 as the expressed_value of a Setref operation *)
-        in (Int 42, s''')
-    ;;
diff --git a/code/calculator/calc5.ml b/code/calculator/calc5.ml
deleted file mode 100644 (file)
index f855c88..0000000
+++ /dev/null
@@ -1,106 +0,0 @@
-(* calc5.ml: calc3,ml enhanced with Mutable Pairs *)
-
-    type term =
-      Intconstant of int
-    | Multiplication of (term * term)
-    | Addition of (term * term)
-    | Variable of char
-    | Let of (char * term * term)
-    | Iszero of term
-    | If of (term * term * term)
-    | Makepair of (term * term)
-    | First of term
-    | Lambda of (char * term)
-    | Apply of (term * term)
-    | Letrec of (char * term * term)
-    | Setfirst of (term * term)
-    ;;
-
-    type index = int;;
-
-    type bound_value = Nonrecursive of expressed_value | Recursive_Closure of char * char * term * assignment
-    and assignment = (char * bound_value) list
-    and expressed_value = Int of int | Bool of bool | Pair of index * index | Closure of char * term * assignment;;
-
-    type store = expressed_value list;;
-
-    let rec eval (t : term) (g : assignment) (s : store) = match t with
-      Intconstant x -> (Int x, s)
-    | Multiplication (t1, t2) ->
-        (* we don't handle cases where the subterms don't evaluate to Ints *)
-        let (Int i1, s') = eval t1 g s
-        in let (Int i2, s'') = eval t2 g s'
-        (* Multiplication (t1, t2) should evaluate to an Int *)
-        in (Int (i1 * i2), s'')
-    | Addition (t1, t2) ->
-        let (Int i1, s') = eval t1 g s
-        in let (Int i2, s'') = eval t2 g s'
-        in (Int (i1 + i2), s'')
-    | Variable (var) -> ((
-        (* we don't handle cases where g doesn't bind var to any value *)
-        match List.assoc var g with
-          | Nonrecursive value -> value
-          | Recursive_Closure (self_var, arg_var, body, savedg) as rec_closure ->
-              (* we update savedg to bind self_var to rec_closure here *)
-              let savedg' = (self_var, rec_closure) :: savedg
-              in Closure (arg_var, body, savedg')
-        ), s)
-    | Let (var_to_bind, t2, t3) ->
-        (* evaluate t3 under a new assignment where var_to_bind has been bound to
-           the result of evaluating t2 under the current assignment *)
-        let (value2, s') = eval t2 g s
-        (* we have to wrap value2 in Nonrecursive *)
-        in let g' = (var_to_bind, Nonrecursive value2) :: g
-        in eval t3 g' s'
-    | Iszero (t1) ->
-        (* we don't handle cases where t1 doesn't evaluate to an Int *)
-        let (Int i1, s') = eval t1 g s
-        (* Iszero t1 should evaluate to a Bool *)
-        in (Bool (i1 = 0), s')
-    | If (t1, t2, t3) ->
-        (* we don't handle cases where t1 doesn't evaluate to a boolean *)
-        let (Bool b1, s') = eval t1 g s
-        (* note we thread s' through only one of the then/else clauses *)
-        in if b1 then eval t2 g s'
-        else eval t3 g s'
-    | Makepair (t1, t2) ->
-        let (value1, s') = eval t1 g s
-        in let (value2, s'') = eval t2 g s'
-        (* now we want to retrieve the next free index in s'' *)
-        in let new_index = List.length s''
-        (* now we want to insert value1 and value2 there; the following is an easy but inefficient way to do it *)
-        in let s''' = List.append s'' [value1; value2]
-        in (Pair (new_index, new_index + 1), s''')
-    | First (t1) ->
-        (* we don't handle cases where t1 doesn't evaluate to a Pair *)
-        let (Pair (index1, index2), s') = eval t1 g s
-        (* note that s' may be different from s, if t1 itself contained any mutation operations *)
-        in (List.nth s' index1, s')
-    | Lambda (arg_var, t2) -> (Closure (arg_var, t2, g), s)
-    | Apply (t1, t2) ->
-        (* we don't handle cases where t1 doesn't evaluate to a function value *)
-        let (Closure (arg_var, body, savedg), s') = eval t1 g s
-        in let (value2, s'') = eval t2 g s'
-        (* evaluate body under savedg, except with arg_var bound to Nonrecursive value2 *)
-        in let savedg' = (arg_var, Nonrecursive value2) :: savedg
-        in eval body savedg' s''
-    | Letrec (var_to_bind, t2, t3) ->
-        (* we don't handle cases where t2 doesn't evaluate to a function value *)
-        let (Closure (arg_var, body, savedg), s') = eval t2 g s
-        (* evaluate t3 under a new assignment where var_to_bind has been recursively bound to that function value *) 
-        in let g' = (var_to_bind, Recursive_Closure (var_to_bind, arg_var, body, savedg)) :: g
-        in eval t3 g' s'
-    | Setfirst (t1, t2) ->
-        (* we don't handle cases where t1 doesn't evaluate to a Pair *)
-        let (Pair (index1, index2), s') = eval t1 g s
-        (* note that s' may be different from s, if t1 itself contained any mutation operations *)
-        in let (value2, s'') = eval t2 g s'
-        (* now we create a list which is just like s'' except it has value2 in index1 *)
-        in let rec replace_nth lst m =
-            match lst with
-            | [] -> failwith "list too short"
-            | x::xs when m = 0 -> value2 :: xs
-            | x::xs -> x :: replace_nth xs (m - 1)
-        in let s''' = replace_nth s'' index1
-        in (Int 42, s''')
-    ;;
diff --git a/code/calculator/calc6.ml b/code/calculator/calc6.ml
deleted file mode 100644 (file)
index 9cf5abc..0000000
+++ /dev/null
@@ -1,108 +0,0 @@
-(* calc6.ml: calc3.ml enhanced with Mutable Variables *)
-
-    type term =
-      Intconstant of int
-    | Multiplication of (term * term)
-    | Addition of (term * term)
-    | Variable of char
-    | Let of (char * term * term)
-    | Iszero of term
-    | If of (term * term * term)
-    | Makepair of (term * term)
-    | First of term
-    | Lambda of (char * term)
-    | Apply of (term * term)
-    | Letrec of (char * term * term)
-    | Change of (char * term * term)
-    ;;
-
-    type index = int;;
-
-    type bound_value = index;;
-    type assignment = (char * bound_value) list;;
-    type expressed_value = Int of int | Bool of bool | Pair of expressed_value * expressed_value | Closure of char * term * assignment;;
-
-    type store = expressed_value list;;
-
-    let rec eval (t : term) (g : assignment) (s : store) = match t with
-      Intconstant x -> (Int x, s)
-    | Multiplication (t1, t2) ->
-        (* we don't handle cases where the subterms don't evaluate to Ints *)
-        let (Int i1, s') = eval t1 g s
-        in let (Int i2, s'') = eval t2 g s'
-        (* Multiplication (t1, t2) should evaluate to an Int *)
-        in (Int (i1 * i2), s'')
-    | Addition (t1, t2) ->
-        let (Int i1, s') = eval t1 g s
-        in let (Int i2, s'') = eval t2 g s'
-        in (Int (i1 + i2), s'')
-    | Variable (var) ->
-        (* we don't handle cases where g doesn't bind var to any value *)
-        let index = List.assoc var g
-        (* get value stored at location index in s *)
-        in let value = List.nth s index
-        in (value, s)
-    | Let (var_to_bind, t2, t3) ->
-        let (value2, s') = eval t2 g s
-        (* note that s' may be different from s, if t2 itself contained any mutation operations *)
-        (* get next free index in s' *)
-        in let new_index = List.length s'
-        (* now we want to insert value2 there; the following is an easy but inefficient way to do it *)
-        in let s'' = List.append s' [value2]
-        (* bind var_to_bind to location new_index in the store *)
-        in let g' = ((var_to_bind, new_index) :: g)
-        in eval t3 g' s''
-    | Iszero (t1) ->
-        (* we don't handle cases where t1 doesn't evaluate to an Int *)
-        let (Int i1, s') = eval t1 g s
-        (* Iszero t1 should evaluate to a Bool *)
-        in (Bool (i1 = 0), s')
-    | If (t1, t2, t3) ->
-        (* we don't handle cases where t1 doesn't evaluate to a boolean *)
-        let (Bool b1, s') = eval t1 g s
-        (* note we thread s' through only one of the then/else clauses *)
-        in if b1 then eval t2 g s'
-        else eval t3 g s'
-    | Makepair (t1, t2) ->
-        let (value1, s') = eval t1 g s
-        in let (value2, s'') = eval t2 g s'
-        in (Pair (value1, value2), s'')
-    | First (t1) ->
-        (* we don't handle cases where t1 doesn't evaluate to a Pair *)
-        let (Pair (value1, value2), s') = eval t1 g s
-        in (value1, s')
-    | Lambda (arg_var, t2) -> (Closure (arg_var, t2, g), s)
-    | Apply (t1, t2) ->
-        (* we don't handle cases where t1 doesn't evaluate to a function value *)
-        let (Closure (arg_var, body, savedg), s') = eval t1 g s
-        in let (value2, s'') = eval t2 g s'
-        (* evaluate body under savedg, except with arg_var bound to a new location containing value2 *)
-        in let new_index = List.length s''
-        in let s''' = List.append s'' [value2]
-        in let savedg' = (arg_var, new_index) :: savedg
-        in eval body savedg' s'''
-    | Letrec (var_to_bind, t2, t3) ->
-        (* we don't handle cases where t2 doesn't evaluate to a function value *)
-        let (Closure (arg_var, body, savedg), s') = eval t2 g s
-        in let new_index = List.length s'
-        in let savedg' = (var_to_bind, new_index) :: savedg
-        in let new_closure = Closure (arg_var, body, savedg')
-        in let s'' = List.append s' [new_closure]
-        in let g' = (var_to_bind, new_index) :: g
-        in eval t3 g' s''
-    | Change (var, t2, t3) ->
-        (* we don't handle cases where g doesn't bind var to any value *)
-        let index = List.assoc var g
-        in let (value2, s') = eval t2 g s
-        (* note that s' may be different from s, if t2 itself contained any mutation operations *)
-        (* now we create a list which is just like s' except it has value2 at index *)
-        in let rec replace_nth lst m =
-            match lst with
-            | [] -> failwith "list too short"
-            | x::xs when m = 0 -> value2 :: xs
-            | x::xs -> x :: replace_nth xs (m - 1)
-        in let s'' = replace_nth s' index
-        (* evaluate t3 using original assignment function and new store *)
-        in eval t3 g s''
-    ;;
-
diff --git a/code/calculator/calc7.ml b/code/calculator/calc7.ml
deleted file mode 100644 (file)
index 6a3e55c..0000000
+++ /dev/null
@@ -1,124 +0,0 @@
-(* calc7.ml: calc6.ml enhanced with Aliases and Passing by Reference *)
-
-    type term =
-      Intconstant of int
-    | Multiplication of (term * term)
-    | Addition of (term * term)
-    | Variable of char
-    | Let of (char * term * term)
-    | Iszero of term
-    | If of (term * term * term)
-    | Makepair of (term * term)
-    | First of term
-    | Lambda of (char * term)
-    | Apply of (term * term)
-    | Letrec of (char * term * term)
-    | Change of (char * term * term)
-    | Alias of (char * char * term)
-    | Applyalias of (term * char)
-    ;;
-
-    type index = int;;
-
-    type bound_value = index;;
-    type assignment = (char * bound_value) list;;
-    type expressed_value = Int of int | Bool of bool | Pair of expressed_value * expressed_value | Closure of char * term * assignment;;
-
-    type store = expressed_value list;;
-
-    let rec eval (t : term) (g : assignment) (s : store) = match t with
-      Intconstant x -> (Int x, s)
-    | Multiplication (t1, t2) ->
-        (* we don't handle cases where the subterms don't evaluate to Ints *)
-        let (Int i1, s') = eval t1 g s
-        in let (Int i2, s'') = eval t2 g s'
-        (* Multiplication (t1, t2) should evaluate to an Int *)
-        in (Int (i1 * i2), s'')
-    | Addition (t1, t2) ->
-        let (Int i1, s') = eval t1 g s
-        in let (Int i2, s'') = eval t2 g s'
-        in (Int (i1 + i2), s'')
-    | Variable (var) ->
-        (* we don't handle cases where g doesn't bind var to any value *)
-        let index = List.assoc var g
-        (* get value stored at location index in s *)
-        in let value = List.nth s index
-        in (value, s)
-    | Let (var_to_bind, t2, t3) ->
-        let (value2, s') = eval t2 g s
-        (* note that s' may be different from s, if t2 itself contained any mutation operations *)
-        (* get next free index in s' *)
-        in let new_index = List.length s'
-        (* now we want to insert value2 there; the following is an easy but inefficient way to do it *)
-        in let s'' = List.append s' [value2]
-        (* bind var_to_bind to location new_index in the store *)
-        in let g' = ((var_to_bind, new_index) :: g)
-        in eval t3 g' s''
-    | Iszero (t1) ->
-        (* we don't handle cases where t1 doesn't evaluate to an Int *)
-        let (Int i1, s') = eval t1 g s
-        (* Iszero t1 should evaluate to a Bool *)
-        in (Bool (i1 = 0), s')
-    | If (t1, t2, t3) ->
-        (* we don't handle cases where t1 doesn't evaluate to a boolean *)
-        let (Bool b1, s') = eval t1 g s
-        (* note we thread s' through only one of the then/else clauses *)
-        in if b1 then eval t2 g s'
-        else eval t3 g s'
-    | Makepair (t1, t2) ->
-        let (value1, s') = eval t1 g s
-        in let (value2, s'') = eval t2 g s'
-        in (Pair (value1, value2), s'')
-    | First (t1) ->
-        (* we don't handle cases where t1 doesn't evaluate to a Pair *)
-        let (Pair (value1, value2), s') = eval t1 g s
-        in (value1, s')
-    | Lambda (arg_var, t2) -> (Closure (arg_var, t2, g), s)
-    | Apply (t1, t2) ->
-        (* we don't handle cases where t1 doesn't evaluate to a function value *)
-        let (Closure (arg_var, body, savedg), s') = eval t1 g s
-        in let (value2, s'') = eval t2 g s'
-        (* evaluate body under savedg, except with arg_var bound to a new location containing value2 *)
-        in let new_index = List.length s''
-        in let s''' = List.append s'' [value2]
-        in let savedg' = (arg_var, new_index) :: savedg
-        in eval body savedg' s'''
-    | Letrec (var_to_bind, t2, t3) ->
-        (* we don't handle cases where t2 doesn't evaluate to a function value *)
-        let (Closure (arg_var, body, savedg), s') = eval t2 g s
-        in let new_index = List.length s'
-        in let savedg' = (var_to_bind, new_index) :: savedg
-        in let new_closure = Closure (arg_var, body, savedg')
-        in let s'' = List.append s' [new_closure]
-        in let g' = (var_to_bind, new_index) :: g
-        in eval t3 g' s''
-    | Change (var, t2, t3) ->
-        (* we don't handle cases where g doesn't bind var to any value *)
-        let index = List.assoc var g
-        in let (value2, s') = eval t2 g s
-        (* note that s' may be different from s, if t2 itself contained any mutation operations *)
-        (* now we create a list which is just like s' except it has value2 at index *)
-        in let rec replace_nth lst m =
-            match lst with
-            | [] -> failwith "list too short"
-            | x::xs when m = 0 -> value2 :: xs
-            | x::xs -> x :: replace_nth xs (m - 1)
-        in let s'' = replace_nth s' index
-        (* evaluate t3 using original assignment function and new store *)
-        in eval t3 g s''
-    | Alias (var_to_bind, orig_var, t3) ->
-        (* we don't handle cases where g doesn't bind orig_var to any value *)
-        let index = List.assoc orig_var g
-        (* bind var_to_bind to the same index in the store *)
-        in let g' = ((var_to_bind, index) :: g)
-        in eval t3 g' s
-    | Applyalias (t1, var) ->
-        (* we don't handle cases where t1 doesn't evaluate to a function value *)
-        let (Closure (arg_var, body, savedg), s') = eval t1 g s
-        (* we don't handle cases where g doesn't bind var to any value *)
-        in let index = List.assoc var g
-        (* evaluate body under savedg, except with arg_var bound to existing index *)
-        in let savedg' = (arg_var, index) :: savedg
-        in eval body savedg' s'
-    ;;
-
diff --git a/code/caml-lambda/lambda.ml b/code/caml-lambda/lambda.ml
deleted file mode 100644 (file)
index 1eaca65..0000000
+++ /dev/null
@@ -1,389 +0,0 @@
-(* *)
-
-module Private =  struct
-    type var_t = int*string
-    let var v = (0, v)
-    let string_of_var (i, v) = v ^ String.make i '\''
-    let equal_var (i1, v1) (i2, v2) = i1 == i2 && (String.compare v1 v2 == 0)
-
-    type lambda_t = [ `Var of var_t | `Lam of var_t * lambda_t | `App of lambda_t * lambda_t ]
-
-(* DeBruijn terms
- * substitution and translation algorithms from Chris Hankin, An Introduction to Lambda Calculi for Comptuer Scientists
- *)
-
-    type debruijn_t = [ `Db_free of var_t | `Db_index of int | `Db_lam of debruijn_t | `Db_app of debruijn_t*debruijn_t ]
-
-    let debruijn_subst (expr : debruijn_t) (m : int) (new_term : debruijn_t) =
-        let rec renumber m i = function
-        | `Db_free _ as term -> term
-        | `Db_index j as term when j < i -> term
-        | `Db_index j -> `Db_index (j + m - 1)
-        | `Db_app(left, right) -> `Db_app(renumber m i left, renumber m i right)
-        | `Db_lam body -> `Db_lam(renumber m (i+1) body)
-        in let rec loop m = function
-        | `Db_free _ as term -> term
-        | `Db_index j as term when j < m -> term
-        | `Db_index j when j > m -> `Db_index (j-1)
-        | `Db_index j -> renumber j 1 new_term
-        | `Db_app(left, right) -> `Db_app(loop m left, loop m right)
-        | `Db_lam body -> `Db_lam(loop (m+1) body)
-        in loop m expr
-
-    let debruijn (expr : lambda_t) : debruijn_t =
-        let pos seq (target : var_t) =
-            let rec loop (i : int) = function
-            | [] -> `Db_free target
-            | x::xs when equal_var x target -> `Db_index i
-            | _::xs -> loop (i+1) xs
-            in loop 1 seq
-        in let rec loop seq = function
-        | `Var v -> pos seq v
-        | `Lam (v, body) -> `Db_lam(loop (v::seq) body)
-        | `App (left, right) -> `Db_app(loop seq left, loop seq right)
-        in loop [] expr
-
-    let rec dbruijn_equal (t1 : debruijn_t) (t2 : debruijn_t) = match (t1, t2) with
-    | (`Db_free v1, `Db_free v2) -> equal_var v1 v2
-    | (`Db_index j1, `Db_index j2) -> j1 == j2
-    | (`Db_app(left1, right1), `Db_app(left2, right2)) -> dbruijn_equal left1 left2 && dbruijn_equal right1 right2
-    | (`Db_lam(body1), `Db_lam(body2)) -> dbruijn_equal body1 body2
-    | _ -> false
-
-    let rec debruijn_contains (t1 : debruijn_t) (t2 : debruijn_t) = match (t1, t2) with
-    | (`Db_free v1, `Db_free v2) -> equal_var v1 v2
-    | (`Db_index j1, `Db_index j2) -> j1 == j2
-    | (`Db_app(left1, right1), `Db_app(left2, right2)) when dbruijn_equal left1 left2 && dbruijn_equal right1 right2 -> true
-    | (`Db_app(left, right), term2) -> debruijn_contains left term2 || debruijn_contains right term2
-    | (`Db_lam(body1), `Db_lam(body2)) when dbruijn_equal body1 body2 -> true
-    | (`Db_lam(body1), term2) -> debruijn_contains body1 term2
-    | _ -> false
-
-
-    (* non-normalizing string_of_lambda *)
-    let string_of_lambda (expr : lambda_t) =
-        let rec top = function
-            | `Var v -> string_of_var v
-            | `Lam _ as term -> "fun " ^ dotted term
-            | `App ((`App _ as left), right) -> top left ^ " " ^ atom right
-            | `App (left, right) -> atom left ^ " " ^ atom right
-        and atom = function
-            | `Var v -> string_of_var v
-            | `Lam _ as term -> "(fun " ^ dotted term ^ ")"
-            | `App _ as term -> "(" ^ top term ^ ")"
-        and dotted = function
-            | `Lam (v, (`Lam _ as body)) -> (string_of_var v) ^ " " ^ dotted body
-            | `Lam (v, body) -> (string_of_var v) ^ " -> " ^ top body
-        in top expr
-
-(*
- * substitution and normal-order evaluator based on Haskell version by Oleg Kisleyov
- * http://okmij.org/ftp/Computation/lambda-calc.html#lambda-calculator-haskell
- *)
-
-(* if v occurs free_in term, returns Some v' where v' is the highest-tagged
- * variable with the same name as v occurring (free or bound) in term
- *)
-    let free_in ((tag, name) as v) term =
-        let rec loop = function
-        | `Var((tag', name') as v') ->
-                if name <> name' then false, v
-                else if tag = tag' then true, v
-                else false, v'
-        | `App(left, right) ->
-                let left_bool, ((left_tag, _) as left_v) = loop left in
-                let right_bool, ((right_tag, _) as right_v) = loop right in
-                left_bool || right_bool, if left_tag > right_tag then left_v else right_v
-        | `Lam(v', _) when equal_var v v' -> (false, v)
-        | `Lam(_, body) -> loop body
-        in match loop term with
-        | false, _ -> None
-        | true, v -> Some v
-
-    let rec subst v new_term term = match new_term with
-        | `Var v' when equal_var v v' -> term
-        | _ -> (match term with
-            | `Var v' when equal_var v v' -> new_term
-            | `Var _ -> term
-            | `App(left, right) -> `App(subst v new_term left, subst v new_term right)
-            | `Lam(v', _) when equal_var v v' -> term
-            (* if x is free in the inserted term new_term, a capture is possible *)
-            | `Lam(v', body) ->
-                    (match free_in v' new_term with
-                    (* v' not free in new_term, can substitute new_term for v without any captures *)
-                    | None -> `Lam(v', subst v new_term body)
-                    (* v' free in new_term, need to alpha-convert *)
-                    | Some max_x ->  
-                        let bump_tag (tag, name) (tag', _) =
-                            (max tag tag') + 1, name in
-                        let bump_tag' ((_, name) as v1) ((_, name') as v2) =
-                            if (String.compare name name' == 0) then bump_tag v1 v2 else v1 in
-                        (* bump v' > max_x from new_term, then check whether
-                         * it also needs to be bumped > v
-                         *)
-                        let uniq_x = bump_tag' (bump_tag v' max_x) v in
-                        let uniq_x' = (match free_in uniq_x body with
-                            | None -> uniq_x
-                            (* bump uniq_x > max_x' from body *)
-                            | Some max_x' -> bump_tag uniq_x max_x'
-                        ) in
-                        (* alpha-convert body *)
-                        let body' = subst v' (`Var uniq_x') body in
-                        (* now substitute new_term for v *)
-                        `Lam(uniq_x', subst v new_term body')
-                    )
-        )
-
-    let check_eta = function
-        | `Lam(v, `App(body, `Var u)) when equal_var v u && free_in v body = None -> body
-        | (_ : lambda_t) as term -> term
-
-
-
-
-    exception Lambda_looping;;
-
-    let eval ?(eta=false) (expr : lambda_t) : lambda_t =
-        let rec looping (body : debruijn_t) = function
-          | [] -> false
-        | x::xs when dbruijn_equal body x -> true
-        | _::xs -> looping body xs
-        in let rec loop (stack : lambda_t list) (body : lambda_t) = 
-            match body with
-            | `Var v as term -> unwind term stack
-            | `App(left, right) -> loop (right::stack) left
-            | `Lam(v, body) -> (match stack with
-                | [] ->
-                    let term = (`Lam(v, loop [] body)) in
-                        if eta then check_eta term else term
-                | x::xs -> loop xs (subst v x body)
-            )
-        and unwind left = function
-        | [] -> left
-        | x::xs -> unwind (`App(left, loop [] x)) xs
-        in loop [] expr
-
-
-    let cbv ?(aggressive=true) (expr : lambda_t) : lambda_t =
-        let rec loop = function
-        | `Var v as term -> term
-        | `App(left, right) ->
-                let right' = loop right in
-                (match loop left with
-                | `Lam(v, body) -> loop (subst v right' body)
-                | _ as left' -> `App(left', right')
-                )
-        | `Lam(v, body) as term ->
-                if aggressive then `Lam(v, loop body)
-                else term
-        in loop expr
-
-
-
-
-
-    (*
-    
-     (* (Oleg's version of) Ken's evaluator; doesn't seem to work -- requires laziness? *)
-    let eval' ?(eta=false) (expr : lambda_t) : lambda_t =
-        let rec loop = function
-        | `Var v as term -> term
-        | `Lam(v, body) ->
-                let term = (`Lam(v, loop body)) in
-                    if eta then check_eta term else term
-        | `App(`App _ as left, right) ->
-            (match loop left with
-                | `Lam _ as redux -> loop (`App(redux, right))
-                | nonred_head -> `App(nonred_head, loop right)
-            )
-        | `App(left, right) -> `App(left, loop right)
-        in loop expr
-
-
-        module Sorted = struct
-            let rec cons y = function
-                | x :: _ as xs when x = y -> xs
-                | x :: xs when x < y -> x :: cons y xs
-                | xs [* [] or x > y *] -> y :: xs
-
-            let rec mem y = function
-                | x :: _ when x = y -> true
-                | x :: xs when x < y -> mem y xs
-                | _ [* [] or x > y *] -> false
-
-            let rec remove y = function
-                | x :: xs when x = y -> xs
-                | x :: xs when x < y -> x :: remove y xs
-                | xs [* [] or x > y *] -> xs
-
-            let rec merge x' y' = match x', y' with
-                | [], ys -> ys
-                | xs, [] -> xs
-                | x::xs, y::ys ->
-                    if x < y then x :: merge xs y'
-                    else if x = y then x :: merge xs ys
-                    else [* x > y *] y :: merge x' ys
-        end
-
-        let free_vars (expr : lambda_t) : string list =
-            let rec loop = function
-                | `Var x -> [x]
-                | `Lam(x, t) -> Sorted.remove x (loop t)
-                | `App(t1, t2) -> Sorted.merge (loop t1) (loop t2)
-            in loop expr
-
-        let free_in v (expr : lambda_t) =
-            Sorted.mem v (free_vars t)
-
-        let new_var =
-            let counter = ref 0 in
-            fun () -> (let z = !counter in incr counter; "_v"^(string_of_int z))
-
-        ...
-        | `Lam(x, body) as term when not (free_in v body) -> term
-        | `Lam(y, body) when not (free_in y new_term) -> `Lam(y, subst v new_term body)
-        | `Lam(y, body) ->
-            let z = new_var () in
-            subst v new_term (`Lam(z, subst y (`Var z) body))
-    *)
-
-
-
-    (*
-
-    let bound_vars (expr : lambda_t) : string list =
-        let rec loop = function
-            | `Var x -> []
-            | `Lam(x, t) -> Sorted.cons x (loop t)
-            | `App(t1, t2) -> Sorted.merge (loop t1) (loop t2)
-        in loop expr
-
-    let reduce_cbv ?(aggressive=true) (expr : lambda_t) : lambda_t =
-        let rec loop = function
-        | `Var x as term -> term
-        | `App(t1, t2) ->
-                let t2' = loop t2 in
-                (match loop t1 with
-                | `Lam(x, t) -> loop (subst x t2' t)
-                | _ as term -> `App(term, t2')
-                )
-        | `Lam(x, t) as term ->
-                if aggressive then `Lam(x, loop t)
-                else term
-        in loop expr
-
-    let reduce_cbn (expr : lambda_t) : lambda_t =
-        let rec loop = function
-        | `Var x as term -> term
-        | `Lam(v, body) ->
-                check_eta (`Lam(v, loop body))
-        | `App(t1, t2) ->
-                (match loop t1 with
-                | `Lam(x, t) -> loop (subst x t2 t)
-                | _ as term -> `App(term, loop t2)
-                )
-        in loop expr
-
-    *)
-
-
-    (*
-
-    type env_t = (string * lambda_t) list
-
-    let subst body x value =
-        ((fun env ->
-            let new_env = (x, value) :: env in
-            body new_env) : env_t -> lambda_t)
-
-    type strategy_t = By_value | By_name
-
-    let eval (strategy : strategy_t) (expr : lambda_t) : lambda_t =
-        in let rec inner = function
-            | `Var x as t ->
-                (fun env ->
-                    try List.assoc x env with
-                    | Not_found -> t)
-            | `App(t1, value) -> 
-                (fun env ->
-                    let value' =
-                        if strategy = By_value then inner value env else value in
-                    (match inner t1 env with
-                    | `Lam(x, body) ->
-                        let body' = (subst (inner body) x value' env) in
-                        if strategy = By_value then body' else inner body' env
-                    | (t1' : lambda_t) -> `App(t1', inner value env)
-                    )
-                )
-            | `Lam(x, body) ->
-                (fun env ->
-                    let v = new_var () in
-                    `Lam(v, inner body ((x, `Var v) :: env)))
-        in inner expr ([] : env_t)
-
-    let pp_env env =
-        let rec loop acc = function
-            | [] -> acc
-            | (x, term)::es -> loop ((x ^ "=" ^ string_of_lambda term) :: acc) es
-        in "[" ^ (String.concat ", " (loop [] (List.rev env))) ^ "]"
-
-    let eval (strategy : strategy_t) (expr : lambda_t) : lambda_t =
-        let new_var =
-            let counter = ref 0 in
-            fun () -> (let z = !counter in incr counter; "_v"^(string_of_int z))
-        in let rec inner term =
-            begin
-            Printf.printf "starting [ %s ]\n" (string_of_lambda term);
-            let res = match term with
-            | `Var x as t ->
-                (fun env ->
-                    try List.assoc x env with
-                    | Not_found -> t)
-            | `App(t1, value) -> 
-                (fun env ->
-                    let value' =
-                        if strategy = By_value then inner value env else value in
-                    (match inner t1 env with
-                    | `Lam(x, body) ->
-                        let body' = (subst (inner body) x value' env) in
-                        if strategy = By_value then body' else inner body' env
-                    | (t1' : lambda_t) -> `App(t1', inner value env)
-                    )
-                )
-            | `Lam(x, body) ->
-                (fun env ->
-                    let v = new_var () in
-                    `Lam(v, inner body ((x, `Var v) :: env)))
-            in
-            (fun env -> 
-                (Printf.printf "%s with %s => %s\n" (string_of_lambda term) (pp_env env) (string_of_lambda (res env)); res env))
-            end
-        in inner expr ([] : env_t)
-
-    *)
-
-    let normal ?(eta=false) expr = eval ~eta expr
-
-    let normal_string_of_lambda ?(eta=false) (expr : lambda_t) =
-        string_of_lambda (normal ~eta expr)
-
-    let rec to_int expr = match expr with
-        | `Lam(s, `Lam(z, `Var z')) when z' = z -> 0
-        | `Lam(s, `Var s') when equal_var s s' -> 1
-        | `Lam(s, `Lam(z, `App (`Var s', t))) when s' = s -> 1 + to_int (`Lam(s, `Lam(z, t)))
-        | _ -> failwith (normal_string_of_lambda expr ^ " is not a church numeral")
-
-    let int_of_lambda ?(eta=false) (expr : lambda_t) =
-        to_int (normal ~eta expr)
-
-end
-
-type lambda_t = Private.lambda_t
-open Private
-let var = var
-let pp, pn, pi = string_of_lambda, normal_string_of_lambda, int_of_lambda
-let pnv, piv= (fun expr -> string_of_lambda (cbv expr)), (fun expr -> to_int (cbv expr))
-let debruijn, dbruijn_equal, debruijn_contains = debruijn, dbruijn_equal, debruijn_contains
-
-let alpha_eq x y = dbruijn_equal (debruijn x) (debruijn y)
-
diff --git a/code/caml-lambda/q_lambda.ml b/code/caml-lambda/q_lambda.ml
deleted file mode 100644 (file)
index 66762e5..0000000
+++ /dev/null
@@ -1,51 +0,0 @@
-(* Please keep me in sync with brion.inria.fr/gallium/index.php/Lambda_calculus_quotations *)
-
-open Camlp4.PreCast;;
-module CamlSyntax = Camlp4OCamlParser.Make(Camlp4OCamlRevisedParser.Make(Syntax));;
-
-let expr_of_string = CamlSyntax.Gram.parse_string CamlSyntax.expr_eoi;;
-
-module LambdaGram = MakeGram(Lexer);;
-
-let term = LambdaGram.Entry.mk "term";;
-let term_eoi = LambdaGram.Entry.mk "lambda term quotation";;
-
-Camlp4_config.antiquotations := true;;
-
-EXTEND LambdaGram
-  GLOBAL: term term_eoi;
-  term:
-    [ "top"
-      [ "fun"; v = var; "->"; t = term -> <:expr< `Lam(var $v$, $t$) >>
-      | "fun"; v = var; v' = var; "->"; t = term -> <:expr< `Lam(var $v$, `Lam(var $v'$, $t$)) >>
-      | "fun"; v = var; v' = var; v'' = var; "->"; t = term -> <:expr< `Lam(var $v$, `Lam(var $v'$, `Lam(var $v''$, $t$))) >>
-      | "fun"; v = var; v' = var; v'' = var; v''' = var; "->"; t = term -> <:expr< `Lam(var $v$, `Lam(var $v'$, `Lam(var $v''$, `Lam(var $v'''$, $t$)))) >>
-      | "fun"; v = var; v' = var; v'' = var; v''' = var; v'''' = var; "->"; t = term -> <:expr< `Lam(var $v$, `Lam(var $v'$, `Lam(var $v''$, `Lam(var $v'''$, `Lam(var $v''''$, $t$))))) >>
-      ]
-
-    | "app"
-      [ t1 = SELF; t2 = SELF           -> <:expr< `App($t1$, $t2$) >> ]
-
-    | "simple"
-      [ `ANTIQUOT((""|"term"), a)      -> expr_of_string _loc a
-       | v = var                        -> <:expr< `Var(var $v$) >>
-       | "("; t = term; ")"             -> t 
-      ]
-
-    ];
-  var:
-    [[ v = LIDENT               -> <:expr< $str:v$ >>
-     | `ANTIQUOT((""|"var"), a) -> expr_of_string _loc a
-    ]];
-  term_eoi:
-    [[ t = term; `EOI -> t ]];
-END;;
-
-let expand_lambda_quot_expr loc _loc_name_opt quotation_contents =
-  LambdaGram.parse_string term_eoi loc quotation_contents;;
-
-(* to have this syntax <:lam< fun k -> k >> *)
-Syntax.Quotation.add "lam" Syntax.Quotation.DynAst.expr_tag expand_lambda_quot_expr;;
-
-Syntax.Quotation.default := "lam";;
-
diff --git a/code/json2.js b/code/json2.js
deleted file mode 100644 (file)
index 0498ef9..0000000
+++ /dev/null
@@ -1,483 +0,0 @@
-/*
-    http://www.JSON.org/json2.js
-    2010-08-25
-
-    Public Domain.
-
-    NO WARRANTY EXPRESSED OR IMPLIED. USE AT YOUR OWN RISK.
-
-    See http://www.JSON.org/js.html
-
-
-    This code should be minified before deployment.
-    See http://javascript.crockford.com/jsmin.html
-
-    USE YOUR OWN COPY. IT IS EXTREMELY UNWISE TO LOAD CODE FROM SERVERS YOU DO
-    NOT CONTROL.
-
-
-    This file creates a global JSON object containing two methods: stringify
-    and parse.
-
-        JSON.stringify(value, replacer, space)
-            value       any JavaScript value, usually an object or array.
-
-            replacer    an optional parameter that determines how object
-                        values are stringified for objects. It can be a
-                        function or an array of strings.
-
-            space       an optional parameter that specifies the indentation
-                        of nested structures. If it is omitted, the text will
-                        be packed without extra whitespace. If it is a number,
-                        it will specify the number of spaces to indent at each
-                        level. If it is a string (such as '\t' or '&nbsp;'),
-                        it contains the characters used to indent at each level.
-
-            This method produces a JSON text from a JavaScript value.
-
-            When an object value is found, if the object contains a toJSON
-            method, its toJSON method will be called and the result will be
-            stringified. A toJSON method does not serialize: it returns the
-            value represented by the name/value pair that should be serialized,
-            or undefined if nothing should be serialized. The toJSON method
-            will be passed the key associated with the value, and this will be
-            bound to the value
-
-            For example, this would serialize Dates as ISO strings.
-
-                Date.prototype.toJSON = function (key) {
-                    function f(n) {
-                        // Format integers to have at least two digits.
-                        return n < 10 ? '0' + n : n;
-                    }
-
-                    return this.getUTCFullYear()   + '-' +
-                         f(this.getUTCMonth() + 1) + '-' +
-                         f(this.getUTCDate())      + 'T' +
-                         f(this.getUTCHours())     + ':' +
-                         f(this.getUTCMinutes())   + ':' +
-                         f(this.getUTCSeconds())   + 'Z';
-                };
-
-            You can provide an optional replacer method. It will be passed the
-            key and value of each member, with this bound to the containing
-            object. The value that is returned from your method will be
-            serialized. If your method returns undefined, then the member will
-            be excluded from the serialization.
-
-            If the replacer parameter is an array of strings, then it will be
-            used to select the members to be serialized. It filters the results
-            such that only members with keys listed in the replacer array are
-            stringified.
-
-            Values that do not have JSON representations, such as undefined or
-            functions, will not be serialized. Such values in objects will be
-            dropped; in arrays they will be replaced with null. You can use
-            a replacer function to replace those with JSON values.
-            JSON.stringify(undefined) returns undefined.
-
-            The optional space parameter produces a stringification of the
-            value that is filled with line breaks and indentation to make it
-            easier to read.
-
-            If the space parameter is a non-empty string, then that string will
-            be used for indentation. If the space parameter is a number, then
-            the indentation will be that many spaces.
-
-            Example:
-
-            text = JSON.stringify(['e', {pluribus: 'unum'}]);
-            // text is '["e",{"pluribus":"unum"}]'
-
-
-            text = JSON.stringify(['e', {pluribus: 'unum'}], null, '\t');
-            // text is '[\n\t"e",\n\t{\n\t\t"pluribus": "unum"\n\t}\n]'
-
-            text = JSON.stringify([new Date()], function (key, value) {
-                return this[key] instanceof Date ?
-                    'Date(' + this[key] + ')' : value;
-            });
-            // text is '["Date(---current time---)"]'
-
-
-        JSON.parse(text, reviver)
-            This method parses a JSON text to produce an object or array.
-            It can throw a SyntaxError exception.
-
-            The optional reviver parameter is a function that can filter and
-            transform the results. It receives each of the keys and values,
-            and its return value is used instead of the original value.
-            If it returns what it received, then the structure is not modified.
-            If it returns undefined then the member is deleted.
-
-            Example:
-
-            // Parse the text. Values that look like ISO date strings will
-            // be converted to Date objects.
-
-            myData = JSON.parse(text, function (key, value) {
-                var a;
-                if (typeof value === 'string') {
-                    a =
-/^(\d{4})-(\d{2})-(\d{2})T(\d{2}):(\d{2}):(\d{2}(?:\.\d*)?)Z$/.exec(value);
-                    if (a) {
-                        return new Date(Date.UTC(+a[1], +a[2] - 1, +a[3], +a[4],
-                            +a[5], +a[6]));
-                    }
-                }
-                return value;
-            });
-
-            myData = JSON.parse('["Date(09/09/2001)"]', function (key, value) {
-                var d;
-                if (typeof value === 'string' &&
-                        value.slice(0, 5) === 'Date(' &&
-                        value.slice(-1) === ')') {
-                    d = new Date(value.slice(5, -1));
-                    if (d) {
-                        return d;
-                    }
-                }
-                return value;
-            });
-
-
-    This is a reference implementation. You are free to copy, modify, or
-    redistribute.
-*/
-
-/*jslint evil: true, strict: false */
-
-/*members "", "\b", "\t", "\n", "\f", "\r", "\"", JSON, "\\", apply,
-    call, charCodeAt, getUTCDate, getUTCFullYear, getUTCHours,
-    getUTCMinutes, getUTCMonth, getUTCSeconds, hasOwnProperty, join,
-    lastIndex, length, parse, prototype, push, replace, slice, stringify,
-    test, toJSON, toString, valueOf
-*/
-
-
-// Create a JSON object only if one does not already exist. We create the
-// methods in a closure to avoid creating global variables.
-
-if (!this.JSON) {
-    this.JSON = {};
-}
-
-(function () {
-
-    function f(n) {
-        // Format integers to have at least two digits.
-        return n < 10 ? '0' + n : n;
-    }
-
-    if (typeof Date.prototype.toJSON !== 'function') {
-
-        Date.prototype.toJSON = function (key) {
-
-            return isFinite(this.valueOf()) ?
-                   this.getUTCFullYear()   + '-' +
-                 f(this.getUTCMonth() + 1) + '-' +
-                 f(this.getUTCDate())      + 'T' +
-                 f(this.getUTCHours())     + ':' +
-                 f(this.getUTCMinutes())   + ':' +
-                 f(this.getUTCSeconds())   + 'Z' : null;
-        };
-
-        String.prototype.toJSON =
-        Number.prototype.toJSON =
-        Boolean.prototype.toJSON = function (key) {
-            return this.valueOf();
-        };
-    }
-
-    var cx = /[\u0000\u00ad\u0600-\u0604\u070f\u17b4\u17b5\u200c-\u200f\u2028-\u202f\u2060-\u206f\ufeff\ufff0-\uffff]/g,
-        escapable = /[\\\"\x00-\x1f\x7f-\x9f\u00ad\u0600-\u0604\u070f\u17b4\u17b5\u200c-\u200f\u2028-\u202f\u2060-\u206f\ufeff\ufff0-\uffff]/g,
-        gap,
-        indent,
-        meta = {    // table of character substitutions
-            '\b': '\\b',
-            '\t': '\\t',
-            '\n': '\\n',
-            '\f': '\\f',
-            '\r': '\\r',
-            '"' : '\\"',
-            '\\': '\\\\'
-        },
-        rep;
-
-
-    function quote(string) {
-
-// If the string contains no control characters, no quote characters, and no
-// backslash characters, then we can safely slap some quotes around it.
-// Otherwise we must also replace the offending characters with safe escape
-// sequences.
-
-        escapable.lastIndex = 0;
-        return escapable.test(string) ?
-            '"' + string.replace(escapable, function (a) {
-                var c = meta[a];
-                return typeof c === 'string' ? c :
-                    '\\u' + ('0000' + a.charCodeAt(0).toString(16)).slice(-4);
-            }) + '"' :
-            '"' + string + '"';
-    }
-
-
-    function str(key, holder) {
-
-// Produce a string from holder[key].
-
-        var i,          // The loop counter.
-            k,          // The member key.
-            v,          // The member value.
-            length,
-            mind = gap,
-            partial,
-            value = holder[key];
-
-// If the value has a toJSON method, call it to obtain a replacement value.
-
-        if (value && typeof value === 'object' &&
-                typeof value.toJSON === 'function') {
-            value = value.toJSON(key);
-        }
-
-// If we were called with a replacer function, then call the replacer to
-// obtain a replacement value.
-
-        if (typeof rep === 'function') {
-            value = rep.call(holder, key, value);
-        }
-
-// What happens next depends on the value's type.
-
-        switch (typeof value) {
-        case 'string':
-            return quote(value);
-
-        case 'number':
-
-// JSON numbers must be finite. Encode non-finite numbers as null.
-
-            return isFinite(value) ? String(value) : 'null';
-
-        case 'boolean':
-        case 'null':
-
-// If the value is a boolean or null, convert it to a string. Note:
-// typeof null does not produce 'null'. The case is included here in
-// the remote chance that this gets fixed someday.
-
-            return String(value);
-
-// If the type is 'object', we might be dealing with an object or an array or
-// null.
-
-        case 'object':
-
-// Due to a specification blunder in ECMAScript, typeof null is 'object',
-// so watch out for that case.
-
-            if (!value) {
-                return 'null';
-            }
-
-// Make an array to hold the partial results of stringifying this object value.
-
-            gap += indent;
-            partial = [];
-
-// Is the value an array?
-
-            if (Object.prototype.toString.apply(value) === '[object Array]') {
-
-// The value is an array. Stringify every element. Use null as a placeholder
-// for non-JSON values.
-
-                length = value.length;
-                for (i = 0; i < length; i += 1) {
-                    partial[i] = str(i, value) || 'null';
-                }
-
-// Join all of the elements together, separated with commas, and wrap them in
-// brackets.
-
-                v = partial.length === 0 ? '[]' :
-                    gap ? '[\n' + gap +
-                            partial.join(',\n' + gap) + '\n' +
-                                mind + ']' :
-                          '[' + partial.join(',') + ']';
-                gap = mind;
-                return v;
-            }
-
-// If the replacer is an array, use it to select the members to be stringified.
-
-            if (rep && typeof rep === 'object') {
-                length = rep.length;
-                for (i = 0; i < length; i += 1) {
-                    k = rep[i];
-                    if (typeof k === 'string') {
-                        v = str(k, value);
-                        if (v) {
-                            partial.push(quote(k) + (gap ? ': ' : ':') + v);
-                        }
-                    }
-                }
-            } else {
-
-// Otherwise, iterate through all of the keys in the object.
-
-                for (k in value) {
-                    if (Object.hasOwnProperty.call(value, k)) {
-                        v = str(k, value);
-                        if (v) {
-                            partial.push(quote(k) + (gap ? ': ' : ':') + v);
-                        }
-                    }
-                }
-            }
-
-// Join all of the member texts together, separated with commas,
-// and wrap them in braces.
-
-            v = partial.length === 0 ? '{}' :
-                gap ? '{\n' + gap + partial.join(',\n' + gap) + '\n' +
-                        mind + '}' : '{' + partial.join(',') + '}';
-            gap = mind;
-            return v;
-        }
-    }
-
-// If the JSON object does not yet have a stringify method, give it one.
-
-    if (typeof JSON.stringify !== 'function') {
-        JSON.stringify = function (value, replacer, space) {
-
-// The stringify method takes a value and an optional replacer, and an optional
-// space parameter, and returns a JSON text. The replacer can be a function
-// that can replace values, or an array of strings that will select the keys.
-// A default replacer method can be provided. Use of the space parameter can
-// produce text that is more easily readable.
-
-            var i;
-            gap = '';
-            indent = '';
-
-// If the space parameter is a number, make an indent string containing that
-// many spaces.
-
-            if (typeof space === 'number') {
-                for (i = 0; i < space; i += 1) {
-                    indent += ' ';
-                }
-
-// If the space parameter is a string, it will be used as the indent string.
-
-            } else if (typeof space === 'string') {
-                indent = space;
-            }
-
-// If there is a replacer, it must be a function or an array.
-// Otherwise, throw an error.
-
-            rep = replacer;
-            if (replacer && typeof replacer !== 'function' &&
-                    (typeof replacer !== 'object' ||
-                     typeof replacer.length !== 'number')) {
-                throw new Error('JSON.stringify');
-            }
-
-// Make a fake root object containing our value under the key of ''.
-// Return the result of stringifying the value.
-
-            return str('', {'': value});
-        };
-    }
-
-
-// If the JSON object does not yet have a parse method, give it one.
-
-    if (typeof JSON.parse !== 'function') {
-        JSON.parse = function (text, reviver) {
-
-// The parse method takes a text and an optional reviver function, and returns
-// a JavaScript value if the text is a valid JSON text.
-
-            var j;
-
-            function walk(holder, key) {
-
-// The walk method is used to recursively walk the resulting structure so
-// that modifications can be made.
-
-                var k, v, value = holder[key];
-                if (value && typeof value === 'object') {
-                    for (k in value) {
-                        if (Object.hasOwnProperty.call(value, k)) {
-                            v = walk(value, k);
-                            if (v !== undefined) {
-                                value[k] = v;
-                            } else {
-                                delete value[k];
-                            }
-                        }
-                    }
-                }
-                return reviver.call(holder, key, value);
-            }
-
-
-// Parsing happens in four stages. In the first stage, we replace certain
-// Unicode characters with escape sequences. JavaScript handles many characters
-// incorrectly, either silently deleting them, or treating them as line endings.
-
-            text = String(text);
-            cx.lastIndex = 0;
-            if (cx.test(text)) {
-                text = text.replace(cx, function (a) {
-                    return '\\u' +
-                        ('0000' + a.charCodeAt(0).toString(16)).slice(-4);
-                });
-            }
-
-// In the second stage, we run the text against regular expressions that look
-// for non-JSON patterns. We are especially concerned with '()' and 'new'
-// because they can cause invocation, and '=' because it can cause mutation.
-// But just to be safe, we want to reject all unexpected forms.
-
-// We split the second stage into 4 regexp operations in order to work around
-// crippling inefficiencies in IE's and Safari's regexp engines. First we
-// replace the JSON backslash pairs with '@' (a non-JSON character). Second, we
-// replace all simple value tokens with ']' characters. Third, we delete all
-// open brackets that follow a colon or comma or that begin the text. Finally,
-// we look to see that the remaining characters are only whitespace or ']' or
-// ',' or ':' or '{' or '}'. If that is so, then the text is safe for eval.
-
-            if (/^[\],:{}\s]*$/
-.test(text.replace(/\\(?:["\\\/bfnrt]|u[0-9a-fA-F]{4})/g, '@')
-.replace(/"[^"\\\n\r]*"|true|false|null|-?\d+(?:\.\d*)?(?:[eE][+\-]?\d+)?/g, ']')
-.replace(/(?:^|:|,)(?:\s*\[)+/g, ''))) {
-
-// In the third stage we use the eval function to compile the text into a
-// JavaScript structure. The '{' operator is subject to a syntactic ambiguity
-// in JavaScript: it can begin a block or an object literal. We wrap the text
-// in parens to eliminate the ambiguity.
-
-                j = eval('(' + text + ')');
-
-// In the optional fourth stage, we recursively walk the new structure, passing
-// each name/value pair to a reviver function for possible transformation.
-
-                return typeof reviver === 'function' ?
-                    walk({'': j}, '') : j;
-            }
-
-// If the text is not JSON parseable, then a SyntaxError is thrown.
-
-            throw new SyntaxError('JSON.parse');
-        };
-    }
-}());
-
diff --git a/code/lambda-test.js b/code/lambda-test.js
deleted file mode 100644 (file)
index 8f5fe4a..0000000
+++ /dev/null
@@ -1,651 +0,0 @@
-load("lambda.js");
-
-
-var g_eta = false;
-var g_cbv = false;
-
-function to_int(expr) {
-       var reduced = reduce(expr, g_eta, g_cbv);
-       if (reduced.to_int) {
-               return reduce(reduced, false, false).to_int(0);
-       } else {
-               return "not a church numeral";
-       }
-}
-
-function to_string(expr) {
-       var reduced = reduce(expr, g_eta, g_cbv);
-       return reduced.to_string();
-}
-
-
-function test() {
-
-       function make_lam2(a, b, aa) {
-               return make_lam(a, make_lam(b, aa));
-       }
-       function make_lam3(a, b, c, aa) {
-               return make_lam(a, make_lam(b, make_lam(c, aa)));
-       }
-       function make_lam4(a, b, c, d, aa) {
-               return make_lam(a, make_lam(b, make_lam(c, make_lam(d, aa))));
-       }
-       function make_lam5(a, b, c, d, e, aa) {
-               return make_lam(a, make_lam(b, make_lam(c, make_lam(d, make_lam(e, aa)))));
-       }
-       function make_app3(aa, bb, cc) {
-               return make_app(make_app(aa, bb), cc);
-       }
-       function make_app4(aa, bb, cc, dd) {
-               return make_app(make_app(make_app(aa, bb), cc), dd);
-       }
-       function make_app5(aa, bb, cc, dd, ee) {
-               return make_app(make_app(make_app(make_app(aa, bb), cc), dd), ee);
-       }
-
-       var s = make_var("s");
-       var z = make_var("z");
-       var m = make_var("m");
-       var n = make_var("n");
-       var u = make_var("u");
-       var v = make_var("v");
-       var d = make_var("d");
-       var ss = new Lambda_var(s);
-       var zz = new Lambda_var(z);
-       var mm = new Lambda_var(m);
-       var nn = new Lambda_var(n);
-       var uu = new Lambda_var(u);
-       var vv = new Lambda_var(v);
-       var dd = new Lambda_var(d);
-       var succ = make_lam3(m, s, z, make_app(ss, make_app3(mm, ss, zz)));
-       var tt = make_lam2(m, n, mm);
-       var ff = make_lam2(m, n, nn);
-       var kk = tt;
-       var get1 = tt;
-       var get2 = ff;
-       var id = make_lam(s, ss);
-       var ww = make_lam(s, make_app(ss, ss));
-       var pair = make_lam3(m, n, s, make_app3(ss, mm, nn));
-       var zero = make_lam2(s, z, zz);
-       var one = make_lam2(s, z, make_app(ss, zz));
-       var two = make_lam2(s, z, make_app(ss, make_app(ss, zz)));
-       var three = make_lam2(s, z, make_app(ss, make_app(ss, make_app(ss, zz))));
-       var four = make_lam2(s, z, make_app(ss, make_app(ss, make_app(ss, make_app(ss, zz)))));
-       var five = make_lam2(s, z, make_app(ss, make_app(ss, make_app(ss, make_app(ss, make_app(ss, zz))))));
-       var iszero = make_lam(m, make_app3(mm, make_lam(s, ff), tt));
-       var add = make_lam2(m, n, make_app3(mm, succ, nn));
-       var mul = make_lam3(m, n, s, make_app(mm, make_app(nn, ss)));
-       var pred1 = make_lam3(n, s, z, make_app4(nn, make_lam2(u, v, make_app(vv, make_app(uu, ss))), make_app(kk, zz), id));
-
-       var shift = make_lam(s, make_app(ss, make_lam2(m, n, make_app3(pair, make_app(succ, mm), mm))));
-       var pred2 = make_lam(n, make_app4(nn, shift, make_app3(pair, zero, zero), get2));
-
-
-       function make_sub() {
-               var mzero = make_app(make_app(pair, zero), id);
-               var msucc = make_lam(s, make_app(ss, make_lam(m, make_lam(n, make_app(make_app(pair, make_app(succ, mm)), make_app(kk, ss))))));
-               var mtail = make_lam(s, make_app(make_app(ss, get2), ss));
-               return make_lam(m, make_lam(n, make_app(make_app(make_app(nn, mtail), make_app(make_app(mm, msucc), mzero)), get1)));
-       }
-       var sub = make_sub();
-
-       var min = make_lam(m, make_lam(n, make_app(make_app(sub, mm), make_app(make_app(sub, mm), nn))));
-       var max = make_lam(m, make_lam(n, make_app(make_app(add, nn), make_app(make_app(sub, mm), nn))));
-
-       function make_lt() {
-               var mzero = make_app(make_app(pair, zero), id);
-               var msucc = make_lam(s, make_app(ss, make_lam(m, make_lam(n, make_app(make_app(pair, make_app(succ, mm)), make_app(kk, ss))))));
-               var mtail = make_lam(s, make_app(make_app(ss, get2), ss));
-               return make_lam(n, make_lam(m, make_app(make_app(make_app(make_app(make_app(nn, mtail), make_app(make_app(mm, msucc), mzero)), get1), make_lam(s, tt)), ff)));
-       }
-       var lt = make_lt();
-
-       function make_leq() {
-               var mzero = make_app(make_app(pair, zero), id);
-               var msucc = make_lam(s, make_app(ss, make_lam(m, make_lam(n, make_app(make_app(pair, make_app(succ, mm)), make_app(kk, ss))))));
-               var mtail = make_lam(s, make_app(make_app(ss, get2), ss));
-               return make_lam(m, make_lam(n, make_app(make_app(make_app(make_app(make_app(nn, mtail), make_app(make_app(mm, msucc), mzero)), get1), make_lam(s, ff)), tt)));
-       }
-       var leq = make_leq();
-
-       function make_eq() {
-               var mzero = make_app(make_app(pair, zero), make_app(kk, make_app(make_app(pair, one), id)));
-               var msucc = make_lam(s, make_app(ss, make_lam(m, make_lam(n, make_app(make_app(pair, make_app(succ, mm)), make_app(kk, ss))))));
-               var mtail = make_lam(s, make_app(make_app(ss, get2), ss));
-               return make_lam(m, make_lam(n, make_app(make_app(make_app(make_app(make_app(nn, mtail), make_app(make_app(mm, msucc), mzero)), get1), make_lam(s, ff)), tt)));
-       }
-       var eq = make_eq();
-
-       function make_divmod() {
-               var triple = make_lam4(m, n, z, s, make_app4(ss, mm, nn, zz));
-               var mzero = make_app4(triple, succ, make_app(kk, zero), id);
-               var msucc = make_lam(u, make_app4(triple, id, succ, make_app(kk, uu)));
-               // mtail is open in d
-               var mtail = make_lam(s, make_app(ss, make_lam5(m, n, u, v, z, make_lam(s, make_app3(zz, dd, make_app3(ss, make_app(uu, mm), make_app(vv, nn)))))));
-               var res = make_lam2(n, u, make_app3(
-                               make_lam(d, make_app3(nn, mtail, make_lam(s, make_app(dd, make_app3(ss, zero, zero))))),
-                               make_app4(uu, msucc, mzero, make_lam3(m, n, s, make_app(ss, zz))),
-                               make_lam5(m, n, u, v, s, make_app3(pair, mm, nn))
-                       ));
-               return res;
-       }
-       var divmod = make_divmod();
-       var div = make_lam2(n, m, make_app4(divmod, nn, mm, get1));
-       var mod = make_lam2(n, m, make_app4(divmod, nn, mm, get2));
-
-       var yhalf = make_lam(u, make_app(vv, make_app(uu, uu)));
-       var y = make_lam(v, make_app(yhalf, yhalf));
-       var yyhalf = make_lam(u, make_app(vv, make_lam(n, make_app3(uu, uu, nn))))
-       var yy = make_lam(v, make_app(yyhalf, yyhalf));
-
-       var turinghalf = make_lam2(u, v, make_app(vv, make_app3(uu, uu, vv)));
-       var turing = make_app(turinghalf, turinghalf);
-       var tturinghalf = make_lam2(u, v, make_app(vv, make_lam(m, make_app4(uu, uu, vv, mm))));
-       var tturing = make_app(tturinghalf, tturinghalf);
-
-       var ifzero = make_lam(n, make_app4(nn, make_lam2(u, v, make_app(vv, make_app(uu, succ))), make_app(kk, zero), make_lam3(m, s, z, make_app(ss, mm) )));
-
-       var fact1 = make_app(ww, make_lam2(u, n, make_app4(ifzero, nn, make_lam(s, make_app3(mul, nn, make_app3(uu, uu, ss))), one)));
-       function make_fact(y) {
-               return make_app(y, make_lam2(u, n, make_app4(ifzero, nn, make_lam(s, make_app3(mul, nn, make_app(uu, ss))), one)));
-       }
-       var fact2 = make_fact(y);
-       var fact3 = make_fact(yy);
-       var fact4 = make_fact(turing);
-       var fact5 = make_fact(tturing);
-
-       function check(expect, formula) {
-               var i = to_int(formula);
-               print(expect, expect === i);
-       }
-
-       function checkbool(expect, index, formula) {
-               if (expect) {
-                       print(index, equal(reduce(formula, g_eta, g_cbv), tt));
-               } else {
-                       print(index, equal(reduce(formula, g_eta, g_cbv), ff));
-               }
-       }
-
-       check(0, zero);
-       check(1, one);
-       check(2, two);
-       check(3, three);
-       check(4, four);
-       check(5, five);
-
-       check(1, make_app(succ, zero));
-       check(2, make_app(succ, make_app(succ, zero)));
-       check(3, make_app(succ, make_app(succ, make_app(succ, zero))));
-       check(4, make_app(succ, make_app(succ, make_app(succ, make_app(succ, zero)))));
-       check(5, make_app(succ, make_app(succ, make_app(succ, make_app(succ, make_app(succ, zero))))));
-
-
-       check(2, make_app(succ, one));
-       check(3, make_app(succ, make_app(succ, one)));
-       check(4, make_app(succ, make_app(succ, make_app(succ, one))));
-       check(5, make_app(succ, make_app(succ, make_app(succ, make_app(succ, one)))));
-
-       check(3, make_app(succ, two));
-       check(4, make_app(succ, make_app(succ, two)));
-       check(5, make_app(succ, make_app(succ, make_app(succ, two))));
-
-       print("checking iszero");
-       checkbool(true, 0, make_app(iszero, zero));
-       checkbool(true, 1, make_app(iszero, one));
-       checkbool(true, 2, make_app(iszero, two));
-       checkbool(true, 3, make_app(iszero, three));
-       checkbool(true, 4, make_app(iszero, four));
-       checkbool(true, 5, make_app(iszero, five));
-
-       print("checking add");
-       check(0, make_app(make_app(add, zero), zero));
-       check(1, make_app(make_app(add, zero), one));
-       check(2, make_app(make_app(add, zero), two));
-       check(3, make_app(make_app(add, zero), three));
-       check(4, make_app(make_app(add, zero), four));
-       check(5, make_app(make_app(add, zero), five));
-       check(1, make_app(make_app(add, one), zero));
-       check(2, make_app(make_app(add, one), one));
-       check(3, make_app(make_app(add, one), two));
-       check(4, make_app(make_app(add, one), three));
-       check(5, make_app(make_app(add, one), four));
-       check(6, make_app(make_app(add, one), five));
-       check(2, make_app(make_app(add, two), zero));
-       check(3, make_app(make_app(add, two), one));
-       check(4, make_app(make_app(add, two), two));
-       check(5, make_app(make_app(add, two), three));
-       check(6, make_app(make_app(add, two), four));
-       check(7, make_app(make_app(add, two), five));
-       check(3, make_app(make_app(add, three), zero));
-       check(4, make_app(make_app(add, three), one));
-       check(5, make_app(make_app(add, three), two));
-       check(6, make_app(make_app(add, three), three));
-       check(7, make_app(make_app(add, three), four));
-       check(8, make_app(make_app(add, three), five));
-       check(4, make_app(make_app(add, four), zero));
-       check(5, make_app(make_app(add, four), one));
-       check(6, make_app(make_app(add, four), two));
-       check(7, make_app(make_app(add, four), three));
-       check(8, make_app(make_app(add, four), four));
-       check(9, make_app(make_app(add, four), five));
-
-       print("checking mul");
-       check(0, make_app(make_app(mul, zero), zero));
-       check(0, make_app(make_app(mul, zero), one));
-       check(0, make_app(make_app(mul, zero), two));
-       check(0, make_app(make_app(mul, zero), three));
-       check(0, make_app(make_app(mul, zero), four));
-       check(0, make_app(make_app(mul, zero), five));
-       check(0, make_app(make_app(mul, one), zero));
-       check(1, make_app(make_app(mul, one), one));
-       check(2, make_app(make_app(mul, one), two));
-       check(3, make_app(make_app(mul, one), three));
-       check(4, make_app(make_app(mul, one), four));
-       check(5, make_app(make_app(mul, one), five));
-       check(0, make_app(make_app(mul, two), zero));
-       check(2, make_app(make_app(mul, two), one));
-       check(4, make_app(make_app(mul, two), two));
-       check(6, make_app(make_app(mul, two), three));
-       check(8, make_app(make_app(mul, two), four));
-       check(10, make_app(make_app(mul, two), five));
-       check(0, make_app(make_app(mul, three), zero));
-       check(3, make_app(make_app(mul, three), one));
-       check(6, make_app(make_app(mul, three), two));
-       check(9, make_app(make_app(mul, three), three));
-       check(12, make_app(make_app(mul, three), four));
-       check(15, make_app(make_app(mul, three), five));
-       check(0, make_app(make_app(mul, four), zero));
-       check(4, make_app(make_app(mul, four), one));
-       check(8, make_app(make_app(mul, four), two));
-       check(12, make_app(make_app(mul, four), three));
-       check(16, make_app(make_app(mul, four), four));
-       check(20, make_app(make_app(mul, four), five));
-
-
-       function check_pred(pred) {
-               check(0, make_app(pred, zero));
-               check(0, make_app(pred, make_app(pred, zero)));
-               check(0, make_app(pred, make_app(pred, make_app(pred, zero))));
-               check(0, make_app(pred, make_app(pred, make_app(pred, make_app(pred, zero)))));
-               check(0, make_app(pred, make_app(pred, make_app(pred, make_app(pred, make_app(pred, zero))))));
-
-               check(0, make_app(pred, one));
-               check(0, make_app(pred, make_app(pred, one)));
-               check(0, make_app(pred, make_app(pred, make_app(pred, one))));
-               check(0, make_app(pred, make_app(pred, make_app(pred, make_app(pred, one)))));
-               check(0, make_app(pred, make_app(pred, make_app(pred, make_app(pred, make_app(pred, one))))));
-
-               check(1, make_app(pred, two));
-               check(0, make_app(pred, make_app(pred, two)));
-               check(0, make_app(pred, make_app(pred, make_app(pred, two))));
-               check(0, make_app(pred, make_app(pred, make_app(pred, make_app(pred, two)))));
-               check(0, make_app(pred, make_app(pred, make_app(pred, make_app(pred, make_app(pred, two))))));
-
-               check(2, make_app(pred, three));
-               check(1, make_app(pred, make_app(pred, three)));
-               check(0, make_app(pred, make_app(pred, make_app(pred, three))));
-               check(0, make_app(pred, make_app(pred, make_app(pred, make_app(pred, three)))));
-               check(0, make_app(pred, make_app(pred, make_app(pred, make_app(pred, make_app(pred, three))))));
-
-               check(3, make_app(pred, four));
-               check(2, make_app(pred, make_app(pred, four)));
-               check(1, make_app(pred, make_app(pred, make_app(pred, four))));
-               check(0, make_app(pred, make_app(pred, make_app(pred, make_app(pred, four)))));
-               check(0, make_app(pred, make_app(pred, make_app(pred, make_app(pred, make_app(pred, four))))));
-
-               check(4, make_app(pred, five));
-               check(3, make_app(pred, make_app(pred, five)));
-               check(2, make_app(pred, make_app(pred, make_app(pred, five))));
-               check(1, make_app(pred, make_app(pred, make_app(pred, make_app(pred, five)))));
-               check(0, make_app(pred, make_app(pred, make_app(pred, make_app(pred, make_app(pred, five))))));
-       }
-
-       print("checking pred1");
-       check_pred(pred1);
-
-       print("checking pred2");
-       check_pred(pred2);
-
-       print("checking sub");
-       check(0, make_app(make_app(sub, zero), zero));
-       check(0, make_app(make_app(sub, zero), one));
-       check(0, make_app(make_app(sub, zero), two));
-       check(0, make_app(make_app(sub, zero), three));
-       check(0, make_app(make_app(sub, zero), four));
-       check(0, make_app(make_app(sub, zero), five));
-       check(1, make_app(make_app(sub, one), zero));
-       check(0, make_app(make_app(sub, one), one));
-       check(0, make_app(make_app(sub, one), two));
-       check(0, make_app(make_app(sub, one), three));
-       check(0, make_app(make_app(sub, one), four));
-       check(0, make_app(make_app(sub, one), five));
-       check(2, make_app(make_app(sub, two), zero));
-       check(1, make_app(make_app(sub, two), one));
-       check(0, make_app(make_app(sub, two), two));
-       check(0, make_app(make_app(sub, two), three));
-       check(0, make_app(make_app(sub, two), four));
-       check(0, make_app(make_app(sub, two), five));
-       check(3, make_app(make_app(sub, three), zero));
-       check(2, make_app(make_app(sub, three), one));
-       check(1, make_app(make_app(sub, three), two));
-       check(0, make_app(make_app(sub, three), three));
-       check(0, make_app(make_app(sub, three), four));
-       check(0, make_app(make_app(sub, three), five));
-       check(4, make_app(make_app(sub, four), zero));
-       check(3, make_app(make_app(sub, four), one));
-       check(2, make_app(make_app(sub, four), two));
-       check(1, make_app(make_app(sub, four), three));
-       check(0, make_app(make_app(sub, four), four));
-       check(0, make_app(make_app(sub, four), five));
-       check(5, make_app(make_app(sub, five), zero));
-       check(4, make_app(make_app(sub, five), one));
-       check(3, make_app(make_app(sub, five), two));
-       check(2, make_app(make_app(sub, five), three));
-       check(1, make_app(make_app(sub, five), four));
-       check(0, make_app(make_app(sub, five), five));
-
-       print("checking min");
-       check(0, make_app(make_app(min, zero), zero));
-       check(0, make_app(make_app(min, zero), one));
-       check(0, make_app(make_app(min, zero), two));
-       check(0, make_app(make_app(min, zero), three));
-       check(0, make_app(make_app(min, zero), four));
-       check(0, make_app(make_app(min, zero), five));
-       check(0, make_app(make_app(min, one), zero));
-       check(1, make_app(make_app(min, one), one));
-       check(1, make_app(make_app(min, one), two));
-       check(1, make_app(make_app(min, one), three));
-       check(1, make_app(make_app(min, one), four));
-       check(1, make_app(make_app(min, one), five));
-       check(0, make_app(make_app(min, two), zero));
-       check(1, make_app(make_app(min, two), one));
-       check(2, make_app(make_app(min, two), two));
-       check(2, make_app(make_app(min, two), three));
-       check(2, make_app(make_app(min, two), four));
-       check(2, make_app(make_app(min, two), five));
-       check(0, make_app(make_app(min, three), zero));
-       check(1, make_app(make_app(min, three), one));
-       check(2, make_app(make_app(min, three), two));
-       check(3, make_app(make_app(min, three), three));
-       check(3, make_app(make_app(min, three), four));
-       check(3, make_app(make_app(min, three), five));
-       check(0, make_app(make_app(min, four), zero));
-       check(1, make_app(make_app(min, four), one));
-       check(2, make_app(make_app(min, four), two));
-       check(3, make_app(make_app(min, four), three));
-       check(4, make_app(make_app(min, four), four));
-       check(4, make_app(make_app(min, four), five));
-       check(0, make_app(make_app(min, five), zero));
-       check(1, make_app(make_app(min, five), one));
-       check(2, make_app(make_app(min, five), two));
-       check(3, make_app(make_app(min, five), three));
-       check(4, make_app(make_app(min, five), four));
-       check(5, make_app(make_app(min, five), five));
-
-       print("checking max");
-       check(0, make_app(make_app(max, zero), zero));
-       check(1, make_app(make_app(max, zero), one));
-       check(2, make_app(make_app(max, zero), two));
-       check(3, make_app(make_app(max, zero), three));
-       check(4, make_app(make_app(max, zero), four));
-       check(5, make_app(make_app(max, zero), five));
-       check(1, make_app(make_app(max, one), zero));
-       check(1, make_app(make_app(max, one), one));
-       check(2, make_app(make_app(max, one), two));
-       check(3, make_app(make_app(max, one), three));
-       check(4, make_app(make_app(max, one), four));
-       check(5, make_app(make_app(max, one), five));
-       check(2, make_app(make_app(max, two), zero));
-       check(2, make_app(make_app(max, two), one));
-       check(2, make_app(make_app(max, two), two));
-       check(3, make_app(make_app(max, two), three));
-       check(4, make_app(make_app(max, two), four));
-       check(5, make_app(make_app(max, two), five));
-       check(3, make_app(make_app(max, three), zero));
-       check(3, make_app(make_app(max, three), one));
-       check(3, make_app(make_app(max, three), two));
-       check(3, make_app(make_app(max, three), three));
-       check(4, make_app(make_app(max, three), four));
-       check(5, make_app(make_app(max, three), five));
-       check(4, make_app(make_app(max, four), zero));
-       check(4, make_app(make_app(max, four), one));
-       check(4, make_app(make_app(max, four), two));
-       check(4, make_app(make_app(max, four), three));
-       check(4, make_app(make_app(max, four), four));
-       check(5, make_app(make_app(max, four), five));
-       check(5, make_app(make_app(max, five), zero));
-       check(5, make_app(make_app(max, five), one));
-       check(5, make_app(make_app(max, five), two));
-       check(5, make_app(make_app(max, five), three));
-       check(5, make_app(make_app(max, five), four));
-       check(5, make_app(make_app(max, five), five));
-
-       print("checking lt");
-       checkbool(false, 0, make_app(make_app(lt, zero), zero));
-       checkbool(true, 0, make_app(make_app(lt, zero), one));
-       checkbool(true, 0, make_app(make_app(lt, zero), two));
-       checkbool(true, 0, make_app(make_app(lt, zero), three));
-       checkbool(true, 0, make_app(make_app(lt, zero), four));
-       checkbool(true, 0, make_app(make_app(lt, zero), five));
-       checkbool(false, 1, make_app(make_app(lt, one), zero));
-       checkbool(false, 1, make_app(make_app(lt, one), one));
-       checkbool(true, 1, make_app(make_app(lt, one), two));
-       checkbool(true, 1, make_app(make_app(lt, one), three));
-       checkbool(true, 1, make_app(make_app(lt, one), four));
-       checkbool(true, 1, make_app(make_app(lt, one), five));
-       checkbool(false, 2, make_app(make_app(lt, two), zero));
-       checkbool(false, 2, make_app(make_app(lt, two), one));
-       checkbool(false, 2, make_app(make_app(lt, two), two));
-       checkbool(true, 2, make_app(make_app(lt, two), three));
-       checkbool(true, 2, make_app(make_app(lt, two), four));
-       checkbool(true, 2, make_app(make_app(lt, two), five));
-       checkbool(false, 3, make_app(make_app(lt, three), zero));
-       checkbool(false, 3, make_app(make_app(lt, three), one));
-       checkbool(false, 3, make_app(make_app(lt, three), two));
-       checkbool(false, 3, make_app(make_app(lt, three), three));
-       checkbool(true, 3, make_app(make_app(lt, three), four));
-       checkbool(true, 3, make_app(make_app(lt, three), five));
-       checkbool(false, 4, make_app(make_app(lt, four), zero));
-       checkbool(false, 4, make_app(make_app(lt, four), one));
-       checkbool(false, 4, make_app(make_app(lt, four), two));
-       checkbool(false, 4, make_app(make_app(lt, four), three));
-       checkbool(false, 4, make_app(make_app(lt, four), four));
-       checkbool(true, 4, make_app(make_app(lt, four), five));
-       checkbool(false, 5, make_app(make_app(lt, five), zero));
-       checkbool(false, 5, make_app(make_app(lt, five), one));
-       checkbool(false, 5, make_app(make_app(lt, five), two));
-       checkbool(false, 5, make_app(make_app(lt, five), three));
-       checkbool(false, 5, make_app(make_app(lt, five), four));
-       checkbool(false, 5, make_app(make_app(lt, five), five));
-
-       print("checking leq");
-       checkbool(true, 0, make_app(make_app(leq, zero), zero));
-       checkbool(true, 0, make_app(make_app(leq, zero), one));
-       checkbool(true, 0, make_app(make_app(leq, zero), two));
-       checkbool(true, 0, make_app(make_app(leq, zero), three));
-       checkbool(true, 0, make_app(make_app(leq, zero), four));
-       checkbool(true, 0, make_app(make_app(leq, zero), five));
-       checkbool(false, 1, make_app(make_app(leq, one), zero));
-       checkbool(true, 1, make_app(make_app(leq, one), one));
-       checkbool(true, 1, make_app(make_app(leq, one), two));
-       checkbool(true, 1, make_app(make_app(leq, one), three));
-       checkbool(true, 1, make_app(make_app(leq, one), four));
-       checkbool(true, 1, make_app(make_app(leq, one), five));
-       checkbool(false, 2, make_app(make_app(leq, two), zero));
-       checkbool(false, 2, make_app(make_app(leq, two), one));
-       checkbool(true, 2, make_app(make_app(leq, two), two));
-       checkbool(true, 2, make_app(make_app(leq, two), three));
-       checkbool(true, 2, make_app(make_app(leq, two), four));
-       checkbool(true, 2, make_app(make_app(leq, two), five));
-       checkbool(false, 3, make_app(make_app(leq, three), zero));
-       checkbool(false, 3, make_app(make_app(leq, three), one));
-       checkbool(false, 3, make_app(make_app(leq, three), two));
-       checkbool(true, 3, make_app(make_app(leq, three), three));
-       checkbool(true, 3, make_app(make_app(leq, three), four));
-       checkbool(true, 3, make_app(make_app(leq, three), five));
-       checkbool(false, 4, make_app(make_app(leq, four), zero));
-       checkbool(false, 4, make_app(make_app(leq, four), one));
-       checkbool(false, 4, make_app(make_app(leq, four), two));
-       checkbool(false, 4, make_app(make_app(leq, four), three));
-       checkbool(true, 4, make_app(make_app(leq, four), four));
-       checkbool(true, 4, make_app(make_app(leq, four), five));
-       checkbool(false, 5, make_app(make_app(leq, five), zero));
-       checkbool(false, 5, make_app(make_app(leq, five), one));
-       checkbool(false, 5, make_app(make_app(leq, five), two));
-       checkbool(false, 5, make_app(make_app(leq, five), three));
-       checkbool(false, 5, make_app(make_app(leq, five), four));
-       checkbool(true, 5, make_app(make_app(leq, five), five));
-
-       print("checking eq");
-       checkbool(true, 0, make_app(make_app(eq, zero), zero));
-       checkbool(false, 0, make_app(make_app(eq, zero), one));
-       checkbool(false, 0, make_app(make_app(eq, zero), two));
-       checkbool(false, 0, make_app(make_app(eq, zero), three));
-       checkbool(false, 0, make_app(make_app(eq, zero), four));
-       checkbool(false, 0, make_app(make_app(eq, zero), five));
-       checkbool(false, 1, make_app(make_app(eq, one), zero));
-       checkbool(true, 1, make_app(make_app(eq, one), one));
-       checkbool(false, 1, make_app(make_app(eq, one), two));
-       checkbool(false, 1, make_app(make_app(eq, one), three));
-       checkbool(false, 1, make_app(make_app(eq, one), four));
-       checkbool(false, 1, make_app(make_app(eq, one), five));
-       checkbool(false, 2, make_app(make_app(eq, two), zero));
-       checkbool(false, 2, make_app(make_app(eq, two), one));
-       checkbool(true, 2, make_app(make_app(eq, two), two));
-       checkbool(false, 2, make_app(make_app(eq, two), three));
-       checkbool(false, 2, make_app(make_app(eq, two), four));
-       checkbool(false, 2, make_app(make_app(eq, two), five));
-       checkbool(false, 3, make_app(make_app(eq, three), zero));
-       checkbool(false, 3, make_app(make_app(eq, three), one));
-       checkbool(false, 3, make_app(make_app(eq, three), two));
-       checkbool(true, 3, make_app(make_app(eq, three), three));
-       checkbool(false, 3, make_app(make_app(eq, three), four));
-       checkbool(false, 3, make_app(make_app(eq, three), five));
-       checkbool(false, 4, make_app(make_app(eq, four), zero));
-       checkbool(false, 4, make_app(make_app(eq, four), one));
-       checkbool(false, 4, make_app(make_app(eq, four), two));
-       checkbool(false, 4, make_app(make_app(eq, four), three));
-       checkbool(true, 4, make_app(make_app(eq, four), four));
-       checkbool(false, 4, make_app(make_app(eq, four), five));
-       checkbool(false, 5, make_app(make_app(eq, five), zero));
-       checkbool(false, 5, make_app(make_app(eq, five), one));
-       checkbool(false, 5, make_app(make_app(eq, five), two));
-       checkbool(false, 5, make_app(make_app(eq, five), three));
-       checkbool(false, 5, make_app(make_app(eq, five), four));
-       checkbool(true, 5, make_app(make_app(eq, five), five));
-
-       print("checking div");
-       check(0, make_app(make_app(div, zero), one));
-       check(0, make_app(make_app(div, zero), two));
-       check(0, make_app(make_app(div, zero), three));
-       check(0, make_app(make_app(div, zero), four));
-       check(0, make_app(make_app(div, zero), five));
-       check(1, make_app(make_app(div, one), one));
-       check(0, make_app(make_app(div, one), two));
-       check(0, make_app(make_app(div, one), three));
-       check(0, make_app(make_app(div, one), four));
-       check(0, make_app(make_app(div, one), five));
-       check(2, make_app(make_app(div, two), one));
-       check(1, make_app(make_app(div, two), two));
-       check(0, make_app(make_app(div, two), three));
-       check(0, make_app(make_app(div, two), four));
-       check(0, make_app(make_app(div, two), five));
-       check(3, make_app(make_app(div, three), one));
-       check(1, make_app(make_app(div, three), two));
-       check(1, make_app(make_app(div, three), three));
-       check(0, make_app(make_app(div, three), four));
-       check(0, make_app(make_app(div, three), five));
-       check(4, make_app(make_app(div, four), one));
-       check(2, make_app(make_app(div, four), two));
-       check(1, make_app(make_app(div, four), three));
-       check(1, make_app(make_app(div, four), four));
-       check(0, make_app(make_app(div, four), five));
-       check(5, make_app(make_app(div, five), one));
-       check(2, make_app(make_app(div, five), two));
-       check(1, make_app(make_app(div, five), three));
-       check(1, make_app(make_app(div, five), four));
-       check(1, make_app(make_app(div, five), five));
-
-       print("checking mod");
-       check(0, make_app(make_app(mod, zero), one));
-       check(0, make_app(make_app(mod, zero), two));
-       check(0, make_app(make_app(mod, zero), three));
-       check(0, make_app(make_app(mod, zero), four));
-       check(0, make_app(make_app(mod, zero), five));
-       check(0, make_app(make_app(mod, one), one));
-       check(1, make_app(make_app(mod, one), two));
-       check(1, make_app(make_app(mod, one), three));
-       check(1, make_app(make_app(mod, one), four));
-       check(1, make_app(make_app(mod, one), five));
-       check(0, make_app(make_app(mod, two), one));
-       check(0, make_app(make_app(mod, two), two));
-       check(2, make_app(make_app(mod, two), three));
-       check(2, make_app(make_app(mod, two), four));
-       check(2, make_app(make_app(mod, two), five));
-       check(0, make_app(make_app(mod, three), one));
-       check(1, make_app(make_app(mod, three), two));
-       check(0, make_app(make_app(mod, three), three));
-       check(3, make_app(make_app(mod, three), four));
-       check(3, make_app(make_app(mod, three), five));
-       check(0, make_app(make_app(mod, four), one));
-       check(0, make_app(make_app(mod, four), two));
-       check(1, make_app(make_app(mod, four), three));
-       check(0, make_app(make_app(mod, four), four));
-       check(4, make_app(make_app(mod, four), five));
-       check(0, make_app(make_app(mod, five), one));
-       check(1, make_app(make_app(mod, five), two));
-       check(2, make_app(make_app(mod, five), three));
-       check(1, make_app(make_app(mod, five), four));
-       check(0, make_app(make_app(mod, five), five));
-
-       if (!g_cbv) {
-               print("checking fact1");
-               check(1, make_app(fact1, zero));
-               check(1, make_app(fact1, one));
-               check(2, make_app(fact1, two));
-               check(6, make_app(fact1, three));
-               check(24, make_app(fact1, four));
-       }
-
-       if (!g_cbv) {
-               print("checking fact2");
-               check(1, make_app(fact2, zero));
-               check(1, make_app(fact2, one));
-               check(2, make_app(fact2, two));
-               check(6, make_app(fact2, three));
-               check(24, make_app(fact2, four));
-       }
-
-       if (g_cbv<2) {
-               print("checking fact3");
-               check(1, make_app(fact3, zero));
-               check(1, make_app(fact3, one));
-               check(2, make_app(fact3, two));
-               check(6, make_app(fact3, three));
-               check(24, make_app(fact3, four));
-       }
-
-       if (!g_cbv) {
-               print("checking fact4");
-               check(1, make_app(fact4, zero));
-               check(1, make_app(fact4, one));
-               check(2, make_app(fact4, two));
-               check(6, make_app(fact4, three));
-               check(24, make_app(fact4, four));
-       }
-
-       if (g_cbv<2) {
-               print("checking fact5");
-               check(1, make_app(fact5, zero));
-               check(1, make_app(fact5, one));
-               check(2, make_app(fact5, two));
-               check(6, make_app(fact5, three));
-               check(24, make_app(fact5, four));
-       }
-
-}
-
-
-test();
-
diff --git a/code/lambda.js b/code/lambda.js
deleted file mode 100644 (file)
index 83ae7c4..0000000
+++ /dev/null
@@ -1,634 +0,0 @@
-/*jslint bitwise: true,
-    eqeqeq: true,
-    immed: true,
-    newcap: true,
-    nomen: true,
-    onevar: true,
-    plusplus: true,
-    regexp: true,
-    rhino: true,
-    browser: false,
-    undef: true,
-    white: true,
-
-    evil: false,
-    regexp: false,
-    sub: true,
-    laxbreak: true,
-    onevar: false,
-    debug: true */
-
-
-// DeBruijn terms
-// substitution and translation algorithms from Chris Hankin, An Introduction to Lambda Calculi for Comptuer Scientists
-//
-function Db_free(variable) {
-    this.variable = variable;
-    this.subst = function (m, new_term) {
-        return this;
-    };
-    this.renumber = function (m, i) {
-        return this;
-    };
-    // we assume that other will have variable iff it's a Db_free
-    this.equal = function (other) {
-        return other.variable && this.variable.equal(other.variable);
-    };
-    this.contains = this.equal;
-}
-
-function Db_index(i) {
-    this.index = i;
-    this.subst = function (m, new_term) {
-        if (this.index < m) {
-            return this;
-        } else if (this.index > m) {
-            return new Db_index(this.index - 1);
-        } else {
-            return new_term.renumber(this.index, 1);
-        }
-    };
-    this.renumber = function (m, i) {
-        if (this.index < i) {
-            return this;
-        } else {
-            return new Db_index(this.index + m - 1);
-        }
-    };
-    // we assume that other will have index iff it's a Db_index
-    this.equal = function (other) {
-        return this.index === other.index;
-    };
-    this.contains = this.equal;
-}
-
-function Db_app(left, right) {
-    this.left = left;
-    this.right = right;
-    this.subst = function (m, new_term) {
-        return new Db_app(this.left.subst(m, new_term), this.right.subst(m, new_term));
-    };
-    this.renumber = function (m, i) {
-        return new Db_app(this.left.renumber(m, i), this.right.renumber(m, i));
-    };
-    // we assume that other will have left iff it's a Db_app
-    this.equal = function (other) {
-        return other.left && this.left.equal(other.left) && this.right.equal(other.right);
-    };
-    this.contains = function (other) {
-        if (other.left && this.left.equal(other.left) && this.right.equal(other.right)) {
-            return true;
-        } else {
-            return this.left.contains(other) || this.right.contains(other);
-        }
-    };
-}
-
-function Db_lam(body) {
-    this.body = body;
-    this.subst = function (m, new_term) {
-        return new Db_lam(this.body.subst(m + 1, new_term));
-    };
-    this.renumber = function (m, i) {
-        return new Db_lam(this.body.renumber(m, i + 1));
-    };
-    // we assume that other will have body iff it's a Db_lam
-    this.equal = function (other) {
-        return other.body && this.body.equal(other.body);
-    };
-    this.contains = function (other) {
-        if (other.body && this.body.equal(other.body)) {
-            return true;
-        } else {
-            return this.body.contains(other);
-        }
-    };
-}
-
-
-// lambda terms
-// substitution and normal-order evaluator based on Haskell version by Oleg Kisleyov
-// http://okmij.org/ftp/Computation/lambda-calc.html#lambda-calculator-haskell
-//
-function Variable(name, tag) {
-    this.name = name;
-    this.tag = tag || 0;
-    this.to_string = function () {
-        // append count copies of str to accum
-//         function markup(accum, count) {
-//             if (count === 0) {
-//                 return accum;
-//             } else {
-//                 return markup(accum + "'", count - 1);
-//             }
-//         }
-//         return markup(this.name, this.tag);
-               var s = this.name;
-               for (var count = 0; count < this.tag; count += 1) {
-                       s += "'";
-               }
-               return s;
-    };
-    this.equal = function (other) {
-        return (this.tag === other.tag) && (this.name === other.name);
-    };
-    // position of this in seq
-    this.position = function (seq) {
-        for (var i = 0; i < seq.length; i += 1) {
-            if (this.equal(seq[i])) {
-                return new Db_index(i + 1);
-            }
-        }
-        return new Db_free(this);
-    };
-}
-
-// if v occurs free_in term, returns Some v' where v' is the highest-tagged
-// variable with the same name as v occurring (free or bound) in term
-//
-function free_in(v, term) {
-    var res = term.has_free(v);
-    return res[0] && res[1];
-}
-
-function subst(v, new_term, expr) {
-    if (new_term.variable && new_term.variable.equal(v)) {
-        return expr;
-    } else {
-        return expr.subst(v, new_term);
-    }
-}
-
-function equal(expr1, expr2) {
-    return expr1.debruijn([]).equal(expr2.debruijn([]));
-}
-
-function contains(expr1, expr2) {
-    return expr1.debruijn([]).contains(expr2.debruijn([]));
-}
-
-
-function Lambda_var(variable) {
-    this.variable = variable;
-    this.debruijn = function (seq) {
-        return this.variable.position(seq);
-    };
-    this.to_string = function (as_atom) {
-        return this.variable.to_string();
-    };
-    this.has_free = function (v) {
-        if (v.name !== this.variable.name) {
-            return [false, v];
-        } else if (v.tag === this.variable.tag) {
-            return [true, v];
-        } else {
-            return [false, this.variable];
-        }
-    };
-    this.subst = function (v, new_term) {
-        if (this.variable.equal(v)) {
-            return new_term;
-        } else {
-            return this;
-        }
-    };
-    this.check_eta = function () {
-        return this;
-    };
-    this.eval_loop = function (stack, eta) {
-        function unwind(left, stack) {
-//             if (stack.length === 0) {
-//                 return left;
-//             } else {
-//                 var x = stack[0];
-//                 var xs = stack.slice(1);
-//                 return unwind(new Lambda_app(left, x.eval_loop([], eta)), xs);
-//             }
-                       var res = left, x;
-                       while (stack.length) {
-                               x = stack.shift();
-                               // res = new Lambda_app(res, x.eval_loop([], eta));
-                               res = new Lambda_app(res, reduce(x, eta, false));
-                       }
-                       return res;
-        }
-        // return unwind(this, stack);
-               // trampoline to, args
-               return [null, unwind(this, stack)];
-    };
-    this.eval_cbv = function (aggressive) {
-        return this;
-    };
-}
-
-function Lambda_app(left, right) {
-    this.left = left;
-    this.right = right;
-    this.debruijn = function (seq) {
-        return new Db_app(this.left.debruijn(seq), this.right.debruijn(seq));
-    };
-    this.to_string = function (as_atom) {
-        var base;
-        if (this.left.left) {
-            base = this.left.to_string() + " " + this.right.to_string(true);
-        } else {
-            base = this.left.to_string(true) + " " + this.right.to_string(true);
-        }
-        if (as_atom) {
-            return "(" + base + ")";
-        } else {
-            return base;
-        }
-    };
-    this.has_free = function (v) {
-        var left_res = this.left.has_free(v);
-        var right_res = this.right.has_free(v);
-        var left_bool = left_res[0];
-        var right_bool = right_res[0];
-        var left_tag = left_res[1].tag;
-        var right_tag = right_res[1].tag;
-        var res;
-        if (left_tag > right_tag) {
-            res = left_res[1];
-        } else {
-            res = right_res[1];
-        }
-        return [left_bool || right_bool, res];
-    };
-    this.subst = function (v, new_term) {
-        return new Lambda_app(subst(v, new_term, this.left), subst(v, new_term, this.right));
-    };
-    this.check_eta = function () {
-        return this;
-    };
-    this.eval_loop = function (stack, eta) {
-        var new_stack = stack.slice(0);
-        new_stack.unshift(this.right);
-        // return this.left.eval_loop(new_stack, eta);
-               // trampoline to, args
-               return [this.left, new_stack, eta];
-    };
-    this.eval_cbv = function (aggressive) {
-        var left = this.left.eval_cbv(aggressive);
-        var right = this.right.eval_cbv(aggressive);
-        if (left.body) {
-            return subst(left.bound, right, left.body).eval_cbv(aggressive);
-        } else {
-            return new Lambda_app(left, right);
-        }
-    };
-}
-
-
-//     (* if v occurs free_in term, returns Some v' where v' is the highest-tagged
-//      * variable with the same name as v occurring (free or bound) in term *)
-
-
-function Lambda_lam(variable, body) {
-    this.bound = variable;
-    this.body = body;
-    this.debruijn = function (seq) {
-        var new_seq = seq.slice(0);
-        new_seq.unshift(this.bound);
-        return new Db_lam(this.body.debruijn(new_seq));
-    };
-    this.to_string = function (as_atom) {
-        var base = "\\" + this.to_dotted();
-        if (as_atom) {
-            return "(" + base + ")";
-        } else {
-            return base;
-        }
-    };
-    this.to_dotted = function () {
-        if (this.body.to_dotted) {
-            return this.bound.to_string() + " " + this.body.to_dotted();
-        } else {
-            return this.bound.to_string() + ". " + this.body.to_string();
-        }
-    };
-    this.has_free = function (v) {
-        if (this.bound.equal(v)) {
-            return [false, v];
-        } else {
-            return this.body.has_free(v);
-        }
-    };
-    this.subst = function (v, new_term) {
-        function bump_tag(v1, v2) {
-            var max;
-            if (v1.tag > v2.tag) {
-                max = v1.tag;
-            } else {
-                max = v2.tag;
-            }
-            return new Variable(v1.name, max + 1);
-        }
-        function bump_tag2(v1, v2) {
-            if (v1.name !== v2.name) {
-                return v1;
-            } else {
-                return bump_tag(v1, v2);
-            }
-        }
-        if (this.bound.equal(v)) {
-            return this;
-        } else {
-            var res = free_in(this.bound, new_term);
-            // if x is free in the inserted term new_term, a capture is possible
-            if (res) {
-                // this.bound is free in new_term, need to alpha-convert
-                var uniq_x = bump_tag2(bump_tag(this.bound, res), v);
-                var res2 = free_in(uniq_x, this.body);
-                if (res2) {
-                    uniq_x = bump_tag(uniq_x, res2);
-                }
-                var body2 = subst(this.bound, new Lambda_var(uniq_x), this.body);
-                return new Lambda_lam(uniq_x, subst(v, new_term, body2));
-            } else {
-                // this.bound not free in new_term, can substitute new_term for v without any captures
-                return new Lambda_lam(this.bound, subst(v, new_term, this.body));
-            }
-        }
-    };
-    this.check_eta = function () {
-        if (this.body.right && this.body.right.variable && this.bound.equal(this.body.right.variable) && !free_in(this.bound, this.body.left)) {
-            return this.body.left;
-        } else {
-            return this;
-        }
-    };
-    this.eval_loop = function (stack, eta) {
-        if (stack.length === 0) {
-                       // var term = new Lambda_lam(this.bound, this.body.eval_loop([], eta));
-                       var term = new Lambda_lam(this.bound, reduce(this.body, eta, false));
-                       if (eta) {
-                               return [null, term.check_eta()];
-                       } else {
-                               return [null, term];
-                       }
-        } else {
-            var x = stack[0];
-            var xs = stack.slice(1);
-            // return subst(this.bound, x, this.body).eval_loop(xs, eta);
-                       // trampoline to, args
-                       return [subst(this.bound, x, this.body), xs, eta];
-        }
-    };
-    this.eval_cbv = function (aggressive) {
-        if (aggressive) {
-            return new Lambda_lam(this.bound, this.body.eval_cbv(aggressive));
-        } else {
-            return this;
-        }
-    };
-    this.to_int = function (sofar) {
-//         if (this.body.body && this.body.body.variable && this.body.bound.equal(this.body.body.variable)) {
-//             return 0 + sofar;
-//         } else if (this.body.variable && this.bound.equal(this.body.variable)) {
-//             return 1 + sofar;
-//         } else if (this.body.body && this.body.body.left && this.body.body.left.variable && this.bound.equal(this.body.body.left.variable)) {
-//             var new_int = new Lambda_lam(this.bound, new Lambda_lam(this.body.bound, this.body.body.right));
-//             return new_int.to_int(1 + sofar);
-//         } else {
-//             return "not a church numeral";
-//         }
-               var res = 0, s = this.bound, z, cursor;
-               if (this.body.variable && s.equal(this.body.variable)) {
-                       return 1;
-               } else if (this.body.bound) {
-                       z = this.body.bound;
-                       cursor = this.body.body;
-                       while (cursor.left && cursor.left.variable && s.equal(cursor.left.variable)) {
-                               res += 1;
-                               cursor = cursor.right;
-                       }
-                       if (cursor.variable && z.equal(cursor.variable)) {
-                               return res;
-                       }
-               }
-               return "not a church numeral";
-    };
-}
-
-
-
-///////////////////////////////////////////////////////////////////////////////////
-
-// cbv is false: use call-by-name
-// cbv is 1: use call-by-value, don't descend inside lambda
-// cbv is 2: applicative order
-function reduce(expr, eta, cbv) {
-    if (cbv) {
-        return expr.eval_cbv(cbv > 1);
-    } else {
-        // return expr.eval_loop([], eta);
-               // using trampoline to reduce call stack overflows
-               var to_eval = expr, res = [[], eta];
-               while (to_eval !== null) {
-                       res = to_eval.eval_loop.apply(to_eval, res);
-                       to_eval = res.shift();
-               }
-               return res[0];
-    }
-}
-
-function make_var(name) {
-    return new Variable(name);
-}
-function make_app(aa, bb) {
-    return new Lambda_app(aa, bb);
-}
-function make_lam(a, aa) {
-    return new Lambda_lam(a, aa);
-}
-
-try {
-    if (console && console.debug) {
-        function print() {
-            console.debug.apply(this, arguments);
-        }
-    }
-} catch (e) {}
-
-
-
-
-/* Chris's original
-
-// Basic data structure, essentially a LISP/Scheme-like cons
-// pre-terminal nodes are expected to be of the form new cons(null, "string")
-function cons(car, cdr) {
-  this.car = car;
-  this.cdr = cdr;
-}
-
-// takes a stack of symbols, returns a pair: a tree and the remaining symbols
-function parse(split) {
-  if (split == null) return (new cons (null, null));
-  if (split.length == 0) return (new cons (null, null));
-  var token = split.shift();
-  if (token == ")") return (new cons (null, split));
-  var next = parse(split);
-  if (token == "(") {
-       var nextnext = parse(next.cdr);
-       return (new cons ((new cons (next.car, nextnext.car)),
-                                         nextnext.cdr));
-  }
-  return (new cons ((new cons ((new cons (null, token)),
-                                                          next.car)),
-                                       next.cdr))
-}
-
-// substitute arg in for v in tree
-function sub(tree, v, arg) {
-  if (tree == null) return (null);
-  if (tree.car == null) if (tree.cdr == v) return (arg);
-  if (tree.car == null) return (tree);
-
-  // perform alpha reduction to prevent variable collision
-  if (isBindingForm(tree)) 
-       return (new cons (tree.car, 
-                                         sub(sub(tree.cdr,         // inner sub = alpha reduc.
-                                                         tree.cdr.car.cdr, 
-                                                         fresh(tree.cdr.car.cdr)),
-                                                 v,
-                                                 arg)));
-
-  return (new cons ((sub (tree.car, v, arg)),
-                                       (sub (tree.cdr, v, arg))))
-}
-
-// Guaranteed unique for each call as long as string is not empty.
-var i = 0;
-function fresh(string) {
-  i = i+1;
-  if (typeof(string) != "string") return (string);
-  return (new cons (null,  
-                                       string.substring(0,1) + (i).toString()));
-}
-
-// Keep reducing until there is no more change
-function fixedPoint (tree) {
-  var t2 = reduce(tree);
-  if (treeToString(tree) == treeToString(t2)) return (tree);
-  return (fixedPoint (t2));
-}
-
-// Reduce all the arguments, then try to do beta conversion on the whole
-function reduce(tree) {
-  if (tree == null) return (tree);
-  if (typeof(tree) == "string") return (tree);
-  return (convert (new cons (reduce (tree.car), mapReduce (tree.cdr))));
-}
-
-// Reduce all the arguments in a list
-function mapReduce(tree) {
-  if (tree == null) return (tree);
-  if (tree.car == null) return (tree);
-  return (new cons (reduce (tree.car), mapReduce(tree.cdr )));
-}
-
-// If the list is of the form ((lambda var body) arg), do beta reduc.
-function convert(tree) {
-       if (isLet(tree)) {
-         return (sub(tree.cdr.car, tree.car.cdr.car.cdr, tree.car.cdr.cdr.car));}
-       else 
-         if (isConvertable(tree)) {
-               return (sub(tree.car.cdr.cdr.car, tree.car.cdr.car.cdr, tree.cdr.car));}
-         else return(tree);
-} 
-
-// Is of form ((let var arg) body)?
-function isLet(tree) {
-  if (tree == null) return (false);
-  if (!(isBindingForm(tree.car))) return (false);
-  if (tree.car.car.cdr != "let") return (false);
-  if (tree.cdr == null) return (false);
-  if (tree.cdr.car == null) return (false);
-  return(true);
-}  
-
-// Is of form ((lambda var body) arg)?
-function isConvertable(tree) {
-  if (tree == null) return (false);
-  if (!(isBindingForm(tree.car))) return (false);
-  if (tree.car.car.cdr != "lambda") return (false);
-  if (tree.cdr == null) return (false);
-  if (tree.cdr.car == null) return (false);
-  return(true);
-}  
-
-// Is of form (lambda var body)?
-function isBindingForm(tree) {
-  if (tree == null) return (false);
-  if (tree.car == null) return (false);
-  if (tree.car.car != null) return (false);
-  if ((tree.car.cdr != "lambda") 
-         && (tree.car.cdr != "let")
-         && (tree.car.cdr != "exists")
-         && (tree.car.cdr != "forall")
-         && (tree.car.cdr != "\u03BB")
-         && (tree.car.cdr != "\u2200")
-         && (tree.car.cdr != "\u2203")
-        )
-       return (false);
-  if (tree.car.cdr == null) return (false);
-  if (tree.cdr.car == null) return (false);
-  if (tree.cdr.car.car != null) return (false);
-  if (tree.cdr.cdr == null) return (false);
-  return (true);
-}
-
-function treeToString(tree) {
-  if (tree == null) return ("")
-  if (tree.car == null) return (tree.cdr)
-  if ((tree.car).car == null) 
-       return (treeToString(tree.car) + " " + treeToString(tree.cdr))
-  return ("(" + treeToString(tree.car) + ")" + treeToString(tree.cdr))
-}
-
-// use this instead of treeToString if you want to see the full structure
-function treeToStringRaw(tree) {
-  if (tree == null) return ("@")
-  if (typeof(tree) == "string") return (tree);
-  return ("(" + treeToStringRaw(tree.car) + "." + 
-                               treeToStringRaw(tree.cdr) + ")")
-}
-
-// Make sure each paren will count as a separate token
-function stringToTree(input) {
-  input = input.replace(/let/g, " ( ( let ");
-  input = input.replace(/=/g, " ");
-  input = input.replace(/in/g, " ) ");
-  input = input.replace(/\(/g, " ( ");
-  input = input.replace(/\)/g, " ) ");
-  input = input.replace(/;.*\n/g," ");
-  input = input.replace(/\^/g, " ^ ");
-  input = input.replace(/[\\]/g, " lambda ");
-  input = input.replace(/\u03BB/g, " lambda ");
-  return ((parse(input.split(/[ \f\n\r\t\v]+/))).car)
-}
-
-// Adjust spaces to print pretty
-function formatTree(tree) {
-  output = treeToStringRaw (tree);
-  output = output.replace(/^[ \f\n\r\t\v]+/, "");
-  output = output.replace(/[ \f\n\r\t\v]+$/, "");
-  output = output.replace(/[ \f\n\r\t\v]+\)/g, ")");
-  output = output.replace(/\)([^)(])/g, ") $1");
-  output = output.replace(/lambda/g, "\\");
-//  output = output.replace(/lambda/g, "\u03BB");
-//  output = output.replace(/exists/g, "\u2203");
-//  output = output.replace(/forall/g, "\u2200");
-  return (output)
-}
-
-function mytry(form) { 
-  i = 0;
-  form.result.value = formatTree((stringToTree(form.input.value)));
-  // form.result.value = formatTree(fixedPoint(stringToTree(form.input.value)));
-}
-
-*/
-
diff --git a/code/monads.ml b/code/monads.ml
deleted file mode 100644 (file)
index d872593..0000000
+++ /dev/null
@@ -1,1061 +0,0 @@
-(*
- * monads.ml
- *
- * Relies on features introduced in OCaml 3.12
- *
- * This library uses parameterized modules, see tree_monadize.ml for
- * more examples and explanation.
- *
- * Some comparisons with the Haskell monadic libraries, which we mostly follow:
- * In Haskell, the Reader 'a monadic type would be defined something like this:
- *     newtype Reader a = Reader { runReader :: env -> a }
- * (For simplicity, I'm suppressing the fact that Reader is also parameterized
- * on the type of env.)
- * This creates a type wrapper around `env -> a`, so that Haskell will
- * distinguish between values that have been specifically designated as
- * being of type `Reader a`, and common-garden values of type `env -> a`.
- * To lift an aribtrary expression E of type `env -> a` into an `Reader a`,
- * you do this:
- *     Reader { runReader = E }
- * or use any of the following equivalent shorthands:
- *     Reader (E)
- *     Reader $ E
- * To drop an expression R of type `Reader a` back into an `env -> a`, you do
- * one of these:
- *     runReader (R)
- *     runReader $ R
- * The `newtype` in the type declaration ensures that Haskell does this all
- * efficiently: though it regards E and R as type-distinct, their underlying
- * machine implementation is identical and doesn't need to be transformed when
- * lifting/dropping from one type to the other.
- *
- * Now, you _could_ also declare monads as record types in OCaml, too, _but_
- * doing so would introduce an extra level of machine representation, and
- * lifting/dropping from the one type to the other wouldn't be free like it is
- * in Haskell.
- *
- * This library encapsulates the monadic types in another way: by
- * making their implementations private. The interpreter won't let
- * let you freely interchange the `'a Reader_monad.m`s defined below
- * with `Reader_monad.env -> 'a`. The code in this library can see that
- * those are equivalent, but code outside the library can't. Instead, you'll
- * have to use operations like `run` to convert the abstract monadic types
- * to types whose internals you have free access to.
- *
- * Acknowledgements: This is largely based on the mtl library distributed
- * with the Glasgow Haskell Compiler. I've also been helped in
- * various ways by posts and direct feedback from Oleg Kiselyov and
- * Chung-chieh Shan. The following were also useful:
- * - <http://pauillac.inria.fr/~xleroy/mpri/progfunc/>
- * - Ken Shan "Monads for natural language semantics" <http://arxiv.org/abs/cs/0205026v1>
- * - http://www.grabmueller.de/martin/www/pub/Transformers.pdf
- * - http://en.wikibooks.org/wiki/Haskell/Monad_transformers
- *
- * Licensing: MIT (if that's compatible with the ghc sources this is partly
- * derived from)
- *)
-
-
-(* Some library functions used below. *)
-
-exception Undefined
-
-module Util = struct
-  let fold_right = List.fold_right
-  let map = List.map
-  let append = List.append
-  let reverse = List.rev
-  let concat = List.concat
-  let concat_map f lst = List.concat (List.map f lst)
-  (* let zip = List.combine *)
-  let unzip = List.split
-  let zip_with = List.map2
-  let replicate len fill =
-    let rec loop n accu =
-      if n == 0 then accu else loop (pred n) (fill :: accu)
-    in loop len []
-  (* Dirty hack to be a default polymorphic zero.
-   * To implement this cleanly, monads without a natural zero
-   * should always wrap themselves in an option layer (see Tree_monad). *)
-  let undef = Obj.magic (fun () -> raise Undefined)
-end
-
-(*
- * This module contains factories that extend a base set of
- * monadic definitions with a larger family of standard derived values.
- *)
-
-module Monad = struct
-
-  (*
-   * Signature extenders:
-   *   Make :: BASE -> S
-   *   MakeT :: BASET (with Wrapped : S) -> result sig not declared
-   *)
-
-
-  (* type of base definitions *)
-  module type BASE = sig
-    (* We make all monadic types doubly-parameterized so that they
-     * can layer nicely with Continuation, which needs the second
-     * type parameter. *)
-    type ('x,'a) m
-    type ('x,'a) result
-    type ('x,'a) result_exn
-    val unit : 'a -> ('x,'a) m
-    val bind : ('x,'a) m -> ('a -> ('x,'b) m) -> ('x,'b) m
-    val run : ('x,'a) m -> ('x,'a) result
-    (* run_exn tries to provide a more ground-level result, but may fail *)
-    val run_exn : ('x,'a) m -> ('x,'a) result_exn
-    (* To simplify the library, we require every monad to supply a plus and zero. These obey the following laws:
-     *     zero >>= f   ===  zero
-     *     plus zero u  ===  u
-     *     plus u zero  ===  u
-     * Additionally, they will obey one of the following laws:
-     *     (Catch)   plus (unit a) v  ===  unit a
-     *     (Distrib) plus u v >>= f   ===  plus (u >>= f) (v >>= f)
-     * When no natural zero is available, use `let zero () = Util.undef`.
-     * The Make functor automatically detects for zero >>= ..., and
-     * plus zero _, plus _ zero; it also substitutes zero for pattern-match failures.
-     *)
-    val zero : unit -> ('x,'a) m
-    (* zero has to be thunked to ensure results are always poly enough *)
-    val plus : ('x,'a) m -> ('x,'a) m -> ('x,'a) m
-  end
-  module type S = sig
-    include BASE
-    val (>>=) : ('x,'a) m -> ('a -> ('x,'b) m) -> ('x,'b) m
-    val (>>) : ('x,'a) m -> ('x,'b) m -> ('x,'b) m
-    val join : ('x,('x,'a) m) m -> ('x,'a) m
-    val apply : ('x,'a -> 'b) m -> ('x,'a) m -> ('x,'b) m
-    val lift : ('a -> 'b) -> ('x,'a) m -> ('x,'b) m
-    val lift2 :  ('a -> 'b -> 'c) -> ('x,'a) m -> ('x,'b) m -> ('x,'c) m
-    val (>=>) : ('a -> ('x,'b) m) -> ('b -> ('x,'c) m) -> 'a -> ('x,'c) m
-    val do_when :  bool -> ('x,unit) m -> ('x,unit) m
-    val do_unless :  bool -> ('x,unit) m -> ('x,unit) m
-    val forever : (unit -> ('x,'a) m) -> ('x,'b) m
-    val sequence : ('x,'a) m list -> ('x,'a list) m
-    val sequence_ : ('x,'a) m list -> ('x,unit) m
-    val guard : bool -> ('x,unit) m
-    val sum : ('x,'a) m list -> ('x,'a) m
-  end
-
-  module Make(B : BASE) : S with type ('x,'a) m = ('x,'a) B.m and type ('x,'a) result = ('x,'a) B.result and type ('x,'a) result_exn = ('x,'a) B.result_exn = struct
-    include B
-    let bind (u : ('x,'a) m) (f : 'a -> ('x,'b) m) : ('x,'b) m =
-      if u == Util.undef then Util.undef
-      else B.bind u (fun a -> try f a with Match_failure _ -> zero ())
-    let plus u v =
-      if u == Util.undef then v else if v == Util.undef then u else B.plus u v
-    let run u =
-      if u == Util.undef then raise Undefined else B.run u
-    let run_exn u =
-      if u == Util.undef then raise Undefined else B.run_exn u
-    let (>>=) = bind
-    (* expressions after >> will be evaluated before they're passed to
-     * bind, so you can't do `zero () >> assert false`
-     * this works though: `zero () >>= fun _ -> assert false`
-     *)
-    let (>>) u v = u >>= fun _ -> v
-    let lift f u = u >>= fun a -> unit (f a)
-    (* lift is called listM, fmap, and <$> in Haskell *)
-    let join uu = uu >>= fun u -> u
-    (* u >>= f === join (lift f u) *)
-    let apply u v = u >>= fun f -> v >>= fun a -> unit (f a)
-    (* [f] <*> [x1,x2] = [f x1,f x2] *)
-    (* let apply u v = u >>= fun f -> lift f v *)
-    (* let apply = lift2 id *)
-    let lift2 f u v = u >>= fun a -> v >>= fun a' -> unit (f a a')
-    (* let lift f u === apply (unit f) u *)
-    (* let lift2 f u v = apply (lift f u) v *)
-    let (>=>) f g = fun a -> f a >>= g
-    let do_when test u = if test then u else unit ()
-    let do_unless test u = if test then unit () else u
-    (* A Haskell-like version works:
-         let rec forever uthunk = uthunk () >>= fun _ -> forever uthunk
-     * but the recursive call is not in tail position so this can stack overflow. *)
-    let forever uthunk =
-        let z = zero () in
-        let id result = result in
-        let kcell = ref id in
-        let rec loop _ =
-            let result = uthunk (kcell := id) >>= chained
-            in !kcell result
-        and chained _ =
-            kcell := loop; z (* we use z only for its polymorphism *)
-        in loop z
-    (* Reimplementations of the preceding using a hand-rolled State or StateT
-can also stack overflow. *)
-    let sequence ms =
-      let op u v = u >>= fun x -> v >>= fun xs -> unit (x :: xs) in
-        Util.fold_right op ms (unit [])
-    let sequence_ ms =
-      Util.fold_right (>>) ms (unit ())
-
-    (* Haskell defines these other operations combining lists and monads.
-     * We don't, but notice that M.mapM == ListT(M).distribute
-     * There's also a parallel TreeT(M).distribute *)
-    (*
-    let mapM f alist = sequence (Util.map f alist)
-    let mapM_ f alist = sequence_ (Util.map f alist)
-    let rec filterM f lst = match lst with
-      | [] -> unit []
-      | x::xs -> f x >>= fun flag -> filterM f xs >>= fun ys -> unit (if flag then x :: ys else ys)
-    let forM alist f = mapM f alist
-    let forM_ alist f = mapM_ f alist
-    let map_and_unzipM f xs = sequence (Util.map f xs) >>= fun x -> unit (Util.unzip x)
-    let zip_withM f xs ys = sequence (Util.zip_with f xs ys)
-    let zip_withM_ f xs ys = sequence_ (Util.zip_with f xs ys)
-    let rec foldM f z lst = match lst with
-      | [] -> unit z
-      | x::xs -> f z x >>= fun z' -> foldM f z' xs
-    let foldM_ f z xs = foldM f z xs >> unit ()
-    let replicateM n x = sequence (Util.replicate n x)
-    let replicateM_ n x = sequence_ (Util.replicate n x)
-    *)
-    let guard test = if test then B.unit () else zero ()
-    let sum ms = Util.fold_right plus ms (zero ())
-  end
-
-  (* Signatures for MonadT *)
-  module type BASET = sig
-    module Wrapped : S
-    type ('x,'a) m
-    type ('x,'a) result
-    type ('x,'a) result_exn
-    val bind : ('x,'a) m -> ('a -> ('x,'b) m) -> ('x,'b) m
-    val run : ('x,'a) m -> ('x,'a) result
-    val run_exn : ('x,'a) m -> ('x,'a) result_exn
-    val elevate : ('x,'a) Wrapped.m -> ('x,'a) m
-    (* lift/elevate laws:
-     *     elevate (W.unit a) == unit a
-     *     elevate (W.bind w f) == elevate w >>= fun a -> elevate (f a)
-     *)
-    val zero : unit -> ('x,'a) m
-    val plus : ('x,'a) m -> ('x,'a) m -> ('x,'a) m
-  end
-  module MakeT(T : BASET) = struct
-    include Make(struct
-        include T
-        let unit a = elevate (Wrapped.unit a)
-    end)
-    let elevate = T.elevate
-  end
-
-end
-
-
-
-
-
-module Identity_monad : sig
-  (* expose only the implementation of type `'a result` *)
-  type ('x,'a) result = 'a
-  type ('x,'a) result_exn = 'a
-  include Monad.S with type ('x,'a) result := ('x,'a) result and type ('x,'a) result_exn := ('x,'a) result_exn
-end = struct
-  module Base = struct
-    type ('x,'a) m = 'a
-    type ('x,'a) result = 'a
-    type ('x,'a) result_exn = 'a
-    let unit a = a
-    let bind a f = f a
-    let run a = a
-    let run_exn a = a
-    let zero () = Util.undef
-    let plus u v = u
-  end
-  include Monad.Make(Base)
-end
-
-
-module Maybe_monad : sig
-  (* expose only the implementation of type `'a result` *)
-  type ('x,'a) result = 'a option
-  type ('x,'a) result_exn = 'a
-  include Monad.S with type ('x,'a) result := ('x,'a) result and type ('x,'a) result_exn := ('x,'a) result_exn
-  (* MaybeT transformer *)
-  module T : functor (Wrapped : Monad.S) -> sig
-    type ('x,'a) result = ('x,'a option) Wrapped.result
-    type ('x,'a) result_exn = ('x,'a) Wrapped.result_exn
-    include Monad.S with type ('x,'a) result := ('x,'a) result and type ('x,'a) result_exn := ('x,'a) result_exn
-    val elevate : ('x,'a) Wrapped.m -> ('x,'a) m
-  end
-end = struct
-  module Base = struct
-    type ('x,'a) m = 'a option
-    type ('x,'a) result = 'a option
-    type ('x,'a) result_exn = 'a
-    let unit a = Some a
-    let bind u f = match u with Some a -> f a | None -> None
-    let run u = u
-    let run_exn u = match u with
-      | Some a -> a
-      | None -> failwith "no value"
-    let zero () = None
-    (* satisfies Catch *)
-    let plus u v = match u with None -> v | _ -> u
-  end
-  include Monad.Make(Base)
-  module T(Wrapped : Monad.S) = struct
-    module BaseT = struct
-      include Monad.MakeT(struct
-        module Wrapped = Wrapped
-        type ('x,'a) m = ('x,'a option) Wrapped.m
-        type ('x,'a) result = ('x,'a option) Wrapped.result
-        type ('x,'a) result_exn = ('x,'a) Wrapped.result_exn
-        let elevate w = Wrapped.bind w (fun a -> Wrapped.unit (Some a))
-        let bind u f = Wrapped.bind u (fun t -> match t with
-          | Some a -> f a
-          | None -> Wrapped.unit None)
-        let run u = Wrapped.run u
-        let run_exn u =
-          let w = Wrapped.bind u (fun t -> match t with
-            | Some a -> Wrapped.unit a
-            | None -> Wrapped.zero ()
-          ) in Wrapped.run_exn w
-        let zero () = Wrapped.unit None
-        let plus u v = Wrapped.bind u (fun t -> match t with | None -> v | _ -> u)
-      end)
-    end
-    include BaseT
-  end
-end
-
-
-module List_monad : sig
-  (* declare additional operation, while still hiding implementation of type m *)
-  type ('x,'a) result = 'a list
-  type ('x,'a) result_exn = 'a
-  include Monad.S with type ('x,'a) result := ('x,'a) result and type ('x,'a) result_exn := ('x,'a) result_exn
-  val permute : ('x,'a) m -> ('x,('x,'a) m) m
-  val select : ('x,'a) m -> ('x,'a * ('x,'a) m) m
-  (* ListT transformer *)
-  module T : functor (Wrapped : Monad.S) -> sig
-    type ('x,'a) result = ('x,'a list) Wrapped.result
-    type ('x,'a) result_exn = ('x,'a) Wrapped.result_exn
-    include Monad.S with type ('x,'a) result := ('x,'a) result and type ('x,'a) result_exn := ('x,'a) result_exn
-    val elevate : ('x,'a) Wrapped.m -> ('x,'a) m
-    (* note that second argument is an 'a list, not the more abstract 'a m *)
-    (* type is ('a -> 'b W) -> 'a list -> 'b list W == 'b listT(W) *)
-    val distribute : ('a -> ('x,'b) Wrapped.m) -> 'a list -> ('x,'b) m
-    val permute : ('x,'a) m -> ('x,('x,'a) m) m
-    val select : ('x,'a) m -> ('x,('a * ('x,'a) m)) m
-    val expose : ('x,'a) m -> ('x,'a list) Wrapped.m
-  end
-end = struct
-  module Base = struct
-   type ('x,'a) m = 'a list
-   type ('x,'a) result = 'a list
-   type ('x,'a) result_exn = 'a
-   let unit a = [a]
-   let bind u f = Util.concat_map f u
-   let run u = u
-   let run_exn u = match u with
-     | [] -> failwith "no values"
-     | [a] -> a
-     | many -> failwith "multiple values"
-   let zero () = []
-   (* satisfies Distrib *)
-   let plus = Util.append
-  end
-  include Monad.Make(Base)
-  (* let either u v = plus u v *)
-  (* insert 3 [1;2] ~~> [[3;1;2]; [1;3;2]; [1;2;3]] *)
-  let rec insert a u =
-    plus (unit (a :: u)) (match u with
-        | [] -> zero ()
-        | x :: xs -> (insert a xs) >>= fun v -> unit (x :: v)
-    )
-  (* permute [1;2;3] ~~> [1;2;3]; [2;1;3]; [2;3;1]; [1;3;2]; [3;1;2]; [3;2;1] *)
-  let rec permute u = match u with
-      | [] -> unit []
-      | x :: xs -> (permute xs) >>= (fun v -> insert x v)
-  (* select [1;2;3] ~~> [(1,[2;3]); (2,[1;3]), (3;[1;2])] *)
-  let rec select u = match u with
-    | [] -> zero ()
-    | x::xs -> plus (unit (x, xs)) (select xs >>= fun (x', xs') -> unit (x', x :: xs'))
-  module T(Wrapped : Monad.S) = struct
-    (* Wrapped.sequence ms  ===
-         let plus1 u v =
-           Wrapped.bind u (fun x ->
-           Wrapped.bind v (fun xs ->
-           Wrapped.unit (x :: xs)))
-         in Util.fold_right plus1 ms (Wrapped.unit []) *)
-    (* distribute  ===  Wrapped.mapM; copies alist to its image under f *)
-    let distribute f alist = Wrapped.sequence (Util.map f alist)
-
-    include Monad.MakeT(struct
-      module Wrapped = Wrapped
-      type ('x,'a) m = ('x,'a list) Wrapped.m
-      type ('x,'a) result = ('x,'a list) Wrapped.result
-      type ('x,'a) result_exn = ('x,'a) Wrapped.result_exn
-      let elevate w = Wrapped.bind w (fun a -> Wrapped.unit [a])
-      let bind u f =
-        Wrapped.bind u (fun ts ->
-        Wrapped.bind (distribute f ts) (fun tts ->
-        Wrapped.unit (Util.concat tts)))
-      let run u = Wrapped.run u
-      let run_exn u =
-        let w = Wrapped.bind u (fun ts -> match ts with
-          | [] -> Wrapped.zero ()
-          | [a] -> Wrapped.unit a
-          | many -> Wrapped.zero ()
-        ) in Wrapped.run_exn w
-      let zero () = Wrapped.unit []
-      let plus u v =
-        Wrapped.bind u (fun us ->
-        Wrapped.bind v (fun vs ->
-        Wrapped.unit (Base.plus us vs)))
-    end)
-
-   (* insert 3 {[1;2]} ~~> {[ {[3;1;2]}; {[1;3;2]}; {[1;2;3]} ]} *)
-   let rec insert a u =
-     plus
-     (unit (Wrapped.bind u (fun us -> Wrapped.unit (a :: us))))
-     (Wrapped.bind u (fun us -> match us with
-         | [] -> zero ()
-         | x::xs -> (insert a (Wrapped.unit xs)) >>= fun v -> unit (Wrapped.bind v (fun vs -> Wrapped.unit (x :: vs)))))
-
-   (* select {[1;2;3]} ~~> {[ (1,{[2;3]}); (2,{[1;3]}), (3;{[1;2]}) ]} *)
-   let rec select u =
-     Wrapped.bind u (fun us -> match us with
-         | [] -> zero ()
-         | x::xs -> plus (unit (x, Wrapped.unit xs))
-             (select (Wrapped.unit xs) >>= fun (x', xs') -> unit (x', Wrapped.bind xs' (fun ys -> Wrapped.unit (x :: ys)))))
-
-   (* permute {[1;2;3]} ~~> {[ {[1;2;3]}; {[2;1;3]}; {[2;3;1]}; {[1;3;2]}; {[3;1;2]}; {[3;2;1]} ]} *)
-
-   let rec permute u =
-     Wrapped.bind u (fun us -> match us with
-         | [] -> unit (zero ())
-         | x::xs -> permute (Wrapped.unit xs) >>= (fun v -> insert x v))
-
-    let expose u = u
-  end
-end
-
-
-(* must be parameterized on (struct type err = ... end) *)
-module Error_monad(Err : sig
-  type err
-  exception Exc of err
-  (*
-  val zero : unit -> err
-  val plus : err -> err -> err
-  *)
-end) : sig
-  (* declare additional operations, while still hiding implementation of type m *)
-  type err = Err.err
-  type 'a error = Error of err | Success of 'a
-  type ('x,'a) result = 'a error
-  type ('x,'a) result_exn = 'a
-  include Monad.S with type ('x,'a) result := ('x,'a) result and type ('x,'a) result_exn := ('x,'a) result_exn
-  val throw : err -> ('x,'a) m
-  val catch : ('x,'a) m -> (err -> ('x,'a) m) -> ('x,'a) m
-  (* ErrorT transformer *)
-  module T : functor (Wrapped : Monad.S) -> sig
-    type ('x,'a) result = ('x,'a) Wrapped.result
-    type ('x,'a) result_exn = ('x,'a) Wrapped.result_exn
-    include Monad.S with type ('x,'a) result := ('x,'a) result and type ('x,'a) result_exn := ('x,'a) result_exn
-    val elevate : ('x,'a) Wrapped.m -> ('x,'a) m
-    val throw : err -> ('x,'a) m
-    val catch : ('x,'a) m -> (err -> ('x,'a) m) -> ('x,'a) m
-  end
-end = struct
-  type err = Err.err
-  type 'a error = Error of err | Success of 'a
-  module Base = struct
-    type ('x,'a) m = 'a error
-    type ('x,'a) result = 'a error
-    type ('x,'a) result_exn = 'a
-    let unit a = Success a
-    let bind u f = match u with
-      | Success a -> f a
-      | Error e -> Error e (* input and output may be of different 'a types *)
-    let run u = u
-    let run_exn u = match u with
-      | Success a -> a
-      | Error e -> raise (Err.Exc e)
-    let zero () = Util.undef
-    (* satisfies Catch *)
-    let plus u v = match u with
-      | Success _ -> u
-      | Error _ -> if v == Util.undef then u else v
-  end
-  include Monad.Make(Base)
-  (* include (Monad.MakeCatch(Base) : Monad.PLUS with type 'a m := 'a m) *)
-  let throw e = Error e
-  let catch u handler = match u with
-    | Success _ -> u
-    | Error e -> handler e
-  module T(Wrapped : Monad.S) = struct
-    include Monad.MakeT(struct
-      module Wrapped = Wrapped
-      type ('x,'a) m = ('x,'a error) Wrapped.m
-      type ('x,'a) result = ('x,'a) Wrapped.result
-      type ('x,'a) result_exn = ('x,'a) Wrapped.result_exn
-      let elevate w = Wrapped.bind w (fun a -> Wrapped.unit (Success a))
-      let bind u f = Wrapped.bind u (fun t -> match t with
-        | Success a -> f a
-        | Error e -> Wrapped.unit (Error e))
-      let run u =
-        let w = Wrapped.bind u (fun t -> match t with
-          | Success a -> Wrapped.unit a
-          | Error e -> Wrapped.zero ()
-        ) in Wrapped.run w
-      let run_exn u =
-        let w = Wrapped.bind u (fun t -> match t with
-          | Success a -> Wrapped.unit a
-          | Error e -> raise (Err.Exc e))
-        in Wrapped.run_exn w
-      let plus u v = Wrapped.plus u v
-      let zero () = Wrapped.zero () (* elevate (Wrapped.zero ()) *)
-    end)
-    let throw e = Wrapped.unit (Error e)
-    let catch u handler = Wrapped.bind u (fun t -> match t with
-      | Success _ -> Wrapped.unit t
-      | Error e -> handler e)
-  end
-end
-
-(* pre-define common instance of Error_monad *)
-module Failure = Error_monad(struct
-  type err = string
-  exception Exc = Failure
-  (*
-  let zero = ""
-  let plus s1 s2 = s1 ^ "\n" ^ s2
-  *)
-end)
-
-
-(* must be parameterized on (struct type env = ... end) *)
-module Reader_monad(Env : sig type env end) : sig
-  (* declare additional operations, while still hiding implementation of type m *)
-  type env = Env.env
-  type ('x,'a) result = env -> 'a
-  type ('x,'a) result_exn = env -> 'a
-  include Monad.S with type ('x,'a) result := ('x,'a) result and type ('x,'a) result_exn := ('x,'a) result_exn
-  val ask : ('x,env) m
-  val asks : (env -> 'a) -> ('x,'a) m
-  (* lookup i == `fun e -> e i` would assume env is a functional type *)
-  val local : (env -> env) -> ('x,'a) m -> ('x,'a) m
-  (* ReaderT transformer *)
-  module T : functor (Wrapped : Monad.S) -> sig
-    type ('x,'a) result = env -> ('x,'a) Wrapped.result
-    type ('x,'a) result_exn = env -> ('x,'a) Wrapped.result_exn
-    include Monad.S with type ('x,'a) result := ('x,'a) result and type ('x,'a) result_exn := ('x,'a) result_exn
-    val elevate : ('x,'a) Wrapped.m -> ('x,'a) m
-    val ask : ('x,env) m
-    val asks : (env -> 'a) -> ('x,'a) m
-    val local : (env -> env) -> ('x,'a) m -> ('x,'a) m
-    val expose : ('x,'a) m -> env -> ('x,'a) Wrapped.m
-  end
-end = struct
-  type env = Env.env
-  module Base = struct
-    type ('x,'a) m = env -> 'a
-    type ('x,'a) result = env -> 'a
-    type ('x,'a) result_exn = env -> 'a
-    let unit a = fun e -> a
-    let bind u f = fun e -> let a = u e in let u' = f a in u' e
-    let run u = fun e -> u e
-    let run_exn = run
-    let zero () = Util.undef
-    let plus u v = u
-  end
-  include Monad.Make(Base)
-  let ask = fun e -> e
-  let asks selector = ask >>= (fun e -> unit (selector e)) (* may fail *)
-  let local modifier u = fun e -> u (modifier e)
-  module T(Wrapped : Monad.S) = struct
-    module BaseT = struct
-      module Wrapped = Wrapped
-      type ('x,'a) m = env -> ('x,'a) Wrapped.m
-      type ('x,'a) result = env -> ('x,'a) Wrapped.result
-      type ('x,'a) result_exn = env -> ('x,'a) Wrapped.result_exn
-      let elevate w = fun e -> w
-      let bind u f = fun e -> Wrapped.bind (u e) (fun a -> f a e)
-      let run u = fun e -> Wrapped.run (u e)
-      let run_exn u = fun e -> Wrapped.run_exn (u e)
-      (* satisfies Distrib *)
-      let plus u v = fun e -> Wrapped.plus (u e) (v e)
-      let zero () = fun e -> Wrapped.zero () (* elevate (Wrapped.zero ()) *)
-    end
-    include Monad.MakeT(BaseT)
-    let ask = Wrapped.unit
-    let local modifier u = fun e -> u (modifier e)
-    let asks selector = ask >>= (fun e ->
-      try unit (selector e)
-      with Not_found -> fun e -> Wrapped.zero ())
-    let expose u = u
-  end
-end
-
-
-(* must be parameterized on (struct type store = ... end) *)
-module State_monad(Store : sig type store end) : sig
-  (* declare additional operations, while still hiding implementation of type m *)
-  type store = Store.store
-  type ('x,'a) result =  store -> 'a * store
-  type ('x,'a) result_exn = store -> 'a
-  include Monad.S with type ('x,'a) result := ('x,'a) result and type ('x,'a) result_exn := ('x,'a) result_exn
-  val get : ('x,store) m
-  val gets : (store -> 'a) -> ('x,'a) m
-  val put : store -> ('x,unit) m
-  val puts : (store -> store) -> ('x,unit) m
-  (* StateT transformer *)
-  module T : functor (Wrapped : Monad.S) -> sig
-    type ('x,'a) result = store -> ('x,'a * store) Wrapped.result
-    type ('x,'a) result_exn = store -> ('x,'a) Wrapped.result_exn
-    include Monad.S with type ('x,'a) result := ('x,'a) result and type ('x,'a) result_exn := ('x,'a) result_exn
-    val elevate : ('x,'a) Wrapped.m -> ('x,'a) m
-    val get : ('x,store) m
-    val gets : (store -> 'a) -> ('x,'a) m
-    val put : store -> ('x,unit) m
-    val puts : (store -> store) -> ('x,unit) m
-    (* val passthru : ('x,'a) m -> (('x,'a * store) Wrapped.result * store -> 'b) -> ('x,'b) m *)
-    val expose : ('x,'a) m -> store -> ('x,'a * store) Wrapped.m
-  end
-end = struct
-  type store = Store.store
-  module Base = struct
-    type ('x,'a) m =  store -> 'a * store
-    type ('x,'a) result =  store -> 'a * store
-    type ('x,'a) result_exn = store -> 'a
-    let unit a = fun s -> (a, s)
-    let bind u f = fun s -> let (a, s') = u s in let u' = f a in u' s'
-    let run u = fun s -> (u s)
-    let run_exn u = fun s -> fst (u s)
-    let zero () = Util.undef
-    let plus u v = u
-  end
-  include Monad.Make(Base)
-  let get = fun s -> (s, s)
-  let gets viewer = fun s -> (viewer s, s) (* may fail *)
-  let put s = fun _ -> ((), s)
-  let puts modifier = fun s -> ((), modifier s)
-  module T(Wrapped : Monad.S) = struct
-    module BaseT = struct
-      module Wrapped = Wrapped
-      type ('x,'a) m = store -> ('x,'a * store) Wrapped.m
-      type ('x,'a) result = store -> ('x,'a * store) Wrapped.result
-      type ('x,'a) result_exn = store -> ('x,'a) Wrapped.result_exn
-      let elevate w = fun s ->
-        Wrapped.bind w (fun a -> Wrapped.unit (a, s))
-      let bind u f = fun s ->
-        Wrapped.bind (u s) (fun (a, s') -> f a s')
-      let run u = fun s -> Wrapped.run (u s)
-      let run_exn u = fun s ->
-        let w = Wrapped.bind (u s) (fun (a,s) -> Wrapped.unit a)
-        in Wrapped.run_exn w
-      (* satisfies Distrib *)
-      let plus u v = fun s -> Wrapped.plus (u s) (v s)
-      let zero () = fun s -> Wrapped.zero () (* elevate (Wrapped.zero ()) *)
-    end
-    include Monad.MakeT(BaseT)
-    let get = fun s -> Wrapped.unit (s, s)
-    let gets viewer = fun s ->
-      try Wrapped.unit (viewer s, s)
-      with Not_found -> Wrapped.zero ()
-    let put s = fun _ -> Wrapped.unit ((), s)
-    let puts modifier = fun s -> Wrapped.unit ((), modifier s)
-    (* let passthru u f = fun s -> Wrapped.unit (f (Wrapped.run (u s), s), s) *)
-    let expose u = u
-  end
-end
-
-
-(* State monad with different interface (structured store) *)
-module Ref_monad(V : sig
-  type value
-end) : sig
-  type ref
-  type value = V.value
-  type ('x,'a) result = 'a
-  type ('x,'a) result_exn = 'a
-  include Monad.S with type ('x,'a) result := ('x,'a) result and type ('x,'a) result_exn := ('x,'a) result_exn
-  val newref : value -> ('x,ref) m
-  val deref : ref -> ('x,value) m
-  val change : ref -> value -> ('x,unit) m
-  (* RefT transformer *)
-  module T : functor (Wrapped : Monad.S) -> sig
-    type ('x,'a) result = ('x,'a) Wrapped.result
-    type ('x,'a) result_exn = ('x,'a) Wrapped.result_exn
-    include Monad.S with type ('x,'a) result := ('x,'a) result and type ('x,'a) result_exn := ('x,'a) result_exn
-    val elevate : ('x,'a) Wrapped.m -> ('x,'a) m
-    val newref : value -> ('x,ref) m
-    val deref : ref -> ('x,value) m
-    val change : ref -> value -> ('x,unit) m
-  end
-end = struct
-  type ref = int
-  type value = V.value
-  module D = Map.Make(struct type t = ref let compare = compare end)
-  type dict = { next: ref; tree : value D.t }
-  let empty = { next = 0; tree = D.empty }
-  let alloc (value : value) (d : dict) =
-    (d.next, { next = succ d.next; tree = D.add d.next value d.tree })
-  let read (key : ref) (d : dict) =
-    D.find key d.tree
-  let write (key : ref) (value : value) (d : dict) =
-    { next = d.next; tree = D.add key value d.tree }
-  module Base = struct
-    type ('x,'a) m = dict -> 'a * dict
-    type ('x,'a) result = 'a
-    type ('x,'a) result_exn = 'a
-    let unit a = fun s -> (a, s)
-    let bind u f = fun s -> let (a, s') = u s in let u' = f a in u' s'
-    let run u = fst (u empty)
-    let run_exn = run
-    let zero () = Util.undef
-    let plus u v = u
-  end
-  include Monad.Make(Base)
-  let newref value = fun s -> alloc value s
-  let deref key = fun s -> (read key s, s) (* shouldn't fail because key will have an abstract type, and we never garbage collect *)
-  let change key value = fun s -> ((), write key value s) (* shouldn't allocate because key will have an abstract type *)
-  module T(Wrapped : Monad.S) = struct
-    module BaseT = struct
-      module Wrapped = Wrapped
-      type ('x,'a) m = dict -> ('x,'a * dict) Wrapped.m
-      type ('x,'a) result = ('x,'a) Wrapped.result
-      type ('x,'a) result_exn = ('x,'a) Wrapped.result_exn
-      let elevate w = fun s ->
-        Wrapped.bind w (fun a -> Wrapped.unit (a, s))
-      let bind u f = fun s ->
-        Wrapped.bind (u s) (fun (a, s') -> f a s')
-      let run u =
-        let w = Wrapped.bind (u empty) (fun (a,s) -> Wrapped.unit a)
-        in Wrapped.run w
-      let run_exn u =
-        let w = Wrapped.bind (u empty) (fun (a,s) -> Wrapped.unit a)
-        in Wrapped.run_exn w
-      (* satisfies Distrib *)
-      let plus u v = fun s -> Wrapped.plus (u s) (v s)
-      let zero () = fun s -> Wrapped.zero () (* elevate (Wrapped.zero ()) *)
-    end
-    include Monad.MakeT(BaseT)
-    let newref value = fun s -> Wrapped.unit (alloc value s)
-    let deref key = fun s -> Wrapped.unit (read key s, s)
-    let change key value = fun s -> Wrapped.unit ((), write key value s)
-  end
-end
-
-
-(* must be parameterized on (struct type log = ... end) *)
-module Writer_monad(Log : sig
-  type log
-  val zero : log
-  val plus : log -> log -> log
-end) : sig
-  (* declare additional operations, while still hiding implementation of type m *)
-  type log = Log.log
-  type ('x,'a) result = 'a * log
-  type ('x,'a) result_exn = 'a * log
-  include Monad.S with type ('x,'a) result := ('x,'a) result and type ('x,'a) result_exn := ('x,'a) result_exn
-  val tell : log -> ('x,unit) m
-  val listen : ('x,'a) m -> ('x,'a * log) m
-  val listens : (log -> 'b) -> ('x,'a) m -> ('x,'a * 'b) m
-  (* val pass : ('x,'a * (log -> log)) m -> ('x,'a) m *)
-  val censor : (log -> log) -> ('x,'a) m -> ('x,'a) m
-  (* WriterT transformer *)
-  module T : functor (Wrapped : Monad.S) -> sig
-    type ('x,'a) result = ('x,'a * log) Wrapped.result
-    type ('x,'a) result_exn = ('x,'a * log) Wrapped.result_exn
-    include Monad.S with type ('x,'a) result := ('x,'a) result and type ('x,'a) result_exn := ('x,'a) result_exn
-    val elevate : ('x,'a) Wrapped.m -> ('x,'a) m
-    val tell : log -> ('x,unit) m
-    val listen : ('x,'a) m -> ('x,'a * log) m
-    val listens : (log -> 'b) -> ('x,'a) m -> ('x,'a * 'b) m
-    val censor : (log -> log) -> ('x,'a) m -> ('x,'a) m
-  end
-end = struct
-  type log = Log.log
-  module Base = struct
-    type ('x,'a) m = 'a * log
-    type ('x,'a) result = 'a * log
-    type ('x,'a) result_exn = 'a * log
-    let unit a = (a, Log.zero)
-    let bind (a, w) f = let (b, w') = f a in (b, Log.plus w w')
-    let run u = u
-    let run_exn = run
-    let zero () = Util.undef
-    let plus u v = u
-  end
-  include Monad.Make(Base)
-  let tell entries = ((), entries) (* add entries to log *)
-  let listen (a, w) = ((a, w), w)
-  let listens selector u = listen u >>= fun (a, w) -> unit (a, selector w) (* filter listen through selector *)
-  let pass ((a, f), w) = (a, f w) (* usually use censor helper *)
-  let censor f u = pass (u >>= fun a -> unit (a, f))
-  module T(Wrapped : Monad.S) = struct
-    module BaseT = struct
-      module Wrapped = Wrapped
-      type ('x,'a) m = ('x,'a * log) Wrapped.m
-      type ('x,'a) result = ('x,'a * log) Wrapped.result
-      type ('x,'a) result_exn = ('x,'a * log) Wrapped.result_exn
-      let elevate w =
-        Wrapped.bind w (fun a -> Wrapped.unit (a, Log.zero))
-      let bind u f =
-        Wrapped.bind u (fun (a, w) ->
-        Wrapped.bind (f a) (fun (b, w') ->
-        Wrapped.unit (b, Log.plus w w')))
-      let zero () = elevate (Wrapped.zero ())
-      let plus u v = Wrapped.plus u v
-      let run u = Wrapped.run u
-      let run_exn u = Wrapped.run_exn u
-    end
-    include Monad.MakeT(BaseT)
-    let tell entries = Wrapped.unit ((), entries)
-    let listen u = Wrapped.bind u (fun (a, w) -> Wrapped.unit ((a, w), w))
-    let pass u = Wrapped.bind u (fun ((a, f), w) -> Wrapped.unit (a, f w))
-    (* rest are derived in same way as before *)
-    let listens selector u = listen u >>= fun (a, w) -> unit (a, selector w)
-    let censor f u = pass (u >>= fun a -> unit (a, f))
-  end
-end
-
-(* pre-define simple Writer *)
-module Writer1 = Writer_monad(struct
-  type log = string
-  let zero = ""
-  let plus s1 s2 = s1 ^ "\n" ^ s2
-end)
-
-(* slightly more efficient Writer *)
-module Writer2 = struct
-  include Writer_monad(struct
-    type log = string list
-    let zero = []
-    let plus w w' = Util.append w' w
-  end)
-  let tell_string s = tell [s]
-  let tell entries = tell (Util.reverse entries)
-  let run u = let (a, w) = run u in (a, Util.reverse w)
-  let run_exn = run
-end
-
-
-(* TODO needs a T *)
-module IO_monad : sig
-  (* declare additional operation, while still hiding implementation of type m *)
-  type ('x,'a) result = 'a
-  type ('x,'a) result_exn = 'a
-  include Monad.S with type ('x,'a) result := ('x,'a) result and type ('x,'a) result_exn := ('x,'a) result_exn
-  val printf : ('a, unit, string, ('x,unit) m) format4 -> 'a
-  val print_string : string -> ('x,unit) m
-  val print_int : int -> ('x,unit) m
-  val print_hex : int -> ('x,unit) m
-  val print_bool : bool -> ('x,unit) m
-end = struct
-  module Base = struct
-    type ('x,'a) m = { run : unit -> unit; value : 'a }
-    type ('x,'a) result = 'a
-    type ('x,'a) result_exn = 'a
-    let unit a = { run = (fun () -> ()); value = a }
-    let bind (a : ('x,'a) m) (f: 'a -> ('x,'b) m) : ('x,'b) m =
-     let fres = f a.value in
-       { run = (fun () -> a.run (); fres.run ()); value = fres.value }
-    let run a = let () = a.run () in a.value
-    let run_exn = run
-    let zero () = Util.undef
-    let plus u v = u
-  end
-  include Monad.Make(Base)
-  let printf fmt =
-    Printf.ksprintf (fun s -> { Base.run = (fun () -> Pervasives.print_string s); value = () }) fmt
-  let print_string s = { Base.run = (fun () -> Printf.printf "%s\n" s); value = () }
-  let print_int i = { Base.run = (fun () -> Printf.printf "%d\n" i); value = () }
-  let print_hex i = { Base.run = (fun () -> Printf.printf "0x%x\n" i); value = () }
-  let print_bool b = { Base.run = (fun () -> Printf.printf "%B\n" b); value = () }
-end
-
-
-module Continuation_monad : sig
-  (* expose only the implementation of type `('r,'a) result` *)
-  type ('r,'a) m
-  type ('r,'a) result = ('r,'a) m
-  type ('r,'a) result_exn = ('a -> 'r) -> 'r
-  include Monad.S with type ('r,'a) result := ('r,'a) result and type ('r,'a) result_exn := ('r,'a) result_exn and type ('r,'a) m := ('r,'a) m
-  val callcc : (('a -> ('r,'b) m) -> ('r,'a) m) -> ('r,'a) m
-  val reset : ('a,'a) m -> ('r,'a) m
-  val shift : (('a -> ('q,'r) m) -> ('r,'r) m) -> ('r,'a) m
-  (* val abort : ('a,'a) m -> ('a,'b) m *)
-  val abort : 'a -> ('a,'b) m
-  val run0 : ('a,'a) m -> 'a
-  (* ContinuationT transformer *)
-  module T : functor (Wrapped : Monad.S) -> sig
-    type ('r,'a) m
-    type ('r,'a) result = ('a -> ('r,'r) Wrapped.m) -> ('r,'r) Wrapped.result
-    type ('r,'a) result_exn = ('a -> ('r,'r) Wrapped.m) -> ('r,'r) Wrapped.result_exn
-    include Monad.S with type ('r,'a) result := ('r,'a) result and type ('r,'a) result_exn := ('r,'a) result_exn and type ('r,'a) m := ('r,'a) m
-    val elevate : ('x,'a) Wrapped.m -> ('x,'a) m
-    val callcc : (('a -> ('r,'b) m) -> ('r,'a) m) -> ('r,'a) m
-    (* TODO: reset,shift,abort,run0 *)
-  end
-end = struct
-  let id = fun i -> i
-  module Base = struct
-    (* 'r is result type of whole computation *)
-    type ('r,'a) m = ('a -> 'r) -> 'r
-    type ('r,'a) result = ('a -> 'r) -> 'r
-    type ('r,'a) result_exn = ('r,'a) result
-    let unit a = (fun k -> k a)
-    let bind u f = (fun k -> (u) (fun a -> (f a) k))
-    let run u k = (u) k
-    let run_exn = run
-    let zero () = Util.undef
-    let plus u v = u
-  end
-  include Monad.Make(Base)
-  let callcc f = (fun k ->
-    let usek a = (fun _ -> k a)
-    in (f usek) k)
-  (*
-  val callcc : (('a -> 'r) -> ('r,'a) m) -> ('r,'a) m
-  val throw : ('a -> 'r) -> 'a -> ('r,'b) m
-  let callcc f = fun k -> f k k
-  let throw k a = fun _ -> k a
-  *)
-
-  (* from http://www.haskell.org/haskellwiki/MonadCont_done_right
-   *
-   *  reset :: (Monad m) => ContT a m a -> ContT r m a
-   *  reset e = ContT $ \k -> runContT e return >>= k
-   *
-   *  shift :: (Monad m) => ((a -> ContT r m b) -> ContT b m b) -> ContT b m a
-   *  shift e = ContT $ \k ->
-   *              runContT (e $ \v -> ContT $ \c -> k v >>= c) return *)
-  let reset u = unit ((u) id)
-  let shift f = (fun k -> (f (fun a -> unit (k a))) id)
-  (* let abort a = shift (fun _ -> a) *)
-  let abort a = shift (fun _ -> unit a)
-  let run0 (u : ('a,'a) m) = (u) id
-  module T(Wrapped : Monad.S) = struct
-    module BaseT = struct
-      module Wrapped = Wrapped
-      type ('r,'a) m = ('a -> ('r,'r) Wrapped.m) -> ('r,'r) Wrapped.m
-      type ('r,'a) result = ('a -> ('r,'r) Wrapped.m) -> ('r,'r) Wrapped.result
-      type ('r,'a) result_exn = ('a -> ('r,'r) Wrapped.m) -> ('r,'r) Wrapped.result_exn
-      let elevate w = fun k -> Wrapped.bind w k
-      let bind u f = fun k -> u (fun a -> f a k)
-      let run u k = Wrapped.run (u k)
-      let run_exn u k = Wrapped.run_exn (u k)
-      let zero () = Util.undef
-      let plus u v = u
-    end
-    include Monad.MakeT(BaseT)
-    let callcc f = (fun k ->
-      let usek a = (fun _ -> k a)
-      in (f usek) k)
-  end
-end
-
-
-(*
- * Scheme:
- * (define (example n)
- *    (let ([u (let/cc k ; type int -> int pair
- *               (let ([v (if (< n 0) (k 0) (list (+ n 100)))])
- *                 (+ 1 (car v))))]) ; int
- *      (cons u 0))) ; int pair
- * ; (example 10) ~~> '(111 . 0)
- * ; (example -10) ~~> '(0 . 0)
- *
- * OCaml monads:
- * let example n : (int * int) =
- *   Continuation_monad.(let u = callcc (fun k ->
- *       (if n < 0 then k 0 else unit [n + 100])
- *       (* all of the following is skipped by k 0; the end type int is k's input type *)
- *       >>= fun [x] -> unit (x + 1)
- *   )
- *   (* k 0 starts again here, outside the callcc (...); the end type int * int is k's output type *)
- *   >>= fun x -> unit (x, 0)
- *   in run u)
- *
- *)
-
-
-module Tree_monad : sig
-  (* We implement the type as `'a tree option` because it has a natural`plus`,
-   * and the rest of the library expects that `plus` and `zero` will come together. *)
-  type 'a tree = Leaf of 'a | Node of ('a tree * 'a tree)
-  type ('x,'a) result = 'a tree option
-  type ('x,'a) result_exn = 'a tree
-  include Monad.S with type ('x,'a) result := ('x,'a) result and type ('x,'a) result_exn := ('x,'a) result_exn
-  (* TreeT transformer *)
-  module T : functor (Wrapped : Monad.S) -> sig
-    type ('x,'a) result = ('x,'a tree option) Wrapped.result
-    type ('x,'a) result_exn = ('x,'a tree) Wrapped.result_exn
-    include Monad.S with type ('x,'a) result := ('x,'a) result and type ('x,'a) result_exn := ('x,'a) result_exn
-    val elevate : ('x,'a) Wrapped.m -> ('x,'a) m
-    (* note that second argument is an 'a tree?, not the more abstract 'a m *)
-    (* type is ('a -> 'b W) -> 'a tree? -> 'b tree? W == 'b treeT(W) *)
-    val distribute : ('a -> ('x,'b) Wrapped.m) -> 'a tree option -> ('x,'b) m
-    val expose : ('x,'a) m -> ('x,'a tree option) Wrapped.m
-  end
-end = struct
-  type 'a tree = Leaf of 'a | Node of ('a tree * 'a tree)
-  (* uses supplied plus and zero to copy t to its image under f *)
-  let mapT (f : 'a -> 'b) (t : 'a tree option) (zero : unit -> 'b) (plus : 'b -> 'b -> 'b) : 'b = match t with
-      | None -> zero ()
-      | Some ts -> let rec loop ts = (match ts with
-                     | Leaf a -> f a
-                     | Node (l, r) ->
-                         (* recursive application of f may delete a branch *)
-                         plus (loop l) (loop r)
-                   ) in loop ts
-  module Base = struct
-    type ('x,'a) m = 'a tree option
-    type ('x,'a) result = 'a tree option
-    type ('x,'a) result_exn = 'a tree
-    let unit a = Some (Leaf a)
-    let zero () = None
-    (* satisfies Distrib *)
-    let plus u v = match (u, v) with
-      | None, _ -> v
-      | _, None -> u
-      | Some us, Some vs -> Some (Node (us, vs))
-    let bind u f = mapT f u zero plus
-    let run u = u
-    let run_exn u = match u with
-      | None -> failwith "no values"
-      (*
-      | Some (Leaf a) -> a
-      | many -> failwith "multiple values"
-      *)
-      | Some us -> us
-  end
-  include Monad.Make(Base)
-  module T(Wrapped : Monad.S) = struct
-    module BaseT = struct
-      include Monad.MakeT(struct
-        module Wrapped = Wrapped
-        type ('x,'a) m = ('x,'a tree option) Wrapped.m
-        type ('x,'a) result = ('x,'a tree option) Wrapped.result
-        type ('x,'a) result_exn = ('x,'a tree) Wrapped.result_exn
-        let zero () = Wrapped.unit None
-        let plus u v =
-          Wrapped.bind u (fun us ->
-          Wrapped.bind v (fun vs ->
-          Wrapped.unit (Base.plus us vs)))
-        let elevate w = Wrapped.bind w (fun a -> Wrapped.unit (Some (Leaf a)))
-        let bind u f = Wrapped.bind u (fun t -> mapT f t zero plus)
-        let run u = Wrapped.run u
-        let run_exn u =
-            let w = Wrapped.bind u (fun t -> match t with
-              | None -> Wrapped.zero ()
-              | Some ts -> Wrapped.unit ts
-            ) in Wrapped.run_exn w
-      end)
-    end
-    include BaseT
-    let distribute f t = mapT (fun a -> elevate (f a)) t zero plus
-    let expose u = u
-  end
-
-end;;
-
-
diff --git a/code/parse.js b/code/parse.js
deleted file mode 100644 (file)
index 5cdeb40..0000000
+++ /dev/null
@@ -1,347 +0,0 @@
-// Parser for lambda with let written in Simplified JavaScript
-//      by Jim Pryor 2010-09-22
-//      Stripped down from Top Down Operator Precedence : parse.js
-//      http://javascript.crockford.com/tdop/index.html
-//      Douglas Crockford 2010-06-26
-
-//      See also http://effbot.org/zone/simple-top-down-parsing.htm
-
-
-/*jslint onevar: false
- */
-
-/*   members create, error, message, name, prototype, stringify, toSource,
-    toString, write
-*/
-
-/*global make_var, make_app, make_lam, Lambda_var */
-
-var make_parse = function () {
-    var symbol_table = {};
-    var token;
-    var tokens;
-    var token_nr;
-
-    var advance = function (id) {
-        var a, o, t, v;
-        if (id && token.id !== id) {
-            token.error("Expected '" + id + "'.");
-        }
-        if (token_nr >= tokens.length) {
-            token = symbol_table["(end)"];
-            return;
-        }
-        t = tokens[token_nr];
-        token_nr += 1;
-        v = t.value;
-        a = t.type;
-        if (a === "name") {
-            o = symbol_table[v];
-            if (!o || typeof o === 'function') {
-                o = symbol_table["(name)"];
-            } else {
-                a = o.arity || "keyword";
-            }
-        } else if (a ===  "number") {
-            o = symbol_table["(number)"];
-                       a = "literal";
-        } else if (a === "operator") {
-            o = symbol_table[v];
-            if (!o) {
-                t.error("Unknown operator.");
-            }
-            a = "keyword";
-        } else {
-            t.error("Unexpected token.");
-        }
-        token = Object.create(o);
-        token.from  = t.from;
-        token.to    = t.to;
-        token.value = v;
-        token.arity = a; // will be: name, keyword, literal
-        return token;
-    };
-
-    var original_symbol = {
-        handler: function () {
-            this.error("Undefined.");
-        }
-    };
-
-       /*
-       try {
-               if (console && console.debug) {
-                       function print() {
-                               console.debug.apply(this, arguments);
-                       }
-               }
-       } catch (e) {}
-       */
-
-    var symbol = function (id) {
-        var s = symbol_table[id];
-        if (!s) {
-            s = Object.create(original_symbol);
-            s.id = s.value = id;
-            symbol_table[id] = s;
-        }
-        return s;
-    };
-
-    var var_table;
-    var name_table;
-
-    var name_handler = function () {
-        var n = name_table[this.value];
-        if (!n) {
-            n = make_var(this.value);
-            var_table[this.value] = n;
-            n = new Lambda_var(n);
-            name_table[this.value] = n;
-        }
-        if (this.first) {
-            return make_app(this.first.handler(), n);
-        } else {
-            return n;
-        }
-    };
-
-    var branch_handler = function () {
-        var n = this.second.handler();
-        if (this.first) {
-            return make_app(this.first.handler(), n);
-        } else {
-            return n;
-        }
-    };
-
-    var lambda_handler = function () {
-        var body = this.second.handler();
-        var n, v;
-        while (this.first.length) {
-            n = this.first.pop().value;
-            v = var_table[n];
-            if (!v) {
-                v = make_var(n);
-                var_table[n] = v;
-                name_table[n] = new Lambda_var(v);
-            }
-            body = make_lam(v, body);
-        }
-        return body;
-    };
-
-    symbol("(end)");
-    symbol("(name)").handler = name_handler;
-    symbol("let").handler = lambda_handler;
-    symbol("=").handler = branch_handler;
-    symbol("in");
-    symbol(")").handler = branch_handler;
-    symbol("(");
-    symbol("\\").handler = lambda_handler;
-    symbol("lambda").handler = lambda_handler;
-    symbol("\u03bb").handler = lambda_handler;
-    // symbol("\u2203").handler = exists_handler;
-    // symbol("\u2200").handler = forall_handler;
-    symbol(".");
-
-       function make_constants() {
-
-               function make_lam2(a, b, aa) {
-                       return make_lam(a, make_lam(b, aa));
-               }
-               function make_lam3(a, b, c, aa) {
-                       return make_lam(a, make_lam(b, make_lam(c, aa)));
-               }
-               function make_app3(aa, bb, cc) {
-                       return make_app(make_app(aa, bb), cc);
-               }
-               var u = make_var("u");
-               var v = make_var("v");
-               var x = make_var("x");
-               var s = make_var("s");
-               var z = make_var("z");
-               var uu = new Lambda_var(u);
-               var vv = new Lambda_var(v);
-               var xx = new Lambda_var(x);
-               var ss = new Lambda_var(s);
-               var zz = new Lambda_var(z);
-               var_table = { u: u, v: v, x: x, s: s, z: z};
-               name_table = {u: uu, v: vv, x: xx, s: ss, z: zz};
-               number_table = {};
-
-               // constants have their own id and arity = literal
-               // numbers have id = "(number)" and arity = literal
-               symbol("(number)").handler = function () {
-                       var n = this.value;
-                       var res = number_table[n];
-                       if (!res) {
-                               res = zz;
-                               while (n > 0) {
-                                       n -= 1;
-                                       res = make_app(ss, res);
-                               }
-                               res = make_lam2(s, z, res);
-                               number_table[this.value] = res;
-                       }
-                       if (this.first) {
-                               return make_app(this.first.handler(), res);
-                       } else {
-                               return res;
-                       }
-               }
-
-               var constant = function (s, v) {
-                       var x = symbol(s);
-                       x.handler = function () {
-                               this.value = symbol_table[this.id].value;
-                               if (this.first) {
-                                       return make_app(this.first.handler(), this.value);
-                               } else {
-                                       return this.value;
-                               }
-                       };
-                       x.arity = "literal";
-                       x.value = v;
-                       return x;
-               };
-
-               constant("S", make_lam3(u, v, x, make_app3(uu, xx, make_app(vv, xx))));
-               constant("K", make_lam2(u, v, uu));
-               constant("I", make_lam(x, xx));
-               constant("B", make_lam3(u, v, x, make_app(uu, make_app(vv, xx))));
-               constant("C", make_lam3(u, v, x, make_app3(uu, xx, vv)));
-
-               // trush \uv.vu = CI
-               constant("T", make_lam2(u, v, make_app(vv, uu)));
-               // mockingbird \u.uu = SII
-               constant("M", make_lam(u, make_app(uu, uu)));
-               // warbler \uv.uvv = C(BM(BBT) = C(BS(C(BBI)I))I
-               constant("W", make_lam2(u, v, make_app3(uu, vv, vv)));
-               // lark \uv.u(vv) = CBM = BWB
-               constant("L", make_lam2(u, v, make_app(uu, make_app(vv, vv))));
-               // Y is SLL
-
-       }
-       make_constants();
-
-    var expression = function (in_let) {
-        var t, n;
-        if (token.id === "\\" || token.id === "lambda") {
-            token.value = "lambda";
-            t = token;
-            advance();
-            n = token;
-            if (n.arity !== "name") {
-                n.error("Expected a variable name.");
-            }
-            advance();
-            if (token.id === "(") {
-                t.first = [n];
-                advance();
-                t.second = expression(false);
-                advance(")");
-                return t;
-            } else {
-                t.first = [];
-                while (token.arity === "name" || token.id === "\\") {
-                   if (token.id !== "\\") {
-                      t.first.push(n);
-                      n = token;
-                   }
-                    advance();
-                }
-                               if (token.arity === "literal" && t.first.length === 0) {
-                                       t.first.push(n);
-                                       t.second = token;
-                                       advance();
-                               } else if (token.id === ".") {
-                    t.first.push(n);
-                    advance();
-                    t.second = expression(in_let);
-                } else if (t.first.length === 1) {
-                    t.second = n;
-                } else {
-                    t.first.push(n);
-                    t.error("Can't parse lambda abstract.");
-                }
-                return t;
-            }
-        } else {
-            n = null;
-            while (token.id === "(") {
-                advance();
-                t = expression(false);
-                token.first = n;
-                token.second = t;
-                n = token;
-                advance(")");
-                if (in_let && token.id === "let" || token.id === "(end)" || token.id === ")") {
-                    return n;
-                }
-            }
-            while (true) {
-                               if (n && (in_let && token.id === "in" || token.id === "(end)" || token.id === ")")) {
-                    return n;
-                } else if (token.id === "(") {
-                    advance();
-                    t = expression(false);
-                    token.first = n;
-                    token.second = t;
-                    n = token;
-                    advance(")");
-                } else {
-                    if (token.arity !== "name" && token.arity !== "literal") {
-                        token.error("Expected a variable name or literal.");
-                    }
-                    token.first = n;
-                    n = token;
-                    advance();
-                }
-            }
-        }
-       };
-
-    return function (source) {
-        tokens = source.tokens();
-        token_nr = 0;
-        advance();
-        
-        // let n = c in b
-        // (\n. b) c
-
-        var t = null, eq, c, base = {};
-        var target = base;
-
-        while (token.id === "let") {
-            t = token;
-            advance();
-            if (token.arity !== "name") {
-                token.error("Expected a variable name.");
-            }
-            t.first = [token];
-            advance();
-            eq = token; // token.id === "="
-            advance("=");
-            c = expression(true);
-
-                       eq.first = t;
-                       eq.second = c;
-                       target.second = eq;
-
-//             c.first = eq;
-//             eq.second = t;
-//             target.second = c;
-
-            target = t;
-            advance("in");
-        }
-    
-        target.second = expression(false);
-
-        advance("(end)");
-        return base.second;
-    };
-
-};
-
diff --git a/code/same-fringe.rkt b/code/same-fringe.rkt
deleted file mode 100644 (file)
index 8a8a7ba..0000000
+++ /dev/null
@@ -1,193 +0,0 @@
-#lang racket
-(require racket/control) ; this tells Scheme to let us use shift and reset
-
-(define (visit yield t)
-  (cond [(pair? t) (visit yield (car t)) (visit yield (cdr t))]
-        [else (yield t)]))
-
-
-; delimcc-based implementation of coroutines, following http://okmij.org/ftp/continuations/implementations.html#caml-shift
-(define (coroutine2 main start thread)
-  (letrec ([yield (lambda (x) (shift0 k (cons x k)))]
-           [loop (lambda (curk data)
-                   (let ([x (car data)] [k (cdr data)])
-                     (cond
-                       [(eq? k 'finished) (loop curk (curk x))]
-                       [(eq? k 'exit) x]
-                       [else (loop k (curk x))])))])
-    (loop (lambda (x) (reset0 (cons (thread yield x) 'finished))) (reset0 (cons (main yield start) 'exit)))))
-
-; call/cc-based, following Xavier Leroy's ocaml-callcc
-(define (coroutine2^ main start thread)
-  (let/cc initk (let* ([curk initk]
-                       [yield (lambda (x) (let/cc k (let ([oldk curk]) (set! curk k) (oldk x))))])
-                  (main yield (begin (thread yield (let/cc k2 (set! curk k2) start)))))))
-
-(define (proc coroutine2 max1 max2)
-  (letrec ([proc1 (lambda (yield n) (if (>= n max1) (begin (displayln "1: exit") 100) (begin (display "1: received ") (displayln n) (proc1 yield (yield (+ 1 n))))))]
-           [proc2 (lambda (yield n) (if (>= n max2) (begin (displayln "2: finished") -2) (begin (display "2: received ") (displayln n) (proc2 yield (yield (+ 1 n))))))])
-    (coroutine2 proc1 0 proc2)))
-
-; the following is meant to be a general-purpose handler with the following behavior:
-; 1. call main with start
-; 2. first yield to proc1, which yields back to main,
-; 3. then main yields to proc2, which yields back to main; and so on
-; 4. when either proc finishes, subsequent yields from main which would have gone to that procedure instead always return #f
-; 5. we stop looping only when main finishes
-(define (coroutine3 main start proc1 proc2)
-  (letrec ([yield (lambda (x) (shift0 k (cons x k)))]
-           [false (lambda (x) (reset0 (false (shift0 k (cons #f k)))))]
-           [loop (lambda (inmain curk otherk data)
-                   (let ([x (car data)] [k (cdr data)])
-                     (cond
-                       [(eq? k 'finished) (loop #t otherk false (curk x))]
-                       [(eq? k 'exit) x]
-                       [inmain (loop #f k otherk (curk x))]
-                       [else (loop #t otherk k (curk x))])))])
-    (loop #t (lambda (x) (reset0 (cons (proc1 yield x) 'finished)))
-          (lambda (x) (reset0 (cons (proc2 yield x) 'finished)))
-          (reset0 (cons (main yield start) 'exit)))))
-
-; the same-fringe application doesn't make use of the 'start or 'restart parameters
-; the 'blah values yielded to the leaf-iterators are ignored too
-(define (same-fringe1 tree1 tree2)
-  (letrec ([next1 (lambda (yield x) (visit yield tree1))]
-           [next2 (lambda (yield x) (visit yield tree2))]
-           [main (lambda (yield x)
-                   (let* ([leaf1 (yield 'blah)]
-                          [leaf2 (yield 'blah)])
-                     (cond [(and leaf1 leaf2) (and (equal? leaf1 leaf2) (main yield 'blah))]
-                           [(or leaf1 leaf2) #f]
-                           [else #t])))])
-           (coroutine3 main 'restart next1 next2)))
-
-
-; another delimcc solution, based on Biernacki, Danvy and Shan "On the static and dynamic extents of delimited continuations" 2006, section 4.1.4
-; here, next1 = '(leaf1 . thunk_for_more_leaves); final thunk => '(finished . #f)
-(define (make-enumerator2 tree)
-  (define (yield x) (shift k (cons x k)))
-  (reset (visit yield tree) '(finished . #f)))
-  
-(define (same-fringe2 tree1 tree2)
-  (define next1 (make-enumerator2 tree1))
-  (define next2 (make-enumerator2 tree2))
-  (letrec ([loop (lambda (res1 res2)
-                   (let* ([leaf1 (car res1)]
-                          [leaf2 (car res2)]
-                          [next1 (cdr res1)]
-                          [next2 (cdr res2)])
-                     (cond
-                       [(and next1 next2) (and (equal? leaf1 leaf2) (loop (next1) (next2)))]
-                       [(or next1 next2) #f]
-                       [else #t])))])
-    (loop next1 next2)))
-
-
-; call/cc solution, from http://c2.com/cgi/wiki?SameFringeProblem ("Scheme Language, using CoRoutines")
-; here, (next1) => '(1 . #t); (next1) => '(2 . #t); (next1) => '(finished . #f)
-(define (make-enumerator3 t)
-  (letrec ([resk #f]
-           [yieldk #f]
-           [resume (lambda () (let/cc k
-                                (set! yieldk k)
-                                (cond [(eq? resk #f)
-                                       (visit yield t)
-                                       (set! resk 'finished)
-                                       (yieldk (cons 'finished #f))]
-                                      [(eq? resk 'finished)
-                                       #;(error "End of generator")
-                                       (yieldk (cons 'finished #f))
-                                       ]
-                                      [else (resk)])))]
-           [yield (lambda (x) (let/cc k
-                                 (set! resk k)
-                                 (yieldk (cons x #t))))])
-    resume))
-
-(define (same-fringe3 tree1 tree2)
-  (define next1 (make-enumerator3 tree1))
-  (define next2 (make-enumerator3 tree2))
-  (letrec ([loop (lambda (res1 res2)
-                   (let* ([leaf1 (car res1)]
-                          [leaf2 (car res2)]
-                          [isleaf1 (cdr res1)]
-                          [isleaf2 (cdr res2)])
-                     (cond
-                       [(and isleaf1 isleaf2) (and (equal? leaf1 leaf2) (loop (next1) (next2)))]
-                       [(or isleaf1 isleaf2) #f]
-                       [else #t])))])
-    (loop (next1) (next2))))
-
-
-
-(define (test same-fringe)
-  (define tree1 '(((1 . 2) . (3 . 4)) . (5 . 6)))
-  (define tree2 '(1 . (((2 . 3) . (4 . 5)) . 6)))
-  (define tree3 '(1 . (((2 . 3) . (4 . 5)) . 7)))
-  (define tree4 '(((1 . 2) . (4 . 5)) . 7))
-  (define tree5 '(((1 . 2) . (3 . 4)) . 5))
-  (define tree6 '(((10 . 2) . (3 . 4)) . 5))
-  (define tree7 8)
-  (and (same-fringe tree1 tree2)
-       (same-fringe tree7 tree7)
-       (not (or
-             (same-fringe tree1 tree3)         
-             (same-fringe tree1 tree4)
-             (same-fringe tree4 tree1)
-             (same-fringe tree5 tree1)
-             (same-fringe tree1 tree5)
-             (same-fringe tree1 tree6)
-             (same-fringe tree6 tree1)
-             (same-fringe tree6 tree7)
-             ))))
-
-#|
-
-In Lua, using CoRoutines:
- function tree_leaves(tree)
-    if tree.leaf then
-        coroutine.yield(tree.leaf)
-    else                          
-        tree_leaves(tree.left)
-        tree_leaves(tree.right)
-    end                                        
- end
- function same_fringe(tree1, tree2)                                  
-    local iter1 = coroutine.wrap(tree_leaves)
-    local iter2 = coroutine.wrap(tree_leaves)    
-    for node in iter1, tree1 do                        
-        if node ~= iter2(tree2) then                   
-            return false
-        end
-    end                                                     
-    return iter2() == nil
- end
-
-In OCaml:
-# #require "delimcc";;
-# open Delimcc;;
-# type seq = End | Next of int * seq computation
-  and 'a computation = unit -> 'a;;
-# type 'a tree = Leaf of 'a | Node of 'a tree * 'a tree;;
-# let rec visit p = function Leaf i -> shift p (fun a -> Next (i, a)) | Node (t1,t2) -> let () = visit p t1 in visit p t2;;
-# let prompt mid = let p = new_prompt() in push_prompt p (mid p);;
-val prompt : ('a Delimcc.prompt -> unit -> 'a) -> 'a = <fun>
-# let make_seq t = prompt (fun p () -> let () = visit p t in End);;
-val make_seq : int tree -> seq = <fun>
-# let tree1 = Node (Node (Node(Leaf 1,Leaf 2), Node(Leaf 3,Leaf 4)), Node(Leaf 5,Leaf 6));;
-# let next1 = make_seq tree1;;
-val next1 : seq = Next (1, <fun>)
-# let next2 = match next1 with Next(_,f) -> f ();;
-val next2 : seq = Next (2, <fun>)
-# let next3 = match next2 with Next(_,f) -> f ();;
-val next3 : seq = Next (3, <fun>)
-# let next4 = match next3 with Next(_,f) -> f ();;
-val next4 : seq = Next (4, <fun>)
-# let next5 = match next4 with Next(_,f) -> f ();;
-val next5 : seq = Next (5, <fun>)
-# let next6 = match next5 with Next(_,f) -> f ();;
-val next6 : seq = Next (6, <fun>)
-# let next7 = match next6 with Next(_,f) -> f ();;
-val next7 : seq = End
-
-|#
diff --git a/code/tokens.js b/code/tokens.js
deleted file mode 100644 (file)
index c6630fa..0000000
+++ /dev/null
@@ -1,180 +0,0 @@
-// Based on tokens.js
-//      2009-05-17
-//      (c) 2006 Douglas Crockford
-
-//      Produce an array of simple token objects from a string.
-//      A simple token object contains these members:
-//           type: 'name', 'string', 'number', 'operator'
-//           value: string or number value of the token
-//           from: index of first character of the token
-//           to: index of the last character + 1
-
-//      Comments of the ; type are ignored.
-
-//      Operators are by default single characters. Multicharacter
-//      operators can be made by supplying a string of multi_start and
-//      multi_continue characters.
-//      characters. For example,
-//           '<>+-&', '=>&:'
-//      will match any of these:
-//           <=  >>  >>>  <>  >=  +: -: &: &&: &&
-
-/*jslint onevar: false
- */
-
-String.prototype.tokens = function (multi_start, multi_continue) {
-    var c;                      // The current character.
-    var from;                   // The index of the start of the token.
-    var i = 0;                  // The index of the current character.
-    var length = this.length;
-    var n;                      // The number value.
-    var q;                      // The quote character.
-    var str;                    // The string value.
-
-    var result = [];            // An array to hold the results.
-
-    var make = function (type, value) {
-
-// Make a token object.
-
-        return {
-            type: type,
-            value: value,
-            from: from,
-            to: i
-        };
-    };
-
-// Begin tokenization. If the source string is empty, return nothing.
-
-    if (!this) {
-        return;
-    }
-
-// If multi_start and multi_continue strings are not provided, supply defaults.
-
-    if (typeof multi_start !== 'string') {
-        multi_start = '';
-    }
-    if (typeof multi_continue !== 'string') {
-        multi_continue = '';
-    }
-
-
-// Loop through this text, one character at a time.
-
-    c = this.charAt(i);
-    while (c) {
-        from = i;
-
-// Ignore whitespace.
-
-        if (c <= ' ') {
-            i += 1;
-            c = this.charAt(i);
-
-// name.
-
-        } else if (c >= 'a' && c <= 'z' || c >= 'A' && c <= 'Z') {
-            str = c;
-            i += 1;
-            for (;;) {
-                c = this.charAt(i);
-                if ((c >= 'a' && c <= 'z') || (c >= 'A' && c <= 'Z') ||
-                        (c >= '0' && c <= '9') || c === '_' || c === '-' || c === '/') {
-                    str += c;
-                    i += 1;
-                               } else if (c === '?' || c === '!') {
-                               // should only be terminal
-                    str += c;
-                    i += 1;
-                                       c = this.charAt(i);
-                               // make sure next character is not an identifier
-                                       if ((c >= 'a' && c <= 'z') || (c >= 'A' && c <= 'Z') ||
-                                               (c >= '0' && c <= '9') || c === '_' || c === '-' || c === '/' || c === '?' || c === '!') {
-                                               str += c;
-                                               i += 1;
-                                               make('name', str).error("Bad identifier");
-                                       }
-                               } else {
-                    break;
-                }
-            }
-            result.push(make('name', str));
-
-// number.
-
-// A number cannot start with a decimal point. It must start with a digit,
-// possibly '0'.
-
-        } else if (c >= '0' && c <= '9') {
-            str = c;
-            i += 1;
-
-// Look for more digits.
-
-            for (;;) {
-                c = this.charAt(i);
-                if (c < '0' || c > '9') {
-                    break;
-                }
-                i += 1;
-                str += c;
-            }
-
-// Make sure the next character is not a letter.
-
-            if (c >= 'a' && c <= 'z' || c >= 'A' && c <= 'Z' || c === '_') {
-                str += c;
-                i += 1;
-                make('number', str).error("Bad number");
-            }
-
-// Convert the string value to a number. If it is finite, then it is a good
-// token.
-
-            n = +str;
-            if (isFinite(n)) {
-                result.push(make('number', n));
-            } else {
-                make('number', str).error("Bad number");
-            }
-
-// comment.
-
-        } else if (c === ';') {
-            for (;;) {
-                c = this.charAt(i);
-                if (c === '\n' || c === '\r' || c === '') {
-                    break;
-                }
-                i += 1;
-            }
-
-// multi-char operator.
-
-        } else if (multi_start.indexOf(c) >= 0) {
-            str = c;
-            i += 1;
-            while (i < length) {
-                c = this.charAt(i);
-                if (multi_continue.indexOf(c) < 0) {
-                    break;
-                }
-                str += c;
-                i += 1;
-            }
-            result.push(make('operator', str));
-
-// single-character operator.
-
-        } else {
-            i += 1;
-            result.push(make('operator', c));
-            c = this.charAt(i);
-        }
-    }
-    return result;
-};
-
-
diff --git a/code/tree_monadize.ml b/code/tree_monadize.ml
deleted file mode 100644 (file)
index 70e7df9..0000000
+++ /dev/null
@@ -1,278 +0,0 @@
-(*
- * tree_monadize.ml
- *
- * If you've got some block of code that uses `unit`s and `bind`s, and you
- * want to interpret it alternately using this monad, that monad, or another
- * monad, you can use OCaml's module system. You'd write your code like this:
- *) 
-
-module Reader_monad = struct
-    (* change this to suit your needs *)
-    type env = int -> int;;
-
-    type 'a m = env -> 'a;;
-    let unit a : 'a m = fun e -> a;;
-    let bind (u : 'a m) (f : 'a -> 'b m) : 'b m =
-      fun e -> f (u e) e;;
-end
-
-module State_monad = struct
-    (* change this to suit your needs *)
-    type store = int;;
-
-    type 'a m = store -> 'a * store;;
-    let unit a : 'a m  = fun s -> (a, s);;
-    let bind (u : 'a m) (f : 'a -> 'b m) : 'b m =
-      fun s -> (let (a, s') = u s in (f a) s');;
-end
-
-module List_monad = struct
-    type 'a m = 'a list;;
-    let unit a : 'a m = [a];;
-    let bind (u: 'a m) (f : 'a -> 'b m) : 'b m =
-      List.concat(List.map f u);;
-end
-
-(*
- * Then you can replace code that looks like this:
- *     ... reader_bind ...
- * with code that looks like this:
- *     ... Reader_monad.bind ...
- * and the latter can be reformulated like this:
- *     let open Reader_monad in ... bind ...
- * or equivalently, like this:
- *     Reader_monad.(... bind ...)
- * Then you can use literally the same `... bind ...` code when writing instead:
- *     State_monad.(... bind ...)
- *)
-
-(* That's great, however it still requires us to repeat the
- * `... bind ...` code every time we want to change which monad we're working
- * with. Shouldn't there be a way to _parameterize_ the `... bind ...` code
- * on a monad, so that we only have to write the `... bind ...` code once,
- * but can invoke it alternately with the Reader_monad supplied as an
- * argument, or the State_monad, or another?
- *
- * There is a way to do this, but it requires putting the `... bind ...` code in
- * its own module, and making that module parameterized on some M_monad
- * module. Also we have to explicitly declare what commonality we're expecting
- * from M_monad modules we're going to use as parameters. We'll explain how to
- * do this in a moment.
- *
- * As preparation, a general observation:
- * 'a and so on are type variables in OCaml; they stand for arbitrary types.
- * What if you want a variable for a type constructor? For example, you want to
- * generalize this pattern:
- *      type ('a) t1 = 'a -> ('a) list
- *      type ('a) t2 = 'a -> ('a) option
- *      type ('a) t3 = 'a -> ('a) reader
- * and so on? OCaml won't let you do this:
- *      type ('a, 'b) t = 'a -> ('a) 'b
- * To generalize on the 'b position, we instead have to use OCaml's modules,
- * and in particular its ability to make modules parameterized on other modules
- * (OCaml calls these parameterized modules Functors, but that name is also
- * used in other ways in this literature, so I won't give in to it.)
- *
- * Here's how you'd have to define the t type from above:
- *      module T_maker(
- *      (* A sig...end block specifies the type of a module
- *       * What we're doing here is specifying the type of the 
- *       * module parameter that will choose
- *       * whether b = list or b = option or b = reader...
- *       * This module parameter may supply values as well as types *)
- *      M : sig
- *          type ('a) b
- *      end
- *      ) = 
- *      (* A struct...end block gives a module value
- *       * What we're doing here is building a new module that makes
- *       * use of the module that was supplied as M *)
- *      struct
- *          type ('a) t = 'a -> ('a) M.b
- *      end
- * And here's how you'd use it:
- *      module T_list = T_maker(struct type 'a b = 'a list end);;
- *      type 'a t1 = 'a T_list.t;;
- *      module T_option = T_maker(struct type 'a b = 'a option end);;
- *      type 'a t2 = 'a T_option.t;;
- *      (* and so on *)
- *
- * I know, it seems unnecessarily complicated. Nonetheless, that's how it
- * works. And that is also the technique we'll use to make our
- * `... bind ...` code parametric on some M_monad module.
- *)
-
-type 'a tree = Leaf of 'a | Node of ('a tree) * ('a tree);;
-
-let t1 = Node
-           (Node
-             (Leaf 2, Leaf 3),
-            Node
-             (Leaf 5,
-              Node
-                (Leaf 7, Leaf 11)));;
-
-
-module Tree_monadizer(M : sig
-  (* the module we're using as a parameter has to supply function values
-   * for unit and bind, as well as a monadic type constructor *)
-  type 'a m
-  val unit : 'a -> 'a m
-  val bind : 'a m -> ('a -> 'b m) -> 'b m
-end) = struct
-  let rec monadize (f: 'a -> 'b M.m) (t: 'a tree) : 'b tree M.m =
-    match t with
-    | Leaf a -> M.bind (f a) (fun b -> M.unit (Leaf b))
-    | Node(l, r) ->
-        M.bind (monadize f l) (fun l' ->
-          M.bind (monadize f r) (fun r' ->
-            M.unit (Node (l', r'))))
-end;;
-
-
-(* Now we supply Reader_monad as a parameter to Tree_monadizer.
- * We'll get back a module TreeReader that contains a single value,
- * the monadize function specialized to the Reader monad *)
-module TreeReader = Tree_monadizer(Reader_monad);;
-
-
-(* Make a TreeState module containing monadize specialized to the State monad *)
-module TreeState =  Tree_monadizer(State_monad);;
-
-
-(* Make a TreeList module containing monadize specialized to the List monad *)
-module TreeList =  Tree_monadizer(List_monad);;
-
-
-(* The Continuation monad is a bit more complicated *)
-module Continuation_monad = struct
-    type ('r,'a) m = ('a -> 'r) -> 'r;;
-    let unit a : ('r,'a) m = fun k -> k a;;
-    let bind (u: ('r,'a) m) (f: 'a -> ('r,'b) m) : ('r,'b) m =
-      fun k -> u (fun a -> f a k);;
-end
-
-(* Since the Continuation monad is parameterized on two types---it's
- * ('r,'a) cont not ('a) cont---we can't match the type ('a) monad that
- * Tree_monadizer expects in its parameter. So we have to make a different
- * Tree_monadizer2 that takes a ('r,'a) monad type constructor in its
- * parameter instead *)
-module Tree_monadizer2(M : sig
-  type ('r,'a) m
-  val unit : 'a -> ('r,'a) m
-  val bind : ('r,'a) m -> ('a -> ('r,'b) m) -> ('r,'b) m
-end) = struct
-  (* the body of the monadize function is the same; the only difference is in
-   * the types *)
-  let rec monadize (f: 'a -> ('r,'b) M.m) (t: 'a tree) : ('r,'b tree) M.m =
-    match t with
-    | Leaf a -> M.bind (f a) (fun b -> M.unit (Leaf b))
-    | Node(l, r) ->
-        M.bind (monadize f l) (fun l' ->
-          M.bind (monadize f r) (fun r' ->
-            M.unit (Node (l', r'))))
-end;;
-
-(* Make a TreeCont module containing monadize specialized to the Cont monad *)
-mod