blob: 0cd8bbf55962cd16a7757e28ecc956c44b6c5ec0 (
plain)
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
|
#lang racket
(provide install-arithmetic-package
make-integer
test-integer
make-rat
test-rat
make-real
test-real
make-complex
test-complex
make-complex-rect
test-complex-rect
make-complex-polar
test-complex-polar
=zero?
equ?
add
sub
mul
div
sinme
cosme
atanme
sqrme
sqrtme
raiseme
dropme)
(require "./install-integer.rkt"
"./install-rational.rkt"
"./install-real.rkt"
"./install-complex.rkt"
"../../../shared/data-directed-programming.rkt")
(define pkg (make-dispatch-table))
(define get (getter pkg))
(define put (putter pkg))
(define print-tbl (printer pkg))
(define apply-fn (make-apply-with-raising-and-drop
get))
(install-integer put get)
(install-rational put get)
(install-real put get)
(install-complex apply-fn get put)
(define (install-arithmetic-package)
(list get put apply-fn))
;; constructors
;; integer
(define (make-integer n)
((get 'make 'integer) n))
(define test-integer (make-integer 3))
;; rational
(define (make-rat n d)
((get 'make 'rational) n d))
(define test-rat (make-rat 5 2))
;; real
(define (make-real n)
((get 'make 'real) n))
(define test-real (make-real 1.5))
;; complex
(define (make-complex x y)
((get 'make-from-real-imag 'complex) x y))
(define (make-complex-rect x y)
((get 'make-from-real-imag 'complex) x y))
(define (make-complex-polar x y)
((get 'make-from-mag-ang 'complex) x y))
(define test-complex (make-complex 1 2))
(define test-complex-rect (make-complex-rect 1 2))
(define test-complex-polar (make-complex-rect 1 2))
;; polynomial
(define (make-polynomial var terms)
((get 'make 'polynomial) var terms))
;; generic methods
(define (equ? a1 a2)
(apply-fn 'equ? a2))
(define (=zero? datum)
(apply-fn '=zero? datum))
(define (add a1 a2)
(apply-fn 'add a1 a2))
(define (sub a1 a2)
(apply-fn 'sub a1 a2))
(define (mul a1 a2)
(apply-fn 'mul a1 a2))
(define (div a1 a2)
(apply-fn 'div a1 a2))
(define (raiseme datum)
(apply-fn 'raise datum))
(define (dropme datum)
(apply-fn 'project datum))
(define (sqrme datum)
(apply-fn 'sqr datum))
(define (sqrtme datum)
(apply-fn 'sqrt datum))
(define (cosme datum)
(apply-fn 'cos datum))
(define (sinme datum)
(apply-fn 'sin datum))
(define (atanme a1 a2)
(apply-fn 'atan a2))
|
