diff --git a/CHANGELOG.md b/CHANGELOG.md index e5502bcb..8dbb0ade 100755 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -14,6 +14,7 @@ * add immutable strings as in R7RS spec [#285](https://github.com/jcubic/lips/issues/285) * add R7RS `char<...>?` and `string<...>?` functions [#298](https://github.com/jcubic/lips/issues/298) * improve syntax-rule exception message (appending macro code) +* update `log` to accept two arguments [#301](https://github.com/jcubic/lips/issues/301) ### Bugfix * fix `let-values` to allow binding to list [#281](https://github.com/jcubic/lips/issues/281) * fix wrong strings in `string-fill!` diff --git a/dist/std.min.scm b/dist/std.min.scm index caf88b6b..9e194812 100644 --- a/dist/std.min.scm +++ b/dist/std.min.scm @@ -302,6 +302,7 @@ (define (truncate/ x y) (quotient&remainder x y)) (define (truncate-quotient x y) (quotient x y)) (define (truncate-remainder x y) (remainder x y)) +(define (log z . rest) "(log z)\u000A(log z1 z2)\u000A\u000AFunction that calculates natural logarithm of z where the argument can be\u000Aany number (including complex negative and rational). If the value is 0\u000Ait returns NaN. It two arguments are provided it will calculate logarithm\u000Aof z1 with given base-z2." (if (not (null? rest)) (let ((base (car rest))) (/ (log z) (log base))) (cond ((real? z) (cond ((zero? z) NaN) ((> z 0) (Math.log z)) (else (+ (Math.log (abs z)) (* Math.PI +1i))))) ((complex? z) (let ((arg (Math.atan2 (imag-part z) (real-part z)))) (+ (Math.log (z.modulus)) (* +1i arg)))) ((rational? z) (log (exact->inexact z)))))) (define-syntax case-lambda (syntax-rules () ((case-lambda (params body0 ...) ...) (lambda args (let ((len (length args))) (letrec-syntax ((cl (syntax-rules ::: () ((cl) (error "no matching clause")) ((cl ((p :::) . body) . rest) (if (= len (length (quote (p :::)))) (apply (lambda (p :::) . body) args) (cl . rest))) ((cl ((p ::: . tail) . body) . rest) (if (>= len (length (quote (p :::)))) (apply (lambda (p ::: . tail) . body) args) (cl . rest)))))) (cl (params body0 ...) ...)))))) "(case-lambda expr ...)\u000A\u000AMacro create new function with different version of the function depend on\u000Anumber of arguments. Each expression is similar to single lambda.\u000A\u000Ae.g.:\u000A\u000A (define sum\u000A (case-lambda\u000A ((x) x)\u000A ((x y) (+ x y))\u000A ((x y z) (+ x y z))))\u000A\u000A (sum 1)\u000A (sum 1 2)\u000A (sum 1 2 3)\u000A\u000AMore arguments will give an error.") (define (boolean=? . args) "(boolean=? b1 b2 ...)\u000A\u000AChecks if all arguments are boolean and if they are the same." (if (< (length args) 2) (error "boolean=?: too few arguments") (reduce (lambda (acc item) (and (boolean? item) (eq? acc item))) (car args) (cdr args)))) (define (port? x) "(port? x)\u000A\u000AReturns true if the argument is an input or output port object." (or (output-port? x) (input-port? x))) diff --git a/dist/std.scm b/dist/std.scm index d900d055..1c1e05c4 100644 --- a/dist/std.scm +++ b/dist/std.scm @@ -3553,6 +3553,31 @@ (define (truncate-quotient x y) (quotient x y)) (define (truncate-remainder x y) (remainder x y)) +(define (log z . rest) + "(log z) + (log z1 z2) + + Function that calculates natural logarithm of z where the argument can be + any number (including complex negative and rational). If the value is 0 + it returns NaN. It two arguments are provided it will calculate logarithm + of z1 with given base-z2." + (if (not (null? rest)) + (let ((base (car rest))) + (/ (log z) (log base))) + (cond ((real? z) + (cond ((zero? z) NaN) + ((> z 0) (Math.log z)) + (else + (+ (Math.log (abs z)) + (* Math.PI +i))))) + ((complex? z) + (let ((arg (Math.atan2 (imag-part z) + (real-part z)))) + (+ (Math.log (z.modulus)) + (* +i arg)))) + ((rational? z) + (log (exact->inexact z)))))) + ;; ----------------------------------------------------------------------------- (define-syntax case-lambda (syntax-rules () diff --git a/dist/std.xcb b/dist/std.xcb index 26a7a94b..a56f41a6 100644 Binary files a/dist/std.xcb and b/dist/std.xcb differ diff --git a/lib/R7RS.scm b/lib/R7RS.scm index dafda691..ae8b9930 100755 --- a/lib/R7RS.scm +++ b/lib/R7RS.scm @@ -245,6 +245,31 @@ (define (truncate-quotient x y) (quotient x y)) (define (truncate-remainder x y) (remainder x y)) +(define (log z . rest) + "(log z) + (log z1 z2) + + Function that calculates natural logarithm (base e) of z. Where the argument + can be any number (including complex negative and rational). If the value is 0 + it returns NaN. It two arguments are provided it will calculate logarithm + of z1 with given base z2." + (if (not (null? rest)) + (let ((base (car rest))) + (/ (log z) (log base))) + (cond ((real? z) + (cond ((zero? z) NaN) + ((> z 0) (Math.log z)) + (else + (+ (Math.log (abs z)) + (* Math.PI +i))))) + ((complex? z) + (let ((arg (Math.atan2 (imag-part z) + (real-part z)))) + (+ (Math.log (z.modulus)) + (* +i arg)))) + ((rational? z) + (log (exact->inexact z)))))) + ;; ----------------------------------------------------------------------------- (define-syntax case-lambda (syntax-rules ()