156 lines
3 KiB
C
156 lines
3 KiB
C
#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;
|
|
}
|