Posted 2020-12-06 21:21:25 GMT
allocate-instance Advent Calendar 2020 7日目の記事です。
これまで、allocate-instanceで確保するストレージをスロット付きオブジェクトというところまで拡大して、データ構造を差し替えたりしてみましたが、現時点で考え付くものをまとめてみたいと思います(ネタ切れともいう)
今回も共通の処理は、slotted-objectsにまとめたものを利用します。
(defpackage "e718761d-aab2-548a-aa32-d3ba5e48b3ce"
(:use c2cl slotted-objects))(in-package "e718761d-aab2-548a-aa32-d3ba5e48b3ce")
先日も似たようなことをやっていましたが、symbol-plistをストレージにしたらどうかという試みです。
(defclass symbol-class (slotted-class)
())
(defclass symbol-object (slotted-object)
()
(:metaclass symbol-class))
(defmethod allocate-instance ((class symbol-class) &rest initargs)
(let ((sym (gentemp (string (class-name class)))))
(setf (symbol-plist sym)
(mapcan (lambda (s)
(list s (make-unbound-marker)))
(class-slots class)))
(allocate-slotted-instance (class-wrapper class)
sym)))
(defmethod slot-value-using-class ((class symbol-class) instance (slotd slot-definition))
(get (instance-slots instance) slotd))
(defmethod (setf slot-value-using-class) (value (class symbol-class) instance (slotd slot-definition))
(setf (get (instance-slots instance) slotd)
value))
(defclass symbol-foo (symbol-object)
((a :initform 0)
(b :initform 1)
(c :initform 2))
(:metaclass symbol-class))
シンボルはplistだけを利用するのですが、インスタンスをシンボルの値にするの方が色々応用がききそうです。
(let ((obj (make-instance 'symbol-foo)))
(set (instance-slots obj) obj)
(instance-slots obj))
→ symbol-foo4symbol-foo4
→ #<symbol-foo 4020099DF3>
(symbol-plist 'symbol-foo4)
→
(#<standard-effective-slot-definition a 42202D39D3>
0
#<standard-effective-slot-definition b 42202D4B93>
1
#<standard-effective-slot-definition c 42202D4D2B>
2)
(incf (slot-value symbol-foo4 'a) 100)
→ 100
(symbol-plist 'symbol-foo4)
→
(#<standard-effective-slot-definition a 42202D39D3>
100
#<standard-effective-slot-definition b 42202D4B93>
1
#<standard-effective-slot-definition c 42202D4D2B>
2)
(defclass alist-class (slotted-class)
())
(defclass alist-object (slotted-object)
()
(:metaclass alist-class))
(defmethod allocate-instance ((class alist-class) &rest initargs)
(allocate-slotted-instance (class-wrapper class)
(mapcar (lambda (s)
(cons s (make-unbound-marker)))
(class-slots class))))
(defmethod slot-value-using-class ((class alist-class) instance (slotd slot-definition))
(cdr (assoc slotd (instance-slots instance))))
(defmethod (setf slot-value-using-class)
(value (class alist-class) instance (slotd slot-definition))
(setf (cdr (assoc slotd (instance-slots instance)))
value))
(defclass alist-foo (alist-object)
((a :initform 0)
(b :initform 1)
(c :initform 2))
(:metaclass alist-class))
構造が似ているだけに、シンボルのplistと大差ありません。
シンボルのplistやリストをオブジェクトと連携させた際の応用としては、古えのAIプログラム等は、シンボルのplistやリスト操作を駆使したものが多いので、そういうリストとシンボルの塊のプログラムにマッピングをして見通しの良いプログラムに段階的に変換したりするのに使えたりするかもしれません。
(let ((obj (make-instance 'alist-foo)))
(incf (slot-value obj 'c) 100)
(instance-slots obj))
→
((#<standard-effective-slot-definition a 402019DFB3> . 0)
(#<standard-effective-slot-definition b 402019E01B> . 1)
(#<standard-effective-slot-definition c 402019E083> . 102)) ハッシュテーブルをストレージにするのは先日試しました
データ効率向上以外の応用としては、クロージャー+ハッシュテーブルなプログラムをクラスを利用したものに変換するのに使えたりするかもしれません。
AoSな構成については先日書きました。
1990年代のMOPの応用例の考察として、LispマシンにあったAREAというGC対象外の手動でメモリ管理する領域にインスタンスのストレージを確保する、というのがちょくちょく出てきます。
大きい配列をそのような領域に確保するという目的には丁度良いかもしれません。
AoSの逆のSoAについてはAoSと似たような応用が考えられますが、配列要素にガッチリ型を指定可能なので、型検査のメリットを活かすスロットの一つの実現方法としてSoAを利用するというのもありかなと思ったりしています。
(defclass struct-class (slotted-class)
())
(defmethod ensure-class-using-class :before ((class struct-class) name &rest initargs)
(eval `(defstruct ,(intern (concatenate 'string (string (class-name class)) (string '-struct)))
,@(mapcar (lambda (s)
(list (slot-definition-name s) (make-unbound-marker)))
(class-slots class)))))
(defclass struct-object (slotted-object)
()
(:metaclass struct-class))
(defmethod allocate-instance ((class struct-class) &rest initargs)
(allocate-slotted-instance (class-wrapper class)
(funcall (fdefinition
(intern
(concatenate 'string
(string 'make-)
(string (class-name class))
(string '-struct)))))))
(defmethod slot-value-using-class ((class struct-class) instance (slotd slot-definition))
(slot-value (instance-slots instance) (slot-definition-name slotd)))
(defmethod (setf slot-value-using-class) (value (class struct-class) instance (slotd slot-definition))
(setf (slot-value (instance-slots instance) (slot-definition-name slotd))
value))
(defclass struct-foo (struct-object)
((a :initform 0)
(b :initform 1)
(c :initform 2))
(:metaclass struct-class))
段々屋上屋っぽくなってきましたが、これも既存の構造体メインで構築したプログラムを、段階的に徐々に変換するのに使えたりもすかもしれません(上例ではクラス定義時に構造体を定義していますが)
(let ((obj (make-instance 'struct-foo)))
(incf (slot-value obj 'c) 100)
(instance-slots obj))
→ #S(struct-foo-struct :a 0 :b 1 :c 102) (defclass class-class (slotted-class)
())
(defmethod ensure-class-using-class :before ((class class-class) name &rest initargs &key direct-slots)
(ensure-class-using-class (find-class 'standard-class)
(intern (concatenate 'string (string name) (string '-storage)))
:direct-slots direct-slots))
(defclass class-object (slotted-object)
()
(:metaclass class-class))
(defmethod allocate-instance ((class class-class) &rest initargs)
(allocate-slotted-instance (class-wrapper class)
(make-instance (intern (concatenate 'string
(string (class-name class))
(string '-storage))))))
(defmethod slot-value-using-class ((class class-class) instance (slotd slot-definition))
(slot-value (instance-slots instance) (slot-definition-name slotd)))
(defmethod (setf slot-value-using-class) (value (class class-class) instance (slotd slot-definition))
(setf (slot-value (instance-slots instance) (slot-definition-name slotd))
value))
完全に屋上屋ですが、既存の定義をニコイチにしてスロット名をつけかえたりできるかもしれません。
(defclass class-foo (class-object)
((a :initform 0)
(b :initform 1)
(c :initform 2))
(:metaclass class-class))(let ((obj (make-instance 'class-foo)))
(incf (slot-value obj 'c) 100)
(describe (instance-slots obj)))
⇒
#<class-foo-storage 40200BA7F3> is a class-foo-storage
a 0
b 1
c 102
当初の計画ではデータ構造ごとにエントリーを書いていればallocate-instanceアドベントカレンダーの25日間はしのげるかなと思ったのですが、話が広げられないので今回一つにまとめて書いてしまいました。
あと18ネタをどう捻り出すか……。
■
HTML generated by 3bmd in LispWorks 7.0.0