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

(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
          ([var val] ...)
          super-expr
          ([method-name method-expr] ...))
   (lambda parameter-list
     (letrec* ([var val] ...)
       (let ([super super-expr])
         (append
          (list (cons 'method-name method-expr) ...)
          super))))])

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