; the class-method name to get the superclass
; the method name to start searching in the superclass
(define super 'super)

; the class-method name to get the class-description
; the method name to get the class
(define class 'class)

; the class-method name to get the class name
(define name 'name)

; a class of objects
; usage: (Object class-method arg..)
(define Object
  (lambda (class-method . args)
    (cond
      ((eq? class-method 'super) #f)     ; no superclass
      ((eq? class-method 'name) "Object")
      ((eq? class-method 'class) Object-class)
      (else (message Object class-method nil args))))
)

; the class-method name to create new objects
(define new 'new)

; the method name to describe an object
(define toString 'toString)

; the class-description for Object
(define Object-class
  (list
    (list 'new                  ; usage: (Object new)
      (lambda (null args)       ; returns new object
        (letrec (
          (this
            (lambda (method . args)
              (cond
                ((eq? method 'class) Object)
                (else (message Object method this args))))))
          this
        )
      )
    )
    (list 'super                ; usage: (anObject super class method args)
      (lambda (this args)       ; returns result of (anObject method arg..)
                                ; method is searched beginning in (class super)
        (message ((car args) 'super) (cadr args) this (cddr args))
      )
    )
    (list 'toString             ; usage: (anObject toString)
      (lambda (this args)       ; returns "a[n] <class-name>"
        (let ((c (substring ((this 'class) 'name) 0 1)))
          (if (or (string-ci=? c "a") (string-ci=? c "e")
                  (string-ci=? c "i") (string-ci=? c "o"))
            (string-append "an " ((this 'class) 'name))
            (string-append "a " ((this 'class) 'name))
          )
        )
      )
    )
  )
)

; an internal function to send a message
; usage: (message class method this args)
; return: result of (method this args) or unspecified
(define (message klass method this args)
  ; searches recursively in class-description
  ; and then in (class super)
  (define (send class-description method this args)
    (if (> (length class-description) 0)
      (if (eq? method (caar class-description))
        ((cadar class-description) this args)
        (send (cdr class-description) method this args)
      )
      (if (klass 'super)
        (message (klass 'super) method this args))
    )
  )
  (send (klass 'class) method this args)
)

; an internal function to get an element of a list
; usage: (get list n)
; return: n'th element, counted from zero
(define (get list n)
  (if (> n 0)
    (get (cdr list) (- n 1))
    (car list)
  )
)

; an internal function to replace an element of a list
; usage: (put! list n value)
(define (put! list n value)
  (if (> n 0)
    (put! (cdr list) (- n 1) value)
    (set-car! list value)
  )
)