Note: This solution uses form-case .
To find the free (or bound) variables in a given expression of lambda calculus:
We need a small package of procedures for dealing with lists of symbols as sets:
(define member?
(lambda (s los)
(if (null? los)
#f
(if (eq? s (car los))
#t
(member? s (cdr los))))))
(define adjoin
(lambda (s los)
(if (member? s los)
los
(cons s los))))
(define union
(lambda (los1 los2)
(if (null? los1)
los2
(adjoin (car los1) (union (cdr los1) los2)))))
(define remove-first
(lambda (s los)
(if (null? los)
'()
(if (eq? s (car los))
(cdr los)
(cons (car los) (remove-first s (cdr los)))))))
Now, here are the main procedures:
(define free-vars
(lambda (expr)
(form-case expr
(variable v (list v))
(lambda (formal-list body) (remove-first (car formal-list)
(free-vars body)))
(call (rator rand) (union (free-vars rator) (free-vars rand)))
(else (error 'free-vars "syntactically incorrect expression ~s"
expr)))))
(define bound-vars
(lambda (expr)
(form-case expr
(variable v '())
(lambda (formal-list body)
((lambda (internal-bound-vars)
(if (member? (car formal-list) (free-vars body))
(adjoin (car formal-list) internal-bound-vars)
internal-bound-vars))
(bound-vars body)))
(call (rator rand)
(union (bound-vars rator) (bound-vars rand)))
(else (error 'bound-vars "syntactically incorrect expression ~s"
expr)))))
To mark every variable in an expression of the lambda calculus with its lexical address:
To find the free variables in an expression, we first need a small package of procedures for dealing with lists of symbols as sets:
(define member?
(lambda (s los)
(if (null? los)
#f
(if (eq? s (car los))
#t
(member? s (cdr los))))))
(define adjoin
(lambda (s los)
(if (member? s los)
los
(cons s los))))
(define union
(lambda (los1 los2)
(if (null? los1)
los2
(adjoin (car los1) (union (cdr los1) los2)))))
(define set-difference
(lambda (los1 los2)
(if (null? los1)
'()
(if (member? (car los1) los2)
(set-difference (cdr los1) los2)
(cons (car los1) (set-difference (cdr los1) los2))))))
(define grand-union
(lambda (llos)
(if (null? llos)
'()
(union (car llos) (grand-union (cdr llos))))))
This is an extendend version of free-vars that includes the if
expression, as well as modified call clause:
(define free-vars
(lambda (expr)
(form-case expr
(variable v (list v))
(lambda (formals body) (set-difference (free-vars body)
formals))
(if (test-expr then-expr else-expr)
(union (free-vars test-expr)
(union (free-vars then-expr)
(free-vars else-expr))))
(call rator-rands
(grand-union (map free-vars rator-rands)))
(else (error 'free-vars "syntactically incorrect expression ~s"
expr)))))
The last preliminary is a lookup routine. It takes a variable, a list
of lists of variables (called STACK) and a number indicating how many
such lists of variables it has already searched through, and returns a
two-element list, in which the first element is the total number of
lists of variables that had to be examined before the variable sought
was found and the second element is the zero-based position of the
variable in the list in which it was found.
(define lookup
(lambda (variable stack depth)
(if (member? variable (car stack))
(list depth (list-index variable (car stack)))
(lookup variable (cdr stack) (+ depth 1)))))
(define list-index
(lambda (s los)
(list-index-helper s los 0)))
(define list-index-helper
(lambda (s los level)
(if (eq? s (car los))
level
(list-index-helper s (cdr los) (+ level 1)))))
Here, then, is the code for the lexical-address procedure.
(define lexical-address
(lambda (expr)
(lexical-address-helper expr (list (free-vars expr)))))
(define lexical-address-helper
(lambda (expr stack)
(form-case expr
(variable v (cons v (cons ': (lookup v stack 0))))
(if (test-expr then-expr else-expr)
(list 'if
(lexical-address-helper test-expr stack)
(lexical-address-helper then-expr stack)
(lexical-address-helper else-expr stack)))
(lambda (formals body)
(list 'lambda
formals
(lexical-address-helper body
(cons formals stack))))
(call rator-rands
(map (lambda (sub) (lexical-address-helper sub stack)) rator-rands)))))