Objects

Objects: data structures that protect their components

When one creates a collection of procedures that are designed to operate on data structures that share a common form, it is often convenient to observe some conventions (called invariants) associated with those structures. For example, if one is planning to use binary search on a vector, it is important for all the procedures that might modify the contents of that vector to preserve the ordering property on which the search procedure relies, by rearranging the vector's elements if necessary. Unless the vector meets the precondition that its elements are arranged in the order established by the relation that the search procedure uses, the binary search algorithm will yield incorrect answers.

However, if many programmers are working together on a large programming project, there is no way for the author of a library that contains such a data structure to enforce her decision. In our example, the predefined vector-set! procedure can be used to store any value at any position in a vector, and it does not automatically preserve the invariant that the author of the library has in mind. The procedures provided by the author of the library are suggestions, not requirements; a collaborator can always go behind those procedures to operate directly on the vector.

One of the basic ideas of the programming paradigm called object-oriented programming is to intercept such 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. To request the execution of one of these methods, one sends the object a message that names the desired method, providing any additional arguments 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.

Objects in Scheme

In Scheme, an object is implemented as a procedure that takes messages as parameters and inspects them before acting on them. The components of the data structure are defined as static variables, in a way that makes them accessible to the object but not directly to other procedures that might want to operate on them in some way that the object's designer would disapprove of.

Here's an extremely simple example -- an object named sample-box that contains only one component, contents, and responds to only one message, :show-contents.

;;; sample-box: a box with constant contents, capable of
;;; reporting its contents on command

;; Given:
;;   MESSAGE, a symbol

;; Result:
;;   CONTENTS, a value

;; Precondition:
;;   MESSAGE is the symbol :SHOW-CONTENTS.

;; Postcondition:
;;   CONTENTS is the value stored in SAMPLE-BOX's static
;;   variable.

(define sample-box
  (let ((contents (make-vector 1 42)))
    (lambda (message)
      (if (eq? message ':show-contents)
          (vector-ref contents 0)
          (error "sample-box: unrecognized message")))))

> (sample-box ':show-contents)
42
> (sample-box ':set-contents-to-zero!)
(bug) sample-box: unrecognized message
> (* contents 2)
(bug) reference to undefined identifier: contents
> (* sample-box 2)
*: expects type <number> as 1st argument, given: #<procedure:sample-box>; other arguments were: 2
> (* (sample-box ':show-contents) 2)
84

Attempts to access the contents component of sample-box without going through the approved interface fail. 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.

Note that the static variable contents is introduced in a let-expression that encloses the lambda-expression for the procedural part of the object. The idea is that, unlike a global, top-level variable, a static variable is defined only inside the body of the let-expression, so that outside procedures cannot use or modify it in ways that might break the object's invariants. On the other hand, unlike a local variable introduced by a let-expression inside the procedure body, a static variable continues to exist and can retain its value between invocations of the procedural part of the object. This pattern -- let enclosing lambda -- is the key to defining useful objects in Scheme.

One could revise the definition of the sample-box object, allowing it to accept the message :set-contents-to-zero!. Let's call an object that can accept this message as well as the :show-contents message a zeroable box:

;;; zeroable-box: a box that can report its contents on
;;; demand or replace them with 0

;; Given:
;;   MESSAGE, a symbol

;; Result:
;;   Either CONTENTS, a value, or no result.

;; Precondition:
;;   MESSAGE is either the symbol :SHOW-CONTENTS or the
;;   symbol :SET-CONTENTS-TO-ZERO!. 

;; Postconditions:
;;   (1) If MESSAGE is :SHOW-CONTENTS, then CONTENTS is the
;;       value stored in ZEROABLE-BOX's static variable.
;;   (2) If MESSAGE is :SET-CONTENTS-TO-ZERO!, then the
;;       value stored in ZEROABLE-BOX's static variable is 0.

(define zeroable-box
  (let ((contents (make-vector 1 57)))
    (lambda (message)
      (cond ((eq? message ':show-contents)
             (vector-ref contents 0))
            ((eq? message ':set-contents-to-zero!)
             (vector-set! contents 0 0))
            (else (error (string-append
                          "zeroable-box: "
                          "unrecognized message"))))))

> (zeroable-box ':show-contents)
57
> (zeroable-box ':set-contents-to-zero!)
> (zeroable-box ':show-contents)
0

Of course, there is no way for anyone to set the contents of this particular object to anything except zero, so now that the box has been zeroed its contents will remain zero forever.

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 component (a Boolean value) and responding to only two messages: :show-position, which returns the symbol on if the component contains #t and off if it contains #f, and :toggle!, which changes the component from #t to #f or from #f to #t. Here's a constructor for switches:

;;; make-switch: construct and return an object that
;;; remembers whether it is on or off and can reveal or
;;; change its state on command

;; Givens:
;;   None

;; Result:
;;   SWITCH, a unary procedure

;; Preconditions:
;;   None.

;; Postconditions:
;;   (1) SWITCH is initially off.
;;   (2) When SWITCH is invoked with the argument
;;       :SHOW-POSITION, it returns the symbol OFF if it is
;;       off and the symbol ON if it is on.
;;   (3) When SWITCH has been invoked with the argument
;;       :TOGGLE!, it is on if it was formerly off and off
;;       if it was formerly on.
;;   (4) It is an error to give SWITCH any other argument
;;       when invoking it.

(define make-switch
  (lambda ()
    (let ((state (make-vector 1 #f)))
      (lambda (message)
        (cond ((eq? message ':show-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")))))))

Now let's manufacture a couple of switches and show that they can be toggled independently:

> (define lamp-switch (make-switch))
> (define vacuum-cleaner-switch (make-switch))
> (lamp-switch ':show-position)
off
> (vacuum-cleaner-switch ':show-position)
off
> (lamp-switch ':toggle!)
> (lamp-switch ':show-position)
on
> (vacuum-cleaner-switch ':show-position)
off
> (lamp-switch ':toggle!)
> (vacuum-cleaner-switch ':toggle!)
> (lamp-switch ':show-position)
off
> (vacuum-cleaner-switch ':show-position)
on

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 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.

Methods with additional arguments

In the preceding examples, the messages received by the object have not included any additional arguments. Suppose that we want to define an object like sample-box except that one can replace the value in the contents component with any integer that is larger than the one that it currently contains, by sending it the message :raise! and including the new, larger value. We can accommodate such messages by making the object a procedure of variable arity, requiring at least one argument (the name of the method to be applied) but allowing for more:

;;; growing-box: a box with constant contents, capable of
;;; reporting its contents, or replacing them with larger
;;; values, on command

;; Givens:
;;   MESSAGE, a symbol
;;   (optionally) NEW-VALUE, an integer

;; Result:
;;   CONTENTS, a value

;; Preconditions:
;;   (1) MESSAGE is either the symbol :SHOW-CONTENTS or the
;;       symbol :RAISE!.
;;   (2) If MESSAGE is :SHOW-CONTENTS, then the NEW-VALUE
;;       argument is not provided.
;;   (3) If MESSAGE is :RAISE!, then NEW-VALUE is provided
;;       and is greater than the value stored in
;;       GROWING-BOX's static variable.

;; Postcondition:
;;   CONTENTS is the value stored in GROWING-BOX's static
;;   variable.

(define growing-box
  (let ((contents (make-vector 1 0)))
    (lambda (message . arguments)
      (cond ((eq? message ':show-contents)
             (if (null? arguments)
                 (vector-ref contents 0)
                 (error (string-append
                           "growing-box:show-contents: "
                           "no arguments are required"))))

            ((eq? message ':raise!)
             (cond ((null? arguments)
                    (error (string-append
                              "growing-box:raise!: "
                              "an argument is required")))
                   ((not (null? (cdr arguments)))
                    (error (string-append
                              "growing-box:raise!: "
                              "only one argument is "
                              "required"))) 
                   (else
                    (let ((new-value (car arguments)))
                      (cond ((not (integer? new-value))
                             (error (string-append
                                       "growing-box:raise!: "
                                       "the argument must "
                                       "be an integer"))) 
                            ((<= new-value
                                 (vector-ref contents 0))
                             (error (string-append
                                      "growing-box:raise!: "
                                      "the argument must "
                                      "exceed the current "
                                      "contents"))) 
                            (else (vector-set! contents
                                               0
                                               new-value)))))))

            (else (error (string-append
                           "growing-box:"
                           "unrecognized message"))))))

> (growing-box ':show-contents)
0
> (growing-box ':raise! 5)
> (growing-box ':show-contents)
5
> (growing-box ':raise! 3)
(bug) growing-box:raise!: the argument must exceed the current contents
> (growing-box ':show-contents)
5
> (growing-box ':raise! 'foo)
(bug) growing-box:raise!: the argument must be an integer
> (growing-box ':raise!)
(bug) growing-box:raise!: an argument is required
> (growing-box ':show-contents)
5
> (growing-box ':raise! 7)
> (growing-box ':show-contents)
7

Objects with several components

To define an object with several components, some mutable, some not, one places creates several static variables in the let-expression that encloses the object procedure and provides mutation messages for the mutable components but not for the immutable ones. For instance, here is a constructor for a kind of box that remembers its initial contents in a separate, immutable component and can restore them on demand. Each such box responds to three messages: :show-contents, :change-contents!, and :restore-initial-contents!:

;;; make-restorable-box: construct and return an object that
;;; remembers a value and can reveal or replace its
;;; contents, or restore its initial contents, on command

;; Given:
;;   INITIALIZER, a value

;; Result:
;;   RESTORABLE-BOX, a procedure

;; Preconditions:
;;   None.

;; Postconditions:
;;   (1) Initially, RESTORABLE-BOX contains INITIALIZER.
;;   (2) When RESTORABLE-BOX is invoked with the argument
;;       :SHOW-CONTENTS, it returns its current contents.
;;   (3) When RESTORABLE-BOX has been invoked with
;;       :CHANGE-CONTENTS! as its first argument and some
;;       value NEW-VALUE as its second, it contains
;;       NEW-VALUE.
;;   (4) When RESTORABLE-BOX has been invoked with the
;;       argument :RESTORE-INITIAL-CONTENTS!, it contains
;;       INITIALIZER.
;;   (5) It is an error to give RESTORABLE-BOX any other
;;       argument when invoking it, or to give it more than
;;       one argument when its first argument is
;;       :SHOW-CONTENTS or :RESTORE-INITIAL-CONTENTS!, or to
;;       give it only one argument, or more than two, when
;;       its first argument is :CHANGE-CONTENTS!.

(define make-restorable-box
  (lambda (initializer)
    (let ((contents (make-vector 1 initializer))
          (initial-contents initializer))
      (lambda (message . arguments)
        (cond ((eq? message ':show-contents)
               (if (null? arguments)
                   (vector-ref contents 0)
                   (error (string-append
                            "restorable-box:show-contents: "
                            "no arguments are required"))))

              ((eq? message ':change-contents!)
               (cond ((null? arguments)
                      (error (string-append
                               "restorable-box:change-contents!: " 
                               "an argument is required")))
                     ((not (null? (cdr arguments)))
                      (error (string-append
                               "restorable-box:change-contents!: "
                               "only one argument is "
                               "required")))
                     (else (vector-set! contents
                                        0
                                        (car arguments)))))

              ((eq? message ':restore-initial-contents!)
               (if (null? arguments)
                   (vector-set! contents 0 initial-contents)
                   (error (string-append
                            "restorable-box:restore-initial-contents!: "
                            "no arguments are required"))))

              (else
               (error (string-append
                        "restorable-box: "
                        "unrecognized message")))))))

> (define instructor-box (make-restorable-box 'Davis))
> (instructor-box ':show-contents)
Davis
> (instructor-box ':change-contents! 'Stone)
> (instructor-box ':show-contents)
Stone
> (instructor-box ':restore-initial-contents!)
> (instructor-box ':show-contents)
Davis