Implement MOP:VALIDATE-SUPERCLASS.

Start breaking out MOP defintions into separate 'mop.lisp' file.
parent cade4388
......@@ -3172,4 +3172,8 @@ or T when any keyword is acceptable due to presence of
(defmethod class-prototype ((class structure-class))
(allocate-instance class))
(eval-when (:compile-toplevel :load-toplevel :execute)
(require "MOP"))
(provide 'clos)
......@@ -107,6 +107,7 @@
(load (do-compile "require.lisp"))
(load (do-compile "substitute.lisp"))
(load (do-compile "clos.lisp"))
(load (do-compile "mop.lisp"))
;; Order matters for these files.
(mapc #'do-compile '("collect.lisp"
"macros.lisp"
......
;;;; Does not currently include all the MOP, but it should.
(in-package #:mop)
(defclass funcallable-standard-class (class))
(defmethod class-name ((class funcallable-standard-class))
'funcallable-standard-class)
;;; StandardGenericFunction.java defines FUNCALLABLE-INSTANCE-FUNCTION and
;;; SET-FUNCALLABLE-INSTANCE-FUNCTION.
;;;
;;; TODO
;;;
;;; 1. Verify that we can make FUNCALLABLE-STANDARD-CLASS instances
;;; which work.
;;;
;;; 2. Tighten the type checks so that only instances of
;;; FUNCALLABLE-STANDARD-CLASS are callable.
(defgeneric validate-superclass (class superclass)
(:documentation
"This generic function is called to determine whether the class
superclass is suitable for use as a superclass of class."))
(defmethod validate-superclass ((class class) (superclass class))
(or (eql (class-name superclass) t)
(eql (class-name class) (class-name superclass))
(or (and (eql (class-name class) 'standard-class)
(eql (class-name superclass) 'funcallable-standard-class))
(and (eql (class-name class) 'funcallable-standard-class)
(eql (class-name superclass) 'standard-class)))))
(export '(funcallable-standard-class
validate-superclass))
(provide 'mop)
......@@ -360,3 +360,14 @@
1)
(defclass foo-class (standard-class))
(defmethod mop:validate-superclass ((class foo-class) (superclass standard-object))
t)
(deftest validate-superclass.1
(mop:validate-superclass
(make-instance 'foo-class)
(make-instance 'standard-object))
t)
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment