Racketのdefine-member-nameの例

member-name-example.rkt

#lang racket

;;
;; queue%クラスのメソッド enqueue, dequeue を producer%, consumer%だけに公開している。
;; let の外部からはこの２メソッドは見えない。
;;

(define-values (queue% producer% consumer%)
  (let ()
    (define-member-name enqueue (generate-member-key))
    (define-member-name dequeue (generate-member-key))

    (define queue%
      (class object% (super-new)
        (define buf '())
        (define/public (enqueue x)
          (set! buf (append buf `(,x))))
        (define/public (dequeue)
          (cond ((pair? buf)
                 (begin0 (car buf) (set! buf (cdr buf))))
                (else 'nil)))))

    ;; enqueue fibonacci numbers
    (define producer%
      (class object% (super-new)
        (init queue)
        (define q queue)
        (define pair '(0 . 1))
        (define/public (produce-next)
          (let ((a (car pair))
                (b (cdr pair)))
            (send q enqueue b)
            (set! pair (cons b (+ a b)))))))

    (define consumer%
      (class object% (super-new)
        (init tag queue)
        (define tag- tag)
        (define q queue)
        (define/public (display-next)
          (printf "~a > ~a\n" tag- (send q dequeue)))))

    (values queue% producer% consumer%)))

;; helper
(define (repeatedly n f)
  (let loop ((n n) (ls '()))
    (if (= n 0)
        (reverse ls)
        (loop (- n 1) (cons (f) ls)))))
(define-syntax repeatedly$
  (syntax-rules ()
    ((_ n e ...) (repeatedly n (thunk e ...)))))

(define (main)
  (let* ((q (make-object queue%))
         (p (make-object producer% q))
         (c1 (make-object consumer% 'C1 q))
         (c2 (make-object consumer% 'C2 q)))
    (repeatedly$ 10
                 (send p produce-next))
    (repeatedly$ 4
                 (send c1 display-next)
                 (send c2 display-next)
                 (send c2 display-next))

    (send q enqueue 999)   ; error
    ))

(main)

output

C1 > 1
C2 > 1
C2 > 2
C1 > 3
C2 > 5
C2 > 8
C1 > 13
C2 > 21
C2 > 34
C1 > 55
C2 > nil
C2 > nil
send: no such method
  method name: enqueue
  class name: queue%