乐正

Actions speak louder than words.

Sicp-ex2-84

问题

利用练习2.83的raise操作修改apply-generic过程,使它能通过逐层提升的方式将参数 强制到同样的类型,正如本书中讨论的。你将需要安排一种方式,去检查两个类型中那个更 高。请以一种能与系统中其他部分“相容”,而且又不会影响向塔中加入新层次的方式完成这 一工作。

解答

练习2.84 (ex2-84.scm) download
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
(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))
          (if (= (length args) 2)
              (let ((type1 (car type-tags))
                    (type2 (cadr type-tags))
                    (a1 (car args))
                    (a2 (cadr args)))
                (if (not (eq? type1 type2))
                    (cond ((is-parent a1 (contents a2))
                           (apply-generic op a1 (raise a2)))
                          ((is-parent a2 (contents a1))
                           (apply-generic op (raise a1) a2))
                          (else
                            (let ((t1->t2 (get-coercion type1 type2))
                                  (t2->t1 (get-coercion type2 type1)))
                              (cond (t1->t2
                                      (apply-generic op (t1->t2 a1) a2))
                                    (t2->t1
                                      (apply-generic op a1 (t2->t1 a2)))
                                    (else
                                      (error "No method for these types"
                                            (list op type-tags)))))))
                    (error "No method for these types"
                           (list op type-tags))))
              (error "No method for these types"
                     (list op type-tags)))))))

(define (is-parent arg1 arg2)
  (cond ((not (pair? arg1)) #f)
        ((eq? (type-tag arg1) (type-tag arg2)) #t)
        (else (is-parent (contents arg1) arg2))))

draft

« sicp-ex2-83 sicp-ex2-85 »

Comments