klisp

commit 57d3bff73d6d696c1e3add6c5df5b6205b2ed44d
parent cba5b0fd23a245318366ac131e76169d37ee94dd
Author: Andres Navarro <canavarro82@gmail.com>
Date:   Sun, 20 Mar 2011 03:56:04 -0300

Added abs to the ground environment.

Diffstat:
M
src/kgnumbers.c
 | 
24
+++++++++++++++++++++++-
M
src/kgnumbers.h
 | 
5
++++-
M
src/kground.c
 | 
2
++

3 files changed, 29 insertions(+), 2 deletions(-)
diff --git a/src/kgnumbers.c b/src/kgnumbers.c
@@ -237,7 +237,7 @@ bool kzerop(TValue n) { return kfast_zerop(n); }
 /* 12.5.10 positive?, negative? */
 /* use ftyped_predp */
 
-/* 12.5.10 odd?, even? */
+/* 12.5.11 odd?, even? */
 /* use ftyped_predp */
 
 /* Helpers for positive?, negative?, odd? & even? */
@@ -245,3 +245,25 @@ bool kpositivep(TValue n) { return ivalue(n) > 0; }
 bool knegativep(TValue n) { return ivalue(n) < 0; }
 bool koddp(TValue n) { return (ivalue(n) & 1) != 0; }
 bool kevenp(TValue n) { return (ivalue(n) & 1) == 0; }
+
+/* 12.5.12 abs */
+void kabs(klisp_State *K, TValue *xparams, TValue ptree, TValue denv)
+{
+    UNUSED(xparams);
+    UNUSED(denv);
+
+    bind_1tp(K, "abs", ptree, "number", knumberp, n);
+
+    switch(ttype(n)) {
+    case K_TFIXINT: {
+	int32_t i = ivalue(n);
+	kapply_cc(K, i < 0? i2tv(-i) : n);
+    }
+    case K_TEINF:
+	kapply_cc(K, KEPINF);
+    default:
+	/* shouldn't happen */
+	assert(0);
+	return;
+    }
+}
diff --git a/src/kgnumbers.h b/src/kgnumbers.h
@@ -71,7 +71,7 @@ bool kzerop(TValue n);
 /* 12.5.10 positive?, negative? */
 /* use ftyped_predp */
 
-/* 12.5.10 odd?, even? */
+/* 12.5.11 odd?, even? */
 /* use ftyped_predp */
 
 /* Helpers for positive?, negative?, odd? & even? */
@@ -80,6 +80,9 @@ bool knegativep(TValue n);
 bool koddp(TValue n);
 bool kevenp(TValue n);
 
+/* 12.5.12 abs */
+void kabs(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 */
diff --git a/src/kground.c b/src/kground.c
@@ -539,6 +539,8 @@ void kinit_ground_env(klisp_State *K)
     add_applicative(K, ground_env, "even?", ftyped_predp, 3, symbol, 
 		    p2tv(kintegerp), p2tv(kevenp));
 
+    /* 12.5.12 abs */
+    add_applicative(K, ground_env, "abs", kabs, 0);
 
     /* ... TODO */