LISPUSER

(define (solve)
  (let* ((x (in-range 0 100))
         (y (in-range 0 100))
         (z (in-range 0 100)))
    (if (= (* x x) (+ (* 2 y) z 500))
        (list x y z)
        (fail "no solution"))))

(display (solve))

方針

• in-range で変数毎に継続を作る
• fail で失敗したら，作っておいた継続をつかってやり直す

考えた事

クロージャで値を覚える簡単なジェネレータを考えてみます．

(define gen/closure
 （lambda ()
    (let ((n -1))
      (lambda ()
        (set! n (+ n 1))
        n))))

これを使うと

> (define f (gen/closure))
> (f)
0
> (f)
1
> (f)
2

のようにジェネレータが実現できます．これは状態 n を書きかえる事でジェネ レータを実現しています．これを継続で表現してみましょう．まず，

(define f
  (lambda (n)
    (f (+ n 1))))

という再帰関数を考えます．

この関数は次々と (f 0) -> (f 1) -> (f 2) -> と再帰してしまいますが， 再帰する直前の継続を考えてみましょう．(f 0) -> [継続1] -> (f 1) -> [継続2] -> (f 2) -> [継続3] と考えます．ここで，継続を覚えておいて処 理を中断できれば，ジェネレータを実現できそうですね．

;; 0 を返す
1. (f 0)
2. 継続を覚える
3. 値 0 を返す

;; 1 を返す
2. で覚えた継続を呼びだす
3. (f 1)
4. 継続を覚える
5. 値 1 を返す

;; 2 を返す
6. で覚えた継続を呼びだす
7. (f 2)
8. 継続を覚える
9. 値 3 を返す

これをプログラムにしようとすると，「値 0 を返す」といった処理が困ってい まいます．これはどうやって実現すれば良いでしょうか？そう，答えは「値を 返す直前の継続」を使うのです．

;; ただ値を返す
(defun f1
  (lambda ()
    'undefined)) ;; 返したい値 

(define cc #f) ;; 継続
;; 値を返す直前の継続を覚える
(defun f2
  (lambda ()
    (call/cc
      (lambda (k)
        (set! cc k)) ;; この K が値を返す
        'undefined)))

> (f1)
'undefined
> (f2)
'undefined
> (cc 1)
1
> (cc 2)
2

となります．ここで継続 cc に保存されている継続が値を返す継続です． ここまでくれば

(define gen/cc
  (let ((*値を返す継続* #f))
    (letrec ((next (lambda () (step 0)))
             (step (lambda (n)
                     [継続を覚える]
                     [値を返す]
                     (step (+ n 1)))))
      (lambda ()
        (lambda ()
         [値を返す継続を覚える]
         [継続を呼びだす])))))

上記のような関数が理解できると思います．これを Scheme のコードで実現すると

(define gen/cc
  (let ((success #f))
    (letrec ((next (lambda () (step 0)))
             (step (lambda (n)
                     (call/cc
                      (lambda (k)
                        (set! next k)
                        (success n)))
                     (step (+ n 1)))))
      (lambda ()
        (lambda ()
          (call/cc
           (lambda (k)
             (set! success k)
             (next))))))))

となります．同様の方法で，任意の再帰関数の継続を取り出してジェネレータ にできます．

挑戦編

今回は指定された範囲の値を返しつづける関数を考えました． とりあえず正の整数の範囲で動けばいいや，という版．

(define range
  (lambda (beg end)
     (cond ((< beg end)
            (range (+ beg 1) end))
           (else
             end))))

(use srfi-1)

;; 継続を保持するためのリスト
(define all-ranges ())

;; 継続が呼ばれるたびに順番に値を生成する
(define (in-range beg end)
  (let ((id (gensym))
        (success '?))
    (letrec ((cont-success
              (lambda (x) (gen beg end)))
             (gen
              (lambda (beg end)
                (cond ((< beg end)
                       (call/cc
                        (lambda (k)
                          (set! cont-success k)
                          (success beg)))
                       (gen (+ beg 1) end))
                      ((= beg end)
                       (set! all-ranges
                             (remove (lambda (x) (eq? (car x) id))
                                     all-ranges))
                       end)))))
      (call/cc
       (lambda (k)
         (if (assoc id all-ranges)
             #f
             (set! all-ranges (cons (cons id k) all-ranges)))))
      (call/cc
       (lambda (k)
         (set! success k)
         (cont-success 'done))))))

;; 継続が残っていれば，それを呼びだす．もう継続がなくなっていたらあきらめる
(define (fail msg)
  (cond ((null? all-ranges)
         "No solution")
        (else
         ((cdar all-ranges) #f))))

ほんとにあってるのかな？大域変数使うわけないような気がするのですが．

なんだかんだで楽しみにしているので，planet-scheme にははやく復旧しても らいたいです．

2006/02/27 解答編

Planet Scheme 復旧したので見てみました．答えは……おぉ，見事． 私のはこれに比べたらまるで C のコードだ…… orz

なんと fail を書きかえていくとゆう方針でした．頭イイなぁ．解答のでは， fail 関数に関数の継続を記憶していってます．fail するたびに 0, 1, 2, 3 というように値を増す変数を考えましょう．

(define fail (lambda () (error "no solution")))

(define gen/cc
  (lambda ()
    (call/cc
     (lambda (cont)
       (step 0 cont)))))

;; (define step (lambda (n) (step (+ n 1)))) 相当    
(define step
  (lambda (n cont)
    (let ((save fail))
      (set! fail
            (lambda ()
              (set! fail save)
              (step (+ n 1) cont)))
      (cont n))))

> (define x (gen/cc))
> x
0
> (fail)
> x
1
> (fail)
> x
2

となります．キモは fail を呼ぶ時に，「既存の定義に fail を戻した後，次 のスッテプに進む」fail を作るところですね．こら面白い．何もなくなったら 最初の fail の定義に戻るため，全ての状態を尽して fail するとエラーがで る，と．

(define in-range
  (lambda (a b)
    (call/cc
     (lambda (cont)
       (enumerate a b cont)))))

(define enumerate
  (lambda (a b cont)
    (if (> a b)
        (fail)
        (let ((save fail))
          (set! fail
                (lambda ()
                  (set! fail save)
                  (enumerate (+ a 1) b cont)))
          (cont a)))))

(let ((x (in-range 0 100))
      (y (in-range 0 100))
      (z (in-range 0 100)))
  (if (= (* x x)
         (+ (* 2 y) z 500))
      (list x y z)
      (fail))) ; => (23 0 29)

おもしろいな〜．↓の説明がわかりやすいっす．

http://www.iro.umontreal.ca/%7Eboucherd/mslug/meetings/20041020/minutes-en.html