#:g1: Rubyオブジェクトの未来をつくる「シェイプ」をCommon Lispで実装してみた

Posted 2021-09-28 15:04:10 GMT

こちらの記事を読んでCommon Lispに既に似たような機構があるなと思ったので、このshapeというものをCommon Lispで実装してみることにしました。

shapeの動作

まずRuby(TruffleRuby)のshapeは下記のような動作とのことです。

# read
index = obj.shape[:name]
obj[index]

# write index = obj.shape[:name] obj[index] = value

オブジェクトのスロット名からスロットのインデックスを算出し、オブジェクトの内部配列をインデックスでアクセスするから速いということのようです。
オブジェクトからスロットのインデックスを算出するということなので、Common Lisp(AMOP)で表現すると、大体下記のようなところでしょうか

(defgeneric shape (obj slot-name))

(defmethod shape ((obj standard-object) slot-name) (slot-definition-location (find slot-name (class-slots (class-of obj)) :key #'slot-definition-name)))

(defclass foo ()
  (a b c))

(let ((obj (make-instance 'foo))) (setf (standard-instance-access obj (shape obj 'a)) 42) (standard-instance-access obj (shape obj 'a))) → 42

高速化してみる

記事中にRubyのクラスがfrozenの場合は高速化できるようなことが書いてあったので、Common Lispでも最適化してみましょう。

frozenに該当する機構はCommon Lispには存在しないので、適当にフラグを付けるだけにしておきます。
ちなみに、Common Lispでも一応その類の最適化を模索している人達もいます。大体はDylanのsealingをお手本にしているようです。

とりあえず、class-frozen-pは下記のようにしてみます。

(defgeneric class-frozen-p (class))
(defmethod class-frozen-p ((class cl:standard-class))
  (get (class-name class) 'frozenp))

(defgeneric (setf class-frozen-p) (boolean class)) (defmethod (setf class-frozen-p) (boolean (class cl:standard-class)) (setf (get (class-name class) 'frozenp) boolean))

コンパイラマクロを付けてみる

次に、class-frozen-p が成立する場合、インデックスの算出をコンパイル時に行うことにしてみます。
コンパイル時にクラス情報を取得するのが難しいので、今回は手抜きでstandard-objectのインスタンスもしくは、(the ...)で型宣言された場合にコンパイラマクロを展開するようにしてみます。

(define-compiler-macro shape (&whole whole obj slot-name)
  (flet ((compute-slot-location (class)
           (slot-definition-location
            (find (the symbol (eval slot-name)) (class-slots class) :key #'slot-definition-name))))
    (let ((class (typecase obj
                   ((cons (eql the) *)
                    (find-class (elt obj 1)))
                   (standard-object
                    (class-of obj))
                   (T :unknown))))
      (typecase class
        (class (if (class-frozen-p class)
                   (let* ((loc (compute-slot-location class)))
                     (check-type loc integer)
                     loc)
                   whole))
        (T whole)))))

試してみる

(setf (class-frozen-p (find-class 'foo)) T)

(defun set-foo-a-fast (obj value) (declare (optimize (speed 3) (safety 0) (debug 0))) (setf (standard-instance-access obj (shape (the foo obj) 'a)) value) (standard-instance-access obj (shape (the foo obj) 'a)))

上記のset-foo-a-fastは、SBCLで最適化されるとdisassembleの結果は下記のようになり、ほぼ内部の配列に添字でアクセスしているだけです。

; disassembly for set-foo-a-fast
; Size: 22 bytes. Origin: #x53823BA6
; A6:       488B4205         mov RAX, [RDX+5]                 ; no-arg-parsing entry point
; AA:       48897801         mov [RAX+1], RDI
; AE:       488B4205         mov RAX, [RDX+5]
; B2:       488B5001         mov RDX, [RAX+1]
; B6:       488BE5           mov RSP, RBP
; B9:       F8               clc
; BA:       5D               pop RBP
; BB:       C3               ret

最適化を発動させない場合、

(setf (class-frozen-p (find-class 'foo)) nil)

(defun set-foo-a-slow (obj value) (declare (optimize (speed 3) (safety 0) (debug 0))) (setf (standard-instance-access obj (shape obj 'a)) value) (standard-instance-access obj (shape obj 'a)))

下記のように実行時にスロット名を引いてアクセスしています。

; disassembly for set-foo-a-slow
; Size: 118 bytes. Origin: #x538D2E4D
; 4D:       488975F0         mov [RBP-16], RSI                ; no-arg-parsing entry point
; 51:       4C8945F8         mov [RBP-8], R8
; 55:       4883EC10         sub RSP, 16
; 59:       498BD0           mov RDX, R8
; 5C:       488B3D9DFFFFFF   mov RDI, [rip-99]                ; 'a
; 63:       B904000000       mov ECX, 4
; 68:       48892C24         mov [RSP], RBP
; 6C:       488BEC           mov RBP, RSP
; 6F:       E8445FD4FC       call #x50618DB8                  ; #<fdefn shape>
; 74:       480F42E3         cmovb RSP, RBX
; 78:       4C8B45F8         mov R8, [RBP-8]
; 7C:       488B75F0         mov RSI, [RBP-16]
; 80:       498B4005         mov RAX, [R8+5]
; 84:       4889749001       mov [RAX+RDX*4+1], RSI
; 89:       4C8945F8         mov [RBP-8], R8
; 8D:       4883EC10         sub RSP, 16
; 91:       498BD0           mov RDX, R8
; 94:       488B3D65FFFFFF   mov RDI, [rip-155]               ; 'a
; 9B:       B904000000       mov ECX, 4
; A0:       48892C24         mov [RSP], RBP
; A4:       488BEC           mov RBP, RSP
; A7:       E80C5FD4FC       call #x50618DB8                  ; #<fdefn shape>
; AC:       480F42E3         cmovb RSP, RBX
; B0:       4C8B45F8         mov R8, [RBP-8]
; B4:       498B4005         mov RAX, [R8+5]
; B8:       488B549001       mov RDX, [RAX+RDX*4+1]
; BD:       488BE5           mov RSP, RBP
; C0:       F8               clc
; C1:       5D               pop RBP
; C2:       C3               ret

速度は最適化された場合、大体4倍程度高速な様子(思ったより高速化されていない……)

(time 
 (let ((obj (make-instance 'foo)))
   (dotimes (i 1000000)
     (set-foo-a-fast obj))))
Evaluation took:
  0.053 seconds of real time
  0.050000 seconds of total run time (0.050000 user, 0.000000 system)
  94.34% CPU
  172,648,872 processor cycles
  0 bytes consed

(time (let ((obj (make-instance 'foo))) (dotimes (i 1000000) (set-foo-a-slow obj)))) Evaluation took: 0.210 seconds of real time 0.210000 seconds of total run time (0.210000 user, 0.000000 system) 100.00% CPU 692,425,819 processor cycles 0 bytes consed

そもそも高速なstandard-instance-accessを使ってしまっているのでslot-valueでのアクセスと比較してみます。

(defun set-foo-a/slot-name (obj value)
  (declare (optimize (speed 3) (safety 0) (debug 0)))
  (setf (slot-value obj 'a) value)
  (slot-value obj 'a))

(time (let ((obj (make-instance 'foo))) (dotimes (i 1000000) (set-foo-a/slot-name obj))))

Evaluation took: 0.064 seconds of real time 0.060000 seconds of total run time (0.060000 user, 0.000000 system) 93.75% CPU 211,657,683 processor cycles 0 bytes consed

猛烈に遅くなる予想でしたが、slot-valueのスロット名がコンパイル時に確定しているため最適化されてしまい、shapeの速い方とほぼ同じ速度です。

; disassembly for set-foo-a/slot-name
; Size: 69 bytes. Origin: #x538D31AA
; AA:       488945F8         mov [RBP-8], RAX                 ; no-arg-parsing entry point
; AE:       4883EC10         sub RSP, 16
; B2:       488BD7           mov RDX, RDI
; B5:       488BF8           mov RDI, RAX
; B8:       B904000000       mov ECX, 4
; BD:       48892C24         mov [RSP], RBP
; C1:       488BEC           mov RBP, RSP
; C4:       E80F6FD4FC       call #x5061A0D8                  ; #<fdefn (sb-pcl::slot-accessor :global a sb-pcl::writer)>
; C9:       480F42E3         cmovb RSP, RBX
; CD:       488B45F8         mov RAX, [RBP-8]
; D1:       4883EC10         sub RSP, 16
; D5:       488BD0           mov RDX, RAX
; D8:       B902000000       mov ECX, 2
; DD:       48892C24         mov [RSP], RBP
; E1:       488BEC           mov RBP, RSP
; E4:       E8CF6ED4FC       call #x5061A0B8                  ; #<fdefn (sb-pcl::slot-accessor :global a sb-pcl::reader)>
; E9:       488BE5           mov RSP, RBP
; EC:       F8               clc
; ED:       5D               pop RBP
; EE:       C3               ret

ということで遅くするために実行時にスロット名を与えることにしてみます。

(defun set-foo-a/slot-name/ (obj value name)
  (declare (optimize (speed 3) (safety 0) (debug 0)))
  (setf (slot-value obj name) value)
  (slot-value obj name))

(time (let ((obj (make-instance 'foo))) (dotimes (i 1000000) (set-foo-a/slot-name/ obj 42 'a))))

Evaluation took: 0.105 seconds of real time 0.100000 seconds of total run time (0.100000 user, 0.000000 system) 95.24% CPU 346,033,917 processor cycles 0 bytes consed

どうやら色々最適化してくれるようでSBCLの場合は大して遅くならないようです……。

まとめ

Rubyオブジェクトの未来をつくる「シェイプ」をCommon Lispで真似してみました。
Common Lispの場合は、オブジェクトの内部配列にインデックスでアクセスするという機構は既に備わっているので何も考えずにslot-valueで書いても最適化で高速化されることが多いようです。

標準的でないメタクラスや総称関数を定義した場合は、これらの最適化が外れることが多くなるとは思いますが、恐らく普通のオブジェクト指向プログラミングをする範囲では十分に速いものになるかと思います。


HTML generated by 3bmd in LispWorks 7.0.0

comments powered by Disqus