1(define (string-for-each proc str1 . str2)
2  (apply for-each proc (string->list str1)
3           (map string->list str2)))
4
5(define (exact-non-negative-integer? k)
6  (and (integer? k) (exact? k) (>= k 0)))
7
8(define (exact-integer-sqrt k)
9  (unless (exact-non-negative-integer? k)
10    (assertion-violation 'exact-integer-sqrt "exact non-negative integer required" (list k)))
11  (let* ([s (exact (truncate (sqrt k)))]
12         [r (- k (* s s))])
13    (values s r)))
14
15(define (mod x y)
16  (- x (* (div x y) y)))
17
18(define (div-and-mod x y)
19  (let ([d (div x y)])
20      (values d (- x (* d y)))))
21
22(define (mod0 x y)
23    (- x (* (div0 x y) y)))
24
25(define (div0-and-mod0 x y)
26    (let ([d0 (div0 x y)])
27      (values d0 (- x (* d0 y)))))
28
29;; Originally from Ypsilon Scheme start
30(define (rationalize x e)
31  (or (real? x) (assertion-violation 'rationalize (format "expected real, but got ~s as argument 1" x) (list x e)))
32  (or (real? e) (assertion-violation 'rationalize (format "expected real, but got ~s as argument 2" e) (list x e)))
33  (cond ((infinite? e)
34         (if (infinite? x) +nan.0 0.0))
35        ((= x 0) x)
36        ((= x e) (- x e))
37        ((negative? x)
38         (- (rationalize (- x) e)))
39        (else
40         (let ((e (abs e)))
41           (let loop ((bottom (- x e)) (top (+ x e)))
42             (cond ((= bottom top) bottom)
43                   (else
44                    (let ((x (ceiling bottom)))
45                      (cond ((< x top) x)
46                            (else
47                             (let ((a (- x 1)))
48                               (+ a (/ 1 (loop (/ 1 (- top a)) (/ 1 (- bottom a))))))))))))))))
49;; Originally from Ypsilon Scheme end
50
51;; N.B. We can implement much faster version for Bignum using GMP.
52(define (gcd2 m n)
53  (if (zero? n)
54      (if (inexact? n) (inexact (abs m)) (abs m))
55      (gcd2 n (mod m n))))
56
57(define (gcd . n*)
58  (unless (for-all integer-valued? n*)
59    (assertion-violation 'gcd "integer valued numbers required"))
60  (case (length n*)
61    [(0) 0]
62    [(1) (abs (first n*))]
63    [(2) (gcd2 (first n*) (second n*))]
64    [else
65     (apply gcd (gcd2 (first n*) (second n*)) (cddr n*))]))
66
67(define (lcm2 a b)
68  (abs (/ (* a b) (gcd2 a b))))
69
70(define (lcm . n*)
71  (unless (for-all integer-valued? n*)
72    (assertion-violation 'lcm "integer valued numbers required"))
73  (case (length n*)
74    [(0) 1]
75    [(1) (abs (first n*))]
76    [(2) (lcm2 (first n*) (second n*))]
77    [else
78     (apply lcm (lcm2 (first n*) (second n*)) (cddr n*))]))
79