#include #include #include "lisp.h" static Pointer READTABLE; Pointer character(Char c) { Pointer ptr = memory_new(CHAR, sizeof(Char)); CHAR(ptr) = c; return ptr; } unsigned get_utf8(FILE* s) { unsigned c = fgetc(s); if (c & 0x80 && c & 0x40) { switch(c >> 3 & 0x07) { case 0: case 1: case 2: case 3: c |= fgetc(s) << 8; break; case 4: case 5: c |= fgetc(s) << 8; c |= fgetc(s) << 16; break; case 6: c |= fgetc(s) << 8; c |= fgetc(s) << 16; c |= fgetc(s) << 24; break; default: break; } } return c; } unsigned unget_utf8(unsigned c, FILE* s) { switch (c & 0x80808000) { case 0x80808000: ungetc(c >> 24, s); case 0x00808000: ungetc(c >> 16, s); case 0x00008000: ungetc(c >> 8, s); } ungetc(c, s); return c; } Pointer stream(FILE* s) { Pointer ptr = memory_new(STREAM, sizeof(Stream)); STREAM(ptr) = s; return ptr; } Char peek_char(Pointer type, Stream stream) { Char c; if (feof(stream)) return 0; if (type == NIL) { return unget_utf8(get_utf8(stream), stream); } if (type == T) { while(isspace((char) (c = get_utf8(stream))) && !feof(stream)); if (feof(stream)) return 0; return unget_utf8(c, stream); } if (TYPE(type) == CHAR) { while((c = get_utf8(stream)) != CHAR(type) && !feof(stream)); if (feof(stream)) return 0; return unget_utf8(c, stream); } return UNDEFINED; } Pointer peek_char_fn(Pointer args, Pointer env) { Pointer type = CAR(args); Pointer streamPtr = CAR(CDR(args)); Stream stream = streamPtr == NIL ? STREAM(environment_get(env, STANDARD_INPUT)) : STREAM(streamPtr); Char c = peek_char(type, stream); if (feof(stream)) { return NIL; } return character(c); } Pointer read_char_fn(Pointer args, Pointer env) { Pointer streamPtr = CAR(args); Stream stream = streamPtr == NIL ? STREAM(environment_get(env, STANDARD_INPUT)) : STREAM(streamPtr); if (feof(stream)) { return NIL; } return character(get_utf8(stream)); } static Pointer buffer; Pointer read1(Pointer streamPtr, Pointer env) { Stream stream = STREAM(streamPtr); double num = 0; Pointer macro; Char c = peek_char(T, stream); if (feof(stream)) return NIL; macro = table_get(READTABLE, c); if (macro != UNDEFINED) { switch(memory_get(macro)->type) { case NATIVE_FUNC: return NATIVE_FUNC(macro)(LIST(streamPtr, character(get_utf8(stream))), env); case FUNC: return eval_fn(LIST(macro, streamPtr, character(get_utf8(stream))), env); default: break; } } string_clear(buffer); while ((c = peek_char(NIL, stream)) != 0 && !isspace((char) c) && table_get(READTABLE, c) == UNDEFINED) { buffer = string_push(buffer, getc(stream)); } buffer = string_push(buffer, '\0'); char* end; num = strtod(STRING(buffer).data, &end); if ((size_t) end == (size_t) STRING(buffer).data + STRING(buffer).length - 1) { return number(num); } return symbol(STRING(buffer).data, STRING(buffer).length - 1); } Pointer read_fn(Pointer args, Pointer env) { Pointer streamPtr = CAR(args); streamPtr = streamPtr == NIL ? environment_get(env, STANDARD_INPUT) : streamPtr; Stream stream = STREAM(streamPtr); Pointer result = read1(streamPtr, env); char c; while((c = getc(stream)) && isspace(c) && c != '\n'); if (c != '\n') ungetc(c, stream); return result; } Pointer set_reader_macro(Pointer c, Pointer fn) { READTABLE = table_set(READTABLE, c, fn); return T; } Pointer set_reader_macro_fn(Pointer args, Pointer env) { (void) env; return set_reader_macro(CAR(args), CAR(CDR (args))); } static bool return_char(Stream stream) { Char c; return feof(stream) || (c = peek_char(NIL, stream)) == 0 || isspace((char) c) || table_get(READTABLE, c) != UNDEFINED; } static char space[] = "SPACE"; static char tab[] = "TAB"; static char newline[] = "NEWLINE"; Pointer read_char_macro(Pointer args, Pointer env) { (void) env; Pointer streamPtr = CAR(args); Stream stream = streamPtr == NIL ? STREAM(environment_get(env, STANDARD_INPUT)) : STREAM(streamPtr); Char c = get_utf8(stream); if (return_char(stream)) { return character(c); } int pos = 0; char searched_char = 0; c = toupper(c); if (c == (unsigned) space[pos]) { pos++; searched_char = ' '; } else if (c == (unsigned) tab[pos]) { pos++; searched_char = '\t'; } else if (c == (unsigned) newline[pos]) { pos++; searched_char = '\n'; } while (!feof(stream) && (c = get_utf8(stream)) && !isspace((char) c) && table_get(READTABLE, c) == UNDEFINED && searched_char != 0) { c = toupper(c); switch (searched_char) { case ' ': if (c == (unsigned) space[pos]) { if (pos == sizeof(space) - 2 && return_char(stream)) { return character(' '); } pos++; continue; } break; case '\t': if (c == (unsigned) tab[pos]) { if (pos == sizeof(tab) - 2 && return_char(stream)) { return character('\t'); } pos++; continue; } break; case '\n': if (c == (unsigned) newline[pos]) { if (pos == sizeof(newline) - 2 && return_char(stream)) { return character('\n'); } pos++; continue; } } break; } return UNDEFINED; // ERROR! } Pointer read_list_macro(Pointer args, Pointer env) { Pointer streamPtr = CAR(args); Stream stream = streamPtr == NIL ? STREAM(environment_get(env, STANDARD_INPUT)) : STREAM(streamPtr); Pointer car = read_fn(args, env); Pointer cdr = NIL; char c = peek_char(T, stream); if (!feof(stream)) { if (c != ')') { cdr = read_list_macro(args, env); } else { get_utf8(stream); } } return cons(car, cdr); } Pointer read_right_paren_macro(Pointer args, Pointer env) { (void) args; (void) env; return NIL; // TODO: Should return an error when the error system is set. } void reader_init(void) { buffer = string(NULL, 0); READTABLE = table(1); READTABLE = table_set(READTABLE, '(', native_func(read_list_macro)); READTABLE = table_set(READTABLE, ')', native_func(read_list_macro)); READTABLE = table_set(READTABLE, '\\', native_func(read_char_macro)); }