[movitz-cvs] CVS update: movitz/special-operators-cl.lisp

[Frode Vatvedt Fjeld]

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

Modified Files:
	special-operators-cl.lisp 
Log Message:
When doing eval-when, execute :compile-toplevel (on the host side)
after movitz-side :execute and/or :load-toplevel. Why not?

Date: Wed Jul 21 05:19:15 2004
Author: ffjeld

Index: movitz/special-operators-cl.lisp
diff -u movitz/special-operators-cl.lisp:1.19 movitz/special-operators-cl.lisp:1.20
--- movitz/special-operators-cl.lisp:1.19	Fri Jun 11 14:34:02 2004
+++ movitz/special-operators-cl.lisp	Wed Jul 21 05:19:15 2004
@@ -9,7 +9,7 @@
 ;;;; Created at:    Fri Nov 24 16:31:11 2000
 ;;;; Distribution:  See the accompanying file COPYING.
 ;;;;                
-;;;; $Id: special-operators-cl.lisp,v 1.19 2004/06/11 21:34:02 ffjeld Exp $
+;;;; $Id: special-operators-cl.lisp,v 1.20 2004/07/21 12:19:15 ffjeld Exp $
 ;;;;                
 ;;;;------------------------------------------------------------------
 
@@ -864,26 +864,24 @@
 (define-special-operator eval-when (&all forward &form form &top-level-p top-level-p)
   (destructuring-bind (situations &body body)
       (cdr form)
-    (when (member :compile-toplevel situations)
-;;;      (warn "EVAL-WHEN: ~S" `(progn ,@(movitz::translate-program body :muerte.cl :cl
-;;;								 :when :eval
-;;;								 :remove-double-quotes-p t)))
-      (with-compilation-unit ()
-	(dolist (toplevel-form (translate-program body :muerte.cl :cl
-						  :when :eval
-						  :remove-double-quotes-p t))
-	  (with-host-environment ()
-	    (if *compiler-compile-eval-whens*
-		(funcall (compile () `(lambda () ,toplevel-form)))
-	      (eval toplevel-form))))))
-    (if (or (member :execute situations)
-	    (and (member :load-toplevel situations)
-		 top-level-p))
-	(compiler-call #'compile-implicit-progn
-	  :defaults forward
-	  :top-level-p top-level-p
-	  :form body)
-      (compiler-values ()))))
+    (multiple-value-prog1
+	(if (or (member :execute situations)
+		(and (member :load-toplevel situations)
+		     top-level-p))
+	    (compiler-call #'compile-implicit-progn
+	      :defaults forward
+	      :top-level-p top-level-p
+	      :form body)
+	  (compiler-values ()))
+      (when (member :compile-toplevel situations)
+	(with-compilation-unit ()
+	  (dolist (toplevel-form (translate-program body :muerte.cl :cl
+						    :when :eval
+						    :remove-double-quotes-p t))
+	    (with-host-environment ()
+	      (if *compiler-compile-eval-whens*
+		  (funcall (compile () `(lambda () ,toplevel-form)))
+		(eval toplevel-form)))))))))
 
 (define-special-operator function (&funobj funobj &form form &result-mode result-mode &env env)
   (destructuring-bind (name)