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); }