105 |
|
|
106 |
(defun equalp-with-case (x y) |
(defun equalp-with-case (x y) |
107 |
"Like EQUALP, but doesn't do case conversion of characters. |
"Like EQUALP, but doesn't do case conversion of characters. |
108 |
Currently doesn't work on arrays of dimension > 1." |
Currently doesn't work on arrays of dimension > 2." |
109 |
(cond |
(cond |
110 |
((consp x) |
((consp x) |
111 |
(and (consp y) |
(and (consp y) |
112 |
(equalp-with-case (car x) (car y)) |
(equalp-with-case (car x) (car y)) |
113 |
(equalp-with-case (cdr x) (cdr y)))) |
(equalp-with-case (cdr x) (cdr y)))) |
114 |
((and (typep x 'array) |
((and (typep x 'array) |
115 |
(typep y 'array) |
(= (array-rank x) 0)) |
116 |
(not (eql (array-rank x) (array-rank y)))) |
(equalp-with-case (aref x) (aref y))) |
|
nil) |
|
117 |
((typep x 'vector) |
((typep x 'vector) |
118 |
(and (typep y 'vector) |
(and (typep y 'vector) |
119 |
(let ((x-len (length x)) |
(let ((x-len (length x)) |
124 |
for e2 across y |
for e2 across y |
125 |
always (equalp-with-case e1 e2)))))) |
always (equalp-with-case e1 e2)))))) |
126 |
((and (typep x 'array) |
((and (typep x 'array) |
127 |
(= (array-rank x) 0)) |
(typep y 'array) |
128 |
(equalp-with-case (aref x) (aref y))) |
(not (equal (array-dimensions x) |
129 |
|
(array-dimensions y)))) |
130 |
|
nil) |
131 |
|
;; I should use ROW-MAJOR-AREF to do this, but that's broken |
132 |
|
;; in GCL right now. |
133 |
|
((and (typep x 'array) |
134 |
|
(= (array-rank x) 2)) |
135 |
|
(let ((dim (array-dimensions x))) |
136 |
|
(loop for i from 0 below (first dim) |
137 |
|
always (loop for j from 0 below (second dim) |
138 |
|
always (equalp-with-case (aref x i j) |
139 |
|
(aref y i j)))))) |
140 |
(t (eql x y)))) |
(t (eql x y)))) |
141 |
|
|
142 |
(defun do-entry (entry &optional |
(defun do-entry (entry &optional |