159 |
(defun do-test (&optional (name *test*)) |
(defun do-test (&optional (name *test*)) |
160 |
(do-entry (get-entry name))) |
(do-entry (get-entry name))) |
161 |
|
|
162 |
|
(defun my-aref (a &rest args) |
163 |
|
(apply #'aref a args)) |
164 |
|
|
165 |
|
(defun my-row-major-aref (a index) |
166 |
|
(row-major-aref a index)) |
167 |
|
|
168 |
(defun equalp-with-case (x y) |
(defun equalp-with-case (x y) |
169 |
"Like EQUALP, but doesn't do case conversion of characters. |
"Like EQUALP, but doesn't do case conversion of characters. |
170 |
Currently doesn't work on arrays of dimension > 2." |
Currently doesn't work on arrays of dimension > 2." |
176 |
(equalp-with-case (cdr x) (cdr y)))) |
(equalp-with-case (cdr x) (cdr y)))) |
177 |
((and (typep x 'array) |
((and (typep x 'array) |
178 |
(= (array-rank x) 0)) |
(= (array-rank x) 0)) |
179 |
(equalp-with-case (aref x) (aref y))) |
(equalp-with-case (my-aref x) (my-aref y))) |
180 |
((typep x 'vector) |
((typep x 'vector) |
181 |
(and (typep y 'vector) |
(and (typep y 'vector) |
182 |
(let ((x-len (length x)) |
(let ((x-len (length x)) |
183 |
(y-len (length y))) |
(y-len (length y))) |
184 |
(and (eql x-len y-len) |
(and (eql x-len y-len) |
185 |
(loop |
(loop |
186 |
for e1 across x |
for i from 0 below x-len |
187 |
for e2 across y |
for e1 = (my-aref x i) |
188 |
|
for e2 = (my-aref y i) |
189 |
always (equalp-with-case e1 e2)))))) |
always (equalp-with-case e1 e2)))))) |
190 |
((and (typep x 'array) |
((and (typep x 'array) |
191 |
(typep y 'array) |
(typep y 'array) |
197 |
(and (typep y 'array) |
(and (typep y 'array) |
198 |
(let ((size (array-total-size x))) |
(let ((size (array-total-size x))) |
199 |
(loop for i from 0 below size |
(loop for i from 0 below size |
200 |
always (equalp-with-case (row-major-aref x i) |
always (equalp-with-case (my-row-major-aref x i) |
201 |
(row-major-aref y i)))))) |
(my-row-major-aref y i)))))) |
202 |
|
|
203 |
(t (eql x y)))) |
(t (eql x y)))) |
204 |
|
|
353 |
;;; Note handling functions and macros |
;;; Note handling functions and macros |
354 |
|
|
355 |
(defmacro defnote (name contents &optional disabled) |
(defmacro defnote (name contents &optional disabled) |
356 |
`(eval-when #+gcl (load eval) #-gcl (:load-toplevel :execute) |
`(eval-when (:load-toplevel :execute) |
357 |
(let ((note (make-note :name ',name |
(let ((note (make-note :name ',name |
358 |
:contents ',contents |
:contents ',contents |
359 |
:disabled ',disabled))) |
:disabled ',disabled))) |