diff --git a/CHANGELOG.md b/CHANGELOG.md index e5502bcb1..8dbb0adef 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 caf88b6bd..9e1948121 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 d900d0553..1c1e05c44 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 26a7a94bd..a56f41a62 100644 Binary files a/dist/std.xcb and b/dist/std.xcb differ diff --git a/lib/R7RS.scm b/lib/R7RS.scm index dafda6914..ae8b99308 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 ()