[slime-cvs] CVS slime

[CVS User heller]

Update of /project/slime/cvsroot/slime
In directory cl-net:/tmp/cvs-serv31270

Modified Files:
	ChangeLog swank-cmucl.lisp 
Log Message:
Slightly better error message when CMUCL fails to find defstructs.

* swank-cmucl.lisp (struct-constructor, setf-definitions): Don't
use COERCE which gives confusing error message.

--- /project/slime/cvsroot/slime/ChangeLog	2010/01/05 09:00:15	1.1954
+++ /project/slime/cvsroot/slime/ChangeLog	2010/01/05 09:00:22	1.1955
@@ -1,5 +1,12 @@
 2010-01-05  Helmut Eller  <heller at common-lisp.net>
 
+	Slightly better error message when CMUCL fails to find defstructs.
+
+	* swank-cmucl.lisp (struct-constructor, setf-definitions): Don't
+	use COERCE which gives confusing error message.
+
+2010-01-05  Helmut Eller  <heller at common-lisp.net>
+
 	Add "quit" and "other window prefix" buffer selectors.
 
 	* slime.el (slime-selector-other-window): New variable.
--- /project/slime/cvsroot/slime/swank-cmucl.lisp	2009/12/22 09:31:15	1.216
+++ /project/slime/cvsroot/slime/swank-cmucl.lisp	2010/01/05 09:00:22	1.217
@@ -1017,14 +1017,12 @@
 (defun struct-constructor (dd)
   "Return a constructor function from a defstruct definition.
 Signal an error if no constructor can be found."
-  (let ((constructor (or (kernel:dd-default-constructor dd)
-                         (car (kernel::dd-constructors dd)))))
-    (when (or (null constructor)
-              (and (consp constructor) (null (car constructor))))
-      (error "Cannot find structure's constructor: ~S"
-             (kernel::dd-name dd)))
-    (coerce (if (consp constructor) (first constructor) constructor)
-            'function)))
+  (let* ((constructor (or (kernel:dd-default-constructor dd)
+                          (car (kernel::dd-constructors dd))))
+         (sym (if (consp constructor) (car constructor) constructor)))
+    (unless sym
+      (error "Cannot find structure's constructor: ~S" (kernel::dd-name dd)))
+    (coerce sym 'function)))
 
 ;;;;;; Generic functions and methods
 
@@ -1197,15 +1195,15 @@
            (null `(:error ,(format nil "Cannot resolve: ~S" source)))))))))
 
 (defun setf-definitions (name)
-  (let ((function (or (ext:info :setf :inverse name)
-                      (ext:info :setf :expander name)
-                      (and (symbolp name)
-                           (fboundp `(setf ,name))
-                           (fdefinition `(setf ,name))))))
-    (if function
-        (list (list `(setf ,name) 
-                    (function-location (coerce function 'function)))))))
-
+  (let ((f (or (ext:info :setf :inverse name)
+               (ext:info :setf :expander name)
+               (and (symbolp name)
+                    (fboundp `(setf ,name))
+                    (fdefinition `(setf ,name))))))
+    (if f
+        `(((setf ,name) ,(function-location (cond ((functionp  f) f)
+                                                  ((macro-function f))
+                                                  ((fdefinition f)))))))))
 
 (defun variable-location (symbol)
   (multiple-value-bind (location foundp)