Objects are a useful tool for directly representing real-world entities that have state. The designers of Simula 67 realized this, but since then much hype has arisen around object-oriented programming. Programmers have tried to apply object-oriented programming to all sorts of problems, and language designers have built languages in which objects provide the only means of encapsulation and abstraction. But many abstractions used in programming do not have state (eg. environment, abstract syntax trees), and representing them as objects can make programming more difficult and programs less abstract. In short, use objects for what they were intended for: modelling entities that have state.
(define p1 (let ((x 0) (y 0)) (lambda (msg) (case msg (Draw (lambda () (pixel x y 'white))) (Getx (lambda () x)) (Gety (lambda () y)) (Move (lambda (nx ny) (set! x nx) (set! y ny)))))))The point
p1
is represented as a procedure (lambda (msg) ...)
that takes a message requesting that one of its encapsulated procedures be
run. These encapsulated procedures are called methods.
The encapsulated state is stored in the instance variables named
x, y
.
To make method invocation more convenient, let's define some syntax:
(extend-syntax (send) ((send obj msg arg ...) ((obj (quote msg)) arg ...)))Suppose you would like to have several different points. Abstracting over the definition of
p1
gives us a procedure that constructs
points. We call this a class:
(define point (lambda () (let ((x 0) (y 0)) (lambda (msg) (case msg (Draw (lambda () (pixel x y 'white))) (Getx (lambda () x)) (Gety (lambda () y)) (Move (lambda (nx ny) (set! x nx) (set! y ny))))))))Let's add an initialization method to our
point
class that
causes the point to be drawn on the screen. This method will be:
(Initialize (lambda () (send ? Draw)))Initialize needs to send a message to the current point to cause it to draw itself. In order to provide a means for this message send to refer to the current point, we add an argument called
this
:
(define point (lambda () (let ((x 0) (y 0)) (lambda (msg this) (case msg (Initialize (lambda () (send this Draw))) (Draw (lambda () (pixel x y 'white))) (Getx (lambda () x)) (Gety (lambda () y)) (Move (lambda (nx ny) (set! x nx) (set! y ny))))))))Of course, we have to send messages a bit differently:
(extend-syntax (send) ((send obj msg arg ...) (let ((o obj)) ((o (quote msg) o) arg ...))))Now methods of an object can recursively refer to other methods of the object.
Suppose we would like each point to have a unique identifying
number. Then we need to add another instance variable to remember
the object's identifer, and also a counter outside the object to remember
the next number to hand out.
We'll also add an Id
method so that client code can
determine the identifier of an object:
(define point (let ((nextid 0)) (lambda () (let ((x 0) (y 0) (id #f)) (lambda (msg this) (case msg (Initialize (lambda () (set! nextid (+ 1 nextid)) (set! id nextid) (send this Draw))) (Id (lambda () id)) ...The variable
nextid
is called a class variable
since it belongs to the point class, but is shared over all objects
of that class.
Let's make class declaration more convenient:
(extend-syntax (class) ((class ((cx cxv) ...) ; class variables and initial values ((ix ixv) ...) ; instance variables and initial values ((method mbody) ...)) ; methods (let ((cx cxv) ...) (lambda () (let ((ix ixv) ...) (lambda (msg this) (case msg (method mbody) ... (else (error "message not understood")))))))))(Caution: the above macro does not treat variable capture correctly. The variable "this" should be captured by method bodies, but not the variable "msg".) We might also make a procedure for building new objects, and have it also initialize the object:
(define new (lambda (class) (let ((o (class))) (send o Initialize) o)))Now we can define and use our point class conveniently:
(define point (class ((nextid 0)) ((x 0) (y 0) (id #f)) ((Initialize (lambda () ...)) (Draw (lambda () (pixel x y 'white))) (Getx (lambda () x)) (Gety (lambda () y)) (Move (lambda (nx ny) (set! x nx) (set! y ny)))))) (define p1 (new point)) (send p1 Move 10 10) (send p1 Draw) (send p1 Move (+ (send Getx p1) 10) (send Gety p1))
color-point
has an instance variable containing
its color, and an instance variable containing a point.
As a color-point
receives messages, it dispatches
on them, and sends any it doesn't understand to the point.
(define color-point (let () ; no class vars (lambda () (let ((pt #f) (color 'white)) (lambda (msg this) (case msg (Initialize (lambda () (set! pt (new point)))) (Setcolor (lambda (c) (set! color c))) (Draw (lambda () (pixel (send pt Getx) (send pt Gety) color))) (else (send pt msg))))))))The class
color-point
extends point
with the new method Setcolor
.
Class color-point
overrides the
Draw
method of point
, since colored points
must be drawn differently.
Finally, any other messages send to a color-point
are delegated to point
.
Delegation is a powerful and flexible facility. But it is difficult to compile to efficient object code, and doesn't fit so well with type systems. To rectify these problems, we'll look at a more structured facility called inheritance.
class, new,
and send
to our interpreter. The abstract syntax for these operations follows:
(define-record Class (class-binds inst-binds methods)) ; class-binds is a list of (symbol expr) ; inst-binds is a list of (symbol expr) ; methods is a list of (symbol symbol-list expr) ; where symbol is the method name, ; symbol-list is the method's argument names ; expr is the method body (define-record New (class)) (define-record Send (obj msg args))The evaluator for simple classes and objects (no delegation) is:
(define eval (lambda (e env) (variant-case e ... (Class (class-binds inst-binds methods) (let ((class-env (extend-list env (firsts class-binds) (map (lambda (e) (eval e env)) (seconds class-binds))))) (make-Class inst-binds methods class-env))) (New (class) (variant-case (eval class env) (Class (inst-binds methods class-env) (let ((obj-env (extend-list class-env (firsts inst-binds) (map (lambda (e) (eval e env)) (seconds inst-binds)))) (meth-env (extend-list empty-env (firsts methods) (map cdr methods)))) (make-Object obj-env meth-env))))) (Send (obj msg args) (let* ((o (eval obj env)) (vargs (map (lambda (e) (eval e env)) args))) (variant-case o (Object (obj-env meth-env) (let ((m (lookup meth-env msg))) (if m (eval (cadr m) (extend-list obj-env (cons 'this (car m)) (cons o vargs))) (error "no such method")))))))