void
pic_set(pic_state *pic, const char *name, pic_value val)
{
size_t ai = pic_enter(pic);
pic_global_set(pic, pic_intern_cstr(pic, name), val);
pic_leave(pic, ai);
}
void
pic_print_backtrace(pic_state *pic, xFILE *file)
{
assert(! pic_invalid_p(pic->err));
if (! pic_error_p(pic->err)) {
xfprintf(file, "raise: ");
pic_fwrite(pic, pic->err, file);
} else {
struct pic_error *e;
e = pic_error_ptr(pic->err);
if (e->type != pic_intern_cstr(pic, "")) {
pic_fwrite(pic, pic_obj_value(e->type), file);
xfprintf(file, " ");
}
xfprintf(file, "error: ");
pic_fwrite(pic, pic_obj_value(e->msg), file);
xfprintf(file, "\n");
/* TODO: print error irritants */
xfputs(pic_str_cstr(pic, e->stack), file);
}
}
pic_value
pic_ref(pic_state *pic, const char *name)
{
size_t ai = pic_enter(pic);
pic_value r = pic_global_ref(pic, pic_intern_cstr(pic, name));
pic_leave(pic, ai);
return pic_protect(pic, r);
}
void
pic_define(pic_state *pic, const char *name, pic_value val)
{
pic_value sym = pic_intern_cstr(pic, name);
if (pic_dict_has(pic, pic->globals, sym)) {
pic_warnf(pic, "redefining variable: %s", pic_str(pic, pic_sym_name(pic, sym), NULL));
}
pic_dict_set(pic, pic->globals, sym, val);
}
static pic_value
pic_symbol_string_to_symbol(pic_state *pic)
{
pic_value v;
pic_get_args(pic, "o", &v);
if (! pic_str_p(v)) {
pic_error(pic, "string->symbol: expected string");
}
return pic_symbol_value(pic_intern_cstr(pic, pic_str_cstr(pic_str_ptr(v))));
}
struct pic_proc *
pic_make_proc(pic_state *pic, pic_func_t func, const char *name)
{
struct pic_proc *proc;
assert(name != NULL);
proc = (struct pic_proc *)pic_obj_alloc(pic, sizeof(struct pic_proc), PIC_TT_PROC);
proc->kind = PIC_PROC_KIND_FUNC;
proc->u.func.f = func;
proc->u.func.name = pic_intern_cstr(pic, name);
proc->env = NULL;
return proc;
}
struct pic_record *
pic_make_record(pic_state *pic, pic_value rectype)
{
struct pic_record *rec;
struct pic_dict *data;
data = pic_make_dict(pic);
rec = (struct pic_record *)pic_obj_alloc(pic, sizeof(struct pic_record), PIC_TT_RECORD);
rec->data = data;
pic_record_set(pic, rec, pic_intern_cstr(pic, "@@type"), rectype);
return rec;
}
pic_value
pic_make_error(pic_state *pic, const char *type, const char *msg, pic_value irrs)
{
struct error *e;
pic_value stack, ty = pic_intern_cstr(pic, type);
stack = pic_get_backtrace(pic);
e = (struct error *)pic_obj_alloc(pic, sizeof(struct error), PIC_TYPE_ERROR);
e->type = pic_sym_ptr(pic, ty);
e->msg = pic_str_ptr(pic, pic_cstr_value(pic, msg));
e->irrs = irrs;
e->stack = pic_str_ptr(pic, stack);
return pic_obj_value(e);
}
struct pic_proc *
pic_make_proc(pic_state *pic, pic_func_t func, const char *name)
{
struct pic_proc *proc;
pic_sym *sym;
assert(name != NULL);
sym = pic_intern_cstr(pic, name);
proc = (struct pic_proc *)pic_obj_alloc(pic, sizeof(struct pic_proc), PIC_TT_PROC);
proc->tag = PIC_PROC_TAG_FUNC;
proc->u.f.func = func;
proc->u.f.name = sym;
proc->u.f.env = NULL;
return proc;
}
bool
pic_interned_p(pic_state *pic, pic_sym sym)
{
return sym == pic_intern_cstr(pic, pic_symbol_name(pic, sym));
}
void
pic_attr_set(pic_state *pic, pic_value obj, const char *key, pic_value v)
{
pic_dict_set(pic, pic_attr(pic, obj), pic_intern_cstr(pic, key), v);
}
pic_value
pic_attr_ref(pic_state *pic, pic_value obj, const char *key)
{
return pic_dict_ref(pic, pic_attr(pic, obj), pic_intern_cstr(pic, key));
}
void
pic_error(pic_state *pic, const char *msg, pic_value irrs)
{
pic_throw(pic, pic_intern_cstr(pic, ""), msg, irrs);
}
pic_value
pic_proc_env_ref(pic_state *pic, struct pic_proc *proc, const char *key)
{
return pic_dict_ref(pic, pic_proc_env(pic, proc), pic_intern_cstr(pic, key));
}
bool
pic_proc_env_has(pic_state *pic, struct pic_proc *proc, const char *key)
{
return pic_dict_has(pic, pic_proc_env(pic, proc), pic_intern_cstr(pic, key));
}
void
pic_add_feature(pic_state *pic, const char *feature)
{
pic_push(pic, pic_intern_cstr(pic, feature), pic->features);
}
void
pic_proc_env_set(pic_state *pic, struct pic_proc *proc, const char *key, pic_value val)
{
pic_dict_set(pic, pic_proc_env(pic, proc), pic_intern_cstr(pic, key), val);
}
pic_value
pic_record_type(pic_state *pic, struct pic_record *rec)
{
return pic_record_ref(pic, rec, pic_intern_cstr(pic, "@@type"));
}
