From b5183a46f304490682ebbac0a1a116681d3b2163 Mon Sep 17 00:00:00 2001 From: Alexey Dejneka Date: Mon, 3 Feb 2003 11:55:56 +0000 Subject: [PATCH] 0.7.12.16: Fixed compiler failure related to checking types of functions (reported by Robert E. Brown); --- NEWS | 2 ++ src/compiler/ir1opt.lisp | 1 + src/compiler/ir1util.lisp | 2 +- src/compiler/pack.lisp | 12 ++++++------ tests/compiler.pure.lisp | 19 +++++++++++++++++++ version.lisp-expr | 2 +- 6 files changed, 30 insertions(+), 8 deletions(-) diff --git a/NEWS b/NEWS index 86fb57a..b9c0e08 100644 --- 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 --- 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 --- 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 --- 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 --- 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 --- 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" -- 1.7.10.4