0.9.11.37:
authorAlexey Dejneka <adejneka@comail.ru>
Fri, 14 Apr 2006 17:57:57 +0000 (17:57 +0000)
committerAlexey Dejneka <adejneka@comail.ru>
Fri, 14 Apr 2006 17:57:57 +0000 (17:57 +0000)
        * Fix MISC.367: when delaying IR1-conversion of an optional
          entry replace default value forms with their values.

NEWS
src/compiler/ctype.lisp
src/compiler/ir1tran-lambda.lisp
src/compiler/proclaim.lisp
tests/compiler.pure.lisp
version.lisp-expr

diff --git a/NEWS b/NEWS
index 7800e5a..f9c286b 100644 (file)
--- a/NEWS
+++ b/NEWS
@@ -48,6 +48,8 @@ changes in sbcl-0.9.12 relative to sbcl-0.9.11:
        structure accessors.
     ** printing characters should simply be printed by the FORMAT ~:C
        directive.
+    ** compiler failure when compiling functions with hairy constant
+       defaults for optional parameters.
 
 changes in sbcl-0.9.11 relative to sbcl-0.9.10:
   * new platform: experimental support for SBCL x86/Darwin, including
index 32ed243..7927814 100644 (file)
            ((lambda-var-arg-info arg)
             (let* ((info (lambda-var-arg-info arg))
                    (default (arg-info-default info))
-                   (def-type (when (constantp default)
-                               (ctype-of (eval default)))))
+                   (def-type (when (sb!xc:constantp default)
+                               (ctype-of (constant-form-value default)))))
               (ecase (arg-info-kind info)
                 (:keyword
                  (let* ((key (arg-info-key info))
index 34a4cb0..c2ae9ae 100644 (file)
     ;; problems: hidden references should not be established to
     ;; lambdas of kind NIL should not have (otherwise the compiler
     ;; might let-convert or delete them) and to variables.
-    (let ((name (or debug-name source-name))
-          (defaults (if supplied-p (list default nil) (list default))))
+    (let ((name (or debug-name source-name)))
       (if (or force
               supplied-p-p ; this entry will be of kind NIL
               (and (lambda-p ep) (eq (lambda-kind ep) nil)))
           (convert-optional-entry ep
                                   default-vars default-vals
-                                  defaults
+                                  (if supplied-p (list default nil) (list default))
                                   name)
-          (delay
-           (register-entry-point
-            (convert-optional-entry (force ep)
-                                    default-vars default-vals
-                                    defaults
-                                    name)
-            res))))))
+          (let* ((default `',(constant-form-value default))
+                 (defaults (if supplied-p (list default nil) (list default))))
+            ;; DEFAULT can contain a reference to a
+            ;; to-be-optimized-away function/block/tag, so better to
+            ;; reduce code now (but we possibly lose syntax checking
+            ;; in an unreachable code).
+            (delay
+             (register-entry-point
+              (convert-optional-entry (force ep)
+                                      default-vars default-vals
+                                      defaults
+                                      name)
+              res)))))))
 
 ;;; Create the MORE-ENTRY function for the OPTIONAL-DISPATCH RES.
 ;;; ENTRY-VARS and ENTRY-VALS describe the fixed arguments. REST is
index 9dd4dc6..8381cd9 100644 (file)
        (dolist (name args)
          (unless (symbolp name)
            (error "can't declare a non-symbol as SPECIAL: ~S" name))
-         (when (constantp name)
+         (when (sb!xc:constantp name)
            (error "can't declare a constant as SPECIAL: ~S" name))
          (with-single-package-locked-error
              (:symbol name "globally declaring ~A special"))
index 0bfef0e..d0821f4 100644 (file)
                                        (- (+ source-day
                                              canonicalized-shift) 7)))))))
                result))))
+
+;;; MISC.637: incorrect delaying of conversion of optional entries
+;;; with hairy constant defaults
+(let ((f '(lambda ()
+  (labels ((%f11 (f11-2 &key key1)
+             (labels ((%f8 (f8-2 &optional (f8-5 (if nil (return-from %f11 0) 0)))
+                        :bad1))
+               (%f8 (%f8 0)))
+             :bad2))
+    :good))))
+  (assert (eq (funcall (compile nil f)) :good)))
index 7b72fce..f0b501c 100644 (file)
@@ -17,4 +17,4 @@
 ;;; checkins which aren't released. (And occasionally for internal
 ;;; versions, especially for internal versions off the main CVS
 ;;; branch, it gets hairier, e.g. "0.pre7.14.flaky4.13".)
-"0.9.11.36"
+"0.9.11.37"