picolisp

Unnamed repository; edit this file to name it for gitweb.
git clone https://logand.com/git/picolisp.git/
Log | Files | Refs | README | LICENSE

commit 3380db547599afc1fdcee187bf82e14ac4aefeba
parent 77cbd0d9452b2ac1107e078e5ae1895d79a4662a
Author: Commit-Bot <unknown>
Date:   Tue, 18 May 2010 09:31:02 +0000

Automatic commit from picoLisp.tgz, From: Tue, 18 May 2010 06:31:02 GMT
Diffstat:
Mlib/math32.l | 18+++++++++++++++---
Mlib/math64.l | 26+++++++++++++++++++++++---
Mlib/test.l | 4+++-
Msrc/ext.c | 56+++++++++++++++++++++++++++++++++++++++++++++-----------
Msrc64/version.l | 4++--
Atest/lib/math.l | 43+++++++++++++++++++++++++++++++++++++++++++
6 files changed, 131 insertions(+), 20 deletions(-)

diff --git a/lib/math32.l b/lib/math32.l @@ -1,6 +1,9 @@ -# 21feb10abu +# 18may10abu # (c) Software Lab. Alexander Burger +(de pow (X Y) + (ext:Pow X Y 1.0) ) + (de exp (X) (ext:Exp X 1.0) ) @@ -16,7 +19,16 @@ (de tan (A) (ext:Tan A 1.0) ) -(de atan (X Y) - (ext:Atan X Y 1.0) ) +(de asin (A) + (ext:Asin A 1.0) ) + +(de acos (A) + (ext:Acos A 1.0) ) + +(de atan (A) + (ext:Atan A 1.0) ) + +(de atan2 (X Y) + (ext:Atan2 X Y 1.0) ) # vi:et:ts=3:sw=3 diff --git a/lib/math64.l b/lib/math64.l @@ -1,4 +1,4 @@ -# 22feb10abu +# 18may10abu # (c) Software Lab. Alexander Burger (load "lib/native.l") @@ -7,15 +7,23 @@ (and (gt0 X) ("log" X 1.0)) ) (gcc "math" NIL + (pow (X Y) "Pow" 'N X Y 1.0) (exp (X) "Exp" 'N X 1.0) ("log" (X) "Log" 'N X 1.0) (sin (A) "Sin" 'N A 1.0) (cos (A) "Cos" 'N A 1.0) (tan (A) "Tan" 'N A 1.0) - (atan (X Y) "Atan" 'N X Y 1.0) ) + (asin (A) "Asin" 'N A 1.0) + (acos (A) "Acos" 'N A 1.0) + (atan (A) "Atan" 'N A 1.0) + (atan2 (X Y) "Atan2" 'N X Y 1.0) ) #include <math.h> +long Pow(long x, long y, int scl) { + return round((double)scl * pow((double)x / (double)scl, (double)y / (double)scl)); +} + long Exp(long x, int scl) { return round((double)scl * exp((double)x / (double)scl)); } @@ -36,7 +44,19 @@ long Tan(long a, int scl) { return round((double)scl * tan((double)a / (double)scl)); } -long Atan(long x, long y, int scl) { +long Asin(long a, int scl) { + return round((double)scl * asin((double)a / (double)scl)); +} + +long Acos(long a, int scl) { + return round((double)scl * acos((double)a / (double)scl)); +} + +long Atan(long a, int scl) { + return round((double)scl * atan((double)a / (double)scl)); +} + +long Atan2(long x, long y, int scl) { return round((double)scl * atan2((double)x / (double)scl, (double)y / (double)scl)); } /**/ diff --git a/lib/test.l b/lib/test.l @@ -1,4 +1,4 @@ -# 09sep09abu +# 18may10abu # (c) Software Lab. Alexander Burger ### Unit Tests ### @@ -26,6 +26,8 @@ (load "test/lib/lint.l") +(load "test/lib/math.l") + (msg 'OK) # vi:et:ts=3:sw=3 diff --git a/src/ext.c b/src/ext.c @@ -1,4 +1,4 @@ -/* 21feb10abu +/* 18may10abu * (c) Software Lab. Alexander Burger */ @@ -71,6 +71,16 @@ any Snx(any ex) { /*** Math ***/ +// (ext:Pow 'x 'y 'scale) -> num +any Pow(any ex) { + double x, y, n; + + x = evDouble(ex, cdr(ex)); + y = evDouble(ex, cddr(ex)); + n = evDouble(ex, cdddr(ex)); + return doubleToNum(n * pow(x / n, y / n)); +} + // (ext:Exp 'x 'scale) -> num any Exp(any ex) { double x, n; @@ -91,36 +101,60 @@ any Log(any ex) { // (ext:Sin 'angle 'scale) -> num any Sin(any ex) { - any x; double a, n; - a = evDouble(ex, x = cdr(ex)); - n = evDouble(ex, cdr(x)); + a = evDouble(ex, cdr(ex)); + n = evDouble(ex, cddr(ex)); return doubleToNum(n * sin(a / n)); } // (ext:Cos 'angle 'scale) -> num any Cos(any ex) { - any x; double a, n; - a = evDouble(ex, x = cdr(ex)); - n = evDouble(ex, cdr(x)); + a = evDouble(ex, cdr(ex)); + n = evDouble(ex, cddr(ex)); return doubleToNum(n * cos(a / n)); } // (ext:Tan 'angle 'scale) -> num any Tan(any ex) { - any x; double a, n; - a = evDouble(ex, x = cdr(ex)); - n = evDouble(ex, cdr(x)); + a = evDouble(ex, cdr(ex)); + n = evDouble(ex, cddr(ex)); return doubleToNum(n * tan(a / n)); } -// (ext:Atan 'x 'y 'scale) -> num +// (ext:Asin 'angle 'scale) -> num +any Asin(any ex) { + double a, n; + + a = evDouble(ex, cdr(ex)); + n = evDouble(ex, cddr(ex)); + return doubleToNum(n * asin(a / n)); +} + +// (ext:Acos 'angle 'scale) -> num +any Acos(any ex) { + double a, n; + + a = evDouble(ex, cdr(ex)); + n = evDouble(ex, cddr(ex)); + return doubleToNum(n * acos(a / n)); +} + +// (ext:Atan 'angle 'scale) -> num any Atan(any ex) { + double a, n; + + a = evDouble(ex, cdr(ex)); + n = evDouble(ex, cddr(ex)); + return doubleToNum(n * atan(a / n)); +} + +// (ext:Atan2 'x 'y 'scale) -> num +any Atan2(any ex) { double x, y, n; x = evDouble(ex, cdr(ex)); diff --git a/src64/version.l b/src64/version.l @@ -1,6 +1,6 @@ -# 16may10abu +# 18may10abu # (c) Software Lab. Alexander Burger -(de *Version 3 0 2 21) +(de *Version 3 0 2 22) # vi:et:ts=3:sw=3 diff --git a/test/lib/math.l b/test/lib/math.l @@ -0,0 +1,43 @@ +# 18may10abu +# (c) Software Lab. Alexander Burger + +(load "lib/math.l") + +### pow ### +(test 8.0 (pow 2.0 3.0)) +(test 8.0 (pow 64.0 0.5)) + +### exp ### +(test 2.718282 (exp 1.0)) + +### log ### +(test 0.693147 (log 2.0)) + +### sin ### +(test 0.0 (sin 0.0)) +(test 1.0 (sin (/ pi 2))) + +### cos ### +(test 1.0 (cos 0.0)) +(test -1.0 (cos pi)) + +### tan ### +(test 0.0 (tan 0.0)) +(test 0.0 (tan pi)) + +### asin ### +(test 0.0 (asin 0.0)) +(test (/ pi 2) (asin 1.0)) + +### acos ### +(test 0.0 (acos 1.0)) +(test pi (acos -1.0)) + +### atan ### +(test 0.0 (atan 0.0)) + +### atan2 ### +(test 0.0 (atan2 0.0 1.0)) +(test (/ pi 2) (atan2 1.0 0.0)) + +# vi:et:ts=3:sw=3