* 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.

9 files changed, 162 insertions, 17 deletions

diff --git a/ChangeLog b/ChangeLog
index 6ea80d12..f378d7ba 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,3 +1,43 @@
+2012-03-19  Kaz Kylheku  <kaz@kylheku.com>
+
+	* 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.
+
 2012-03-18  Kaz Kylheku  <kaz@kylheku.com>
 
 	* eval.c (eval_init): url_decode has two parameters now,
diff --git a/configure b/configure
index 042a736a..76c47d47 100755
--- a/configure
+++ b/configure
@@ -757,12 +757,16 @@ char SIZEOF_SUPERLONG_T[sizeof (superlong_t)];
 
   if [ $SIZEOF_PTR -eq $SIZEOF_SHORT ] ; then
     intptr="short"
+    uintptr=y
   elif [ $SIZEOF_PTR -eq $SIZEOF_INT ] ; then
     intptr="int"
+    uintptr=y
   elif [ $SIZEOF_PTR -eq $SIZEOF_LONG ] ; then
     intptr="long"
+    uintptr=y
   elif [ $SIZEOF_PTR -eq $SIZEOF_LONG_LONG_T ] ; then
     intptr="longlong_t"
+    uintptr=$ulonglong
   fi
 
   if [ -z "$intptr" ] ; then
@@ -773,6 +777,10 @@ fi
 
 printf '"%s"\n' "$intptr"
 printf "typedef $intptr int_ptr_t;\n" >> config.h
+if [ -n "$uintptr" ] ; then
+  printf "#define HAVE_UINTPTR_T 1\n" >> config.h
+  printf "typedef unsigned $intptr uint_ptr_t;\n" >> config.h
+fi
 intptr_max_expr="((((($intptr) 1 << $((SIZEOF_PTR * 8 - 2))) - 1) << 1) + 1)"
 printf "#define INT_PTR_MAX %s\n" "$intptr_max_expr" >> config.h
 printf "#define INT_PTR_MIN (-INT_PTR_MAX)\n" >> config.h
diff --git a/eval.c b/eval.c
index 74acb79f..26e31f59 100644
--- a/eval.c
+++ b/eval.c
@@ -2188,6 +2188,8 @@ void eval_init(void)
   reg_fun(intern(lit("gcd"), user_package), func_n2(gcd));
   reg_fun(intern(lit("fixnump"), user_package), func_n1(fixnump));
   reg_fun(intern(lit("bignump"), user_package), func_n1(bignump));
+  reg_fun(intern(lit("floatp"), user_package), func_n1(floatp));
+  reg_fun(intern(lit("integerp"), user_package), func_n1(integerp));
   reg_fun(intern(lit("numberp"), user_package), func_n1(numberp));
 
   reg_fun(intern(lit("zerop"), user_package), func_n1(zerop));
@@ -2288,6 +2290,7 @@ void eval_init(void)
   reg_fun(intern(lit("trim-str"), user_package), func_n1(trim_str));
   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("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/gc.c b/gc.c
index b2247a9b..2b2567b9 100644
--- a/gc.c
+++ b/gc.c
@@ -186,30 +186,28 @@ static void finalize(val obj)
   switch (obj->t.type) {
   case NIL:
   case CONS:
-    return;
-  case STR:
-    free(obj->st.str);
-    obj->st.str = 0;
-    return;
   case CHR:
   case NUM:
   case LIT:
   case SYM:
   case PKG:
   case FUN:
+  case LCONS:
+  case LSTR:
+  case ENV:
+  case FLNUM:
+    return;
+  case STR:
+    free(obj->st.str);
+    obj->st.str = 0;
     return;
   case VEC:
     free(obj->v.vec-2);
     obj->v.vec = 0;
     return;
-  case LCONS:
-  case LSTR:
-    return;
   case COBJ:
     obj->co.ops->destroy(obj);
     return;
-  case ENV:
-    return;
   case BGNUM:
     mp_clear(mp(obj));
     return;
@@ -262,6 +260,7 @@ tail_call:
   case NUM:
   case LIT:
   case BGNUM:
+  case FLNUM:
     return;
   case CONS:
     mark_obj(obj->c.car);
diff --git a/hash.c b/hash.c
index c9e69261..f6c5a69c 100644
--- a/hash.c
+++ b/hash.c
@@ -90,6 +90,24 @@ static unsigned long hash_c_str(const wchar_t *str)
   return h;
 }
 
+static cnum hash_double(double n)
+{
+#ifdef HAVE_UINTPTR_T
+  uint_ptr_t h = 0;
+#else
+  unsigned long h = 0;
+#endif
+
+  mem_t *p = (mem_t *) &n, *q = p + sizeof(double);
+
+  while (p < q) {
+    h = h << 8 | h >> (8 * sizeof h - 1);
+    h += *p++;
+  }
+
+  return h & NUM_MAX;
+}
+
 static cnum equal_hash(val obj)
 {
   switch (type(obj)) {
@@ -135,6 +153,8 @@ static cnum equal_hash(val obj)
     return equal_hash(obj->ls.prefix);
   case BGNUM:
     return mp_hash(mp(obj)) & NUM_MAX;
+  case FLNUM:
+    return hash_double(obj->fl.n);
   case COBJ:
     return obj->co.ops->hash(obj) & NUM_MAX;
   }
@@ -150,6 +170,8 @@ static cnum eql_hash(val obj)
       return NUM_MAX;
     if (obj->t.type == BGNUM)
       return mp_hash(mp(obj)) & NUM_MAX;
+    if (obj->t.type == FLNUM)
+      return hash_double(obj->fl.n);
     switch (sizeof (mem_t *)) {
     case 4:
       return (((cnum) obj) >> 4) & NUM_MAX;
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:
diff --git a/lib.h b/lib.h
index e33667a4..47fa3d38 100644
--- a/lib.h
+++ b/lib.h
@@ -40,7 +40,7 @@ typedef int_ptr_t cnum;
 typedef enum type {
   NIL, NUM = TAG_NUM, CHR = TAG_CHR, LIT = TAG_LIT, CONS,
   STR, SYM, PKG, FUN, VEC, LCONS, LSTR, COBJ, ENV,
-  BGNUM
+  BGNUM, FLNUM
 } type_t;
 
 typedef enum functype
@@ -193,6 +193,11 @@ struct bignum {
   mp_int mp;
 };
 
+struct flonum {
+  type_t type;
+  double n;
+};
+
 union obj {
   struct any t;
   struct cons c;
@@ -206,6 +211,7 @@ union obj {
   struct cobj co;
   struct env e;
   struct bignum bn;
+  struct flonum fl;
 };
 
 INLINE cnum tag(val obj) { return ((cnum) obj) & TAG_MASK; }
@@ -280,7 +286,7 @@ INLINE val chr(wchar_t ch)
 extern val keyword_package, system_package, user_package;
 extern val null, t, cons_s, str_s, chr_s, fixnum_s, sym_s, pkg_s, fun_s, vec_s;
 extern val stream_s, hash_s, hash_iter_s, lcons_s, lstr_s, cobj_s, cptr_s;
-extern val env_s, bignum_s;
+extern val env_s, bignum_s, float_s;
 extern val var_s, expr_s, regex_s, chset_s, set_s, cset_s, wild_s, oneplus_s;
 extern val nongreedy_s, compiled_regex_s;
 extern val quote_s, qquote_s, unquote_s, splice_s;
@@ -378,9 +384,12 @@ val getplist_f(val list, val key, val *found);
 val proper_plist_to_alist(val list);
 val improper_plist_to_alist(val list, val boolean_keys);
 val num(cnum val);
+val flo(double val);
 cnum c_num(val num);
 val fixnump(val num);
 val bignump(val num);
+val floatp(val num);
+val integerp(val num);
 val numberp(val num);
 val plus(val anum, val bnum);
 val plusv(val nlist);
@@ -439,6 +448,7 @@ val list_str(val str);
 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 chrp(val chr);
 wchar_t c_chr(val chr);
 val chr_isalnum(val ch);
diff --git a/parser.l b/parser.l
index 76ba8203..58276605 100644
--- a/parser.l
+++ b/parser.l
@@ -150,6 +150,7 @@ static wchar_t num_esc(char *num)
 
 SYM     [a-zA-Z0-9_]+
 NUM     [+\-]?[0-9]+
+FLO     [+\-]?[0-9]+([.][0-9]+)?([eE][+-]?[0-9]+)?
 BSCHR   [a-zA-Z0-9!$%&*+\-<=>?\\^_~]
 BSYM    {BSCHR}({BSCHR}|#)*
 NSCHR   [a-zA-Z0-9!$%&*+\-<=>?\\^_~/]
@@ -185,7 +186,18 @@ UONLY   {U2}{U}|{U3}{U}{U}|{U4}{U}{U}{U}
       || yy_top_state() == QSILIT)
     yy_pop_state();
 
-  yylval.num = int_str(str, num(10));
+  yylval.val = int_str(str, num(10));
+  return NUMBER;
+}
+
+<SPECIAL,NESTED,BRACED>{FLO} {
+  val str = string_own(utf8_dup_from(yytext));
+
+  if (yy_top_state() == INITIAL
+      || yy_top_state() == QSILIT)
+    yy_pop_state();
+
+  yylval.val = flo_str(str);
   return NUMBER;
 }
 
@@ -195,7 +207,7 @@ UONLY   {U2}{U}|{U3}{U}{U}|{U4}{U}{U}{U}
   if (yy_top_state() == INITIAL
       || yy_top_state() == QSILIT)
     yy_pop_state();
-  yylval.num = int_str(str, num(10));
+  yylval.val = int_str(str, num(10));
   return METANUM;
 }
 
diff --git a/parser.y b/parser.y
index 29e678d5..7a058d60 100644
--- a/parser.y
+++ b/parser.y
@@ -63,7 +63,6 @@ static val parsed_spec;
   wchar_t *lexeme;
   union obj *val;
   wchar_t chr;
-  union obj *num;
   cnum lineno;
 }