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 ,@movitz-options)))))
+ (defpackage ,package-name ,@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