1. Records and Object Orientation
    1. define-record-type
    2. define-record-printer
    3. define-reader-ctor
    4. The records egg
    5. srfi-99
      1. Type extension
      2. Record properties and object orientation
      3. Rects revisited
      4. Variant records and object orientation
      5. The datatype egg
    6. Epilogue
  2. Last update
  3. Author

Records and Object Orientation

Records are the feature most painfully missed in R5RS. Consequently Chicken supplied define-record in the special-forms unit. It is easy to use, but personally I don't like it because it does too much behind the scene. For example, the following call

(define-record rect x y w h)

creates automatically ten procedures

for each slot, x, y, w, h

This is convenient, but since these procedures are never defined explicitly, you might have problems understanding code, where their use is far away from the call to define-record. Moreover, you are missing the flexibility to choose your own names for these procedures, and -- which is more important -- you can't make individual slots read-only.

define-record-type

All these problems are avoided using srfi-9's define-record-type, also supplied by CHICKEN in the chicken.base module. The following call will do exactly the same as the define-record call above, but now all names are explicit, hence can be chosen by yourself and the modifiers can be omitted at all, thus providing read-only slots.

(define-record-type rect
  (make-rect x y w h)
  rect?
  (x rect-x rect-x-set!)
  (y rect-y rect-y-set!)
  (w rect-w rect-w-set!)
  (h rect-h rect-h-set!)
)

You can also save some procedure identifiers by replacing e.g. rect-x-set! with (setter rect-x). Then you can mutate the x slot in the srfi-17 way by (set! (rect-x rt) new-slot).

define-record-printer

Both define-record and define-record-type can be used in combination with define-record-printer from the chicken.base module, thus allowing records to be printed in a readable form. Without it, a rect instance is simply printed #<rect>, which is not very descriptive. But having written

(define-record-printer (rect rt out)
  (fprintf out "#,(rect ~s ~s ~s ~s)"
  (rect-x rt) (rect-y rt) (rect-w rt) (rect-h rt)))

(make-rect 0 0 1 2) will print #,(rect 0 0 1 2) instead of #<rect>.

define-reader-ctor

Now you can turn things around and read a rect instance written in the form printed above via

 (define rt '#,(rect 0 0 1 2))

provided you have used srfi-10's define-reader-ctor, supplied by CHICKEN's chicken.read-syntax module via

 (define-reader-ctor 'rect make-rect)

The records egg

Up to now, you have used a syntactic interface to rects. There is a procedural one as well, provided by the records. Now I can reduce the number of identifiers by packaging accessors and modifiers with srfi-17's getter-with-setter, so that set! can work on accessor expressions. But note that define-record-printer is used a bit different than the above, because you must use the name of the record-type, not the record-type-descriptor.

(use records)
(define RECT (make-record-type 'rect '(x y w h)))
(define Rect (record-constructor RECT))
(define rect? (record-predicate RECT))
(define rect-x (getter-with-setter (record-accessor RECT 'x)
                                   (record-mutator RECT 'x)))
(define rect-y (getter-with-setter (record-accessor RECT 'y)
                                   (record-mutator RECT 'y)))
(define rect-w (getter-with-setter (record-accessor RECT 'w)
                                   (record-mutator RECT 'w)))
(define rect-h (getter-with-setter (record-accessor RECT 'h)
                                   (record-mutator RECT 'h)))
(define-record-printer ('rect rt out) ; note 'rect, not RECT
  (fprintf out "#,(rect ~s ~s ~s ~s)"
    (rect-x rt) (rect-y rt) (rect-w rt) (rect-h rt)))

Now with (define rt (Rect 0 0 1 2)), rt will print #,(rect 0 0 1 2), (rect-x rt) will print 0 and after (set! (rect-x rt) 10) it will print 10.

Henceforth, record-type descriptors will be written all uppercase, and the corresponding constructor starting uppercase.

srfi-99

CHICKENS's implementation of srfi-99, written by Thomas Chust, combines both interfaces, the syntactic and the procedural one, so that they can be used interchangeably, and it provides its own version of define-record-printer.

This one module comprises srfi-99-variants and srfi-99-records, the latter in turn comprising submodules srfi-99-records-procedural, srfi-99-records-inspection and srfi-99-records-syntactic, the former being an extension to the srfi-99 document. As that document postulates, CHICKENS's srfi-99 records not only implement type extension in the form of single inheritance, but also all optional extensions, the srfi-document mentions: opaque, sealed and non-generative records.

And that's not all. Thomas' implementation includes record-properties, which can be attached to record-type-descriptors -- henceforth abbreviated rtd's -- and which can be used to implement single inheritance object orientation.

Type extension

From now on, we assume srfi-99 is used.

Let's start with specializing a rectangle to a square in the procedural interface. First rects.

(define RECT (make-rtd 'rect
               '#((mutable x) (mutable y) (mutable w) (mutable h))))
(define Rect (rtd-constructor RECT))
(define rect? (rtd-predicate RECT))
(define rect-x (rtd-accessor RECT 'x))
(define rect-y (rtd-accessor RECT 'y))
(define rect-w (rtd-accessor RECT 'w))
(define rect-h (rtd-accessor RECT 'h))

Apart from name-changes, you'll notice, that the fields are now referenced in a vector instead of a list and they are tagged as mutable. Alternatively, you could have tagged them with immutable. Short forms of, e.g. (mutable x) or (immutable y) are accepted as well, namely (x) or y respectively, but I strongly recommend, not to use them: It's all to easy to write x when you mean (x) and later wonder, why a setter doesn't work, although you have explicitly supplied a correct one. Another change is, that explicit mutators via getter-with-setter are missing; they are automatically provided by the srfi-99 library, so something like (set! (rect-x rt) 10) would work as expected, provided the field x is tagged as mutable. The name-changes of srfi-99 with the rtd abbreviations, untypical for Scheme, are caused not to conflict with R6RS-records.

But the fun begins now, specializing rects to squares.

(define SQUARE (make-rtd 'square '#() #:parent RECT))
(define (Square x y l)
  ((rtd-constructor SQUARE) x y l l))
(define (square? rt)
  (and ((rtd-predicate SQUARE) rt) (= (rect-w rt) (rect-h rt))))

Note, that the slot vector is empty. There are no new slots. But the constructor and the predicate need to be corrected to reflect the spezialization. A raw rtd-constructor of a child rtd accepts the parent's and the child's slots in this order as arguments.

Now, every square is a rectangle, but not every rectangle a square! Note, that albeit the rtd SQUARE doesn't provide any accessors, they are inherited from rtd RECT. But the names rect-x etc. are a bit foreign to a square. That's where dynamic binding and object orientation comes into the play ...

Record properties and object orientation

The above is fine, but there is a serious drawback: The accessors are statically bound. So we had to prefix the slot-names with the rtd-name to avoid name clashes, forcing the user of these records to remember in which hierarchy-level the accessors were defined; a real problem, if the hierarchy is deep. We would prefer to have them dynamically bound and given them names like x, y, w and h, the actual routine being looked up by the system. That's exactly what record-properties provide.

First we have to define, for each method to be implemented, in particular for the slots, record-properties, e.g. (define-record-property x).

This defines procedures of at least one argument, which will eventually be applied to records, which have corresponding procedures bound to its record-type-descriptor. Before this happens, these properties will allways return the default value #f independently of its argument; try this by issuing (x #t) or (x #t #t #t). If you want another value to be returned, you must supply it as a second argument to define-record-property. This second argument is returned via CHICKEN's constantly procedure. But you should be aware, that symbols as second argument to record-properties are treated specially: inside rtd's they refer to accessors of equally named fields.

To bind properties to record-type-descriptors, you'll use the #:property clause of make-rtd. Note, that after their implementation in the rtd, the properties will be more or less dynamically bound versions of the statically bound accessors like rect-x and the corresponding mutators. The accessors are simply referenced by their names as a symbol, while the mutators must be curried.

(define-record-property x)
(define-record-property y)
(define-record-property w)
(define-record-property h)
(define-record-property x!)
(define-record-property y!)
(define-record-property w!)
(define-record-property h!)

(define RECT
  (make-rtd 'rect '#((mutable x) (mutable y) (mutable w) (mutable h))
            #:property x 'x
            #:property x!
            (lambda (rt)
              (lambda (a)
                (set! (x rt) a)))
            #:property y 'y
            #:property y!
            (lambda (rt)
              (lambda (b)
                (set! (y rt) b)))
            #:property w 'w
            #:property w!
            (lambda (rt)
              (lambda (b)
                (set! (w rt) b)))
            #:property h 'h
            #:property h!
            (lambda (rt)
              (lambda (b)
                (set! (h rt) b)))
            ))
(define Rect (rtd-constructor RECT))
(define rect? (rtd-predicate RECT))

;; now squares as speciealized rects
(define-record-property l)
(define-record-property l!)

(define SQUARE
  (make-rtd 'square '#()
            #:parent RECT
            #:property l w
            #:property l!
            (lambda (rt)
               (lambda (c)
                (set! (w rt) c)
                (set! (h rt) c)))
            ))

(define (Square x y l)
  ((rtd-constructor SQUARE) x y l l))

(define (square? rt)
  (and ((rtd-predicate SQUARE) rt) (= (rect-w rt) (rect-h rt))))

Now x, x! and friends are dynamically bound. They are called like (x rt) and ((x! rt) a). If there where other records with properties x and x! bound to its type, always the right accessor or mutator would be chosen. To see this, let's enhance the example, so that it's more realistic. In doing this, we'll package the types in modules.

Rects revisited

Realistic rects should always have numeric fields, and they should be movable and scalable. An area method would be nice as well. Moreover, they should always be in a valid state. In other words, we would like to have an invariant property, which checks the validity of an object's state, automatic documentation and properties move!, scale! and area.

Since invariant and automatic documentation should be available everywhere, we package corresponding properties in an abstract base type, OBJECT, to be overridden in any of its children. Abstract types don't have constructors.

(module objects *
  (import scheme
          (only data-structures sort)
          (only srfi-99
                define-record-property
                make-rtd
                rtd-predicate
                record?))

(define-record-property invariant)
(define-record-property property-names)

(define OBJECT
        (make-rtd 'object '#()
          #:property invariant #t
          #:property property-names
          (lambda (obj)
            (sort-symbols
              '(invariant property-names)))
          ))
(define object? (rtd-predicate OBJECT))

(define (sort-symbols symlist)
  (sort symlist (lambda (x y)
                  (string-ci<=? (symbol->string x)
                                (symbol->string y)))))
) ; objects

To test, that invariant works indeed everywhere, we'll use a fake module using the syntactic interface:

(module foos (FOO Foo foo? invariant)
  (import scheme objects
          (only srfi-99 define-record-type define-record-property))
;;; a different inheritance branch
(define-record-type (FOO #:parent OBJECT #:property invariant "foo") (Foo) foo?)
) ; foos

Now the implementation of rectangles ...

(module rects (RECT Rect rect? x x! y y! w w! h h! move! scale! area)
  (import scheme objects
          (only (chicken base) error define-reader-ctor)
          (only (chicken format) fprintf)
          (only srfi-99 define-record-printer define-record-property
                make-rtd rtd-constructor rtd-predicate))
  (reexport objects)

;; new properties
(define-record-property x)
(define-record-property x!)
(define-record-property y)
(define-record-property y!)
(define-record-property w)
(define-record-property w!)
(define-record-property h)
(define-record-property h!)
(define-record-property area)
(define-record-property move!)
(define-record-property scale!)

;;; rtd, denoted all upper case
(define RECT
  (make-rtd 'rect '#((mutable x) (mutable y) (mutable w) (mutable h))
            #:parent OBJECT
            #:property invariant
            (lambda (rt)
              (if (and (number? (x rt))
                       (number? (y rt))
                       (number? (w rt))
                       (number? (h rt))
                       (>= (w rt) 0)
                       (>= (h rt) 0))
                '(and (number? (x rt))
                      (number? (y rt))
                      (number? (w rt))
                      (number? (h rt))
                      (>= (w rt) 0)
                      (>= (h rt) 0))
                #f))
            #:property property-names
            (lambda (rt)
              (sort-symbols
                (append '(area scale! move! x x! y y! w w! h h!)
                        (property-names rt OBJECT))))
            #:property area
            (lambda (rt) (* (w rt) (h rt)))
            #:property move!
            (lambda (rt)
              (lambda (dx dy)
                ((x! rt) (+ (x rt) dx))
                ((y! rt) (+ (y rt) dy))))
            #:property scale!
            (lambda (rt)
              (lambda (s)
                (cond
                  ((and (number? s) (>= s 0))
                   ((w! rt) (* s (w rt)))
                   ((h! rt) (* s (h rt))))
                  (else
                    (error 'scale! "positive number expected" s)))))
            #:property x 'x
            #:property x!
            (lambda (rt)
              (lambda (a)
                (if (number? a)
                  (set! (x rt) a)
                  (error 'x! "number expected" a))))
            #:property y 'y
            #:property y!
            (lambda (rt)
              (lambda (b)
                (if (number? b)
                  (set! (y rt) b)
                  (error 'y! "number eypected" b))))
            #:property w 'w
            #:property w!
            (lambda (rt)
              (lambda (a)
                (if (number? a)
                  (set! (w rt) a)
                  (error 'w! "number expected" a))))
            #:property h 'h
            #:property h!
            (lambda (rt)
              (lambda (a)
                (if (number? a)
                  (set! (h rt) a)
                  (error 'h! "number expected" a))))
            ))

;; constructor, denoted with leading upper case
(define (Rect a b c d)
  (let ((result ((rtd-constructor RECT) a b c d)))
    (if (invariant result)
      result
      (error 'Rect "invariant broken"))))
;; predicate
(define (rect? arg)
  (and ((rtd-predicate RECT) arg)
       (if (invariant arg) #t #f)))

;; printer
(define-record-printer (RECT rt out)
  (fprintf out "#,(rect ~s ~s ~s ~s)"
               (x rt) (y rt) (w rt) (h rt))) 

;; reader
(define-reader-ctor 'rect Rect)

) ; rects

... and of squares:

(module squares (SQUARE Square square? l l!)
  (import scheme
          rects
          (only (chicken base) error define-reader-ctor)
          (only (chicken format) fprintf)
          (only srfi-99 define-record-printer define-record-property
                make-rtd rtd-constructor rtd-predicate))
  (reexport rects)

(define-record-property l)
(define-record-property l!)

;;; type extension, aka inheritance
(define SQUARE
  (make-rtd 'square '#()
            #:parent RECT
            #:property invariant
            (lambda (rt)
              (if (and (invariant rt RECT)
                       (= (w rt) (h rt)))
                '(and (invariant rt RECT)
                      (= (w rt) (h rt)))
                #f))
            #:property property-names
            (lambda (rt)
              (sort-symbols
                (append '(l l!)
                        (property-names rt RECT))))
            #:property l w
            #:property l!
            (lambda (rt)
              (lambda (c)
                (set! (w rt) c)
                (set! (h rt) c)))
            ))

;; constructor, denoted with leading upper case
(define (Square x y l)
  (let ((result ((rtd-constructor SQUARE) x y l l)))
    (if (invariant result)
      result
      (error 'Square "invariant broken"))))
;; predicate
(define (square? arg)
  (and ((rtd-predicate SQUARE) arg)
       (invariant arg)))
;; printer
(define-record-printer (SQUARE rt out)
  (fprintf out "#,(square ~s ~s ~s)" (x rt) (y rt) (l rt))) 

;; reader
(define-reader-ctor 'square Square)

) ; squares

Interesting is, how invariant and property-names are overridden in the subtpye SQUARE. To access the parent versions, simply add the supertype RECT as a second argument to the property. Another interesting point is the constructor Square. You can't simply call (Rect x y l l). This would create a RECT, not a SQUARE. But the latter has four slots, not three. So you must call ((rtd-constructor SQUARE) x y l l) and check the invariant. Note in passing that child constructors always expect the parent slots before the child slots. The latter don't exist in the present case. Note also, that property l is simply equivalent to property w, but l! isn't equivalent to w!. And last, but not least, properties move!, scale! and area needn't be redefined in SQUARE, the parent versions do the job.

Now you can test your objects as well as some inspectors, issuing e.g.

(import foos squares
        (only srfi-99 rtd? record? rtd-name rtd-uid rtd-parent
              rtd-field-names rtd-all-field-names))
(rtd? SQUARE)
(rtd-name (rtd-parent SQUARE))
(rtd-field-names SQUARE)
(rtd-all-field-names SQUARE)
(rtd-uid RECT)
(rtd-field-names RECT)
(define sq (Square 1 2 3))
(define rt (Rect 0 0 1 2))
(object? sq)
(record? rt)
(invariant sq)
(invariant rt)
(type-name rt)
(parent-type-name sq)
(define foo (Foo))
(rect? foo)
(foo? foo)
(invariant foo)
(square? sq)
(rect? sq)
(square? rt)
(x sq)
(y sq)
(l sq)
(x rt)
(y rt)
(w rt)
(h rt)
((move! sq) 10 20)
(invariant sq)
(x sq)
(y sq)
(l sq)
((x! sq) 0)
((y! sq) 0)
((l! sq) 5)
(invariant sq)
rt
sq

Variant records and object orientation

Above, we've implemented methods as record-properties, Thomas Chust's extension to srfi-99 records. This way, the record alone encapsulates data and properties. But there is another pattern to implement object orientation with srfi-99 records, taking the message-sending metaphor literally. In this pattern, the record has only one record-property, a message handler, which accepts messages as arguments and discriminates between them according to their type. And messages can conveniently be implemented as variant records, another of Thomas' extensions to srfi-99 records.

In this pattern, instead of calling the property move! as above,

((move! sq) 10 20),

a move! message is send to sq's only property, its handler, as follows

((handle sq) (move! 10 20))

Whereas in the method-properties pattern, encapsulation is achieved by the record, in the message-sending pattern, the module does the encapsulation job. This means, equally named methods are discriminated by the record instance, equally named messages need to be renamed or prefixed.

In essence, variant records supply two macros,

the former defining a series of constructors, the latter discriminating between them in a case like fashion. Our old friends, objects, rects and squares can now be implemented as follows.

;; abstract root object
(module objects (OBJECT handle OBJECT-MESSAGE object-message? invariant messages)
  (import scheme
          (only (chicken base) constantly error)
          (only srfi-99
                define-record-property
                make-rtd
                rtd-predicate
                record?
                record-rtd
                rtd-name
                rtd-parent
                define-variant-type
                variant-case))
  
(define-record-property handle) ; the only property

;; message constructors
(define-variant-type OBJECT-MESSAGE object-message?
  (invariant)
  (messages))

(define OBJECT
  (make-rtd 'object '#()
            #:property handle
            (lambda (obj)
              (lambda (msg)
                (if (object-message? msg)
                  (variant-case OBJECT-MESSAGE msg
                    ((invariant) #t)
                    ((messages) '((#:OBJECT (invariant) (messages)))))
                  ;do nothing (enabling broadcasts)
                  )))))

(define object? (rtd-predicate OBJECT))

) ; objects

Note, how the messages are defined and set apart. Besides the message type and predicate two parameterless constructors, invariant and messages, are defined and exported by the module. The exported handle property then inspects -- using variant-case -- the message constructors in sequence and invokes the code of the first matching one, after having checked, that msg is indeed of type OBJECT-MESSAGE, invoking the else clause otherwise. Here, the else clause does nothing on purpose: Message handling can be used for broadcasting. Hence, if a message is not understood, nothing happens.

Here, these constructors are parameterless, but as we'll see in the sequel, variant-case not only serves as a discriminator, but also as an accessor to the constructors' arguments, without need to define accessor procedures.

Here's the new version of the rects module:

(module rects (RECT Rect rect? RECT-MESSAGE rect-message? x x! y y! w w!
               h h! move! scale! area)
  (import scheme objects
          (only (chicken base) constantly error void define-reader-ctor)
          (only (chicken format) fprintf)
          (only srfi-99 define-record-printer define-record-property
                define-variant-type variant-case
                make-rtd rtd-constructor rtd-predicate rtd-accessor))
  (reexport objects)

;; new messages
(define-variant-type RECT-MESSAGE rect-message?
  (x)
  (x! arg)
  (y)
  (y! arg)
  (w)
  (w! arg)
  (h)
  (h! arg)
  (move! dx dy)
  (scale! s)
  (area))

;;; message-handler
(define (rect-handler obj)
  (lambda (msg)
    (cond
      ((rect-message? msg)
       (variant-case RECT-MESSAGE msg
         ((x) (%x obj))
         ((x! arg) (set! (%x obj) arg))
         ((y) (%y obj))
         ((y! arg) (set! (%y obj) arg))
         ((w) (%w obj))
         ((w! arg) (set! (%w obj) arg))
         ((h) (%h obj))
         ((h! arg) (set! (%h obj) arg))
         ((move! dx dy)
          (set! (%x obj) (+ (%x obj) dx)) 
          (set! (%y obj) (+ (%y obj) dy)))
         ((scale! s)
          (set! (%w obj) (* (%w obj) s)) 
          (set! (%h obj) (* (%h obj) s)))
         ((area) (* (%w obj) (%h obj)))))
      ((object-message? msg)
       (variant-case OBJECT-MESSAGE msg
        ((invariant)
         (if (and (number? (%x obj)) (number? (%y obj))
                  (number? (%w obj)) (number? (%h obj))
                  (>= (%w obj) 0) (>= (%h obj) 0))
           '(and (number? (%x obj)) (number? (%y obj))
                 (number? (%w obj)) (number? (%h obj))
                 (>= (%w obj) 0) (>= (%h obj) 0))
           #f))
         ((messages)
          (cons '(#:RECT (x) (x! arg) (y) (y! arg) (w) (w! arg)
                         (h) (h!  arg) (move! dx dy) (scale! s) (area))
                ((handle obj OBJECT) (messages))))))
      (else
        ((handle obj OBJECT) msg)))))

;;; rtd, denoted all upper case
(define RECT
  (make-rtd 'rect '#((mutable x) (mutable y) (mutable w) (mutable h))
            #:parent OBJECT
            #:property handle rect-handler
            ))

;; constructor, denoted with leading upper case
(define (Rect a b c d)
  (let ((result ((rtd-constructor RECT) a b c d)))
    (if ((handle result) (invariant))
      result
      (error 'Rect "invariant broken"))))

;; predicate
(define (rect? arg)
  (and ((rtd-predicate RECT) arg)
       ((handle arg) (invariant))))

;; printer
(define-record-printer (RECT rt out)
  (fprintf out "#,(rect ~s ~s ~s ~s)"
                ((handle rt) (x)) ((handle rt) (y))
                ((handle rt) (w)) ((handle rt) (h))))

;; reader
(define-reader-ctor 'rect Rect)

;;hidden
(define %x (rtd-accessor RECT 'x))
(define %y (rtd-accessor RECT 'y))
(define %w (rtd-accessor RECT 'w))
(define %h (rtd-accessor RECT 'h))

) ; rects

The interesting thing here is, that of course, the handler can be defined outside of the record RECT and only be referenced inside. The variant-record RECT-MESSAGE does only define the new messages, whereas RECT's handler accepts messages of OBJECT-MESSAGE as well, they are imported with rects.

Now the message-sending-version of the squares module.

(module squares (SQUARE SQUARE-MESSAGE Square square? square-message? l l!)
  (import scheme rects ;objects
          (only (chicken base) constantly error define-reader-ctor)
          (only (chicken format) fprintf)
          (only srfi-99 define-record-printer define-record-property
                define-variant-type variant-case
                make-rtd rtd-constructor rtd-predicate rtd-accessor))
  (reexport rects)

;; new messages
(define-variant-type SQUARE-MESSAGE square-message?
  (l)
  (l! arg))

(define (square-handler obj)
  (lambda (msg)
    (cond
      ((square-message? msg)
       (variant-case SQUARE-MESSAGE msg
         ((l) ((handle obj) (w)))
         ((l! arg)
          ((handle obj) (w! arg))
          ((handle obj) (h! arg)))))
      ((object-message? msg)
       (variant-case OBJECT-MESSAGE msg
        ((invariant)
         (if (and ((handle obj RECT) (invariant))
                  (= ((handle obj) (w)) ((handle obj) (h))))
           '(and ((handle obj RECT) (invariant))
                 (= ((handle obj) (w)) ((handle obj) (h))))
           #f))
        ((messages)
         (cons '(#:SQUARE (l) (l! arg))
                 ((handle obj RECT) (messages))))))
      (else
       ((handle obj RECT) msg)))))

;;;; type extension, aka inheritance
(define SQUARE
  (make-rtd 'square '#()
            #:parent RECT
            #:property handle square-handler))

(define (Square x y l)
  (let ((result ((rtd-constructor SQUARE) x y l l)))
    (if ((handle result) (invariant))
      result
      (error 'Square "invariant broken"))))

(define (square? arg)
  (and ((rtd-predicate SQUARE) arg)
       ((handle arg) (invariant))))

;; printer
(define-record-printer (SQUARE rt out)
  (fprintf out "#,(square ~s ~s ~s)" ((handle rt) (x))
                                     ((handle rt) (y))
                                     ((handle rt) (l))))

;; reader
(define-reader-ctor 'square Square)

) ; squares

To show the usage of this oop message-sending pattern compared to the above method-property pattern, simply do the following

(define sq (Square 0 0 1))
(define rt (Rect 0 0 10 20)
(for-each (lambda (x) ((handle x) (l! 5))) (list sq rt))

No error occurs! Instead, only sq has changed, but rt is untouched: RECT can't handle the (l! 5) message and hence ignores it. This is exactly the behaviour you want when broadcasting a message. There is no easy way to do the same with methods.

The datatype egg

Above, messages are defined with define-variant-type and processed with variant-case from the srfi-99 library. That's not the only possibility. You can use define-datatype and cases from the datatype egg instead, an implementation of the equally named routines from the classic Friedman, Wand, Haynes, Essentials of programming languages. We will not rewrite our modules objects, rects and squares in this terminology, but simply note the differences in syntax and semantics.

Whereas the constructors in define-variant-type are written as normal Scheme procedures, e.g. (move! dx dy), define-datatype constructors specify argument type predicates, or, more general, preconditions: (move! (dx number?) (dy number?)). In other words, type tests are done automatically. This saves a lot of work. Moreover, by redefining a constructor in a module, the preconditions can be intensified by additional predicates, which is in accordance with the "is a" relationship of inheritance.

The cases construct of the datatype egg differs from variant-case above insofar, as they are not written as procedure calls. Instead of ((move! dx dy) ...) one writes (move! (dx dy) ...). This underlines the fact, that the variants play different roles. They serve not only as constructors, but as discriminators and accessors as well ...

Epilogue

We've seen, that srfi-99 records provide all the means to implement OOP, especially in Thomas Chust's implementation. We've also described two patterns to do that, methods and messages. Which pattern you prefer, is on your own. Both have advantages and drawbacks. Methods are more tightly coupled with records, messages are more flexible, in particular, they allow broadcasts. In connection with define-datatype, they provide automatic precondition tests, where preconditions can even be intensified.

It should be noted, that Chicken Scheme supplies a lot of eggs with other implementations of OOP. One, based on datatype and message passing as described above, is supplied in the datatypes egg (note the plural). The most complete one, however, is coops, which is similar to Common Lisp's CLOS. This diversity demonstrates the power of the simple minimalist Scheme language ...

Last update

Jun 25, 2015

Author

Juergen Lorenz