[movitz-cvs] CVS update: movitz/losp/muerte/typep.lisp

[Frode Vatvedt Fjeld]

Update of /project/movitz/cvsroot/movitz/losp/muerte
In directory common-lisp.net:/tmp/cvs-serv13377

Modified Files:
	typep.lisp 
Log Message:
My previous fix in the deftype expander was flawed: We need to check
the package of the second element of the form (the type-name), not the
first (the operator, i.e. deftype).

Also, on emarsden's suggestion, I added some with-standard-io-syntax
wrappers around some symbol-name generators, just for consistency.

Date: Wed Jul 28 07:50:26 2004
Author: ffjeld

Index: movitz/losp/muerte/typep.lisp
diff -u movitz/losp/muerte/typep.lisp:1.34 movitz/losp/muerte/typep.lisp:1.35
--- movitz/losp/muerte/typep.lisp:1.34	Wed Jul 28 05:30:34 2004
+++ movitz/losp/muerte/typep.lisp	Wed Jul 28 07:50:26 2004
@@ -9,7 +9,7 @@
 ;;;; Created at:    Fri Dec  8 11:07:53 2000
 ;;;; Distribution:  See the accompanying file COPYING.
 ;;;;                
-;;;; $Id: typep.lisp,v 1.34 2004/07/28 12:30:34 ffjeld Exp $
+;;;; $Id: typep.lisp,v 1.35 2004/07/28 14:50:26 ffjeld Exp $
 ;;;;                
 ;;;;------------------------------------------------------------------
 
@@ -406,7 +406,8 @@
 	    form)))))
 
 (defmacro define-typep (tname lambda &body body)
-  (let ((fname (format nil "~A-~A" 'typep tname)))
+  (let ((fname (with-standard-io-syntax
+		 (format nil "~A-~A" 'typep tname))))
     `(progn
        (eval-when (:compile-toplevel)
 	 (setf (gethash (intern ,(symbol-name tname))
@@ -426,10 +427,11 @@
 	   (defun ,fname ,lambda , at body)))))
 
 (defmacro deftype (&whole form name lambda &body body)
-  (let ((fname (intern (format nil "~A-~A" 'deftype name))))
+  (let ((fname (intern (with-standard-io-syntax
+			 (format nil "~A-~A" 'deftype name)))))
     `(progn
        (eval-when (:compile-toplevel)
-	 (unless (eq (symbol-package (car ',form)) (find-package :common-lisp))
+	 (unless (eq (symbol-package (cadr ',form)) (find-package :common-lisp))
 	   ,form)
 	 (setf (gethash (translate-program ',name :cl :muerte.cl)
 			*compiler-derived-typespecs*)