Changeset 9769


Ignore:
Timestamp:
Jun 16, 2008, 11:17:10 PM (11 years ago)
Author:
gb
Message:

Restore the definition of PARSE-DEFINITION-SPEC, which doesn't have
too much to do with how source info is recorded but was in this file
and was called from (at least) some code in xref.lisp.

File:
1 edited

Legend:

Unmodified
Added
Removed
  • branches/working-0711/ccl/lib/source-files.lisp

    r9740 r9769  
    457457
    458458
     459(defun parse-definition-spec (form)
     460  (let ((type t)
     461        name classes qualifiers)
     462    (cond
     463     ((consp form)
     464      (cond ((eq (car form) 'setf)
     465             (setq name form))
     466            (t (setq name (car form))
     467               (let ((last (car (last (cdr form)))))
     468                 (cond ((and (listp last)(or (null last)(neq (car last) 'eql)))
     469                        (setq classes last)
     470                        (setq qualifiers (butlast (cdr form))))
     471                       (t (setq classes (cdr form)))))                   
     472               (cond ((null qualifiers)
     473                      (setq qualifiers t))
     474                     ((equal qualifiers '(:primary))
     475                      (setq qualifiers nil))))))
     476     (t (setq name form)))
     477    (when (and (consp name)(eq (car name) 'setf))
     478        (setq name (or (%setf-method (cadr name)) name))) ; e.g. rplacd
     479    (when (not (or (symbolp name)
     480                   (setf-function-name-p name)))
     481      (return-from parse-definition-spec))
     482    (when (consp qualifiers)
     483      (mapc #'(lambda (q)
     484                (when (listp q)
     485                  (return-from parse-definition-spec)))
     486          qualifiers))
     487    (when classes
     488      (mapc #'(lambda (c)
     489                (when (not (and c (or (symbolp c)(and (consp c)(eq (car c) 'eql)))))
     490                  (return-from parse-definition-spec)))
     491            classes))           
     492    (when (or (consp classes)(consp qualifiers))(setq type 'method))
     493    (values type name classes qualifiers)))
     494
    459495;;;; * backwards compatability. find-definitions-for-name or definition-source is the preferred way
    460496;;;; to lookup sources.
Note: See TracChangeset for help on using the changeset viewer.