/* Read a lisp object. This is the main interface to the reader. */
sexpr *readobj(IC *ic) {
reader *r = ic->r;
char *token;
/* These are used by strtod(). Number is the return value, and
unparsed is set to the portion of the string not parsed.
If it is not pointing at the terminating '\0' when we are done, then
we failed to get a number. */
double number;
char *unparsed;
token = gettoken(r);
if(token == NULL) return ic->eof;
if(!strcmp(token, "(")) return readlist(ic);
if(!strcmp(token, "\'") ||
!strcmp(token, "`") ||
!strcmp(token, ",") ||
!strcmp(token, ",@")) {
/* We are going to read the following object, and then wrap it in
a call to something. Figure out what that something is. */
sexpr *quoter = NULL;
protect_ptr(ic->g, (void **)"er);
if(!strcmp(token, "\'"))
STORE(ic->g, NULL, quoter, ic->n_quote);
else if(!strcmp(token, "`"))
STORE(ic->g, NULL, quoter, ic->n_quasiquote);
else if(!strcmp(token, ","))
STORE(ic->g, NULL, quoter, ic->n_unquote);
else if(!strcmp(token, ",@"))
STORE(ic->g, NULL, quoter, ic->n_unquote_splicing);
else {
fprintf(stderr,
"Fatal error in lisp reader - this should never happen!\n");
longjmp(ic->quit, 1);
}
sexpr *obj = readobj(ic);
protect_ptr(ic->g, (void **)&obj);
sexpr *ret = listl(ic, quoter, obj, NULL);
unprotect_ptr(ic->g);
unprotect_ptr(ic->g);
return ret;
}
/* Check to see if it's a valid number. */
if(strcasecmp(token, "inf") &&
strcasecmp(token, "infinity") &&
strcasecmp(token, "nan")) {
number = strtod(token, &unparsed);
if(unparsed != token && *unparsed == '\0')
return mk_number(ic, number);
}
return intern(ic, token);
}
static enum TOK_T get_next_token(port *in, pointer *token)
{
char ch, *t;
skip_white_spc(in);
switch (ch = get_next_char(in)) {
case EOF:
return FILE_END;
case '(':
return LIST_START;
case ')':
return LIST_END;
case '"':
*token = mk_string(read_string(in));
return STRING;
case '\'':
return QUOTE;
case '`':
return BACKQUOTE;
case ',':
if ((ch = get_next_char(in)) == '@')
return SPLICE;
else {
push_back_char(in, ch);
return UNQUOTE;
}
case '.':
return DOT;
default:
push_back_char(in, ch);
t = get_char_until_delim(in);
if (test_number(t)) {
*token = mk_number(atoi(t));
return NUMBER;
} else {
*token = mk_symbol(t);
return SYMBOL;
}
}
}
