0.7.12.16:

        Fixed compiler failure related to checking types of functions
        (reported by Robert E. Brown);

diff --git a/NEWS b/NEWS
index 86fb57a..b9c0e08 100644 (file)
--- a/NEWS
+++ b/NEWS
@@ -1528,6 +1528,8 @@ changes in sbcl-0.7.13 relative to sbcl-0.7.12:
     ** the logical bit-array operators such as BIT-AND now accept an
        explicit NIL for their "opt-arg" argument (to indicate a
        freshly-consed result bit-array);
+  * fixed compiler failure related to checking types of functions
+    (reported by Robert E. Brown);
 
 planned incompatible changes in 0.7.x:
   * (not done yet, but planned:) When the profiling interface settles

diff --git a/src/compiler/ir1opt.lisp b/src/compiler/ir1opt.lisp
index 2a7f9a1..c28977e 100644 (file)
--- a/src/compiler/ir1opt.lisp
+++ b/src/compiler/ir1opt.lisp
@@ -134,6 +134,7 @@
           (let* ((fun (combination-fun dest))
                  (args (combination-args dest))
                  (fun-type (continuation-type fun)))
+            (setf (continuation-%externally-checkable-type fun) *wild-type*)
             (if (or (not (fun-type-p fun-type))
                     ;; FUN-TYPE might be (AND FUNCTION (SATISFIES ...)).
                     (fun-type-wild-args fun-type))

diff --git a/src/compiler/ir1util.lisp b/src/compiler/ir1util.lisp
index 683bca8..c6c4ac4 100644 (file)
--- a/src/compiler/ir1util.lisp
+++ b/src/compiler/ir1util.lisp
@@ -210,7 +210,7 @@
 ;;;    CONT of LAST in its block, then we make it the start of a new
 ;;;    deleted block.
 ;;; -- If the continuation is :INSIDE-BLOCK inside a block, then we
-;;;    split the block using Node-Ends-Block, which makes the
+;;;    split the block using NODE-ENDS-BLOCK, which makes the
 ;;;    continuation be a :BLOCK-START.
 (defun ensure-block-start (cont)
   (declare (type continuation cont))

diff --git a/src/compiler/pack.lisp b/src/compiler/pack.lisp
index c963ee1..5057a72 100644 (file)
--- a/src/compiler/pack.lisp
+++ b/src/compiler/pack.lisp
@@ -26,8 +26,8 @@
 
 ;;; Return true if the element at the specified offset in SB has a
 ;;; conflict with TN:
-;;; -- If a component-live TN (:component kind), then iterate over
-;;;    all the blocks. If the element at Offset is used anywhere in
+;;; -- If a component-live TN (:COMPONENT kind), then iterate over
+;;;    all the blocks. If the element at OFFSET is used anywhere in
 ;;;    any of the component's blocks (always-live /= 0), then there
 ;;;    is a conflict.
 ;;; -- If TN is global (Confs true), then iterate over the blocks TN
@@ -104,7 +104,7 @@
             (loc-live (svref (finite-sb-always-live sb) this-offset)))
        (cond
         ((eq kind :component)
-         (dotimes (num (ir2-block-count *component-being-compiled*) nil)
+         (dotimes (num (ir2-block-count *component-being-compiled*))
            (declare (type index num))
            (setf (sbit loc-live num) 1)
            (set-bit-vector (svref loc-confs num))))
@@ -590,8 +590,8 @@
 ;;;; optimized saving
 
 ;;; Save TN if it isn't a single-writer TN that has already been
-;;; saved. If multi-write, we insert the save Before the specified
-;;; VOP. Context is a VOP used to tell which node/block to use for the
+;;; saved. If multi-write, we insert the save BEFORE the specified
+;;; VOP. CONTEXT is a VOP used to tell which node/block to use for the
 ;;; new VOP.
 (defun save-if-necessary (tn before context)
   (declare (type tn tn) (type (or vop null) before) (type vop context))
@@ -606,7 +606,7 @@
   (values))
 
 ;;; Load the TN from its save location, allocating one if necessary.
-;;; The load is inserted Before the specifier VOP. Context is a VOP
+;;; The load is inserted BEFORE the specifier VOP. CONTEXT is a VOP
 ;;; used to tell which node/block to use for the new VOP.
 (defun restore-tn (tn before context)
   (declare (type tn tn) (type (or vop null) before) (type vop context))

diff --git a/tests/compiler.pure.lisp b/tests/compiler.pure.lisp
index 6080159..0d4c271 100644 (file)
--- a/tests/compiler.pure.lisp
+++ b/tests/compiler.pure.lisp
@@ -292,3 +292,22 @@
                     (declare (optimize speed (safety 0)))
                     (typecase a
                       (array (loop (print (car a)))))))))
+
+;;; Bug reported by Robert E. Brown sbcl-devel 2003-02-02: compiler
+;;; failure
+(compile nil
+         '(lambda (key tree collect-path-p)
+           (let ((lessp (key-lessp tree))
+                 (equalp (key-equalp tree)))
+             (declare (type (function (t t) boolean) lessp equalp))
+             (let ((path '(nil)))
+               (loop for node = (root-node tree)
+                  then (if (funcall lessp key (node-key node))
+                           (left-child node)
+                           (right-child node))
+                  when (null node)
+                  do (return (values nil nil nil))
+                  do (when collect-path-p
+                       (push node path))
+                  (when (funcall equalp key (node-key node))
+                    (return (values node path t))))))))

diff --git a/version.lisp-expr b/version.lisp-expr
index 234f336..6dd8ef3 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.7.12.15"
+"0.7.12.16"