* configure (uintptr): New variable. Indicates whether unsigned

version of intptr_t is available and should be generated in config.h
as uintptr_t.

* eval.c (eval_init): New intrinsic functions floatp,
integerp, flo-str.

* gc.c (finalize): Handle FLNUM case. Rearranged
cases so that all trivially returning cases are
together.
(mark): Handle FLNUM case.

* hash.c (hash_double): New function.
(equal_hash): Handle FLNUM via hash_double.
(eql_hash): Likewise.

* lib.c: <math.h> is included.
(float_s): New symbol variable.
(code2type, equal): Handle FLNUM case in switch.
(integerp): New function; does the same thing
as integerp before.
(numberp): Returns t for floats.
(flo, floatp, flo_str): New functions.
(obj_init): Initialize new float_s variable.
(obj_print, obj_pprint): Handle FLNUM case in switch.
Printing does not work yet; needs work in stream.c.

* lib.h (enum type): New enumeration FLNUM.
(struct flonum): New struct type.
(union obj): New member, fl.
(float_s, flo, floatp, integerp, flo_str): Declared.

* parser.l (FLO): New token pattern definition.
Scans to a NUMBER token.
Corrected uses of yylval.num to yylval.val.

* parser.y (%union): Removed num member from yystype.

1 files changed, 54 insertions, 2 deletions

diff --git a/lib.c b/lib.c
index ec72754f..306d1118 100644
--- a/lib.c
+++ b/lib.c
@@ -35,6 +35,7 @@
 #include <setjmp.h>
 #include <errno.h>
 #include <wchar.h>
+#include <math.h>
 #include "config.h"
 #ifdef HAVE_GETENVIRONMENTSTRINGS
 #define NOMINMAX
@@ -61,7 +62,7 @@ val system_package, keyword_package, user_package;
 
 val null, t, cons_s, str_s, chr_s, fixnum_s, sym_s, pkg_s, fun_s, vec_s;
 val stream_s, hash_s, hash_iter_s, lcons_s, lstr_s, cobj_s, cptr_s;
-val env_s, bignum_s;
+val env_s, bignum_s, float_s;
 val var_s, expr_s, regex_s, chset_s, set_s, cset_s, wild_s, oneplus_s;
 val nongreedy_s, compiled_regex_s;
 val quote_s, qquote_s, unquote_s, splice_s;
@@ -116,6 +117,7 @@ static val code2type(int code)
   case COBJ: return cobj_s;
   case ENV: return env_s;
   case BGNUM: return bignum_s;
+  case FLNUM: return float_s;
   }
   return nil;
 }
@@ -909,6 +911,10 @@ val equal(val left, val right)
     if (type(right) == BGNUM && mp_cmp(mp(left), mp(right)) == MP_EQ)
       return t;
     return nil;
+  case FLNUM:
+    if (type(right) == FLNUM && left->fl.n == right->fl.n)
+      return t;
+    return nil;
   case COBJ:
     if (type(right) == COBJ)
       return left->co.ops->equal(left, right);
@@ -1121,6 +1127,14 @@ cnum c_num(val num)
   }
 }
 
+val flo(double n)
+{
+  val obj = make_obj();
+  obj->fl.type = FLNUM;
+  obj->fl.n = n;
+  return obj;
+}
+
 val fixnump(val num)
 {
   return (is_num(num)) ? t : nil;
@@ -1131,7 +1145,7 @@ val bignump(val num)
   return (type(num) == BGNUM) ? t : nil;
 }
 
-val numberp(val num)
+val integerp(val num)
 {
   switch (tag(num)) {
   case TAG_NUM:
@@ -1147,6 +1161,27 @@ val numberp(val num)
   }
 }
 
+val floatp(val num)
+{
+  return (type(num) == FLNUM) ? t : nil;
+}
+
+val numberp(val num)
+{
+  switch (tag(num)) {
+  case TAG_NUM:
+    return t;
+  case TAG_PTR:
+    if (num == nil)
+      return nil;
+    if (num->t.type == BGNUM || num->t.type == FLNUM)
+      return t;
+    /* fallthrough */
+  default:
+    return nil;
+  }
+}
+
 val plusv(val nlist)
 {
   if (!nlist)
@@ -1916,6 +1951,20 @@ val int_str(val str, val base)
   return num(value);
 }
 
+val flo_str(val str)
+{
+  const wchar_t *wcs = c_str(str);
+  wchar_t *ptr;
+
+  /* TODO: detect if we have wcstod */
+  double value = wcstod(wcs, &ptr);
+  if (value == 0 && ptr == wcs)
+    return nil;
+  if ((value == HUGE_VAL || value == -HUGE_VAL) && errno == ERANGE)
+    return nil;
+  return flo(value);
+}
+
 val chrp(val chr)
 {
   return (is_chr(chr)) ? t : nil;
@@ -3978,6 +4027,7 @@ static void obj_init(void)
   cptr_s = intern(lit("cptr"), user_package);
   env_s = intern(lit("env"), user_package);
   bignum_s = intern(lit("bignum"), user_package);
+  float_s = intern(lit("float"), user_package);
   var_s = intern(lit("var"), system_package);
   expr_s = intern(lit("expr"), system_package);
   regex_s = intern(lit("regex"), system_package);
@@ -4169,6 +4219,7 @@ val obj_print(val obj, val out)
     return obj;
   case NUM:
   case BGNUM:
+  case FLNUM:
     format(out, lit("~s"), obj, nao);
     return obj;
   case SYM:
@@ -4272,6 +4323,7 @@ val obj_pprint(val obj, val out)
     return obj;
   case NUM:
   case BGNUM:
+  case FLNUM:
     format(out, lit("~s"), obj, nao);
     return obj;
   case SYM: