Yコンビネータ復習

前にCommonLispで書いてみたんだけど、もう全然覚えてない。
書き方もひどいな。こりゃ。
というわけでもう一度やり直してみた。
今度はもう少し詳しく書く(つもり)
使ったのはallegro common lisp


Yコンビネータができるまで

  (if (zerop n)
      0
      (+ n (fun (1- n)))))

こんな再帰関数があったとする
呼び出すとこうなる。

cl-user> (fun 3)
6

まずこの関数から

(defun fun (n)
  (if (zerop n)
      0
      (+ n (fun (1- n)))))

この中のfunを消したい。
引数としてここで呼び出す関数を受け取るように変えて、その引数をfuncallすればソースコード上からfunの呼び出しが消える。

(defun fun (rcf)
  (lambda (n)
    (if (zerop n)
    0
    (+ n (funcall rcf (1- n))))))

こうなりました。
再帰持に呼び出す関数をrcfとして引数で受け取る。
直接funを呼び出していた部分は(funcall rcf (1- n))とする。
funの引数には再帰呼び出しする関数を渡さないといけない。

(funcall (fun #'fun) 3)

funの呼び出しもこう変える。
で、実際に呼び出すとエラーになる。

cl-user> (funcall (fun #'fun) 3)
`#<Interpreted Closure (:internal fun) @ #x20822f1a>' is not of the
expected type `number'
   [Condition of type type-error]

そう。funは呼び出す関数を受け取るようになっているのに

    (+ n (funcall rcf (1- n))))))

の部分では(1- n)を渡すままになってるのが問題。
これでは動かない。ここも書き換えよう。
funは
?関数を受け取って
?数値を受け取って数値を返す関数を返す
関数。
自分自身を呼び出してほしいのだから引数には自分自身を渡す。
要は(funcall (fun #'fun) 3)と同じことをすればいい。

    (+ n (funcall rcf (1- n))))))
       ↓
    (funcall rcf rcf)

これで?がかえってくるので、これに(1- n)を渡せばいい

    (+ n (funcall rcf (1- n))))))
       ↓
    (+ n (funcall (funcall rcf rcf) (1- n))))))

結果、こんな感じになる。

(defun fun (rcf)
  #'(lambda (n)
    (if (zerop n)
    0
    (+ n (funcall (funcall rcf rcf) (1- n))))))

cl-user> (funcall (fun #'fun) 3)
6

呼び出しが(funcall (fun #'fun) 3)なのは面倒なので
(defun fun (rcf)...
をmake-funに改名して裏方に回す。
んで別のfunを作る。
こんな感じにする。

(defun make-fun (rcf)
  #'(lambda (n)
    (if (zerop n)
    0
    (+ n (funcall (funcall rcf rcf) (1- n))))))

(defun fun ()
  (make-fun #'make-fun))

cl-user> (funcall (fun) 3)
6

なんでfunを

(defun fun (n)
  (funcall (make-fun #'make-fun) n))

にしないのかは内緒。
このあたり、funcallのいるcommonlispは辛いな・・・。

(defun make-fun (rcf)
  #'(lambda (n)
    (if (zerop n)
    0
    (+ n (funcall (funcall rcf rcf) (1- n))))))
(defun fun ()
  (make-fun #'make-fun))

次に(funcall (funcall rcf rcf) (1- n)部分をローカル関数に切り出す。
こんな感じになった。

(defun make-fun (rcf)
  (labels ((callrcf (m) (funcall (funcall rcf rcf) m)))
    #'(lambda (n)
      (if (zerop n)
      0
      (+ n (callrcf (1- n)))))))

(defun fun ()
  (make-fun #'make-fun))

cl-user> (funcall (fun) 3)
6
(defun make-fun (rcf)
  (labels ((callrcf (m) (funcall (funcall rcf rcf) m)))

    #'(lambda (n)
      (if (zerop n)
       0
       (+ n (callrcf (1- n)))))))

(defun fun ()
  (make-fun #'make-fun))

今、こうなってるんだけど、もともとの処理をしている部分って枠の部分だけだよね?
「枠の部分に相当する処理を行う関数」を受け取って「make-funに相当する関数」を返す関数を作れば汎用的にならないか?

    #'(lambda (n)
      (if (zerop n)
       0
       (+ n (callrcf (1- n)))))))

囲み部分に相当する関数を受け取とるということは。。。

(defun make-f (f) ...

こんな感じで引数として関数を受け取って。。。

make-funに相当する関数を返すんだから。。。。

(defun make-f(f)
  #'(lambda (rcf) ...

こんな感じ。

あとはcallrcfの定義があって、実際の処理の代わりに引数のfをfuncallする。
全体はこんな感じ。

(defun make-f(f)
  #'(lambda (rcf)
      (labels ((callrcf (m) (funcall (funcall rcf rcf) m)))
    (funcall f #'callrcf))))

(defun fun-impl(crcf)
  #'(lambda (n)
      (if (zerop n)
      0
      (+ n (funcall crcf (1- n))))))

(defun fun ()
  (funcall (make-f #'fun-impl) (make-f #'fun-impl)))

cl-user> (funcall (fun) 3)
6

fun-implはmake-fに渡す関数。実際の再起処理を書いてある。こいつをmake-fに渡せば、make-fun相当のクロージャが返ってくる。
これで、make-funは(make-f #'fun-impl)で置き換えられることになる。
だからfunの定義は

(defun fun ()
  (make-fun #'make-fun))

から

(defun fun ()
  (funcall (make-f #'fun-impl) (make-f #'fun-impl)))

に変わってる。

さて次に

(defun fun ()
  (funcall (make-f #'fun-impl) (make-f #'fun-impl)))

を考える。
これも汎用化しよう。
リテラルで#'fun-implをmake-fの引数に渡してしまっているが、これも外から受け取るようにしてしまう。
ちょっと気が早いけど名前もYに変えよう。

(defun Y (f)
   (funcall (make-f f) (make-f f)))

(defun make-f(f)
  #'(lambda (rcf)
      (labels ((callrcf (m) (funcall (funcall rcf rcf) m)))
    (funcall f #'callrcf))))

(defun fun-impl(crcf)
  #'(lambda (n)
      (if (zerop n)
      0
      (+ n (funcall crcf (1- n))))))

(defun fun(n)
  (funcall (Y #'fun-impl) n))

cl-user> (fun 3)
6

だいたいできた。
あとは細かい調整。

まず、make-fのlabelsにある関数をリテラルで展開してしまおう。

(defun make-f(f)
  #'(lambda (rcf)
      (labels ((callrcf (m) (funcall (funcall rcf rcf) m)))
                                    この関数をリテラルにして
    (funcall f #'callrcf))))
                直接この引数に入れてしまう。

こんな感じになりました。

(defun Y (f)
  (funcall (make-f f) (make-f f)))

(defun make-f(f)
  #'(lambda (rcf)
      (funcall f #'(lambda (m) (funcall (funcall rcf rcf) m)))))

(defun fun-impl(crcf)
  #'(lambda (n)
      (if (zerop n)
      0
      (+ n (funcall crcf (1- n))))))

(defun fun(n)
  (funcall (Y #'fun-impl) n))

cl-user> (fun 3)
6

もう少し調整。

(defun Y (f)
  (funcall (make-f f) (make-f f)))

この部分のmake-fもリテラルを直接引数にしてしまう。
これでmake-f関数が消えた。
Yコンビネータできた!

(defun Y (f)
  (funcall 
   (funcall 
    #'(lambda (f)
    #'(lambda (rcf)
        (funcall f #'(lambda (m) (funcall (funcall rcf rcf) m))))) f)
   (funcall 
    #'(lambda (f)
    #'(lambda (rcf)
        (funcall f #'(lambda (m) (funcall (funcall rcf rcf) m))))) f)))

(defun fun-impl(crcf)
  #'(lambda (n)
      (if (zerop n)
      0
      (+ n (funcall crcf (1- n))))))

(defun fun(n)
  (funcall (Y #'fun-impl) n))

cl-user> (fun 3)
6

λ式で書ききるとこんな感じ。

(funcall #'(lambda (n)
  (funcall 
   (funcall 
    #'(lambda (f)
    (funcall 
     (funcall 
      #'(lambda (f)
          #'(lambda (rcf)
          (funcall f #'(lambda (m) (funcall (funcall rcf rcf) m))))) f)
     (funcall 
      #'(lambda (f)
          #'(lambda (rcf)
          (funcall f #'(lambda (m) (funcall (funcall rcf rcf) m))))) f)))
    #'(lambda (crcf)
    #'(lambda (n)
        (if (zerop n)
        0
        (+ n (funcall crcf (1- n)))))))
   n))
 3)