ikarus/src/set-operations.ss

39 lines
721 B
Scheme
Raw Normal View History

2006-11-23 19:33:45 -05:00
2007-09-10 16:33:05 -04:00
(define (remq1 x ls)
2006-11-23 19:33:45 -05:00
(cond
[(null? ls) '()]
[(eq? x (car ls)) (cdr ls)]
[else
2007-09-10 16:33:05 -04:00
(let ([t (remq1 x (cdr ls))])
2006-11-23 19:33:45 -05:00
(cond
[(eq? t (cdr ls)) ls]
[else (cons (car ls) t)]))]))
(define (singleton x) (list x))
(define (union s1 s2)
(define (add* s1 s2)
(cond
[(null? s1) s2]
[else (add (car s1) (add* (cdr s1) s2))]))
(define (add x s)
(cond
[(memq x s) s]
[else (cons x s)]))
(cond
[(null? s1) s2]
[(null? s2) s1]
[else (add* s1 s2)]))
(define (difference s1 s2)
(define (rem* s1 s2)
(cond
[(null? s1) s2]
2007-09-10 16:33:05 -04:00
[else (remq1 (car s1) (rem* (cdr s1) s2))]))
2006-11-23 19:33:45 -05:00
(cond
[(null? s1) '()]
[(null? s2) s1]
[else (rem* s2 s1)]))