Posted 2020-12-04 18:27:55 GMT
allocate-instance Advent Calendar 2020 5日目の記事です。
allocate-instance
をいじくるネタを捻り出す毎日ですが、今回は履歴付きスロットを実現してみたいと思います。
今回も共通の処理は、slotted-objects
にまとめたものを利用します。
スロットの更新履歴を全部保存しておいて、後から参照できるようなスロットです。
実例はこれまで目にしたことはないもののMOPの文献等でたまに用例として出てきたりします。
履歴を保存するデータ構造は色々な方法で簡単に作成できると思うので、allocate-instance
がそのようなデータ構造を確保してしまう方が、allocate-instance
よりも上のレベルであれこれするより素直で直截的かと思うので、allocate-instance
のカスタマイズ向きな用例かもしれません。
今回は素朴な実装ですが、slot-history
という現在の値と履歴のハッシュテーブルを持つオブジェクトを定義して各スロットがそれを保持することにしてみました。
スロットに値をセットする時にタイムスタンプを押しますが、get-internal-real-time
を適当に使っています。
(defpackage "f9685263-15f6-55c9-a3bb-325737df58f2"
(:use :c2cl :slotted-objects))
(in-package "f9685263-15f6-55c9-a3bb-325737df58f2")
(defclass history-slots-class (slotted-class) ())
(defclass history-slots-object (slotted-object)
()
(:metaclass history-slots-class))
(defclass slot-history ()
((cur :initform (make-unbound-marker) :accessor slot-history-value)
(log :initform (make-hash-table) :accessor slot-history-log)))
(defmethod allocate-instance ((class history-slots-class) &rest initargs)
(allocate-slotted-instance (class-wrapper class)
(map 'vector
(lambda (x)
(declare (ignore x))
(make-instance 'slot-history))
(class-slots class))))
(defmethod slot-value-using-class ((class history-slots-class) instance (slotd slot-definition))
(slot-history-value (elt (instance-slots instance) (slot-definition-location slotd))))
(defmethod (setf slot-value-using-class)
(value (class history-slots-class) instance (slotd slot-definition))
(let ((slot (elt (instance-slots instance) (slot-definition-location slotd))))
(setf (gethash (get-internal-real-time) (slot-history-log slot))
value)
(setf (slot-history-value slot) value)))
(defclass foo (slotted-object)
((a :initform 0)
(b :initform 1)
(c :initform 2))
(:metaclass history-slots-class))
(defun replay-slots (instance)
(let* ((slots (instance-slots instance))
(timestamps (sort
(loop :for s :across slots
:append (loop :for ts :being :the :hash-keys :of (slot-value s 'log) :collect ts))
#'<)))
(dolist (ts timestamps)
(map nil
(lambda (slot name)
(let ((log (gethash ts (slot-value slot 'log))))
(when log
(format T "~&~S: ~S → ~S~%" ts name log))))
slots
(mapcar #'slot-definition-name (class-slots (class-of instance)))))))
(let ((o (make-instance 'foo)))
;; それぞれのスロットに値を10回セット
(dotimes (i 10)
(sleep (/ 1 (1+ (random 100))))
(setf (slot-value o 'a) i)
(sleep (/ 1 (1+ (random 100))))
(setf (slot-value o 'b) i)
(sleep (/ 1 (1+ (random 100))))
(setf (slot-value o 'c) i))
;; スロット変更履歴再生
(replay-slots o))
11530892: a → 0
11530892: b → 1
11530892: c → 2
11530892: a → 0
11530892: b → 1
11530892: c → 2
11530892: a → 0
11530892: b → 1
11530892: c → 2
11530907: a → 0
11530918: b → 0
11530928: c → 0
11530951: a → 1
11530964: b → 1
11530974: c → 1
11531224: a → 2
11531251: b → 2
11531270: c → 2
11531282: a → 3
11531300: b → 3
11531310: c → 3
11531343: a → 4
11531393: b → 4
11531405: c → 4
11531464: a → 5
11531475: b → 5
11531527: c → 5
11531564: a → 6
11531664: b → 6
11531674: c → 6
11531691: a → 7
11531703: b → 7
11531729: c → 7
11531872: a → 8
11531888: b → 8
11531904: c → 8
11531936: a → 9
11531961: b → 9
11531984: c → 9
アクセス時間的にシビアなもので使うには、きっちり実装したものでないと厳しそうですが、デバッグ時に値の変更履歴を確認したい時には、素朴な実装でも活用できそうな気がします。
■
HTML generated by 3bmd in LispWorks 7.0.0