(define (set-self object-part) (set! self object-part) (send super 'set-self! object-part)) (define (virtual-operations object) (send object 'set-self! object)) (define (new-instance class) (let ((instance (class))) (virtual-operations instance) instance)) (define (object) (let ((super ()) (self nil)) (define (set-self obj-part) (set! self obj-part)) (define (responds-to message) (let ((method (method-lookup self message))) (if method #t #f))) (define (dispatch message) (cond ((eqv? message 'set-self!) set-self) ((eqv? message 'responds-to?) responds-to) (else ()))) (set! self dispatch) self)) ;;; example (define (a) (let ((super (new-part object)) (self nil)) (let ((aa 5)) (define (m1 x) (display "m1 i class a")) (define (m2 x) (display "m2 i class a") (send self 'mes1 x)) (define (set-self object-part) (set! self object-part) (send super 'set-self! object-part)) (define (dispatch message) (cond ((eqv? message 'mes1) m1) ((eqv? message 'mes2) m2) ((eqv? message 'set-self!) set-self) (else (method-lookup super message)))) (set! self dispatch)) self)) (define (b) (let ((super (new-part a)) (self nil)) (let ((bb 5)) (define (m1 x) (display "m1 i class b")) (define (m3 x) (display "m3 i class b")) (define (set-self object-part) (set! self object-part) (send super 'set-self! object-part)) (define (dispatch message) (cond ((eqv? message 'mes1) m1) ((eqv? message 'mes3) m3) ((eqv? message 'set-self!) set-self) (else (method-lookup super message)))) (set! self dispatch)) self)) (define (c) (let ((super (new-part a)) (self nil)) (let ((cc 5)) (define (m1 x) (display "m1 i class c")) (define (m3 x) (display "m3 i class c")) (define (set-self object-part) (set! self object-part) (send super 'set-self! object-part)) (define (dispatch message) (cond ((eqv? message 'mes1) m1) ((eqv? message 'mes3) m3) ((eqv? message 'set-self!) set-self) (else (method-lookup super message)))) (set! self dispatch)) self))