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@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))))))))))