Message Passing with GOOPS

[Michael Tiedtke]

(use-modules (oop goops))

GOOPS has some nice features (you can even use unexported methods with generics in 1.8) but there is no message passing paradigm. Objective-C has tell Racket has send but Guile/GOOPS is missing call.

This is a first "raw" definition where the parameter message has to be a quoted symbol.

(define-method (call (receiver <object>) message . arguments)
  (apply (slot-ref receiver message) arguments))


The class definition still looks like traditional GOOPS but it works.

An example:

(define-class <receiver> ()
  (msg #:init-value (lambda () 'hello-world)))

(define r (make <receiver>))
(call r 'msg) => 'hello-world


Now I'd like to have an easier syntax for describing the slot. The definition might be:

(define-syntax define-message
  (syntax-rules ()
    ((_ (message-name arguments ... ) body ...)
     (message-name #:init-value (lambda (arguments ...) body ...)))))

But the following example doesn't work in 1.8:

(define-class <house> ()
  (define-message (phone n)
    (repeat n (lambda () (bell) 'rang)) ))

GOOPS complains about malformed slots and seems to see the unexpanded form.
I could use a little help here, anyone? Even for the naming scheme: send is already used by unix sockets and methods are part of the implementation of generics. Perhaps message isn't that bad.


The missing symbols from my pretext:

(define (natural-number? n)
  (and (exact? n)
       (integer? n)  ; 'integer?' does not check for exactness ...
       (> n 0)))

(define-public (repeat n closure)
  "Execute closure n times."
  (if (not (or (natural-number? n) (= n 0)))
      (error "repeat: the parameter n must be an exact natural number or zero.")
      (let loop ((i 0))
        (if (< i n)
          (begin
            (closure)
            (loop (1+ i)))) )))


From my pretext.rkt

(define-syntax broadcast
  (syntax-rules ()
    ((_ object-list method ...)
     (map {lambda (object) (send object method ...)}
          object-list))))
(define-syntax broadcast*
  (syntax-rules ()
    ((_ object-list method ...)
     (map {lambda (object) (send* object method ...)}
          object-list))))

(define-syntax define/on-delegate
  (syntax-rules ()
    ((_ delegate-object (method-name ...))
     (define (method-name ...)
       (send delegate-object method-name ...)) )))


PS
Perhaps it's better to recreate a clean object model without 3,000 lines of C code like GOOPS. But then GOOPS really creates the illusion of an object oriented environment with a MOP ...