Lecture 8 - slide 11 : 11

(define (new-instance class . parameters)
 (let ((instance (apply class parameters)))
   (virtual-operations instance)
   instance))

; Arrange for virtual operations in object
(define (virtual-operations object)
  (send 'set-self! object object))

(define (new-part class . parameters)
  (apply class parameters))

(define (method-lookup object selector)
  (cond ((procedure? object) (object selector))
         (else (error "Inappropriate object in method-lookup: " object))))

(define (send message object . args)
  (let ((method (method-lookup object message)))
    (cond ((procedure? method) (apply method args))
          ((null? method) (error "Message not understood: " message))
          (else (error "Inappropriate result of method lookup: " method)))))

; The root in the class hierarchy
(define (object)
  (let ((super '())
        (self 'nil))

   (define (set-self! object-part)
     (set! self object-part))

   (define (dispatch message)
      (cond ((eqv? message 'set-self!) set-self!)
            (else (error "Undefined message" message))))
 
   (set! self dispatch)
   self))


; The class y which inherits from x and redefines get-tate
(define (x)
 (let ((super (new-part object))
       (self 'nil))

   (let ((x-state 1) 
        )
     
     (define (get-state) x-state)

     (define (res)
       (send 'get-state self))

     (define (set-self! object-part)
         (set! self object-part)
         (send 'set-self! super object-part))
     
     (define (self message)
         (cond ((eqv? message 'get-state) get-state)
               ((eqv? message 'res) res)
               ((eqv? message 'set-self!) set-self!)
               (else (method-lookup super message))))
     
      self)))  ; end x


(define (y)
 (let ((super (new-part x))
       (self 'nil))

   (let ((y-state 2) 
        )
     
     (define (get-state) y-state)

     (define (set-self! object-part)
         (set! self object-part)
         (send 'set-self! super object-part))
     
     (define (self message)
         (cond ((eqv? message 'get-state) get-state)
               ((eqv? message 'set-self!) set-self!)
               (else (method-lookup super message))))
     
      self))) ; end y