From bb30e8bc09ffaf5b7bf0ce7ecca17c55c8bf428d Mon Sep 17 00:00:00 2001
From: Kaz Kylheku <kaz@kylheku.com>
Date: Wed, 19 Mar 2014 00:07:48 -0700
Subject: * arith.c (tofloat, toint): New functions.

* arith.h (tofloat, toint): Declared.

* eval.c (eval_init): tofloat and toint registered
as intrinsics.

* txr.1: Documented.
---
 ChangeLog | 11 +++++++++++
 arith.c   | 50 ++++++++++++++++++++++++++++++++++++++++++++++++++
 arith.h   |  2 ++
 eval.c    |  2 ++
 txr.1     | 26 ++++++++++++++++++++++++++
 5 files changed, 91 insertions(+)

diff --git a/ChangeLog b/ChangeLog
index 0afa2f97..f65b56df 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,3 +1,14 @@
+2014-03-19  Kaz Kylheku  <kaz@kylheku.com>
+
+	* arith.c (tofloat, toint): New functions.
+
+	* arith.h (tofloat, toint): Declared.
+
+	* eval.c (eval_init): tofloat and toint registered
+	as intrinsics.
+
+	* txr.1: Documented.
+
 2014-03-16  Kaz Kylheku  <kaz@kylheku.com>
 
 	Version 86
diff --git a/arith.c b/arith.c
index 1eb9c5fb..63391848 100644
--- a/arith.c
+++ b/arith.c
@@ -1930,6 +1930,56 @@ val n_perm_k(val n, val k)
   return rising_product(plus(minus(n, k), one), n);
 }
 
+val tofloat(val obj)
+{
+  switch (tag(obj)) {
+  case TAG_NUM:
+    return flo_int(obj);
+  case TAG_LIT:
+    return flo_str(obj);
+  case TAG_PTR:
+    switch (type(obj)) {
+    case BGNUM:
+      return flo_int(obj);
+    case FLNUM:
+      return obj;
+    case STR:
+    case LSTR:
+      return flo_str(obj);
+    default:
+      break;
+    }
+    /* fallthrough */
+  default:
+    uw_throwf(error_s, lit("tofloat: ~s is not convertible to float"), obj, nao);
+  }
+}
+
+val toint(val obj, val base)
+{
+  switch (tag(obj)) {
+  case TAG_NUM:
+    return obj;
+  case TAG_LIT:
+    return int_str(obj, base);
+  case TAG_PTR:
+    switch (type(obj)) {
+    case BGNUM:
+      return obj;
+    case FLNUM:
+      return int_flo(obj);
+    case STR:
+    case LSTR:
+      return int_str(obj, base);
+    default:
+      break;
+    }
+    /* fallthrough */
+  default:
+    uw_throwf(error_s, lit("tofloat: ~s is not convertible to float"), obj, nao);
+  }
+}
+
 void arith_init(void)
 {
   mp_init(&NUM_MAX_MP);
diff --git a/arith.h b/arith.h
index a73bdde8..1479564c 100644
--- a/arith.h
+++ b/arith.h
@@ -33,4 +33,6 @@ val in_int_ptr_range(val bignum);
 val cum_norm_dist(val x);
 val n_choose_k(val n, val k);
 val n_perm_k(val n, val k);
+val tofloat(val obj);
+val toint(val obj, val base);
 void arith_init(void);
diff --git a/eval.c b/eval.c
index a0f73610..b0213253 100644
--- a/eval.c
+++ b/eval.c
@@ -3426,6 +3426,8 @@ void eval_init(void)
   reg_fun(intern(lit("num-str"), user_package), func_n1(num_str));
   reg_fun(intern(lit("int-flo"), user_package), func_n1(int_flo));
   reg_fun(intern(lit("flo-int"), user_package), func_n1(flo_int));
+  reg_fun(intern(lit("tofloat"), user_package), func_n1(tofloat));
+  reg_fun(intern(lit("toint"), user_package), func_n2o(toint, 1));
   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/txr.1 b/txr.1
index b9a1e2e7..4dbc7dbe 100644
--- a/txr.1
+++ b/txr.1
@@ -10317,6 +10317,32 @@ The flo-int function returns an exact floating point value corresponding to the
 integer argument, if possible, otherwise an approximation using a nearby
 floating point value.
 
+.SS Functions tofloat and toint
+
+.TP
+Syntax:
+
+  (tofloat <value>)
+  (toint <value> [<radix>])
+
+.TP
+Description:
+
+These convenience functions convert a given value to a floating-point value or
+to an integer, respectively.
+
+If a floating-point value is passed into tofloat, or an integer value into
+toint, then the value is simply returned.
+
+If <value> is a string, then it is converted by tofloat as if by the
+function flo-str, and by toint as if by the function int-str.
+
+If <value> is an integer, then it is converted by tofloat as if by
+the function flo-int.
+
+If <value> is a floating-point number, then it is converted by toint
+as if by the function int-flo.
+
 .SH BIT OPERATIONS
 
 In TXR Lisp, similarly to Common Lisp, bit operations on integers are based
-- 
cgit v1.2.3