Equality predicate optional, start testing.
This commit is contained in:
parent
6873a5b7ea
commit
b5c705d59f
1 changed files with 27 additions and 20 deletions
|
@ -31,22 +31,28 @@
|
||||||
TAG-LSET
|
TAG-LSET
|
||||||
|
|
||||||
make-lset
|
make-lset
|
||||||
lset-add
|
|
||||||
lset-remove
|
lset-empty?
|
||||||
|
|
||||||
lset-member?
|
lset-member?
|
||||||
|
|
||||||
|
lset-add
|
||||||
|
lset-remove
|
||||||
|
|
||||||
list->lset
|
list->lset
|
||||||
lset->list
|
lset->list
|
||||||
|
|
||||||
lset-merge
|
lset-merge
|
||||||
lset-intersect
|
lset-intersect
|
||||||
lset-subtract
|
lset-subtract
|
||||||
|
|
||||||
|
lset-tests!
|
||||||
)
|
)
|
||||||
|
|
||||||
(import scheme
|
(import scheme
|
||||||
(chicken string)
|
(chicken string)
|
||||||
(chicken random))
|
(chicken random)
|
||||||
|
testing)
|
||||||
|
|
||||||
;; Tag used for identifying list sets from this module
|
;; Tag used for identifying list sets from this module
|
||||||
(define TAG-LSET
|
(define TAG-LSET
|
||||||
|
@ -64,15 +70,22 @@
|
||||||
""))
|
""))
|
||||||
|
|
||||||
;; Creates new list set using given equality procedure
|
;; Creates new list set using given equality procedure
|
||||||
(define (make-lset equality?)
|
(define (make-lset . equality?)
|
||||||
(list TAG-LSET
|
(let ((equality? (if (null? equality?)
|
||||||
(list equality?)))
|
equal?
|
||||||
|
(car equality?))))
|
||||||
|
(list TAG-LSET
|
||||||
|
(list equality?))))
|
||||||
|
|
||||||
;; Convenience accessors
|
;; Convenience accessors
|
||||||
(define lset-meta cadr)
|
(define lset-meta cadr)
|
||||||
(define lset-equality? caadr)
|
(define lset-equality? caadr)
|
||||||
(define lset-list cddr)
|
(define lset-list cddr)
|
||||||
|
|
||||||
|
;; Returns true if the list set is empty
|
||||||
|
(define (lset-empty? ls)
|
||||||
|
(null? (lset-list ls)))
|
||||||
|
|
||||||
;; Returns true if given element is in the list
|
;; Returns true if given element is in the list
|
||||||
(define (lset-member? ls el)
|
(define (lset-member? ls el)
|
||||||
(let ((equality? (lset-equality? ls)))
|
(let ((equality? (lset-equality? ls)))
|
||||||
|
@ -155,20 +168,14 @@
|
||||||
(loop (cdr lst)
|
(loop (cdr lst)
|
||||||
(lset-remove ls (car lst))))))
|
(lset-remove ls (car lst))))))
|
||||||
|
|
||||||
|
;; Module self-tests
|
||||||
|
(define (lset-tests!)
|
||||||
|
(run-tests
|
||||||
|
lset
|
||||||
|
(test-true make-lset/lset-empty? (lset-empty? (make-lset)))
|
||||||
|
))
|
||||||
|
|
||||||
)
|
)
|
||||||
|
|
||||||
(import util-set-list)
|
(import util-set-list)
|
||||||
|
(lset-tests!)
|
||||||
(print TAG-LSET)
|
|
||||||
(print (make-lset string=?))
|
|
||||||
(define ls (make-lset string=?))
|
|
||||||
(print ls)
|
|
||||||
(define ls1 (lset-add ls "a"))
|
|
||||||
(print ls1)
|
|
||||||
(define ls2 (lset-add ls1 "a"))
|
|
||||||
(print ls2)
|
|
||||||
(define ls3 (lset-add ls2 "b"))
|
|
||||||
(print ls3)
|
|
||||||
(define ls4 (lset-remove ls3 "a"))
|
|
||||||
(print ls4)
|
|
||||||
(print (list->lset '("asdf" "qwer" "asdf" "xcvv" "asdf" "qwer" "lkjh") string=?))
|
|
||||||
|
|
Loading…
Add table
Add a link
Reference in a new issue