klisp-rust/setops at main · kathe/klisp-rust · GitHub

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
; Set operations.
; ISECT = intersection (A*B)
; UNION = union (A+B)
; SETDIFF = difference (A-B)

(setq isect
  (lambda (a b)
    (loop is ((a a) (r nil))
      (cond ((null a) (nrever r))
            ((memb (car a) b)
              (is (cdr a) (cons (car a) r)))
            (else
              (is (cdr a) r))))))

(setq union
  (lambda (a b)
    (loop u ((a (conc a b)) (r nil))
      (cond ((null a) (nrever r))
            ((memb (car a) r)
              (u (cdr a) r))
            (else
              (u (cdr a) (cons (car a) r)))))))

(setq setdiff
  (lambda (a b)
    (loop d ((a a) (r nil))
      (cond ((null a) (rever r))
            ((memb (car a) b)
              (d (cdr a) r))
            (else
              (d (cdr a) (cons (car a) r)))))))