Objects in Scheme
Summary:
We consider a mechanism for grouping information together, but
limiting access to the internal representation. We refer to the
values built in this way as objects.
Representing Compound Information
In our explorations of Scheme, we've seen a number of data
structures that allow us to organize information. A list is a
dynamic data structure with a variable number of components. A vector
is a data structure with a fixed number of components, each of which
you can quickly access by number.
As you've seen, we often build data structures for a particular kind of
data. For example, in describing a circle that we might later render,
we might store four pieces of information. (There are other useful
pieces of information, but these are four that can get us started.)
0: the color of the circle;
1: a real number for the x coordinate of the center of the circle;
2: a real number for the y coordinate of the center of the circle; and
3: a real number for the radius of the circle.
We then choose whether we want to store those attributes in a list or
a vector. Suppose we want our circles to be mutable, so we store those
components in a vector, with the color at index 0, the x coordinate
at index 1, the y coordinate at index 2, and the radius at index 3.
Once we've designed a representation, we could then tell other
programmers about this representation, and let them rely on the
structure (e.g., someone who wants to change the color of a circle
would do a vector-set! at index 0).
However, suppose we change the representation (e.g., we design a
position type and decide to use that type to represent the center of
the circle). In that case other programmers must then change their
code to match the new representation, which seems time consuming and
error-prone. Hence, it is often better to provide a set of procedures
to give other programmers access to the key components of our structure.
If they use only our procedures, then we can change the representation
freely (as long as we change our procedures correspondingly) and their
code will continue to work.
Here are some sample procedures for this simple representation of a
circle.
(define make-circle
(lambda (color x-center y-center radius)
(cond
((not (color? color))
(error "make-circle: parameter 1 (color) must be a color"))
((not (real? x-center))
(error "make-circle: parameter 2 (x-center) must be real"))
((not (real? y-center))
(error "make-circle: parameter 3 (y-center) must be real"))
((or (not (real? radius)) (not (positive? radius)))
(error "make-circle: parameter 4 (radius) must be a positive real"))
(else
(vector color x-center y-center radius)))))
(define circle-get-color
(lambda (circle)
(vector-ref circle 0)))
(define circle-get-x
(lambda (circle)
(vector-ref circle 1)))
...
(define circle-set-color!
(lambda (circle newcolor)
(cond
((not (color? newcolor))
(error "circle-set-color!: parameter 2 (newcolor) must be a color"))
(else
(vector-set! circle 0 newcolor)))))
(define circle-set-center!
(lambda (circle newx newy)
(cond
((not (real? newx))
(error "circle-set-center!: parameter 2 (newx) must be real"))
((not (real? newy))
(error "circle-set-center!: parameter 3 (newy) must be real"))
(else
(vector-set! circle 1 newx)
(vector-set! circle 2 newy)))))
...
It is now possible to write new procedures that work with circles.
For example, we can render one of these circles as follows.
(define image-render-circle!
(lambda (image circle)
(let ((radius (circle-get-radius circle)))
(context-set-fgcolor! (circle-get-color circle))
(image-select-ellipse image REPLACE
(- (circle-get-x circle) radius)
(- (circle-get-y circle) radius)
(* 2 radius)
(* 2 radius))
(when (image-has-selection? image)
(image-fill-selection! image)
(image-select-nothing! image)))))
Similarly, we can compute the area of a circle with
(define circle-area
(lambda (circle)
(* pi (square (circle-radius circle)))))
If we later change the underlying representation to use a position
for the center, we'll need to change circle-get-x
and such, but we will not need to change
image-render-circle or
circle-area.
(define make-circle
(lambda (color x-center y-center radius)
(cond
((not (color? color))
(error "make-circle: parameter 1 (color) must be a color"))
((not (real? x-center))
(error "make-circle: parameter 2 (x-center) must be real"))
((not (real? y-center))
(error "make-circle: parameter 3 (y-center) must be real"))
((or (not (real? radius)) (not (positive? radius)))
(error "make-circle: parameter 4 (radius) must be a positive real"))
(else
(vector color (position-new x-center y-center) radius)))))
(define circle-get-color
(lambda (circle)
(vector-ref circle 0)))
(define circle-get-x
(lambda (circle)
(vector-ref (position-col circle 1))))
...
(define circle-set-color!
(lambda (circle newcolor)
(cond
((not (color? newcolor))
(error "circle-set-color!: parameter 2 (newcolor) must be a color"))
(else
(vector-set! circle 0 newcolor)))))
(define circle-set-center!
(lambda (circle newx newy)
(cond
((not (real? newx))
(error "circle-set-center!: parameter 2 (newx) must be real"))
((not (real? newy))
(error "circle-set-center!: parameter 3 (newy) must be real"))
(else
(vector-set! circle 1 (position-new newx newy))))))
...
If we did not want to permit other programmers to change particular parts
(e.g., we might not want client programmers to recolor circles) or to
to limit the kinds of possible access (e.g., you can set the x and y
coordinates of a turtles, but you can't determine them).
we would not provide procedures that gave that extra access.
Problems With This Technique
This technique (of providing both representation and procedures that
use that representation) has many advantages, as suggested above.
For many, the most compelling advantage is that client
code (procedures that use our student representation)
need not change when the representation changes.
Another possible advantage is that we prevent naive programmers from
doing inappropriate things to our structure (e.g., storing something
other than a color at index 0).
Unfortunately, we haven't really prevented
such inappropriate behavior, since clients can still determine the
representation we use and then modify things directly.
> (define circle0 (make-circle "blue" 0 0 10))
> (circle-set-color circle0 'red)
make-circle: parameter 1 (color) must be a color
> circle0
#("blue" 0 0 10)
> (vector-set! circle0 0 'red)
> (image-render-circle! canvas circle0)
context-set-fgcolor!: expects type <color> for 1st parameter, given red
in (context-set-fgcolor! red)
We'd like to encapsulate our implementation so
that we can hide how our circles are implemented and restrict how
they're used.
Objects: Representations that Protect Their Contents
One of the basic ideas of the programming paradigm called
object-oriented programming is to encapsulate
the data so as to intercept low-level interventions and treat them
as errors. An object is a data structure that
permits access to and modification of its elements only through a
fixed set of procedures, the object's methods.
One cannot peek inside
an object; one is limited to
the procedures provided.
To request the execution of one of these methods, one
sends the object a message
that names the desired method, providing any additional parameters that
the object will need as part of the message. Attempting to send an
object a message that does not name one of its methods simply causes
an error. The custom is to precede the message names with colons.
Objects in Scheme
The Scheme standard does not include objects. However, you can
implement an object as a procedure that takes messages as
parameters and inspects them before acting on them. Since Scheme
typically does not allow one to look inside procedures, procedures
provide an appropriate form of encapsulation.
How do we store data for use within the procedure? We can use vectors
to build the storage locations that are protected by the procedure.
Here's a simple example -- an object named sample-box that
contains only one field,contents, and responds to only one
message, ':get-contents.
;;; Value
;;; sample-box
;;; Type:
;;; object
;;; Purpose:
;;; To provide a sample "box"; something whose value you
;;; can look at but not change.
;;; Valid Messages:
;;; :get-contents
;;; Get the contents of the box.
(define sample-box
(let ((contents (vector 42)))
(lambda (message)
(cond
((eq? message ':get-contents)
(vector-ref contents 0))
(else
(error "sample-box: unrecognized message" message))))))
That is,
Build a new symbol table with the let that
contains one name-to-value mapping (that is, it maps
contents to a one-element vector that
contains 42).
Build and return a procedure that takes a message as a
parameter. Since the lambda falls within the
let, it has access to that new symbol table
and nothing else has direct access.
We can test our sample object by trying to set the contents
to 0.
> (sample-box ':get-contents)
42
> (sample-box ':set-contents-to-zero!)
sample-box: unrecognized message :set-contents-to-zero!
> (sample-box ':set-contents! 0)
sample-box: unrecognized message :set-contents!
> (vector-set! contents 0)
reference to unidentified identifier: contents
> (vector-set! sample-box 0 0)
vector-set!: expects type <mutable vector> as 1st argument, given: #<procedure:sample-box>; other arguments were: 0 0
> (sample-box ':get-contents)
42
All these attempts to modify the contents field of
sample-box fail, as will all attempts. Sending it the
message ':set-contents-to-zero! doesn't work, because
the procedure is not set up to receive such a message. And you can't
reach the actual contents variable from outside the
sample-box procedure because that identifier is bound to
the storage location that contains 42 only inside the body of the
let-expression.
In fact, we can't even see that vector (as we could with circles)
> sample-box
#<procedure:sample-box>
Changing Object Values
Of course, a value that you cannot change is not always so useful.
Hence, we
might revise the procedure so that it would accept the message
':set-contents-to-zero!:
;;; Value
;;; zeroable-box
;;; Type:
;;; object
;;; Purpose:
;;; Provides a sample "box"; something whose value you
;;; can look at and change to 0
;;; Valid Messages:
;;; :get-contents
;;; Get the contents of the box.
;;; :set-to-zero!
;;; Set the contents of the box to 0.
(define zeroable-box
(let ((contents (vector 57)))
(lambda (message)
(cond
((eq? message ':get-contents)
(vector-ref contents 0))
((eq? message ':set-contents-to-zero!)
(vector-set! contents 0 0))
(else
(error "zeroable-box: unrecognized message" message))))))
Here's a simple interaction with the box.
> (zeroable-box ':get-contents)
57
> (zeroable-box ':set-contents-to-zero!)
> (zeroable-box ':get-contents)
0
Of course, there is no way for anyone to set the contents of this
particular object to anything except zero. Now
that the box has been zeroed its contents will remain zero forever.
If we want the box to change, we might add an ':increment!
message.
;;; Value
;;; another-box
;;; Type:
;;; object
;;; Purpose:
;;; Provides a sample "box"; something whose value you
;;; can look at, set to 0, and increment
;;; Valid Messages:
;;; :get-contents
;;; Get the contents of the box.
;;; :set-to-zero!
;;; Set the contents of the box to 0.
;;; :increment!
;;; Add 1 to the contents of the box.
(define another-box
(let ((contents (vector 0)))
(lambda (message)
(cond
((eq? message ':get-contents)
(vector-ref contents 0))
((eq? message ':set-contents-to-zero!)
(vector-set! contents 0 0))
((eq? message ':increment!)
(vector-set! contents 0 (+ (vector-ref contents 0) 1)))
(else (error "zeroable-box: unrecognized message"))))))
Our interactions with this box are similar.
> (another-box ':get-contents)
0
> (another-box ':increment!)
> (another-box ':increment!)
> (another-box ':increment!)
> (another-box ':get-contents)
3
> (another-box ':set-contents-to-zero!)
> (another-box ':get-contents)
0
> (another-box ':increment!)
> (another-box ':get-contents)
1
What if we want to include a value with a message, such as when we want
to change the boxed value to a particular new value? We'll see later in
this reading.
Making Several Objects of the Same Type
In the preceding examples, we have created only one object of each type,
but it is not difficult to write a higher-order constructor procedure
that can be called repeatedly, to build and return any number of
objects of a given type. Suppose, for example, that we want to build
several switches, each of which is an object
with one field (a Boolean value) and responding to only two messages:
':get-position, which returns 'on if the
field contains #t and 'off if it contains
#f, and ':toggle!, which changes the field
from #t to #f or from #f
to #t.
We might start by building a single switch to think about the design.
(define switch
(let ((state (vector #f)))
(lambda (message)
(cond
((eq? message ':get-position)
(if (vector-ref state 0) 'on 'off))
((eq? message ':toggle!)
(vector-set! state 0 (not (vector-ref state 0))))
(else
(error "switch: unrecognized message" message))))))
However, when we want more than one, we need a procedure that builds
switches. Hence, we need to write a procedure that returns something
like the previous object. We call something that returns objects
a constructor. Here's a constructor for switches.
;;; Procedure:
;;; make-switch
;;; Parameters:
;;; [None]
;;; Purpose:
;;; Creates a new switch in the off position.
;;; Produces:
;;; newswitch, a switch
;;; Preconditions:
;;; [None]
;;; Postconditions:
;;; newswitch is an object which responds to two messages:
;;; :get-position
;;; Shows the current position ('on or 'off)
;;; :toggle!
;;; Switches the current position
(define make-switch
(lambda ()
(let ((state (vector #f))) ; All switches are off when manufactured.
(lambda (message)
(cond
((eq? message ':type)
'switch)
((eq? message ':->string)
(string-append "#<switch>("
(if (vector-ref state 0) "on" "off")
")"))
((eq? message ':get-position)
(if (vector-ref state 0) 'on 'off))
((eq? message ':toggle!)
(vector-set! state 0 (not (vector-ref state 0))))
(else
(error "#<switch>: unrecognized message" message)))))))
The ordering of lambdas and lets is important.
Because the make-switch procedure enters the
let-expression to create a new binding each time it
is invoked, each switch that is returned by make-switch
gets a separate static state variable to put its state in.
This static variable retains its contents unchanged even between calls
to the object and independently of calls to any other object of the
same type.
You'll note that we've added support for two other messages,
':type and ':->string message.
It is good practice to regularly include those two methods.
> (define overhead-lights (make-switch))
> (define board-lights (make-switch))
> (overhead-lights ':get-position)
off
> (board-lights ':get-position)
off
> (board-lights ':toggle!)
> (board-lights ':get-position)
on
> (overhead-lights ':get-position)
off
> (overhead-lights ':toggle!)
> (overhead-lights ':->string)
"#<switch>(on)"
> (overhead-lights ':type)
switch
Methods with Parameters
In all of the preceding examples, the messages received by the object have
not included any additional parameters. Suppose that we want to define an
object similar to sample-box except that one can replace the
value in the contents field with any integer that is larger
than the one that it currently contains, by giving it the message
':set-value! and including the new, larger value.
Scheme supports a special lambda syntax that permits
variable numbers of parameters. If you include a period in the
parameter list and follow it with an identifier, when the procedure
is called, all remaining arguments are packed up into a list and
associated with that identifier.
> (define param-test (lambda (message . parameters) parameters))
> (param-test 'hello)
()
> (param-test 'hello 'goodbye)
(goodbye)
> (param-test 'hello 'goodbye 1 2 3)
(goodbye 1 2 3)
> (param-test)
procedure param-test: expects at least 1 argument, given 0
As the examples suggest, this form allows us to require one parameter
(the message) and leave the remaining parameters optional. We often
use this form when supporting parameterized messages.
;;; Procedure:
;;; make-growing-box
;;; Parameters:
;;; [None]
;;; Purpose:
;;; Creates a new box whose values you can change to larger values.
;;; Produces:
;;; newbox, a box whose contents can change to larger values.
;;; Preconditions:
;;; [None]
;;; Postconditions:
;;; newbox is an object which responds to two messages:
;;; :get-value
;;; Get the contents of the box.
;;; :set-value! val
;;; Set the contents of the box to val, provided val
;;; is larger than the current contents of the box.
(define make-growing-box
(lambda ()
; Build a new vector that contains the one value
; accessed by the object.
(let ((contents (vector 0)))
; Respond to messages with additional parameters
(lambda (message . parameters)
(cond
; [type]
; Get the type
((eq? message ':type)
'growing-box)
; [:->string]
; Convert to a sting (typically for output)
((eq? message ':->string)
(string-append "#<growing-box>("
(number->string (vector-ref contents 0))
")"))
; [:get-value]
; Show the current contents of the box
((eq? message ':get-value)
(vector-ref contents 0))
; [:set-value! val]
; Replace the contents of the box with val
((eq? message ':set-value!)
(cond
; We need at least one parameter
((null? parameters)
(error "growing-box:set-value!: requires an argument"))
; But no more than one
((not (null? (cdr parameters)))
(error "growing-box:set-value!: only one argument allowed"))
(else
(let ((new-contents (car parameters)))
(cond
; That parameter needs to be an integer
((not (integer? new-contents))
(error "growing-box:set-value: "
"the argument must be an integer"))
; Precondition: The new value must be larger
((<= new-contents (vector-ref contents 0))
(error "growing-box:set-value: "
"the argument must exceed the current contents"))
(else (vector-set! contents 0 new-contents)))))))
; [OTHER MESSAGE]
; No other messages are allowed
(else
(error "#<growing-box>: unrecognized message " message))))))
> (define growable (make-growing-box))
> box
<procedure>
> (growable ':get-value)
0
> (growable ':set-value! 5)
> (growable ':get-value)
5
> (growable ':set-value! 3)
growing-box:set-value: the argument must exceed the current contents
> (growable ':get-value)
5
> (growable ':set-value! 'foo)
growing-box:set-value: the argument must be an integer
> (growable ':set-value!)
growing-box:set-value: an argument is required
> (growable ':get-value)
5
> (growable ':set-value! 7)
> (growable ':->string)
"#<growing-box>(7)"
Objects with Multiple Fields
All the objects that we've seen so far have stored only one value.
However, since we use a vector to keep track of the value, we can
certainly store more than one value in the vector. For example,
suppose we want something that keeps track of the number of times we
get the answers yes
and no
. We'll use
position 0 to keep track of the yes answers and position 1 to keep
track of the no answers.
(define make-yesno
(lambda ()
(let ((counts (vector 0 0)))
(lambda (message)
(cond
; [:type]
((eq? message ':type)
'yesno)
; [:->string]
; Convert to a string
((eq? message ':->string)
(string-append "<yesno>("
"yes:" (number->string (vector-ref counts 0))
", no:" (number->string (vector-ref counts 1))
")"))
; [:yes!]
; Increment the number of yes responses.
((eq? message ':yes!)
(vector-set! counts 0 (+ 1 (vector-ref counts 0))))
; [:no!]
; Increment the number of no responses.
((eq? message ':no!)
(vector-set! counts 1 (+ 1 (vector-ref counts 1))))
; [:report!]
; Print a report of responses.
((eq? message 'report!)
(display "Yes appeared ")
(display (vector-ref counts 0))
(display " times.")
(newline)
(display "No appeared ")
(display (vector-ref counts 1))
(display " times.")
(newline))
(else
(error "#<yesno>: unrecognized message" message)))))))
For example,
> (define yn (make-yesno))
> (yn ':yes!)
> (yn ':report!)
Yes appeared 1 times.
No appeared 0 times.
> (yn ':no!)
> (yn ':no!)
> (yn ':no!)
> (yn ':report!)
Yes appeared 1 times.
No appeared 3 times.
> (yn ':no!)
> (yn ':no!)
However, we might find it clearer to build two
vectors, one that keeps track of yes responses and one that keeps
track of no responses.
(define make-yesno
(lambda ()
(let ((yes-count (vector 0))
(no-count (vector 0)))
(lambda (message)
(cond
; [:type]
((eq? message ':type)
'yesno)
; [:->string]
; Convert to a string
((eq? message ':->string)
(string-append "<yesno>("
"yes:" (number->string (vector-ref yes-count 0))
", no:" (number->string (vector-ref no-count 0))
")"))
; [:yes!]
; Increment the number of yes responses.
((eq? message ':yes!)
(vector-set! yes-count 0 (+ 1 (vector-ref yes-count 0))))
; [:no!]
; Increment the number of no responses.
((eq? message ':no!)
(vector-set! counts 0 (+ 1 (vector-ref no-count 0))))
; [:report!]
; Print a report of responses.
((eq? message 'report!)
(display "Yes appeared ")
(display (vector-ref yes-count 0))
(display " times.")
(newline)
(display "No appeared ")
(display (vector-ref no-count 1))
(display " times.")
(newline))
(else
(error "#<yesno>: unrecognized message" message)))))))
This latter technique has the advantage of being a bit more readable -
We don't have to remember what position in the vector we've used for
what value.
Circle Objects
At the beginning of this reading, we considered one mechanism for
representing circles: a vector with associated procedures. Now
that you've seen how to build objects, we can consider how to
represent circles as objects.