static li_object *eval_quasiquote(li_object *exp, li_object *env) {
li_object *head, *iter, *tail;
if (!li_is_pair(exp))
return exp;
else if (li_is_unquoted(exp))
return li_eval(li_cadr(exp), env);
else if (li_is_unquoted_splicing(li_car(exp))) {
head = tail = li_null;
for (iter = li_eval(li_cadar(exp), env); iter; iter = li_cdr(iter)) {
if (head)
tail = li_set_cdr(tail, li_cons(li_car(iter), li_null));
else
head = tail = li_cons(li_car(iter), li_null);
}
if (tail) {
li_set_cdr(tail, eval_quasiquote(li_cdr(exp), env));
return head;
} else {
return eval_quasiquote(li_cdr(exp), env);
}
}
return li_cons(eval_quasiquote(li_car(exp), env),
eval_quasiquote(li_cdr(exp), env));
}
static li_object *list_of_values(li_object *exps, li_object *env) {
li_object *head, *node, *tail;
head = li_null;
while (exps) {
tail = li_cons(li_eval(li_car(exps), env), li_null);
node = head ? li_set_cdr(node, tail) : (head = tail);
exps = li_cdr(exps);
}
return head;
}
static li_object *p_get_environment_variables(li_object *args)
{
extern const char *const *environ;
const char *const *sp = environ;
li_object *head = NULL,
*tail = NULL;
li_parse_args(args, "");
while (*sp) {
if (head)
tail = li_set_cdr(tail, li_cons(li_string_make(*sp), NULL));
else
head = tail = li_cons(li_string_make(*sp), NULL);
sp++;
}
return head;
}
extern li_object *li_apply(li_object *proc, li_object *args) {
li_object *head, *tail, *obj;
if (li_is_primitive_procedure(proc))
return li_to_primitive_procedure(proc)(args);
head = li_null;
while (args) {
obj = li_car(args);
if (!li_is_self_evaluating(obj))
obj = li_cons(li_symbol("quote"), li_cons(obj, li_null));
if (head)
tail = li_set_cdr(tail, li_cons(obj, li_null));
else
head = tail = li_cons(obj, li_null);
args = li_cdr(args);
}
return li_eval(li_cons(proc, head), li_to_lambda(proc).env);
}
