#:g1: MOP vs マクロ (6)

Posted 2019-02-20 18:53:42 GMT

今回は前回に引き続きECLOSネタから、

でMOP vs マクロ比較をしてみたいと思います。

インスタンス生成を何らかの形で記録するというのはAMOPの3.1章にも出てくる定番ネタです。

この機能の実現は、インスタンス生成で使うmake-instanceに記録を行う関数のフックをかけてやればOKでしょう。
加えて、ECLOSではインスタンスを記録しつつもGCされたら消えるとのことなのですが、これは弱参照リストかなにかにすれば、これもOKでしょう。

ということで書いてみました。

MOPでの実装

LispWorksとSBCLで弱参照のシークエンスを物色してみましたが、弱参照の配列にしてみました。
LispWorksでは、weak-arrayというものがありadjustableなのですが、SBCLにはないので、結局make-weak-pointerで包んでいます。
trivial-garbageを利用すればいくらか可搬性は増すかもしれません。

(cl:in-package :cl-user)
(ql:quickload :closer-mop)
(defpackage "d5fc135c-3bcf-4976-9a9e-e6b92c12bd9d"
  (:use :c2cl :alexandria))
(in-package "d5fc135c-3bcf-4976-9a9e-e6b92c12bd9d")
(defun make-weak-vector (size &rest initargs)
  (declare (dynamic-extent initargs))
  #+lispworks (apply #'hcl:make-weak-vector size initargs)
  #+sbcl (apply #'make-array size :element-type 'sb-ext:weak-pointer initargs))
(defclass instance-recording-class (standard-class)
  ((instance-record :initform (make-weak-vector 0 :adjustable T :fill-pointer 0)
                    :accessor class-instance-record)))
(defmethod validate-superclass ((c instance-recording-class) (sc standard-class))
  T)
(defmethod make-instance :around ((class instance-recording-class) &rest initargs)
  (let* ((inst (call-next-method))
         #+sbcl (inst (sb-ext:make-weak-pointer inst)))
    (vector-push-extend inst (class-instance-record class))
    inst))
(defun reset-instance-record (class)
  (setf (class-instance-record class)
        (make-weak-vector 0 :adjustable T :fill-pointer 0)))

試してみる

(defconstant <zot> 
  (defclass zot () 
    ((a :initform 42))
    (:metaclass instance-recording-class)))
(dotimes (i 8)
  (make-instance <zot>))
(class-instance-record <zot>)
#+sbcl
→#(#<weak pointer: #<zot {10349DBA73}>> #<weak pointer: #<zot {10349ECDF3}>> #<weak pointer: #<zot {10349ECE63}>> #<weak pointer: #<zot {10349ECEE3}>>
        #<weak pointer: #<zot {10349ECF33}>> #<weak pointer: #<zot {10349ECFD3}>> #<weak pointer: #<zot {10349ED023}>> #<weak pointer: #<zot {10349ED073}>>)
#+lispworks
→ #(#<zot 4020034723> #<zot 4020034B43> #<zot 4020034EAB> #<zot 4020035213>
    #<zot 402003557B> #<zot 40200358E3> #<zot 4020035C4B> #<zot 4020035FB3>) 
#+lispworks (hcl:gc-all)
#+sbcl (sb-ext:gc :full t)
(class-instance-record <zot>)
#+sbcl
→ #(#<broken weak pointer> #<broken weak pointer> #<broken weak pointer> #<broken weak pointer> #<broken weak pointer> #<broken weak pointer>
       #<broken weak pointer> #<broken weak pointer>)
#+lispworks
→ #(nil nil nil nil nil nil nil nil) 
;; (clear-instance-record <zot>)

SBCLのほうはweak-pointerオブジェクトで包まれるのでちょっと扱いが面倒ですが、まあこんなものでしょう。

allocate-instanceにフックをかけるのでは駄目なのか

AMOPの例でもこういう記録系の拡張は、make-instanceにフックをかけますが、生成ならばallocate-instanceへのフックでも良さそうです。

両者で何が違うのか考えてみましたが、class-prototypeを実行するとプロトタイプの生成でallocate-instanceが呼ばれるので、クラスのプロトタイプインスタンスも含みたい場合はallocate-instanceの方が良いのでしょう。
恐らく、インスタンス記録系は、クラスのプロトタイプインスタンスは大抵除外して考えそうなので、make-instanceの方が自然かと思います。

allocate-instanceを利用した場合

(defmethod allocate-instance :around ((class instance-recording-class) &rest initargs)
  (let* ((inst (call-next-method))
         #+sbcl (inst (sb-ext:make-weak-pointer inst)))
    (vector-push-extend inst (class-instance-record class))
    inst))
(defconstant <bar> 
  (defclass bar () 
    ((a :initform 42))
    (:metaclass instance-recording-class)))
(class-instance-record <bar>)
→ #() 
(class-prototype <bar>)
→ #<bar 402008BEE3> 
(class-instance-record <bar>)
→ #(#<bar 402008BEE3>)

マクロで考えてみた

あまりこういうのはマクロに向いていない気もしますが、比較のために書いてみました。

(defvar *instance-recording-table*
  (make-hash-table))
(defmacro with-instance-recording ((type) &body form)
  (with-unique-names (inst)
    `(let* ((,inst (progn ,@form))
            #+sbcl (,inst (sb-ext:make-weak-pointer ,inst)))
       #-sbcl (check-type ,inst ,type)
       #+sbcl (check-type (sb-ext:weak-pointer-value ,inst) ,type)
       (vector-push-extend ,inst
                           (or (gethash ',type *instance-recording-table*)
                               (setf (gethash ',type *instance-recording-table*)
                                     (make-weak-vector 0 :adjustable T :fill-pointer 0))))
       ,inst)))
(defun get-instance-record (type)
  (values (gethash type *instance-recording-table*)))
(defun reset-instance-record (type)
  (setf (gethash type *instance-recording-table*)
        (make-weak-vector 0 :adjustable T :fill-pointer 0)))

試してみる

(defclass quux ()
  ((x :initform 0)))
(dotimes (i 8)
  (with-instance-recording (quux) 
    (make-instance 'quux)))
(get-instance-record 'quux)
→ #(#<quux 40200A1413> #<quux 40200A26A3> #<quux 40200A351B> #<quux 40200A4393>
    #<quux 40200A520B> #<quux 40200A6083> #<quux 40200A6EFB> #<quux 40200A7D73>) 
(hcl:gc-all)
(get-instance-record 'quux)
→ #(nil nil nil nil nil nil nil nil)

マクロなのでクラスオブジェクト以外にも使えます。
(というかそういう風に作っただけ)

(defstruct sss a b c)
(dotimes (i 8)
  (with-instance-recording (sss) 
    (make-sss)))
(get-instance-record 'sss)
→ #(#S(sss :a nil :b nil :c nil) #S(sss :a nil :b nil :c nil)
   #S(sss :a nil :b nil :c nil) #S(sss :a nil :b nil :c nil)
   #S(sss :a nil :b nil :c nil) #S(sss :a nil :b nil :c nil)
   #S(sss :a nil :b nil :c nil) #S(sss :a nil :b nil :c nil))  
(hcl:gc-all)
(get-instance-record 'sss)
→ #(nil nil nil nil nil nil nil nil)

まとめ

インスタンスの記録についてMOPとマクロで比較してみましたが、元がMOP向きな問題だけにさすがにMOPの方がすっきりします。
しかし、実現している内容はマクロ版も大して変わらないので、あとは使い勝手がどうなるか、でしょうか。

■

HTML generated by 3bmd in LispWorks 7.0.0

comments powered by Disqus