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

[Helmut Eller]

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

Modified Files:
	swank-backend.lisp 
Log Message:
(with-struct): New macro.
Date: Tue May  4 14:57:52 2004
Author: heller

Index: slime/swank-backend.lisp
diff -u slime/swank-backend.lisp:1.45 slime/swank-backend.lisp:1.46
--- slime/swank-backend.lisp:1.45	Sat May  1 22:16:04 2004
+++ slime/swank-backend.lisp	Tue May  4 14:57:52 2004
@@ -79,6 +79,24 @@
         (sort (copy-list *unimplemented-interfaces*) #'string<)))
 
 
+;;;; Utilities
+
+(defmacro with-struct ((conc-name &rest names) obj &body body)
+  "Like with-slots but works only for structs."
+  (flet ((reader (slot) (intern (concatenate 'string
+					     (symbol-name conc-name)
+					     (symbol-name slot))
+				(symbol-package conc-name))))
+    (let ((tmp (gensym "OO-")))
+    ` (let ((,tmp ,obj))
+        (symbol-macrolet
+            ,(loop for name in names collect 
+                   (typecase name
+                     (symbol `(,name (,(reader name) ,tmp)))
+                     (cons `(,(first name) (,(reader (second name)) ,tmp)))
+                     (t (error "Malformed syntax in WITH-STRUCT: ~A" name))))
+          , at body)))))
+  
 ;;;; TCP server
 
 (definterface create-socket (host port)