#lang racket (define new-object make-hash) (define (clone object) (hash-copy object)) (define-syntax !! (syntax-rules() ((_ object msg new-val) (hash-set! object 'msg new-val)))) (define-syntax ?? (syntax-rules () ((_ object msg) (dispatch object 'msg)))) (define-syntax -> (syntax-rules () ((_ object msg arg ...) ((dispatch object 'msg) object arg ...)))) (define (son-of parent) (let ((o (new-object))) (!! o <> parent) o)) (define (dispatch object msg) (if (eq? object 'unknown) (error "Unknown message" msg) (let ((slot (hash-ref object msg 'unknown))) (if (eq? slot 'unknown) (dispatch (hash-ref object '<> 'unknown) msg) slot)))) (define Pino (new-object)) (!! Pino name "Pino") (!! Pino hello (lambda (self x) (display (?? self name)) (display ": hi, ") (display (?? x name)) (display "!") (newline))) (!! Pino set-name (lambda (self x) (!! self name x))) (!! Pino set-name-&-age (λ (self n a) (!! self name n) (!! self age a))) (define Pina (clone Pino)) (!! Pina name "Pina") (-> Pino hello Pina) (-> Pino set-name "Ugo") (-> Pina set-name-&-age "Lucia" 25) (-> Pino hello Pina) (define Glenn (son-of Pino)) (?? Glenn name) (!! Glenn name "Glenn") (!! Glenn age 50) (-> Glenn hello Pina)