Derick Eddington

2012-06-09 05:56:18 UTC

While exploring ways to support recursion, including mutual

recursion, in a project of mine, I discovered that the Y

combinator can be extended to support mutual recursion. I'm sure

this has already been discovered, but I haven't found any mention

of it in the searching I've had time to do, so I thought I'd show

it here because it might be interesting.

Starting with a quick explanation of Y:

(define (Y make-proc)

(let ((take-self-and-make-proc

(lambda (self)

(let ((recur (lambda (v) ((self self) v))))

(make-proc recur)))))

(take-self-and-make-proc take-self-and-make-proc)))

(define loop

(Y (lambda (recur)

(lambda (n) (when (positive? n) (recur (- n 1)))))))

What Y does is arrange a way to give the user's procedure a

procedure that does the recursion by getting the user's procedure

again. To get the user's procedure again and have it be able to

recur again, a procedure that does the recursion must be given

again to the procedure that returns the user's procedure, and

this is what take-self-and-make-proc does. The key to Y is the

closures and the order they're made. take-self-and-make-proc

keeps the reference to make-proc, recur keeps the reference to

take-self-and-make-proc, and take-self-and-make-proc is always

given to itself so it's available for next time. (Side note: I

tried to make something similar to Y that doesn't allocate

closures as much, but failed.)

To enable mutual recursion, we can extend the above technique so

that the user's procedures each close-over multiple procedures

for calling the mutual procedures. We can see what this might

look like by extending Y to support two mutually recursive

procedures:

(define (Y2 make-proc1 make-proc2)

(let

((take-both-and-make-proc1

(lambda (self tbmp2)

(let ((call-proc1 (lambda (v) ((self self tbmp2) v)))

(call-proc2 (lambda (v) ((tbmp2 self tbmp2) v))))

(make-proc1

call-proc1 call-proc2))))

(take-both-and-make-proc2

(lambda (tbmp1 self)

(let ((call-proc1 (lambda (v) ((tbmp1 tbmp1 self) v)))

(call-proc2 (lambda (v) ((self tbmp1 self) v))))

(make-proc2

call-proc1 call-proc2)))))

(values

(take-both-and-make-proc1 take-both-and-make-proc1

take-both-and-make-proc2)

(take-both-and-make-proc2 take-both-and-make-proc1

take-both-and-make-proc2))))

(define-values (even? odd?)

(let ((make-even?

(lambda (even? odd?)

(lambda (x) (or (zero? x) (odd? (- x 1))))))

(make-odd?

(lambda (even? odd?)

(lambda (x) (and (positive? x) (even? (- x 1)))))))

(Y2 make-even? make-odd?)))

Now it's easier to see how this can be fully generalized to:

(define (YM . procs-makers)

(define (make-take-all-and-make-proc make-proc)

(lambda (tamps)

(define (make-proc-caller t)

(lambda vals (apply (t tamps) vals)))

(apply make-proc

(map make-proc-caller tamps))))

(let ((tamps (map make-take-all-and-make-proc

procs-makers)))

(apply values

(map (lambda (x) (x tamps))

tamps))))

However, this has poor performance. With a macro, something

similar can be done that has better performance and is similar to

letrec:

(define-syntax letrec-YM

(lambda (stx)

(syntax-case stx (lambda)

((_ ((id (lambda a . b)) ...) . body)

(with-syntax

(((tamp ...) (generate-temporaries #'(id ...))))

(with-syntax

(((caller-body ...)

(map (lambda (a t)

(syntax-case a ()

((x ...)

(cons t a))

((x ... . y)

#`(apply #,t x ... y))))

#'(a ...)

#'((tamp tamp ...) ...))))

#'(let ((tamp

(lambda (tamp ...)

(let ((id (lambda a caller-body))

...)

(lambda a . b))))

...)

(let ((id (tamp tamp ...))

...)

. body))))))))

recursion, in a project of mine, I discovered that the Y

combinator can be extended to support mutual recursion. I'm sure

this has already been discovered, but I haven't found any mention

of it in the searching I've had time to do, so I thought I'd show

it here because it might be interesting.

Starting with a quick explanation of Y:

(define (Y make-proc)

(let ((take-self-and-make-proc

(lambda (self)

(let ((recur (lambda (v) ((self self) v))))

(make-proc recur)))))

(take-self-and-make-proc take-self-and-make-proc)))

(define loop

(Y (lambda (recur)

(lambda (n) (when (positive? n) (recur (- n 1)))))))

What Y does is arrange a way to give the user's procedure a

procedure that does the recursion by getting the user's procedure

again. To get the user's procedure again and have it be able to

recur again, a procedure that does the recursion must be given

again to the procedure that returns the user's procedure, and

this is what take-self-and-make-proc does. The key to Y is the

closures and the order they're made. take-self-and-make-proc

keeps the reference to make-proc, recur keeps the reference to

take-self-and-make-proc, and take-self-and-make-proc is always

given to itself so it's available for next time. (Side note: I

tried to make something similar to Y that doesn't allocate

closures as much, but failed.)

To enable mutual recursion, we can extend the above technique so

that the user's procedures each close-over multiple procedures

for calling the mutual procedures. We can see what this might

look like by extending Y to support two mutually recursive

procedures:

(define (Y2 make-proc1 make-proc2)

(let

((take-both-and-make-proc1

(lambda (self tbmp2)

(let ((call-proc1 (lambda (v) ((self self tbmp2) v)))

(call-proc2 (lambda (v) ((tbmp2 self tbmp2) v))))

(make-proc1

call-proc1 call-proc2))))

(take-both-and-make-proc2

(lambda (tbmp1 self)

(let ((call-proc1 (lambda (v) ((tbmp1 tbmp1 self) v)))

(call-proc2 (lambda (v) ((self tbmp1 self) v))))

(make-proc2

call-proc1 call-proc2)))))

(values

(take-both-and-make-proc1 take-both-and-make-proc1

take-both-and-make-proc2)

(take-both-and-make-proc2 take-both-and-make-proc1

take-both-and-make-proc2))))

(define-values (even? odd?)

(let ((make-even?

(lambda (even? odd?)

(lambda (x) (or (zero? x) (odd? (- x 1))))))

(make-odd?

(lambda (even? odd?)

(lambda (x) (and (positive? x) (even? (- x 1)))))))

(Y2 make-even? make-odd?)))

Now it's easier to see how this can be fully generalized to:

(define (YM . procs-makers)

(define (make-take-all-and-make-proc make-proc)

(lambda (tamps)

(define (make-proc-caller t)

(lambda vals (apply (t tamps) vals)))

(apply make-proc

(map make-proc-caller tamps))))

(let ((tamps (map make-take-all-and-make-proc

procs-makers)))

(apply values

(map (lambda (x) (x tamps))

tamps))))

However, this has poor performance. With a macro, something

similar can be done that has better performance and is similar to

letrec:

(define-syntax letrec-YM

(lambda (stx)

(syntax-case stx (lambda)

((_ ((id (lambda a . b)) ...) . body)

(with-syntax

(((tamp ...) (generate-temporaries #'(id ...))))

(with-syntax

(((caller-body ...)

(map (lambda (a t)

(syntax-case a ()

((x ...)

(cons t a))

((x ... . y)

#`(apply #,t x ... y))))

#'(a ...)

#'((tamp tamp ...) ...))))

#'(let ((tamp

(lambda (tamp ...)

(let ((id (lambda a caller-body))

...)

(lambda a . b))))

...)

(let ((id (tamp tamp ...))

...)

. body))))))))