Coops - An introduction to chicken scheme's object system

Update: A small bug in the code has been fixed thanks to hypnocat's feedback

For this post I want to take you on a tour through chicken scheme's object system coops. It is the successor of the older and now unsupported tinyclos extension. So if you have been relying on tinyclos you should consider switching to coops.

Now I can hear some of you say: "Wait, an object system for a functional language?". Yes! Scheme is much more than a functional language, it is a multi-paradigm language meaning that you can choose the programming paradigm to fit your problem. Functional, imperative and object oriented, all is possible with scheme.

The main goal of objects is to hide (state) information from its users. You should not be concerned with the nitty gritty implementation details of a function (and not messing with it!), thus objects provide a clean interface to your program. This interface is used by sending messages in one form or another to your object. Not covered by this definition of object orientation is the notion of a 'class hierarchy and inheritance''. Languages like C++ and Java heavily rely on this paradigm. In this discussion classes are general plans of how objects will look like, while objects are the "real thing". Some people call objects instances of classes.

In scheme you can already implement objects (without classes) using a dispatching method and you may have already seen the famous bank account example by Abelson / Sussman in Structures and Interpretation of Computer Programs. If not you can look it up in section 3.1.1. Here the implementation details are hidden inside the dispatch procedure.

Java and C++ also take information hiding to the extreme. Not only the object's state is hidden behind walls but also the state manipulating code, which is called methods. What this means in practise is that you need to assign a method to an object while planning your abstractions. In most cases this works well. In others it will become a deliberate design decision where to put a particular method.

A short example: Imagine you have a class human which is inherited by a class male and female. Now as we all have an urge to reproduce where to put a method for having sex? Create a method haveSex in the human class, duplicate it in male or female? What would the argument to such a class be? What about having sex with people of the same sex, toys, animals, buildings...

Depending on your willingness to imagine all these things you will have to make a deliberate design decision here. One that will affect on how you see the world.

With scheme being a lisp you are in for a surprise: Its designers have taken a slightly different approach to object orientation: a dynamic object system centered around objects, classes and generic functions. Mostly these systems have been inspired by the Common Lisp Object System (CLOS). Coops is no exceptions. Ok, we do know what objects and classes are but what are generic functions?

First of all classes in coops look like this:

(define-class <human> () (name birthdate children))
(define-class <male> (<human>) (testosterone-level))
(define-class <female> (<human>) (estrogen-level))

By tradition class names are encapsulated in < and > to distinguish them from ordinary symbols.

As you can see coops' classes only hold on to their precious state. Methods are defined separately from their classes. So for our human example we declare a generic function called have-sex! and define the methods for each class combination we want to imagine separately!

(define-generic (have-sex! a b))

; the most common case
(define-method (have-sex! (a <male>) (b <female>))
               (let ((newborn (make <human> 'name "Bobby" 'birthdate (current-seconds) 'children '())))
                    (set! (slot-value a 'children) (cons newborn (slot-value a 'children)))
                    (set! (slot-value b 'children) (cons newborn (slot-value b 'children)))))

; all other cases (greatly simplified!)

(define-method (have-sex! (a <male>) (b <male>)) 'just-fun)
(define-method (have-sex! (a <female>) (b <female>)) 'just-fun)

; even more cases are up to your imagination....

So you can see here that we can provide sex recipes independently to the kind (and number) of participants. We could even change and extend our repertoire later should the need arise.

Now to a more theoretical example with less tendency to need parental discretion: a game. Inspired by lisp tutorials we will see how the coops object model can be used to create a small work of interactive fiction. Interactive fiction as an introduction is not a new thing: Conrad Barski has written casting SPELs in Lisp for introducing lisp in general. I want to use this example for showing you how to use coops.

Every interactive fiction work will need a player character, rooms and objects. We start modelling a player. It will have a location (which will be a room), an inventory to put objects in and a description of itself:

(define-class <player> ()
  ((description initform: "You don't see anything special")
   (location initform: '())
   (inventory initform: '())))

;; missing definition of kitchen will get placed in here

(define me (make <player>
             'description "A normal looking guy."
             'location kitchen))

As you see the class <player> does not have a super class, it has a description, location and inventory. The initform: keyword will be evaluated on instantiation of the class if no initial value is given. Fortunately me does get a description as well as a place to start, but no inventory -- it will be empty. So since the player starts in the kitchen we will add it. A room has a name which will be displayed as the current location, a longer description which the player will see the first time and upon examining the room and a list of objects in the room:

(define-class <room> ()
  ((name)
   (long-description '())
   (objects '())))

(define kitchen (make <room>
                  'name "kitchen"
                  'long-description "You are standing in the cleanest kitchen you have ever seen. A stove, sink, kitchen table and a cupboard with cups and plates fill up the small room. On the table sits an apple"
                  'objects `(,table ,apple)))

As you can see the initform: can also be omitted for primitive initialisation types (we could also place a lambda there and it will get evaluated upon instantiation). And on to objects:

(define-class <object> ()
  ((name)
   (description initform: "You don't see anything special.")
   (movable #t)
   (weight 1)
   (close-description "You don't see anything special.")))

(define-class <container> (<object>)
  ((transparent '#f)
   (status 'closed)
   (contents '())))

This is an example of inheritance: a <container> is an object which can hold other objects. And thus it has a state of openness as well as transparency. A close-description will be displayed when the player uses the examine command. So to complete the single room let's create a table and an apple:

(define table (make <object>
                'name "table"
                'description "A wooded kitchen table, very clean"
                'close-description "There seems to be a small message carved on the side"
                'movable #f))

(define apple (make <object>
                'name "apple"
                'description "A juicy looking red delicious"
                'close-description "You cannot find a wormhole, it is a spotless apple!"
                'movable #t))

So we are in the kitchen and we now want to manipulate objects of our world. The following generic functions will give us this ability:

(define-generic (describe <room>))
(define-generic (examine <object>))
(define-generic (take <object> <player>))
(define-generic (go <player> direction))
(define-generic (print-inventory <player>))
(define-generic (drop <object>))
(define-generic (carrying? <object> <player>))

These declarations tell coops to prepare internal bookkeeping for methods with these names and arity. The implementation of a specific generic function is done with the define-method macro. The object it applies to are written as a list (objname class) in an argument slot. Now let's see how we change an object's internal state:

(define-method (carrying? (o <object>) (p <player>))
  (not (null? (member o (slot-value p 'inventory)))))

(define-method (print-inventory (p <player>))
  (say "You are carrying:")
  (let ((things (slot-value p 'inventory)))
    (if (null? things) (say "\tnothing.")
        (for-each (lambda (thing) (say "\t" (slot-value thing 'name))) things))))

carrying? is a predicate that tells us if a <player> p is carrying an <object> o. The method print-inventory prints the inventory of the current player. Here you can see how an object's slots are accessed: (slot-value p 'inventory). slot-value is a generic getter for an object's slot. You can define your own getters and setters by defining them in the class definition with the accessor:, reader: and writer:.

To get an idea of our world we need to be able to get to the descriptions. Ignore the say command for now as well as the stuff about exits.

(define-method (describe (location <room>))
  (let ((location-name (slot-value location 'name)))
    (blank)
    (say (slot-value location 'long-description))
    (when (not (null? (slot-value location 'objects)))
          (blank)
          (say "You see " (fold (lambda (element seed) (string-append seed "a " (slot-value element 'name) " ")) "" (slot-value location 'objects)) "."))
    (cond ((get-exits location) =>
           (lambda (exits)
            (blank)
            (say "There are exits to")
            (for-each (lambda (e) (say "\tthe " (symbol->string (direction e)) ", leading to the " (direction-name e))) exits))))))

(define-method (examine (o <object>))
  (say (slot-value o 'close-description)))

So let's take an apple from the table. The apple is put in the player's inventory and removed from the room's object list. Dropping objects will move the object from the inventory to the current room's object list:

(define-method (take (o <object>) (p <player>))
  (let ((location (slot-value p 'location)))
    (if (not (slot-value o 'movable))
        (say "I cannot take " (slot-value o 'name))
        (begin
          (set! (slot-value p 'inventory) (cons o (slot-value p 'inventory)))
          (set! (slot-value location 'objects) (remove (lambda (obj) (eq? o obj)) (slot-value location 'objects)))
          (say "Taken.")))))

(define-method (drop (o <object>) (p <player>))
  (let ((location (slot-value p 'location)))
    (if (not (carrying? o p))
        (say "You don't have " (slot-value 'name o))
        (begin
          (set! (slot-value location 'objects) (cons o (slot-value location 'objects)))
          (set! (slot-value p 'inventory) (remove (lambda (obj) (eq? o obj)) (slot-value p 'inventory)))
          (say "Dropped " (slot-value o 'name))))))

This is only the beginning for a whole game! You can get the whole source code which includes a small "parser" and a command prompt as well as another room and a small macro connecting these and methods to move (go). I do hope you enjoyed this small tour of coops and object oriented frameworks.

Of course there are other implementations of object oriented systems for chicken scheme, namely prometheus, tinyclos.

This article has been drafted as a recipe for the CHICKEN Gazette but I was unsure of its usefulness. So it has been dumped here. Feel free to send me feedback on it!