gcd.scm

(define (gcd n m)
  (cond ((= n 0) m)
        ((= m 0) n)
        ((> n m) (print (remainder n m)) (gcd (remainder n m) m))
        ((< n m) (print (remainder m n)) (gcd (remainder m n) n))))

; {{{

(define (poly-remove0 l)
  (if (null? (cdr l)) l
      (if (= 0 (car l)) (poly-remove0 (cdr l)) l)))

(define (poly-mul-token l n)
  (if (= n 0) l
      (poly-mul-token (append l (list 0)) (- n 1))))

(define (poly-mul-num l n)
  (map (lambda (a) (* a n)) l))

(define (poly-iszero? l)
  (if (null? l) #t (if (= 0 (car l)) (poly-iszero? (cdr l)) #f)))

(define (poly-sub l1 l2)
  (cond ((< (length l1) (length l2)) (cons (* -1 (car l2))
                                           (poly-sub l1 (cdr l2))))
        ((> (length l1) (length l2)) (cons (caar l1)
                                           (poly-sub (cdr l1) l2)))
        (else
         (map (lambda (a b) (- a b)) l1 l2))))

(define (poly-cmp op l1 l2)
  (if (not (= (length (poly-remove0 l1)) (length (poly-remove0 l2))))
      (op (length (poly-remove0 l1)) (length (poly-remove0 l2)))
      (fold-right (lambda (a b rest) (if (not (= a b)) (op a b) rest))
                  (op 0 0)
                  l1 l2)))

(define (poly-div l1 l2)
  (cond ((< (length l1) (length l2))
         (values (make-list (+ 1 (- (length l1) (length l2))) 0) l1))
        ((> (length l1) (length l2))
         (receive (q r)
                  (poly-div l1 (poly-mul-token l2 (- (length l1) (length l2))))
                  (receive (qrest rrest)
                           (poly-div (cdr r) l2)
                           (values (append q qrest) (cons (car r) rrest)))))
        (else
         (values (list (/ (car l1) (car l2)))
                 (poly-sub l1 (poly-mul-num l2 (/ (car l1) (car l2))))))))
; }}}

(define (gcd-poly l1 l2)
  (cond ((poly-iszero? l1) l2)
        ((poly-iszero? l2) l1)
        ((poly-cmp (lambda (a b) (> a b)) l1 l2)
         (receive (q r) (poly-div l1 l2)
                  (begin
                    (print q (poly-remove0 r))
                    (if (= (car q) 0) r
                        (gcd-poly (poly-remove0 r) l2)))))
        ((poly-cmp (lambda (a b) (< a b)) l1 l2)
         (receive (q r) (poly-div l2 l1)
                  (begin
                    (print q (poly-remove0 r))
                    (if (= (car q) 0) r
                        (gcd-poly (poly-remove0 r) l1)))))))

(gcd-poly (list 81 216 324 312 214 104 36  8   1)
          (list 3  20  76  180 298 332 252 108 27))

;  (gcd 4106508504 228886641)