(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 ...