static rsexp compile (RState* r, rsexp expr, rsexp next)
{
rsexp code;
r_gc_scope_open (r);
if (r_symbol_p (expr)) {
code = emit_refer (r, expr, next);
goto exit;
}
if (!r_pair_p (expr)) {
code = emit_constant (r, expr, next);
goto exit;
}
if (form_eq_p (r, R_QUOTE, expr)) {
code = compile_quotation (r, expr, next);
goto exit;
}
if (form_eq_p (r, R_DEFINE, expr)) {
code = compile_definition (r, expr, next);
goto exit;
}
if (form_eq_p (r, R_SET_X, expr)) {
code = compile_assignment (r, expr, next);
goto exit;
}
if (form_eq_p (r, R_IF, expr)) {
code = compile_conditional (r, expr, next);
goto exit;
}
if (form_eq_p (r, R_LAMBDA, expr)) {
code = compile_lambda (r, expr, next);
goto exit;
}
if (form_eq_p (r, R_CALL_CC, expr)) {
code = compile_call_cc (r, expr, next);
goto exit;
}
code = compile_application (r, expr, next);
exit:
r_gc_scope_close_and_protect (r, code);
return code;
}
value_t compile_form(value_t expr, value_t next) {
if (SYM_QUOTE == UNSPECIFIED) {
SYM_QUOTE = make_symbol("quote");
SYM_IF = make_symbol("if");
SYM_DEFINE = make_symbol("$DEFINE");
SYM_LAMBDA = make_symbol("lambda");
SYM_SET1 = make_symbol("set!");
SYM_DEFMACRO = make_symbol("define-rewriter");
SYM_CALLCC = make_symbol("$CALL-CC");
}
value_t head = pair_left(expr);
value_t result;
if (head == SYM_IF) {
result = compile_if(pair_right(expr), next);
}
else if (head == SYM_LAMBDA) {
result = compile_lambda(pair_right(expr), next);
}
else if (head == SYM_QUOTE) {
result = compile_quote(pair_right(expr), next);
}
else if (head == SYM_DEFINE) {
result = compile_define(pair_right(expr), next);
}
else if (head == SYM_SET1) {
result = compile_assignment(pair_right(expr), next);
}
else if (head == SYM_DEFMACRO) {
result = compile_defmacro(pair_right(expr), next);
}
else if (head == SYM_CALLCC) {
result = compile_call_cc(pair_right(expr), next);
}
else {
result = compile_application(expr, next);
}
return result;
}
