From b74f0cdddade7e2cc767224afd09d2c7c9ea4817 Mon Sep 17 00:00:00 2001
From: Jesse McDonald <nybble41@gmail.com>
Date: Tue, 17 Nov 2009 01:07:42 -0600
Subject: [PATCH] Adjust number-reader to allow 'negative zero' FP values.

Also add builtins for NaN and +/- infinity, and bytecodes for classification.
---
 builtin.c        | 13 ++++++++++++-
 builtin.h        | 12 ++++++++----
 doc/bytecode.txt |  8 ++++++++
 interp.c         |  5 +++++
 reader.c         |  9 ++++++---
 5 files changed, 39 insertions(+), 8 deletions(-)

diff --git a/builtin.c b/builtin.c
index 498fcb0..20091f8 100644
--- a/builtin.c
+++ b/builtin.c
@@ -2,6 +2,7 @@
 #include <inttypes.h>
 #include <stdbool.h>
 #include <stdlib.h>
+#include <math.h>
 
 #include "gc.h"
 #include "builtin.h"
@@ -19,12 +20,22 @@ void builtin_init(void)
 {
   gc_root_t ms_root;
 
-  register_gc_root(&builtin_list, UNDEFINED);
+  register_gc_root(&builtin_list, NIL);
   register_gc_root(&ms_root, UNDEFINED);
 
   register_builtin(BI_UNDEFINED, UNDEFINED);
   register_builtin(BI_STRING_TO_NUMBER, make_builtin_fn(bi_string_to_number));
 
+#ifdef NAN
+  register_builtin(BI_POS_NAN, make_float(NAN));
+  register_builtin(BI_NEG_NAN, make_float(-NAN));
+#endif
+
+#ifdef INFINITY
+  register_builtin(BI_POS_INFINITY, make_float(INFINITY));
+  register_builtin(BI_NEG_INFINITY, make_float(-INFINITY));
+#endif
+
   register_structure(&ms_root);
   register_template(&ms_root);
   register_lambda(&ms_root);
diff --git a/builtin.h b/builtin.h
index fb12d3d..a8fef28 100644
--- a/builtin.h
+++ b/builtin.h
@@ -8,10 +8,14 @@
 #include "gc.h"
 
 /* Names of fundamental builtin values */
-#define BI_UNDEFINED "undefined"
-#define BI_STRUCTURE "structure"
-#define BI_TEMPLATE  "template"
-#define BI_LAMBDA    "lambda"
+#define BI_UNDEFINED     "undefined"
+#define BI_STRUCTURE     "structure"
+#define BI_TEMPLATE      "template"
+#define BI_LAMBDA        "lambda"
+#define BI_POS_NAN       "+NaN"
+#define BI_NEG_NAN       "-NaN"
+#define BI_POS_INFINITY  "+infinity"
+#define BI_NEG_INFINITY  "-infinity"
 
 /* Name of builtin function */
 #define BI_STRING_TO_NUMBER "string->number"
diff --git a/doc/bytecode.txt b/doc/bytecode.txt
index 5272146..c04f33f 100644
--- a/doc/bytecode.txt
+++ b/doc/bytecode.txt
@@ -75,6 +75,14 @@ unary-expr: up to 255, 1 out, 1 in
   5d (set! out (ilogb  in))
   5e (set! out (log1p  in))
   ;  (set! out (rint   in))  ; implies changing rounding mode; use floor or ceil
+
+  ; C99
+  70 (set! out (normal?    in))
+  71 (set! out (finite?    in))
+  72 (set! out (subnormal? in))
+  73 (set! out (infinite?  in))
+  74 (set! out (nan?       in))
+
 binary-expr: up to 63 (01..3f), 1 out, 2 in
   00 unary-expr
 
diff --git a/interp.c b/interp.c
index 6aa7db1..a2d044c 100644
--- a/interp.c
+++ b/interp.c
@@ -451,6 +451,11 @@ static value_t eval_unary_expression(interp_state_t *state, uint8_t subcode, uin
   case 0x5c: return make_float(expm1(get_float(ST1)));
   case 0x5d: return make_float(ilogb(get_float(ST1)));
   case 0x5e: return make_float(log1p(get_float(ST1)));
+  case 0x70: return boolean_value(isnormal(get_float(ST1)));
+  case 0x71: return boolean_value(isfinite(get_float(ST1)));
+  case 0x72: return boolean_value(fpclassify(get_float(ST1)) == FP_SUBNORMAL);
+  case 0x73: return boolean_value(isinf(get_float(ST1)));
+  case 0x74: return boolean_value(isnan(get_float(ST1)));
   default: release_assert(NOTREACHED("Invalid unary sub-bytecode."));
   }
 
diff --git a/reader.c b/reader.c
index 26b7a99..b2f0a24 100644
--- a/reader.c
+++ b/reader.c
@@ -382,11 +382,10 @@ static value_t read_number(reader_state_t *state)
     next_char(state);
   }
 
-  if (negative)
-    num = -num;
-
   if ((radix != 10) || ((state->ch != '.') && (state->ch != 'E') && (state->ch != 'e')))
   {
+    if (negative)
+      num = -num;
     release_assert(!issymbol(state->ch));
     release_assert((FIXNUM_MIN <= num) && (num <= FIXNUM_MAX));
     return fixnum_value(num);
@@ -416,6 +415,9 @@ static value_t read_number(reader_state_t *state)
     flt *= pow(10, _get_fixnum(num));
   }
 
+  if (negative)
+    flt = -flt;
+
   release_assert(!issymbol(state->ch));
   return make_float(flt);
 }
@@ -653,6 +655,7 @@ static value_t read_placeholder(reader_state_t *state)
     char *name = value_to_string(read_string(state));
     value_t bi = lookup_builtin(name);
     free(name);
+    release_assert(bi != FALSE_VALUE);
     return bi;
   }
   else