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