From 946c88ae095260a816aae8e1d5eacb32e4424718 Mon Sep 17 00:00:00 2001
From: Kaz Kylheku <kaz@kylheku.com>
Date: Thu, 22 Mar 2012 10:38:17 -0700
Subject: * arith.c (floorf, ceili, sine, cosi, atang, loga): New functions.

* eval.c (eval_init): New intrinsic functions registered:
floor, ceil, sin, cons, atan, log.

* lib.h (floorf, ceili, sine, cosi, atang, loga): Declared.

* txr.1: Doc stub section for new functions.

* txr.vim: Highighting added.
---
 ChangeLog | 13 +++++++++++++
 arith.c   | 30 ++++++++++++++++++++++++++++++
 eval.c    |  6 ++++++
 lib.h     |  6 ++++++
 txr.1     |  2 ++
 txr.vim   |  5 +++--
 6 files changed, 60 insertions(+), 2 deletions(-)

diff --git a/ChangeLog b/ChangeLog
index 7da801c8..0a264e7c 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,3 +1,16 @@
+2012-03-22  Kaz Kylheku  <kaz@kylheku.com>
+
+	* arith.c (floorf, ceili, sine, cosi, atang, loga): New functions.
+
+	* eval.c (eval_init): New intrinsic functions registered:
+	floor, ceil, sin, cons, atan, log.
+
+	* lib.h (floorf, ceili, sine, cosi, atang, loga): Declared.
+
+	* txr.1: Doc stub section for new functions.
+
+	* txr.vim: Highighting added.
+
 2012-03-22  Kaz Kylheku  <kaz@kylheku.com>
 
 	* arith.c (int_flo): If sprintf produces something
diff --git a/arith.c b/arith.c
index 6bb82efd..a820dc8e 100644
--- a/arith.c
+++ b/arith.c
@@ -1296,6 +1296,36 @@ inval:
             anum, bnum, nao);
 }
 
+val floorf(val num)
+{
+  return flo(floor(c_flo(to_float(lit("floor"), num))));
+}
+
+val ceili(val num)
+{
+  return flo(ceil(c_flo(to_float(lit("ceil"), num))));
+}
+
+val sine(val num)
+{
+  return flo(sin(c_flo(to_float(lit("sin"), num))));
+}
+
+val cosi(val num)
+{
+  return flo(cos(c_flo(to_float(lit("cos"), num))));
+}
+
+val atang(val num)
+{
+  return flo(atan(c_flo(to_float(lit("atan"), num))));
+}
+
+val loga(val num)
+{
+  return flo(log(c_flo(to_float(lit("log"), num))));
+}
+
 /*
  * TODO: replace this text-based hack!
  */
diff --git a/eval.c b/eval.c
index ba5bd6c5..af3b6a22 100644
--- a/eval.c
+++ b/eval.c
@@ -2187,6 +2187,12 @@ void eval_init(void)
   reg_fun(intern(lit("exptmod"), user_package), func_n3(exptmod));
   reg_fun(intern(lit("sqrt"), user_package), func_n1(sqroot));
   reg_fun(intern(lit("gcd"), user_package), func_n2(gcd));
+  reg_fun(intern(lit("floor"), user_package), func_n1(floorf));
+  reg_fun(intern(lit("ceil"), user_package), func_n1(ceili));
+  reg_fun(intern(lit("sin"), user_package), func_n1(sine));
+  reg_fun(intern(lit("cos"), user_package), func_n1(cosi));
+  reg_fun(intern(lit("atan"), user_package), func_n1(atang));
+  reg_fun(intern(lit("log"), user_package), func_n1(loga));
   reg_fun(intern(lit("fixnump"), user_package), func_n1(fixnump));
   reg_fun(intern(lit("bignump"), user_package), func_n1(bignump));
   reg_fun(intern(lit("floatp"), user_package), func_n1(floatp));
diff --git a/lib.h b/lib.h
index f6deb1ce..e4dbfb8d 100644
--- a/lib.h
+++ b/lib.h
@@ -426,6 +426,12 @@ val exptv(val nlist);
 val exptmod(val base, val exp, val mod);
 val sqroot(val anum);
 val gcd(val anum, val bnum);
+val floorf(val);
+val ceili(val);
+val sine(val);
+val cosi(val);
+val atang(val);
+val loga(val);
 val string_own(wchar_t *str);
 val string(const wchar_t *str);
 val string_utf8(const char *str);
diff --git a/txr.1 b/txr.1
index 685c5f82..280da48e 100644
--- a/txr.1
+++ b/txr.1
@@ -6649,6 +6649,8 @@ Certain object types have a custom equal function.
 
 .SS Arithmetic function abs
 
+.SS Arithmetic functions floor, ceil, sin, cos, atan, log
+
 .SS Functions fixnump, bignump, integerp, floatp, numberp
 
 .SS Functions zerop, evenp, oddp
diff --git a/txr.vim b/txr.vim
index 11af4e68..95b7c0f9 100644
--- a/txr.vim
+++ b/txr.vim
@@ -43,8 +43,9 @@ syn keyword txl_keyword contained reverse ldiff flatten lazy-flatten
 syn keyword txl_keyword contained memq memql memqual tree-find some
 syn keyword txl_keyword contained remq remql remqual
 syn keyword txl_keyword contained all none eq eql equal + - * / abs trunc mod
-syn keyword txl_keyword contained expt exptmod sqrt gcd fixnump bignump 
-syn keyword txl_keyword contained integerp floatp
+syn keyword txl_keyword contained expt exptmod sqrt gcd 
+syn keyword txl_keyword contained floor ceil sin cos atan log
+syn keyword txl_keyword contained fixnump bignump integerp floatp
 syn keyword txl_keyword contained numberp zerop evenp oddp >
 syn keyword txl_keyword contained zerop evenp oddp > < >= <= max min
 syn keyword txl_keyword contained search-regex match-regex regsub
-- 
cgit v1.2.3