Added optional second arg to R6RS log function

* module/rnrs/base.scm (log): now takes a base argument, using the
  change of base formula for logs.
* test-suite/tests/r6rs-base.test ("log (2nd arg)"): Add test cases.

diff --git a/module/rnrs/base.scm b/module/rnrs/base.scm
index b9dddab0b967ffbd2996137e213caf86e3c2f346..b867929fe59ffb1a9dba530c4d087908493e3281 100644 (file)
--- a/module/rnrs/base.scm
+++ b/module/rnrs/base.scm
@@ -74,6 +74,7 @@
 
          syntax-rules identifier-syntax)
   (import (rename (except (guile) error raise)
+                  (log log-internal)
                   (euclidean-quotient div)
                   (euclidean-remainder mod)
                   (euclidean/ div-and-mod)
@@ -85,6 +86,14 @@
                   (inexact->exact exact))
           (srfi srfi-11))
 
+ (define log
+   (case-lambda
+     ((n)
+      (log-internal n))
+     ((n base)
+      (/ (log n)
+         (log base)))))
+
  (define (boolean=? . bools)
    (define (boolean=?-internal lst last)
      (or (null? lst)

diff --git a/test-suite/tests/r6rs-base.test b/test-suite/tests/r6rs-base.test
index 1509b04ede071e36ac170f05aba8955ea2682a60..dfddf7c34b593b34d4e45482429db9e391c14b60 100644 (file)
--- a/test-suite/tests/r6rs-base.test
+++ b/test-suite/tests/r6rs-base.test
@@ -21,6 +21,22 @@
   :use-module ((rnrs base) :version (6))
   :use-module (test-suite lib))
 
+
+;; numbers are considered =? if their difference is less than a set
+;; tolerance
+(define (=? alpha beta)
+  (< (abs (- alpha beta)) 1e-10))
+
+(with-test-prefix "log (2nd arg)"
+  (pass-if "log positive-base" (=? (log 8 2) 3))
+  (pass-if "log negative-base" (=? (real-part (log 256 -4))
+                                   0.6519359443))
+  (pass-if "log base-one" (= (log 10 1) +inf.0))
+  (pass-if "log base-zero"
+    (catch #t
+      (lambda () (log 10 0) #f)
+      (lambda args #t))))
+
 (with-test-prefix "boolean=?"
   (pass-if "boolean=? null" (boolean=?))
   (pass-if "boolean=? unary" (boolean=? #f))