継続による時間操作とフィラデルフィア・エミュレータ(2)

要約:

副作用無し(と言うにはかなり怪しいが)で実装されたambを二種類、作った。

前回の続き。
ambが一つだけなら、amb自体が破壊的更新を行っても問題は無いが、複数のambが組み合わさってバックトラックされる可能性があると、破壊的更新してしまうのはまずいので、ambを作り直す事になった。
じゃあ、どう実装すれば良いのか。
要するに、ambによってバックトラックが発生した時に、他のambの内部状態もロールバックされれば良いという話なので、ここでは二つのアプローチを考えてみた。

dynamic-wind(に類する仕組みであるgauche.parameter)を使って、継続のロールバックが起こったら勝手に他のambもその時点の状態に巻き戻るようにする。
各ambの内部状態は単一のスタックに保存するようにし、また、各ambにはそれぞれ固有の識別シンボルを発行し、特定ambが起こしたバックトラックは「スタックを、前回の該当ambの位置にまで戻してから再実行」として実装する。

前者の実装。

(use gauche.parameter)
(define (make-closure-amb . opt-failed-thunk)
  (let1 fail (make-parameter (get-optional opt-failed-thunk
                               (lambda ()
                                 (error "amb failed"))))
    (define (closure-amb . opts)
      (let-optionals* opts ((targets '()) proc)
        (cond
          ((null? targets) ((fail)))
          ((null? (cdr targets)) (proc (car targets)))
          (else
            (let/cc all-done
              (let/cc backtrack
                (parameterize ((fail backtrack))
                  (all-done (proc (car targets)))))
              (closure-amb (cdr targets) proc))))))
    closure-amb))

後者の実装。

(use srfi-1)
(define make-amb
  (let1 amb-stack '()
    (lambda opt-failed-thunk
      (let1 amb-symbol (gensym)
        (define (amb-stack-push! thunk)
          (push! amb-stack (cons amb-symbol thunk)))
        (define (amb-backtrack!)
          (let1 backtrack (find-tail
                            (lambda (x)
                              (eq? amb-symbol
                                   (car x)))
                            amb-stack)
            (unless backtrack
              (error "assertion"))
            (set! amb-stack (cdr backtrack))
            (cdar backtrack)))
        (define (fail)
          ((amb-backtrack!)))
        (define (choose2 . args)
          (if (null? args)
            (fail)
            (let/cc cc
              (amb-stack-push! (lambda ()
                                 (cc (apply choose2 (cdr args)))))
              (car args))))
        (amb-stack-push! (get-optional opt-failed-thunk
                           (lambda ()
                             (error "amb failed"))))
        choose2))))

とりあえず、両方とも正常に動いた(ように見えた、自分には)。
しかし、それぞれ固有の癖があり、どちらも一長一短であった。

closure-ambの特徴。

dynamic-wind(と同性能のgauche.parameter)によって実装されているので、ambの最中にcall/ccで継続を保存し、あとで継続を辿っても、バックトラックポイントの正しい復元が行われる。
しかし、明示的にambの有効範囲をクロージャとして指定する必要がある為、(pythag (choose 1 2 3) (choose 3 4 5) (choose 4 5 6))のような分かりやすい表記はできなくなってしまった。
その反面、明示的にambの有効範囲を指定できるという事で、そのクロージャを抜ければ、ambの内部に不要なバックトラックポイントが残ってしまう事がなくなった(オリジナルのambでは恒久的にバックトラックポイントが残ってしまうように思える)。

choose2の特徴。

dynamic-windを使って実装していたりはしないので、amb最中にcall/ccで継続を保存して、あとで継続を辿っても正しくロールバックされない。
しかし、(pythag (choose 1 2 3) (choose 3 4 5) (choose 4 5 6))のような、これまで通りの表記が可能。
オリジナルのambと同様に、不要なバックトラックポイントがスタック内部に恒久的に残ってしまう問題はあるが、各amb毎に識別子を持つようにした為、きちんとamb生成部分から実行している限り、検索が最後まで成功しなかった場合でも、無関係なバックトラックポイントまで戻り過ぎてしまうような事は起こらない、筈。また、内部でこっそり自前のGCを持たせるようにする事も可能そうな気はする。

今回の場合、

ambとしての分かりやすさは不要
なんか今後再利用しそうな気がする
途中でcall/cc使いそうな気もする

という事で、closure-ambの方の実装を選ぶ事にした。

次回に続く。