Y combinator for mutual recursive functions

mutualY.scm

#lang racket
;; and the end of : https://yinwang0.wordpress.com/2012/04/09/reinvent-y/

;; Exercise: The Y combinator derived from this tutorial only works for direct recursion,
;; try to derive the Y combinator for mutual recursive functions, for example the following two functions even and odd.

(define even
  (lambda (x)
    (cond
     [(zero? x) #t]
     [(= 1 x) #f]
     [else (odd (sub1 x))])))

(define odd
  (lambda (x)
    (cond
     [(zero? x) #f]
     [(= 1 x) #t]
     [else (even (sub1 x))])))

(even 42) ; #t
(odd 233) ; #t

;; 1. Bind, to a name

;; lambda-even
(lambda (even odd)
  (lambda (x)
    (cond
     [(zero? x) #t]
     [(= 1 x) #f]
     [else (odd (sub1 x))])))

;; lambda-odd
(lambda (odd even)
  (lambda (x)
    (cond
     [(zero? x) #f]
     [(= 1 x) #t]
     [else (even (sub1 x))])))

;; try to work out a m-Y like this:
;; (define m-Y
;;     (lambda (lambda-even lambda-odd)
;;         some-magic-here)) => get the "even"
;;
;; (define even1
;;     (m-Y
;;         (lambda (even odd)
;;             (lambda (x)
;;                 (cond
;;                 [(zero? x) #t]
;;                 [(= 1 x) #f]
;;                 [else (odd (sub1 x))])))
;;
;;         (lambda (odd even)
;;             (lambda (x)
;;                 (cond
;;                 [(zero? x) #f]
;;                 [(= 1 x) #t]
;;                 [else (even (sub1 x))])))))
;;
;; (define odd1
;;     (m-Y
;;         (lambda (odd even)
;;             (lambda (x)
;;                 (cond
;;                 [(zero? x) #f]
;;                 [(= 1 x) #t]
;;                 [else (even (sub1 x))])))
;;         (lambda (even odd)
;;             (lambda (x)
;;                 (cond
;;                 [(zero? x) #t]
;;                 [(= 1 x) #f]
;;                 [else (odd (sub1 x))])))))
;;
;; (odd1 233) ; #t
;; (even1 42) ; #t

;; 2. Copy, each-other-application
((lambda (even odd)
   (lambda (x)
     (cond
      [(zero? x) #t]
      [(= 1 x) #f]
      [else (odd (sub1 x))])))
 ;; arg1
 (lambda (even odd)
   (lambda (x)
     (cond
      [(zero? x) #t]
      [(= 1 x) #f]
      [else (odd (sub1 x))])))
 ;; arg2
 (lambda (odd even)
   (lambda (x)
     (cond
      [(zero? x) #f]
      [(= 1 x) #t]
      [else (even (sub1 x))]))))

;; 3. fix: first argument to the application should be itself
((lambda (even odd)
   (lambda (x)
     (cond
      [(zero? x) #t]
      [(= 1 x) #f]
      [else ((odd odd even) (sub1 x))])))
 ;; arg1
 (lambda (even odd)
   (lambda (x)
     (cond
      [(zero? x) #t]
      [(= 1 x) #f]
      [else ((odd odd even) (sub1 x))])))
 ;; arg2
 (lambda (odd even)
   (lambda (x)
     (cond
      [(zero? x) #f]
      [(= 1 x) #t]
      [else ((even even odd) (sub1 x))]))))

;; test
(((lambda (even odd)
    (lambda (x)
      (cond
       [(zero? x) #t]
       [(= 1 x) #f]
       [else ((odd odd even) (sub1 x))])))
  ;; arg1
  (lambda (even odd)
    (lambda (x)
      (cond
       [(zero? x) #t]
       [(= 1 x) #f]
       [else ((odd odd even) (sub1 x))])))
  ;; arg2
  (lambda (odd even)
    (lambda (x)
      (cond
       [(zero? x) #f]
       [(= 1 x) #t]
       [else ((even even odd) (sub1 x))]))))
 42) ;; => #t

;; 4. extract it
;; outer form
((lambda (f1 f2) (f1 f1 f2))
 (lambda (even odd)
   (lambda (x)
     (cond
      [(zero? x) #t]
      [(= 1 x) #f]
      [else ((odd odd even) (sub1 x))])))
 ;; arg2
 (lambda (odd even)
   (lambda (x)
     (cond
      [(zero? x) #f]
      [(= 1 x) #t]
      [else ((even even odd) (sub1 x))]))))

;; inner form
;; ((lambda (f1 f2) (f1 f1 f2))
;;     (lambda (even odd)
;;       ((lambda (g1)
;;         (lambda (x)
;;             (cond
;;             [(zero? x) #t]
;;             [(= 1 x) #f]
;;             [else (g1 (sub1 x))])))
;;        (odd odd even)))
;;     ;; arg2
;;     (lambda (odd even)
;;       ((lambda (g2)
;;         (lambda (x)
;;             (cond
;;             [(zero? x) #f]
;;             [(= 1 x) #t]
;;             [else (g2 (sub1 x))])))
;;        (even even odd))))

;; racket/scheme call by value ,use eta-expansion


((lambda (f1 f2) (f1 f1 f2))
 (lambda (even odd)
   ((lambda (g1)
      (lambda (x)
        (cond
         [(zero? x) #t]
         [(= 1 x) #f]
         [else (g1 (sub1 x))])))
    (lambda (v1) ((odd odd even) v1))))
 (lambda (odd even)
   ((lambda (g2)
      (lambda (x)
        (cond
         [(zero? x) #f]
         [(= 1 x) #t]
         [else (g2 (sub1 x))])))
    (lambda (v1) ((even even odd) v1)))))


;; extract even odd

(define m-Y
  (lambda (h1 h2)
    ((lambda (f1 f2) (f1 f1 f2))
     (lambda (p1 p2)
       (h1
        (lambda (v1) ((p2 p2 p1) v1))))
     (lambda (p2 p1)
       (h2
        (lambda (v1) ((p1 p1 p2) v1)))))))


(define even1
  (m-Y
   (lambda (odd)
     (lambda (x)
       (cond
        [(zero? x) #t]
        [(= 1 x) #f]
        [else (odd (sub1 x))])))
   (lambda (even)
     (lambda (x)
       (cond
        [(zero? x) #f]
        [(= 1 x) #t]
        [else (even (sub1 x))])))))

(even1 42) ; => #t

see

http://typeof.net/2014/m/formation-of-modern-magic--poly-variadic-fixed-point-combinator.html