0.pre8.11:

	Fixed evaluation order in optional entries (reported by
	Gilbert Baumann in #lisp 2003-03-26).

diff --git a/NEWS b/NEWS
index faa9abc..c7ff1eb 100644 (file)
--- a/NEWS
+++ b/NEWS
@@ -1629,6 +1629,8 @@ changes in sbcl-0.8.0 relative to sbcl-0.7.14
   * fixed a bug in computing method discriminating functions: it is
     now possible to define methods specialized on classes which have
     forward-referenced superclasses.  (thanks to Gerd Moellmann)
+  * fixed evaluation order in optional entries. (reported by Gilbert
+    Baumann)
   * fixed some bugs revealed by Paul Dietz' test suite:
     ** COPY-ALIST now signals an error if its argument is a dotted
        list;

diff --git a/src/compiler/ir1-translators.lisp b/src/compiler/ir1-translators.lisp
index 7177de5..ab89de1 100644 (file)
--- a/src/compiler/ir1-translators.lisp
+++ b/src/compiler/ir1-translators.lisp
@@ -530,15 +530,17 @@
   During evaluation of the Forms, bind the Vars to the result of evaluating the
   Value forms. The variables are bound in parallel after all of the Values are
   evaluated."
-  (multiple-value-bind (forms decls) (parse-body body nil)
-    (multiple-value-bind (vars values) (extract-let-vars bindings 'let)
-      (let ((fun-cont (make-continuation)))
-        (let* ((*lexenv* (process-decls decls vars nil cont))
-               (fun (ir1-convert-lambda-body
-                     forms vars
-                     :debug-name (debug-namify "LET ~S" bindings))))
-          (reference-leaf start fun-cont fun))
-        (ir1-convert-combination-args fun-cont cont values)))))
+  (if (null bindings)
+      (ir1-translate-locally  body start cont)
+      (multiple-value-bind (forms decls) (parse-body body nil)
+        (multiple-value-bind (vars values) (extract-let-vars bindings 'let)
+          (let ((fun-cont (make-continuation)))
+            (let* ((*lexenv* (process-decls decls vars nil cont))
+                   (fun (ir1-convert-lambda-body
+                         forms vars
+                         :debug-name (debug-namify "LET ~S" bindings))))
+              (reference-leaf start fun-cont fun))
+            (ir1-convert-combination-args fun-cont cont values))))))
 
 (def-ir1-translator let* ((bindings &body body)
                          start cont)

diff --git a/src/compiler/ir1tran.lisp b/src/compiler/ir1tran.lisp
index 3a3376a..c5f7b41 100644 (file)
--- a/src/compiler/ir1tran.lisp
+++ b/src/compiler/ir1tran.lisp
@@ -1535,12 +1535,21 @@
                              :where-from (leaf-where-from var)
                              :specvar (lambda-var-specvar var)))
                           fvars))
-        (fun (ir1-convert-lambda-body `((%funcall ,fun
-                                                  ,@(reverse vals)
-                                                  ,@defaults))
-                                      arg-vars
-                                      :debug-name "&OPTIONAL processor"
-                                       :note-lexical-bindings nil)))
+        (fun (collect ((default-bindings)
+                        (default-vals))
+                (dolist (default defaults)
+                  (if (constantp default)
+                      (default-vals default)
+                      (let ((var (gensym)))
+                        (default-bindings `(,var ,default))
+                        (default-vals var))))
+                (ir1-convert-lambda-body `((let (,@(default-bindings))
+                                             (%funcall ,fun
+                                                       ,@(reverse vals)
+                                                       ,@(default-vals))))
+                                         arg-vars
+                                         :debug-name "&OPTIONAL processor"
+                                         :note-lexical-bindings nil))))
     (mapc (lambda (var arg-var)
            (when (cdr (leaf-refs arg-var))
              (setf (leaf-ever-used var) t)))

diff --git a/tests/compiler.pure.lisp b/tests/compiler.pure.lisp
index b58bbea..8154102 100644 (file)
--- a/tests/compiler.pure.lisp
+++ b/tests/compiler.pure.lisp
@@ -332,3 +332,8 @@
        ((lambda (&optional *x* &rest y) (declare (special *x*)) (values *x* y)) nil))
    for real-warns-p = (nth-value 1 (compile nil fun))
    do (assert (eq warns-p real-warns-p)))
+
+;;; Bug reported by Gilbert Baumann on #lisp IRC 2003-03-26
+(assert (equal (funcall (eval '(lambda (x &optional (y (pop x))) (list x y)))
+                        '(1 2))
+               '((2) 1)))

diff --git a/version.lisp-expr b/version.lisp-expr
index 71fcd84..965ab00 100644 (file)
--- a/version.lisp-expr
+++ b/version.lisp-expr
@@ -18,4 +18,4 @@
 ;;; versions, especially for internal versions off the main CVS
 ;;; branch, it gets hairier, e.g. "0.pre7.14.flaky4.13".)
 
-"0.pre8.10"
+"0.pre8.11"