From f578dd10fa6d9a8d7c3d15d3100406976f6a273c Mon Sep 17 00:00:00 2001 From: Christophe Rhodes Date: Mon, 27 Jan 2003 17:45:37 +0000 Subject: [PATCH] 0.7.12.6: Fix compiled calls to bit-array functions to allow an explicit opt-arg of NIL ... and also fix the defknowns for %BITSET and %SBITSET, even though currently they always get SOURCE-TRANSFORMed away. ... minimal tests for these two issues --- NEWS | 3 +++ src/code/array.lisp | 7 +++++++ src/compiler/fndb.lisp | 8 ++++---- tests/array.pure.lisp | 12 ++++++++++++ version.lisp-expr | 2 +- 5 files changed, 27 insertions(+), 5 deletions(-) diff --git a/NEWS b/NEWS index cd82a81..2bbba60 100644 --- a/NEWS +++ b/NEWS @@ -1514,6 +1514,9 @@ changes in sbcl-0.7.13 relative to sbcl-0.7.12: * fixed some bugs revealed by Paul Dietz' test suite: ** ARRAY-IN-BOUNDS-P now allows arbitrary integers as arguments, not just nonnegative fixnums; + ** 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); planned incompatible changes in 0.7.x: * (not done yet, but planned:) When the profiling interface settles diff --git a/src/code/array.lisp b/src/code/array.lisp index bf0bba6..68aa0c6 100644 --- a/src/code/array.lisp +++ b/src/code/array.lisp @@ -444,6 +444,13 @@ ;;; ZOO ;;; But that doesn't seem to be what happens in CMU CL. ;;; +;;; KLUDGE: this is probably because ANSI, in its wisdom (CLHS +;;; 5.1.2.5) requires implementations to support +;;; (SETF (APPLY #'AREF ...) ...) +;;; [and also #'BIT and #'SBIT]. Yes, this is terrifying, and it's +;;; also terrifying that this sequence of definitions causes it to +;;; work. +;;; ;;; Also, it would be nice to make DESCRIBE FOO tell whether a symbol ;;; has a setf expansion and/or a setf function defined. diff --git a/src/compiler/fndb.lisp b/src/compiler/fndb.lisp index 9e0fa6a..cd5299d 100644 --- a/src/compiler/fndb.lisp +++ b/src/compiler/fndb.lisp @@ -804,12 +804,12 @@ (defknown (bit-and bit-ior bit-xor bit-eqv bit-nand bit-nor bit-andc1 bit-andc2 bit-orc1 bit-orc2) - ((array bit) (array bit) &optional (or (array bit) (member t))) + ((array bit) (array bit) &optional (or (array bit) (member t nil))) (array bit) (foldable) #|:derive-type #'result-type-last-arg|#) -(defknown bit-not ((array bit) &optional (or (array bit) (member t))) +(defknown bit-not ((array bit) &optional (or (array bit) (member t nil))) (array bit) (foldable) #|:derive-type #'result-type-last-arg|#) @@ -1341,8 +1341,8 @@ (defknown %put (symbol t t) t (unsafe)) (defknown %setelt (sequence index t) t (unsafe)) (defknown %svset (simple-vector index t) t (unsafe)) -(defknown %bitset (bit-vector &rest index) bit (unsafe)) -(defknown %sbitset (simple-bit-vector &rest index) bit (unsafe)) +(defknown %bitset ((array bit) &rest index) bit (unsafe)) +(defknown %sbitset ((simple-array bit) &rest index) bit (unsafe)) (defknown %charset (string index character) character (unsafe)) (defknown %scharset (simple-string index character) character (unsafe)) (defknown %set-symbol-value (symbol t) t (unsafe)) diff --git a/tests/array.pure.lisp b/tests/array.pure.lisp index 2a8fac0..6663f06 100644 --- a/tests/array.pure.lisp +++ b/tests/array.pure.lisp @@ -96,3 +96,15 @@ (assert (array-in-bounds-p a 7)) (assert (not (array-in-bounds-p a 11))) (assert (not (array-in-bounds-p a (1+ most-positive-fixnum))))) + +;;; arrays of bits should work: +(let ((a (make-array '(10 10) :element-type 'bit :adjustable t))) + (setf (bit a 0 0) 1) + (assert (= (bit a 0 0) 1))) +(let ((a (make-array '(10 10) :element-type 'bit))) + (setf (sbit a 0 0) 1) + (assert (= (sbit a 0 0) 1))) + +(let ((x (copy-seq #*0011)) + (y (copy-seq #*0101))) + (assert (equalp (bit-and x y nil) #*0001))) diff --git a/version.lisp-expr b/version.lisp-expr index 14e8b22..5e5f30e 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.5" +"0.7.12.6" -- 1.7.10.4