10 (define (denominator x)
18 (make-rational (fix:+ (fix:* (numerator x) (denominator y))
19 (fix:* (denominator x) (numerator y)))
20 (fix:* (denominator x) (denominator y))))
23 (make-rational (fix:- (fix:* (numerator x) (denominator y))
24 (fix:* (denominator x) (numerator y)))
25 (fix:* (denominator x) (denominator y))))
28 (make-rational (fix:* (numerator x) (numerator y))
29 (fix:* (denominator x) (denominator y))))
32 (make-rational (fix:* (numerator x) (denominator y))
33 (fix:* (denominator x) (numerator y))))
36 (make-rational (denominator x) (numerator x)))
38 ; Type dispatch and promotion
40 (define (type-dispatch ops x)
45 (define (promote-dispatch ops x y)
49 ((cdr ops) x (fixnum->flonum y)))
51 ((cdr ops) (fixnum->flonum x) y)
57 (type-dispatch (cons fix:neg flo:neg) x))
60 (type-dispatch (cons fix:abs flo:abs) x))
62 (define (flo:1+ x) (flo:+ x 1.0))
63 (define (flo:1- x) (flo:- x 1.0))
66 (type-dispatch (cons fix:1+ flo:1+) n))
69 (type-dispatch (cons fix:1- flo:1-) n))
71 (define (apply-to-flonum op x)
72 (if (flonum? x) (op x) x))
75 (apply-to-flonum flo:round x))
77 (apply-to-flonum flo:floor x))
79 (apply-to-flonum flo:ceiling x))
81 (apply-to-flonum flo:truncate x))
85 (define (fix:/ x y) ; Non-standard definition while we don't have rationals
86 (if (fix:= 0 (fix:remainder x y))
88 (flo:/ (fixnum->flonum x) (fixnum->flonum y))))
90 (define (pair+ x y) (promote-dispatch (cons fix:+ flo:+) x y))
91 (define (pair- x y) (promote-dispatch (cons fix:- flo:-) x y))
92 (define (pair* x y) (promote-dispatch (cons fix:* flo:*) x y))
93 (define (pair/ x y) (promote-dispatch (cons fix:/ flo:/) x y))
95 (define (pair> x y) (promote-dispatch (cons fix:> flo:>) x y))
96 (define (pair< x y) (promote-dispatch (cons fix:< flo:<) x y))
97 (define (pair>= x y) (promote-dispatch (cons fix:>= flo:>=) x y))
98 (define (pair<= x y) (promote-dispatch (cons fix:<= flo:<=) x y))
99 (define (pair= x y) (promote-dispatch (cons fix:= flo:=) x y))
105 (fold-left pair+ 0 args))
107 (define (- first . rest)
110 (pair- first (apply + rest))))
113 (fold-left pair* 1 args))
115 (define (/ first . rest)
118 (pair/ first (apply * rest))))
120 (define (quotient n1 n2)
121 (fix:quotient n1 n2))
123 (define (remainder n1 n2)
124 (fix:remainder n1 n2))
126 (define modulo remainder)
130 (define (test-relation rel l)
135 (if (rel (car l) (car (cdr l)))
136 (test-relation rel (cdr l))
140 (test-relation pair= args))
143 (test-relation pair> args))
146 (test-relation pair< args))
149 (test-relation pair>= args))
152 (test-relation pair<= args))
156 (define (zero? x) (pair= x 0.0))
157 (define (positive x) (pair> x 0.0))
158 (define (odd? n) (pair= (remainder n 2) 0))
159 (define (odd? n) (not (pair= (remainder n 2) 0)))
162 ; Current state of the numerical tower
163 (define (complex? x) #f)
164 (define (real? x) #t)
165 (define (rational? x) #t)
166 (define (integer? x) (= x (round x)))
167 (define (exact? x) (fixnum? x))
168 (define (inexact? x) (flonum? x))
172 (if (ratnum? x) #t #f))))