Posted 2019-02-20 18:53:42 GMT
今回は前回に引き続きECLOSネタから、
でMOP vs マクロ比較をしてみたいと思います。
インスタンス生成を何らかの形で記録するというのはAMOPの3.1章にも出てくる定番ネタです。
この機能の実現は、インスタンス生成で使うmake-instance
に記録を行う関数のフックをかけてやればOKでしょう。
加えて、ECLOSではインスタンスを記録しつつもGCされたら消えるとのことなのですが、これは弱参照リストかなにかにすれば、これもOKでしょう。
ということで書いてみました。
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