2.79

练习 2.79 请定义一个通用型相等谓词 equ?，它能检查两个数是否相等。请将它安装到通用算术包里。这一操作应该能处理常规的数、有理数和复数。

(define helper (js-eval "const table = {}; function get (op, type) {console.log('getting ', op, type);    const res = table[op][JSON.stringify(type)]; console.log('res = ', res); return res;} function put (op,type, proc) { console.log('putting ', op, type, proc);   table[op] = table[op] || {};    table[op][JSON.stringify(type)] = proc; } const exports = {get, put, table}; window.theTable = table; exports;"))

(define JSON (js-eval "JSON"))

(define (get op type)
    (js-invoke helper 'get op (js-invoke JSON 'stringify type))
)

(define (put op type proc)
    (js-invoke helper 'put op (js-invoke JSON 'stringify type) proc)
)

(define (error msg v)
    msg
)

(define (attach-tag type-tag contents)
    (cons type-tag contents)
)

(define (type-tag datum)
    (if (pair? datum)
        (car datum)
        'scheme-number
    )
)

(define (contents datum)
    (if (pair? datum)
        (cdr datum)
        datum
    )
)

(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))
                (error
                    "No method for these types -- APPLY-GENERIC"
                    (list op type-tags)
                )
            )
        )
    )
)

(define (equ? x y) (apply-generic 'equ? x y))

(define (install-scheme-number-package)
    (define (tag x) (attach-tag 'scheme-number x))

    (put 'equ? '(scheme-number scheme-number) (lambda (x y) (tag (eq? x y))))
    (put 'make 'scheme-number (lambda (x) (tag x)))

    'done
)

(install-scheme-number-package)

(define (make-scheme-number n)
    ((get 'make 'scheme-number) n)
)

(define a (make-scheme-number 1))
(define b (make-scheme-number 2))

(equ? a b)

(equ? a a)

现在已经支持了 scheme-number。

看一下常规的数：

(equ? 1 1)

(equ? 1 2)

也支持了。再安装一下有理数：

(define (install-rational-package)
;; internal procedures
    (define (number x) (car x))
    (define (denom x) (cdr x))
    (define (make-rat n d)
        (let ((g (gcd n d)))
            (cons (/ n g) (/ d g))
        )
    )
    (define (add-rat x y)
        (make-rat (+ (* (numer x) (denom y))
                    (* (numer y) (denom x))
                  )
                  (* (denom x) (denom y)))
    )
    (define (sub-rat x y)
        (make-rat (- (* (numer x) (denom y))
                    (* (numer y) (denom x))
                  )
                  (* (denom x) (denom y))
        )
    )
    (define (mul-rat x y)
        (make-rat (* (numer x) (numer y)
                (* (denom x) (denom y))))
    )
    (define (div-rat x y)
        (make-rat (* (numer x) (denom y))
                (* (denom x) (numer y))
        )
    )

;; interface to rest of the system
    (define (tag x) (attach-tag 'rational x))
    (put 'equ? '(rational rational) (lambda (x y) (tag (= (numer x) (numer y)))))
    (put 'make 'rational (lambda (n d) (tag (make-rat n d))))
    (put 'numer 'rational (lambda (x) (numer (contents x))))
    (put 'denom 'rational (lambda (x) (denom (contents x))))
    (put 'add '(rational rational) (lambda (x y) (tag (add-rat x y))))
    (put 'sub '(rational rational) (lambda (x y) (tag (sub-rat x y))))
    (put 'mul '(rational rational) (lambda (x y) (tag (mul-rat x y))))
    (put 'div '(rational rational) (lambda (x y) (tag (div-rat x y))))

    'done
)

(define (make-rational n d)
    ((get 'make 'rational) n d)
)

(install-rational-package)

(equ? (make-rational 1 2) (make-rational 1 2))

再测试一下对有理数的支持。

接着，再安装一下复数：

```

最后，测试一下对复数的支持：

```eval-scheme