src/sicp/ex2_85.rkt

   1 #lang racket
   2
   3 (put 'project '(complex)
   4      (lambda (c) (real c)))
   5
   6 (put 'project '(rational)
   7      (lambda (r) (floor r)))
   8
   9 (put 'project '(real)
  10      (lambda (d)
  11        (let ((rat (rationalize (inexact->exact d) 1/100)))
  12          (make-rat (numerator rat)
  13                    (denominator rat)))))
  14
  15 ;; drop
  16 (define (drop x)
  17   (let ((project-fn (get 'project (list (type-tag x)))))
  18     (if (project-fn)
  19         (let ((dropped-x (project-fn x)))
  20           (if (equ? (raise dropped-x) x)
  21               (drop dropped-x)
  22               x))
  23         x)))
  24
  25