図書館に返さないといけないので、 あとでわかるようにThe Little SchemerのY combinatorの導出過程をなぞったやつをメモメモ。

Little Schemerはlengthでやってたけど、ここではリストの和を返す手続きを作ってみる。 「それapplyでできるよ！」ってのは置いといて。

(use gauche.test)

(define (eternity x)
  (eternity x))

(test-section "lambda, lambda, lambda, ...")

; 長さ0のリストの和までおk
(define sum0-a
  ((lambda (sum)
     (lambda (l)
       (cond ((null? l) 0)
             (else (+ (car l) (sum (cdr l)))))))
   eternity))

; 長さ1のリストの和までおk
(define sum1-a
  ((lambda (sum)
     (lambda (l)
       (cond ((null? l) 0)
             (else (+ (car l) (sum (cdr l)))))))
   sum0-a))

; 長さ2のリストの和までおk
(define sum2-a
  ((lambda (sum)
     (lambda (l)
       (cond ((null? l) 0)
             (else (+ (car l) (sum (cdr l)))))))
   sum1-a))

(test "sum0-a" 0 (cut sum0-a '()))
(test "sum1-a" 1 (cut sum1-a '(1)))
(test "sum1-a" 3 (cut sum2-a '(1 2)))

(test-section "lambdaの連鎖をDRY")

(define sum0-b
  ((lambda (mk-sum)
     (mk-sum eternity))
   (lambda (sum)
     (lambda (l)
       (cond ((null? l) 0)
             (else (+ (car l) (sum (cdr l)))))))))

(define sum1-b
  ((lambda (mk-sum)
     (mk-sum
       (mk-sum eternity)))
   (lambda (sum)
     (lambda (l)
       (cond ((null? l) 0)
             (else (+ (car l) (sum (cdr l)))))))))

(define sum2-b
  ((lambda (mk-sum)
     (mk-sum
       (mk-sum
         (mk-sum eternity))))
   (lambda (sum)
     (lambda (l)
       (cond ((null? l) 0)
             (else (+ (car l) (sum (cdr l)))))))))

(test "sum0-b" 0 (cut sum0-b '()))
(test "sum1-b" 1 (cut sum1-b '(1)))
(test "sum1-b" 3 (cut sum2-b '(1 2)))

(test-section "eternityの代わりにmk-sumを")

(define sum0-c
  ((lambda (mk-sum)
     (mk-sum mk-sum))
   (lambda (sum)
     (lambda (l)
       (cond ((null? l) 0)
             (else (+ (car l) (sum (cdr l)))))))))

(test "sum0-c" 0 (cut sum0-c '()))

(test-section "このsumはmk-sumだよね")

(define sum0-d
  ((lambda (mk-sum)
     (mk-sum mk-sum))
   (lambda (mk-sum)
     (lambda (l)
       (cond ((null? l) 0)
             (else (+ (car l) (mk-sum (cdr l)))))))))

(test "sum0-d" 0 (cut sum0-d '()))

(test-section "mk-sumの引数はリストじゃなくて。ちなみにこれで再帰が1回増やせる")

(define sum1-e
  ((lambda (mk-sum)
     (mk-sum mk-sum))
   (lambda (mk-sum)
     (lambda (l)
       (cond ((null? l) 0)
             (else (+ (car l) ((mk-sum eternity) (cdr l)))))))))

(test "sum1-e" 1 (cut sum1-e '(1)))

(test-section "これで良くね？")

(define sum-f
  ((lambda (mk-sum)
     (mk-sum mk-sum))
   (lambda (mk-sum)
     (lambda (l)
       (cond ((null? l) 0)
             (else (+ (car l) ((mk-sum mk-sum) (cdr l)))))))))

(test "sum-f" 0 (cut sum-f '()))
(test "sum-f" 1 (cut sum-f '(1)))
(test "sum-f" 3 (cut sum-f '(1 2)))
(test "sum-f" 6 (cut sum-f '(1 2 3)))

(test-section "(mk-sum mk-sum)はsum")

(define sum-g
  ((lambda (mk-sum)
     (mk-sum mk-sum))
   (lambda (mk-sum)
     ((lambda (sum)
        (lambda (l)
          (cond ((null? l) 0)
                (else (+ (car l) (sum (cdr l)))))))
      (lambda (x)
        ((mk-sum mk-sum) x))))))

;(define sum-g-eternity
;  ((lambda (mk-sum)
;     (mk-sum mk-sum))
;   (lambda (mk-sum)
;     ((lambda (sum)
;        (lambda (l)
;          (cond ((null? l) 0)
;                (else (+ (car l) (sum (cdr l)))))))
;      (mk-sum mk-sum))))) ; ここで先にループしてしまう

(test "sum-g" 0 (cut sum-g '()))
(test "sum-g" 1 (cut sum-g '(1)))
(test "sum-g" 3 (cut sum-g '(1 2)))
(test "sum-g" 6 (cut sum-g '(1 2 3)))

(test-section "抽出")

(define sum-h
  ((lambda (s)
     ((lambda (mk-sum)
        (mk-sum mk-sum))
      (lambda (mk-sum)
        (s (lambda (x)
             ((mk-sum mk-sum) x))))))
   (lambda (sum)
     (lambda (l)
       (cond ((null? l) 0)
             (else (+ (car l) (sum (cdr l)))))))))

(test "sum-h" 0 (cut sum-h '()))
(test "sum-h" 1 (cut sum-h '(1)))
(test "sum-h" 3 (cut sum-h '(1 2)))
(test "sum-h" 6 (cut sum-h '(1 2 3)))

(test-section "分離")

(define ?
  (lambda (s)
    ((lambda (mk-sum)
       (mk-sum mk-sum))
     (lambda (mk-sum)
       (s (lambda (x)
            ((mk-sum mk-sum) x)))))))

(define sum-i
  (? (lambda (sum)
      (lambda (l)
        (cond ((null? l) 0)
              (else (+ (car l) (sum (cdr l)))))))))

(test "sum-i" 0 (cut sum-i '()))
(test "sum-i" 1 (cut sum-i '(1)))
(test "sum-i" 3 (cut sum-i '(1 2)))
(test "sum-i" 6 (cut sum-i '(1 2 3)))

; これをY combinatorという
(define Y
  (lambda (p)
    ((lambda (f) (f f))
     (lambda (f)
       (p (lambda (x) ((f f) x)))))))

(test-section "lengthを使わないで再帰を定義")

(define length
  (Y (lambda (len)
       (lambda (l)
         (cond ((null? l) 0)
               (else (+ 1 (len (cdr l)))))))))

(test "length 0" 0 (cut length '()))
(test "length 3" 3 (cut length '(1 2 3)))
(test "length 5" 5 (cut length '(1 2 3 4 5)))

(test-end)

うーん、わかったようなそうでもないような。まあ流れだけだなぁ。

さて、また変な時間（21時〜3時）に寝てしまって、変な時間から起きてるわけだが。