beginnings of REPL

[muddle-interpreter.git] / src / read.c

diff --git a/src/read.c b/src/read.c
new file mode 100644 (file)
index 0000000..57dd81f
--- /dev/null
+++ b/src/read.c
@@ -0,0 +1,207 @@
+/*
+Copyright (C) 2017 Keziah Wesley
+
+You can redistribute and/or modify this file under the terms of the
+GNU Affero General Public License as published by the Free Software
+Foundation, either version 3 of the License, or (at your option) any
+later version.
+
+This file is distributed in the hope that it will be useful, but
+WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+Affero General Public License for more details.
+
+You should have received a copy of the GNU Affero General Public
+License along with this file. If not, see
+<http://www.gnu.org/licenses/>.
+*/
+
+#include "read.h"
+#include "object.h"
+
+#include <assert.h>
+#include <stdio.h>
+
+/**
+Tokenization
+*/
+
+// Return the number of whitespace characters at the beginning of the input.
+static int
+count_whitespace (const char *p)
+{
+  for (int i = 0;; i++)
+    {
+      switch (p[i])
+       {
+       case 0:
+       case ' ':
+       case '\n':
+       case '\r':
+       case '\t':
+       case '\v':
+       case '\f':
+         break;
+       default:
+         return i;
+       }
+    }
+}
+
+// Return the number of characters at the beginning of the input
+// constituting a valid PNAME.
+// If the input ends with '\', it is incomplete, and -1 is returned.
+static int
+count_pname (const char *p)
+{
+  // rule (1): valid FLOAT / FIX isn't a PNAME.
+  // Caller must try to read as number first!
+
+  // rule (2): dot can't be first
+  if (p[0] == '.')
+    return 0;
+
+  // rule (3): "if you can't type it interactively, it's only valid non-interactively"
+  // (not currently enforced; just don't give your atoms names like ^L)
+
+  for (int i = 0;; i++)
+    {
+      switch (p[i])
+       {
+         // separators end the PNAME
+         // rule (4): whitespace
+         // rule (5): special characters
+         // rule (6): brackets
+       case ' ':
+       case '\n':
+       case '\r':
+       case '\t':
+       case '\v':
+       case '\f':
+       case ',':
+       case '#':
+       case '\'':
+       case ';':
+       case '%':
+       case '(':
+       case ')':
+       case '[':
+       case ']':
+       case '<':
+       case '>':
+       case '{':
+       case '}':
+       case '"':
+       case 0:
+         return i;
+         // escape: next char becomes normal
+       case '\\':
+         if (!p[++i])
+           return -1;
+       }
+    }
+}
+
+/**
+State machine
+*/
+
+/*
+static uint32_t obj_get_fix32(const object *o) {
+    assert(o->type == EVALTYPE_FIX32);
+    return o->v.fix32;
+}
+*/
+
+// stack[0..len]: objs in current list
+// stack[len]: parent len
+const char *
+read_token (const char *p, reader_stack * st)
+{
+  p += count_whitespace (p);
+  switch (p[0])
+    {
+    case '\0':
+      break;
+    case '(':
+    case '<':
+    case '[':
+      {
+       // opener: push current framelen; start new frame
+       // store child type and parent framelen in a pseudo-object together
+       evaltype type;
+       switch (p++[0])
+         {
+         case '(':
+           type = EVALTYPE_LIST;
+           break;
+         case '<':
+           type = EVALTYPE_FORM;
+           break;
+         case '[':
+           type = EVALTYPE_VECTOR;
+           break;
+         default:
+           assert (0 && "martian opener token?");
+         }
+       *--(st->pos) = (object)
+       {
+       .fix32.type = type,.fix32.rest = 0,.fix32.val = st->framelen,};
+       st->framelen = 0;
+       break;
+      }
+    case ')':
+    case '>':
+      {
+       evaltype type;
+       switch (p++[0])
+         {
+         case ')':
+           type = EVALTYPE_LIST;
+           break;
+         case '>':
+           type = EVALTYPE_FORM;
+           break;
+         default:
+           assert (0 && "martian list closer token?");
+         }
+       // build list from current stack frame
+       pool_ptr o =
+         pool_copy_array_rev ((pool_object *) st->pos, st->framelen);
+       // pop frame, push new LIST
+       st->pos += st->framelen;
+       assert (st->pos->type == type);
+       st->framelen = st->pos->fix32.val + 1;
+       // overwrite the frame marker with the collection it became
+       st->pos->list = (list_object)
+       {
+       .type = type,.rest = 0,.head = o};
+       break;
+      }
+    case ']':
+      {
+       p++;
+       // build vector from current stack frame
+       heap_ptr h = heap_copy_array_rev (st->pos, st->framelen);
+       // pop frame, push new VECTOR
+       uint32_t len = st->framelen;
+       st->pos += st->framelen;
+       assert (st->pos->type == EVALTYPE_VECTOR);
+       st->framelen = st->pos->fix32.val + 1;
+       st->pos->vector = new_vector (h, len);
+       break;
+      }
+    case '4':
+      {
+       p++;
+       // push fix obj, extending frame
+       (--(st->pos))->fix64 = new_fix64 (4);
+       st->framelen++;
+       break;
+      }
+    default:
+      fprintf (stderr, "read unimplemented for char: '%c'\n", *p);
+      assert (0 && "read unimplemented for char");
+    }
+  return p;
+}