#:g1: 履歴付きスロットなインスタンス

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

comments powered by Disqus