; "Poor Man's" objects using syntactic extension

; IF using GNU Guile, uncomment the following line
; (use-syntax (ice-9 syncase))

(define-syntax defObj
  (syntax-rules ()
    ((_ (name . varlist)
	((slot1 val1) ...)      ; SLOTS are the object's variables
	((meth1 body1) ...))    ; METHODS are the object's procedures
     (define name
       (lambda varlist
	 (let* ((slot1 val1) ...)      
	   (letrec ((meth1 body1) ...) 
	     (lambda (msg . args)
	       (case msg
		 ((meth1) (apply meth1 args)) ...
		 (else
		  (error 'name "invalid message ~s"
			 (cons msg args))))))))))
    ((_ (name . varlist)
        ((meth1 body1) ...))
     (defObj (name . varlist)
             ()
             ((meth1 body1) ...)))
    ))

; sending a message without having to explicitly quote the method
(define-syntax send-msg
  (syntax-rules ()
    ((_ obj msg arg ...)
     (obj 'msg arg ...))))


; examples

(defObj (Foo kar kdr)
         ((get-car (lambda () kar))
          (get-cdr (lambda () kdr))
          (set-car! (lambda (x) (set! kar x)))
          (set-cdr! (lambda (x) (set! kdr x)))))

(defObj (Arith)
          ((add  (lambda (x y) (+ x y)))
           (sub  (lambda (x y) (- x y)))
           (mult (lambda (x y) (* x y)))
           (div  (lambda (x y) (/ x y)))
          ))