(let ((v1 (make-array 1 :element-type 'bit
:initial-contents '(1)
:fill-pointer 0))
(v2 (make-array 1 :element-type 'bit
:initial-contents '(1)
:fill-pointer 1))
(r (make-array nil)))
(funcall
(compile
nil
`(lambda (r p2)
(declare (optimize speed (safety 1))
(type (simple-array t nil) r)
(type (array *) p2))
(setf (aref r) (bit-and ,v1 (the (bit-vector *) p2)))
(values)))
r v2)
(let ((result (aref r)))
(values
(notnot (simple-bit-vector-p result))
(=t (array-dimension result 0) 1)
(=t (aref result 0) 1))))
$ openmcl
Welcome to OpenMCL Version (Beta: Darwin) 0.14.3-50328!
? (defun notnot (x) (not (not x)))
NOTNOT
? (let ((v1 (make-array 1 :element-type 'bit
:initial-contents '(1)
:fill-pointer 0))
(v2 (make-array 1 :element-type 'bit
:initial-contents '(1)
:fill-pointer 1))
(r (make-array nil)))
(funcall
(compile
nil
`(lambda (r p2)
(declare (optimize speed (safety 1))
(type (simple-array t nil) r)
(type (array *) p2))
(setf (aref r) (bit-and ,v1 (the (bit-vector *) p2)))
(values)))
r v2)
(let ((result (aref r)))
(values
(notnot (simple-bit-vector-p result))
(=t (array-dimension result 0) 1)
(=t (aref result 0) 1))))
;Compiler warnings :
; Undefined function =T (2 references), in an anonymous lambda form.
> Error in process listener(1): #<BIT-VECTOR 1 fill-pointer 0, displaced> and #<BIT-VECTOR 1 fill-pointer, displaced> have different dimensions.
> While executing: CCL::CHECK-MATCHING-DIMENSIONS
> Type :POP to abort.
Type :? for other options.
1 >
$ clisp
i i i i i i i ooooo o ooooooo ooooo ooooo
I I I I I I I 8 8 8 8 8 o 8 8
I \ `+' / I 8 8 8 8 8 8
\ `-+-' / 8 8 8 ooooo 8oooo
`-__|__-' 8 8 8 8 8
| 8 o 8 8 o 8 8
------+------ ooooo 8oooooo ooo8ooo ooooo 8
Copyright (c) Bruno Haible, Michael Stoll 1992, 1993
Copyright (c) Bruno Haible, Marcus Daniels 1994-1997
Copyright (c) Bruno Haible, Pierpaolo Bernardi, Sam Steingold 1998
Copyright (c) Bruno Haible, Sam Steingold 1999-2000
Copyright (c) Sam Steingold, Bruno Haible 2001-2004
[1]> (defun notnot (x) (not (not x)))
NOTNOT
[2]> (defun =t (a b) (notnot (= a b)))
=T
[3]> (let ((v1 (make-array 1 :element-type 'bit
:initial-contents '(1)
:fill-pointer 0))
(v2 (make-array 1 :element-type 'bit
:initial-contents '(1)
:fill-pointer 1))
(r (make-array nil)))
(funcall
(compile
nil
`(lambda (r p2)
(declare (optimize speed (safety 1))
(type (simple-array t nil) r)
(type (array *) p2))
(setf (aref r) (bit-and ,v1 (the (bit-vector *) p2)))
(values)))
r v2)
(let ((result (aref r)))
(values
(notnot (simple-bit-vector-p result))
(=t (array-dimension result 0) 1)
(=t (aref result 0) 1))))
T ;
T ;
T
[4]>
I posted this bug to the OpenMCL-devel list. It is fixed in the bleeding edge branch. You need to get a
new image file and interfaces databse file from the clozure.com ftp server (/bup/testing) to rebuild
OpenMCL from CVS.
$ openmcl
Welcome to OpenMCL Version (Beta: Darwin) 0.14.3-050420!
? (defun notnot (x) (not (not x)))
NOTNOT
? (defun =t (a b) (notnot (= a b)))
=T
? (let ((v1 (make-array 1 :element-type 'bit
:initial-contents '(1)
:fill-pointer 0))
(v2 (make-array 1 :element-type 'bit
:initial-contents '(1)
:fill-pointer 1))
(r (make-array nil)))
(funcall
(compile
nil
`(lambda (r p2)
(declare (optimize speed (safety 1))
(type (simple-array t nil) r)
(type (array *) p2))
(setf (aref r) (bit-and ,v1 (the (bit-vector *) p2)))
(values)))
r v2)
(let ((result (aref r)))
(values
(notnot (simple-bit-vector-p result))
(=t (array-dimension result 0) 1)
(=t (aref result 0) 1))))
T
T
T
?