Changeset 9769

Timestamp:

Jun 16, 2008, 4:17:10 PM (16 years ago)

Author:

Gary Byers

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:

• branches/working-0711/ccl/lib/source-files.lisp (modified) (1 diff)

branches/working-0711/ccl/lib/source-files.lisp

@@ -457 +457 @@
 
 
+(defun parse-definition-spec (form)
+  (let ((type t)
+        name classes qualifiers)
+    (cond
+     ((consp form)
+      (cond ((eq (car form) 'setf)
+             (setq name form))
+            (t (setq name (car form))
+               (let ((last (car (last (cdr form)))))
+                 (cond ((and (listp last)(or (null last)(neq (car last) 'eql)))
+                        (setq classes last)
+                        (setq qualifiers (butlast (cdr form))))
+                       (t (setq classes (cdr form)))))                   
+               (cond ((null qualifiers)
+                      (setq qualifiers t))
+                     ((equal qualifiers '(:primary))
+                      (setq qualifiers nil))))))
+     (t (setq name form)))
+    (when (and (consp name)(eq (car name) 'setf))
+        (setq name (or (%setf-method (cadr name)) name))) ; e.g. rplacd
+    (when (not (or (symbolp name)
+                   (setf-function-name-p name)))
+      (return-from parse-definition-spec))
+    (when (consp qualifiers)
+      (mapc #'(lambda (q)
+                (when (listp q)
+                  (return-from parse-definition-spec)))
+          qualifiers))
+    (when classes
+      (mapc #'(lambda (c)
+                (when (not (and c (or (symbolp c)(and (consp c)(eq (car c) 'eql)))))
+                  (return-from parse-definition-spec)))
+            classes))            
+    (when (or (consp classes)(consp qualifiers))(setq type 'method))
+    (values type name classes qualifiers)))
+
 ;;;; * backwards compatability. find-definitions-for-name or definition-source is the preferred way
 ;;;; to lookup sources.