read: implement basic decimal FIXes

Implement read for FIXes of the form /-?[0-9]+/

Signed-off-by: Kaz Wesley <keziahw@gmail.com>

diff --git a/doc/ROADMAP.md b/doc/ROADMAP.md
index be3251b0c0cb3d89e41d817b6f195fb344ed3fcd..d4e961fde704273c0b09932dc2a4ef0c47f37735 100644 (file)
--- a/doc/ROADMAP.md
+++ b/doc/ROADMAP.md
@@ -4,6 +4,7 @@ Roughly dependency-ordered todo list:
 * [ ] *PROCESS/MCALL*
 * [ ] EVAL; initial interpreter and REPL
 * [ ] atoms, global bindings, normal FUNCTIONs
+* [ ] unit test script prerequisites (assertions, type introspection...)
 * [ ] *GC*
 * [ ] local bindings
 * [ ] control flow

diff --git a/src/object.h b/src/object.h
index 80c886e3051108c8c47fe886eee00c00dcc5b966..b62cacbd7793db78966e9cc86da31715d05b6491 100644 (file)
--- a/src/object.h
+++ b/src/object.h
@@ -111,14 +111,14 @@ typedef struct
   alignas (16) evaltype type;
   pool_ptr rest;
   uint32_t _pad;
-  uint32_t val;
+  int32_t val;
 } fix32_object;
 
 typedef struct
 {
   alignas (16) evaltype type;
   pool_ptr rest;
-  uint64_t val;
+  int64_t val;
 } fix64_object;
 
 typedef struct
@@ -196,12 +196,20 @@ union object
 Initialization helpers.
 */
 
+static inline fix32_object
+new_fix32 (int32_t n)
+{
+  return (fix32_object)
+  {
+  .type = EVALTYPE_FIX32,.rest = 0,.val = n};
+}
+
 static inline fix64_object
-new_fix64 (uint64_t n)
+new_fix64 (int64_t n)
 {
   return (fix64_object)
   {
-  .type = EVALTYPE_FIX64,.rest = 0,.val = n,};
+  .type = EVALTYPE_FIX64,.rest = 0,.val = n};
 }
 
 static inline list_object

diff --git a/src/print.c b/src/print.c
index 64a6115360db417b4ac8a9102c67e42175835fa6..539016e13b30e4b4151fbbdb21c723fd80f0720e 100644 (file)
--- a/src/print.c
+++ b/src/print.c
@@ -59,10 +59,10 @@ print_object (const object * o)
   switch (o->type)
     {
     case EVALTYPE_FIX32:
-      printf ("%u", o->fix32.val);
+      printf ("%d", o->fix32.val);
       break;
     case EVALTYPE_FIX64:
-      printf ("%lu", o->fix64.val);
+      printf ("%ld", o->fix64.val);
       break;
     case EVALTYPE_LIST:
       printf ("(");

diff --git a/src/read.c b/src/read.c
index 57dd81f511d8f3538e73ee7efed7bd1bd7945029..68efbf3eef5c2c5434c4550a23f692f464508976 100644 (file)
--- a/src/read.c
+++ b/src/read.c
@@ -113,10 +113,70 @@ static uint32_t obj_get_fix32(const object *o) {
 }
 */
 
+static int
+read_num (const char *p, reader_stack *st)
+{
+  int i = 0;
+  // Use an unsigned intermediate to simplify overflow checks.
+  uint64_t x = 0;
+  // Disallow "number" composed of ancillary number components only.
+  bool gotdigits = false;
+  // Skip for now, later we'll check again to potentially negate.
+  if (p[0] == '-')
+    i++;
+  // TODO: asterisk-deliminated *octal*
+  // TODO: other bases?
+  for (; p[i]; i++)
+    {
+      if (p[i] >= '0' && p[i] <= '9')
+       {
+         if (x * 10 + (p[i] - '0') < x)
+           goto read_float;
+         x = x * 10 + (p[i] - '0');
+         gotdigits = true;
+         continue;
+       }
+
+      // TODO: decimal points, exponent notation
+      // NB. a terminal decimal denotes a FIX
+      // NB. exponent notation doesn't necessarily indicate a float
+
+      // TODO: distinguish 'delimiter' characters that terminate
+      // number from 'identifier' chars that cause parsing to fail
+      // (and potentially be parsed as an atom)
+      break;
+    }
+  if (!gotdigits)
+    return 0;
+  if (p[0] != '-')
+    {
+      if (x <= INT32_MAX)
+       (--(st->pos))->fix32 = new_fix32 ((int32_t)x);
+      else if (x <= INT64_MAX)
+       (--(st->pos))->fix64 = new_fix64 (x);
+      else
+       goto read_float;
+    }
+  else
+    {
+      if (-x >= (uint64_t)INT32_MIN)
+       (--(st->pos))->fix32 = new_fix32 (0 - (int32_t)x);
+      else if (-x >= (uint64_t)INT64_MIN)
+       (--(st->pos))->fix64 = new_fix64 (0 - (int64_t)x);
+      else
+       goto read_float;
+    }
+  st->framelen++;
+  return i;
+ read_float:
+  assert(0 && "unimplemented: promote num to float");
+  return i;
+}
+
 // stack[0..len]: objs in current list
 // stack[len]: parent len
 const char *
-read_token (const char *p, reader_stack * st)
+read_token (const char *p, reader_stack *st)
 {
   p += count_whitespace (p);
   switch (p[0])
@@ -191,17 +251,17 @@ read_token (const char *p, reader_stack * st)
        st->pos->vector = new_vector (h, len);
        break;
       }
-    case '4':
+    default:
       {
-       p++;
-       // push fix obj, extending frame
-       (--(st->pos))->fix64 = new_fix64 (4);
-       st->framelen++;
-       break;
+       int n = read_num (p, st);
+       if (n)
+         return p + n;
+
+       // TODO: try read pname
+
+       fprintf (stderr, "read unimplemented for char: '%c'\n", *p);
+       assert (0 && "read unimplemented for char");
       }
-    default:
-      fprintf (stderr, "read unimplemented for char: '%c'\n", *p);
-      assert (0 && "read unimplemented for char");
     }
   return p;
 }