MalVal *read_list(Reader *reader, MalType type, char start, char end) {
MalVal *ast, *form;
char *token = reader_next(reader);
//g_print("read_list start token: %s\n", token);
if (token[0] != start) { abort("expected '(' or '['"); }
ast = malval_new_list(type, g_array_new(TRUE, TRUE, sizeof(MalVal*)));
while ((token = reader_peek(reader)) &&
token[0] != end) {
//g_print("read_list internal token %s\n", token);
form = read_form(reader);
if (!form) {
if (!mal_error) { abort("unknown read_list failure"); }
g_array_free(ast->val.array, TRUE);
malval_free(ast);
return NULL;
}
g_array_append_val(ast->val.array, form);
}
if (!token) { abort("expected ')' or ']', got EOF"); }
reader_next(reader);
//g_print("read_list end token: %s\n", token);
return ast;
}
MalVal *read_atom(Reader *reader) {
char *token;
GRegex *regex;
GMatchInfo *matchInfo;
GError *err = NULL;
gint pos;
MalVal *atom;
token = reader_next(reader);
//g_print("read_atom token: %s\n", token);
regex = g_regex_new ("(^-?[0-9]+$)|(^-?[0-9][0-9.]*$)|(^nil$)|(^true$)|(^false$)|^\"(.*)\"?$|:(.*)|(^[^\"]*$)", 0, 0, &err);
g_regex_match (regex, token, 0, &matchInfo);
if (g_match_info_fetch_pos(matchInfo, 1, &pos, NULL) && pos != -1) {
//g_print("read_atom integer\n");
atom = malval_new_integer(g_ascii_strtoll(token, NULL, 10));
} else if (g_match_info_fetch_pos(matchInfo, 2, &pos, NULL) && pos != -1) {
//g_print("read_atom float\n");
atom = malval_new_float(g_ascii_strtod(token, NULL));
} else if (g_match_info_fetch_pos(matchInfo, 3, &pos, NULL) && pos != -1) {
//g_print("read_atom nil\n");
atom = &mal_nil;
} else if (g_match_info_fetch_pos(matchInfo, 4, &pos, NULL) && pos != -1) {
//g_print("read_atom true\n");
atom = &mal_true;
} else if (g_match_info_fetch_pos(matchInfo, 5, &pos, NULL) && pos != -1) {
//g_print("read_atom false\n");
atom = &mal_false;
} else if (g_match_info_fetch_pos(matchInfo, 6, &pos, NULL) && pos != -1) {
//g_print("read_atom string: %s\n", token);
int end = strlen(token)-1;
if (token[end] != '"') { abort("expected '\"', got EOF"); }
token[end] = '\0';
atom = malval_new_string(g_strcompress(g_match_info_fetch(matchInfo, 6)));
} else if (g_match_info_fetch_pos(matchInfo, 7, &pos, NULL) && pos != -1) {
//g_print("read_atom keyword\n");
atom = malval_new_keyword(MAL_GC_STRDUP(g_match_info_fetch(matchInfo, 7)));
} else if (g_match_info_fetch_pos(matchInfo, 8, &pos, NULL) && pos != -1) {
//g_print("read_atom symbol\n");
atom = malval_new_symbol(MAL_GC_STRDUP(g_match_info_fetch(matchInfo, 8)));
} else {
malval_free(atom);
atom = NULL;
}
return atom;
}
MalVal *read_form(Reader *reader) {
char *token;
MalVal *form = NULL, *tmp;
// while(token = reader_next(reader)) {
// printf("token: %s\n", token);
// }
// return NULL;
token = reader_peek(reader);
if (!token) { return NULL; }
//g_print("read_form token: %s\n", token);
switch (token[0]) {
case ';':
abort("comments not yet implemented");
break;
case '\'':
reader_next(reader);
form = _listX(2, malval_new_symbol("quote"),
read_form(reader));
break;
case '`':
reader_next(reader);
form = _listX(2, malval_new_symbol("quasiquote"),
read_form(reader));
break;
case '~':
reader_next(reader);
if (token[1] == '@') {
form = _listX(2, malval_new_symbol("splice-unquote"),
read_form(reader));
} else {
form = _listX(2, malval_new_symbol("unquote"),
read_form(reader));
};
break;
case '^':
reader_next(reader);
MalVal *meta = read_form(reader);
form = _listX(3, malval_new_symbol("with-meta"),
read_form(reader), meta);
break;
case '@':
reader_next(reader);
form = _listX(2, malval_new_symbol("deref"),
read_form(reader));
break;
// list
case ')':
abort("unexpected ')'");
break;
case '(':
form = read_list(reader, MAL_LIST, '(', ')');
break;
// vector
case ']':
abort("unexpected ']'");
break;
case '[':
form = read_list(reader, MAL_VECTOR, '[', ']');
break;
// hash-map
case '}':
abort("unexpected '}'");
break;
case '{':
form = read_hash_map(reader);
break;
default:
form = read_atom(reader);
break;
}
return form;
}
/* ./dfa2_test INFILE */
int main(int argc, char **argv)
{
static char rbuf[4096];
struct Printer *p = stdp();
u32 any_fail = 0;
--argc, ++argv;
if (argc < 1) {
PUTERR("error: no input files");
return 1;
}
/* TODO argument uniqueness? is "./test a a a a" okay?
* atleast becomes an issue with stdin.
*/
while (argc) {
struct Lexer lexer;
u32 fail;
lexer.reader.fd = open(*argv, O_RDONLY);
lexer.reader.buf = rbuf;
lexer.reader.buf_cap = ARRAY_COUNT(rbuf);
lexer.reader.buf_start = 0;
lexer.reader.buf_end = 0;
if (lexer.reader.fd < 0) {
/* TODO use error-writer */
pr_str(p, "file ");
pr_str(p, *argv);
pr_chr(p, '\n');
pr_flush(p);
PUTERRNO("open");
/* TODO skip file? */
return 1;
}
if (DEBUG) {
pr_str(p, "file ");
pr_str(p, *argv);
pr_str(p, ":\n");
}
lexer.c = reader_next(&lexer.reader);
fail = run_testfile(&lexer, p);
any_fail = (any_fail || fail);
--argc, ++argv;
}
pr_flush(p);
(void)writer_flush(stde());
if (any_fail) {
return 1;
}
if (p->err) {
PUTERRNO("write");
return 1;
}
return 0;
}
