Added gcd lcm

scheme/base.sld

@@ -13,6 +13,8 @@
     exact?
     inexact?
     odd?
+    gcd
+    lcm
     call-with-current-continuation
     call/cc
     call-with-values
@@ -176,7 +178,6 @@
 ;    expt
 ;    foldl
 ;    foldr
-;    gcd
 ;    get-output-bytevector
 ;    get-output-string
 ;    include
@@ -184,7 +185,6 @@
 ;    input-port?
 ;    integer->char
 ;    integer?
-;    lcm
 ;    length
 ;    let*-values
 ;    let-values
@@ -899,4 +899,34 @@
   (define (inexact? num) (not (exact? num)))
   (define (max first . rest) (foldl (lambda (old new) (if (> old new) old new)) first rest))
   (define (min first . rest) (foldl (lambda (old new) (if (< old new) old new)) first rest))
+  ; Implementations of gcd and lcm using Euclid's algorithm
+  ;
+  ; Also note that each form is written to accept either 0 or
+  ; 2 arguments, per R5RS. This could probably be generalized
+  ; even further, if necessary.
+  ;
+  (define gcd gcd/entry)
+  (define lcm lcm/entry)
+  ; Main GCD algorithm
+  (define (gcd/main a b)
+    (if (= b 0)
+      (abs a)
+      (gcd/main b (modulo a b))))
+
+  ; A helper function to reduce the input list
+  (define (gcd/entry . nums)
+    (if (eqv? nums '())
+      0
+      (foldl gcd/main (car nums) (cdr nums))))
+
+  ; Main LCM algorithm
+  (define (lcm/main a b)
+    (abs (/ (* a b) (gcd/main a b))))
+
+  ; A helper function to reduce the input list
+  (define (lcm/entry . nums)
+    (if (eqv? nums '())
+      1
+      (foldl lcm/main (car nums) (cdr nums))))
+  ;; END gcd lcm
 ))