Objects are a poor man's closure. Closures are a poor man's object.

q.rkt

#lang racket/base

(require racket/contract
         racket/match
         racket/math)


(define numerator/c   exact-integer?)
(define denominator/c (and/c exact-integer? (not/c zero?)))
(define Q/c (->i ((msg (symbols 'p 'q '->exact)))
                 (result (msg) (match msg ('p        numerator/c)
                                          ('q        denominator/c)
                                          ('->exact  exact?)))))

(provide/contract
  (Q         (-> numerator/c denominator/c Q/c))
  (Q+        (-> Q/c ... Q/c))
  (Q*        (-> Q/c ... Q/c))
  (Q-        (-> Q/c Q/c ... Q/c))
  (Q/        (-> Q/c Q/c ... Q/c))

  (half      Q/c)
  (third     Q/c)
  (quarter   Q/c)
  (fifth     Q/c)
  (sixth     Q/c)
  (seventh   Q/c)
  (eighth    Q/c)
  (ninth     Q/c)
  (tenth     Q/c)
  (sixteenth Q/c))


(define (Q p q)
  (let* ((s  (* (sgn p) (sgn q)))  ; Sign
         (p+ (abs p))              ; Absolute numerator
         (q+ (abs q))              ; Absolute denominator
         (d  (gcd p+ q+))
         (P  (* s (/ p+ d)))       ; Signed, normalised numerator
         (Q  (/ q+ d)))            ; Normalised denominator

    (lambda (msg)
      (match msg ('p       P)
                 ('q       Q)
                 ('->exact (/ P Q))))))


(define Q+
  (lambda values
    (foldl (lambda (a b) (Q (+ (* (a 'p) (b 'q)) (* (a 'q) (b 'p)))
                            (* (a 'q) (b 'q))))
           zero values)))


(define Q*
  (lambda values
    (foldl (lambda (a b) (Q (* (a 'p) (b 'p))
                            (* (a 'q) (b 'q))))
           one values)))


(define Q-
  (lambda values
    (match values
      ((list x)         (Q- zero x))
      ((list-rest x xs) (apply Q+ x (map (lambda (x) (Q (* -1 (x 'p)) (x 'q))) xs))))))


(define Q/
  (lambda values
    (match values
      ((list x)         (Q/ one x))
      ((list-rest x xs) (apply Q* x (map (lambda (x) (Q (x 'q) (x 'p))) xs))))))


(define zero      (Q 0 1))
(define one       (Q 1 1))
(define half      (Q 1 2))
(define third     (Q 1 3))
(define quarter   (Q 1 4))
(define fifth     (Q 1 5))
(define sixth     (Q 1 6))
(define seventh   (Q 1 7))
(define eighth    (Q 1 8))
(define ninth     (Q 1 9))
(define tenth     (Q 1 10))
(define sixteenth (Q 1 16))


(module+ test
  (require rackunit)

  (check-equal? (zero      '->exact) 0)
  (check-equal? (one       '->exact) 1)
  (check-equal? (half      '->exact) 1/2)
  (check-equal? (third     '->exact) 1/3)
  (check-equal? (quarter   '->exact) 1/4)
  (check-equal? (fifth     '->exact) 1/5)
  (check-equal? (sixth     '->exact) 1/6)
  (check-equal? (seventh   '->exact) 1/7)
  (check-equal? (eighth    '->exact) 1/8)
  (check-equal? (ninth     '->exact) 1/9)
  (check-equal? (tenth     '->exact) 1/10)
  (check-equal? (sixteenth '->exact) 1/16)

  (check-equal? ((Q+ half quarter eighth sixteenth sixteenth) '->exact) 1)
  (check-equal? ((Q* half quarter eighth) '->exact) 1/64)
  (check-equal? ((Q- one) '->exact) -1)
  (check-equal? ((Q- one half quarter) '->exact) 1/4)
  (check-equal? ((Q/ half) '->exact) 2)
  (check-equal? ((Q/ one half quarter) '->exact) 8))