From 56600f5e7ceb6339a20966b0f827634c8a7bf8ff Mon Sep 17 00:00:00 2001
From: Kaz Kylheku <kaz@kylheku.com>
Date: Wed, 21 Mar 2012 15:52:09 -0700
Subject: * arith.c (trunc): Floating support.

---
 ChangeLog |   4 +++
 arith.c   | 107 ++++++++++++++++++++++++++++++++++++++++++--------------------
 2 files changed, 77 insertions(+), 34 deletions(-)

diff --git a/ChangeLog b/ChangeLog
index 0b07cdbf..c2add367 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,3 +1,7 @@
+2012-03-21  Kaz Kylheku  <kaz@kylheku.com>
+
+	* arith.c (trunc): Floating support.
+
 2012-03-21  Kaz Kylheku  <kaz@kylheku.com>
 
 	* arith.c (plus, minus, mul): Removing unnecessary type checks,
diff --git a/arith.c b/arith.c
index 1a5981ec..f97a163a 100644
--- a/arith.c
+++ b/arith.c
@@ -634,10 +634,8 @@ tail:
 
 val trunc(val anum, val bnum)
 {
-  int tag_a = tag(anum);
-  int tag_b = tag(bnum);
-
-  switch (TAG_PAIR(tag_a, tag_b)) {
+tail:
+  switch (TAG_PAIR(tag(anum), tag(bnum))) {
   case TAG_PAIR(TAG_NUM, TAG_NUM):
     {
       cnum a = c_num(anum);
@@ -655,41 +653,82 @@ val trunc(val anum, val bnum)
       }
     }
   case TAG_PAIR(TAG_NUM, TAG_PTR):
-    type_check(bnum, BGNUM);
-    return zero;
-  case TAG_PAIR(TAG_PTR, TAG_NUM):
-    {
-      val n;
-      type_check(anum, BGNUM);
-      n = make_bignum();
-      if (sizeof (int_ptr_t) <= sizeof (mp_digit)) {
-        cnum b = c_num(bnum);
-        cnum bp = ABS(b);
-        if (mp_div_d(mp(anum), bp, mp(n), 0) != MP_OKAY)
+    switch (type(bnum)) {
+    case BGNUM:
+      return zero;
+    case FLNUM:
+      {
+        double x = c_num(anum), y = c_flo(bnum);
+        if (y == 0.0)
           goto divzero;
-        if (b < 0)
-          mp_neg(mp(n), mp(n));
-      } else {
-        int err;
-        mp_int tmp;
-        mp_init(&tmp);
-        mp_set_intptr(&tmp, c_num(bnum));
-        err = mp_div(mp(anum), &tmp, mp(n), 0);
-        mp_clear(&tmp);
-        if (err != MP_OKAY)
+        else 
+          return flo((x - fmod(x, y))/y);
+      }
+    default:
+      break;
+    }
+    break;
+  case TAG_PAIR(TAG_PTR, TAG_NUM):
+    switch (type(anum)) {
+    case BGNUM:
+      {
+        val n;
+        n = make_bignum();
+        if (sizeof (int_ptr_t) <= sizeof (mp_digit)) {
+          cnum b = c_num(bnum);
+          cnum bp = ABS(b);
+          if (mp_div_d(mp(anum), bp, mp(n), 0) != MP_OKAY)
+            goto divzero;
+          if (b < 0)
+            mp_neg(mp(n), mp(n));
+        } else {
+          int err;
+          mp_int tmp;
+          mp_init(&tmp);
+          mp_set_intptr(&tmp, c_num(bnum));
+          err = mp_div(mp(anum), &tmp, mp(n), 0);
+          mp_clear(&tmp);
+          if (err != MP_OKAY)
+            goto divzero;
+        }
+        return normalize(n);
+      }
+    case FLNUM:
+      {
+        double x = c_flo(anum), y = c_num(bnum);
+        if (y == 0.0)
           goto divzero;
+        else 
+          return flo((x - fmod(x, y))/y);
       }
-      return normalize(n);
+    default:
+      break;
     }
+    break;
   case TAG_PAIR(TAG_PTR, TAG_PTR):
-    {
-      val n;
-      type_check(anum, BGNUM);
-      type_check(bnum, BGNUM);
-      n = make_bignum();
-      if (mp_div(mp(anum), mp(bnum), mp(n), 0) != MP_OKAY)
-        goto divzero;
-      return normalize(n);
+    switch (TYPE_PAIR(type(anum), type (bnum))) {
+    case TYPE_PAIR(BGNUM, BGNUM):
+      {
+        val n;
+        n = make_bignum();
+        if (mp_div(mp(anum), mp(bnum), mp(n), 0) != MP_OKAY)
+          goto divzero;
+        return normalize(n);
+      }
+    case TYPE_PAIR(FLNUM, FLNUM):
+      {
+        double x = c_flo(anum), y = c_flo(bnum);
+        if (y == 0.0)
+          goto divzero;
+        else 
+          return flo((x - fmod(x, y))/y);
+      }
+    case TYPE_PAIR(BGNUM, FLNUM):
+      anum = flo_int(anum);
+      goto tail;
+    case TYPE_PAIR(FLNUM, BGNUM):
+      bnum = flo_int(bnum);
+      goto tail;
     }
   }
   uw_throwf(error_s, lit("trunc: invalid operands ~s ~s"), anum, bnum, nao);
-- 
cgit v1.2.3