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;
}
expr_val * compile_statement(base_node * stmt, scope * scope, str_list * lines) {
int op;
switch (stmt->type) {
case BINARY_OP_NODE:
op = ((binary_op_node*) stmt)->op;
switch(op) {
case OP_EQUAL:
return compile_assignment(((binary_op_node*) stmt), scope, lines);
case OP_PLUS:
return compile_addition(((binary_op_node*) stmt), scope, lines);
case OP_TYPE_ASS:
return compile_type_assignment(((binary_op_node*) stmt), scope, lines);
case EQUAL: case LESS: case LESS_EQUAL: case GREATER: case GREATER_EQUAL:
return compile_comparison_assignment(((binary_op_node*) stmt), scope, lines);
}
case IF_NODE:
return compile_if((if_node*) stmt, scope, lines);
case BLOCK_NODE:
return compile_block((block_node *) stmt, scope, lines, 1);
case ID_NODE:
return compile_id(((id_node*) stmt), scope, lines);
case INT_NODE:
return compile_int((int_node*) stmt, scope, lines);
case CHAR_NODE:
return compile_char((char_node*) stmt, scope, lines);
case INT_TYPE_NODE:
return compile_int_type((type_node *) stmt, scope, lines);
case CHAR_TYPE_NODE:
return compile_char_type((type_node *) stmt, scope, lines);
case FUNC_NODE:
return compile_function((function_node*) stmt, scope, lines);
case FUNC_ARGS_NODE:
return compile_args((argument_node *) stmt, scope, lines);
case RETURN_NODE:
return compile_return((return_node *) stmt, scope, lines);
case CALL_NODE:
return compile_call((call_node *) stmt, scope, lines);
case CALL_ARGS_NODE:
return compile_call_args((argument_node *) stmt, scope, lines);
case END_NODE:
break;
}
return NULL;
}
static HRESULT compile_call_statement(compile_ctx_t *ctx, call_statement_t *stat)
{
/* It's challenging for parser to distinguish parameterized assignment with one argument from call
* with equality expression argument, so we do it in compiler. */
if(!stat->is_strict && stat->expr->args && !stat->expr->args->next && stat->expr->args->type == EXPR_EQUAL) {
binary_expression_t *eqexpr = (binary_expression_t*)stat->expr->args;
if(eqexpr->left->type == EXPR_BRACKETS) {
member_expression_t new_member = *stat->expr;
WARN("converting call expr to assign expr\n");
new_member.args = ((unary_expression_t*)eqexpr->left)->subexpr;
return compile_assignment(ctx, &new_member, eqexpr->right, FALSE);
}
}
return compile_member_expression(ctx, stat->expr, FALSE);
}
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;
}
static HRESULT compile_assign_statement(compile_ctx_t *ctx, assign_statement_t *stat, BOOL is_set)
{
return compile_assignment(ctx, stat->member_expr, stat->value_expr, is_set);
}
