0.7.9.9:

[sbcl.git] / src / code / eval.lisp

diff --git a/src/code/eval.lisp b/src/code/eval.lisp
index abd46dd..f8ef5b0 100644 (file)
--- 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,7 +75,7 @@
        (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)))
@@ -102,7 +86,7 @@
                                      (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 +138,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))))
 \f