#:g1: Common Lispで抽象クラス

Posted 2016-09-11 18:50:34 GMT

暇潰しにQITAB - a collection of free Lisp codeのソースを眺めていた所、MOPで抽象クラスを実現したコードをみつけました。

;;;                                                                  ;;;
;;; Free Software under the MIT license.                             ;;;
;;;                                                                  ;;;
;;; Copyright (c) 2008 ITA Software, Inc.  All rights reserved.      ;;;
;;;                                                                  ;;;
;;; Original author: Dan Weinreb                                     ;;;
;;;                                                                  ;;;

;;; Utilities that make use of the meta-object protocol. ;;; Abstract classes are classes that must never be ;;; instantiated. They are only used as superclasses. ;;; In general, they perform two useful function: ;;; First, they can be used to define a "protocol", ;;; namely a set of generic functions that some ;;; group of classes should implement. ;;; Second, they can provide some utility methods ;;; that any of the subclasses is free to take ;;; advantage of, so that the subclasses can share ;;; code in a modular way. ;;; This implementation was provided to us by MOPmeister ;;; Pascal Costanza, of the Vrije Universiteit Brussel, ;;; Programming Technology Lab. (define-condition instantiate-abstract (error) ((class-name :type symbol :initarg :class-name :reader instantiate-abstract-class-name)) (:documentation "There was an attempt to instantiate an abstract class") (:report (lambda (c stream) (format stream "There was an attempt to make an instance of abstract class ~S" (instantiate-abstract-class-name c)))))

(defclass abstract-class (standard-class) () (:documentation "This is a metaclass. Any class that has this as its metaclass is an abstract class. An attempt to instantiate an abstract class signals a INSTANTIATE-ABSTRACT condition."))

;;; Why are the validate methods here? In general, two metaclasses are not semantically compatible with ;;; each other. For example, one metaclass may ensure that slot values are only given to the outside ;;; world in encrypted form, for security reasons, and another metaclass may want to add automatic ;;; logging whenever slot values are changed. Combining them means that either one or the other ;;; metaclass functionality is violated. There is no general way to resolve such problems. ;;; Validate-superclass is a way to announce which metaclasses are compatible with each other. Here we ;;; announce that abstract classes can have standard classes as direct superclasses, and vice versa. (defmethod closer-mop:validate-superclass ((class abstract-class) (superclass standard-class)) t)

(defmethod closer-mop:validate-superclass ((class standard-class) (superclass abstract-class)) t)

(defvar *outside-abstract-class* nil)

(defmethod allocate-instance ((class abstract-class) &key &allow-other-keys) (unless *outside-abstract-class* (error 'instantiate-abstract :class-name (class-name class))))

(defmethod closer-mop:class-prototype :around ((class abstract-class)) (let ((*outside-abstract-class* t)) (call-next-method)))

元は、Pascal Costanza氏のコードらしいのですが、元コードは探しても見付けられませんでした。




make-instance に細工をする方法

現在、Quicklispで導入できるTim Bradshaw氏のabstract-classesでは、abstract-classというメタクラスを作って、それに、make-instanceを設定し、make-instanceが実行されたらエラーという感じです。

;;; 導入方法
(ql:quickload :abstract-classes)


(define-class <abstract-class> (<class>) ())

(define-method make ((class <abstract-class>) :rest initargs) (error "There was an attempt to make an instance of abstract class" class))


(define-class <foo> ()
  :metaclass <abstract-class>)

(make <foo>) ⊳ *** ERROR: There was an attempt to make an instance of abstract class #<class <foo>>


(define-class <bar> (<foo>)
  :metaclass <class>)

(make <bar>) → #<<bar> 0x2797b30>


しかし、これでOKかと思いきや、Common Lispの場合は、make-instanceせずにクラス変数を取得するのにclass-prototypeが利用されているようで、make-instanceを潰す方法では、抽象クラスのクラス変数が取得できてしまうようです(なお、Gaucheにはclass-prototypeはないようなので、この心配はなさそうです)


(defclass foo ()
  ((c :initform 42 :allocation :class))
  (:metaclass abstract-classes:abstract-class)) 

(finalize-inheritance (find-class 'foo)) → nil

(slot-value (class-prototype (find-class 'foo)) 'c) → 42


class-prototype に細工をする方法



そういえば、MCSは、抽象クラスの定義構文を持っていた、と思い出したので、MCSではどうなっているか眺めてみましたが、instantiableクラスとabstractクラスに分かれた構成になっていて、allocate-instance/class-prototypeは、instantiableクラスにしか定義されていないので、No applicable methodsエラーになります。


Common LispのMOPはなかなか全貌を捕えることが難しい印象ですが、なんといっても参考にできる資料が少ないと思います。

HTML generated by 3bmd in LispWorks 7.0.0

comments powered by Disqus