ASDF, readtables and with-operation

I'm working with code that plays some tricks on the readtable.  
Occasionally, this causes compilation of other systems to fail  
because the altered readtable generally mucks things up. At the risk  
of violating "you aren't going to need it", here is a suggested  
patch. It includes stubs for start-operation and stop-operation and a  
macro with-operation that is used only in the operate function. With- 
operation calls start-operation, dynamically restores *readtable*,  
calls the rest of the operate body in an unwind-protect and then  
calls stop-operation. The patch is included as an attachment and inline.

thoughts very welcome.


Index: asdf.lisp
===================================================================
RCS file: /cvs/agraph/lisp/asdf/asdf.lisp,v
retrieving revision 1.2
diff -u -w -r1.2 asdf.lisp
--- asdf.lisp	8 Sep 2006 20:45:21 -0000	1.2
+++ asdf.lisp	16 Jan 2007 16:25:37 -0000
@@ -876,6 +876,24 @@
                    :directory '(:relative ".asdf"))
     (truename (user-homedir-pathname))))
+(defmethod start-operation ((op t) (system t))
+  nil)
+
+(defmethod stop-operation ((op t) (system t))
+  nil)
+
+(defmacro with-operation ((op system) &body body)
+  (let ((gop (gensym))
+	(gsystem (gensym)))
+    `(let ((,gop ,op) (,gsystem ,system)
+	   (*readtable* (copy-readtable nil)))
+       (unwind-protect
+	    (progn
+	      (start-operation ,gop ,gsystem)
+	      ,@body)
+	 ;; cleanup
+	 (stop-operation ,gop ,gsystem)))))
+
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; invoking operations
@@ -889,6 +907,7 @@
      (unless (version-satisfies system version)
        (error 'missing-component :requires system :version version))
      (let ((steps (traverse op system)))
+      (with-operation (op system)
        (with-compilation-unit ()
	(loop for (op . component) in steps do
	     (loop
@@ -910,7 +929,7 @@
		    (setf (gethash (type-of op)
				   (component-operation-times component))
			  (get-universal-time))
-		    (return)))))))))
+		      (return))))))))))
(defun oos (&rest args)
    "Alias of OPERATE function"

--
Gary Warren King, metabang.com
Cell: (413) 885 9127
Fax: (206) 338-4052
gwkkwg on Skype * garethsan on AIM

-------------------------------------------------------------------------
Take Surveys. Earn Cash. Influence the Future of IT
Join SourceForge.net's Techsay panel and you'll get the chance to share your
opinions on IT & business topics through brief surveys - and earn cash
http://www.techsay.com/default.php?page=join.php&p=sourceforge&CID=DEVDEV

_______________________________________________
cclan-list mailing list
[email protected]
https://lists.sourceforge.net/lists/listinfo/cclan-list

Index: asdf.lisp
===================================================================
RCS file: /cvs/agraph/lisp/asdf/asdf.lisp,v
retrieving revision 1.2
diff -u -w -r1.2 asdf.lisp
--- asdf.lisp	8 Sep 2006 20:45:21 -0000	1.2
+++ asdf.lisp	16 Jan 2007 16:25:16 -0000
@@ -876,6 +876,24 @@
                   :directory '(:relative ".asdf"))
    (truename (user-homedir-pathname))))
 
+(defmethod start-operation ((op t) (system t))
+  nil)
+
+(defmethod stop-operation ((op t) (system t))
+  nil)
+
+(defmacro with-operation ((op system) &body body)
+  (let ((gop (gensym))
+	(gsystem (gensym)))
+    `(let ((,gop ,op) (,gsystem ,system)
+	   (*readtable* (copy-readtable nil)))
+       (unwind-protect
+	    (progn
+	      (start-operation ,gop ,gsystem)
+	      ,@body)
+	 ;; cleanup
+	 (stop-operation ,gop ,gsystem)))))
+
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;;; invoking operations
 
@@ -889,6 +907,7 @@
     (unless (version-satisfies system version)
       (error 'missing-component :requires system :version version))
     (let ((steps (traverse op system)))
+      (with-operation (op system)
       (with-compilation-unit ()
 	(loop for (op . component) in steps do
 	     (loop
@@ -910,7 +929,7 @@
 		    (setf (gethash (type-of op)
 				   (component-operation-times component))
 			  (get-universal-time))
-		    (return)))))))))
+		      (return))))))))))
 
 (defun oos (&rest args)
   "Alias of OPERATE function"