SICP 問題 2.86

(define (square x) (apply-generic 'square x))
(define (square-root x) (apply-generic 'square-root x))
(define (sine x) (apply-generic 'sine x))
(define (cosine x) (apply-generic 'cosine x))
(define (atangent x) (apply-generic 'atangent x))

;; scheme-number
(put 'square '(scheme-number) (lambda (x) (* x x)))
(put 'square-root '(scheme-number) (lambda (x) (sqrt x)))
(put 'sine '(scheme-number) (lambda (x) (sin x)))
(put 'cosine '(scheme-number) (lambda (x) (cos x)))
(put 'atangent '(scheme-number) (lambda (x) (atan x)))

;; rational
(put 'square '(rational) (lambda (x) (make-rat (square (numer x))
                                               (square (denom x)))))
(put 'square-root '(rational) (lambda (x) (make-real (sqrt (project x)))))
(put 'sine 'rational (lambda (x) (make-real (sin (project x))))) ;;real
(put 'cosine 'rational (lambda (x) (make-real (cos (project x))))) ;;real
(put 'atangent 'rational (lambda (x) (make-real (atan (project x))))) ;;real

;; real
(put 'square '(real) (lambda (x) (square x)))
(put 'square-root '(real) (lambda (x) (sqrt x)))
(put 'sine '(real) (lambda (x) (sin x)))
(put 'cosine '(real) (lambda (x) (cos x)))
(put 'atangent '(real) (lambda (x) (atan x)))

;; complex
(put 'square '(complex)
     (lambda (x) (make-complex-from-real-imag (+ (square (real-part x))
                                                 (square (imag)))
                                              (* 2 (real-part x) (imag-part x)))))
(put 'square-root '(complex)
     (lambda (x) (make-complex-from-mag-ang (sqrt (magnitude x))
                                            (/ (angle x) 2))))
(put 'sine '(complex)
     (lambda (x) (make-complex-from-real-imag (sin (real-part x))
                                              (sin (imag-part x)))))
(put 'cosine '(complex)
     (lambda (x) (make-complex-from-real-imag (cos (real-part x))
                                              (cos (imag-part x)))))
(put 'atangent '(complex)
     (lambda (x) (make-complex-from-real-imag (atan (real-part x))
                                              (atan (imag-part x)))))