2010-12-29

文字列操作の性能(1)

Common Lispで文字列を操作する場合に、何種類かある方法のうち、どれが一番効率的か知りたかったので、調べることにした。今回は参照編。

次のコードを使って、シーケンシャルアクセスの時間を測った。処理系はClozure CL 1.6。get-internal-real-timeの単位はミリ秒。

(defmacro with-random-string ((var &optional (length 1000)) &body body)
  `(let ((,var (make-string ,length)))
     (iter (for i index-of-string ,var)
           (setf (aref ,var i) (code-char (+ 32 (random 95)))))
     ,@body))

(defmacro with-null-stream ((var) &body body)
  `(let ((,var (make-two-way-stream (make-concatenated-stream) 
                                    (make-broadcast-stream))))
     (with-open-stream (,var ,var)
       ,@body)))

(defmacro with-benchmark (&body body)
  (with-gensyms (time)
    `(let ((,time (get-internal-real-time)))
       ,@body
       (- (get-internal-real-time) ,time))))

(defparameter *times* 1000)
(defparameter *length* 1024)

(iter (repeat *times*)
      (sum (with-random-string (str *length*)
             (with-null-stream (*standard-output*)
               (with-benchmark
                 (iter (for i index-of-string str)
                       (princ (char str i))))))))

(iter (repeat *times*)
      (sum (with-random-string (str *length*)
             (with-null-stream (*standard-output*)
               (with-benchmark
                 (iter (for i index-of-string str)
                       (princ (aref str i))))))))

(iter (repeat *times*)
      (sum (with-random-string (str *length*)
             (with-null-stream (*standard-output*)
               (with-benchmark
                 (iter (for i index-of-string str)
                       (princ (elt str i))))))))

(iter (repeat *times*)
      (sum (with-random-string (str *length*)
             (with-null-stream (*standard-output*)
               (with-input-from-string (s str)
                 (with-benchmark
                   (iter (for c = (read-char s nil))
                         (while c)
                         (princ c))))))))

結果は、

関数 所要時間(ミリ秒)
char 1093
aref 998
elt 1063
read-char 1189

arefが一番速い。eltは、型に合わせて下位のアクセサを呼ぶと思っていたので、一番速くないのは予想通り。何となくcharはプリミティブなアクセサだと思い込んでいたけど、実際はarefとeltよりも遅い。文字列ストリームが一番遅いのは予想外。予想以上に上位の関数で組み立てられている模様。

実際のコードを読んでみた。まずはchar。

(defun char (string index)
  "Given a string and a non-negative integer index less than the length of
  the string, returns the character object representing the character at
  that position in the string."
  (if (typep string 'simple-string)
    (schar (the simple-string string) index)
    (if (stringp string)
      (multiple-value-bind (data offset) (array-data-and-offset string)
        (schar (the simple-string data) (+ index offset)))
      (report-bad-arg string 'string))))

scharを呼んでいる。scharの定義は、

(defun schar (s i)
  "SCHAR returns the character object at an indexed position in a string
   just as CHAR does, except the string must be a simple-string."
  (let* ((typecode (typecode s)))
    (declare (fixnum typecode))
    (if (= typecode target::subtag-simple-base-string)
      (aref (the simple-string s) i)
      (report-bad-arg s 'simple-string))))

で、結局呼ぶのはaref。Common Lispでは文字列は文字のベクタなので、ベクタに対する処理のarefの方が下位ということなんだろう。

(defun aref (a &lexpr subs)
  "Return the element of the ARRAY specified by the SUBSCRIPTS."
  (let* ((n (%lexpr-count subs)))
    (declare (fixnum n))
    (if (= n 1)
      (%aref1 a (%lexpr-ref subs n 0))
      (if (= n 2)
        (%aref2 a (%lexpr-ref subs n 0) (%lexpr-ref subs n 1))
        (if (= n 3)
          (%aref3 a (%lexpr-ref subs n 0) (%lexpr-ref subs n 1) (%lexpr-ref subs n 2))
          (let* ((typecode (typecode a)))
            (declare (fixnum typecode))
            (if (>= typecode target::min-vector-subtag)
              (%err-disp $XNDIMS a n)
              (if (< typecode target::min-array-subtag)
                (report-bad-arg a 'array)
                ;;  This typecode is Just Right ...
                (progn
                  (unless (= (the fixnum (%svref a target::arrayH.rank-cell)) n)
                    (%err-disp $XNDIMS a n))
                  (let* ((rmi (%array-index a subs n)))
                    (declare (fixnum rmi))
                    (multiple-value-bind (data offset) (%array-header-data-and-offset a)
                      (declare (fixnum offset))
                      (uvref data (the fixnum (+ offset rmi))))))))))))))

arefはあからさまにプリミティブな内容。

(defun elt (sequence idx)
  "Return the element of SEQUENCE specified by INDEX."
  (seq-dispatch
   sequence
   (let* ((cell (nthcdr idx sequence)))
     (if (consp cell)
       (car (the cons cell))
       (if cell
         (report-bad-arg sequence '(satisfies proper-list-p))
         (%err-disp $XACCESSNTH idx sequence))))
       
   (progn
     (unless (and (typep idx 'fixnum) (>= (the fixnum idx) 0))
       (report-bad-arg idx 'unsigned-byte))
     (locally 
       (if (>= idx (length sequence))
         (%err-disp $XACCESSNTH idx sequence)
         (aref sequence idx))))))

eltは、総称関数ではなく、普通の関数。規格上でもそう決まっている。これもarefを呼んでいる。

文字列ストリームは、level-1/l1-streams.lispに定義がある。read-charしたとき、最終的に呼ばれるのは、おそらくこれ。

(defun string-input-stream-ioblock-read-char (ioblock)
  (let* ((string (string-stream-ioblock-string ioblock))
         (idx (string-input-stream-ioblock-index ioblock))
         (end (string-input-stream-ioblock-end ioblock)))
    (declare (fixnum idx end)
             (simple-string string))
    (if (< idx end)
      (progn (setf (string-input-stream-ioblock-index ioblock)
                   (the fixnum (1+ idx)))
             (schar string idx))
      :eof)))

scharを呼んでいるので、最終的に呼ばれるのはaref。

というわけで、実際の定義も計測結果を裏付ける内容だった。定義を見る限り、ランダムアクセスでも順位は変わらない。文字列ストリームだけ、file-positionで位置を指定する分、他と差が開くかもしれない。

結論としては、Clozure CL 1.6においては、文字列の要素を参照する場合、arefが一番速い。

情報を頂いたので追記。SBCLでは、最適化を掛けると、charやeltがarefに展開されるようで、ディスアセンブルした結果も一致するとのこと。良いなあ。

2010-12-28

Packrat Parser

Common Lispでの実装がPackrat ParsingPackrat Parsing: 遅延版にあった。この方の書く記事は実践的でいつも面白い。

確かに、構造体を利用した遅延版は速いかもしれないんだけど、富豪的なメモリの使い方。パーザの数をn、文字列の長さをlとすると、クロージャをn * l個必ず作らなければならない。遅延評価のHaskellとかなら問題ないのかもしれないけど、Lispだと結構辛い。構造体を作る処理自体も重そう。それと、パーザを定義するごとに構造体のフィールドを増やさないといけないのは、色々と面倒な気がする。マクロで、パーザの定義ごとに構造体を再定義する方法はあるかもしれないけど、ちょっと泥臭い。

自分で使う分には、ハッシュテーブルで十分かとも思うけど、実際にどれだけ高速化するか測ってみないとなんとも言えない。

2010-12-27

ちょっと気の利いた再帰の使い方

考えてみると当たり前なんだけど、軽く感動した再帰の使い方について。

ストリームか文字列を同じ引数として受け取る関数を書こうとして、ストリームの場合と文字列の場合の処理の振り分けについて考えていた。最初は単純に、typecaseや、cl-matchなどのパターンマッチャで、型ごとに分岐させるか、総称関数を使って、型ごとに関数を分けてしまおうと考えた。ただ、処理が、分岐や別の関数に散らばってしまうので、何となくしっくり来なかった。

そこで、他の人がどうやってるのかが気になって、使ってる処理系のコードを読んでみたところ、


(defun f (string-or-stream)
  (if (stringp string-or-stream)
      (with-input-from-string (s string-or-stream)
        (f s))
      (main-process)))

のようなアプローチを採っていた。賢い。

今後、こういうパターンでは使わせてもらおう。

2010-12-20

cond-cons

Scheme:マクロの効用リストの構築で、cond-consというマクロが紹介されてるけど、Common Lispで欲しくなったので書いてみた。

(defmacro cond-cons (&rest clauses)
  (labels ((rec (clauses)
             (if clauses
                 (let ((clause (car clauses))
                       (r (rec (cdr clauses))))
                   `(if ,(car clause) (cons (progn ,@(cdr clause)) ,r) ,r))
                 nil)))
    (rec clauses)))

一瞬、rが複数回評価されて、副作用があるとまずいんじゃ、とか思ったけど、考えたらifで分岐するから問題なかった。

マクロなのに末尾再帰版。すみません。大好きです末尾再帰。

(defmacro cond-cons (&rest clauses)
  (labels ((rec (clauses fn)
             (if clauses
                 (let ((clause (car clauses)))
                   (rec (cdr clauses)
                        (lambda (x)
                          `(if ,(car clause)
                               (cons (progn ,@(cdr clause)) ,(funcall fn x))
                               ,(funcall fn x)))))
                 `(nreverse ,(funcall fn nil)))))
    (rec clauses (lambda (x) x))))

コンパイル時にしか評価されないので、ほとんど意味がない。末尾再帰じゃないバージョンだとスタックが溢れるくらい、clausesが長いリストだったりするなら多少は意味があるだろうけど、それってどんなだよ。

Paul Grahamも同じ趣旨のことをOn Lispかどこかに書いてたように思うけど、マクロ定義のコードで頑張る意味なんてない。

ちなみに、Gaucheでは、util.listにcond-listという名前で、より高機能なものが収録されている。何でそんなことを書くかというと、以前探したときに、しばらく見付けられなかったからではない。そんなわけはない。

2010-12-13

teepeedee2でfaviconを表示

手探りでやるしかないから、えらく苦労した。

(eval-when (:compile-toplevel :load-toplevel :execute)
  (asdf:load-system :teepeedee2))

(defpackage :tpd2-favicon (:use :cl :tpd2 :tpd2.ml.html))
(in-package :tpd2-favicon)

(defconstant +icon-content-type+
  (byte-vector-cat "Content-Type: image/x-icon" tpd2.io:+newline+))

(eval-when (:compile-toplevel :load-toplevel :execute)
  (defun favicon ()
    (with-open-file (in "work/tpd2/favicon.ico" :element-type '(unsigned-byte 8))
      (let ((buf (make-array (file-length in) :element-type '(unsigned-byte 8))))
        (read-sequence buf in)
        buf))))

(dispatcher-register-path
 (find-or-make-dispatcher "localhost:8080")
 "/favicon.ico"
 #'(lambda (dispatcher con done)
     (declare (ignore dispatcher))
     (start-http-response :content-type +icon-content-type+)
     (send-http-response con done (with-sendbuf () #.(favicon)))))

(defsite *favicon-site* :dispatcher (find-or-make-dispatcher "localhost:8080"))

(with-site (*favicon-site*)
  (defpage "/" ()
    (<p "favicon test")))

(http-start-server 8080)
(ccl:process-run-function "tpd2" #'event-loop)