#:g1: mopでstandard-objectとsymbolを融合したい

Posted 2020-11-09 20:39:18 GMT

いまを去ること4年前のことですが、Lisp Meet Up presented by Shibuya.lisp #42の「Mathematicaとオブジェクト指向について」をネットで観覧していて、シンボルをオブジェクトのように扱うネタをみて、Common Lispでもシンボルをオブジェクトのストレージにできるんじゃないかなあと思ったのですが、ブログのネタ帳にメモだけ残してすっかり忘れていました。

Common Lispで似たようなものが作れるのではないかというのは、y2q_actionmanさんもブログでリアクションをしています。

y2q_actionmanさんは、シンボルを中心に新しくシステムを構築していますが、自分は既存のオブジェクト指向システムと融合できるのではないか、という感じだったので、そんな感じのものを今回書いてみました。

ちなみに、発表されていたMathematicaの当該機能はUpSetというものらしいですが、オブジェクト指向システムを簡単に実現できる柔軟な仕組みのようなものみたいです。

基本的な戦略

——だけ、なので、make-instanceにフックでも仕掛ければ終了、ともいえますが、インスタンスのオブジェクトに名前(シンボル)を保持するように拡張するという無駄に複雑な方向で実現してみたいと思います。
具体的には、allocate-instanceで確保するベクタの長さを一つ延して先頭に名前を詰めることにします。

実装してみる

こんなクラス定義があるとすると、

(defclass foo (symb-object)
  ((a :initform 0)
   (b :initform 1)
   (c :initform 2))
  (:metaclass symb-class))

(make-instance 'foo)
→ #<foo foo0> 

(setf (slot-value foo0 'a) 42) → 42

(get 'foo0 'a) → 42

(symbol-plist 'foo0)(c 2 b 1 a 42)

——というような挙動にしました。
融合というからには、(setf get)でのシンボルのplistへの書き込みもオブジェクトと同期させたいところですが、getを変更するのは大袈裟なので今回は見送っています。

コード

(defpackage "2cd9cb9c-2302-5cc4-9c4c-aafd83e01db4" (:use :c2cl))

(in-package "2cd9cb9c-2302-5cc4-9c4c-aafd83e01db4")

(defclass slotted-class (standard-class) ())

(defclass symb-class (slotted-class) ())

(defclass symb-object () () (:metaclass symb-class))

(defmethod validate-superclass ((class symb-class) (super standard-class)) T)

(defmethod compute-slots :around ((class symb-class)) (let ((slotds (call-next-method))) (dolist (s slotds) (setf (slot-definition-location s) (1+ (position s slotds)))) slotds))

#+LispWorks (defmethod allocate-instance ((class symb-class) &rest initargs) (let* ((class (clos::ensure-class-finalized class)) (storage (sys:alloc-g-vector$fixnum (1+ (length (class-slots class))) clos::*slot-unbound*)) (instance (sys:alloc-fix-instance (clos::class-wrapper class) storage)) (name (gentemp (string (class-name class))))) (setf (elt storage 0) name) (setf (symbol-value name) instance) instance))

#+LispWorks (defun instance-name (instance) (elt (clos::%svref instance 1) 0))

(defmethod initialize-instance :after ((inst symb-object) &rest initargs) (let* ((class (class-of inst)) (name (instance-name inst))) (dolist (slot (class-slots class)) (let ((slot-name (slot-definition-name slot))) (setf (get name slot-name) (and (slot-boundp inst slot-name) (slot-value inst slot-name)))))))

(defmethod slot-value-using-class ((class symb-class) instance (slotd slot-definition)) (standard-instance-access instance (1+ (position slotd (class-slots class)))))

(defmethod (setf slot-value-using-class) (val (class symb-class) instance (slotd slot-definition)) (setf (get (instance-name instance) (slot-definition-name slotd)) val) (setf (standard-instance-access instance (1+ (position slotd (class-slots class)))) val))

(defmethod print-object ((instance symb-object) stream) (print-unreadable-object (instance stream :type T) (format stream "~S" (instance-name instance))))

まとめ

allocate-instancesymbolを生成してしまうというのが、一番直截的な感はありますが、色々なプロトコルでsymbolを扱えるようにするのが面倒で今回は妥協しました。
いつかチャレンジしてみたい気もしますが、Common LispのMOPは、そもそもstandard-objectから派生したオブジェクト以外のもの扱うことはできるのでしょうか。


HTML generated by 3bmd in LispWorks Personal Edition 7.1.2

comments powered by Disqus