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

fix order of arguments in lset=

Browse source
This commit is contained in:
Alex Shinn 2020-05-27 14:27:31 +09:00
parent ca52b2ff97
commit 255ee079e5
2 changed files with 4 additions and 1 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

3
lib/srfi/1/lset.scm
View file

@ -15,7 +15,8 @@
(lp1 set2 (cdr sets))))))))) (lp1 set2 (cdr sets)))))))))
(define (lset= eq . sets) (define (lset= eq . sets)
(and (apply lset<= eq sets) (apply lset<= eq (reverse sets)))) (and (apply lset<= eq sets)
(apply lset<= (lambda (b a) (eq a b)) (reverse sets))))
(define (lset-adjoin eq set . elts) (define (lset-adjoin eq set . elts)
(lset-union2 eq set elts)) (lset-union2 eq set elts))

2
lib/srfi/1/test.sld
View file

@ -164,6 +164,8 @@
(test #f (lset= = '(2 1) '(2 1 0))) (test #f (lset= = '(2 1) '(2 1 0)))
(test #t (lset<= = '(2 1) '(2 1 0))) (test #t (lset<= = '(2 1) '(2 1 0)))
(test #f (lset<= = '(2 1 0) '(2 1))) (test #f (lset<= = '(2 1 0) '(2 1)))
;; order matters
(test #t (lset= (lambda (a b) (= (inexact->exact (round a)) b)) '(1.2 0.1 2.3) '(2 1 0)))
(test '(u o i a b c d c e) (lset-adjoin eq? '(a b c d c e) 'a 'e 'i 'o 'u)) (test '(u o i a b c d c e) (lset-adjoin eq? '(a b c d c e) 'a 'e 'i 'o 'u))
(test '(u o i a b c d e) (lset-union eq? '(a b c d e) '(a e i o u))) (test '(u o i a b c d e) (lset-union eq? '(a b c d e) '(a e i o u)))
(test '(x a a c) (lset-union eq? '(a a c) '(x a x))) (test '(x a a c) (lset-union eq? '(a a c) '(x a x)))