reimplementation (oupsi)

old/read.c

@@ -0,0 +1,156 @@
+#include <stdio.h>
+#include <stdlib.h>
+#include <string.h>
+
+#include "wscm.h"
+
+static O read(Lx *lex);
+
+static void skipcomments(Lx *lex) {
+  while (lex->kind == TOK_COMMENT) {
+    if (!nexttoken(lex))
+      break;
+  }
+}
+
+static O makeobject(Lx *lex) {
+  if (lex->kind == TOK_WORD) {
+    char *tok = lex->buffer;
+    char *end;
+    long v = strtol(tok, &end, 10);
+    if (end != tok && *end == '\0') {
+      nexttoken(lex);
+      return NUM((I)v);
+    } else {
+      S *s = intern(tok, (I)strlen(tok));
+      O sym = BOX(TAG(s, TAG_SYM));
+      nexttoken(lex);
+      return sym;
+    }
+  } else if (lex->kind == TOK_STRING) {
+    // TODO: string type
+    char *tok = lex->buffer;
+    S *s = intern(tok, (I)strlen(tok));
+    O sym = BOX(TAG(s, TAG_SYM));
+    nexttoken(lex);
+    return sym;
+  }
+  return NIL;
+}
+
+static void lastcdr(O list, O cdr_val) {
+  O curr = list;
+  while (1) {
+    C *c = uncons(curr);
+    if (c->cdr == NIL) {
+      c->cdr = cdr_val;
+      return;
+    }
+    curr = c->cdr;
+  }
+}
+
+static O readlist(Lx *lex) {
+  nexttoken(lex);
+  skipcomments(lex);
+
+  if (lex->kind == TOK_RPAREN) {
+    nexttoken(lex);
+    return NIL;
+  }
+
+  O head = NIL;
+  while (lex->kind != TOK_EOF) {
+    skipcomments(lex);
+    if (lex->kind == TOK_RPAREN) {
+      nexttoken(lex);
+      break;
+    }
+
+    if (lex->kind == TOK_DOT) {
+      nexttoken(lex);
+      skipcomments(lex);
+      if (lex->kind == TOK_EOF) {
+        fprintf(stderr, "reader error: unexpected EOF after '.'\n");
+        abort();
+      }
+      O cdr_val = read(lex);
+      skipcomments(lex);
+      if (lex->kind != TOK_RPAREN) {
+        fprintf(stderr, "reader error: expected ')' after dotted pair cdr\n");
+        abort();
+      }
+      nexttoken(lex);
+      O normal = listreverse(head);
+      if (normal == NIL) {
+        fprintf(stderr, "reader error: '.' with no preceding elements\n");
+        abort();
+      }
+      lastcdr(normal, cdr_val);
+      return normal;
+    }
+    O elem = read(lex);
+    head = cons(elem, head);
+    skipcomments(lex);
+  }
+
+  return listreverse(head);
+}
+
+static O readquote(Lx *lex) {
+  nexttoken(lex);
+  skipcomments(lex);
+  O e = read(lex);
+  O qsym = BOX(TAG(intern("quote", -1), TAG_SYM));
+  return cons(qsym, cons(e, NIL));
+}
+
+static O read(Lx *lex) {
+  skipcomments(lex);
+
+  switch (lex->kind) {
+  case TOK_EOF:
+    return NIL;
+  case TOK_LPAREN:
+    return readlist(lex);
+  case TOK_QUOTE:
+    return readquote(lex);
+  case TOK_WORD:
+  case TOK_STRING:
+    return makeobject(lex);
+  case TOK_COMMENT:
+    nexttoken(lex);
+    return read(lex);
+  default:
+    nexttoken(lex);
+    return NIL;
+  }
+}
+
+O readfile(FILE *f) {
+  if (!f)
+    return NIL;
+
+  Lx lex;
+  lex.kind = TOK_EOF;
+  lex.cursor = 0;
+  lex.input = f;
+  lex.buffer[0] = '\0';
+
+  nexttoken(&lex);
+  skipcomments(&lex);
+
+  if (lex.kind == TOK_EOF)
+    return NIL;
+  return read(&lex);
+}
+
+O readstring(const char *s) {
+  if (!s)
+    return NIL;
+  size_t len = strlen(s);
+  FILE *f = fmemopen((void *)s, len, "r");
+  O res = readfile(f);
+  fclose(f);
+  return res;
+}