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

[Frode Vatvedt Fjeld]

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

Modified Files:
	basic-macros.lisp 
Log Message:
Fixed defpackage macro a bit, for CLisp compatibility.

Date: Thu Dec  9 15:20:14 2004
Author: ffjeld

Index: movitz/losp/muerte/basic-macros.lisp
diff -u movitz/losp/muerte/basic-macros.lisp:1.52 movitz/losp/muerte/basic-macros.lisp:1.53
--- movitz/losp/muerte/basic-macros.lisp:1.52	Thu Nov 25 19:05:32 2004
+++ movitz/losp/muerte/basic-macros.lisp	Thu Dec  9 15:20:14 2004
@@ -9,7 +9,7 @@
 ;;;; Created at:    Wed Nov  8 18:44:57 2000
 ;;;; Distribution:  See the accompanying file COPYING.
 ;;;;                
-;;;; $Id: basic-macros.lisp,v 1.52 2004/11/25 18:05:32 ffjeld Exp $
+;;;; $Id: basic-macros.lisp,v 1.53 2004/12/09 14:20:14 ffjeld Exp $
 ;;;;                
 ;;;;------------------------------------------------------------------
 
@@ -70,14 +70,16 @@
 			    ,(cons 'cl:progn body)))
 
 (defmacro defpackage (package-name &rest options)
-  (let ((uses (if (not (assoc :use options))
-		  (list 'muerte.cl)
-		(cdr (assoc :use options)))))
+  (let ((uses (union (if (not (assoc :use options))
+			 (list 'muerte.cl)
+			 (cdr (assoc :use options)))
+		     (when (find-package package-name)
+		       (mapcar #'package-name (package-use-list package-name))))))
     (setf uses (mapcar (lambda (use)
 			 (if (member use (cons :common-lisp (package-nicknames :common-lisp))
 				     :test #'string=)
 			     :muerte.cl
-			   use))
+			     use))
 		       uses))
     (when (or (member :muerte.cl uses :test #'string=)
 	      (member :muerte.common-lisp uses :test #'string=))
@@ -85,7 +87,7 @@
     (let ((movitz-options (cons (cons :use uses)
 				(remove :use options :key #'car))))
       `(eval-when (:compile-toplevel)
-	 (defpackage ,package-name , at movitz-options)))))
+	(defpackage ,package-name , at movitz-options)))))
 
 (defmacro cond (&rest clauses)
   (if (null clauses)
@@ -873,16 +875,19 @@
   (if (not (movitz:movitz-constantp symbol env))
       form
     (let* ((type (movitz:movitz-eval symbol env))
-	   (cl-type (movitz::translate-program type :muerte.cl :cl)))
+	   (movitz-type (movitz-program type))
+	   (cl-type (host-program type)))
       (cond
        ((eq t cl-type)
 	`(load-global-constant the-class-t))
-       ((member type (movitz::image-classes-map movitz:*image*))
+       ((member movitz-type (movitz::image-classes-map movitz:*image*))
 	`(with-inline-assembly (:returns :register)
 	   (:globally (:movl (:edi (:edi-offset classes)) (:result-register)))
-	   (:movl ((:result-register) ,(movitz::class-object-offset type))
+	   (:movl ((:result-register) ,(movitz::class-object-offset movitz-type))
 		  (:result-register))))
-       (t (warn "unknown find-class: ~A" cl-type)
+       (t (warn "unknown find-class: ~S [~S] [~S]" cl-type
+		(and (symbolp cl-type) (symbol-package cl-type))
+		(and (symbolp movitz-type) (symbol-package movitz-type)))
 	  form))
       #+ignore
       (case cl-type