;;; SCHEME--, a small extension of Scheme to demonstrate OO programming.

;;; A new edition without inits, with letrec*, and written 
;;; by John Lacey, 5/4/95.
;;; modified 6/29/95 by Michael Klingbeil to support static class variables
;;; readded init (constructor) which can reference "this" in order to do things;;; such as keeping a list of instances
;;; of all classes of a given type

(case-sensitive #t)

(extend-syntax (call super)
  [(call name super operand1 ...)
   ((lookup-method 'name super)
    this operand1 ...)]
  [(call name operand0 operand1 ...)
   (let ([instance operand0])
     ((lookup-method 'name instance)
      instance operand1 ...))])

(define lookup-method
  (lambda (name instance)
    (let ((x (assq name instance)))
      (if (pair? x)
          (cdr x)
          (error 'call "Bad Method: ~s" name)))))

(extend-syntax (method)
  [(method parameter-list expr1 expr2 ...)
   (lambda (this . parameter-list) expr1 expr2 ...)])

(extend-syntax (letrec*)
  [(letrec* ([var val] ...) expr1 expr2 ...)
   (let ([var 'any] ...)
     (set! var val) ...
     expr1 expr2 ...)])

(extend-syntax (class)
  [(class parameter-list
          ([svar sval] ...)
          ([var val] ...)
          super-expr
          ([method-name method-expr] ...)
          init ...)
   (letrec* ([svar sval] ...)
     (lambda parameter-list
       (letrec* ([var val] ...)
         (let* ([super super-expr]
                [this (append (list (cons 'method-name method-expr) ...)
                             super)])
           init ...
           this))))])

(define Object (lambda () '()))