void load_hs(void) { hs_score = 100; hs_name = "Grandma"; FILE * fi; lisp_object_t* root_obj = 0; fi = fopen(highscore_filename, "r"); if (fi == NULL) { perror(highscore_filename); return; } lisp_stream_t stream; lisp_stream_init_file (&stream, fi); root_obj = lisp_read (&stream); if (root_obj->type == LISP_TYPE_EOF || root_obj->type == LISP_TYPE_PARSE_ERROR) { printf("HighScore: Parse Error in file %s", highscore_filename); } if (strcmp(lisp_symbol(lisp_car(root_obj)), "supertux-highscore") == 0) { LispReader reader(lisp_cdr(root_obj)); reader.read_int("score", &hs_score); reader.read_string("name", &hs_name); } fclose(fi); lisp_free(root_obj); }
LispVal* parse_list(FILE* f) { char c = peek(f); if (c != '(') return NULL; fgetc(f); LispList* list = NULL; LispVal* val = lisp_read(f); while (val != NULL) { list = lisp_list_cons(val, list); val = lisp_read(f); } list = lisp_list_reverse(list); return lisp_val_list(list); }
object read_pair(FILE *in) { object the_car, the_cdr; int c; skip_atmospheric(in); /* the empty list */ c = fgetc(in); if (c == ')') return nil; ungetc(c, in); the_car = lisp_read(in); skip_atmospheric(in); c = fgetc(in); /* improper list ? */ if (c == '.') { /* ... */ if (peek_char(in) == '.') goto proper_pair; c = fgetc(in); if (!isspace(c)) error("Missing delimiter in improper list -- read", nil); the_cdr = lisp_read(in); skip_atmospheric(in); c = fgetc(in); if (c == ')') return cons(the_car, the_cdr); error("Missing parenthesis -- read", nil); } proper_pair: ungetc(c, in); the_cdr = read_pair(in); return cons(the_car, the_cdr); }
object read_vector(FILE *in) { object the_list; if (!is_list((the_list = lisp_read(in)))) error("Cannot read vector -- read", the_list); return list_to_vector(the_list); }
void lisp_repl_file(FILE* f) { while (!feof(f)) { LispVal* val = lisp_read(f); if (!val) break; LispVal* res = lisp_eval(val); lisp_val_print(res); putchar('\n'); lisp_val_free(val); lisp_val_free(res); } }
void lisp_REPL(FILE* in, FILE* out, FILE* err) { while (true) { LISPTR m = lisp_read(in); // debugging - trace what we just read: fputs("lisp_read => ", out); lisp_print(m, out); fputs("\n", out); // NIL means end-of-job: if (m==NIL) break; LISPTR v = lisp_eval(m); fputs("lisp_eval => ", out); lisp_print(v, out); fputs("\n", out); } }
int main() { int i = 0; /* //initialise opArray with opNames and opPointers int i = 0; //initialise + operator ++i; opArray = realloc(opArray, i * sizeof(struct lisp_object)); opArray[i-1].objectType = T_procedure; opArray[i-1].proc.opName = malloc(sizeof("+")); strcpy(opArray[i-1].opName, "+"); opArray[i-1].opPointer = &add; //initalise - operator ++i; opArray = realloc(opArray, i * sizeof(struct op)); opArray[i-1].opName = malloc(sizeof("-")); strcpy(opArray[i-1].opName, "-"); opArray[i-1].opPointer = &subtract; //initalise * operator ++i; opArray = realloc(opArray, i * sizeof(struct op)); opArray[i-1].opName = malloc(sizeof("*")); strcpy(opArray[i-1].opName, "*"); opArray[i-1].opPointer = &multiply; //initalise - operator ++i; opArray = realloc(opArray, i * sizeof(struct op)); opArray[i-1].opName = malloc(sizeof("/")); strcpy(opArray[i-1].opName, "/"); opArray[i-1].opPointer = ÷ */ //printf("++Because this is currently all operations have to be done inside a list++\n"); printf("++++++++++++++++++++Various other things are also a bit shit+++++++++++++++++++\n\n"); do { printf(">"); //struct lisp_object m = lisp_eval(lisp_read()); lisp_write((lisp_eval(lisp_read()))); } while(1); }
LISPTR lisp_read(FILE* in) { LISPTR s = NIL; wchar_t ch = fgetwc(in); while (iswspace(ch)) { ch = fgetwc(in); } if (ch == '(') { // start of cons LISPTR last = s = cons(lisp_read(in), NIL); while (true) { ch = fgetwc(in); while (iswspace(ch)) { ch = fgetwc(in); } if (ch==WEOF || ch==')') { break; } ungetwc(ch, in); LISPTR e = lisp_read(in); rplacd(last, cons(e, NIL)); last = cdr(last); } } else if (ch == '\'') { // '<expr>, sugar for (QUOTE <expr>) s = cons(QUOTE, cons(lisp_read(in), NIL)); } else if (ch == '#') { // so-called sharpsign or 'dispatching macro character' // http://www.lispworks.com/documentation/HyperSpec/Body/02_dh.htm ch = fgetwc(in); switch (ch) { case '\'': // function-quote s = cons(FUNCTION, cons(lisp_read(in), NIL)); break; default: lisp_error(L"invalid char after #"); break; } // switch } else if (ch == WEOF) { // end of file, return NIL. } else { // must be an atom - number, symbol or string wchar_t name[MAX_ATOM_CHARS]; int n = 0; while (true) { if (n < MAX_ATOM_CHARS) { name[n++] = towupper(ch); } ch = fgetwc(in); if (ch==WEOF) break; // better not be inside a string, eh? if (name[0] != '"') { // not a string if (iswspace(ch)) break; if (ch==')' || ch=='(') { ungetwc(ch, in); break; } } else { // collecting a string if (ch=='\\') { ch = fgetwc(in); if (ch==WEOF) break; // bad luck er bad string syntax } else if (ch=='"') { break; // end of string } } } // while (true) name[n] = 0; if (name[0] == '"') { s = intern_string(name+1); } else if (isnumber(name)) { s = intern_number(name); } else { s = intern(name); } } return s; }
object io_read(object port) { return lisp_read(port_implementation(port)); }
object lisp_read(FILE *in) { int c; while ((c = fgetc(in)) != EOF) { /* atmosphere */ if (isspace(c)) { continue; } else if (c == ';') { while (c != EOF && c != '\n') c = fgetc(in); continue; } /* characters, booleans or numbers with radix */ else if (c == '#') { c = fgetc(in); switch (c) { /* number prefixes */ case 'b': case 'B': case 'o': case 'O': case 'x': case 'X': case 'd': case 'D': case 'e': case 'i': ungetc(c, in); return read_number(in); /* booleans */ case 't': case 'T': return the_truth; case 'f': case 'F': return the_falsity; /* characters */ case '\\': return read_character(in); /* vectors */ case '(': ungetc(c, in); return read_vector(in); /* commented form, read and discard */ case ';': lisp_read(in); continue; case '<': error("Object cannot be read back -- read", nil); default: error("Unexpected character -- read", nil); } } /* number */ else if (isdigit(c) || ((c == '-') && isdigit(peek_char(in))) || ((c == '+') && isdigit(peek_char(in)))) { ungetc(c, in); return read_number(in); } /* string */ else if (c == '"') { return read_string(in); } /* symbol */ else if (is_initial(c)) { ungetc(c, in); return read_identifier(in); } /* peculiar identifiers */ else if (((c == '+') || c == '-') && is_delimiter(peek_char(in))) { return make_symbol_c((c == '+' ? "+" : "-")); } /* stuff starting with dot, FIXME for floats */ else if (c == '.') { if (is_delimiter(peek_char(in))) error("Illegal use of . -- read", nil); c = fgetc(in); if (c != '.' || peek_char(in) != '.') error("Symbol has bad name -- read", nil); c = fgetc(in); if (!is_delimiter(peek_char(in))) error("Symbol has bad name -- read", nil); return _ellipsis; } /* pair */ else if (c == '(') { return read_pair(in); } /* quote */ else if (c == '\'') { return cons(_quote, cons(lisp_read(in), nil)); } /* quasiquote */ else if (c == '`') { return cons(_quasiquote, cons(lisp_read(in), nil)); } /* unquote & unquote-splicing */ else if (c == ',') { if (peek_char(in) == '@') { c = fgetc(in); return cons(_unquote_splicing, cons(lisp_read(in), nil)); } else return cons(_unquote, cons(lisp_read(in), nil)); } else error("Unexpected character -- read", nil); } return end_of_file; }
void repl_run(repl_t * repl) { object_t *repl_obj = lisp_read(repl->lisp, REPL_EXPR, strlen(REPL_EXPR)); lisp_eval(repl->lisp, repl_obj); }