scheme通用型算术运算

根据前文的通用型算术模型的构建，我们可以对常规计算和有理数计算也进行同样的模型构建。

点击查看代码

(define (add x y) (apply-generic 'add x y))
(define (sub x y) (apply-generic 'sub x y))
(define (mul x y) (apply-generic 'mul x y))
(define (div x y) (apply-generic 'div 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 'make 'scheme-number
        (lambda (x) (tag x)))
    'done)
(define (make-scheme-number n)
    ((get 'make 'scheme-number) n))

(define (install-ractional-package)
    (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 (+ (* (number x)(denom y))
                     (* (number y)(denom y)))
                  (* (denom x) (denom y))))
    (define (sub-rat x y)
        (make-rat (- (* (number x)(denom y))
                     (* (number y)(denom y)))
                  (* (denom x) (denom y))))
    (define (mul-rat x y)
        (make-rat (* (number x)(number y))
                  (* (denom x)(denom y))))
    (define (div-rat x y)
        (make-rat (* (number x)(denom y))
                  (* (denom x)(number y))))
    (define (tag x) (attach-tag 'rational 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))))
    (put 'make 'rational
        (lambda (n d) (tag (make-rat n d))))
    'done)

练习2.78 常规化常规算术运算

点击查看代码

(define (attach-tag type-tag contents)
    (if (number? contents)
        contents
        (cons type-tag contents)))
(define (type-tag datum)
    (if (number? datum)
        'scheme-number
        (if (pair? datum)
            (car datum)
            (error "unknown tag"))))
(define (contents datum)
    (if (number? datum)
        datum
        (if (pair? datum)
        (cdr datum)
        (error "unknown contents"))))

练习2.79&2.80
实现equ？和zero？判断

点击查看代码

(define (install-scheme-number-package)
    (put 'equ? '(scheme-number scheme-number)
        (lambda (x y) (= x y)))
    (put '=zero? 'scheme-number
        (lambda (x) (= x 0))))
(define (install-ractional-package)
    (define (equal-rat? x y)
        (= (* (number x)(denom y))
           (* (number y)(denom x))))
    (put 'equ? '(ractional ractional)
        (lambda (x y) (tag (equal-rat? x y))))
    (put '=zero? 'ractional
        (lambda (x) (= (number x) 0))))
(define (install-complex-package)
    (define (equ-complex? z1 z2)
        (and (= (real-part z1) (real-part z2))
             (= (imag-part z1) (imag-part z2))))
    (put 'equ? '(complex complex)
        (lambda (x y) (equ-complex? x y)))
    (put '=zero? 'complex
        (lambda (z) (and (= (real-part z) 0)
                         (= (imag-part z) 0)))))