X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fpcl%2Fmacros.lisp;h=baec9382f55a137527920f67e64986d3539e491e;hb=dea9bd5c1afe23d9e061c60db654b88187ba9a5e;hp=9d4bbd8ee53e201f532f4c287e45a9aeb3ee0727;hpb=e8b69b1dd5564a4237b1bdc1060820c3b820cde2;p=sbcl.git

diff --git a/src/pcl/macros.lisp b/src/pcl/macros.lisp
index 9d4bbd8..baec938 100644
--- a/src/pcl/macros.lisp
+++ b/src/pcl/macros.lisp
@@ -29,11 +29,14 @@
 (/show "starting pcl/macros.lisp")
 
 (declaim (declaration
-	  ;; These three nonstandard declarations seem to be used
-	  ;; privately within PCL itself to pass information around,
-	  ;; so we can't just delete them.
-	  %class
+	  ;; As of sbcl-0.7.0.6, SBCL actively uses this declaration
+	  ;; to propagate information needed to set up nice debug
+	  ;; names (as seen e.g. in BACKTRACE) for method functions.
 	  %method-name
+	  ;; These nonstandard declarations seem to be used privately
+	  ;; within PCL itself to pass information around, so we can't
+	  ;; just delete them.
+	  %class
 	  %method-lambda-list
 	  ;; This declaration may also be used within PCL to pass
 	  ;; information around, I'm not sure. -- WHN 2000-12-30
@@ -41,42 +44,6 @@
 
 (/show "done with DECLAIM DECLARATION")
 
-;;; FIXME: This looks like SBCL's PARSE-BODY, and should be shared.
-(eval-when (:compile-toplevel :load-toplevel :execute)
-
-(defun extract-declarations (body &optional environment)
-  ;;(declare (values documentation declarations body))
-  (let (documentation
-        declarations
-        form)
-    (when (and (stringp (car body))
-               (cdr body))
-      (setq documentation (pop body)))
-    (block outer
-      (loop
-        (when (null body) (return-from outer nil))
-        (setq form (car body))
-        (when (block inner
-                (loop (cond ((not (listp form))
-                             (return-from outer nil))
-                            ((eq (car form) 'declare)
-                             (return-from inner t))
-                            (t
-                             (multiple-value-bind (newform macrop)
-                                  (macroexpand-1 form environment)
-                               (if (or (not (eq newform form)) macrop)
-                                   (setq form newform)
-                                 (return-from outer nil)))))))
-          (pop body)
-          (dolist (declaration (cdr form))
-            (push declaration declarations)))))
-    (values documentation
-            (and declarations `((declare ,.(nreverse declarations))))
-            body)))
-) ; EVAL-WHEN
-
-(/show "done with EVAL-WHEN (..) DEFUN EXTRACT-DECLARATIONS")
-
 (defun get-declaration (name declarations &optional default)
   (dolist (d declarations default)
     (dolist (form (cdr d))
@@ -85,18 +52,14 @@
 
 (/show "pcl/macros.lisp 85")
 
-(defmacro doplist ((key val) plist &body body &environment env)
-  (multiple-value-bind (doc decls bod)
-      (extract-declarations body env)
-    (declare (ignore doc))
-    `(let ((.plist-tail. ,plist) ,key ,val)
-       ,@decls
-       (loop (when (null .plist-tail.) (return nil))
-	     (setq ,key (pop .plist-tail.))
-	     (when (null .plist-tail.)
-	       (error "malformed plist, odd number of elements"))
-	     (setq ,val (pop .plist-tail.))
-	     (progn ,@bod)))))
+(defmacro doplist ((key val) plist &body body)
+  `(let ((.plist-tail. ,plist) ,key ,val)
+     (loop (when (null .plist-tail.) (return nil))
+	   (setq ,key (pop .plist-tail.))
+	   (when (null .plist-tail.)
+	     (error "malformed plist, odd number of elements"))
+	   (setq ,val (pop .plist-tail.))
+	   (progn ,@body))))
 
 (/show "pcl/macros.lisp 101")
 
@@ -252,5 +215,5 @@
   `(setf ,name))
 
 (defsetf slot-value set-slot-value)
-
+
 (/show "finished with pcl/macros.lisp")