object *compound_procedure(object *params, object *body,
env_hashtable *env)
{
object *p = ALLOC(object);
TYPE(p) = OBJ_COMPOUND_PROCEDURE;
CPROC_PARAMS(p) = params;
CPROC_BODY(p) = cons(symbol("begin"), body);
CPROC_ENV(p) = env;
return p;
}
/* Apply procedure */
object *apply(object *proc, object *args)
{
primitive_proc p;
env_hashtable *e;
object *params, *param, *arg;
char *s_param;
if (TYPE(proc) == OBJ_PRIMITIVE_PROCEDURE) {
p = PROC(proc);
return p(args);
} else if (TYPE(proc) == OBJ_COMPOUND_PROCEDURE) {
e = env_hashtable_child(CPROC_ENV(proc));
params = CPROC_PARAMS(proc);
while (params != null_object) {
if (TYPE(params) != OBJ_PAIR) {
param = params;
arg = args;
} else {
param = CAR(params);
arg = CAR(args);
}
s_param = STR(param);
env_hashtable_insert(e, s_param, arg);
if (TYPE(params) != OBJ_PAIR)
break;
params = CDR(params);
args = CDR(args);
}
return eval(CPROC_BODY(proc), e);
}
return NULL;
}