A complete listing of the TOOL interpreter is appended to this problem set. This section leads you through the most important parts, describing how they differ from the Scheme evaluator in section 4.1.
We've named the eval procedure tool-eval so as not to confuse it
with Scheme's ordinary eval. The only difference between
tool-eval and the eval in chapter 4 are the new cases added to
handle the new special forms: define-generic-function,
define-method, define-class, and make. Each clause dispatches
to the appropriate handler for that form. Note that we have deleted
lambda; all TOOL functions are defined with
define-generic-function.
(define (tool-eval exp env)
(cond ((self-evaluating? exp) exp)
((variable? exp) (lookup-variable-value exp env))
((quoted? exp) (text-of-quotation exp))
((assignment? exp) (eval-assignment exp env))
((definition? exp) (eval-definition exp env))
((if? exp) (eval-if exp env))
;;we've omitted lambda
;;((lambda? exp)
;; (make-procedure (lambda-parameters exp) (lambda-body exp) env))
((generic-function-definition? exp)
(eval-generic-function-definition exp env))
((method-definition? exp) (eval-define-method exp env))
((class-definition? exp) (eval-define-class exp env))
((instance-creation? exp) (eval-make exp env))
((begin? exp)
(eval-sequence (begin-actions exp) env))
((cond? exp) (tool-eval (cond->if exp) env))
((application? exp)
(tool-apply (tool-eval (operator exp) env)
(list-of-values (operands exp) env)))
(else (error "Unknown expression type -- EVAL >> " exp))))
Apply also gets an extra clause that dispatches to a procedure that handles applications of generic functions.
(define (tool-apply procedure arguments)
(cond ((primitive-procedure? procedure)
(apply-primitive-procedure procedure arguments))
((compound-procedure? procedure)
(eval-sequence
(procedure-body procedure)
(extend-environment (procedure-parameters procedure)
arguments
(procedure-environment procedure))))
((generic-function? procedure)
(apply-generic-function procedure arguments))
(else (error "Unknown procedure type -- APPLY"))))
A class is represented by a data structure that contains the class name, a list of slots for that class, and a list of all the ancestors of the class. For instance, in our cat example above, we would have a class with the name <house-cat>, slots (address size breed), and superclasses (<cat> <object>). Note that the slot names include all the slots for that class (i.e., including the slots for the superclass). Similarly, the list of ancestors of a class includes the superclass and all of its ancestors.
A generic function is a data structure that contains the name of the function and a list of the methods defined for that function. Each method is a pair--the specializers and the resulting procedure to use. The specializers are a list of classes to which the arguments must belong in order for the method to be applicable. The procedure is represented as an ordinary Scheme procedure.
An instance is a structure that contains the class of the instance and the list of values for the slots.
See the attached code for details of the selectors and constructors for these data structures.
The special form (define-generic-function name) is handled by the following procedure:
(define (eval-generic-function-definition exp env)
(let ((name (generic-function-definition-name exp)))
(let ((val (make-generic-function name)))
(define-variable! name val env)
(list 'defined 'generic 'function: name))))
This procedure extracts the name portion of the expression and calls make-generic-function to create a new generic function. Then it binds name to the new generic function in the given environment. The value returned is a message to the user, which will be printed by the read-eval-print loop.
Eval-define-method handles the special form (define-method generic-function (params-and-classes) . body)
For example
(define-method say ((cat <cat>) (stuff <number>))
(newline)
(print '(cats never discuss numbers))
'done)
In general here, generic-function is the generic function to
which the method will be added, params-and-classes is a list of
parameters for this method and the classes to which they must belong,
and body is a procedure body, just as for an ordinary Scheme
procedure. The syntax procedures for this form include
appropriate procedures to select out these pieces (see the code).
Eval-define-method first finds the generic function. Notice that the generic-function piece of the expression must be evaluated to obtain the actual generic function. Eval-define-method disassembles the list of params-and-classes into separate lists of parameters and classes. The parameters, the body, and the environment are combined to form a procedure, just as in Scheme. The classes become the specializers for this method. Finally, the method is installed into the generic function.
(define (eval-define-method exp env)
(let ((gf (tool-eval (method-definition-generic-function exp) env)))
(if (not (generic-function? gf))
(error "Unrecognized generic function -- DEFINE-METHOD >> "
(method-definition-generic-function exp))
(let ((params (method-definition-parameters exp)))
(install-method-in-generic-function
gf
(map (lambda (p) (paramlist-element-class p env))
params)
(make-procedure (map paramlist-element-name params)
(method-definition-body exp)
env))
(list 'added 'method 'to 'generic 'function:
(generic-function-name gf))))))
The special form (define-class name superclass . slots) is handled by
(define (eval-define-class exp env)
(let ((superclass (tool-eval (class-definition-superclass exp)
env)))
(if (not (class? superclass))
(error "Unrecognized superclass -- MAKE-CLASS >> "
(class-definition-superclass exp))
(let ((name (class-definition-name exp))
(all-slots (collect-slots
(class-definition-slot-names exp)
superclass)))
(let ((new-class
(make-class name superclass all-slots)))
(define-variable! name new-class env)
(list 'defined 'class: name))))))
The only tricky part here is that we have to collect all the slots from all the ancestor classes to combine with the slots declared for this particular class. This is accomplished by the procedure collect-slots (see the code).
The final special form (make class slot-names-and-values) is handled by the procedure eval-make. This constructs an instance for the specified class, with the designated slot values. See the attached code for details.
REST STOP
This is a lot to absorb, isn't it?
Here is where the fun starts, and what all the preceding machinery was for. When we apply a generic function to some arguments, we first find all the methods that are applicable, given the classes of the arguments. This gives us a list of methods, of which we will use the first one. (We'll see why the first one in a minute.) We extract the procedure for that method and apply that procedure to the arguments. Note the subtle recursion here: apply-generic-function (below) calls tool-apply with the procedure part of the method.
(define (apply-generic-function generic-function arguments)
(let ((methods (compute-applicable-methods-using-classes
generic-function
(map class-of arguments))))
(if (null? methods)
(error "No method found -- APPLY-GENERIC-FUNCTION")
(tool-apply (method-procedure (car methods)) arguments))))
To compute the list of ``applicable methods'' we first find all methods for that generic function that can be applied, given the list of classes for the arguments. We then sort these according to an ordering called method-more-specific. The idea is that the first method in the sorted list will be the most specific one, which is the the best method to apply for those arguments.
(define (compute-applicable-methods-using-classes generic-function classes)
(sort
(filter
(lambda (method)
(method-applies-to-classes? method classes))
(generic-function-methods generic-function))
method-more-specific?))
To test if a method is applicable, given a list of classes of the supplied arguments, we examine the method specializers and see whether, for each supplied argument, the class of the argument is a subclass of the class required by the specializer:
(define (method-applies-to-classes? method classes)
(define (check-classes supplied required)
(cond ((and (null? supplied) (null? required)) true)
;;something left over, so number of arguments does not match
((or (null? supplied) (null? required)) false)
((subclass? (car supplied) (car required))
(check-classes (cdr supplied) (cdr required)))
(else false)
))
(check-classes classes (method-specializers method)))
To determine subclasses, we use the class ancestor list: class1 is a subclass of class2 if class2 is a member of the class ancestor list of class1:
(define (subclass? class1 class2)
(or (eq? class1 class2)
(memq class2 (class-ancestors class1))))
Finally, we need a way to compare two methods to see which one is ``more specific.'' We do this by looking at the method specializers. Method1 is considered to be more specific than method2 if, for each class in the list of specializers, the class for method1 is a subclass of the class for method2. (See the procedure method-more-specific? in the attached code.)
TOOL is arranged so that ordinary Scheme data objects--numbers, symbols, and so on--appear as TOOL objects. For example, any number is an instance of a predefined class called <number>, which is a class with no slots, whose superclass is <object>. The TOOL interpreter accomplishes this by having a special set of classes, called scheme-object-classes. If a TOOL object is not an ordinary instance (i.e., an instance data structure as described above), the interpreter checks whether it belongs to one of the Scheme object classes by applying an appropriate test. For example, anything that satisfies the Scheme predicate number? is considered to be an instance of <number>. See the code for details.
When the interpreter is initialized, it builds a global environment that has bindings for true, false, nil, the pre-defined classes, and the initial set of generic functions listed at the end of section 1. The driver loop is essentially the same as the driver-loop procedure in chapter 4 of the book. One cute difference is that this driver loop prints values using the TOOL generic function print. By defining new methods for print, you can change the way the interpreter prints data objects.