#:g1: virtual slotをallocate-instanceレベルで考えてみる

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

comments powered by Disqus