From b298a0f12990865eef974ec23a67a17849374f53 Mon Sep 17 00:00:00 2001 From: pw <pw> Date: Thu, 1 Mar 2001 21:45:36 +0000 Subject: [PATCH] This set of changes fixes EVAL-WHEN to work according to the ANSI spec. --- code/eval.lisp | 17 +++--------- compiler/eval.lisp | 15 +++-------- compiler/ir1tran.lisp | 60 ++++++++++++++++--------------------------- compiler/main.lisp | 5 ++-- 4 files changed, 31 insertions(+), 66 deletions(-) diff --git a/code/eval.lisp b/code/eval.lisp index 553daf452..8a0da779a 100644 --- a/code/eval.lisp +++ b/code/eval.lisp @@ -5,7 +5,7 @@ ;;; Carnegie Mellon University, and has been placed in the public domain. ;;; (ext:file-comment - "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/eval.lisp,v 1.31 2000/08/10 10:55:23 dtc Exp $") + "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/eval.lisp,v 1.32 2001/03/01 21:45:33 pw Exp $") ;;; ;;; ********************************************************************** ;;; @@ -127,12 +127,6 @@ ;;;; EVAL and friends. (in-package "LISP") -;;; -;;; This flag is used by EVAL-WHEN to keep track of when code has already been -;;; evaluated so that it can avoid multiple evaluation of nested EVAL-WHEN -;;; (COMPILE)s. -(defvar *already-evaled-this* nil) - ;;; ;;; This needs to be initialized in the cold load, since the top-level catcher ;;; will always restore the initial value. @@ -151,9 +145,7 @@ ;;; EVAL -- Public ;;; -;;; Pick off a few easy cases, and call INTERNAL-EVAL for the rest. If -;;; *ALREADY-EVALED-THIS* is true, then we bind it to NIL before doing a call -;;; so that the effect is confined to the lexical scope of the EVAL-WHEN. +;;; Pick off a few easy cases, and call INTERNAL-EVAL for the rest. ;;; (defun eval (original-exp) "Evaluates its single arg in a null lexical environment, returns the @@ -249,10 +241,7 @@ (collect ((args)) (dolist (arg (rest exp)) (args (eval arg))) - (if *already-evaled-this* - (let ((*already-evaled-this* nil)) - (apply (symbol-function name) (args))) - (apply (symbol-function name) (args)))) + (apply (symbol-function name) (args))) (eval:internal-eval original-exp)))))) (t exp)))) diff --git a/compiler/eval.lisp b/compiler/eval.lisp index d77d98dd2..cd1afc2e0 100644 --- a/compiler/eval.lisp +++ b/compiler/eval.lisp @@ -5,7 +5,7 @@ ;;; Carnegie Mellon University, and has been placed in the public domain. ;;; (ext:file-comment - "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/eval.lisp,v 1.33 2000/09/26 16:38:57 dtc Exp $") + "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/eval.lisp,v 1.34 2001/03/01 21:45:34 pw Exp $") ;;; ;;; ********************************************************************** ;;; @@ -625,23 +625,14 @@ (setf *internal-apply-node-trace* on)) -;;;; INTERNAL-EVAL: - -(proclaim '(special lisp::*already-evaled-this*)) - ;;; INTERNAL-EVAL -- Interface ;;; ;;; Evaluate an arbitary form. We convert the form, then call internal -;;; apply on it. If *ALREADY-EVALED-THIS* is true, then we bind it to NIL -;;; around the apply to limit the inhibition to the lexical scope of the -;;; EVAL-WHEN. +;;; apply on it. ;;; (defun internal-eval (form &optional quietly) (let ((res (c:compile-for-eval form quietly))) - (if lisp::*already-evaled-this* - (let ((lisp::*already-evaled-this* nil)) - (internal-apply res nil '#())) - (internal-apply res nil '#())))) + (internal-apply res nil '#()))) ;;; VALUE -- Internal. diff --git a/compiler/ir1tran.lisp b/compiler/ir1tran.lisp index ec1ae259f..46f3bcb95 100644 --- a/compiler/ir1tran.lisp +++ b/compiler/ir1tran.lisp @@ -5,7 +5,7 @@ ;;; Carnegie Mellon University, and has been placed in the public domain. ;;; (ext:file-comment - "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/ir1tran.lisp,v 1.120 2000/10/06 15:10:15 dtc Exp $") + "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/ir1tran.lisp,v 1.121 2001/03/01 21:45:34 pw Exp $") ;;; ;;; ********************************************************************** ;;; @@ -2212,12 +2212,6 @@ (ir1-convert-progn-body start cont body)))) -;;; This flag is used by Eval-When to keep track of when code has already been -;;; evaluated so that it can avoid multiple evaluation of nested Eval-When -;;; (Compile)s. -;;; -(proclaim '(special lisp::*already-evaled-this*)) - ;;; DO-EVAL-WHEN-STUFF -- Interface ;;; ;;; Do stuff to do an EVAL-WHEN. This is split off from the IR1 convert @@ -2225,46 +2219,36 @@ ;;; processing code. We play with the dynamic environment and eval stuff, then ;;; call Fun with a list of forms to be processed at load time. ;;; -;;; Note: the EVAL situation is always ignored: this is conceptually a -;;; compile-only implementation. -;;; -;;; 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) +(defun do-eval-when-stuff (situations body fun toplevel-p) (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* ((do-eval (and (intersection '(compile :compile-toplevel) situations) - (not lisp::*already-evaled-this*))) - (lisp::*already-evaled-this* t)) - (when do-eval - (eval `(progn ,@body))) - (if (or (intersection '(:load-toplevel load) situations) - (and *converting-for-interpreter* - (intersection '(:execute eval) situations))) - (funcall fun body) - (funcall fun '(nil))))) - + (if toplevel-p + ;; Can only get here from compile-file. + (progn + (when (intersection '(compile :compile-toplevel) situations) + (eval `(progn ,@body))) + ;; Maybe generate code for load-time or run-time eval + (if (or (intersection '(:load-toplevel load) situations) + (and *converting-for-interpreter* + (intersection '(:execute eval) situations))) + (funcall fun body) + (funcall fun '(nil)))) + ;; Not toplevel, only :execute counts. + (if (intersection '(eval :execute) situations) + (funcall fun body) + (funcall fun '(nil))))) (def-ir1-translator eval-when ((situations &rest body) start cont) "EVAL-WHEN (Situation*) Form* - Evaluate the Forms in the specified Situations, any of COMPILE, LOAD, EVAL. - This is conceptually a compile-only implementation, so EVAL is a no-op." - (do-eval-when-stuff situations body - #'(lambda (forms) - (ir1-convert-progn-body start cont forms)))) + Evaluate the Forms in the specified Situations, any of :COMPILE-TOPLEVEL, + :LOAD-TOPLEVEL, :EXECUTE." + (do-eval-when-stuff + situations body #'(lambda (forms) (ir1-convert-progn-body start cont forms)) + nil)) ;;; DO-MACROLET-STUFF -- Interface diff --git a/compiler/main.lisp b/compiler/main.lisp index 5d67d5666..9360611d6 100644 --- a/compiler/main.lisp +++ b/compiler/main.lisp @@ -5,7 +5,7 @@ ;;; Carnegie Mellon University, and has been placed in the public domain. ;;; (ext:file-comment - "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/main.lisp,v 1.119 2000/08/09 13:23:19 dtc Exp $") + "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/main.lisp,v 1.120 2001/03/01 21:45:36 pw Exp $") ;;; ;;; ********************************************************************** ;;; @@ -1104,7 +1104,8 @@ (do-eval-when-stuff (cadr form) (cddr form) #'(lambda (forms) - (process-progn forms path)))) + (process-progn forms path)) + t)) ((macrolet) (unless (>= (length form) 2) (compiler-error "MACROLET form is too short: ~S." form)) -- GitLab