; A keeper of immutable sorted lists; type is S ; It defines a sorted list of values: (define (slg) (let* ((clan-seal (new-seal))(close (car clan-seal))(open (cadr clan-seal))) (list ; the empty list; S (close '()) ; Singleton fun; v -> S (lambda (v) (close (list v))) ; Union of lists; (S, S) -> S (lambda (as bs) (close (let ul ((a (open as))(b (open bs))) (if (null? a) b (if (null? b) a (if (< (car a) (car b)) (cons (car a) (ul (cdr a) b)) (if (= (car a) (car b)) (cons (car a) (ul (cdr a) (cdr b))) (cons (car b) (ul a (cdr b)))))))))) ; Intersection of lists; (S, S) -> S (lambda (as bs) (close (let ul ((a (open as))(b (open bs))) (if (null? a) '() (if (null? b) '() (if (< (car a) (car b)) (ul (cdr a) b) (if (< (car b) (car a)) (ul (cdr b) a) (cons (car a) (ul (cdr a) (cdr b)))))))))) ; Difference of lists; (S, S) -> S (lambda (as bs) (close (let ul ((a (open as))(b (open bs))) (if (null? a) '() (if (null? b) a (if (< (car a) (car b)) (cons (car a) (ul (cdr a) b)) (if (= (car a) (car b)) (ul (cdr a) (cdr b)) (ul a (cdr b))))))))) ; Decomposer of list; S -> (v, S) (lambda (as) (let ((a (open as))) (if (null? a) '() (cons (car a) (close (cdr a))))))))) ; ...... ; Outside converters (define (l->S l) (let ((out (cadr (cddddr l)))) (lambda (as) (let r ((as as)) (let ((a (out as))) (if (null? a) '() (cons (car a) (r (cdr a))))))))) (define (S->l l) (let ((sg (cadr l))(un (caddr l))(mt (car l))) (lambda (l) (let r ((l l)) (if (null? l) mt (un (sg (car l)) (r (cdr l)))))))) ; Demo (define l (slg)) (define pS (l->S l)) (define Sp (S->l l)) (define mt (car l)) (define sngl (cadr l)) (define un (caddr l)) (define in (cadddr l)) (define df (car (cddddr l))) (define out (cadr (cddddr l))) (out (sngl 13)) ; => (13 ()) (pS (sngl 17)) ; => (17) (pS (un (Sp '(3 6 7)) (Sp '(4 6 9)))) ; -> (3 4 6 7 9) (pS (in (Sp '(3 7))(Sp '(3 5 7)))) ; => (3 7) (pS (in (Sp '(1 3 4 6 7 9)) (Sp '(2 3 4 5 7)))) ; => (3 4 7) (pS (df (Sp '(1 3 4 6 7 9)) (Sp '(2 3 4 5 7)))) ; => (1 6 9)