This is the extended <syntax> class that has the substitute and free? methods defined.
(define <syntax>
(class ()
(public unparse rename substitute)
(methods
(unparse)
(rename)
(free?)
(substitute))))
Here are the definitions for the <literal>
, <variable>, <call>,
and <lambda> classes with only the unparse method defined.
(define <literal>
(class (const)
(base <syntax>)
(inheritable const)
(inst-vars const)
(methods
(unparse
(method () const)))))
(define <variable>
(class (var)
(base <syntax>)
(inheritable var)
(inst-vars var)
(methods
(unparse (method () var)))))
(define <lambda>
(class (formal body)
(base <syntax>)
(inheritable formal body)
(inst-vars formal body)
(methods
(unparse
(method ()
(list 'lambda (list formal) (unparse body)))))))
(define <call>
(class (rator rand)
(base <syntax>)
(inheritable rator rand)
(inst-vars rator rand)
(methods
(unparse
(method ()
(list (unparse rator) (unparse rand)))))))
Here is the lambda calculus syntax we use: (Note that the square
brackets are now used instead of angled brackets in the syntax
defintion to avoid any confusion with class defintions.)
[exp] ::= [var]
| (lambda ([var]) [exp])
| ([exp] [exp])
| [const]
[const] ::= number
Here is the procedure parse that takes an expression in
the lambda calculus syntax and parses it into appropriate instances of
objects.
(define parse
(lambda (exp-datum)
(form-case exp-datum
(constant c
(<literal> c))
(variable var
(<variable> var))
(lambda (formals body)
(<lambda> (car formals) (parse body)))
(call (rator rand)
(<call> (parse rator) (parse rand))))))
Here are the extended definitons of the derived classes with the
rename method defined.
(define <literal>
(class (const-init)
(base <literal>)
(base-inst-vars const)
(base-init const-init)
(methods
(rename
(method (old new)
this)))))
(define <variable>
(class (var-init)
(base <variable>)
(base-inst-vars var)
(base-init var-init)
(methods
(rename
(method (old new)
(if (eq? old var)
(<variable> new)
this))))))
(define <lambda>
(class (formal-init body-init)
(base <lambda>)
(base-inst-vars formal body)
(base-init formal-init body-init)
(methods
(rename
(method (old new)
(if (eq? old formal)
this
(<lambda> formal (rename body old new))))))))
(define <call>
(class (rator-init rand-init)
(base <call>)
(base-inst-vars rator rand)
(base-init rator-init rand-init)
(methods
(rename
(method (old new)
(<call> (rename rator old new) (rename rand old new)))))))
Here are the extensions of the classes <variable>,
<call>,
<lambda>, and
(define <literal>
(class (const-init)
(base <literal>)
(base-inst-vars const)
(base-init const-init)
(methods
(free?
(method (v)
#f))
(substitute
(method (new old)
this)))))
(define <variable>
(class (var-init)
(base <variable>)
(base-inst-vars var)
(base-init var-init)
(methods
(free?
(method (v)
(eq? v var)))
(substitute
(method (new old)
(if (eq? old var)
new
this))))))
(define <call>
(class (rator-init rand-init)
(base <call>)
(base-inst-vars rator rand)
(base-init rator-init rand-init)
(methods
(free?
(method (v)
(or (free? rator v)
(free? rand v))))
(substitute
(method (new old)
(<call>
(substitute rator new old)
(substitute rand new old)))))))
(define <lambda>
(class (formal-init body-init)
(base <lambda>)
(base-inst-vars formal body)
(base-init formal-init body-init)
(methods
(free?
(method (v)
(and (not (eq? v formal))
(free? body v))))
(substitute
(method (new old)
(cond
((eq? old formal) this)
((not (free? body old)) this)
((and (not (eq? old formal))
(not (free? new formal)))
(<lambda> formal (substitute body new old)))
(else (let ((z (gensym)))
(<lambda> z (substitute
(rename body formal z)
new
old))))))))))
Here are global generics to invoke the methods:
(define unparse (generic unparse)) (define substitute (generic substitute)) (define rename (generic rename))