/2016/09/01/200000.htmlinkar-us-i.hatenablog.com

上の記事でしっかりしたモナドが作れたので、これを使って継続を実装します。

(define (cont-return x)
  (^(cont) (cont x)))

(define (cont-bind x f)
  (^(cont)
    (x (^(xval)
         ((f xval) cont)))))

(define cont-monad
  (make <monad>
    :return cont-return
    :bind cont-bind))

Contモナドは暗黙的なCPS変換を行うモナドです。暗黙引数?monadにcont-monadが与えられた場合、(mreturn x)は継続を引数に受け取ってその継続にxを渡す関数となります。

次に、call/ccに相当する関数を作ってみます。

(define (mcall/cc handler)
  (^(cont)
    (handler cont)))

簡単ですね。Contモナドの中ではすべての式はCPS変換されているので、貰った継続をそのまま渡せばOKです。

実行例は以下の通り。

(define *mcont* #f)
(let ((?monad cont-monad))
  ((mlet*
    ((result
      (mcall/cc
       (^(cont)
         (set! *mcont* cont)
         (cont "hoge")))))
    (mreturn result))
   identity ; 最後に「トップレベルへの継続」に相当するものを渡す
   ))
;; => "hoge"

(*mcont* "fuga") ; 保存した継続は後から呼び出せる
;; => "fuga"

もちろん、(mlet* ..)の結果を保存しておいて、後で継続とともに呼び出すこともできます。

(define *mcont2* #f)
(define *mcont3* #f)
(define proc (let ((?monad cont-monad))
  (mlet*
   ((x (mcall/cc
        (^(cont)
          (set! *mcont2* cont)
          (cont "hoge"))))
    (y (mcall/cc
        (^(cont)
          (set! *mcont3* cont)
          (cont "fuga")))))
   (mreturn (format #f "~s: ~s" x y)))))

(proc print)     ; => "hoge": "fuga"
(*mcont2* "foo") ; => "foo": "fuga"
(*mcont3* "bar") ; => "foo": "bar"

関連記事