static void
write_str(pic_state *pic, pic_value str, pic_value port, struct writer_control *p)
{
int i;
const char *cstr = pic_str(pic, str);
if (p->mode == DISPLAY_MODE) {
pic_fprintf(pic, port, "%s", pic_str(pic, str));
return;
}
pic_fprintf(pic, port, "\"");
for (i = 0; i < pic_str_len(pic, str); ++i) {
if (cstr[i] == '"' || cstr[i] == '\\') {
pic_fputc(pic, '\\', port);
}
pic_fputc(pic, cstr[i], port);
}
pic_fprintf(pic, port, "\"");
}
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);
}
void
pic_warnf(pic_state *pic, const char *fmt, ...)
{
va_list ap;
pic_value err;
va_start(ap, fmt);
err = pic_vstrf_value(pic, fmt, ap);
va_end(ap);
pic_fprintf(pic, pic_stderr(pic), "warn: %s\n", pic_str(pic, err));
}
static void
write_core(pic_state *pic, pic_value obj, pic_value port, struct writer_control *p)
{
pic_value labels = p->labels;
int i;
/* shared objects */
if (is_shared_object(pic, obj, p)) {
if (pic_weak_has(pic, labels, obj)) {
pic_fprintf(pic, port, "#%d#", pic_int(pic, pic_weak_ref(pic, labels, obj)));
return;
}
i = p->cnt++;
pic_fprintf(pic, port, "#%d=", i);
pic_weak_set(pic, labels, obj, pic_int_value(pic, i));
}
switch (pic_type(pic, obj)) {
case PIC_TYPE_UNDEF:
pic_fprintf(pic, port, "#undefined");
break;
case PIC_TYPE_NIL:
pic_fprintf(pic, port, "()");
break;
case PIC_TYPE_TRUE:
pic_fprintf(pic, port, "#t");
break;
case PIC_TYPE_FALSE:
pic_fprintf(pic, port, "#f");
break;
case PIC_TYPE_ID:
pic_fprintf(pic, port, "#<identifier %s>", pic_str(pic, pic_id_name(pic, obj)));
break;
case PIC_TYPE_EOF:
pic_fprintf(pic, port, "#.(eof-object)");
break;
case PIC_TYPE_INT:
pic_fprintf(pic, port, "%d", pic_int(pic, obj));
break;
case PIC_TYPE_SYMBOL:
pic_fprintf(pic, port, "%s", pic_sym(pic, obj));
break;
case PIC_TYPE_FLOAT:
write_float(pic, obj, port);
break;
case PIC_TYPE_BLOB:
write_blob(pic, obj, port);
break;
case PIC_TYPE_CHAR:
write_char(pic, obj, port, p);
break;
case PIC_TYPE_STRING:
write_str(pic, obj, port, p);
break;
case PIC_TYPE_PAIR:
write_pair(pic, obj, port, p);
break;
case PIC_TYPE_VECTOR:
write_vec(pic, obj, port, p);
break;
case PIC_TYPE_DICT:
write_dict(pic, obj, port, p);
break;
default:
pic_fprintf(pic, port, "#<%s %p>", pic_typename(pic, pic_type(pic, obj)), pic_obj_ptr(obj));
break;
}
if (p->op == OP_WRITE) {
if (is_shared_object(pic, obj, p)) {
pic_weak_del(pic, labels, obj);
}
}
}
