$ guile
guile> (load "object.scm")
guile> (define a (Object new)) ; creates an object and binds a to it
guile> (a toString) ; returns a string describing a
"an Object"

guile> (load "point.scm")
guile> (define a (Point new 1 2)) ; creates a point and binds a to it
guile> (a move 3 4) ; moves the point relative to itself
guile> (a toString) ; returns a string describing a
"a Point at 4,6"

guile> (load "rectangle.scm")
guile> (define a (Rectangle new 1 2 3 4)) ; creates a rectangle and binds a to it
guile> (a move 5 6) ; moves the rectangle relative to itself
guile> (a toString) ; returns a string describing a
"a Rectangle at 6,8 size 3,4"

Infrastructure: Object

Method names such as new are specified in the argument position of forms, i.e., these names can be bound to suitable values that can be compared easily, e.g.

; the class-method name to create new objects
(define new 'new)
; the method name to describe an object
(define toString 'toString)
; the class-method name to get the superclass
; the method name to start searching in the superclass
(define super 'super)
; the class-method name to get the class name
(define name 'name)
; the class-method name to get the class-description
; the method name to get the class
(define class 'class)
 

Classes such as Object and objects such as a are specified in the function position of forms, i.e., these names must be bound to function pointers.

; a class of objects
; usage: (Object class-method arg..)
(define Object
  (lambda (class-method . args)
    (cond
      ((eq? class-method 'super) #f)    ; no superclass
      ((eq? class-method 'name) "Object")
      ((eq? class-method 'class) Object-class)
      (else (message Object class-method nil args))))
)
 

A few method names provide access to a superclass, if any, to the class name, and to the list of methods for the class. These methods have to be defined for every new class.

The list of methods for a class is a list of lists associating a name with a function pointer:

(define Object-class
  (list
    (list new
      (lambda (null args)
        ; ... definition for Object-specific class-method new
      )
    )
    (list toString
      (lambda (this args)
        ; ... definition for Object-specific method toString
      )
    )
  )
)

message looks at a class description, i.e., at a list of method names and method implementations, and tries to invoke the appropriate method:

; an internal function to send a message
; usage: (message class method this args)
; return: result of (method this args) or unspecified
(define (message klass method this args)
  ; searches recursively in class-description
  ; and then in (class super)
  (define (send class-description method this args)
    (if (> (length class-description) 0)
      (if (eq? method (caar class-description))
        ((cadar class-description) this args)
        (send (cdr class-description) method this args)
      )
      (if (klass 'super) ; try to move up the class chain
        (message (klass 'super) method this args))
    )
  )
  (send (klass 'class) method this args) ; start with the current description
)
 

If a method name cannot be found, message recursively searches back along the superclasses to Object — this is a simple albeit inefficient implementation of inheritance.

new is sent to Object which invokes message which looks at Object-class and invokes the Object -specific function for new :

; the class-description for Object
(define Object-class
  (list
    (list 'new                  ; usage: (Object new)
      (lambda (null args)       ; returns new object
        (letrec (
          (this
            (lambda (method . args)
              (cond
                ((eq? method 'class) Object)
                (else (message Object method this args))))))
          this
        )
      )
    )
 

As stated above, an object has to be represented as a function. Most method calls are handled by invoking message , i.e., the relevant functions are looked up in Object-class . A few very specific methods, such as class which returns an object's class, can be implemented directly.

By convention a method receives a reference to the receiver object; this is a bit tricky to implement.

Most methods are much simpler to implement than new :

    (list 'toString             ; usage: (anObject toString)
      (lambda (this args)       ; returns "a[n] <class-name>"
        (let ((c (substring ((this 'class) 'name) 0 1)))
          (if (or (string-ci=? c "a") (string-ci=? c "e")
                  (string-ci=? c "i") (string-ci=? c "o"))
            (string-append "an " ((this 'class) 'name))
            (string-append "a " ((this 'class) 'name))
          )
        )
      )
    )
 

toString is a good candidate for inheritance; therefore it produces a string including the actual receiver's classname, rather then just hardcoded an Object .

State: Point

A point encapsulates cartesian coordinates and it can be moved. This requires some kind of assignment and therefore violates the spirit of Pure Lisp. However, it illustrates how simple inhertiance works for moving coordinates.

The class function for Point is very similar to Object :

; a class of points
; usage: (Point class-method arg..)
(define Point
  (lambda (class-method . args)
    (cond
      ((eq? class-method 'super) Object)
      ((eq? class-method 'name) "Point")
      ((eq? class-method 'class) Point-class)
      (else (message Point class-method nil args))))
)
 

The new method move is defined as a name:

; the method name to move a point
(define move 'move)
 

A new point is set up with x and y coordinates which are stored in a list as part of the object:

; the class-description for Point
(define Point-class
  (list
    (list 'new                  ; usage: (Point new x y)
      (lambda (null args)       ; returns new point
        (letrec (
          (data (list (car args)        ; [0] x
                      (cadr args)))     ; [1] y
          (this
            (lambda (method . args)
              (cond
                ((eq? method 'class) Point)
                ((eq? method 'data)  data)
                ((eq? method 'data!) (set! data (car args)))
                (else (message Point method this args))))))
          this
        )
      )
    )
 

A secret method 'data provides access to the list representing the state of the point, and another method 'data! can be used to replace the complete state. Alternatively, the coordinates could have been stored under individual names with access methods for each. By convention, if a Scheme function name ends in ! it indicates that a modification takes place. set! changes the value to which a name is bound.

    (list 'toString             ; usage: (aPoint toString)
      (lambda (this args)       ; returns "<super> at <x>,<y>"
        (string-append
        (this 'super Point 'toString args)
         " at "
          (number->string (get (this 'data) 0))
          ","
          (number->string (get (this 'data) 1)))
      )
    )
 
    (list 'move                 ; usage: (aPoint move dx dy)
      (lambda (this args)       ; returns this
        (let ((data (this 'data)))
          (put! data 0 (+ (get data 0) (car args)))
          (put! data 1 (+ (get data 1) (cadr args)))
        )
        this
      )
    )
  )
)
 

toString and move access the point's state using functions that treat a list as an array:

; an internal function to get an element of a list
; usage: (get list n)
; return: n'th element, counted from zero
(define (get list n)
  (if (> n 0)
    (get (cdr list) (- n 1))
    (car list)
  )
)
; an internal function to replace an element of a list
; usage: (put! list n value)
(define (put! list n value)
  (if (> n 0)
    (put! (cdr list) (- n 1) value)
    (set-car! list value)
  )
)
 

get recursively locates the n'th element of a list, which is assumed to exist. put! similarly uses set-car! to replace the value stored as n'th element.

guile> ((Point new 1 2) toString)
"a Point at 1,2"

Point 's toString uses Object 's toString to create the first part of the result:

          (this super Point toString args)

This is frequent enough so that a method super is implemented in Object :

    (list 'super                ; usage: (anObject super class method args)
      (lambda (this args)       ; returns result of (anObject method arg..)
                                ; method is searched beginning in (class super)
        (message ((car args) 'super) (cadr args) this (cddr args))
      )
    )
 

This illustrates a very important point about searching for methods (which is true for Java as well). The search for a method from the superclass does not start in the superclass of the receiving object this — it must start in the superclass of the class in which the method was last defined, i.e., Point 's toString is defined in Point and has to send this class Point as part of super so that message can be told to start searching one class above Point .

In this particular case the receiver's class is Point , so it would not matter if message were called with ((this class) super) . However, if Point 's toString is inherited by a subclass, the receiver could be from the subclass, ((this class) super) would refer to Point , and message would then recursively call the inherited method!

Simple Inheritance: Rectangle

A Point can be extended with width and height to form a movable Rectangle :

; a class of rectangles
; usage: (Rectangle class-method arg..)
(define Rectangle
  (lambda (class-method . args)
    (cond
      ((eq? class-method 'super) Point)
      ((eq? class-method 'name) "Rectangle")
      ((eq? class-method 'class) Rectangle-class)
      (else (message Rectangle class-method nil args))))
)
 
; the method name to (re)size a rectangle
(define size 'size)
 

There is more state: data starts with the x and y coordinates just as it did for Point , and then width and height are added:

; the class-description for Rectangle
(define Rectangle-class
  (list
    (list 'new                   ; usage: (Rectangle new x y wid ht)
      (lambda (null args)       ; returns new rectangle
        (letrec (
          (data (list (car args)        ; [0] x ;; like Point
                      (cadr args)       ; [1] y ;; like Point
                      (caddr args)      ; [2] wid
                      (cadddr args)))   ; [3] ht
          (this
            (lambda (method . args)
              (cond
                ((eq? method 'class) Rectangle)
                ((eq? method 'data)  data)
                ((eq? method 'data!) (set! data (car args)))
                (else (message Rectangle method this args))))))
          this
        )
      )
    )
 

move simply operates on the first two elements of data, i.e., this method is inherited from Point — Rectangle-class does not contain a definition for move ; therefore, message will search in the superclass and will find the definition of move in Point-class .

In general, simple inheritance is based on the observation that if the beginning of an object's state looks exactly alike for superclass and subclass, a superclass method can operate on a subclass state and never know the difference.

This is not true in the case of multiple inheritance: If there are several superclasses for a single subclass, the subclass state can only start with one of the superclass states. If a subclass state is to be passed to a superclass, the starting position will have to be recomputed.

Interfaces provide something like multiple inheritance in Java, but they are stateless superclasses.