[slime-cvs] CVS slime/contrib

[CVS User heller]

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

Modified Files:
	ChangeLog swank-kawa.scm 
Log Message:
* swank-kawa.scm (mangled-name): Try to deal unnamed lambdas.
(inspect): Split up into inspect-array-ref and inspect-obj-ref.
(inspect-array-ref): New.
(inspect-obj-ref): New. Include methods in result.

--- /project/slime/cvsroot/slime/contrib/ChangeLog	2011/12/01 16:48:21	1.512
+++ /project/slime/cvsroot/slime/contrib/ChangeLog	2011/12/01 22:34:29	1.513
@@ -1,3 +1,10 @@
+2011-12-01  Helmut Eller  <heller at common-lisp.net>
+
+	* swank-kawa.scm (mangled-name): Try to deal unnamed lambdas.
+	(inspect): Split up into inspect-array-ref and inspect-obj-ref.
+	(inspect-array-ref): New.
+	(inspect-obj-ref): New. Include methods in result.
+
 2011-11-29  Helmut Eller  <heller at common-lisp.net>
 
 	* swank-util.lisp: New file.
--- /project/slime/cvsroot/slime/contrib/swank-kawa.scm	2010/10/17 10:17:31	1.24
+++ /project/slime/cvsroot/slime/contrib/swank-kawa.scm	2011/12/01 22:34:29	1.25
@@ -920,7 +920,9 @@
     (as <meth-ref> (1st (! methods-by-name module name)))))
 
 (df mangled-name ((f <gnu.expr.ModuleMethod>))
-  (let ((name (gnu.expr.Compilation:mangleName (! get-name f))))
+  (let* ((name0 (! get-name f))
+         (name (cond ((nul? name0) (format "lambda~d" (@ selector f)))
+                     (#t (gnu.expr.Compilation:mangleName name0)))))
     (if (= (! maxArgs f) -1)
         (cat name "$V")
         name)))
@@ -1163,29 +1165,44 @@
                            (content-range  c 0 (len c)))))))
 
 (df inspect (obj vm)
-  (let* ((obj (as <obj-ref> (vm-mirror vm obj))))
-    (packing (pack)
-      (typecase obj
-        (<array-ref>
-         (let ((i 0))
-           (iter (! getValues obj)
-                 (fun ((v <value>))
-                   (pack (format "~d: " i))
-                   (set i (1+ i))
-                   (pack `(:value ,(vm-demirror vm v)))
-                   (pack "\n")))))
-        (<obj-ref>
-         (let* ((type (! referenceType obj))
-                (fields (! allFields type))
-                (values (! getValues obj fields)))
-           (iter fields 
-                 (fun ((f <field>))
-                   (let ((val (as <value> (! get values f))))
-                     (when (! is-static f)
-                       (pack "static "))
-                     (pack (! name f)) (pack ": ") 
-                     (pack `(:value ,(vm-demirror vm val)))
-                     (pack "\n"))))))))))
+  (let ((obj (as <obj-ref> (vm-mirror vm obj))))
+    (typecase obj 
+      (<array-ref> (inspect-array-ref vm obj))
+      (<obj-ref> (inspect-obj-ref vm obj)))))
+
+(df inspect-array-ref ((vm <vm>) (obj <array-ref>))
+  (packing (pack)
+    (let ((i 0))
+      (iter (! getValues obj)
+            (fun ((v <value>))
+              (pack (format "~d: " i))
+              (pack `(:value ,(vm-demirror vm v)))
+              (pack "\n")
+              (set i (1+ i)))))))
+
+(df inspect-obj-ref ((vm <vm>) (obj <obj-ref>))
+  (let* ((type (! referenceType obj))
+         (fields (! allFields type))
+         (values (! getValues obj fields))
+         (ifields '()) (sfields '()) (imeths '()) (smeths '())
+         (frob (lambda (lists) (apply append (reverse lists)))))
+    (iter fields 
+          (fun ((f <field>))
+            (let* ((val (as <value> (! get values f)))
+                   (l `(,(! name f) ": " (:value ,(vm-demirror vm val)) "\n")))
+              (if (! is-static f) 
+                  (pushf l sfields)
+                  (pushf l ifields)))))
+    (iter (! allMethods type)
+          (fun ((m <meth-ref>))
+            (let ((l `(,(! name m) ,(! signature m) "\n")))
+              (if (! is-static m)
+                  (pushf l smeths)
+                  (pushf l imeths)))))
+    `(,@(frob ifields) 
+      "--- static fields ---\n" ,@(frob sfields)
+      "--- methods ---\n" ,@(frob imeths)
+      "--- static methods ---\n" ,@(frob smeths))))
 
 (df inspector-content (content (state <inspector-state>))
   (map (fun (part)