From 5d2a9bcc3df76204c97115e0ff8738df1d6ea1a3 Mon Sep 17 00:00:00 2001
From: Alex Shinn <alexshinn@gmail.com>
Date: Fri, 31 Jul 2020 15:09:46 +0900
Subject: [PATCH] SRFI 160 vector= differs from SRFI 133 in not taking an eq
predicate (issue #674)
---
lib/srfi/160/test.sld | 12 ++++++------
lib/srfi/160/uvector.scm | 29 ++++++++++++++---------------
2 files changed, 20 insertions(+), 21 deletions(-)
diff --git a/lib/srfi/160/test.sld b/lib/srfi/160/test.sld
index 9f5ca0a7..64d845fd 100644
--- a/lib/srfi/160/test.sld
+++ b/lib/srfi/160/test.sld
@@ -31,12 +31,12 @@
(test-group "uvectors/predicates"
(test #f (u32vector-empty? '#u32(0)))
(test-assert (u32vector-empty? '#u32()))
- (test-assert (u32vector= eq? '#u32(0 1 2 3) '#u32(0 1 2 3)))
- (test #t (u32vector= eq? '#u32(0 1 2 3) '#u32(0 1 2 3)))
- (test #f (u32vector= = '#u32(1 2 3 4 5) '#u32(1 2 3 4)))
- (test-assert (u32vector= eq?))
- (test-assert (u32vector= eq? '#u32(0)))
- (test-assert (u32vector= equal? (u32vector 0) (u32vector 0)))
+ (test-assert (u32vector= '#u32(0 1 2 3) '#u32(0 1 2 3)))
+ (test #t (u32vector= '#u32(0 1 2 3) '#u32(0 1 2 3)))
+ (test #f (u32vector= '#u32(1 2 3 4 5) '#u32(1 2 3 4)))
+ (test-assert (u32vector=))
+ (test-assert (u32vector= '#u32(0)))
+ (test-assert (u32vector= (u32vector 0) (u32vector 0)))
)
(test-group "uvectors/iteration"
diff --git a/lib/srfi/160/uvector.scm b/lib/srfi/160/uvector.scm
index 515c522d..82bba234 100644
--- a/lib/srfi/160/uvector.scm
+++ b/lib/srfi/160/uvector.scm
@@ -2,21 +2,20 @@
(define (vector-empty? vec)
(zero? (uvector-length vec)))
-(define (vector= eq . o)
- (cond
- ((null? o) #t)
- ((null? (cdr o)) #t)
- (else
- (and (let* ((v1 (car o))
- (v2 (cadr o))
- (len (uvector-length v1)))
- (and (= len (uvector-length v2))
- (let lp ((i 0))
- (or (>= i len)
- (and (eq (uvector-ref v1 i)
- (uvector-ref v2 i))
- (lp (+ i 1)))))))
- (apply vector= eq (cdr o))))))
+(define (vector= . vecs)
+ (let lp1 ((ls vecs))
+ (or (null? ls)
+ (null? (cdr ls))
+ (let* ((v1 (car ls))
+ (v2 (cadr ls))
+ (len (uvector-length v1)))
+ (and (= len (uvector-length v2))
+ (let lp2 ((i 0))
+ (or (>= i len)
+ (and (= (uvector-ref v1 i)
+ (uvector-ref v2 i))
+ (lp2 (+ i 1)))))
+ (lp1 (cdr ls)))))))
(define (list->uvector ls)
(let ((res (make-uvector (length ls))))