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))))))))