Ignore:
Timestamp:
Apr 8, 2008, 3:17:29 AM (13 years ago)
Author:
gz
Message:

make defclass check for illegal class options (ticket #271)

File:
1 edited

Legend:

Unmodified
Added
Removed
  • trunk/source/level-1/l1-clos-boot.lisp

    r8863 r9049  
    30253025
    30263026
    3027 (defun compute-initargs-vector (instance class functions)
     3027;; This is used for compile-time defclass option checking.
     3028(defun class-keyvect (class-arg initargs)
     3029  (let* ((class (if (typep class-arg 'class) class-arg (find-class class-arg nil)))
     3030         (meta-arg (getf initargs :metaclass (if (and class (not (typep class 'forward-referenced-class)))
     3031                                               (class-of class)
     3032                                               *standard-class-class*)))
     3033         (meta-spec (if (quoted-form-p meta-arg) (%cadr meta-arg) meta-arg))
     3034         (meta (if (typep meta-spec 'class) meta-spec (find-class meta-spec))))
     3035    (compute-initargs-vector class meta (list #'initialize-instance #'allocate-instance #'shared-initialize) t)))
     3036
     3037(defun compute-initargs-vector (instance class functions &optional require-rest)
    30283038  (let ((initargs (class-slot-initargs class))
    30293039        (cpl (%inited-class-cpl class)))
     
    30383048                  (memq spec cpl))
    30393049            (let* ((func (%inner-method-function method))
    3040                    (keyvect (if (logbitp $lfbits-aok-bit (lfun-bits func))
    3041                               (return-from compute-initargs-vector t)
     3050                   (keyvect (if (and (logbitp $lfbits-aok-bit (lfun-bits func))
     3051                                     (or (not require-rest)
     3052                                         (logbitp $lfbits-rest-bit (lfun-bits func))))
     3053                              (return-from compute-initargs-vector t)
    30423054                              (lfun-keyvect func))))
    30433055              (dovector (key keyvect)
Note: See TracChangeset for help on using the changeset viewer.