SICP問題2.81

a.

; scheme-number で呼び出し
(exp 3 4)
; 81
(exp (make-complex-from-real-imag 1.0 3) (make-complex-from-real-imag 2.0 3))
; 返って来ない。

無限ループに陥る

b.
無限ループになっている時点で正しくない。このままでは apply-generic は正しく動作しない。

c. apply-generic の修正

(define (apply-generic op . args)
  (let ((type-tags (map type-tag args)))
    (let ((proc (get op type-tags)))
      (if proc
	  (apply proc (map contents args))
	  (if (= (length args) 2)
	      (let ((type1 (car type-tags))
		    (type2 (cadr type-tags))
		    (a1 (car args))
		    (a2 (cadr args)))
		(if (eq? type1 type2)
		    (error "Not method for these types"
		     (list op type-tags))
		    (let ((t1->t2 (get-coercion type1 type2))
			  (t2->t1 (get-coercion type2 type1)))
		      (cond (t1->t2
			     (apply-generic op (t1->t2 a1) a2))
			    (t2->t1
			     (apply-generic op a1 (t2->t1 a2)))
			    (else
			     (error "Not method for these types"
				    (list op type-tags)))))))
	      (error "Not method for these types"
		     (list op type-tags)))))))

(define (scheme-number->complex n)
  (make-complex-from-real-imag (contents n) 0))
(put-coercion 'scheme-number 'complex scheme-number->complex)
(define (exp x y) (apply-generic 'exp x y))
(define (install-scheme-number-package)
  (define (tag x)
    (attach-tag 'scheme-number x))
  (put 'add '(scheme-number scheme-number)
       (lambda (x y) (tag (+ x y))))
  (put 'sub '(scheme-number scheme-number)
       (lambda (x y) (tag (- x y))))
  (put 'mul '(scheme-number scheme-number)
       (lambda (x y) (tag (* x y))))
  (put 'div '(scheme-number scheme-number)
       (lambda (x y) (tag (/ x y))))
  (put 'equ? '(scheme-number scheme-number)
       (lambda (x y) (= x y)))
  ; 追加
  (put '=zero? '(scheme-number)
       (lambda (x) (= x 0)))
  (put 'make 'scheme-number
       (lambda (x) (tag x)))
  (put 'exp '(scheme-number scheme-number)
       (lambda (x y) (tag (expt x y)))) ; 基本手続き expt を使う
  'done)
(install-scheme-number-package)

テスト

; scheme-number で呼び出し
(exp 3 4)
; 81
(exp (make-complex-from-real-imag 1.0 3) (make-complex-from-real-imag 2.0 3))
; *** ERROR: Not method for these types (exp (complex complex))
; Stack Trace:
; _______________________________________
(exp 2 (make-complex-from-real-imag 2.0 3))
; *** ERROR: Not method for these types (exp (complex complex))
; Stack Trace:
; _______________________________________
(exp (make-complex-from-real-imag 1.0 3) 2)
; *** ERROR: Not method for these types (exp (complex complex))
; Stack Trace:
; _______________________________________

無限ループせずに(complex, complex)にそろえられるが、exp には (complex, complex) 用の関数が定義されていないので、エラー出力をして終了する。