This homework is **only required for master students**. Undergrads can do it
too, and you will be graded as usual — but you will *not* be able to
withdraw a graded homework grade, so submit only if you think that your work
is good enough to improve your grade. (Note: the homework grades are all
weighted to compute your overall grade, so adding another grade means that
you get smaller portions for more grades, which can serve as protection
against local disasters.)

Note that while undergrads are not required to submit a solution, it will be
a very good idea to read the homework and go through the solution when it is
later posted — since you *are* expected to know the material.

The language for this homework is:

#lang pl 09

This language is the Broken-scope language that we have seen in class
(`#lang pl broken`

), where `define`

cannot be used to create recursive
functions. It is not really close to the usual course language. In
addition, instead of creating an interpreter, you will extend Racket
itself (that is, instead of implementing a language in a `#lang pl`

, you
will extend this `#lang pl`

).

(Note: if you get a weird linking error then you can avoid it by turning off debugging and coverage in the language options dialog, and instead rely on the server to tell you when coverage is missing.)

As you might have noted, our fixpoint operator — the Y combinator, is very limited: it can be used only with single argument functions. Another possible limitation is that is that it can construct one recursive function, but not several mutually recursive functions. In this homework you will show that the Y combinator is actually capable of addressing both problems.

Begin your work with the definition of the Y combinator that is suitable for plain Racket (untyped, and strict):

#lang pl 09

(define (Y f)

((lambda (x) (x x))

(lambda (x) (f (lambda (z) ((x x) z))))))

(define (Y f)

((lambda (x) (x x))

(lambda (x) (f (lambda (z) ((x x) z))))))

The first problem that we’re going to tackle is the fact that this
definition of the Y combinator is limited to recursive functions of one
argument only. This is because it relies on `(lambda (z) ((x x) z))`

being the same as `(x x)`

, which is true only when the latter is a
one-argument function. For example, the following definition of the
Ackermann function doesn’t work:

(define ackermann

(Y (lambda (ackermann)

(lambda (m n)

(cond [(zero? m) (+ n 1)]

[(zero? n) (ackermann (- m 1) 1)]

[else (ackermann (- m 1)

(ackermann m (- n 1)))])))))

(test (ackermann 3 3) => 61)

(Y (lambda (ackermann)

(lambda (m n)

(cond [(zero? m) (+ n 1)]

[(zero? n) (ackermann (- m 1) 1)]

[else (ackermann (- m 1)

(ackermann m (- n 1)))])))))

(test (ackermann 3 3) => 61)

(Note: Ackermann’s function is an interesting case of a function that cannot be expressed using “simple” recursion; it creates extremely large numbers for small inputs — specifically, don’t try to use more than 3 for the first argument, since the result can easily be too big to fit in your computer’s memory. See the Wikipedia article about this for more information and interesting facts.)

We can get around this by writing a curried definition of the
`ackermann`

function, but this means that the function is called in a
different way, which means changing both its body (the recursive calls)
and the place that uses it (the test expression).

However, we can still get it to work. To avoid changing the test
expression, all we need to do is to make sure that `ackermann`

is
actually bound to a two-argument function that uses the curried version
to do its work:

(define ackermann

(let ([g (Y (lambda (ackermann) …same as before…))])

(lambda (x y) ((g x) y))))

(test (ackermann 3 3) => 61)

(let ([g (Y (lambda (ackermann) …same as before…))])

(lambda (x y) ((g x) y))))

(test (ackermann 3 3) => 61)

and we can also wrap the body (elided in this last example) so that it gets a two-argument version of the function.

The same technique can be used to deal with functions of any arity. To
make things a bit more uniform, we can simply ignore the first argument,
and always pass some random value for this argument. In the `ackermann`

case, this leads to the following definition:

(define ackermann

(let ([g (Y (lambda (ackermann)

(lambda (_) ; we ignore this argument

(lambda (m n)

(let ([ackermann (ackermann #f)])

…same body for the function…)))))])

(g #f)))

(let ([g (Y (lambda (ackermann)

(lambda (_) ; we ignore this argument

(lambda (m n)

(let ([ackermann (ackermann #f)])

…same body for the function…)))))])

(g #f)))

Your job is to define a rewrite rule that does just that, thereby
allowing recursive function definitions of any arity. This is done with
the `rewrite`

form that we have seen briefly in the Schlac language.
Note that this is very similar to writing a preprocessor (which you have
done in previous homework), except that now you’re extending your own
language instead of the language you’re implementing.

Here is a skeleton code to get you started:

(rewrite (define/rec (f x ...) E)

=> (define f

(let ([g (Y (lambda (f)

finish this part))])

(g #f))))

=> (define f

(let ([g (Y (lambda (f)

finish this part))])

(g #f))))

A note about using “`...`

” in templates: a “`...`

” in the input pattern
of a rewrite rule means match on any number of templates on the left of
it (so it’s very much like our use of “`...`

” in BNFs). In this case,
the output pattern must also have a “`...`

” after the same identifiers.
For example, here is a definition of a `define/rec`

rewrite rule that is
more convenient to use than an explicit `lambda`

:

(rewrite (define/fun (id x ...) body)

=> (define id

(lambda (x ...) body)))

=> (define id

(lambda (x ...) body)))

Note that `x`

matches anything, and because of the “`...`

” it matches a
sequence of “anythings” — so the right side of the rule also must have
“`...`

” following the `x`

.

Once you have a good definition of this rewrite rule, you can verify
that it’s working with a definition of `ackermann`

and a matching test:

(define/rec (ackermann m n)

(cond [(zero? m) (+ n 1)]

[(zero? n) (ackermann (- m 1) 1)]

[else (ackermann (- m 1) (ackermann m (- n 1)))]))

(test (ackermann 3 3) => 61)

(cond [(zero? m) (+ n 1)]

[(zero? n) (ackermann (- m 1) 1)]

[else (ackermann (- m 1) (ackermann m (- n 1)))]))

(test (ackermann 3 3) => 61)

(complete the `ackermann`

definition with a type contract line and a
purpose statement. Note that the contract is ignored in this language,
so just put it in a comment.)

Another limit of the `Y`

combinator as defined above is that it supports
only a single recursive function, but having several mutually recursive
functions can be a very useful feature. As a toy example, consider this
expression that defines and uses two mutually-recursive functions:

(letrec ([even? (lambda (n) (if (= n 0) #t (odd? (- n 1))))]

[odd? (lambda (n) (if (= n 0) #f (even? (- n 1))))])

(even? 123))

[odd? (lambda (n) (if (= n 0) #f (even? (- n 1))))])

(even? 123))

We cannot do this directly with the Y combinator, but we can instead define a single recursive function that packages the two recursive ones:

(letrec ([even+odd

(list (lambda (n)

(if (zero? n) #t ((second even+odd) (- n 1))))

(lambda (n)

(if (zero? n) #f ((first even+odd) (- n 1)))))])

((first even+odd) 123))

(list (lambda (n)

(if (zero? n) #t ((second even+odd) (- n 1))))

(lambda (n)

(if (zero? n) #f ((first even+odd) (- n 1)))))])

((first even+odd) 123))

Again, we can use `let`

to make the `letrec`

body the same as it was:

(letrec ([even+odd

(list (lambda (n)

(if (zero? n) #t ((second even+odd) (- n 1))))

(lambda (n)

(if (zero? n) #f ((first even+odd) (- n 1)))))])

(let ([even? (first even+odd)]

[odd? (second even+odd)])

(even? 123)))

(list (lambda (n)

(if (zero? n) #t ((second even+odd) (- n 1))))

(lambda (n)

(if (zero? n) #f ((first even+odd) (- n 1)))))])

(let ([even? (first even+odd)]

[odd? (second even+odd)])

(even? 123)))

And we can do the same to the function bodies to keep the previous body:

(letrec ([even+odd

(list (lambda (n)

(let ([even? (first even+odd)]

[odd? (second even+odd)])

(if (zero? n) #t (odd? (- n 1)))))

(lambda (n)

(let ([even? (first even+odd)]

[odd? (second even+odd)])

(if (zero? n) #f (even? (- n 1))))))])

(let ([even? (first even+odd)]

[odd? (second even+odd)])

(even? 123)))

(list (lambda (n)

(let ([even? (first even+odd)]

[odd? (second even+odd)])

(if (zero? n) #t (odd? (- n 1)))))

(lambda (n)

(let ([even? (first even+odd)]

[odd? (second even+odd)])

(if (zero? n) #f (even? (- n 1))))))])

(let ([even? (first even+odd)]

[odd? (second even+odd)])

(even? 123)))

Note that these definitions always bind all names even when not needed — but we will do something like this automatically using a rewrite rule.

To make things a little simpler, we will define a rewrite rule called
`letfuns`

, which is a little different than `letrec`

in that it can be
used to bind only functions. For example, instead of

(letrec ([foo (lambda (x) …body…)]) …)

we will use

(letfuns ([(foo x) …body…]) …)

We will also use a more systematic package of a number of functions: we use a function that consumes a name of a function (a symbol), and returns the appropriate function.

To summarize all of this, the following piece of code:

(letfuns ([(even? n) (if (= n 0) #t (odd? (- n 1)))]

[(odd? n) (if (= n 0) #f (even? (- n 1)))])

(even? 123))

[(odd? n) (if (= n 0) #f (even? (- n 1)))])

(even? 123))

will be rewritten to:

(let ([g (Y (lambda (funs)

(lambda (name)

(match name

['even?

(lambda (n)

(let ([even? (funs 'even?)]

[odd? (funs 'odd?)])

(if (= n 0) #t (odd? (- n 1)))))]

['odd?

(lambda (n)

(let ([even? (funs 'even?)]

[odd? (funs 'odd?)])

(if (= n 0) #f (even? (- n 1)))))]))))])

(let ([even? (g 'even?)]

[odd? (g 'odd?)])

(even? 123)))

(lambda (name)

(match name

['even?

(lambda (n)

(let ([even? (funs 'even?)]

[odd? (funs 'odd?)])

(if (= n 0) #t (odd? (- n 1)))))]

['odd?

(lambda (n)

(let ([even? (funs 'even?)]

[odd? (funs 'odd?)])

(if (= n 0) #f (even? (- n 1)))))]))))])

(let ([even? (g 'even?)]

[odd? (g 'odd?)])

(even? 123)))

Again, here is a skeleton code to get you started:

(rewrite (letfuns ([(f x) E] ...) B)

=> (let ([g (Y (lambda (funs)

(lambda (name)

finish this part)))])

(let ([f (g 'f)] ...)

B)))

=> (let ([g (Y (lambda (funs)

(lambda (name)

finish this part)))])

(let ([f (g 'f)] ...)

B)))

Use the `even?`

/`odd?`

above as a test, but note that as is, you will
need to change the body so that you get complete coverage. When you run
it you’ll see that one part is still in red, so you should make the body
exercise it too (hint: `and`

or `or`

would be useful here).

Next, change the rewrite rule so it can work with mutually recursive
functions of *any* arity. This should be a very easy change. As a test
for your final version, here is an interesting use for several mutually
recursive functions: we implement an automaton (a state machine) that
consumes a string, and returns `#t`

if the parens in the string are
balanced, and if every continuous block of numeric characters is
strictly increasing. Each “state” of this automaton is implemented via
a function (actually, some state is in arguments to these functions),
and since states call out to other states, the functions are mutually
recursive. Note also that tail-calls are crucial here: the compilation
of this code will basically be similar to a program with `goto`

statements to jump around.

;; an extended example

(define scan

(letfuns ([(start str) (loop (explode-string str) 0)]

[(loop l n) (match l

[(list)

(zero? n)]

[(cons 'open more)

(loop more (add1 n))]

[(cons 'close more)

(and (> n 0) (loop more (sub1 n)))]

[(cons (number: m) more)

(nums more m n)]

[(cons _ more)

(loop more n)])]

[(nums l m n) (match l

[(cons (number: m1) more)

(and (< m m1) (nums more m1 n))]

[else (loop l n)])])

start))

(test (scan "(()123(246x12)) (blah)"))

(test (not (scan "(1232)")))

(test (not (scan "()(")))

(test (not (scan "())")))

(define scan

(letfuns ([(start str) (loop (explode-string str) 0)]

[(loop l n) (match l

[(list)

(zero? n)]

[(cons 'open more)

(loop more (add1 n))]

[(cons 'close more)

(and (> n 0) (loop more (sub1 n)))]

[(cons (number: m) more)

(nums more m n)]

[(cons _ more)

(loop more n)])]

[(nums l m n) (match l

[(cons (number: m1) more)

(and (< m m1) (nums more m1 n))]

[else (loop l n)])])

start))

(test (scan "(()123(246x12)) (blah)"))

(test (not (scan "(1232)")))

(test (not (scan "()(")))

(test (not (scan "())")))

(Note that `explode-string`

does the obvious thing, and returns a list
of symbols and small numbers for digits.)