[slime-cvs] CVS update: slime/swank-cmucl.lisp

[Helmut Eller]

Update of /project/slime/cvsroot/slime
In directory common-lisp.net:/tmp/cvs-serv22402

Modified Files:
	swank-cmucl.lisp 
Log Message:
(+header-type-symbols+): Drop the third arg to apropos-list; it's no
longer supported recent CMUCLs.

Date: Wed Apr 27 16:47:22 2005
Author: heller

Index: slime/swank-cmucl.lisp
diff -u slime/swank-cmucl.lisp:1.143 slime/swank-cmucl.lisp:1.144
--- slime/swank-cmucl.lisp:1.143	Mon Apr  4 01:27:41 2005
+++ slime/swank-cmucl.lisp	Wed Apr 27 16:47:22 2005
@@ -1788,18 +1788,18 @@
 The `symbol-value' of each element is a type tag.")
 
 (defconstant +header-type-symbols+
-  (flet ((suffixp (suffix string)
-           (and (>= (length string) (length suffix))
-                (string= string suffix :start1 (- (length string) 
-                                                  (length suffix))))))
-    ;; Is there a convinient place for all those constants?
-    (remove-if-not
-     (lambda (x) (and (suffixp "-TYPE" (symbol-name x))
-                      (not (member x +lowtag-symbols+))
-                      (boundp x)
-                      (typep (symbol-value x) 'fixnum)))
-     (append (apropos-list "-TYPE" "VM" t)
-             (apropos-list "-TYPE" "BIGNUM" t))))
+  (labels ((suffixp (suffix string)
+             (and (>= (length string) (length suffix))
+                  (string= string suffix :start1 (- (length string) 
+                                                    (length suffix)))))
+           (header-type-symbol-p (x)
+             (and (suffixp "-TYPE" (symbol-name x))
+                  (not (member x +lowtag-symbols+))
+                  (boundp x)
+                  (typep (symbol-value x) 'fixnum))))
+    (remove-if-not #'header-type-symbol-p
+                   (append (apropos-list "-TYPE" "VM")
+                           (apropos-list "-TYPE" "BIGNUM"))))
   "A list of names of the type codes in boxed objects.")
 
 (defimplementation describe-primitive-type (object)