bool
eq(term_t x, term_t y){
if((TAG(x)==TAG_ATOM)&&(TAG(y)==TAG_ATOM))
return x==y;
if(TAG(x)||TAG(y))
return false;
if((!x)&&(!y))
return true;
if((PTAG(x)!=PTAG_ATOM)||(PTAG(y)!=PTAG_ATOM))
return false;
if(x==y)
return true;
return atom_eq(((struct atom*)x)->s,((struct atom*)y)->s);
}
static obj_t parse_atom(struct Parser *st)
{
struct token *t = next(st);
size_t i;
switch (t->type) {
case DOT:
reportlocf(st->rep, t->loc, "datum expected");
return unspecific;
case CPAREN:
reportlocf(st->rep, t->loc, "unmatched parenthesis");
return unspecific;
case END:
return unspecific;
case CHAR:
if (t->len == 2) {
reportlocf(st->rep, t->loc,
"end-of-input in character literal");
return unspecific;
} else if (t->len == 3) {
return make_char(t->text[2]);
} else {
/* Convert to lowercase */
for (i = 0; i < t->len; i++)
t->text[i] = tolower(t->text[i]);
if (atom_eq("#\\space", t->text, t->len)) {
/* Space character literal */
return make_char(' ');
} else if (atom_eq("#\\newline", t->text, t->len)) {
/* Newline character literal */
return make_char('\n');
} else {
reportlocf(st->rep, t->loc,
"illegal character literal");
return unspecific;
}
}
case ATOM:
/* Convert to lowercase */
for (i = 0; i < t->len; i++)
t->text[i] = tolower(t->text[i]);
if (atom_eq("#f", t->text, t->len)) {
/* False constant */
return false_obj;
} else if (atom_eq("#t", t->text, t->len)) {
/* True constant */
return true_obj;
} else if (is_number(t->text, t->len)) {
/* Copy to buffer to make null-terminated */
char *buf = GC_MALLOC_ATOMIC((t->len+1) * sizeof(char));
strncpy(buf, t->text, t->len);
buf[t->len] = 0;
/* Convert to number */
return make_num(atol(buf));
} else if (is_ident(t->text, t->len)) {
/* Symbol */
return make_symbol(intern_string(string_from(t->text, t->len)));
} else {
/* Invalid atom */
reportlocf(st->rep, t->loc, "unrecognized atom");
return unspecific;
}
case STRING:
return parse_string(st, t);
case OARRAY:
reportlocf(st->rep, t->loc, "array literals are not supported");
/* fallthrough: continue processing as lists */
case OPAREN:
return parse_list(st);
case QUOTE:
return parse_quotation(S_QUOTE, st);
case QUASIQUOTE:
return parse_quotation(S_QUASIQUOTE, st);
case UNQUOTE:
return parse_quotation(S_UNQUOTE, st);
case UNQUOTE_SPLICING:
return parse_quotation(S_UNQUOTE_SPLICING, st);
}
/* We should never get to here */
return unspecific;
}
