マクロでtarai回し 2回目

また今度と言ってから8時間しか経ってないけど、どうやらできたみたいなので公開。

まず、普通の関数で引数の評価を遅らせることを考えてみる(r/oはregular order=正規順序の意味)。

(define (tarai-r/o x y z)
  (let ((x-value (force x))
        (y-value (force y)))
    (if (<= x-value y-value)
        y-value
        (let ((z-value (force z)))
          (tarai-r/o (delay (tarai-r/o (1- x-value) y z))
                     (delay (tarai-r/o (1- y-value) z x))
                     (delay (tarai-r/o (1- z-value) x y)))))))

そうしたら、例によってこれをCPSに変換する。

(define (tarai-r/o-cps-0 x y z k)
  (if (promise? x)
      (force-cps-0 x (cut tarai-r/o-cps-1 x y z <> k))
      (tarai-r/o-cps-1 x y z x k)))

(define (tarai-r/o-cps-1 x y z x-value k)
  (if (promise? y)
      (force_cps y (cut tarai-r/o-cps-2 x y z x-value <> k))
      (tarai-r/o-cps-2 x y z x-value y k)))

(define (tarai-r/o-cps-2 x y z x-value y-value k)
  (if (<= x-value y-value)
      (k y-value)
      (tarai-r/o-cps-3 x y z x-value y-value k)))

(define (tarai-r/o-cps-3 x y z x-value y-value k)
  (if (promise? z)
      (force_cps z (cut tarai-r/o-cps-4 x y z x-value y-value <> k))
      (tarai-r/o-cps-4 x y z x-value y-value <> k)))

(define (tarai-r/o-cps-4 x y z x-value y-value z-value k)
  (tarai-r/o-cps-0 (delay (tarai-r/o-cps-0 (1- x-value) y z <>))
                   (delay (tarai-r/o-cps-0 (1- y-value) z x <>))
                   (delay (tarai-r/o-cps-0 (1- z-value) x y <>))
                 k))

ここまでくれば、あとはもうマクロに変換するだけ。

(define-syntax tarai-r/o
  (syntax-rules ()
    ((_ "call" %x %y %z)
     (tarai-r/o 0 %x %y %z))

    ((_ 0 ("delay" %x) %y %z %k ...)
     (tarai-r/o "force" %x (tarai-r/o 1 %y %z) %k ...))

    ((_ 0 %x %y %z %k ...)
     (tarai-r/o 1 %y %z %x %k ...))

    ((_ 1 ("delay" %y) %z %x-value %k ...)
     (tarai-r/o "force" %y (tarai-r/o 2 %z %x-value) %k ...))

    ((_ 1 %y %z %x-value %k ...)
     (tarai-r/o 2 %z %x-value %y %k ...))

    ((_ 2 %z %x-value %y-value %k ...)
     (tarai-r/o "loop" %x-value %y-value %z %x-value %y-value %k ...))

    ((_ "loop" (%x1 %x2 ...) (%y1 %y2 ...) %z %x-value %y-value %k ...)
     (tarai-r/o "loop" (%x2 ...) (%y2 ...) %z %x-value %y-value %k ...))

    ((_ "loop" () (%y1 ...) %z %x-value %y-value %k ...)
     (tarai-r/o "return" %y-value %k ...))

    ((_ "loop" (%x1 %x2 ...) () %z %x-value %y-value %k ...)
     (tarai-r/o 3 %z %x-value %y-value %k ...))

    ((_ 3 ("delay" %z) %x-value %y-value %k ...)
     (tarai-r/o "force" %z (tarai-r/o 4 %x-value %y-value) %k ...))

    ((_ 3 %z %x-value %y-value %k ...)
     (tarai-r/o 4 %x-value %y-value %z %k ...))

    ((_ 4 (%x1 %x2 ...) (%y1 %y2 ...) (%z1 %z2 ...) %k ...)
     (tarai-r/o 0
                ("delay" (tarai-r/o 0 (%x2 ...) (%y1 %y2 ...) (%z1 %z2 ...)))
                ("delay" (tarai-r/o 0 (%y2 ...) (%z1 %z2 ...) (%x1 %x2 ...)))
                ("delay" (tarai-r/o 0 (%z2 ...) (%x1 %x2 ...) (%y1 %y2 ...)))
                %k ...))

    ((_ "return" %val)
     %val)

    ((_ "return" %val (%k1 ...) %k2 ...)
     (tarai-r/o "force" (%k1 ... %val) %k2 ...))

    ((_ "force" (%f ...) %k ...)
     (%f ... %k ...))

    ))

ちょっとしたトリックとして、継続スタックを自前で操作することによってマクロの中で自分自身を呼んでその戻り値を得ることができる。まあ、CPSをベースにしたんだからそう難しいことじゃないんだけど。

動作確認：

(macroexpand '(tarai-r/o "call" (() () () () () ()) (() ()) (())))
==> (() () () () () ())

引数の完全な評価を行っていないので、前の版よりも多少は高速化されているはず。