Marc:

I thought that I might speed up rational arithmetic a bit in the common case where the numerators and denominators are small integers, so I tried some new declarations:

(define-prim (##ratnum.* x y) (##declare (run-time-bindings) (mostly-fixnum)) (let ((p (macro-ratnum-numerator x)) (q (macro-ratnum-denominator x)) (r (macro-ratnum-numerator y)) (s (macro-ratnum-denominator y))) (if (##eq? x y) (macro-ratnum-make (* p p) (* q q)) ; already in lowest form (let* ((gcd-ps (gcd p s)) (gcd-rq (gcd r q)) (num (* (quotient p gcd-ps) (quotient r gcd-rq))) (den (* (quotient q gcd-rq) (quotient s gcd-ps)))) (if (##eq? den 1) num (macro-ratnum-make num den))))))

but this isn't quite right, since, e.g., for the form (* p p), if p is not a fixnum, then gsc generates calls to (* p p) instead of (##* p p) even though (declare (standard-bindings) is in effect. So a user could screw up rational arithmetic simply by redefining * (which is allowed, after all).

Perhaps the code generator should be changed to call (##* p p) directly in this case.

The full expansion is below.

Brad

(define ##ratnum.* (lambda (x y) (let ((s ('#<procedure #7 ##vector-ref> y 1)) (r ('#<procedure #7 ##vector-ref> y 0)) (q ('#<procedure #7 ##vector-ref> x 1)) (p ('#<procedure #7 ##vector-ref> x 0))) (if ('#<procedure #27 ##eq?> x y) ('#<procedure #75 ##subtype-set!> ('#<procedure #76 ##vector> (if (and ('#<procedure #14 ##fixnum?> p) ('#<procedure #14 ##fixnum?> p)) (if ('#<procedure #298 ##eqv?> p 0) 0 (let ((temp.236 (if ('#<procedure #298 ##eqv?> p -1) ('#<procedure #207 ##fx-?> p) ('#<procedure #208 ##fx*?> p p)))) (if temp.236 temp.236 (* p p)))) (* p p)) (if (and ('#<procedure #14 ##fixnum?> q) ('#<procedure #14 ##fixnum?> q)) (if ('#<procedure #298 ##eqv?> q 0) 0 (let ((temp.239 (if ('#<procedure #298 ##eqv?> q -1) ('#<procedure #207 ##fx-?> q) ('#<procedure #208 ##fx*?> q q)))) (if temp.239 temp.239 (* q q)))) (* q q))) 2) (let ((gcd-ps ('#<procedure #94 gcd> p s))) (let ((gcd-rq ('#<procedure #94 gcd> r q))) (let ((num (let ((temp.245 (if (and ('#<procedure #14 ##fixnum?

gcd-rq)

(and ('#<procedure #14 ##fixnum?> r) ('#<procedure #21 ##not> ('#<procedure #298 ##eqv?> gcd-rq 0)))) (if ('#<procedure #298 ##eqv?> gcd-rq -1) (or ('#<procedure #207 ##fx-?

r)

(quotient r gcd-rq)) ('#<procedure #216 ##fxquotient> r gcd-rq)) (quotient r gcd-rq))) (temp.244 (if (and ('#<procedure #14 ##fixnum?

gcd-ps)

(and ('#<procedure #14 ##fixnum?> p) ('#<procedure #21 ##not> ('#<procedure #298 ##eqv?> gcd-ps 0)))) (if ('#<procedure #298 ##eqv?> gcd-ps -1) (or ('#<procedure #207 ##fx-?

p)

(quotient p gcd-ps)) ('#<procedure #216 ##fxquotient> p gcd-ps)) (quotient p gcd-ps)))) (if (and ('#<procedure #14 ##fixnum?> temp.245) ('#<procedure #14 ##fixnum?> temp.244)) (if ('#<procedure #298 ##eqv?> temp. 245 0) 0 (let ((temp.246 (if ('#<procedure #298 ##eqv?> temp.245 -1) ('#<procedure #207 ##fx-?> temp.244) ('#<procedure #208 ##fx*?> temp.244 temp.245)))) (if temp.246 temp.246 (* temp.244 temp.245)))) (* temp.244 temp.245))))) (let ((den (let ((temp.252 (if (and ('#<procedure #14 ##fixnum?> gcd-ps) (and ('#<procedure #14 ##fixnum?> s) ('#<procedure #21 ##not> ('#<procedure #298 ##eqv?> gcd-ps 0)))) (if ('#<procedure #298 ##eqv?> gcd-ps -1) (or ('#<procedure #207 ##fx-?> s) (quotient s gcd-ps)) ('#<procedure #216 ##fxquotient> s gcd-ps)) (quotient s gcd-ps))) (temp.251 (if (and ('#<procedure #14 ##fixnum?> gcd-rq) (and ('#<procedure #14 ##fixnum?> q) ('#<procedure #21 ##not> ('#<procedure #298 ##eqv?> gcd-rq 0)))) (if ('#<procedure #298 ##eqv?> gcd-rq -1) (or ('#<procedure #207 ##fx-?> q) (quotient q gcd-rq)) ('#<procedure #216 ##fxquotient> q gcd-rq)) (quotient q gcd-rq)))) (if (and ('#<procedure #14 ##fixnum?> temp.252) ('#<procedure #14 ##fixnum?> temp.251)) (if ('#<procedure #298 ##eqv?> temp. 252 0) 0 (let ((temp.253 (if ('#<procedure #298 ##eqv?> temp.252 -1) ('#<procedure #207 ##fx-?> temp.251) ('#<procedure #208 ##fx*?> temp.251 temp.252)))) (if temp.253 temp.253 (* temp.251 temp.252)))) (* temp.251 temp.252))))) (if ('#<procedure #27 ##eq?> den 1) num ('#<procedure #75 ##subtype-set!> ('#<procedure #76 ##vector> num den) 2))))))))))