SICP演習問題2.87, 2.89

またもやnaoya_tさんのscheme-number->polynominalを拝借．
いつもいつもお世話になっています..

;;section2.5.3
(define (install-scheme-number-package)
  (put 'add '(scheme-number scheme-number)
       (lambda (x y) (+ x y)))
  (put 'sub '(scheme-number scheme-number)
       (lambda (x y) (- x y)))
  (put 'mul '(scheme-number scheme-number)
       (lambda (x y) (* x y)))
  (put 'div '(scheme-number scheme-number)
       (lambda (x y) (/ x y)))

  ;;excercize2.87
  (put '=zero? '(scheme-number)
       (lambda (x) (= 0 x)))

  (put 'make 'scheme-number
       (lambda (x) (tag x)))
  'done)
(define (install-polynomial-package)
  ;;internal function
  (define (make-poly variable term-list)
    (cons variable term-list))
  (define (variable p) (car p))
  (define (term-list p) (cdr p))
  (define (variable? x)
  (symbol? x))
  (define (same-variable? x y)
    (and (variable? x) (variable? y) (eq? x y)))
  (define (add-poly p1 p2)
    (if (same-variable? (variable p1) (variable p2))
        (make-poly (variable p1)
                   (add-terms (term-list p1)
                              (term-list p2)))
        (error "Polys not in same variable -- ADD-POLY"
               (list p1 p2))))

  ;;excercize2.88
  (define (sub-poly p1 p2)
    (if (same-variable? (variable p1) (variable p2))
        (make-poly (variable p1)
                   (sub-terms (term-list p1)
                              (term-list p2)))))

  (define (mul-poly p1 p2)
    (if (same-variable? (variable p1) (variable p2))
        (make-poly (variable p1)
                   (mul-terms (term-list p1)
                              (term-list p2)))
        (error "Polys not in same variable -- MUL-POLY"
               (list p1 p2))))

  ;;excercize2.87
  (define (=zero-polinomial? p) (empty-termlist? p))

  ;;scheme number型とpolynomial型の演算ができるようにする
  (define (scheme-number->polynomial variable n)
    (make-polynomial variable (list (list 0 n))))

  ;;interface
  (define (tag p) (attach-tag 'polynomial p))
  (put 'add '(polynomial polynomial)
       (lambda (p1 p2) (tag (add-poly p1 p2))))

  ;;excercize2.88
  (put 'sub '(polynomial polynomial)
       (lambda (p1 p2) (tag (sub-poly p1 p2))))

  (put 'mul '(polynomial polynomial)
       (lambda (p1 p2) (tag (mul-poly p1 p2))))

  ;;excercize2.87
  (put '=zero? '(polynomial) =zero-polinomial?)

  (put 'make 'polynomial
       (lambda (variable term-list)
         (tag (make-poly variable term-list))))

  ;;scheme-number と polynomialの演算
  (put 'add '(scheme-number polynomial)
       (lambda (n p) (add (scheme-number->polynomial (car p) n)
                          (attach-tag 'polynomial p))))
  (put 'mul '(polynomial scheme-number)
       (lambda (p n) (mul (scheme-number->polynomial (car p) n)
                          (attach-tag 'polynomial p))))
  'done)

;;;excercize2.88
(define (reverse-terms term-list)
  (if (empty-termlist? term-list)
      '()
      (adjoin-term
       (make-term (order (first-term term-list))
                  (sub 0 (coeff (first-term term-list))))
       (reverse-terms (rest-terms term-list)))))

(define (sub-terms L1 L2)
  (add-terms L1 (reverse-terms L2)))

ところで，

  ;;excercize2.87
  (put '=zero? '(scheme-number)
       (lambda (x) (= 0 x)))

というところだけど，本当は

  ;;excercize2.87
  (put '=zero? 'scheme-number
       (lambda (x) (= 0 x)))

にしたいんだけど，'(scheme-number)じゃないと通らなかったので，とりあえずしてしまった．
polynominalも同様．