[armedbear-cvs] r14012 - trunk/abcl/src/org/armedbear/lisp

[rschlatte at common-lisp.net]

Author: rschlatte
Date: Thu Jul 19 12:41:41 2012
New Revision: 14012

Log:
Enable usage of method combinations with options

- e.g., (defgeneric foo (x) (:method-combination and :most-specific-last))

Modified:
   trunk/abcl/src/org/armedbear/lisp/clos.lisp
   trunk/abcl/src/org/armedbear/lisp/print-object.lisp

Modified: trunk/abcl/src/org/armedbear/lisp/clos.lisp
==============================================================================
--- trunk/abcl/src/org/armedbear/lisp/clos.lisp	Tue Jul 17 00:59:27 2012	(r14011)
+++ trunk/abcl/src/org/armedbear/lisp/clos.lisp	Thu Jul 19 12:41:41 2012	(r14012)
@@ -901,23 +901,23 @@
    (direct-methods :initform nil)))
 
 (define-primordial-class method-combination (metaobject)
-  ((sys::name :initform nil)
+  ((sys::name :initarg :name :initform nil)
    (sys::%documentation :initarg :documentation :initform nil)
    (options :initarg :options :initform nil)))
 
 (define-primordial-class short-method-combination (method-combination)
-  (operator
-   identity-with-one-argument))
+  ((operator :initarg :operator)
+   (identity-with-one-argument :initarg :identity-with-one-argument)))
 
 (define-primordial-class long-method-combination (method-combination)
-  (sys::lambda-list
-   method-group-specs
-   args-lambda-list
-   generic-function-symbol
-   function
-   arguments
-   declarations
-   forms))
+  ((sys::lambda-list :initarg :lambda-list)
+   (method-group-specs :initarg :method-group-specs)
+   (args-lambda-list :initarg :args-lambda-list)
+   (generic-function-symbol :initarg :generic-function-symbol)
+   (function :initarg :function)
+   (arguments :initarg :arguments)
+   (declarations :initarg :declarations)
+   (forms :initarg :forms)))
 
 (define-primordial-class standard-accessor-method (standard-method)
   ((sys::%slot-definition :initarg :slot-definition :initform nil)))
@@ -1033,7 +1033,6 @@
          (operator
           (getf (cddr whole) :operator name)))
     `(progn
-       ;; Class short-method-combination is defined in StandardClass.java.
        (let ((instance (std-allocate-instance
                         (find-class 'short-method-combination))))
          (setf (std-slot-value instance 'sys::name) ',name)

Modified: trunk/abcl/src/org/armedbear/lisp/print-object.lisp
==============================================================================
--- trunk/abcl/src/org/armedbear/lisp/print-object.lisp	Tue Jul 17 00:59:27 2012	(r14011)
+++ trunk/abcl/src/org/armedbear/lisp/print-object.lisp	Thu Jul 19 12:41:41 2012	(r14012)
@@ -79,7 +79,7 @@
 (defmethod print-object ((method-combination method-combination) stream)
   (print-unreadable-object (method-combination stream :identity t)
     (format stream "~A ~S" (class-name (class-of method-combination))
-            (mop::method-combination-name method-combination)))
+            (ignore-errors (mop::method-combination-name method-combination))))
   method-combination)
 
 (defmethod print-object ((restart restart) stream)