; three binary algorithms
(define (lshift x) (* x 2))
(define (rshift x) (quotient x 2))
(define (add1 x) (+ x 1))
(define (multiply left right)
(let loop ((left left) (right right) (prod 0))
(if (zero? left) prod
(loop (rshift left) (lshift right)
(if (odd? left) (+ prod right) prod)))))
(define (divide n d)
(let loop ((t d))
(if (<= t n) (loop (lshift t))
(let loop ((t (rshift t)) (q 0) (r n))
(cond ((< t d) (values q r))
((<= t r) (loop (rshift t) (add1 (lshift q)) (- r t)))
(else (loop (rshift t) (lshift q) r)))))))
(define (stein-gcd n m)
(let loop ((n n) (m m))
(if (zero? n) m (if (zero? m) n
(if (even? n)
(if (even? m)
(lshift (loop (rshift n) (rshift m)))
(loop (rshift n) m))
(if (even? m)
(loop n (rshift m))
(if (< n m)
(loop n (- m n))
(loop (- n m) m))))))))
(display (multiply 14 12)) (newline)
(let-values (((q r) (divide 837 43)))
(display q) (display " ") (display r) (newline))
(display (stein-gcd 2322 654)) (newline)