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