example-functional-object.rkt

#lang racket
(define (cup volume)
  (define amount 0)
  (define (pour-in! d)
    (let ([old-amount amount])
      (if (> (+ old-amount d) volume)
          (begin
            (set! amount volume)
            (- (+ old-amount d) volume))
          (begin
            (set! amount (+ old-amount d))
            0))))
  (define (pour-out! d)
    (let ([old-amount amount])
      (if (> d old-amount)
          (begin
            (set! amount 0)
            old-amount)
          (begin
            (set! amount (- amount d))
            d))))
  (define (read-amount)
    amount)
  (define (obj msg . args)
    (cond
      [(eq? msg 'pour-in!) (apply pour-in! args)]
      [(eq? msg 'pour-out!) (apply pour-out! args)]
      [(eq? msg 'read-amount) (apply read-amount args)]
      [else "Error!"]))
  obj)

(define a-cup (cup 500))
(a-cup 'pour-in! 600)
; 100
(a-cup 'read-amount)
; 500
(a-cup 'pour-out! 300)
; 300
(a-cup 'read-amount)
; 200
(a-cup 'pour-out! 300)
; 200
(a-cup 'read-amount)
; 0