commit 4ac6183168d2b019042bd21e77b4203b20bcae25
parent dc64313aac502c189571fe24cc5dd2f0605efb57
Author: Andres Navarro <canavarro82@gmail.com>
Date: Thu, 19 May 2011 04:43:12 -0300
Added sin, cos & tan to the ground environment.
Diffstat:
3 files changed, 64 insertions(+), 2 deletions(-)
diff --git a/src/kgnumbers.c b/src/kgnumbers.c
@@ -1852,7 +1852,7 @@ void kexp(klisp_State *K, TValue *xparams, TValue ptree, TValue denv)
UNUSED(denv);
UNUSED(xparams);
- bind_1tp(K, ptree, "real", krealp, n);
+ bind_1tp(K, ptree, "number", knumberp, n);
/* TEMP: do it inline for now */
TValue res = i2tv(0);
@@ -1873,6 +1873,7 @@ void kexp(klisp_State *K, TValue *xparams, TValue ptree, TValue denv)
res = kpositivep(K, n)? KIPINF : d2tv(0.0);
break;
case K_TRWNPV:
+ case K_TUNDEFINED:
klispE_throw_simple_with_irritants(K, "no primary value", 1, n);
return;
/* complex and undefined should be captured by type predicate */
@@ -1888,7 +1889,7 @@ void klog(klisp_State *K, TValue *xparams, TValue ptree, TValue denv)
UNUSED(denv);
UNUSED(xparams);
- bind_1tp(K, ptree, "real", krealp, n);
+ bind_1tp(K, ptree, "number", knumberp, n);
/* ASK John: error or no primary value, or undefined */
if (kfast_zerop(n)) {
@@ -1919,6 +1920,7 @@ void klog(klisp_State *K, TValue *xparams, TValue ptree, TValue denv)
res = KIPINF;
break;
case K_TRWNPV:
+ case K_TUNDEFINED:
klispE_throw_simple_with_irritants(K, "no primary value", 1, n);
return;
/* complex and undefined should be captured by type predicate */
@@ -1928,3 +1930,43 @@ void klog(klisp_State *K, TValue *xparams, TValue ptree, TValue denv)
}
kapply_cc(K, res);
}
+
+void ktrig(klisp_State *K, TValue *xparams, TValue ptree, TValue denv)
+{
+ UNUSED(denv);
+ /*
+ ** xparams[0]: trig function
+ */
+ double (*fn)(double) = pvalue(xparams[0]);
+
+ bind_1tp(K, ptree, "number", knumberp, n);
+
+ /* TEMP: do it inline for now */
+ TValue res = i2tv(0);
+ switch(ttype(n)) {
+ case K_TFIXINT:
+ case K_TBIGINT:
+ case K_TBIGRAT:
+ /* for now, all go to double */
+ n = kexact_to_inexact(K, n); /* no need to root it */
+ /* fall through */
+ case K_TDOUBLE: {
+ double d = (*fn)(dvalue(n));
+ res = ktag_double(d);
+ break;
+ }
+ case K_TEINF:
+ case K_TIINF:
+ /* is this ok? */
+ res = KRWNPV;
+ break;
+ case K_TRWNPV:
+ case K_TUNDEFINED:
+ klispE_throw_simple_with_irritants(K, "no primary value", 1, n);
+ return;
+ default:
+ klispE_throw_simple(K, "unsupported type");
+ return;
+ }
+ arith_kapply_cc(K, res);
+}
diff --git a/src/kgnumbers.h b/src/kgnumbers.h
@@ -178,6 +178,9 @@ void ksimplest_rational(klisp_State *K, TValue *xparams, TValue ptree,
void kexp(klisp_State *K, TValue *xparams, TValue ptree, TValue denv);
void klog(klisp_State *K, TValue *xparams, TValue ptree, TValue denv);
+/* 12.9.3 sin, cos, tan */
+void ktrig(klisp_State *K, TValue *xparams, TValue ptree, TValue denv);
+
/* REFACTOR: These should be in a knumber.h header */
/* Misc Helpers */
diff --git a/src/kground.c b/src/kground.c
@@ -9,6 +9,7 @@
#include <stdlib.h>
#include <stdbool.h>
#include <stdint.h>
+#include <math.h>
#include "kstate.h"
#include "kobject.h"
@@ -46,6 +47,7 @@
#include "keval.h"
#include "krepl.h"
+
/*
** BEWARE: this is highly unhygienic, it assumes variables "symbol" and
** "value", both of type TValue. symbol will be bound to a symbol named by
@@ -879,6 +881,21 @@ void kinit_ground_env(klisp_State *K)
add_applicative(K, ground_env, "exp", kexp, 0);
add_applicative(K, ground_env, "log", klog, 0);
+ /* 12.9.3 sin, cos, tan */
+ add_applicative(K, ground_env, "sin", ktrig, 1, sin);
+ add_applicative(K, ground_env, "cos", ktrig, 1, cos);
+ add_applicative(K, ground_env, "tan", ktrig, 1, tan);
+
+ /* 12.9.4 asin, acos, atan */
+ /* TODO */
+
+ /* 12.9.5 cos, sin, tan */
+ /* TODO */
+
+ /* 12.9.6 cos, sin, tan */
+ /* TODO */
+
+
/* TODO complete all other bindings of module real */
/*
