Changeset 11161


Ignore:
Timestamp:
Oct 18, 2008, 7:15:22 PM (11 years ago)
Author:
gz
Message:

some definition-type fixes from r11054

File:
1 edited

Legend:

Unmodified
Added
Removed
  • trunk/source/lib/source-files.lisp

    r11067 r11161  
    6969
    7070(defclass definition-type ()
    71   ((name :allocation :class :reader definition-type-name))
     71  ((name :allocation :class :reader definition-type-name :initform t))
    7272  (:documentation "Superclass of all definition types"))
    7373
     
    192192(defparameter *function-definition-type* (definition-type-instance 'function))
    193193
    194 ;; TODO: what about (:internal .... (method-name quals specs)) ?
    195194(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))
    202206
    203207(defmethod definition-bound-p ((dt function-definition-type) name)
     
    223227(defmethod definition-base-name ((dt method-definition-type) (name cons))
    224228  (if (setf-function-name-p name)
    225     name
     229    (canonical-maybe-setf-name name)
    226230    (definition-base-name *function-definition-type* (car name))))
    227231
     
    420424
    421425;;; backward compatibility
    422 
    423426
    424427;;; modified version of %method-applicable-p - args are class names
Note: See TracChangeset for help on using the changeset viewer.