#: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