[plt-scheme] A puzzle for those people doing class.ss stuff

Geoffrey S. Knauth wrote:
> On Nov 20, 2006, at 19:58, I think Danny Yoo quoted Robby Findler:
>> That's not the whole story: in our class system you get to decide the 
>> relative ordering of the field initializers and the super call. you 
>> don't get to make that decision in Java.
>
> I've run into situations in Java where one-size-fits-all bit me, so 
> I'm thankful DrScheme has this flexibility and this issue was clarified.
>
The class system in mzscheme puzzled the heck out of me initially, so 
that and this thread inspired me to write a cheezy language that lets 
you write extremely simple, java-like classes. This was mostly an 
exercise for me in macro-writing, but if anyone finds it useful feel 
free to steal it. Its missing a ton of stuff, but I only spent an hour 
on it :p.

(require (lib "class.ss"))

  (define-syntax private-field
    (syntax-rules ()
      ((_ id) (private-field id #f))
      ((_ id expr)
       (define id #f))))

  (define-syntax public-field
    (syntax-rules ()
      ((_ id) (_ id #f))
      ((_ id expr)
       (field (id expr)))))
 
  (define-syntax private-method
    (syntax-rules ()
      ((_ (id args ...) expr ...)
       (define (id args ...) expr ...))))
 
  (define-syntax public-method
    (syntax-rules ()
      ((_ (id args ...) expr ...)
       (define/public (id args ...) expr ...))))
 
  (define-syntax override-method
    (syntax-rules ()
      ((_ (id args ...) expr ...)
       (define/override (id args ...) expr ...))))
 
  (define-syntax constructor*
    (syntax-rules ()
      ((_ vars (args ...) expr ...)
       (apply (lambda (args ...) expr ...) vars))))
 
  (define-syntax (jclass stx)
    (syntax-case stx (implements extends constructor)
      ((_ (constructor (args ...) c-expr ...) body ...)
       #'(_  extends object% implements () (constructor (args ...) 
c-expr ...) body ...))
      ((_  extends <base> (constructor (args ...) c-expr ...) body ...)
       #'(_  extends <base> implements () (constructor (args ...) c-expr 
...) body ...))
      ((_  implements (<interface> ...) (constructor (args ...) c-expr 
...) body ...)
       #'(_  extends object% implements (<interface> ...) (constructor 
(args ...) c-expr ...) body ...))
      ((_  extends <base> implements (<interface> ...) (constructor 
(args ...) c-expr ...) body ...)
       #'(class* <base> (<interface> ...)
           (super-new)
           (init-rest rest)
           (constructor* rest (args ...) c-expr ...)
           body ...))))
 
  (define bar (jclass (constructor ()
                                    (printf "In the constructor!\n"))
                      (private-field xyz)
                      (public-field hello 30)
                      (private-method (foo a b)
                                        (+ a b))
                      (public-method (bar a b)
                                       (+ a b))
                      ))
 
  (define bar2 (jclass extends bar (constructor (x)
                                                (begin
                                                  (printf "In bar2 
constructor ~a\n" x)))  
                       (override-method (bar a b)
                                          (- a b))))
 
  (define f (make-object bar))
  (send f bar 2 3)
  (define g (make-object bar2 5))
  (send g bar 2 3)

Would print

In the constructor!
5
In the constructor!
In bar2 constructor 5
-1