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