From 3f7c28ed9255ce0332b2e9214ee771c8a1a8dd1c Mon Sep 17 00:00:00 2001
From: Kaz Kylheku <kaz@kylheku.com>
Date: Wed, 21 Mar 2012 16:47:46 -0700
Subject: * arith.c (divi): New function.

* eval.c (eval_init): divi registered as / intrinsic.

* lib.h (divi): Declared.

* txr.1: divi added to stub heading.

* txr.vim: / operator highlighted.
---
 ChangeLog | 12 ++++++++++++
 arith.c   | 38 ++++++++++++++++++++++++++++++++++++++
 eval.c    |  1 +
 lib.h     |  1 +
 txr.1     |  2 +-
 txr.vim   |  2 +-
 6 files changed, 54 insertions(+), 2 deletions(-)

diff --git a/ChangeLog b/ChangeLog
index 4ae9d8bd..7bce62db 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,3 +1,15 @@
+2012-03-21  Kaz Kylheku  <kaz@kylheku.com>
+
+	* arith.c (divi): New function.
+
+	* eval.c (eval_init): divi registered as / intrinsic.
+
+	* lib.h (divi): Declared.
+
+	* txr.1: divi added to stub heading.
+
+	* txr.vim: / operator highlighted.
+
 2012-03-21  Kaz Kylheku  <kaz@kylheku.com>
 
 	* arith.c (mod): Floating support.
diff --git a/arith.c b/arith.c
index f888ca6f..87565a7e 100644
--- a/arith.c
+++ b/arith.c
@@ -880,6 +880,44 @@ divzero:
   uw_throw(numeric_error_s, lit("mod: division by zero"));
 }
 
+val divi(val anum, val bnum)
+{
+  switch (type(anum)) {
+  case NUM:
+  case BGNUM:
+    anum = flo_int(anum);
+  case FLNUM:
+    break;
+  default:
+    goto type;
+  }
+
+  switch (type(bnum)) {
+  case NUM:
+  case BGNUM:
+    bnum = flo_int(bnum);
+  case FLNUM:
+    break;
+  default:
+    goto type;
+  }
+
+  {
+    double a = c_flo(anum);
+    double b = c_flo(bnum);
+
+    if (b == 0.0)
+      goto divzero;
+
+    return flo(a / b);
+  }
+
+divzero:
+  uw_throw(numeric_error_s, lit("divi: division by zero"));
+type:
+  uw_throwf(error_s, lit("divi: invalid operands ~s ~s"), anum, bnum, nao);
+}
+
 val zerop(val num)
 {
   if (num == zero)
diff --git a/eval.c b/eval.c
index e185acb0..823a20d0 100644
--- a/eval.c
+++ b/eval.c
@@ -2182,6 +2182,7 @@ void eval_init(void)
   reg_fun(intern(lit("abs"), user_package), func_n1(abso));
   reg_fun(intern(lit("trunc"), user_package), func_n2(trunc));
   reg_fun(intern(lit("mod"), user_package), func_n2(mod));
+  reg_fun(intern(lit("/"), user_package), func_n2(divi));
   reg_fun(intern(lit("expt"), user_package), func_n0v(exptv));
   reg_fun(intern(lit("exptmod"), user_package), func_n3(exptmod));
   reg_fun(intern(lit("sqrt"), user_package), func_n1(isqrt));
diff --git a/lib.h b/lib.h
index df9c2592..6ce793b3 100644
--- a/lib.h
+++ b/lib.h
@@ -405,6 +405,7 @@ val mul(val anum, val bnum);
 val mulv(val nlist);
 val trunc(val anum, val bnum);
 val mod(val anum, val bnum);
+val divi(val anum, val bnum);
 val zerop(val num);
 val evenp(val num);
 val oddp(val num);
diff --git a/txr.1 b/txr.1
index ab0fd70b..685c5f82 100644
--- a/txr.1
+++ b/txr.1
@@ -6641,7 +6641,7 @@ symbols, packages, or streams are equal if they are the same hash.
 
 Certain object types have a custom equal function.
 
-.SS Arithmetic functions +, -, *, trunc, mod, expt, sqrt
+.SS Arithmetic functions +, -, *, /, trunc, mod, expt, sqrt
 
 .SS Arithmetic function exptmod
 
diff --git a/txr.vim b/txr.vim
index 0ec1dd72..11af4e68 100644
--- a/txr.vim
+++ b/txr.vim
@@ -42,7 +42,7 @@ syn keyword txl_keyword contained second third fourth fifth sixth copy-list nrev
 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 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 numberp zerop evenp oddp >
-- 
cgit v1.2.3