Changeset 11161
- Timestamp:
- Oct 18, 2008, 7:15:22 PM (12 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
trunk/source/lib/source-files.lisp
r11067 r11161 69 69 70 70 (defclass definition-type () 71 ((name :allocation :class :reader definition-type-name ))71 ((name :allocation :class :reader definition-type-name :initform t)) 72 72 (:documentation "Superclass of all definition types")) 73 73 … … 192 192 (defparameter *function-definition-type* (definition-type-instance 'function)) 193 193 194 ;; TODO: what about (:internal .... (method-name quals specs)) ?195 194 (defmethod definition-base-name ((dt function-definition-type) name) 196 (while (consp name) 197 (if (setf-function-name-p name) 198 (return-from definition-base-name (canonical-maybe-setf-name name)) 199 (let ((x (last name))) 200 (setq name (or (cdr x) (car x)))))) 201 name) 195 (while (and (consp name) (not (setf-function-name-p name))) 196 (let ((x (last name))) 197 (or (setq name (cdr x)) 198 ;; Try to detect the (:internal .... <hairy-method-name>) case 199 (when (and (setq name (car x)) 200 ;;check for plausible method name 201 (setq x (method-def-parameters name)) 202 (neq x 'setf) 203 (not (keywordp x))) 204 (setq name x))))) 205 (canonical-maybe-setf-name name)) 202 206 203 207 (defmethod definition-bound-p ((dt function-definition-type) name) … … 223 227 (defmethod definition-base-name ((dt method-definition-type) (name cons)) 224 228 (if (setf-function-name-p name) 225 name229 (canonical-maybe-setf-name name) 226 230 (definition-base-name *function-definition-type* (car name)))) 227 231 … … 420 424 421 425 ;;; backward compatibility 422 423 426 424 427 ;;; modified version of %method-applicable-p - args are class names
Note: See TracChangeset
for help on using the changeset viewer.