X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcode%2Feval.lisp;h=0ed58c287743255851708545b50649929b0a88ca;hb=2db3b6b4cb740d5b6512459c223859f747807b09;hp=abd46dd0f6a95cf8d511b080a0f2049fd86cbc94;hpb=c831b2828176641e93a45d3fd643e9f58cd44a3f;p=sbcl.git

diff --git a/src/code/eval.lisp b/src/code/eval.lisp
index abd46dd..0ed58c2 100644
--- a/src/code/eval.lisp
+++ b/src/code/eval.lisp
@@ -17,22 +17,6 @@
   (funcall (sb!c:compile-in-lexenv
             (gensym "EVAL-TMPFUN-")
             `(lambda ()
-
-               ;; The user can reasonably expect that the
-               ;; interpreter will be safe.
-               (declare (optimize (safety 3)))
-
-               ;; It's also good if the interpreter doesn't
-               ;; spend too long thinking about each input
-               ;; form, since if the user'd wanted the
-               ;; tradeoff to favor quality of compiled code
-               ;; over compilation speed, he'd've explicitly
-               ;; asked for compilation.
-               (declare (optimize (compilation-speed 2)))
-
-               ;; Other properties are relatively unimportant.
-               (declare (optimize (speed 1) (debug 1) (space 1)))
-
                ,expr)
             lexenv)))
 
@@ -91,18 +75,16 @@
        (let ((name (first exp))
 	     (n-args (1- (length exp))))
 	 (case name
-	   (function
+	   ((function)
 	    (unless (= n-args 1)
 	      (error "wrong number of args to FUNCTION:~% ~S" exp))
 	    (let ((name (second exp)))
-	      (if (and (or (atom name)
-                           (and (consp name)
-                                (eq (car name) 'setf)))
+	      (if (and (legal-fun-name-p name)
                        (not (consp (let ((sb!c:*lexenv* lexenv))
                                      (sb!c:lexenv-find name funs)))))
 		  (fdefinition name)
 		  (%eval original-exp lexenv))))
-	   (quote
+	   ((quote)
 	    (unless (= n-args 1)
 	      (error "wrong number of args to QUOTE:~% ~S" exp))
 	    (second exp))
@@ -154,14 +136,73 @@
 		(declare (ignore ct lt))
 		(when e
 		  (eval-progn-body body lexenv)))))
+	   ((locally)
+	    (multiple-value-bind (body decls) (parse-body (rest exp) nil)
+	      (let ((lexenv
+		     ;; KLUDGE: Uh, yeah.  I'm not anticipating
+		     ;; winning any prizes for this code, which was
+		     ;; written on a "let's get it to work" basis.
+		     ;; These seem to be the variables that need
+		     ;; bindings for PROCESS-DECLS to work
+		     ;; (*FREE-FUNS* and *FREE-VARS* so that
+		     ;; references to free functions and variables in
+		     ;; the declarations can be noted;
+		     ;; *UNDEFINED-WARNINGS* so that warnings about
+		     ;; undefined things can be accumulated [and then
+		     ;; thrown away, as it happens]). -- CSR, 2002-10-24
+		     (let ((sb!c:*lexenv* lexenv)
+			   (sb!c::*free-funs* (make-hash-table :test 'equal))
+			   (sb!c::*free-vars* (make-hash-table :test 'eq))
+			   (sb!c::*undefined-warnings* nil))
+		       (sb!c::process-decls decls
+					    nil nil
+					    (sb!c::make-continuation)
+					    lexenv))))
+		(eval-progn-body body lexenv))))
+	   ((macrolet)
+	    (destructuring-bind (definitions &rest body)
+		(rest exp)
+	      ;; FIXME: shared code with FUNCALL-IN-FOOMACROLET-LEXENV
+	      (declare (type list definitions))
+	      (unless (= (length definitions)
+			 (length (remove-duplicates definitions :key #'first)))
+		(style-warn "duplicate definitions in ~S" definitions))
+	      (let ((lexenv
+		     (sb!c::make-lexenv
+		      :default lexenv
+		      :funs (mapcar
+			     (sb!c::macrolet-definitionize-fun
+			      :eval
+			      ;; I'm not sure that this is the correct
+			      ;; LEXENV to be compiling local macros
+			      ;; in...
+			      lexenv)
+			     definitions))))
+		(eval-in-lexenv `(locally ,@body) lexenv))))
+	   ((symbol-macrolet)
+	    (destructuring-bind (definitions &rest body)
+		(rest exp)
+	      ;; FIXME: shared code with FUNCALL-IN-FOOMACROLET-LEXENV
+	      (declare (type list definitions))
+	      (unless (= (length definitions)
+			 (length (remove-duplicates definitions :key #'first)))
+		(style-warn "duplicate definitions in ~S" definitions))
+	      (let ((lexenv
+		     (sb!c::make-lexenv
+		      :default lexenv
+		      :vars (mapcar
+			     (sb!c::symbol-macrolet-definitionize-fun
+			      :eval)
+			     definitions))))
+		(eval-in-lexenv `(locally ,@body) lexenv))))
 	   (t
 	    (if (and (symbolp name)
 		     (eq (info :function :kind name) :function))
 		(collect ((args))
                          (dolist (arg (rest exp))
-                           (args (eval arg)))
+                           (args (eval-in-lexenv arg lexenv)))
                          (apply (symbol-function name) (args)))
-		(%eval original-exp lexenv))))))
+		(%eval exp lexenv))))))
       (t
        exp))))