Fcalva/chibi-scheme
1
0
Fork 0
mirror of https://github.com/ashinn/chibi-scheme.git synced 2025-05-19 05:39:18 +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 #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"

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

@ -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))))