/* Define procedures cadr, caddr, etc. */
static void define_pair_procedures(env_hashtable *env)
{
buffer *a = buffer_new(""),
*b = buffer_new("x");
define_recursive(a, b, 0, env);
buffer_free(a);
buffer_free(b);
}
/* Define procedures cadr, caddr, etc. */
static void define_pair_procedures(env_hashtable *env)
{
void define_recursive(char *ad_name, char *body, int depth) {
char bufa[1000], bufb[1000];
if (depth > 4)
return;
if (depth > 1) {
sprintf(bufa,
"(define c%sr (lambda (x) %s))",
ad_name,
body);
eval_str(bufa, env);
}
sprintf(bufa, "a%s", ad_name);
sprintf(bufb, "(car %s)", body);
define_recursive(bufa, bufb, depth + 1);
sprintf(bufa, "d%s", ad_name);
sprintf(bufb, "(cdr %s)", body);
define_recursive(bufa, bufb, depth + 1);
}
static void define_recursive(buffer *ad_name, buffer *body, int depth,
env_hashtable *env) {
buffer *expr_buffer,
*new_ad_name,
*new_body;
char *expr_str;
if (depth > 4)
return;
if (depth > 1) {
expr_buffer = buffer_nprintf("(define c%br"
" (lambda (x) %b))",
ad_name,
body);
expr_str = buffer_to_str(expr_buffer);
eval_str(expr_str, env);
free(expr_str);
free(expr_buffer);
}
new_ad_name = buffer_nprintf("a%b", ad_name);
new_body = buffer_nprintf("(car %b)", body);
define_recursive(new_ad_name, new_body, depth + 1, env);
buffer_free(new_ad_name);
buffer_free(new_body);
new_ad_name = buffer_nprintf("d%b", ad_name);
new_body = buffer_nprintf("(cdr %b)", body);
define_recursive(new_ad_name, new_body, depth + 1, env);
buffer_free(new_ad_name);
buffer_free(new_body);
}
