picolisp

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:
M
lib/math32.l
 | 
18
+++++++++++++++---
M
lib/math64.l
 | 
26
+++++++++++++++++++++++---
M
lib/test.l
 | 
4
+++-
M
src/ext.c
 | 
56
+++++++++++++++++++++++++++++++++++++++++++++-----------
M
src64/version.l
 | 
4
++--
A
test/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