src/sicp/ex2_83.rkt

   1 #lang racket
   2
   3 (define (attach-tag tag contents)
   4   (cons tag contents))
   5
   6 (define (integer->rational x)
   7   (if (integer? x)
   8       (attach-tag 'rational (cons (contents x) 1))
   9       (error "input is not an integer")))
  10
  11 ;; install in integer
  12 (put 'raise '(rational)
  13      (lambda (x) (integer->rational x)))
  14
  15 (define (integer->real x)
  16   (* x 1.0))
  17
  18 (define (rational->real r)
  19   (let ((n (numer r))
  20         (d (denom r)))
  21     (make-real (/ (integer->real n) d))))
  22
  23 ;; install into rational package
  24 (put 'raise '(real)
  25      (lambda (r) (rational->real r)))
  26
  27 (define (real->complex r)
  28   (make-complex-from-real-imag r 0))
  29
  30 ;; install into real package
  31 (put 'raise '(complex)
  32      (lambda (r) (real->complex r)))
  33
  34 (define (raise x)
  35   (apply-generic 'raise x))