Use abstract sets described here. sc is symbol comparator suitable for symbol the set apparatus.
(define (sc a b) (let ((a (symbol->string a))(b (symbol->string b))) (if (string<? a b) -1 (if (string<? b a) 1 0)))) (define t (set sc)) ; Include these defines. (define ext (lambda x (if (null? x) empty (union (singleton (car x)) (apply ext (cdr x)))))); (free x) yields the set of free variables in expression x.
(define (free x) (let ((lex (lambda(x) (let ul ((sl (map free x))) (if (null? sl) empty (union (car sl) (ul (cdr sl))))))) (lexl (lambda(x) (let ul ((x x)) (if (null? x) empty (if (symbol? x) (singleton x) (add (car x) (ul (cdr x))))))))) (cond ((symbol? x) (singleton x)) ((let ino ((pl (list boolean? char? vector? procedure? number? string? port? null? promise?))) (and (pair? pl) (or ((car pl) x) (ino (cdr pl))))) empty) ((pair? x) (case (car x) ((lambda λ) (diff (lex (cddr x)) (lexl (cadr x)))) ((if) (lex (cdr x))) ((set!) (add (cadr x) (free (caddr x)))) ((cond) (let condl ((x (cdr x))) (cond ((null? x) empty) ((null? (cdr x)) (lex (if (eq? (caar x) 'else) (cdar x) (car x)))) ((eq? (cadar x) '=>) (union (union (free (caar x)) (free (caddar x))) (condl (cdr x)))) (else (union (free (car x)) (condl (cdr x))))))) ((case) (union (free (cadr x)) (let csl ((x (cddr x))) (cond ((null? x) empty) ((null? (cdr x)) (lex (if (eq? (caar x) 'else) (cdar x) (car x)))) (else (union (lex (cdar x)) (csl (cdr x)))))))) ((and or begin) (lex (cdr x))) ((delay) (free (cadr x))) ((let) (let ((dgl (lambda (bindings body) (union (let fbb ((x bindings)) (if (null? x) empty (union (free (cadar x)) (fbb (cdr x))))) (diff (lex body) (let vars ((x bindings)) (if (null? x) empty (add (caar x) (vars (cdr x)))))))))) (if (symbol? (cadr x)) (remove (cadr x) (dgl (caddr x)(cdddr x))) (dgl (cadr x)(cddr x))))) ((let*) (let dls ((bl (cadr x))) (if (null? bl) (lex (cddr x)) (union (remove (caar bl) (dls (cdr bl))) (free (cadar bl)))))) ((letrec) (diff (let tfl ((bl (cadr x))) (if (null? bl) (lex (cddr x)) (union (free (cadar bl)) (tfl (cdr bl))))) (let z ((bl (cadr x))) (if (null? bl) empty (add (caar bl) (z (cdr bl))))))) ((do) "I have omitted do") ((quote) empty) ((quasiquote) (let tw ((x (cadr x))) (if (pair? x) (if (or (eq? (car x) 'unquote) (eq? (car x) 'unquote-splicing)) (free (cadr x)) (union (tw (car x)) (tw (cdr x)))) empty))) (else (lex x)))))))The following function tame weakens an expression so that it cannot foul the primal environment with constructs such as (set! car cdr).
(define (tame sus) `(let ,(map (lambda (x) (list x x)) (elements (free sus))) ,sus)) (tame '(set! car cdr)) ; => (let ((car car) (cdr cdr)) (set! car cdr))A more discriminating program could improve on this by noting that (car x) is harmless in the role of an expression, but not perhaps in the role of a datum.