1.0.18.2: more conservative interval artihmetic

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

diff --git a/src/code/eval.lisp b/src/code/eval.lisp
index 406dc09..53de408 100644 (file)
--- a/src/code/eval.lisp
+++ b/src/code/eval.lisp
@@ -11,6 +11,15 @@
 
 (in-package "SB!IMPL")
 
+(defparameter *eval-calls* 0)
+
+(defun !eval-cold-init ()
+  (setf *eval-calls* 0
+        *evaluator-mode* :compile)
+  #!+sb-eval
+  (setf sb!eval::*eval-level* -1
+        sb!eval::*eval-verbose* nil))
+
 ;;; general case of EVAL (except in that it can't handle toplevel
 ;;; EVAL-WHEN magic properly): Delegate to #'COMPILE.
 (defun %simple-eval (expr lexenv)
@@ -20,9 +29,10 @@
   ;; to be careful about not muffling warnings arising from inner
   ;; evaluations/compilations, though [e.g. the ignored variable in
   ;; (DEFUN FOO (X) 1)].  -- CSR, 2003-05-13
-  (let ((fun (sb!c:compile-in-lexenv nil
-                                     `(lambda () ,expr)
-                                     lexenv)))
+  (let* (;; why PROGN?  So that attempts to eval free declarations
+         ;; signal errors rather than return NIL.  -- CSR, 2007-05-01
+         (lambda `(lambda () (progn ,expr)))
+         (fun (sb!c:compile-in-lexenv nil lambda lexenv)))
     (funcall fun)))
 
 ;;; Handle PROGN and implicit PROGN.
@@ -92,6 +102,7 @@
 (defun simple-eval-in-lexenv (original-exp lexenv)
   (declare (optimize (safety 1)))
   ;; (aver (lexenv-simple-p lexenv))
+  (incf *eval-calls*)
   (handler-bind
       ((sb!c:compiler-error
         (lambda (c)
@@ -114,9 +125,7 @@
         (typecase exp
           (symbol
            (ecase (info :variable :kind exp)
-             (:constant
-              (values (info :variable :constant-value exp)))
-             ((:special :global)
+             ((:special :global :constant)
               (symbol-value exp))
              ;; FIXME: This special case here is a symptom of non-ANSI
              ;; weirdness in SBCL's ALIEN implementation, which could
@@ -142,7 +151,7 @@
                            (not (consp (let ((sb!c:*lexenv* lexenv))
                                          (sb!c:lexenv-find name funs)))))
                       (%coerce-name-to-fun name)
-                    (%simple-eval original-exp lexenv))))
+                      (%simple-eval original-exp lexenv))))
                ((quote)
                 (unless (= n-args 1)
                   (error "wrong number of args to QUOTE:~% ~S" exp))
@@ -197,9 +206,9 @@
                     ;; PROGN; otherwise, the EVAL-WHEN form returns NIL.
                     (declare (ignore ct lt))
                     (when e
-                    (simple-eval-progn-body body lexenv)))))
+                      (simple-eval-progn-body body lexenv)))))
                ((locally)
-              (simple-eval-locally exp lexenv))
+                (simple-eval-locally exp lexenv))
                ((macrolet)
                 (destructuring-bind (definitions &rest body)
                     (rest exp)
@@ -211,7 +220,7 @@
                               (declare (ignore funs))
                               sb!c:*lexenv*)
                             :eval))))
-                  (simple-eval-locally `(locally ,@body) lexenv))))
+                    (simple-eval-locally `(locally ,@body) lexenv))))
                ((symbol-macrolet)
                 (destructuring-bind (definitions &rest body) (rest exp)
                   (multiple-value-bind (lexenv vars)