* arith.c (plus): Optimization: use num_fast when

result is in the fixnum range.
Implemented FLNUM cases, except for adding a FLNUM
to BGNUM.
(minus, mul): Use num_fast when the cnum value is in the fixnum range.
(int_flo): New function.

* eval.c (eval_init): Register int-flo intrinsic.

* lib.c (c_flo): New function.

* lib.h (TYPE_SHIFT, TYPE_PAIR): New macros, carried over
from the lazy strings branch.
(c_flo, int_flo): Declared.

5 files changed, 164 insertions, 46 deletions

diff --git a/ChangeLog b/ChangeLog
index 582151d3..21b6aa76 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,5 +1,22 @@
 2012-03-20  Kaz Kylheku  <kaz@kylheku.com>
 
+	* arith.c (plus): Optimization: use num_fast when
+	result is in the fixnum range.
+	Implemented FLNUM cases, except for adding a FLNUM
+	to BGNUM.
+	(minus, mul): Use num_fast when the cnum value is in the fixnum range.
+	(int_flo): New function.
+
+	* eval.c (eval_init): Register int-flo intrinsic.
+
+	* lib.c (c_flo): New function.
+
+	* lib.h (TYPE_SHIFT, TYPE_PAIR): New macros, carried over
+	from the lazy strings branch.
+	(c_flo, int_flo): Declared.
+
+2012-03-20  Kaz Kylheku  <kaz@kylheku.com>
+
 	* parser.l (FLO): Adjusted syntax of floating point numbers
 	to allow leading or trailing decimal.
 
diff --git a/arith.c b/arith.c
index 450b4e38..5c17048d 100644
--- a/arith.c
+++ b/arith.c
@@ -271,58 +271,92 @@ val plus(val anum, val bnum)
 
       if (sum < NUM_MIN || sum > NUM_MAX)
         return bignum(sum);
-      return num(sum);
+      return num_fast(sum);
     } 
   case TAG_PAIR(TAG_NUM, TAG_PTR):
-    {
-      val n;
-      type_check(bnum, BGNUM);
-      n = make_bignum();
-      if (sizeof (int_ptr_t) <= sizeof (mp_digit))  {
+    switch (type(bnum)) {
+    case BGNUM:
+      {
+        val n;
+        n = make_bignum();
+        if (sizeof (int_ptr_t) <= sizeof (mp_digit))  {
+          cnum a = c_num(anum);
+          cnum ap = ABS(a);
+          if (a > 0)
+            mp_add_d(mp(bnum), ap, mp(n));
+          else
+            mp_sub_d(mp(bnum), ap, mp(n));
+        } else {
+          mp_int tmp;
+          mp_init(&tmp);
+          mp_set_intptr(&tmp, c_num(anum));
+          mp_add(mp(bnum), &tmp, mp(n));
+          mp_clear(&tmp);
+        }
+        return normalize(n);
+      }
+    case FLNUM:
+      {
         cnum a = c_num(anum);
-        cnum ap = ABS(a);
-        if (a > 0)
-          mp_add_d(mp(bnum), ap, mp(n));
-        else
-          mp_sub_d(mp(bnum), ap, mp(n));
-      } else {
-        mp_int tmp;
-        mp_init(&tmp);
-        mp_set_intptr(&tmp, c_num(anum));
-        mp_add(mp(bnum), &tmp, mp(n));
-        mp_clear(&tmp);
+        return flo((double) a + c_flo(bnum));
       }
-      return normalize(n);
+    default:
+      break;
     }
+    break;
   case TAG_PAIR(TAG_PTR, TAG_NUM):
-    {
-      val n;
-      type_check(anum, BGNUM);
-      n = make_bignum();
-      if (sizeof (int_ptr_t) <= sizeof (mp_digit))  {
+    switch (type(anum)) {
+    case BGNUM:
+      {
+        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 (b > 0)
+            mp_add_d(mp(anum), bp, mp(n));
+          else
+            mp_sub_d(mp(anum), bp, mp(n));
+        } else {
+          mp_int tmp;
+          mp_init(&tmp);
+          mp_set_intptr(&tmp, c_num(bnum));
+          mp_add(mp(anum), &tmp, mp(n));
+          mp_clear(&tmp);
+        }
+        return normalize(n);
+      }
+    case FLNUM:
+      {
         cnum b = c_num(bnum);
-        cnum bp = ABS(b);
-        if (b > 0)
-          mp_add_d(mp(anum), bp, mp(n));
-        else
-          mp_sub_d(mp(anum), bp, mp(n));
-      } else {
-        mp_int tmp;
-        mp_init(&tmp);
-        mp_set_intptr(&tmp, c_num(bnum));
-        mp_add(mp(anum), &tmp, mp(n));
-        mp_clear(&tmp);
+        return flo((double) b + c_flo(anum));
       }
-      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();
-      mp_add(mp(anum), mp(bnum), mp(n));
-      return normalize(n);
+    switch (TYPE_PAIR(type(anum), type(bnum))) {
+    case TYPE_PAIR(BGNUM, BGNUM):
+      {
+        val n;
+        type_check(anum, BGNUM);
+        type_check(bnum, BGNUM);
+        n = make_bignum();
+        mp_add(mp(anum), mp(bnum), mp(n));
+        return normalize(n);
+      }
+    case TYPE_PAIR(FLNUM, FLNUM):
+      {
+        return flo(c_flo(anum) + c_flo(bnum));
+      }
+    case TYPE_PAIR(BGNUM, FLNUM):
+    case TYPE_PAIR(FLNUM, BGNUM):
+      uw_throwf(error_s, lit("plus: unimplemented bignum float combo ~s ~s"),
+                anum, bnum, nao);
+    default:
+      break;
     }
   case TAG_PAIR(TAG_CHR, TAG_NUM):
     {
@@ -367,7 +401,7 @@ val minus(val anum, val bnum)
 
       if (sum < NUM_MIN || sum > NUM_MAX)
         return bignum(sum);
-      return num(sum);
+      return num_fast(sum);
     } 
   case TAG_PAIR(TAG_NUM, TAG_PTR):
     {
@@ -475,15 +509,15 @@ val mul(val anum, val bnum)
       double_intptr_t product = a * (double_intptr_t) b;
       if (product < NUM_MIN || product > NUM_MAX)
         return bignum_dbl_ipt(product);
-      return num(product);
+      return num_fast(product);
 #else
       cnum ap = ABS(a);
       cnum bp = ABS(b);
       if (highest_bit(ap) + highest_bit(bp) < CNUM_BIT - 1) {
         cnum product = a * b;
         if (product >= NUM_MIN && product <= NUM_MAX)
-          return num(a * b);
-        return bignum(a * b);
+          return num_fast(product);
+        return bignum(product);
       } else {
         val n = make_bignum();
         mp_int tmpb;
@@ -1068,6 +1102,61 @@ inval:
             anum, bnum, nao);
 }
 
+/*
+ * TODO: replace this text-based hack!
+ */
+val int_flo(val f)
+{
+  double d = c_flo(f);
+
+  if (d >= INT_PTR_MAX && d <= INT_PTR_MIN) {
+    cnum n = d;
+    if (n < NUM_MIN || n > NUM_MAX)
+      return bignum(n);
+    return num_fast(n);
+  } else {
+    char text[128];
+    char mint[128] = "", mfrac[128] = "", *pint = mint;
+    int have_point, have_exp;
+    int exp = 0, fdigs;
+
+    sprintf(text, "%.64g", d);
+
+    have_exp = (strchr(text, 'e') != 0);
+    have_point = (strchr(text, '.') != 0);
+
+    if (have_exp && have_point)
+      sscanf(text, "%127[0-9].%127[0-9]e%d", mint, mfrac, &exp);
+    else if (have_exp)
+      sscanf(text, "%127[0-9]e%d", mint, &exp);
+    else if (have_point)
+      sscanf(text, "%127[0-9].%127[0-9]", mint, mfrac);
+    else
+      return int_str(string_utf8(text), nil);
+
+    if (have_exp && exp < 0)
+      return zero;
+
+    fdigs = have_point ? strlen(mfrac) : 0;
+
+    if (exp <= fdigs) {
+      fdigs = exp;
+      exp = 0;
+    } else {
+      exp -= fdigs;
+    }
+
+    {
+      char mintfrac[256];
+      val out;
+      val e10 = (exp == 0) ? one : expt(num_fast(10), num(exp));
+      sprintf(mintfrac, "%s%.*s", pint, fdigs, mfrac);
+      out = int_str(string_utf8(mintfrac), nil);
+      return mul(out, e10);
+    }
+  }
+}
+
 void arith_init(void)
 {
   mp_init(&NUM_MAX_MP);
diff --git a/eval.c b/eval.c
index 26e31f59..c56919a7 100644
--- a/eval.c
+++ b/eval.c
@@ -2291,6 +2291,7 @@ void eval_init(void)
   reg_fun(intern(lit("string-lt"), user_package), func_n2(string_lt));
   reg_fun(intern(lit("int-str"), user_package), func_n2o(int_str, 1));
   reg_fun(intern(lit("flo-str"), user_package), func_n1(flo_str));
+  reg_fun(intern(lit("int-flo"), user_package), func_n1(int_flo));
   reg_fun(intern(lit("chrp"), user_package), func_n1(chrp));
   reg_fun(intern(lit("chr-isalnum"), user_package), func_n1(chr_isalnum));
   reg_fun(intern(lit("chr-isalpha"), user_package), func_n1(chr_isalpha));
diff --git a/lib.c b/lib.c
index 306d1118..21b87fed 100644
--- a/lib.c
+++ b/lib.c
@@ -1135,6 +1135,12 @@ val flo(double n)
   return obj;
 }
 
+double c_flo(val num)
+{
+  type_check(num, FLNUM);
+  return num->fl.n;
+}
+
 val fixnump(val num)
 {
   return (is_num(num)) ? t : nil;
diff --git a/lib.h b/lib.h
index 47fa3d38..211d27de 100644
--- a/lib.h
+++ b/lib.h
@@ -43,6 +43,9 @@ typedef enum type {
   BGNUM, FLNUM
 } type_t;
 
+#define TYPE_SHIFT 4
+#define TYPE_PAIR(A, B) ((A) << TYPE_SHIFT | (B))
+
 typedef enum functype
 {
    FINTERP,             /* Interpreted function. */
@@ -386,6 +389,7 @@ val improper_plist_to_alist(val list, val boolean_keys);
 val num(cnum val);
 val flo(double val);
 cnum c_num(val num);
+double c_flo(val num);
 val fixnump(val num);
 val bignump(val num);
 val floatp(val num);
@@ -449,6 +453,7 @@ val trim_str(val str);
 val string_lt(val astr, val bstr);
 val int_str(val str, val base);
 val flo_str(val str);
+val int_flo(val f);
 val chrp(val chr);
 wchar_t c_chr(val chr);
 val chr_isalnum(val ch);