Blame


1 665c255d 2023-08-04 jrmu (define (make-table)
2 665c255d 2023-08-04 jrmu (define local-table '())
3 665c255d 2023-08-04 jrmu (define make-record cons)
4 665c255d 2023-08-04 jrmu (define key-record car)
5 665c255d 2023-08-04 jrmu (define value-record cdr)
6 665c255d 2023-08-04 jrmu (define (make-tree entry left right)
7 665c255d 2023-08-04 jrmu (list entry let right))
8 665c255d 2023-08-04 jrmu (define entry car)
9 665c255d 2023-08-04 jrmu (define left-branch cadr)
10 665c255d 2023-08-04 jrmu (define right-branch caddr)
11 665c255d 2023-08-04 jrmu (define key=? equal?)
12 665c255d 2023-08-04 jrmu (define (list<? l1 l2)
13 665c255d 2023-08-04 jrmu (andmap key<? l1 l2))
14 665c255d 2023-08-04 jrmu (define (key<? key1 key2)
15 665c255d 2023-08-04 jrmu (cond ((and (string? key1)
16 665c255d 2023-08-04 jrmu (string? key2)) (string<? key1 key2))
17 665c255d 2023-08-04 jrmu ((and (number? key1)
18 665c255d 2023-08-04 jrmu (number? key2)) (< key1 key2))
19 665c255d 2023-08-04 jrmu ((and (char? key1)
20 665c255d 2023-08-04 jrmu (char? key2)) (char<? key1 key2))
21 665c255d 2023-08-04 jrmu (else (error "Unsupported key types -- KEY<?" key1 key2))))
22 665c255d 2023-08-04 jrmu (define (element-of-set? x set)
23 665c255d 2023-08-04 jrmu (cond ((null? set) false)
24 665c255d 2023-08-04 jrmu ((key=? (key-record x) (key-record (entry set))) true)
25 665c255d 2023-08-04 jrmu ((key<? (key-record x) (key-record (entry set)))
26 665c255d 2023-08-04 jrmu (element-of-set? x (left-branch set)))
27 665c255d 2023-08-04 jrmu (else
28 665c255d 2023-08-04 jrmu (element-of-set? x (right-branch set)))))
29 665c255d 2023-08-04 jrmu