lv_t *lisp_args_overlay(lexec_t *exec, lv_t *formals, lv_t *args) {
lv_t *pf, *pa;
lv_t *env_layer;
assert(formals->type == l_pair ||
formals->type == l_null ||
formals->type == l_sym);
assert(args->type == l_pair || args->type == l_null || args->type == l_sym);
env_layer = lisp_create_hash();
pf = formals;
pa = args;
/* no args */
if(pf->type == l_null) {
rt_assert(c_list_length(pa) == 0, le_arity, "too many arguments");
return env_layer;
}
/* single arg gets the whole list */
if(pf->type == l_sym) {
c_hash_insert(env_layer, pf, lisp_dup_item(pa));
return env_layer;
}
/* walk through the formal list, matching to args */
while(pf && L_CAR(pf)) {
rt_assert(pa && L_CAR(pa), le_arity, "not enough arguments");
c_hash_insert(env_layer, L_CAR(pf), L_CAR(pa));
pf = L_CDR(pf);
pa = L_CDR(pa);
if(pf && pf->type == l_sym) {
/* improper list */
if(!pa) {
c_hash_insert(env_layer, pf, lisp_create_null());
} else {
c_hash_insert(env_layer, pf, lisp_dup_item(pa));
}
return env_layer;
}
rt_assert(!pf || pf->type == l_pair, le_type, "unexpected formal type");
}
rt_assert(!pa, le_arity, "too many arguments");
return env_layer;
}
lv_t *lisp_let_star(lexec_t *exec, lv_t *args, lv_t *expr) {
lv_t *argp = args;
lv_t *newenv;
lv_t *result;
newenv = lisp_create_pair(lisp_create_hash(), exec->env);
rt_assert(args->type == l_null ||
args->type == l_pair, le_type,
"let arg type");
lisp_exec_push_env(exec, newenv);
if(args->type == l_pair) {
/* walk through each element of the list,
evaling k/v pairs and assigning them
to an environment to run the expr in */
while(argp && L_CAR(argp)) {
rt_assert(c_list_length(L_CAR(argp)) == 2, le_arity,
"let arg arity");
c_hash_insert(L_CAR(newenv), L_CAAR(argp),
lisp_eval(exec, L_CADAR(argp)));
argp=L_CDR(argp);
}
}
result = lisp_eval(exec, expr);
lisp_exec_pop_env(exec);
return result;
}
lv_t *c_env_version(int version) {
environment_list_t *current = s_env_prim;
lv_t *p_layer = lisp_create_hash();
lv_t *newenv;
char filename[40];
lexec_t *exec;
newenv = lisp_create_pair(lisp_create_hash(),
lisp_create_pair(p_layer, NULL));
exec = safe_malloc(sizeof(lexec_t));
memset(exec, 0, sizeof(lexec_t));
exec->env = newenv;
snprintf(filename, sizeof(filename), "env/r%d.scm", version);
/* now, load up a primitive environment */
while(current && current->name) {
c_hash_insert(p_layer, lisp_create_string(current->name),
lisp_create_native_fn(current->fn));
current++;
}
/* now, run the setup environment */
p_load(exec, lisp_create_pair(lisp_create_string(filename), NULL));
/* and return just the generated environment */
return lisp_create_pair(L_CAR(exec->env), NULL);
}
void repl(int level) {
char prompt[30];
char *cmd;
int quit = 0;
int line = 1;
lv_t *parsed_value;
lv_t *env_sym;
lv_t *result;
lv_t *arg;
lv_t *str;
char sym_buf[20];
lexec_t *exec;
exec = lisp_context_new(5); /* get r5rs environment */
while(!quit) {
snprintf(prompt, sizeof(prompt), "%d:%d> ", level, line);
// r!
cmd = readline(prompt);
if(!cmd) {
printf("\n");
quit = 1;
break;
}
if(!*cmd)
continue;
parsed_value = lisp_parse_string(cmd);
if(!parsed_value) {
fprintf(stderr, "synax error\n");
continue;
}
// e!
result = lisp_execute(exec, parsed_value);
// p!
if(result && !is_nil(result)) {
sprintf(sym_buf, "$%d", line);
env_sym = lisp_create_symbol(sym_buf);
c_hash_insert(L_CAR(exec->env), env_sym, result);
dprintf(1, "%s = ", sym_buf);
str = lisp_str_from_value(result);
printf("%s\n", L_STR(str));
}
// and l. ;)
add_history(cmd);
free(cmd);
line++;
}
}
lv_t *lisp_define(lexec_t *exec, lv_t *sym, lv_t *v) {
assert(exec);
/* this is probably not a good or completely safe
* check of an environment */
rt_assert(exec->env->type == l_pair &&
L_CAR(exec->env) &&
L_CAR(exec->env)->type == l_hash, le_type,
"Not a valid environment");
rt_assert(sym->type == l_sym, le_type, "cannot define non-symbol");
rt_assert(c_hash_insert(L_CAR(exec->env), sym, v), le_internal,
"error inserting hash element");
return lisp_create_null();
}
