klisp

commit 4f05c8ff1137f58b0d9732604d18bf39cc763947
parent 1c79e8289790fd9211da39f31e35de4c9b3215bb
Author: Andres Navarro <canavarro82@gmail.com>
Date:   Sun, 20 Mar 2011 03:27:35 -0300

Added - (2 args) to the ground environment.

Diffstat:
M
src/kgnumbers.c
 | 
37
+++++++++++++++++++++++++++++++++++++
M
src/kgnumbers.h
 | 
11
++++++++++-
M
src/kground.c
 | 
4
++++

3 files changed, 51 insertions(+), 1 deletion(-)
diff --git a/src/kgnumbers.c b/src/kgnumbers.c
@@ -184,3 +184,40 @@ void ktimes(klisp_State *K, TValue *xparams, TValue ptree, TValue denv)
 	return;
     }
 }
+
+/* 12.5.6 - */
+/* TEMP: for now only accept two arguments */
+void kminus(klisp_State *K, TValue *xparams, TValue ptree, TValue denv)
+{
+    UNUSED(denv);
+    UNUSED(xparams);
+
+    bind_2tp(K, "-", ptree, "number", knumberp, n1, "number", knumberp, n2);
+
+    switch(max_ttype(n1, n2)) {
+    case K_TFIXINT: {
+	int32_t i1 = ivalue(n1);
+	int32_t i2 = ivalue(n2);
+	/* TODO: check for overflow and create bigint */
+	kapply_cc(K, i2tv(i1-i2));
+    } 
+    case K_TEINF: {
+	if (ttiseinf(n1) && ttiseinf(n2)) {
+	    if (tv_equal(n1, n2)) {
+		/* TEMP: we don't have reals with no prim value yet */
+		/* also no strict arithmetic variable for now */
+		klispE_throw(K, "-: result has no primary value");
+		return;
+	    } else {
+		kapply_cc(K, n1);
+	    }
+	} else {
+	    kapply_cc(K, ttiseinf(n1)? n1 : kneg_inf(n2));
+	}
+    }
+    default:
+	/* shouldn't happen */
+	assert(0);
+	return;
+    }
+}
diff --git a/src/kgnumbers.h b/src/kgnumbers.h
@@ -52,7 +52,16 @@ void kplus(klisp_State *K, TValue *xparams, TValue ptree, TValue denv);
 /* TEMP: for now only accept two arguments */
 void ktimes(klisp_State *K, TValue *xparams, TValue ptree, TValue denv);
 
-/* Helper */
+/* 12.5.6 - */
+/* TEMP: for now only accept two arguments */
+void kminus(klisp_State *K, TValue *xparams, TValue ptree, TValue denv);
+
+/* Misc Helpers */
 inline bool kfast_zerop(TValue n) { return ttisfixint(n) && ivalue(n) == 0; }
+/* TEMP: only exact infinties */
+inline TValue kneg_inf(TValue i) 
+{ 
+    return tv_equal(i, KEPINF)? KEMINF : KEPINF; 
+}
 
 #endif
diff --git a/src/kground.c b/src/kground.c
@@ -513,6 +513,10 @@ void kinit_ground_env(klisp_State *K)
     /* TEMP: for now only accept two arguments */
     add_applicative(K, ground_env, "*", ktimes, 0);
 
+    /* 12.5.6 * */
+    /* TEMP: for now only accept two arguments */
+    add_applicative(K, ground_env, "-", kminus, 0);
+
     /* ... TODO */
 
     /*