-
Notifications
You must be signed in to change notification settings - Fork 0
/
2-79.scm
123 lines (90 loc) · 2.71 KB
/
2-79.scm
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
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
(load "2-78.scm")
(define op-table* (make-equal-hash-table))
(define (put op type proc)
(hash-table/put! op-table* (list op type) proc))
(define (get op type)
(hash-table/get op-table* (list op type) '()))
(define (install-schemer-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)))
(put 'equ? '(scheme-number scheme-number) =)
'done
)
(define (make-scheme-number x)
((get 'make 'scheme-number) x)
)
(define (install-complex-package)
;;...
(define (equal? x y)
(and (= (real-part x) (real-part y)) (= (imag-part x) (imag-part y)))
)
(put 'equ? '(complex complex) equal?)
'done
)
(define (install-rational-package)
(define (numer x) (car x))
(define (denom x) (cdr x))
(define (make-rat n d)
(let ((g (gcd n d)))
(cons (/ n g) (/ d g))))
(define (tag x)
(attach-tag 'rational x))
(define (add-rat x y)
(make-rat (+ (* (numer x) (denom y))
(* (numer y) (denom x)))
(* (denom x) (denom y)))
)
(define (sub-rat x y)
(make-rat (- (* (numer x) (denom y))
(* (numer y) (denom x)))
(* (denom x) (denom y)))
)
(define (mul-rat x y)
(make-rat (* (numer x) (numer y))
(* (denom x) (denom y))))
(define (div-rat x y)
(make-rat (* (numer x) (denom y))
(* (denom x) (numer y))))
(define (equal? x y)
(= (* (numer x) (denom y)) (* (numer y) (denom 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 'equ? '(rational rational) equal?)
(put 'make 'rational (lambda (n d) (tag (make-rat n d))))
'done
)
(define (make-rational n d)
((get 'make 'rational) n d)
)
(define (equ? x y)
(apply-generic 'equ? x y)
)
(define (apply-generic op . args)
(let ((type-tags (map type-tag args)))
(let ((proc (get op type-tags)))
(if (not (null? proc))
(apply proc (map contents args))
(error
"No method for these types -- APPLY-GENERIC"
(list op type-tags))
)
)
)
)
(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))