make numbers neutral

1 files changed, 65 insertions, 22 deletions

diff --git a/liblali.c b/liblali.c
index 87be3d6..78872fd 100644
--- a/liblali.c
+++ b/liblali.c
@@ -276,13 +276,13 @@ Object *newCons(Object **car, Object **cdr, GC_PARAM) {
   return object;
 }
 
-Object *newSymbolWithLength(char *string, size_t length, GC_PARAM) {
+Object *newSymbolWithLength(Type type, char *string, size_t length, GC_PARAM) {
   for (Object *object = symbols; object != nil; object = object->cdr)
     if (memcmp(object->car->string, string, length) == 0
         && object->car->string[length] == '\0')
       return object->car;
 
-  GC_TRACE(gcObject, newObjectWithString(TYPE_SYMBOL, length + 1, GC_ROOTS));
+  GC_TRACE(gcObject, newObjectWithString(type, length + 1, GC_ROOTS));
   memcpy((*gcObject)->string, string, length);
   (*gcObject)->string[length] = '\0';
 
@@ -292,7 +292,7 @@ Object *newSymbolWithLength(char *string, size_t length, GC_PARAM) {
 }
 
 Object *newSymbol(char *string, GC_PARAM) {
-  return newSymbolWithLength(string, strlen(string), GC_ROOTS);
+  return newSymbolWithLength(TYPE_SYMBOL, string, strlen(string), GC_ROOTS);
 }
 
 Object *newObjectWithClosure(Type type, Object **params, Object **body, Object **env, GC_PARAM) {
@@ -535,34 +535,73 @@ Object *readNumberOrSymbol(Stream *stream, GC_PARAM) {
   size_t offset = stream->offset;
   int ch = streamPeek(stream);
 
-  // skip optional leading sign
+  // numbers must have a leading sign
   if (ch == '+' || ch == '-') {
     streamGetc(stream);
     ch = streamPeek(stream);
-  }
 
-  // try to read a number in integer or decimal format
-  if (ch == '.' || isdigit(ch)) {
-    if (isdigit(ch))
-      ch = readWhile(stream, isdigit);
-    if (!isSymbolChar(ch))
-      return newNumber(strtol(stream->buffer + offset, NULL, 10), GC_ROOTS);
-    if (ch == '.') {
-      ch = streamGetc(stream);
-      if (isdigit(streamPeek(stream))) {
+    // try to read a number in integer or decimal format
+    if (ch == '.' || isdigit(ch)) {
+      if (isdigit(ch))
         ch = readWhile(stream, isdigit);
-        if (!isSymbolChar(ch))
-          return newNumber(strtod(stream->buffer + offset, NULL), GC_ROOTS);
+      if (!isSymbolChar(ch))
+        return newSymbolWithLength(TYPE_NUMBER, stream->buffer + offset,
+                             stream->offset - offset, GC_ROOTS);
+      if (ch == '.') {
+        ch = streamGetc(stream);
+        if (isdigit(streamPeek(stream))) {
+          ch = readWhile(stream, isdigit);
+          if (!isSymbolChar(ch))
+            return newSymbolWithLength(TYPE_NUMBER, stream->buffer + offset,
+                             stream->offset - offset, GC_ROOTS);
+        }
       }
     }
   }
 
   // non-numeric character encountered, read a symbol
   readWhile(stream, isSymbolChar);
-  return newSymbolWithLength(stream->buffer + offset,
+  return newSymbolWithLength(TYPE_SYMBOL, stream->buffer + offset,
                              stream->offset - offset, GC_ROOTS);
 }
 
+/* Object *readNumberOrSymbol(Stream *stream, GC_PARAM) { */
+/*   size_t offset = stream->offset; */
+/*   int ch = streamPeek(stream); */
+
+/*   // skip optional leading sign */
+/*   /\* if (ch == '+' || ch == '-') { *\/ */
+/*   /\*   streamGetc(stream); *\/ */
+/*   /\*   ch = streamPeek(stream); *\/ */
+/*   /\* } *\/ */
+
+/*   if (ch == '+' || ch == '-') { */
+/*     streamGetc(stream); */
+/*     ch = streamPeek(stream); */
+
+/*     // try to read a number in integer or decimal format */
+/*     if (ch == '.' || isdigit(ch)) { */
+/*       if (isdigit(ch)) */
+/*         ch = readWhile(stream, isdigit); */
+/*       if (!isSymbolChar(ch)) */
+/*         return newNumber(strtol(stream->buffer + offset, NULL, 10), GC_ROOTS); */
+/*       if (ch == '.') { */
+/*         ch = streamGetc(stream); */
+/*         if (isdigit(streamPeek(stream))) { */
+/*           ch = readWhile(stream, isdigit); */
+/*           if (!isSymbolChar(ch)) */
+/*             return newNumber(strtod(stream->buffer + offset, NULL), GC_ROOTS); */
+/*         } */
+/*       } */
+/*     } */
+/*   } */
+
+/*   // non-numeric character encountered, read a symbol */
+/*   readWhile(stream, isSymbolChar); */
+/*   return newSymbolWithLength(stream->buffer + offset, */
+/*                              stream->offset - offset, GC_ROOTS); */
+/* } */
+
 Object *reverseList(Object *list) {
   Object *object = nil;
 
@@ -637,7 +676,8 @@ void writeObject(Object *object, bool readably, FILE *file) {
     case type:                                  \
       fprintf(file, __VA_ARGS__);               \
       break
-    CASE(TYPE_NUMBER, "%g", object->number);
+    /* CASE(TYPE_NUMBER, (object->number < 0) ? "%g" : "+%g", object->number); */
+    CASE(TYPE_NUMBER, "%s", object->string);
     CASE(TYPE_SYMBOL, "%s", object->string);
     CASE(TYPE_PRIMITIVE, "#<Primitive %s>", object->name);
 #undef CASE
@@ -713,6 +753,9 @@ void writeObject(Object *object, bool readably, FILE *file) {
  */
 
 Object *envLookup(Object *var, Object *env) {
+  if (var->type == TYPE_NUMBER)
+    return var;
+
   for (; env != nil; env = env->parent) {
     Object *vars = env->vars, *vals = env->vals;
 
@@ -784,9 +827,9 @@ Object *primitiveAtom(Object **args, GC_PARAM) {
 Object *primitiveDif(Object **args, GC_PARAM) {
   Object *first = (*args)->car, *second = (*args)->cdr->car;
 
-  if (first->type == TYPE_NUMBER && second->type == TYPE_NUMBER)
-    return (first->number != second->number) ? t : f;
-  else if (first->type == TYPE_STRING && second->type == TYPE_STRING)
+  /* if (first->type == TYPE_NUMBER && second->type == TYPE_NUMBER) */
+  /*   return (first->number != second->number) ? t : f; */
+  if (first->type == TYPE_STRING && second->type == TYPE_STRING)
     return strcmp(first->string, second->string) ? t : f;
   else
     return (first != second) ? t : f;
@@ -1275,7 +1318,7 @@ Object *evalExpr(Object **object, Object **env, GC_PARAM) {
   GC_TRACE(gcBody, nil);
 
   for (;;) {
-    if ((*gcObject)->type == TYPE_SYMBOL)
+    if ((*gcObject)->type == TYPE_SYMBOL || (*gcObject)->type == TYPE_NUMBER)
       return envLookup(*gcObject, *gcEnv);
     if ((*gcObject)->type != TYPE_CONS)
       return *gcObject;