Posted 2020-12-19 21:12:58 GMT
allocate-instance Advent Calendar 2020 20日目の記事です。
MOPの応用として、仮想的なアロケーションの場所を指定する例があります。
大抵は、スロットの:allocation
指定で、:virtual
等を指定するという感じですが、allocate-instance
内でどうにかできないか考えてみます。
allocate-instance
内でどうにかするという縛りなので、スロットストレージに関数を詰めて呼び出すという作戦で実行時にデータを取得できるようにしてみます。
(defpackage "f53e7180-1934-50c0-9c43-7c6a79b7a5e2"
(:use c2cl slotted-objects))
(cl:in-package "f53e7180-1934-50c0-9c43-7c6a79b7a5e2")
(defclass virtual-class (slotted-class)
())
(defclass virtual-object (slotted-object)
()
(:metaclass virtual-class))
(defmethod allocate-slot-storage ((class virtual-class) size initial-value)
(let ((storage (make-sequence 'vector size))
(fctns (make-sequence 'vector size)))
(dotimes (index size fctns)
(setf (elt fctns index)
(let ((index index))
(lambda (op value)
(case op
(:get (elt storage index))
(:set (setf (elt storage index) value)))))))))
(defmethod slot-value-using-class ((class virtual-class) instance (slotd slot-definition))
(funcall (elt (instance-slots instance) (slot-definition-location slotd))
:get 'ignore))
(defmethod (setf slot-value-using-class) (value (class virtual-class) instance (slotd slot-definition))
(funcall (elt (instance-slots instance) (slot-definition-location slotd))
:set value))
微妙に使い勝手が悪いですが、とりあえず下記のように書けます。 スロット読み出しが発生すると、スロットストレージに詰められたクロージャーが呼ばれ、値を計算します。
(defclass 56nyan (virtual-object)
((name)
(code :initarg :item-code)
(price))
(:metaclass virtual-class))
(defun get-56nyan-page (code)
(babel:octets-to-string
(drakma:http-request (format nil "https://www.56nyan.com/fs/goronyan/~A" code)
:force-binary T)
:encoding :cp932))
(defmethod allocate-slot-storage ((class (eql (find-class '56nyan))) size initial-value)
(let* ((fcns (call-next-method))
(slotds (class-slots class)))
(labels ((name->loc (name)
(slot-definition-location (find name slotds :key #'slot-definition-name)))
(slot-fctn (name)
(elt fcns (name->loc name)))
((setf slot-fctn) (fctn name)
(setf (elt fcns (name->loc name)) fctn))
(code ()
(funcall (elt fcns (name->loc 'code)) :get nil)))
(setf (slot-fctn 'name)
(lambda (op value)
(declare (ignore value))
(case op
(:get (plump:attribute (elt (clss:select "meta[property=og:title]" (plump:parse (get-56nyan-page (code)))) 0)
"content"))
(:set nil))))
(setf (slot-fctn 'price)
(lambda (op value)
(declare (ignore value))
(case op
(:get (plump:text (elt (clss:select ".itemPrice" (plump:parse (get-56nyan-page (code)))) 0)))
(:set nil)))))
fcns))
allocate-instance
レベルで実現する意義を考えてみましたが、change-class
しても値がスムースに移行可能なのではないでしょうか。
(defclass 56nyan-static ()
((name)
(code :initarg :item-code)
(price)))
(let ((obj (make-instance '56nyan :code "7e003-001")))
(change-class obj '56nyan-static)
(describe obj))
⇒
#<56nyan-static 42000B7D3B> is a 56nyan-static
name "アカナ グラスランド キャット 340g (42341) 【正規品】"
code "7e003-001"
price "1,093円"
そもそも、Common Lispの場合、スロットのリーダ/ライタでメソッドコンビネーションが使えるので、Virtual Slotsのようなものはあまり必要ないような気もします。
ちなみに、今回のchange-class
の用法ですが、Common Lisp Proメーリングリストのchange-class
の議論で、とりあえずデータをロードして、change-class
で正規化するのが便利、という用例紹介をちょっと真似してみました(今回は正規化してませんが)
自分も以前、change-class
の使い方として試してみたことがあった気がしますが、こういう応用も無くはないのかなと思います。
■
HTML generated by 3bmd in LispWorks 7.0.0