/** * dup an object */ lv_t *lisp_dup_item(lv_t *v) { lv_t *r; lv_t *vptr = v; lv_t *rptr; assert(v); switch(v->type) { case l_int: r = lisp_create_int(0); mpz_set(L_INT(r), L_INT(v)); return r; case l_rational: r = lisp_create_rational(1, 1); mpq_set(L_RAT(r), L_RAT(v)); return r; case l_float: r = lisp_create_float(0.0); mpfr_set(L_FLOAT(r), L_FLOAT(v), MPFR_ROUND_TYPE); return r; case l_bool: return v; case l_sym: return lisp_create_symbol(L_SYM(v)); case l_str: return lisp_create_string(L_STR(v)); case l_null: return v; case l_port: /* can't really copy this -- it's a socket or a file handle, or something else. */ return v; case l_char: return lisp_create_char(L_CHAR(v)); case l_fn: /* can't really copy this either, but it's essentially immutable */ return v; case l_err: return lisp_create_err(L_ERR(v)); case l_hash: /* FIXME: should really be a copy */ return v; case l_pair: r = lisp_create_pair(NULL, NULL); rptr = r; while(vptr && L_CAR(vptr)) { L_CAR(rptr) = lisp_dup_item(L_CAR(vptr)); vptr = L_CDR(vptr); if(vptr) { L_CDR(rptr) = lisp_create_pair(NULL, NULL); rptr = L_CDR(rptr); } } return r; } assert(0); }
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++; } }
/** * generate a unique symbol. This should probably */ lv_t *p_gensym(lexec_t *exec, lv_t *v) { static int sym_no=0; char buffer[20]; assert(v && (v->type == l_pair || v->type == l_null)); rt_assert(c_list_length(v) == 0, le_arity, "gensym arity"); snprintf(buffer, sizeof(buffer), "<gensym-%05d>", sym_no++); return lisp_create_symbol(buffer); }
/** * wrap a lisp value in a symbol (quote, dequote, etc) */ lv_t *lisp_wrap_type(char *symv, lv_t *v) { lv_t *cdr = lisp_create_pair(v, NULL); lv_t *car = lisp_create_pair(lisp_create_symbol(symv), cdr); return car; }