Commit 7521670e authored by Pascal Costanza's avatar Pascal Costanza
Browse files

Removed forced replacement of standard metaclasses with Closer to MOP versions.

Ignore-this: 2cab7a24d8f17062675d9a12063fcdca

darcs-hash:19d18f4943244bab627634c0f4b0921324224a7a
parent 8f2d3358
......@@ -4,12 +4,7 @@
(:use #:common-lisp)
(:nicknames #:c2mop)
(:shadow
#:defclass #:defgeneric #:ensure-generic-function
#:standard-class #:standard-generic-function)
(:export
#:defclass #:defgeneric #:ensure-generic-function
#:standard-class #:standard-generic-function)
(:shadow #:standard-class #:standard-generic-function)
(:import-from #:excl #:classp)
......
......@@ -63,14 +63,6 @@
(when (eq (class-of superclass) (find-class 'cl:standard-class))
(validate-superclass class (class-prototype (find-class 'standard-class))))))
;; The following macro ensures that the new standard-class is used by default.
(defmacro defclass (name (&rest supers) &body options)
(if (member :metaclass options :key #'car)
`(cl:defclass ,name ,supers ,@options)
`(cl:defclass ,name ,supers ,@options
(:metaclass standard-class))))
;; Allegro defines an extra check for :allocation kinds. AMOP expects any kind to be
;; permissible, though. This is corrected here.
......@@ -131,6 +123,7 @@
()
(:metaclass clos:funcallable-standard-class))
#|
;; The following ensures that the new standard-generic-function is used.
(defun ensure-generic-function
......@@ -151,15 +144,8 @@
(apply #'ensure-generic-function-using-class nil name
:generic-function-class generic-function-class
args)))
|#
;; The following macro ensures that the new standard-generic-function
;; is used by default.
(defmacro defgeneric (name (&rest args) &body options)
(if (member :generic-function-class options :key #'car)
`(cl:defgeneric ,name ,args ,@options)
`(cl:defgeneric ,name ,args ,@options
(:generic-function-class standard-generic-function))))
;;; The following three methods ensure that the dependent protocol
;;; for generic function works.
......
......@@ -5,12 +5,10 @@
(:nicknames #:c2mop)
(:shadow
#:defclass #:defgeneric #:defmethod
#:ensure-generic-function
#:defgeneric #:defmethod
#:standard-class #:standard-generic-function)
(:export
#:defclass #:defgeneric #:defmethod
#:ensure-generic-function
#:defgeneric #:defmethod
#:standard-class #:standard-generic-function)
(:import-from #:clos
......
......@@ -42,11 +42,10 @@
((initial-methods :initform '()))
(:metaclass clos:funcallable-standard-class))
;; The following ensures that the new standard-generic-function is used.
#|
(defun ensure-generic-function
(name &rest args
&key (generic-function-class 'standard-generic-function)
&key (generic-function-class 'cl:standard-generic-function)
&allow-other-keys)
(declare (dynamic-extent args))
(when (fboundp name)
......@@ -62,6 +61,7 @@
(apply #'ensure-generic-function-using-class nil name
:generic-function-class generic-function-class
args)))
|#
;; We need a new standard-class for various things.
......@@ -88,19 +88,6 @@
(when (eq (class-of superclass) (find-class 'cl:standard-class))
(validate-superclass class (class-prototype (find-class 'standard-class))))))
;; The following macro ensures that the new standard-class is used
;; by default. It would have been useful to fix other deficiencies
;; in a complete redefinition of defclass, but there is no portable
;; way to ensure the necessary compile-time effects as specified
;; by ANSI Common Lisp. Therefore, we just expand to the original
;; cl:defclass.
(defmacro defclass (name (&rest supers) &body options)
(if (member :metaclass options :key #'car)
`(cl:defclass ,name ,supers ,@options)
`(cl:defclass ,name ,supers ,@options
(:metaclass standard-class))))
;; We need a new funcallable-standard-class for various things.
(cl:defclass funcallable-standard-class (clos:funcallable-standard-class)
......@@ -584,9 +571,6 @@
(add-method ,gf ,method)
,method))))))))))
;; The following macro ensures that the new standard-generic-function
;; is used by default. It also ensures that make-method-lambda is called
;; for the default methods, by expanding into defmethod forms.
(defmacro defgeneric (&whole form name (&rest args) &body options)
(unless (every #'consp options)
......
......@@ -68,19 +68,6 @@
(when (eq (class-of superclass) (find-class 'cl:standard-class))
(validate-superclass class (class-prototype (find-class 'standard-class))))))
;; The following macro ensures that the new standard-class is used
;; by default. It would have been useful to fix other deficiencies
;; in a complete redefinition of defclass, but there is no portable
;; way to ensure the necessary compile-time effects as specified
;; by ANSI Common Lisp. Therefore, we just expand to the original
;; cl:defclass.
(defmacro defclass (name (&rest supers) &body options)
(if (member :metaclass options :key #'car)
`(cl:defclass ,name ,supers ,@options)
`(cl:defclass ,name ,supers ,@options
(:metaclass standard-class))))
;; In MCL, the list of direct superclasses passed by the
;; defclass macro is not empty, as required by AMOP, but
;; instead passes the class metaobject for standard-object
......@@ -151,7 +138,7 @@
(defun ensure-generic-function
(name &rest args
&key (generic-function-class 'standard-generic-function)
&key (generic-function-class 'cl:standard-generic-function)
&allow-other-keys)
(declare (dynamic-extent args))
(when (fboundp name)
......@@ -167,13 +154,7 @@
(apply #'ensure-generic-function-using-class nil name
:generic-function-class generic-function-class
args)))
(defmacro defgeneric (&whole form name (&rest args) &body options)
(unless (every #'consp options)
(error "Illegal generic functions options in defgeneric form ~S." form))
`(cl:defgeneric ,name ,args ,@options
,@(unless (member :generic-function-class options :key #'car :test #'eq)
'((:generic-function-class standard-generic-function)))))
|#
(cl:defgeneric compute-discriminating-function (gf)
(:method ((gf generic-function))
......
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