Scheme Programming/Object Orientation

There are a number of object systems for Scheme. This chapter will take a look at different ones.

Virgo

One library for objects in R7RS is Virgo. To import it, enter this:

> (import (virgo user))

Many implementations, such as Chibi, Gauche, Guile, and Chicken, have their own CLOS-like systems, which may be substantially different in syntax but are very close to each other semantically. Virgo was chosen for portability, but the concepts will apply across implementations.

Defining a Class

This is the format for defining a class:

> (define-class <point> ()
    (x 'init-value 0.0)
    (y 'init-value 0.0))

Constructing an Object

Simply use make to create a new object, with its values initialized.

> (define pt (make <point>))

Getting and Setting

The procedures for getting and setting values are slot-ref and slot-set!, respectively.

> (slot-ref pt 'x)
0.0
> (slot-set! pt 'x 100.0)
> (slot-ref pt 'x)
100.0

Generics

Unlike Java or C#, Virgo has a CLOS-like object system meaning that methods do not belong to a single class. Rather, we define a generic and then assign methods to that generic for handing different classes. Here is an example:

> (define-generic distance)
> (define-method distance ((p <point>))
    (sqrt (+ (square (slot-ref p 'x)) (square (slot-ref p 'y)))))
> (distance pt)
100.0

Methods can also work with multiple classes. To give a nonsense example:

> (define-generic append-anything)
> (define-method append-anything ((p <point>) (s <string>))
    (string-append (number->string (slot-ref p 'x)) s))
> (append-anything pt "Hello")
"100.0Hello"

Inheritance

Virgo also features inheritance. Here is an example:

> (define-class <3point> (<point>)
    (z 'init-value 0.0))
> (define pt3 (make <3point>))
> (slot-ref pt3 'x)
0.0
> (slot-ref pt3 'z)
0.0

Prometheus

Unlike CLOS-like systems, Prometheus uses prototype-based objects instead of classes. Also, methods are tied to objects similarly to Java or C#. Furthermore, objects are not disjoint types, but rather are procedures that interpret the first argument passed to it as a method name.

If you are using an R7RS implementation and have the Prometheus library installed, you can load the library with this:

> (import (prometheus user))

Defining an Object

Defining objects is not very different from CLOS-like systems. Note that an object must inherit from another object unless it is a root object. If you do not want it to inherit from anything else, the object should inherit from *the-root-object*. Keeping our point example:

> (define-object <point> (*the-root-object*)
    (x set-x! 0.0)
    (y set-y! 0.0))

Cloning an Object

The define-object syntax is simply syntactic sugar, and you do not always need to use define-object to create a new instance. Instead you can clone an object like this, recalling that objects are just procedures:

> (define pt (<point> 'clone))

Getting and Setting

Again, getting and setting are just passing different symbols to the object.

> (pt 'x)
0.0
> (pt 'set-x! 100.0)
> (pt 'x)
100.0

Methods

Of course, objects have methods associated with them. A method is a closure with at least two arguments: self, the object being passed to the closure, and resend, which calls the behavior of a parent object. The syntactic sugar for this is define-method:

> (define-method (<point> 'distance self resend)
    (sqrt (+ (square (self 'x)) (square (self 'y)))))
> (pt 'distance)
100.0

Methods can also be defined for an object when it is defined with the define-object syntactic sugar.

> (define-object <3point> (<point>)
    (z set-z! 0.0)

    ((distance self resend)
     (sqrt (+ (square (self 'x))
              (square (self 'y))
              (square (self 'z))))))
> (define pt3 (<3point> 'clone))
> (pt3 'set-x! 3.0)
> (pt3 'set-z! 4.0)
> (pt3 'distance)
5.0

YASOS

"YASOS", or "Yet Another Scheme Object System", is a particularly simple object system for Scheme. YASOS is very similar to the object system of T, an old dialect of Scheme. Let's look at its features.

If you are using an R7RS implementation and have the YASOS library installed, you can load the library with this:

> (import (yasos))

If you have SLIB installed and loaded, you can also do this:

> (require 'yasos)

Predicates and Operations

YASOS, compared to CLOS-like systems, may feel a bit inside-out. First, we declare operations and predicates, then we create objects. Let us keep with our point example for comparison:

> (define-predicate point?)
> (define-operation (get-x p))
> (define-operation (get-y p))
> (define-operation (set-x! p value))
> (define-operation (set-y! p value))
> (define-operation (distance p))

Objects

Now that we have defined our operations for points, we will define an object that handles these operations in its methods. The syntax for objects' methods is similar to Prometheus. Rather than a built-in constructor syntax, we will just define a procedure that returns a newly constructed object.

> (define (make-point x y)
    (object
     ((point? self) #t)
     ((get-x self) x)
     ((get-y self) y)
     ((set-x! self value) (set! x value))
     ((set-y! self value) (set! y value))
     ((distance self)
      (sqrt (+ (square x) (square y))))))
> (define pt (make-point 0.0 0.0))
> (get-x pt)
0.0
> (set-x! pt 100.0)
> (get-x pt)
100.0
> (set-y! pt 100.0)
> (distance pt)
141.4213562373095

This design also means methods must be defined while constructing the object, and cannot be added after the fact.

Inheritance

YASOS uses the syntax object-with-ancestors to allow for inheritance, which will give the object characteristics of the "ancestor" or "parent" objects.

> (define-predicate point3?)
> (define-operation (get-z p))
> (define-operation (set-z! p value))
> (define (make-point3 x y z)
    (object-with-ancestors ((p (make-point x y)))
     ((point3? self) #t)
     ((get-z self) z)
     ((set-z! self value) (set! z value))
     ((distance self)
      (sqrt (+ (square x) (square y) (square z))))))
> (define pt3 (make-point3 1.0 2.0 3.0))
> (get-x pt3)
1.0
> (get-z pt3)
3.0
> (distance pt3)
3.7416573867739413