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

一本目の記事では二分探索しか出来ませんでしたが、工夫すればちゃんとload-time-valueでジャンプテーブルに変換できました。追記だと気づいていない人も多いと思うので別記事にしました。

fcase8

load-time-valueでうまく行かなかったのは変数にアクセスできないからなので、
明示的に変数を関数に引数として渡せばいいのではないだろうかと思い、やってみます。

(defmacro fcase8 (i (&rest vars) &body body)
  `(funcall
    (svref (load-time-value (vector
                             ,@(iter (for b in body)
                                     (for j from 0)
                                     (collecting
                                      `(lambda (,i ,@vars) (locally (declare ((eql ,j) ,i)) ,b)))))
                            t)
           ,i)
    ,i ,@vars))

(defun 4096way/fcase8 (i)
  (let ((rand (random 10)))
    (fcase8 i (rand) ; 依存している変数であるrandをfcase8マクロに伝える
      . #.(loop :for x :from 0 :repeat 4096
             :collect `(progn (* i rand))))))

(test #'4096way/case 4095)   ; 8.9sec
(test #'4096way/case 0)      ; 0.044sec
(test #'4096way/fcase8 4095) ; 0.051sec
(test #'4096way/fcase8 0)    ; 0.053sec

あっさり、引数が0でも4095でも元のcaseバージョンの0と同等の速度になりました。

fcase9 (最終形態?)

でもやっぱり、手で外側の引数を伝えないといけないのはあまりうまくない。
そこで、処理系依存の関数に手を出します。

cltl2というANSIからは抜けた規格が合って、そこには(variable-information var env)という関数があります。これは、macro functionでだけ渡されるenvironment引数envと変数名varを渡すことで、展開時現在でのvarの状況(型、specialかlexicalか、symbol-macroか、etc)を知ることが出来ます。

しかし今知りたいのは「lexicalにboundされた全ての変数のリスト」なので、この手は使えません。変数の名前を知らないので。そこで、SBCLのvariable-informationの実装あたりを見て、処理系依存ですが env からlexcal var list を手に入れる方法を実装したのが以下。fcase4の派生。

(defun find-lexical-variables (env)
  (mapcar #'car
          (sb-c::lexenv-vars
           (sb-c::coerce-to-lexenv env))))

(defmacro fcase9 (i &body body &environment env)
  (let ((vars (find-lexical-variables env)))
    `(funcall
      (svref (load-time-value (vector
                               ,@(iter (for b in body)
                                       (for j from 0)
                                       (collecting
                                        `(lambda (,@vars) (locally (declare ((eql ,j) ,i)) ,b)))))
                              t)
             ,i)
      ,@vars)))


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

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

(test #'4096way/fcase9 4095) ; 0.050 sec
(test #'4096way/fcase9 0)    ; 0.050 sec

コードはこちら。
https://gist.github.com/guicho271828/707be5ad51edb858ff751d954e37c267