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; }