如何解决我实施 SICP Ex 2.85 时出现的奇怪错误？
How to resolve weird Bug in my implementation of SICP Ex 2.85?
练习要求我们制作一个简化数字的过程drop。例如Complex to Real（如果可能）然后修改现有的 apply-generic 以便它可以在计算后简化数字。
只需添加 drop 即可，并且在相同条件下它确实可以在过程之外工作。但是当添加到 apply-generic.
时它给了我一个错误
完整代码如下：
(define (attach-tag type-tag contents)
(cons type-tag contents))
(define (type-tag datum)
(if (pair? datum)
(car datum)
(error "Bad tagged datum: TYPE-TAG" datum)))
(define (contents datum)
(if (pair? datum)
(cdr datum)
(error "Bad tagged datum: CONTENTS" datum)))
(define (put-coercion type1 type2 function)
(put type1 type2 function))
(define (get-coercion type1 type2)
(get type1 type2))
(define (element? ls e)
(cond ((null? ls) #f)
((eq? (car ls) e) #t)
(else (element? (cdr ls) e))))
(define (compose f g) (lambda (x) (f (g x))))
(define (double f) (compose f f))
(define (identity x) x)
(define (compose-n f n)
(cond ((= n 0) identity)
((even? n) (compose-n (double f) (/ n 2)))
(else (compose f (compose-n f (- n 1))))))
(define tower (list (list 'integer 0)
(list 'real 1)
(list 'complex 2)))
(define (child? ti t1 tower)
(define (iter t tow)
(cond
((null? tow) (error "Not located in Tower" t))
((eq? t (caar tow)) (cadar tow))
(else (iter t (cdr tow)))))
(if (< (- (iter t1 tower) (iter ti tower)) 1)
#f
(- (iter t1 tower) (iter ti tower))))
(define (ti->t1 ti t1)
(if (child? ti t1 tower)
(compose-n raise (child? ti t1 tower))
(get-coercion ti t1)))
(define (map-ls proc-ls arg-ls)
(if (null? proc-ls)
'()
(cons ((car proc-ls) (car arg-ls))
(map-ls (cdr proc-ls) (cdr arg-ls)))))
(define (iterator t op ty args)
(if (null? t)
(error "No method for these types"
(list op ty))
(let ((getter (map
(lambda (x) (ti->t1 x (car t))) ty)
))
(if (element? getter #f)
(iterator (cdr t) op ty args)
(let ((eq-tags
(map type-tag (map-ls getter args))))
(let ((proc (get op eq-tags)))
(if proc
(apply proc (map contents
(map-ls getter args)))
(iterator (cdr t) op ty args))))))))
(define (drop x)
(if (or (eq? (type-tag x) 'integer)
(not (project x)))
x
(drop (project x))))
(define (apply-generic op . args)
(let ((type-tags (map type-tag args)))
(let ((proc (get op type-tags)))
(if proc
(drop (apply proc (map contents args)))
(if (element? (map
(lambda (x) (eq? x (car type-tags)))
type-tags) #f)
(drop (iterator type-tags op type-tags args))
(error "No method for these types"
(list op type-tags))
)))))
(define (install-integer-package)
;;internal Procedures
(define (add x y)(+ (contents x) (contents y)))
(define (sub x y)(- (contents x) (contents y)))
(define (mul x y)(* (contents x) (contents y)))
(define (exp x y)(expt (contents x) (contents y)))
(define (make x) x)
(define (equ? x y)(= (contents x) (contents y)))
;;External Procedures
(define (tag x)
(attach-tag 'integer x))
(put 'add '(integer integer)
(lambda (x y) (tag (+ x y))))
(put 'sub '(integer integer)
(lambda (x y) (tag (- x y))))
(put 'mul '(integer integer)
(lambda (x y) (tag (* x y))))
(put 'div '(integer integer)
(lambda (x y) (make-rational x y)))
(put 'make 'integer
(lambda (x) (tag (make x))))
(put 'equ? '(integer integer)
(lambda (x y) (equ? x y)))
(put '=zero? '(integer)
(lambda (x) (= (contents x) 0)))
(put 'exp '(integer integer)
(lambda (x y) (tag (exp x y))))
(put 'raise '(integer)
(lambda (x) (make-real (* x 1.0))))
'done)
(define (install-real-package)
;;internal Procedures
(define (add x y)(+ (contents x) (contents y)))
(define (sub x y)(- (contents x) (contents y)))
(define (mul x y)(* (contents x) (contents y)))
(define (div x y)(/ (contents x) (contents y)))
(define (exp x y)(expt (contents x) (contents y)))
(define (make x) x)
(define (equ? x y)(= (contents x) (contents y)))
;;External Procedures
(define (tag x)
(attach-tag 'real x))
(put 'add '(real real)
(lambda (x y) (tag (add x y))))
(put 'sub '(real real)
(lambda (x y) (tag (sub x y))))
(put 'mul '(real real)
(lambda (x y) (tag (mul x y))))
(put 'div '(real real)
(lambda (x y) (tag (div x y))))
(put 'make 'real
(lambda (x) (tag (make x))))
(put 'equ? '(real real)
(lambda (x y) (equ? x y)))
(put '=zero? '(real)
(lambda (x) (= (contents x) 0)))
(put 'exp '(real real)
(lambda (x y) (tag (exp x y))))
(put 'raise '(real)
(lambda (x) (make-complex-from-real-imag
x 0)))
(put 'project '(real)
(lambda (x)(if (= (round x) x)
(make-integer (round x))
#f)))
'done)
(define (install-rectangular-package)
;; internal procedures
(define (real-part z) (car z))
(define (imag-part z) (cdr z))
(define (make-from-real-imag x y)
(cons x y))
(define (magnitude z)
(sqrt (+ (square (real-part z))
(square (imag-part z)))))
(define (angle z)
(atan (imag-part z) (real-part z)))
(define (make-from-mag-ang r a)
(cons (* r (cos a)) (* r (sin a))))
(define (equ? z1 z2)
(and (= (real-part z1) (real-part z2))
(= (real-part z1) (real-part z2))))
;; interface to the rest of the system
(define (tag x)
(attach-tag 'rectangular x))
(put 'real-part '(rectangular) real-part)
(put 'imag-part '(rectangular) imag-part)
(put 'magnitude '(rectangular) magnitude)
(put 'angle '(rectangular) angle)
(put 'make-from-real-imag 'rectangular
(lambda (x y)
(tag (make-from-real-imag x y))))
(put 'make-from-mag-ang 'rectangular
(lambda (r a)
(tag (make-from-mag-ang r a))))
(put 'equ? '(rectangular rectangular)
(lambda (z1 z2)
(equ? z1 z2)))
(put '=zero? '(rectangular)
(lambda (x) (and (= (real-part x) 0)
(= (imag-part x) 0))))
'done)
(define (install-polar-package)
;; internal procedures
(define (magnitude z) (car z))
(define (angle z) (cdr z))
(define (make-from-mag-ang r a) (cons r a))
(define (real-part z)
(* (magnitude z) (cos (angle z))))
(define (imag-part z)
(* (magnitude z) (sin (angle z))))
(define (make-from-real-imag x y)
(cons (sqrt (+ (square x) (square y)))
(atan y x)))
(define (equ? z1 z2)
(and (= (magnitude z1) (magnitude z2))
(= (angle z1) (angle z2))))
;; interface to the rest of the system
(define (tag x) (attach-tag 'polar x))
(put 'real-part '(polar) real-part)
(put 'imag-part '(polar) imag-part)
(put 'magnitude '(polar) magnitude)
(put 'angle '(polar) angle)
(put 'make-from-real-imag 'polar
(lambda (x y)
(tag (make-from-real-imag x y))))
(put 'make-from-mag-ang 'polar
(lambda (r a)
(tag (make-from-mag-ang r a))))
(put 'equ? '(polar polar)
(lambda (z1 z2)
(equ? z1 z2)))
(put '=zero? '(polar)
(lambda (x) (and (= (magnitude x) 0)
(= (angle x) 0))))
'done)
(define (install-complex-package)
;; imported procedures from rectangular and polar packages
(define (make-from-real-imag x y)
((get 'make-from-real-imag
'rectangular)
x y))
(define (make-from-mag-ang r a)
((get 'make-from-mag-ang 'polar)
r a))
(define (real-part z) (apply-generic 'real-part z))
(define (imag-part z) (apply-generic 'imag-part z))
(define (magnitude z) (apply-generic 'magnitude z))
(define (angle z) (apply-generic 'angle z))
;; internal procedures
(define (add-complex z1 z2)
(make-from-real-imag
(+ (real-part z1) (real-part z2))
(+ (imag-part z1) (imag-part z2))))
(define (sub-complex z1 z2)
(make-from-real-imag
(- (real-part z1) (real-part z2))
(- (imag-part z1) (imag-part z2))))
(define (mul-complex z1 z2)
(make-from-mag-ang
(* (magnitude z1) (magnitude z2))
(+ (angle z1) (angle z2))))
(define (div-complex z1 z2)
(make-from-mag-ang
(/ (magnitude z1) (magnitude z2))
(- (angle z1) (angle z2))))
;; interface to rest of the system
(define (tag z) (attach-tag 'complex z))
(put 'add '(complex complex)
(lambda (z1 z2)
(tag (add-complex z1 z2))))
(put 'sub '(complex complex)
(lambda (z1 z2)
(tag (sub-complex z1 z2))))
(put 'mul '(complex complex)
(lambda (z1 z2)
(tag (mul-complex z1 z2))))
(put 'div '(complex complex)
(lambda (z1 z2)
(tag (div-complex z1 z2))))
(put 'make-from-real-imag 'complex
(lambda (x y)
(tag (make-from-real-imag x y))))
(put 'make-from-mag-ang 'complex
(lambda (r a)
(tag (make-from-mag-ang r a))))
(put 'real-part '(complex) real-part)
(put 'imag-part '(complex) imag-part)
(put 'magnitude '(complex) magnitude)
(put 'angle '(complex) angle)
(put 'equ? '(complex complex) equ?)
(put '=zero? '(complex) =zero?)
(put 'project '(complex)
(lambda (x)(if (= (imag-part x) 0)
(make-real(real-part x))
#f)))
'done)
(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 (equ? x y) (apply-generic 'equ? x y))
(define (=zero? x) (apply-generic '=zero? x))
(define (exp x y) (apply-generic 'exp x y))
(define (raise x) (apply-generic 'raise x))
(define (project x) (apply-generic 'project x))
(define (make-integer n)
((get 'make 'integer) n))
(define (make-real n)
((get 'make 'real) n))
(define (make-complex-from-real-imag x y)
((get 'make-from-real-imag 'complex) x y))
(define (make-complex-from-mag-ang r a)
((get 'make-from-mag-ang 'complex) r a))
(install-rectangular-package)
(install-polar-package)
(install-integer-package)
(install-complex-package)
;(install-rational-package)
(install-real-package)
(define (install-coercion-package)
;;internal definintion
(define (integer->complex n)
(make-complex-from-real-imag
(contents n) 0))
(define (integer->integer n) n)
(define (complex->complex z) z)
(define (rational->rational r) r)
(define (real->real r) r)
;;External definition
(put-coercion 'integer 'integer integer->integer)
(put-coercion 'complex 'complex complex->complex)
(put-coercion 'integer 'complex integer->complex)
(put-coercion 'rational 'rational rational->rational)
(put-coercion 'real 'real real->real)
'done)
(install-coercion-package)
(sub (make-complex-from-real-imag 4 1)
(make-complex-from-real-imag 3 1))
(define proc (get 'sub '(complex complex)))
(define args (list (make-complex-from-real-imag 4 1)
(make-complex-from-real-imag 3 1)))
(display (apply proc (map contents args)))
如果我在 之后应用 drop 程序 ，代码工作正常，即
(drop (apply-generic op .args)) 工作正常。但是我实现的方式 apply-generic
做 (drop (apply-generic op .args)) 应该等同于 到
(define (apply-generic op . args)
(let ((type-tags (map type-tag args)))
(let ((proc (get op type-tags)))
(if proc
(drop (apply proc (map contents args)))
(if(element?(map
(lambda (x) (eq? x (car type-tags)))
type-tags) #f)
(drop (iterator type-tags op type-tags args))
(error "No method for these types"
(list op type-tags))
)))))
但它给我的错误是 Bad tagged datum: TYPE-TAG 4 。请帮忙。
原来我没有设定条件只在执行算术运算时应用 drop，因此 apply-generic 过程试图 drop
当我使用 real-part z 并给我类型标签错误时的参数。
最终代码：
(define arithmetic (list 'add 'sub 'mul 'div))
(define (apply-generic op . args)
(let ((type-tags (map type-tag args)))
(let ((proc (get op type-tags)))
(if proc
(if (element? arithmetic op)
(drop (apply proc (map contents args)))
(apply proc (map contents args)))
(if (element? (map
(lambda (x) (eq? x (car type-tags)))
type-tags) #f)
(iterator type-tags op type-tags args)
(error "No method for these types"
(list op type-tags))
)))))
我在执行 install-real-package 和 equ? 过程时也遇到了一些问题，但它们是无关的
我也最终更改了我的 drop 程序以符合练习的参数
(define (drop num)
(if (and (not (eq? (type-tag num) 'integer))
(equ? (raise (project num)) num))
(drop (project num))
num))
练习要求我们制作一个简化数字的过程drop。例如Complex to Real（如果可能）然后修改现有的 apply-generic 以便它可以在计算后简化数字。
只需添加 drop 即可，并且在相同条件下它确实可以在过程之外工作。但是当添加到 apply-generic.
完整代码如下：
(define (attach-tag type-tag contents)
(cons type-tag contents))
(define (type-tag datum)
(if (pair? datum)
(car datum)
(error "Bad tagged datum: TYPE-TAG" datum)))
(define (contents datum)
(if (pair? datum)
(cdr datum)
(error "Bad tagged datum: CONTENTS" datum)))
(define (put-coercion type1 type2 function)
(put type1 type2 function))
(define (get-coercion type1 type2)
(get type1 type2))
(define (element? ls e)
(cond ((null? ls) #f)
((eq? (car ls) e) #t)
(else (element? (cdr ls) e))))
(define (compose f g) (lambda (x) (f (g x))))
(define (double f) (compose f f))
(define (identity x) x)
(define (compose-n f n)
(cond ((= n 0) identity)
((even? n) (compose-n (double f) (/ n 2)))
(else (compose f (compose-n f (- n 1))))))
(define tower (list (list 'integer 0)
(list 'real 1)
(list 'complex 2)))
(define (child? ti t1 tower)
(define (iter t tow)
(cond
((null? tow) (error "Not located in Tower" t))
((eq? t (caar tow)) (cadar tow))
(else (iter t (cdr tow)))))
(if (< (- (iter t1 tower) (iter ti tower)) 1)
#f
(- (iter t1 tower) (iter ti tower))))
(define (ti->t1 ti t1)
(if (child? ti t1 tower)
(compose-n raise (child? ti t1 tower))
(get-coercion ti t1)))
(define (map-ls proc-ls arg-ls)
(if (null? proc-ls)
'()
(cons ((car proc-ls) (car arg-ls))
(map-ls (cdr proc-ls) (cdr arg-ls)))))
(define (iterator t op ty args)
(if (null? t)
(error "No method for these types"
(list op ty))
(let ((getter (map
(lambda (x) (ti->t1 x (car t))) ty)
))
(if (element? getter #f)
(iterator (cdr t) op ty args)
(let ((eq-tags
(map type-tag (map-ls getter args))))
(let ((proc (get op eq-tags)))
(if proc
(apply proc (map contents
(map-ls getter args)))
(iterator (cdr t) op ty args))))))))
(define (drop x)
(if (or (eq? (type-tag x) 'integer)
(not (project x)))
x
(drop (project x))))
(define (apply-generic op . args)
(let ((type-tags (map type-tag args)))
(let ((proc (get op type-tags)))
(if proc
(drop (apply proc (map contents args)))
(if (element? (map
(lambda (x) (eq? x (car type-tags)))
type-tags) #f)
(drop (iterator type-tags op type-tags args))
(error "No method for these types"
(list op type-tags))
)))))
(define (install-integer-package)
;;internal Procedures
(define (add x y)(+ (contents x) (contents y)))
(define (sub x y)(- (contents x) (contents y)))
(define (mul x y)(* (contents x) (contents y)))
(define (exp x y)(expt (contents x) (contents y)))
(define (make x) x)
(define (equ? x y)(= (contents x) (contents y)))
;;External Procedures
(define (tag x)
(attach-tag 'integer x))
(put 'add '(integer integer)
(lambda (x y) (tag (+ x y))))
(put 'sub '(integer integer)
(lambda (x y) (tag (- x y))))
(put 'mul '(integer integer)
(lambda (x y) (tag (* x y))))
(put 'div '(integer integer)
(lambda (x y) (make-rational x y)))
(put 'make 'integer
(lambda (x) (tag (make x))))
(put 'equ? '(integer integer)
(lambda (x y) (equ? x y)))
(put '=zero? '(integer)
(lambda (x) (= (contents x) 0)))
(put 'exp '(integer integer)
(lambda (x y) (tag (exp x y))))
(put 'raise '(integer)
(lambda (x) (make-real (* x 1.0))))
'done)
(define (install-real-package)
;;internal Procedures
(define (add x y)(+ (contents x) (contents y)))
(define (sub x y)(- (contents x) (contents y)))
(define (mul x y)(* (contents x) (contents y)))
(define (div x y)(/ (contents x) (contents y)))
(define (exp x y)(expt (contents x) (contents y)))
(define (make x) x)
(define (equ? x y)(= (contents x) (contents y)))
;;External Procedures
(define (tag x)
(attach-tag 'real x))
(put 'add '(real real)
(lambda (x y) (tag (add x y))))
(put 'sub '(real real)
(lambda (x y) (tag (sub x y))))
(put 'mul '(real real)
(lambda (x y) (tag (mul x y))))
(put 'div '(real real)
(lambda (x y) (tag (div x y))))
(put 'make 'real
(lambda (x) (tag (make x))))
(put 'equ? '(real real)
(lambda (x y) (equ? x y)))
(put '=zero? '(real)
(lambda (x) (= (contents x) 0)))
(put 'exp '(real real)
(lambda (x y) (tag (exp x y))))
(put 'raise '(real)
(lambda (x) (make-complex-from-real-imag
x 0)))
(put 'project '(real)
(lambda (x)(if (= (round x) x)
(make-integer (round x))
#f)))
'done)
(define (install-rectangular-package)
;; internal procedures
(define (real-part z) (car z))
(define (imag-part z) (cdr z))
(define (make-from-real-imag x y)
(cons x y))
(define (magnitude z)
(sqrt (+ (square (real-part z))
(square (imag-part z)))))
(define (angle z)
(atan (imag-part z) (real-part z)))
(define (make-from-mag-ang r a)
(cons (* r (cos a)) (* r (sin a))))
(define (equ? z1 z2)
(and (= (real-part z1) (real-part z2))
(= (real-part z1) (real-part z2))))
;; interface to the rest of the system
(define (tag x)
(attach-tag 'rectangular x))
(put 'real-part '(rectangular) real-part)
(put 'imag-part '(rectangular) imag-part)
(put 'magnitude '(rectangular) magnitude)
(put 'angle '(rectangular) angle)
(put 'make-from-real-imag 'rectangular
(lambda (x y)
(tag (make-from-real-imag x y))))
(put 'make-from-mag-ang 'rectangular
(lambda (r a)
(tag (make-from-mag-ang r a))))
(put 'equ? '(rectangular rectangular)
(lambda (z1 z2)
(equ? z1 z2)))
(put '=zero? '(rectangular)
(lambda (x) (and (= (real-part x) 0)
(= (imag-part x) 0))))
'done)
(define (install-polar-package)
;; internal procedures
(define (magnitude z) (car z))
(define (angle z) (cdr z))
(define (make-from-mag-ang r a) (cons r a))
(define (real-part z)
(* (magnitude z) (cos (angle z))))
(define (imag-part z)
(* (magnitude z) (sin (angle z))))
(define (make-from-real-imag x y)
(cons (sqrt (+ (square x) (square y)))
(atan y x)))
(define (equ? z1 z2)
(and (= (magnitude z1) (magnitude z2))
(= (angle z1) (angle z2))))
;; interface to the rest of the system
(define (tag x) (attach-tag 'polar x))
(put 'real-part '(polar) real-part)
(put 'imag-part '(polar) imag-part)
(put 'magnitude '(polar) magnitude)
(put 'angle '(polar) angle)
(put 'make-from-real-imag 'polar
(lambda (x y)
(tag (make-from-real-imag x y))))
(put 'make-from-mag-ang 'polar
(lambda (r a)
(tag (make-from-mag-ang r a))))
(put 'equ? '(polar polar)
(lambda (z1 z2)
(equ? z1 z2)))
(put '=zero? '(polar)
(lambda (x) (and (= (magnitude x) 0)
(= (angle x) 0))))
'done)
(define (install-complex-package)
;; imported procedures from rectangular and polar packages
(define (make-from-real-imag x y)
((get 'make-from-real-imag
'rectangular)
x y))
(define (make-from-mag-ang r a)
((get 'make-from-mag-ang 'polar)
r a))
(define (real-part z) (apply-generic 'real-part z))
(define (imag-part z) (apply-generic 'imag-part z))
(define (magnitude z) (apply-generic 'magnitude z))
(define (angle z) (apply-generic 'angle z))
;; internal procedures
(define (add-complex z1 z2)
(make-from-real-imag
(+ (real-part z1) (real-part z2))
(+ (imag-part z1) (imag-part z2))))
(define (sub-complex z1 z2)
(make-from-real-imag
(- (real-part z1) (real-part z2))
(- (imag-part z1) (imag-part z2))))
(define (mul-complex z1 z2)
(make-from-mag-ang
(* (magnitude z1) (magnitude z2))
(+ (angle z1) (angle z2))))
(define (div-complex z1 z2)
(make-from-mag-ang
(/ (magnitude z1) (magnitude z2))
(- (angle z1) (angle z2))))
;; interface to rest of the system
(define (tag z) (attach-tag 'complex z))
(put 'add '(complex complex)
(lambda (z1 z2)
(tag (add-complex z1 z2))))
(put 'sub '(complex complex)
(lambda (z1 z2)
(tag (sub-complex z1 z2))))
(put 'mul '(complex complex)
(lambda (z1 z2)
(tag (mul-complex z1 z2))))
(put 'div '(complex complex)
(lambda (z1 z2)
(tag (div-complex z1 z2))))
(put 'make-from-real-imag 'complex
(lambda (x y)
(tag (make-from-real-imag x y))))
(put 'make-from-mag-ang 'complex
(lambda (r a)
(tag (make-from-mag-ang r a))))
(put 'real-part '(complex) real-part)
(put 'imag-part '(complex) imag-part)
(put 'magnitude '(complex) magnitude)
(put 'angle '(complex) angle)
(put 'equ? '(complex complex) equ?)
(put '=zero? '(complex) =zero?)
(put 'project '(complex)
(lambda (x)(if (= (imag-part x) 0)
(make-real(real-part x))
#f)))
'done)
(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 (equ? x y) (apply-generic 'equ? x y))
(define (=zero? x) (apply-generic '=zero? x))
(define (exp x y) (apply-generic 'exp x y))
(define (raise x) (apply-generic 'raise x))
(define (project x) (apply-generic 'project x))
(define (make-integer n)
((get 'make 'integer) n))
(define (make-real n)
((get 'make 'real) n))
(define (make-complex-from-real-imag x y)
((get 'make-from-real-imag 'complex) x y))
(define (make-complex-from-mag-ang r a)
((get 'make-from-mag-ang 'complex) r a))
(install-rectangular-package)
(install-polar-package)
(install-integer-package)
(install-complex-package)
;(install-rational-package)
(install-real-package)
(define (install-coercion-package)
;;internal definintion
(define (integer->complex n)
(make-complex-from-real-imag
(contents n) 0))
(define (integer->integer n) n)
(define (complex->complex z) z)
(define (rational->rational r) r)
(define (real->real r) r)
;;External definition
(put-coercion 'integer 'integer integer->integer)
(put-coercion 'complex 'complex complex->complex)
(put-coercion 'integer 'complex integer->complex)
(put-coercion 'rational 'rational rational->rational)
(put-coercion 'real 'real real->real)
'done)
(install-coercion-package)
(sub (make-complex-from-real-imag 4 1)
(make-complex-from-real-imag 3 1))
(define proc (get 'sub '(complex complex)))
(define args (list (make-complex-from-real-imag 4 1)
(make-complex-from-real-imag 3 1)))
(display (apply proc (map contents args)))
如果我在 之后应用 drop 程序 ，代码工作正常，即
(drop (apply-generic op .args)) 工作正常。但是我实现的方式 apply-generic
做 (drop (apply-generic op .args)) 应该等同于 到
(define (apply-generic op . args)
(let ((type-tags (map type-tag args)))
(let ((proc (get op type-tags)))
(if proc
(drop (apply proc (map contents args)))
(if(element?(map
(lambda (x) (eq? x (car type-tags)))
type-tags) #f)
(drop (iterator type-tags op type-tags args))
(error "No method for these types"
(list op type-tags))
)))))
但它给我的错误是 Bad tagged datum: TYPE-TAG 4 。请帮忙。
原来我没有设定条件只在执行算术运算时应用 drop，因此 apply-generic 过程试图 drop
当我使用 real-part z 并给我类型标签错误时的参数。
最终代码：
(define arithmetic (list 'add 'sub 'mul 'div))
(define (apply-generic op . args)
(let ((type-tags (map type-tag args)))
(let ((proc (get op type-tags)))
(if proc
(if (element? arithmetic op)
(drop (apply proc (map contents args)))
(apply proc (map contents args)))
(if (element? (map
(lambda (x) (eq? x (car type-tags)))
type-tags) #f)
(iterator type-tags op type-tags args)
(error "No method for these types"
(list op type-tags))
)))))
我在执行 install-real-package 和 equ? 过程时也遇到了一些问题，但它们是无关的
我也最终更改了我的 drop 程序以符合练习的参数
(define (drop num)
(if (and (not (eq? (type-tag num) 'integer))
(equ? (raise (project num)) num))
(drop (project num))
num))