-;;; We have to interact with the interpreter to ensure that the forms
-;;; get EVAL'ed exactly once. We bind *ALREADY-EVALED-THIS* to true to
-;;; inhibit evaluation of any enclosed EVAL-WHENs, either by IR1
-;;; conversion done by EVAL, or by conversion of the body for
-;;; load-time processing. If *ALREADY-EVALED-THIS* is true then we *do
-;;; not* EVAL since some enclosing EVAL-WHEN already did.
-;;;
-;;; We know we are EVAL'ing for LOAD since we wouldn't get called
-;;; otherwise. If LOAD is a situation we call FUN on body. If we
-;;; aren't evaluating for LOAD, then we call FUN on NIL for the result
-;;; of the EVAL-WHEN.
-(defun do-eval-when-stuff (situations body fun)
-
- (when (or (not (listp situations))
- (set-difference situations
- '(compile load eval
- :compile-toplevel :load-toplevel :execute)))
- (compiler-error "bad EVAL-WHEN situation list: ~S" situations))
-
- (let ((deprecated-names (intersection situations '(compile load eval))))
- (when deprecated-names
- (style-warn "using deprecated EVAL-WHEN situation names ~S"
- deprecated-names)))
-
- (let* ((do-eval (and (intersection '(compile :compile-toplevel) situations)
- (not sb!eval::*already-evaled-this*)))
- (sb!eval::*already-evaled-this* t))
- (when do-eval
-
- ;; This is the natural way to do it.
- #-(and sb-xc-host (or sbcl cmu))
- (eval `(progn ,@body))
-
- ;; This is a disgusting hack to work around bug IR1-3 when using
- ;; SBCL (or CMU CL, for that matter) as a cross-compilation
- ;; host. When we go from the cross-compiler (where we bound
- ;; SB!EVAL::*ALREADY-EVALED-THIS*) to the host compiler (which
- ;; has a separate SB-EVAL::*ALREADY-EVALED-THIS* variable), EVAL
- ;; would go and execute nested EVAL-WHENs even when they're not
- ;; toplevel forms. Using EVAL-WHEN instead of bare EVAL causes
- ;; the cross-compilation host to bind its own
- ;; *ALREADY-EVALED-THIS* variable, so that the problem is
- ;; suppressed.
- ;;
- ;; FIXME: Once bug IR1-3 is fixed, this hack can go away. (Or if
- ;; CMU CL doesn't fix the bug, then this hack can be made
- ;; conditional on #+CMU.)
- #+(and sb-xc-host (or sbcl cmu))
- (let (#+sbcl (sb-eval::*already-evaled-this* t)
- #+cmu (common-lisp::*already-evaled-this* t))
- (eval `(eval-when (:compile-toplevel :load-toplevel :execute)
- ,@body))))
-
- (if (or (intersection '(:load-toplevel load) situations)
- (and *converting-for-interpreter*
- (intersection '(:execute eval) situations)))
- (funcall fun body)
- (funcall fun '(nil)))))
-
-(def-ir1-translator eval-when ((situations &rest body) start cont)
+;;; ANSI "3.2.3.1 Processing of Top Level Forms" says that processing
+;;; of non-top-level EVAL-WHENs is very simple:
+;;; EVAL-WHEN forms cause compile-time evaluation only at top level.
+;;; Both :COMPILE-TOPLEVEL and :LOAD-TOPLEVEL situation specifications
+;;; are ignored for non-top-level forms. For non-top-level forms, an
+;;; eval-when specifying the :EXECUTE situation is treated as an
+;;; implicit PROGN including the forms in the body of the EVAL-WHEN
+;;; form; otherwise, the forms in the body are ignored.
+(def-ir1-translator eval-when ((situations &rest forms) start cont)