static rsexp compile_procedure_definition (RState* r,
rsexp expr,
rsexp next)
{
rsexp var, body, formals;
rsexp bind, code;
if (!validate_procedure_definition (r, expr))
return R_FAILURE;
var = r_caadr (expr);
body = r_reverse_x (r, r_cddr (expr));
formals = r_cdadr (expr);
r_gc_scope_open (r);
ensure_or_goto (code = bind = emit_bind (r, var, next), exit);
ensure_or_goto (code = emit_return (r), exit);
ensure_or_goto (code = compile_sequence (r, body, code), exit);
ensure_or_goto (code = emit_close (r, formals, code, bind), exit);
exit:
r_gc_scope_close_and_protect (r, code);
return code;
}
rsexp r_compile (RState* r, rsexp program)
{
rsexp halt = emit_halt (r);
return r_failure_p (halt)
? R_FAILURE
: compile_sequence (r, program, halt);
}
value_t compile_lambda(value_t expr, value_t next) {
int32_t arguments = pair_linked_length(expr);
if (arguments < 2) {
error(1, 0, "Expected at least 2 arguments for 'lambda', got %d", arguments);
}
value_t arg_list = pair_left(expr);
value_t body = pair_right(expr);
value_t return_expr = make_list(OP_RETURN, 0);
protect_value(return_expr);
value_t compiled_body = compile_sequence(body, return_expr);
protect_value(compiled_body);
value_t result = make_list(OP_CLOSURE, arg_list, compiled_body, next, 0);
unprotect_storage(2);
return result;
}
static rsexp compile_lambda (RState* r, rsexp expr, rsexp next)
{
rsexp formals;
rsexp body;
rsexp code;
if (!validate_lambda (r, expr))
return R_FAILURE;
formals = r_cadr (expr);
body = r_reverse_x (r, r_cddr (expr));
r_gc_scope_open (r);
ensure_or_goto (code = emit_return (r), exit);
ensure_or_goto (code = compile_sequence (r, body, code), exit);
ensure_or_goto (code = emit_close (r, formals, code, next), exit);
exit:
r_gc_scope_close_and_protect (r, code);
return code;
}
value_t compile_sequence(value_t expr_list, value_t next) {
// The desired output of this is:
// compile_sequence( { exp1, exp2, exp3 }, next)
// -> compile(exp1, compile(exp2, compile(exp3, next)))
value_t result;
if (expr_list == EMPTY_LIST) {
// We got to the bottom of the sequence, it should return simply the
// value given as "next", since there's nothing else to compile.
result = next;
}
else {
// Here we have a recursion to make. A stack consuming one, since we
// want to compile them from the bottom to the top of the sequence, so
// we can chain the compilation using the compiled next expression as
// 'next' value for this one.
value_t expression = pair_left(expr_list);
value_t expr_tail = pair_right(expr_list);
value_t expr_next = compile_sequence(expr_tail, next);
protect_value(expr_next);
result = compile(expression, expr_next);
unprotect_storage(1);
}
return result;
}
