plp/scheme/scheme8.rkt

#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>> 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 '<<parent>> '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)