Posted 2016-09-11 18:50:34 GMT
暇潰しにQITAB - a collection of free Lisp codeのソースを眺めていた所、MOPで抽象クラスを実現したコードをみつけました。
githubに切り出されたりしていないのと短いのとで全掲します(ユーティリティは除く)。
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; ;;;
;;; 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氏のコードらしいのですが、元コードは探しても見付けられませんでした。
とりあえず、面白い所は、allocate-instanceをエラー出すものに挿し替えてしまい、class-prototypeから呼ぶ時はエラーにならないようにする、という所でしょうか。
何故こういう構成になっているのかさっぱり分からなかったので調べてみました。
まず、MOPで抽象クラスを実現する方法ですが、抽象クラスのインスタンス生成しようとした場合にエラーにすることが多いようです。
make-instance に細工をする方法現在、Quicklispで導入できるTim Bradshaw氏のabstract-classesでは、abstract-classというメタクラスを作って、それに、make-instanceを設定し、make-instanceが実行されたらエラーという感じです。
;;; 導入方法
(ql:quickload :abstract-classes)この仕組みは、Gaucheで書いてみるとシンプルで分かり易いのですが、
(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>>
のように、<abstract-class>メタクラスでは、エラーになりますが、メタクラスが<abstract-class>でなければ、エラーになりませんので、mixinすれば使えます。
(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))
;;上述のQuicklispで導入できるabstract-classes
(:metaclass abstract-classes:abstract-class)) (finalize-inheritance (find-class 'foo))
→ nil
(slot-value (class-prototype (find-class 'foo)) 'c)
→ 42
ちなみに議論は、comp.lang.lispをclass-prototypeで検索すると色々出てきます。
class-prototype に細工をする方法ということで、冒頭のコードのclass-prototypeに細工をする方法になるわけですが、恐らく、クラス変数が取得できる云々というよりは、一番最初にallocate-instanceが呼ばれる場所であるからなのでしょう。
そういえば、MCSは、抽象クラスの定義構文を持っていた、と思い出したので、MCSではどうなっているか眺めてみましたが、instantiableクラスとabstractクラスに分かれた構成になっていて、allocate-instance/class-prototypeは、instantiableクラスにしか定義されていないので、No applicable methodsエラーになります。
さすが最初から組込まれているだけあってすっきりしていますね。
Common LispのMOPはなかなか全貌を捕えることが難しい印象ですが、なんといっても参考にできる資料が少ないと思います。
MOPのレシピ集が欲しい……。
■
HTML generated by 3bmd in LispWorks 7.0.0