;;; -*- Mode:LISP; Package:LISP-INTERNALS; Readtable:ZL; Base:10 -*- (defun prims:eq (a b) (eq a b)) (defun prims:eql (a b) (eql a b)) (defun equal (a b) (cond ((eql a b) t) ((and (consp a) (consp b)) (and (equal (car a) (car b)) (equal (cdr a) (cdr b)))) ((and (stringp a) (stringp b)) (array:%string= a b)) ((and (bit-vector-p a) (bit-vector-p b)) (let ((len-a (length a)) (len-b (length b))) (if (= len-a len-b) (dotimes (i len-a t) (unless (= (svref a i) (svref b i)) (return-from equal nil))) nil))) (t nil))) ;; I think the following would be more efficient - smh ;(defun equal (a b) ; (cond ; ((eql a b) t) ; ((consp a) ; (and (consp b) ; (equal (car a) (car b)) ; (equal (cdr a) (cdr b)))) ; ((stringp a) ; (and (stringp b) ; (array:%string= a b))) ; ((bit-vector-p a) ; (and (bit-vector-p b) ; (let ((len-a (length a)) ; (len-b (length b))) ; (if (= len-a len-b) ; (dotimes (i len-a t) ; (unless (= (svref a i) (svref b i)) ; (return-from equal nil))) ; nil)))) ; (t nil))) (defun equalp (a b) (cond ((eql a b) t) ((and (consp a) (consp b)) (and (equalp (car a) (car b)) (equalp (cdr a) (cdr b)))) ((and (stringp a) (stringp b)) (string-equal a b)) ((and (characterp a) (characterp b)) (char-equal a b)) ((and (vectorp a) (vectorp b)) (let ((len-a (length a)) (len-b (length b))) (if (= len-a len-b) (dotimes (i len-a t) (unless (equalp (svref a i) (svref b i)) (return-from equalp nil))) nil))) ((and (arrayp a) (arrayp b)) (multiple-value-bind (array-pointer-a length-a offset-a array-data-a array-rank-a array-type-a) (array:decode-array a) (multiple-value-bind (array-pointer-b length-b offset-b array-data-b array-rank-b array-type-b) (array:decode-array b) (and (equal (array:array-dimensions a) (array:array-dimensions b)) (do ((i 0 (1+ i))) ((= length-a i) t) (unless (equalp (array:aref-linear-dangerously array-data-a (+ i offset-a) array-type-a) (array:aref-linear-dangerously array-data-b (+ i offset-b) array-type-b)) (return-from equalp nil))))))) (t nil)))