#
Chapter 12
Objects and classes

A class describes a collection of objects that share behavior. The objects described by a class are called the instances of the class. The class specifies the names of the slots that the instance has, although it is up to the instance to populate these slots with particular values. The class also specifies the methods that can be applied to its instances. Slot values can be anything, but method values must be procedures.

Classes are hierarchical. Thus, a class can be a subclass of another class, which is called its superclass. A subclass not only has its own direct slots and methods, but also inherits all the slots and methods of its superclass. If a class has a slot or method that has the same name as its superclass's, then the subclass's slot or method is the one that is retained.

## 12.1 A simple object system

Let us now implement a basic object system in Scheme. We will allow only one superclass per class (single inheritance). If we don't want to specify a superclass, we will use `#t` as a ``zero'' superclass, one that has neither slots nor methods. The superclass of `#t` is deemed to be itself.

As a first approximation, it is useful to define classes using a struct called `standard-class`, with fields for the slot names, the superclass, and the methods. The first two fields we will call `slots` and `superclass` respectively. We will use two fields for methods, a `method-names` field that will hold the list of names of the class's methods, and a `method-vector` field that will hold the vector of the values of the class's methods.5 Here is the definition of the `standard-class`:

    (defstruct standard-class
      slots superclass method-names method-vector)

We can use `make-standard-class`, the maker procedure of `standard-class`, to create a new class. Eg,

    (define trivial-bike-class
      (make-standard-class
       'superclass #t
       'slots '(frame parts size)
       'method-names '()
       'method-vector #()))

This is a very simple class. More complex classes will have non-trivial superclasses and methods, which will require a lot of standard initialization that we would like to hide within the class creation process. We will therefore define a macro called `create-class` that will make the appropriate call to `make-standard-class`.

    (define-macro create-class
      (lambda (superclass slots . methods)
        `(create-class-proc
          ,superclass
          (list ,@(map (lambda (slot) `',slot) slots))
          (list ,@(map (lambda (method) `',(car method)) methods))
          (vector ,@(map (lambda (method) `,(cadr method)) methods)))))

We will defer the definition of the `create-class-proc` procedure to later.

The procedure `make-instance` creates an instance of a class by generating a fresh vector based on information enshrined in the class. The format of the instance vector is very simple: Its first element will refer to the class, and its remaining elements will be slot values. `make-instance`'s arguments are the class followed by a sequence of twosomes, where each twosome is a slot name and the value it assumes in the instance.

    (define make-instance
      (lambda (class . slot-value-twosomes)

        ;Find `n', the number of slots in `class'.
        ;Create an instance vector of length `n + 1',
        ;because we need one extra element in the instance
        ;to contain the class.

        (let* ((slotlist (standard-class.slots class))
               (n (length slotlist))
               (instance (make-vector (+ n 1))))
          (vector-set! instance 0 class)

          ;Fill each of the slots in the instance
          ;with the value as specified in the call to
          ;`make-instance'.

          (let loop ((slot-value-twosomes slot-value-twosomes))
            (if (null? slot-value-twosomes) instance
                (let ((k (list-position (car slot-value-twosomes)
                                        slotlist)))
                  (vector-set! instance (+ k 1)
                    (cadr slot-value-twosomes))
                  (loop (cddr slot-value-twosomes))))))))

Here is an example of instantiating a class:

    (define my-bike
      (make-instance trivial-bike-class
                     'frame 'cromoly
                     'size '18.5
                     'parts 'alivio))

This binds `my-bike` to the instance

    #(<trivial-bike-class> cromoly 18.5 alivio)

where `<trivial-bike-class>` is a Scheme datum (another vector) that is the value of `trivial-bike-class`, as defined above.

The procedure `class-of` returns the class of an instance:

    (define class-of
      (lambda (instance)
        (vector-ref instance 0)))

This assumes that `class-of`'s argument will be a class instance, ie, a vector whose first element points to some instantiation of the `standard-class`. We probably want to make `class-of` return an appropriate value for any kind of Scheme object we feed to it.

    (define class-of
      (lambda (x)
        (if (vector? x)
            (let ((n (vector-length x)))
              (if (>= n 1)
                  (let ((c (vector-ref x 0)))
                    (if (standard-class? c) c #t))
                  #t))
            #t)))

The class of a Scheme object that isn't created using `standard-class` is deemed to be `#t`, the zero class.

The procedures `slot-value` and `set!slot-value` access and mutate the values of a class instance:

    (define slot-value
      (lambda (instance slot)
        (let* ((class (class-of instance))
               (slot-index
                (list-position slot (standard-class.slots class))))
          (vector-ref instance (+ slot-index 1)))))

    (define set!slot-value
      (lambda (instance slot new-val)
        (let* ((class (class-of instance))
               (slot-index
                (list-position slot (standard-class.slots class))))
          (vector-set! instance (+ slot-index 1) new-val))))

We are now ready to tackle the definition of `create-class-proc`. This procedure takes a superclass, a list of slots, a list of method names, and a vector of methods and makes the appropriate call to `make-standard-class`. The only tricky part is the value to be given to the `slots` field. It can't be just the slots argument supplied via `create-class`, for a class must include the slots of its superclass as well. We must append the supplied slots to the superclass's slots, making sure that we don't have duplicate slots.

    (define create-class-proc
      (lambda (superclass slots method-names method-vector)
        (make-standard-class
         'superclass superclass
         'slots
         (let ((superclass-slots
                (if (not (eqv? superclass #t))
                    (standard-class.slots superclass)
                    '())))
           (if (null? superclass-slots) slots
               (delete-duplicates
                (append slots superclass-slots))))
         'method-names method-names
         'method-vector method-vector)))

The procedure `delete-duplicates` called on a list `s`, returns a new list that only includes the last occurrence of each element of `s`.

    (define delete-duplicates
      (lambda (s)
        (if (null? s) s
            (let ((a (car s)) (d (cdr s)))
              (if (memv a d) (delete-duplicates d)
                  (cons a (delete-duplicates d)))))))

Now to the application of methods. We invoke the method on an instance by using the procedure `send`. `send`'s arguments are the method name, followed by the instance, followed by any arguments the method has in addition to the instance itself. Since methods are stored in the instance's class instead of the instance itself, `send` will search the instance's class for the method. If the method is not found there, it is looked for in the class's superclass, and so on further up the superclass chain:

    (define send
      (lambda (method instance . args)
        (let ((proc
               (let loop ((class (class-of instance)))
                 (if (eqv? class #t) (error 'send)
                     (let ((k (list-position
                               method
                               (standard-class.method-names class))))
                       (if k
                           (vector-ref (standard-class.method-vector class) k)
                           (loop (standard-class.superclass class))))))))
          (apply proc instance args))))

We can now define some more interesting classes:

    (define bike-class
      (create-class
       #t
       (frame size parts chain tires)
       (check-fit (lambda (me inseam)
                    (let ((bike-size (slot-value me 'size))
                          (ideal-size (* inseam 3/5)))
                      (let ((diff (- bike-size ideal-size)))
                        (cond ((<= -1 diff 1) 'perfect-fit)
                              ((<= -2 diff 2) 'fits-well)
                              ((< diff -2) 'too-small)
                              ((> diff 2) 'too-big))))))))

Here, `bike-class` includes a method `check-fit`, that takes a bike and an inseam measurement and reports on the fit of the bike for a person of that inseam.

Let's redefine `my-bike`:

    (define my-bike
      (make-instance bike-class
                     'frame 'titanium ; I wish
                     'size 21
                     'parts 'ultegra
                     'chain 'sachs
                     'tires 'continental))

To check if this will fit someone with inseam 32:

    (send 'check-fit my-bike 32)

We can subclass `bike-class`.

    (define mtn-bike-class
      (create-class
        bike-class
        (suspension)
        (check-fit (lambda (me inseam)
                    (let ((bike-size (slot-value me 'size))
                          (ideal-size (- (* inseam 3/5) 2)))
                      (let ((diff (- bike-size ideal-size)))
                        (cond ((<= -2 diff 2) 'perfect-fit)
                              ((<= -4 diff 4) 'fits-well)
                              ((< diff -4) 'too-small)
                              ((> diff 4) 'too-big))))))))

`mtn-bike-class` adds a slot called `suspension` and uses a slightly different definition for the method `check-fit`.

## 12.2 Classes are instances too

It cannot have escaped the astute reader that classes themselves look like they could be the instances of some class (a metaclass, if you will). Note that all classes have some common behavior: each of them has slots, a superclass, a list of method names, and a method vector. `make-instance` looks like it could be their shared method. This suggests that we could specify this common behavior by another class (which itself should, of course, be a class instance too).

In concrete terms, we could rewrite our class implementation to itself make use of the object-oriented approach, provided we make sure we don't run into chicken-and-egg problems. In effect, we will be getting rid of the `class` struct and its attendant procedures and rely on the rest of the machinery to define classes as objects.

Let us identify `standard-class` as the class of which other classes are instances of. In particular, `standard-class` must be an instance of itself. What should `standard-class` look like?

We know `standard-class` is an instance, and we are representing instances by vectors. So it is a vector whose first element holds its class, ie, itself, and whose remaining elements are slot values. We have identified four slots that all classes must have, so `standard-class` is a 5-element vector.

    (define standard-class
      (vector 'value-of-standard-class-goes-here
              (list 'slots
                    'superclass
                    'method-names
                    'method-vector)
              #t
              '(make-instance)
              (vector make-instance)))

Note that the `standard-class` vector is incompletely filled in: the symbol `value-of-standard-class-goes-here` functions as a placeholder. Now that we have defined a `standard-class` value, we can use it to identify its own class, which is itself:

    (vector-set! standard-class 0 standard-class)

Note that we cannot rely on procedures based on the `class` struct anymore. We should replace all calls of the form

    (standard-class? x)
    (standard-class.slots c)
    (standard-class.superclass c)
    (standard-class.method-names c)
    (standard-class.method-vector c)
    (make-standard-class ...)

by

    (and (vector? x) (eqv? (vector-ref x 0) standard-class))
    (vector-ref c 1)
    (vector-ref c 2)
    (vector-ref c 3)
    (vector-ref c 4)
    (send 'make-instance standard-class ...)

## 12.3 Multiple inheritance

It is easy to modify the object system to allow classes to have more than one superclass. We redefine the `standard-class` to have a slot called `class-precedence-list` instead of `superclass`. The `class-precedence-list` of a class is the list of all its superclasses, not just the direct superclasses specified during the creation of the class with `create-class`. The name implies that the superclasses are listed in a particular order, where superclasses occurring toward the front of the list have precedence over the ones in the back of the list.

    (define standard-class
      (vector 'value-of-standard-class-goes-here
              (list 'slots 'class-precedence-list 'method-names 'method-vector)
              '()
              '(make-instance)
              (vector make-instance)))

Not only has the list of slots changed to include the new slot, but the erstwhile `superclass` slot is now `()` instead of `#t`. This is because the `class-precedence-list` of `standard-class` must be a list. We could have had its value be `(#t)`, but we will not mention the zero class since it is in every class's `class-precedence-list`.

The `create-class` macro has to modified to accept a list of direct superclasses instead of a solitary superclass:

    (define-macro create-class
      (lambda (direct-superclasses slots . methods)
        `(create-class-proc
          (list ,@(map (lambda (su) `,su) direct-superclasses))
          (list ,@(map (lambda (slot) `',slot) slots))
          (list ,@(map (lambda (method) `',(car method)) methods))
          (vector ,@(map (lambda (method) `,(cadr method)) methods))
          )))

The `create-class-proc` must calculate the class precedence list from the supplied direct superclasses, and the slot list from the class precedence list:

    (define create-class-proc
      (lambda (direct-superclasses slots method-names method-vector)
        (let ((class-precedence-list
               (delete-duplicates
                (append-map
                 (lambda (c) (vector-ref c 2))
                 direct-superclasses))))
          (send 'make-instance standard-class
                'class-precedence-list class-precedence-list
                'slots
                (delete-duplicates
                 (append slots (append-map
                                (lambda (c) (vector-ref c 1))
                                class-precedence-list)))
                'method-names method-names
                'method-vector method-vector))))

The procedure `append-map` is a composition of `append` and `map`:

    (define append-map
      (lambda (f s)
        (let loop ((s s))
          (if (null? s) '()
              (append (f (car s))
                      (loop (cdr s)))))))

The procedure `send` has to search through the class precedence list left to right when it hunts for a method.

    (define send
      (lambda (method-name instance . args)
        (let ((proc
               (let ((class (class-of instance)))
                 (if (eqv? class #t) (error 'send)
                     (let loop ((class class)
                                (superclasses (vector-ref class 2)))
                       (let ((k (list-position
                                 method-name
                                 (vector-ref class 3))))
                         (cond (k (vector-ref
                                   (vector-ref class 4) k))
                               ((null? superclasses) (error 'send))
                               (else (loop (car superclasses)
                                           (cdr superclasses))))
                         ))))))
          (apply proc instance args))))

5 We could in theory define methods also as slots (whose values happen to be procedures), but there is a good reason not to. The instances of a class share methods but in general differ in their slot values. In other words, methods can be included in the class definition and don't have to be allocated per instance as slots have to be.