[movitz-cvs] CVS update: movitz/compiler-types.lisp

[Frode Vatvedt Fjeld]

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

Modified Files:
	compiler-types.lisp 
Log Message:
Fixed bug in lookup of deftypes at compile-time.

Date: Sun Aug 21 19:51:34 2005
Author: ffjeld

Index: movitz/compiler-types.lisp
diff -u movitz/compiler-types.lisp:1.23 movitz/compiler-types.lisp:1.24
--- movitz/compiler-types.lisp:1.23	Sat Aug 20 22:30:14 2005
+++ movitz/compiler-types.lisp	Sun Aug 21 19:51:34 2005
@@ -10,7 +10,7 @@
 ;;;; Author:        Frode Vatvedt Fjeld <frodef at acm.org>
 ;;;; Created at:    Wed Sep 10 00:40:07 2003
 ;;;;                
-;;;; $Id: compiler-types.lisp,v 1.23 2005/08/20 20:30:14 ffjeld Exp $
+;;;; $Id: compiler-types.lisp,v 1.24 2005/08/21 17:51:34 ffjeld Exp $
 ;;;;                
 ;;;;------------------------------------------------------------------
 
@@ -499,9 +499,8 @@
 	 (type-values 'cons :members '(nil)))
 	(sequence
 	 (type-values '(vector cons) :members '(nil)))
-	(t (let ((deriver (and (boundp 'muerte::*compiler-derived-typespecs*)
-			       (gethash type-specifier
-					(symbol-value 'muerte::*compiler-derived-typespecs*)))))
+	(t (let ((deriver (and (boundp '*image*)
+			       (gethash type-specifier muerte::*compiler-derived-typespecs*))))
 	     (if deriver
 		 (type-specifier-encode (funcall deriver))
 	       (type-values () :include (list type-specifier)))))))
@@ -563,10 +562,10 @@
 	     (type-values () :include (list type-specifier)))))
 	((array vector binding-type)
 	 (type-values () :include (list type-specifier)))
-	(t (let ((deriver (and (boundp 'muerte::*compiler-derived-typespecs*)
-			       (gethash (intern (symbol-name (car type-specifier))
-						:muerte.cl)
-					(symbol-value 'muerte::*compiler-derived-typespecs*)))))
+	(t (let ((deriver (and (boundp '*image*)
+			       (gethash (translate-program (car type-specifier)
+							   :cl :muerte.cl)
+					muerte::*compiler-derived-typespecs*))))
 	     (assert deriver (type-specifier)
 	       "Unknown type ~S." type-specifier)
 	     (type-specifier-encode (apply deriver (cdr type-specifier))))))))))