SICP 読み (83) 2.5.3 例: 記号代数

昨晩ハマってしまった件 (問題 2.90)

何が悪いのかワケが分からない。add-terms の実装は以下。

  (define (add-terms L1 L2)
    (cond ((empty-termlist? L1) L2)
	  ((empty-termlist? L2) L1)
	  (else
	   (let ((t1 (first-term L1)) (t2 (first-term L2)))
	     (cond ((> (order t1) (order t2))
		    ((adjoin-term (add-terms (rest-terms L1) L2)) t1))
		   ((< (order t1) (order t2))
		    ((adjoin-term (add-terms L1 (rest-terms L2))) t2))
		   (else
		    ((adjoin-term (add-terms (rest-terms L1)
					     (rest-terms L2)))
		     (make-term (order t1)
				(add (coeff t1) (coeff t2))))))))))

む。(trace apply-generic) したら (一部のみ)

           CALL apply-generic order (term 0 2)
           RETN apply-generic 0
           CALL apply-generic order (term 0 1)
           RETN apply-generic 0
           CALL apply-generic order (term 0 2)
           RETN apply-generic 0
           CALL apply-generic order (term 0 1)
           RETN apply-generic 0
           CALL apply-generic coeff (term 0 1)
           RETN apply-generic 1
           CALL apply-generic coeff (term 0 2)
           RETN apply-generic 2
           CALL add 1 2
            CALL apply-generic add 1 2
            RETN apply-generic 3
           RETN add 3
           CALL apply-generic first-term (sparse 1)
           RETN apply-generic (term 0 1)
           CALL apply-generic first-term (sparse 2)
           RETN apply-generic (term 0 2)
           CALL apply-generic empty-termlist? (term 0 1)

上記は (add '(polynomial x sparse 1) '(polynomial x sparse 2)) のソレ。あるいは以下。

gosh> (add '(polynomial x sparse 1 0) '(polynomial x sparse 1))
            CALL add (pol... x sparse 1 0) (polynomial x sparse 1)
             CALL apply-generic add (pol... x sp... 1 ...) (poly... x sparse 1)
              CALL apply-generic empty-termlist? (sparse 1 0)
               CALL apply-generic =zero? 1
               RETN apply-generic #f
              RETN apply-generic #f
              CALL apply-generic empty-termlist? (sparse 1)
               CALL apply-generic =zero? 1
               RETN apply-generic #f
              RETN apply-generic #f
              CALL apply-generic first-term (sparse 1 0)
              RETN apply-generic (term 1 1)
              CALL apply-generic first-term (sparse 1)
              RETN apply-generic (term 0 1)
              CALL apply-generic order (term 1 1)
              RETN apply-generic 1
              CALL apply-generic order (term 0 1)
              RETN apply-generic 0
              CALL apply-generic first-term (sparse 1 0)
              RETN apply-generic (term 1 1)
              CALL apply-generic empty-termlist? (term 1 1)

ドコで first-term を取り出して empty-termlist? に渡してる? stack trace も出てるんですが以下。

*** ERROR: No method for these types -- APPLY-GENERIC (empty-termlist? (term))
Stack Trace:
_______________________________________
  0  (apply function args)
        At line 77 of "/usr/share/slib/trace.scm"
  1  (empty-termlist? L1)
        At line 170 of "(stdin)"
  2  (add-terms (rest-terms L1) (rest-terms L2))
        At line 179 of "(stdin)"
  3  (adjoin-term (add-terms (rest-terms L1) (rest-terms L2)))
        At line 179 of "(stdin)"
  4  (add-terms (term-list p1) (term-list p2))
        At line 164 of "(stdin)"
  5  (add-poly p1 p2)
        At line 225 of "(stdin)"
  6  (apply function args)
        At line 77 of "/usr/share/slib/trace.scm"
  7  (apply function args)
        At line 77 of "/usr/share/slib/trace.scm"

何故なんだー、と言ってたんですが M-x occur で発見。

     23:  (define (first-term term-list)
     45:  (put 'first-term '(sparse)
     46:       (lambda (t) (first-term t)))
     62:  (define (first-term term-list) (apply-generic 'first-term term-list))
     63:  (define (rest-terms term-list) (apply-generic 'first-term term-list))
     90:	   (let ((t1 (first-term L1)) (t2 (first-term L2)))
    112:	(add-terms (mul-term-by-all-terms (first-term L1) L2)
    118:	(let ((t2 (first-term L)))
    130:	(let ((t (first-term L)))

とほほほ。rest-terms ...
# って直前エントリ確認したら bug 混入の跡がしっかり残ってますな。

で、修正したら動いたんですが、今度は

*** ERROR: No method for these types -- APPLY-GENERIC (adjoin-term (4))

だそうな。


これは置きかえで調べているトキに検出してた bug なんですが、adjoin-term した後のリストにタグが付いていない。とりあえず、adjoin-term を以下のように

  (define (adjoin-term term-list)
    (lambda (term)
      (let f ((term-list term-list))
	(if (> (order term) (length term-list))
	    (f (cons 0 term-list))
	    (tag (cons (coeff term) term-list))))))

で、試験したら演算な試験は通しだったのですが、adjoin-term の試験で NG

 expected:<(2 3 4)>
  but was:<(sparse 2 3 4)> in adjoin-term
F
 expected:<(2 0 0)>
  but was:<(sparse 2 0 0)> in adjoin-term
F
 expected:<(2 0 1 0)>
  but was:<(sparse 2 0 1 0)> in adjoin-term

試験は以下のように書いてある。

  ("adjoin-term"
   (assert-equal '(2 3 4)
                 ((apply-generic 'adjoin-term '(sparse 3 4)) '(term 2 2)))
   (assert-equal '(2 0 0)
                 ((apply-generic 'adjoin-term '(sparse)) '(term 2 2)))
   (assert-equal '(2 0 1 0)
                 ((apply-generic 'adjoin-term '(sparse 1 0)) '(term 3 2)))
   )

当たり前と言えば当たり前。ってか試験を先に直せよ、ってカンジ。以下のように修正。

  ("adjoin-term"
   (assert-equal '(sparse 2 3 4)
                 ((apply-generic 'adjoin-term '(sparse 3 4)) '(term 2 2)))
   (assert-equal '(sparse 2 0 0)
                 ((apply-generic 'adjoin-term '(sparse)) '(term 2 2)))
   (assert-equal '(sparse 2 0 1 0)
                 ((apply-generic 'adjoin-term '(sparse 1 0)) '(term 3 2)))
   )

とりあえず、対処完了、ってコトで。(を