Very small single dispatch object language.

minitalk.rkt

#lang racket/base

(struct %class  [parent ivars methods] #:transparent)
(struct %object [class ivars] #:transparent)

(define (new class vals)
  (%object class vals))

(define (send obj method-name args)
  (define method (lookup-method (object-class obj) method-name))
  (apply method obj args))

(define (lookup-method class method-name)
  (if class
      (hash-ref (%class-methods class) method-name
                (lambda () (lookup-method (%class-parent class) method-name)))
      (error 'lookup-method "'~a' not found" method-name)))

(define (object-class obj)
  (cond
    [(%object? obj) (%object-class obj)]
    [(number? obj)  Number]))

(define (class-ivars class)
  (if class
      (append (class-ivars (%class-parent class)) (%class-ivars class))
      null))

(define Object (%class #f null (hasheq)))

(define ((%object-var var) obj)
  (define ivars (class-ivars (object-class obj)))
  (for/last ([ivar (in-list ivars)]
             [val (in-list (%object-ivars obj))]
             #:when (eq? var ivar))
    val))

(define (Number-add n m) (+ n m))
(define Number (%class Object null (hasheq '+ Number-add)))

(define (Point-add p0 p1)
  (new Point
       (list (send (send p0 'x null) '+ (list (send p1 'x null)))
             (send (send p0 'y null) '+ (list (send p1 'y null))))))

(define Point
  (%class Object
          (list 'x 'y)
          (hasheq
            '+ Point-add
            'x (%object-var 'x)
            'y (%object-var 'y))))

(module* main #f
  (send (new Point '(100 -100)) '+ (list (new Point '(-100 100)))))