タイトルの通り、あるクラスが特定のクラス(複数可)を継承した時になにか処理を実行させたいのです(たとえば、メソッドを定義したり、ログに出力したり..)
で、CLOSならなんとかなるんじゃないかと、ちょっと作ってみています。
(eval-when (:load-toplevel :compile-toplevel :execute) #+sbcl (use-package :sb-mop)) (defclass addable-class (standard-class) ()) (defmethod validate-superclass ((class addable-class) (super standard-class)) t) (defvar *class-add-rules* '()) (defun define-class-union-rule (cls-name1 cls-name2 action) (pushnew (cons (cons cls-name1 cls-name2) action) *class-add-rules*)) (defmethod ensure-class-using-class :after ((class addable-class) name &rest keys) (declare (ignore keys)) ;;Ensure finalize inheritance (finalize-inheritance class) ;;Get all super-class-list (let ((super-class-names (mapcar #'(lambda (cls) (class-name cls)) (class-precedence-list class)))) ;;Get all matched rule from rule table (let ((matched-rules (remove-if-not (lambda (rule) (and (member (caar rule) super-class-names) (member (cdar rule) super-class-names))) *class-add-rules*))) (loop for rule in matched-rules do (funcall (cdr rule) class))))) (define-class-union-rule 'A-class 'B-class (lambda (cls) (format t "Class: ~A is union of A-class & B-class.~%" cls))) (defclass A-class () ((name :initarg :name :accessor name :initform "A")) (:metaclass addable-class)) (defclass B-class () ((x :initarg :x :accessor x :initform 0) (y :initarg :y :accessor y :initform 0)) (:metaclass addable-class)) (defclass AB-class (A-class B-class) () (:metaclass addable-class))
やってる事としては
継承とはクラスの和算であるとかんがえて
Meta-Classとしてaddable-class(足したときの演算が定義できるクラス)を定義します。
そして、addable-classをメタクラスとして持つクラスを定義したときに、そのクラスの継承関係をチェックして、定義してあるルールにマッチしたらなにか処理を実行したいのです。
その処理の中でクラスにメソッドを追加したりできたら便利だろうと...
今の所は非常に素な実装であって、できる事は2つのクラスを継承している状態になったら発動するだけです。この実装で方向性が見えてきたら機能を追加したり、もっとパターンをちゃんと定義できるようにしたいとおもっています。
困っている事
今現在、ensure-class-using-classのafterメソッドとして何かの処理を実行しているため、
処理の引数にはclass自体がわたってきます。このクラスをベースにしてインスタンスメソッドを定義したりする方法がわからず困っています。アドバイスがありましたら、是非よろしくおねがいいたします。