[Openmcl-devel] Problem with non-standard class options in defclass expansion

[Gary King]

The defclass macro is taking only the car of non-standard defclass 
options instead of the entire option. To point out a particular case, 
here is the example from 
http://www.lisp.org/mop/concepts.html#defclass. The macro-expansion of:

(defclass sst (plane)
      ((mach mag-step 2
             locator sst-mach
             locator mach-location
             :reader mach-speed
             :reader mach))
   (:metaclass faster-class)
   (another-option foo bar))

Gives

(ccl::ensure-class-for-defclass
  'sst
  :direct-superclasses
  '(plane)
  :direct-slots
  (list (list :name 'mach :readers '(mach mach-speed)
              'mag-step '2 'locator 'sst-mach 'locator
              'mach-location))
  :metaclass (find-class 'faster-class)
  'another-option 'foo)

rather than:

(ensure-class 'sst
   ':direct-superclasses '(plane)
   ':direct-slots (list (list ':name 'mach
                              ':readers '(mach-speed mach)
                              'mag-step '2
                              'locator '(sst-mach mach-location)))
   ':metaclass 'faster-class
   'another-option '(foo bar))

If I read things correctly, the offending line is the last one in the 
option parsing section of defclass:

  (case option-name
                    (:default-initargs
                        (let ((canonical ()))
                          (let (key val (tail (cdr option)))
                            (loop (when (null tail) (return nil))
			       (setq key (pop tail)
				     val (pop tail))
			     (push ``(,',key ,,(make-initfunction val) ,',val) canonical))
                            `(':direct-default-initargs (list 
,@(nreverse canonical))))))
                    (:metaclass
                     (unless (and (cadr option)
                                  (typep (cadr option) 'symbol))
                       (illegal-option option))
                     `(:metaclass (find-class ',(cadr option))))
                    (t
                     (list `',option-name `',(cadr option))))))

I think that it should be (list `',option-name `',(cdr option))

Looking for enlightenment,
-- 
Gary Warren King, Lab Manager
EKSL East, University of Massachusetts * 413 577 0176

All are equal before the law and are entitled without any 
discrimination to equal protection of the law. All are entitled to 
equal protection against any discrimination in violation of this 
Declaration and against any incitement to such discrimination.
    -- Universal Declaration of Human Rights, Article 7