追試+改善: 「#:g1: Common Lispで多方向分岐の最適化がされない場合にどうするか」

C のswitch文は(一定の条件で?)ジャンプテーブルに変換されるらしいですね。
つまり、引数となる値から、直接対象となるcase文にジャンプ命令でジャンプできます。
lispも昔のlispはサポートしていた模様。残念ながら最近の速いコンパイラであるSBCLには入ってません。

で、コンパイラには手を入れず、マクロを使って同じものを実装しようという試みがあります。

元記事: http://g000001.cddddr.org/3644058435
参考記事: https://web.archive.org/web/20040613044135/http://www.tfeb.org/programs/ncase.lisp
参考記事: http://ml.cddddr.org/slug/msg02816.html

で、追試します。

case

コードは元記事から。

(defun 256way/case (i)
  (let ((rand (random 10)))
    (case i
      . #.(loop :for x :from 0 :repeat 256
                :collect `((,x) (progn (* i rand)))))))

;; 同等コード
(defun 256way/case (i)
  (let ((rand (random 10)))
    (case i
      ((0) (progn i rand))
      ((1) (progn i rand))
      ((2) (progn i rand))
      ...
      ((255) (progn i rand)))))

(test #'256way/case 255) ; 0.232 sec
(test #'256way/case 0)   ; 0.050 sec

testの中身は適当に想像してください。繰り返してるだけです。
予想通り i=255の時は 255回比較が行われるため遅く, そして i=0のときは一回目の比較で成功するため速いです。手でこんなcase文を書くことはないだろうと思いますが、lispだとマクロでそういう式を生成してコンパイルすることが普通にあるので、こういう違いは効きます。

どうせ展開結果が想像しづらいと思いますので、以降は展開結果の方だけ載せます。

fcase

これも元記事から。vectorに関数を貯めて、それを呼び出します。
ヒープにvectorとクロージャが作られるので遅いです。0と255の速度差はなくなりましたけど...

(defmacro fcase (i &body body)...)

(funcall
 (svref
  (vector (lambda () (progn (* i rand)))
          ... ; 256個
          (lambda () (progn (* i rand))))
  i))

(test #'256way/fcase 255) ; 4.3sec 10,255,897,520 bytes consed
(test #'256way/fcase 0)   ; 4.3sec 10,255,902,528 bytes consed

ここがベースラインになります。

fcase2

まずはlambdaのアロケートをflet(局所関数)で抑えられるか試してみます。

(flet ((f0 () (progn (* i rand)))
       (f1 () (progn (* i rand)))
       (f2 () (progn (* i rand)))
       ...)
  (let ((v (vector #'f0 #'f1 ... #'f255)))
    (funcall (svref v i))))


(test #'256way/fcase2 255) ; 4.3sec 10,255,887,264 bytes consed
(test #'256way/fcase2 0)   ; 4.4sec 10,255,902,256 bytes consed

だめですね。

fcase3

dynamic-extentでヒープアロケーションをなくします。(スタックアロケーションになる)

(flet ((f0 () (progn (* i rand)))
       (f1 () (progn (* i rand)))
       (f2 () (progn (* i rand)))
       ...)
  (declare (dynamic-extent #'f0 #'f1 ... #'f255))
  (let ((v (vector #'f0 #'f1 ... #'f255)))
    (declare (dynamic-extent v))
    (funcall (svref v i))))

(test #'256way/fcase3 255) ; 1.192 sec 0 bytes consed
(test #'256way/fcase3 0)   ; 1.187 sec 0 bytes consed

ヒープアロケーションは抑えられ、ちょっとましになりました。
が、まだ全然遅いです。これは、たとえスタックアロケーションだとしても時間がかかるからでしょうか。

元のcaseのほうは実は case でマッチされた後に定数畳み込みが入っているので、
case3も型宣言を入れたら速いかと思ったのですが、それもありませんでした。

fcase4,fcase5 (コンパイルできない)

ここで、load-time-value を使ってみます。これは元記事ではncaseと呼ばれていたやつで使われていた手法です。(load-time-value form) は、ファイルをロードするときにformを評価して、結果をコード内に直接挿入します。なので、(load-time-value (make-array...)) は、global領域に無名の配列を作ってそこにアクセスするような形になります。(load-time-value (make-array...) t) だとglobalかつstaticな配列であることが期待されます。

こうしておけば、関数が呼ばれるたびにベクタが作られることはないのではと考えるわけです。

(defun 256way/fcase4 (i)
  (let ((rand (random 10)))
    (funcall
     (svref
      (load-time-value
       (vector (lambda () (progn (* i rand))) ...
               (lambda () (progn (* i rand))))
       t)
      i))))

しかし問題が... この関数はコンパイルできません。それは、 load-time-value のformはnull lexical environment で評価される (周りの変数を考慮していない) ので、randやi変数が見えないんですね。formである(vector ...)を評価する際に、unbound variableでエラー吐いてコンパイルできません。

元のncaseも同じ問題があって、マクロの外の変数を読むことが出来ません。
(cltl2:variable-information とか使えばいけるかな...宿題)

fcase5はこれのflet版です。randへの参照がload-time-valueの外に出来るからいけるかなと思ったのですが、よく考えたら局所関数へのlexical bindingも見えないのでダメでした。

fcase6

ここらへんを改善しようと、次はキャッシュを考えてみました。つまり最初の一回は遅いが、二回目以降は速い。キャッシュは、 (load-time-value (list nil)) でフラグを格納するメモリセルを用意して、ここに値を書き込んで実装します。

(defmacro fcase6 (i &body body)
  (with-gensyms (flag v)
    `(flet ,(iter (for b in body)
                  (for i from 0)
                  (collecting
                   `(,(sym 'f i) () ,b)))
       (declare (dynamic-extent ,@(iter (for i below (length body))
                                        (collecting `(function ,(sym 'f i))))))
       (let ((,flag (load-time-value (list nil)))
             (,v (load-time-value
                  (make-array ,(length body) :element-type 'function :initial-element (lambda ())))))
         (unless (car ,flag)
           (setf (car ,flag) t)
           ,@(iter (for i below (length body))
                   (collecting `(setf (aref ,v i) (function ,(sym 'f i))))))
         (funcall (svref ,v ,i))))))

(test #'256way/fcase6 255) ; 1.06sec 0 bytes
(test #'256way/fcase6 0)   ; 1.075sec 0 bytes

早くなりましたが、ほんのちょっとですね...理由は分からず。
(というか、dynamic-extentなものを保存するのって危ない気がする...)

fcase7

元記事のコメントであったバイナリサーチを試してみます。展開すると以下のようになります。
(caseと同じくiの値は型からconstant foldされます)

(flet ((f0 () (locally (declare ((eql 0) i)) (progn (* i rand))) ...))
  (declare
   (dynamic-extent (function f0) ...))
  (if (logbitp 7 i)
      (if (logbitp 6 i)
          (if ...
                          (if (logbitp 1 i)
                              (if (logbitp 0 i)
                                  (f255)
                                  (f254))
                              (if (logbitp 0 i)
                                  (f253)
                                  (f252))) ...)))))))

(test #'256way/fcase7 255) ; 0.100 0 bytes
(test #'256way/fcase7 0)   ; 0.100 0 bytes
;;再掲
(test #'256way/case 255) ; 0.232 sec
(test #'256way/case 0)   ; 0.050 sec

まあ、平均的な値にはなりましたね...もっと大きい値ならどうでしょう。

(test #'4096way/case 4095)   ; 8.9sec
(test #'4096way/case 0)      ; 0.044sec
(test #'4096way/fcase7 4095) ; 0.128sec
(test #'4096way/fcase7 0)    ; 0.129sec

まあ、実用的になったといえるでしょうか。
バイナリサーチならスパースなパターンでも対応できるので、これもあってよいかもしれません。