Fcalva/chibi-scheme
1
0
Fork 0
mirror of https://github.com/ashinn/chibi-scheme.git synced 2025-05-19 13:49:17 +02:00
Code Issues Projects Releases Packages Wiki Activity Actions

SRFI 160 vector= differs from SRFI 133 in not taking an eq predicate (issue #674)

Browse source
This commit is contained in:
Alex Shinn 2020-07-31 15:09:46 +09:00
parent b7ffc4e700
commit 5d2a9bcc3d
2 changed files with 20 additions and 21 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

12
lib/srfi/160/test.sld
View file

@ -31,12 +31,12 @@
(test-group "uvectors/predicates" (test-group "uvectors/predicates"
(test #f (u32vector-empty? '#u32(0))) (test #f (u32vector-empty? '#u32(0)))
(test-assert (u32vector-empty? '#u32())) (test-assert (u32vector-empty? '#u32()))
(test-assert (u32vector= eq? '#u32(0 1 2 3) '#u32(0 1 2 3))) (test-assert (u32vector= '#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 #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 #f (u32vector= '#u32(1 2 3 4 5) '#u32(1 2 3 4)))
(test-assert (u32vector= eq?)) (test-assert (u32vector=))
(test-assert (u32vector= eq? '#u32(0))) (test-assert (u32vector= '#u32(0)))
(test-assert (u32vector= equal? (u32vector 0) (u32vector 0))) (test-assert (u32vector= (u32vector 0) (u32vector 0)))
) )
(test-group "uvectors/iteration" (test-group "uvectors/iteration"

21
lib/srfi/160/uvector.scm
View file

@ -2,21 +2,20 @@
(define (vector-empty? vec) (define (vector-empty? vec)
(zero? (uvector-length vec))) (zero? (uvector-length vec)))
(define (vector= eq . o) (define (vector= . vecs)
(cond (let lp1 ((ls vecs))
((null? o) #t) (or (null? ls)
((null? (cdr o)) #t) (null? (cdr ls))
(else (let* ((v1 (car ls))
(and (let* ((v1 (car o)) (v2 (cadr ls))
(v2 (cadr o))
(len (uvector-length v1))) (len (uvector-length v1)))
(and (= len (uvector-length v2)) (and (= len (uvector-length v2))
(let lp ((i 0)) (let lp2 ((i 0))
(or (>= i len) (or (>= i len)
(and (eq (uvector-ref v1 i) (and (= (uvector-ref v1 i)
(uvector-ref v2 i)) (uvector-ref v2 i))
(lp (+ i 1))))))) (lp2 (+ i 1)))))
(apply vector= eq (cdr o)))))) (lp1 (cdr ls)))))))
(define (list->uvector ls) (define (list->uvector ls)
(let ((res (make-uvector (length ls)))) (let ((res (make-uvector (length ls))))