conservatory
/
picrin
4
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

Merge branch 'string-symbol'

This commit is contained in:
Yuichi Nishiwaki 2016-02-08 03:39:27 +09:00
parent e076a8f4e0 fd248d31bd
commit b3d5b1eea5
18 changed files with 122 additions and 217 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

6
contrib/20.r7rs/src/system.c
View File

@ -17,7 +17,7 @@ pic_system_cmdline(pic_state *pic)
for (i = 0; i < pic->argc; ++i) {
size_t ai = pic_gc_arena_preserve(pic);
v = pic_cons(pic, pic_obj_value(pic_make_str_cstr(pic, pic->argv[i])), v);
v = pic_cons(pic, pic_obj_value(pic_make_cstr(pic, pic->argv[i])), v);
pic_gc_arena_restore(pic, ai);
}
@ -84,7 +84,7 @@ pic_system_getenv(pic_state *pic)
if (val == NULL)
return pic_nil_value();
else
return pic_obj_value(pic_make_str_cstr(pic, val));
return pic_obj_value(pic_make_cstr(pic, val));
}
static pic_value
@ -108,7 +108,7 @@ pic_system_getenvs(pic_state *pic)
;
key = pic_make_str(pic, *envp, i);
val = pic_make_str_cstr(pic, getenv(pic_str_cstr(pic, key)));
val = pic_make_cstr(pic, getenv(pic_str_cstr(pic, key)));
/* push */
data = pic_acons(pic, pic_obj_value(key), pic_obj_value(val), data);

14
contrib/30.readline/src/readline.c
View File

@ -19,7 +19,7 @@ pic_rl_readline(pic_state *pic)
result = readline(prompt);
if(result)
return pic_obj_value(pic_make_str_cstr(pic, result));
return pic_obj_value(pic_make_cstr(pic, result));
else
return pic_eof_object();
}
@ -87,7 +87,7 @@ pic_rl_current_history(pic_state *pic)
{
pic_get_args(pic, "");
return pic_obj_value(pic_make_str_cstr(pic, current_history()->line));
return pic_obj_value(pic_make_cstr(pic, current_history()->line));
}
static pic_value
@ -100,7 +100,7 @@ pic_rl_history_get(pic_state *pic)
e = history_get(i);
return e ? pic_obj_value(pic_make_str_cstr(pic, e->line))
return e ? pic_obj_value(pic_make_cstr(pic, e->line))
: pic_false_value();
}
@ -114,7 +114,7 @@ pic_rl_remove_history(pic_state *pic)
e = remove_history(i);
return e ? pic_obj_value(pic_make_str_cstr(pic, e->line))
return e ? pic_obj_value(pic_make_cstr(pic, e->line))
: pic_false_value();
}
@ -148,7 +148,7 @@ pic_rl_previous_history(pic_state *pic)
e = previous_history();
return e ? pic_obj_value(pic_make_str_cstr(pic, e->line))
return e ? pic_obj_value(pic_make_cstr(pic, e->line))
: pic_false_value();
}
@ -161,7 +161,7 @@ pic_rl_next_history(pic_state *pic)
e = next_history();
return e ? pic_obj_value(pic_make_str_cstr(pic, e->line))
return e ? pic_obj_value(pic_make_cstr(pic, e->line))
: pic_false_value();
}
@ -240,7 +240,7 @@ pic_rl_history_expand(pic_state *pic)
if(status == -1 || status == 2)
pic_errorf(pic, "%s\n", result);
return pic_obj_value(pic_make_str_cstr(pic, result));
return pic_obj_value(pic_make_cstr(pic, result));
}
void

4
contrib/30.regexp/src/regexp.c
View File

@ -146,7 +146,7 @@ pic_regexp_regexp_split(pic_state *pic)
input += match.rm_eo;
}
pic_push(pic, pic_obj_value(pic_make_str_cstr(pic, input)), output);
pic_push(pic, pic_obj_value(pic_make_cstr(pic, input)), output);
return pic_reverse(pic, output);
}
@ -157,7 +157,7 @@ pic_regexp_regexp_replace(pic_state *pic)
pic_value reg;
const char *input;
regmatch_t match;
pic_str *txt, *output = pic_make_str(pic, NULL, 0);
pic_str *txt, *output = pic_make_lit(pic, "");
pic_get_args(pic, "ozs", &reg, &input, &txt);

10
extlib/benz/debug.c
View File

@ -11,18 +11,18 @@ pic_get_backtrace(pic_state *pic)
pic_callinfo *ci;
pic_str *trace;
trace = pic_make_str(pic, NULL, 0);
trace = pic_make_lit(pic, "");
for (ci = pic->ci; ci != pic->cibase; --ci) {
struct pic_proc *proc = pic_proc_ptr(ci->fp[0]);
trace = pic_str_cat(pic, trace, pic_make_str_cstr(pic, " at "));
trace = pic_str_cat(pic, trace, pic_make_str_cstr(pic, "(anonymous lambda)"));
trace = pic_str_cat(pic, trace, pic_make_lit(pic, " at "));
trace = pic_str_cat(pic, trace, pic_make_lit(pic, "(anonymous lambda)"));
if (pic_proc_func_p(proc)) {
trace = pic_str_cat(pic, trace, pic_make_str_cstr(pic, " (native function)\n"));
trace = pic_str_cat(pic, trace, pic_make_lit(pic, " (native function)\n"));
} else if (pic_proc_irep_p(proc)) {
trace = pic_str_cat(pic, trace, pic_make_str_cstr(pic, " (unknown location)\n")); /* TODO */
trace = pic_str_cat(pic, trace, pic_make_lit(pic, " (unknown location)\n")); /* TODO */
}
}

17
extlib/benz/error.c
View File

@ -21,30 +21,29 @@ void
pic_warnf(pic_state *pic, const char *fmt, ...)
{
va_list ap;
pic_value err_line;
pic_str *err;
va_start(ap, fmt);
err_line = pic_xvformat(pic, fmt, ap);
err = pic_vformat(pic, fmt, ap);
va_end(ap);
xfprintf(pic, pic_stderr(pic)->file, "warn: %s\n", pic_str_cstr(pic, pic_str_ptr(pic_car(pic, err_line))));
xfprintf(pic, pic_stderr(pic)->file, "warn: %s\n", pic_str_cstr(pic, err));
}
void
pic_errorf(pic_state *pic, const char *fmt, ...)
{
va_list ap;
pic_value err_line, irrs;
const char *msg;
pic_str *err;
va_start(ap, fmt);
err_line = pic_xvformat(pic, fmt, ap);
err = pic_vformat(pic, fmt, ap);
va_end(ap);
msg = pic_str_cstr(pic, pic_str_ptr(pic_car(pic, err_line)));
irrs = pic_cdr(pic, err_line);
msg = pic_str_cstr(pic, err);
pic_error(pic, msg, irrs);
pic_error(pic, msg, pic_nil_value());
}
pic_value
@ -101,7 +100,7 @@ pic_make_error(pic_state *pic, pic_sym *type, const char *msg, pic_value irrs)
e = (struct pic_error *)pic_obj_alloc(pic, sizeof(struct pic_error), PIC_TT_ERROR);
e->type = type;
e->msg = pic_make_str_cstr(pic, msg);
e->msg = pic_make_cstr(pic, msg);
e->irrs = irrs;
e->stack = stack;

16
extlib/benz/eval.c
View File

@ -117,7 +117,7 @@ analyzer_scope_destroy(pic_state *pic, analyze_scope *scope)
}
static bool
search_scope(analyze_scope *scope, pic_sym *sym)
search_scope(pic_state *pic, analyze_scope *scope, pic_sym *sym)
{
return kh_get(a, &scope->args, sym) != kh_end(&scope->args) || kh_get(a, &scope->locals, sym) != kh_end(&scope->locals) || scope->depth == 0;
}
@ -128,7 +128,7 @@ find_var(pic_state *pic, analyze_scope *scope, pic_sym *sym)
int depth = 0, ret;
while (scope) {
if (search_scope(scope, sym)) {
if (search_scope(pic, scope, sym)) {
if (depth > 0) {
kh_put(a, &scope->captures, sym, &ret); /* capture! */
}
@ -145,13 +145,15 @@ define_var(pic_state *pic, analyze_scope *scope, pic_sym *sym)
{
int ret;
if (search_scope(scope, sym)) {
if (scope->depth > 0 || (pic_reg_has(pic, pic->globals, sym) && ! pic_invalid_p(pic_box_ptr(pic_reg_ref(pic, pic->globals, sym))->value))) {
if (search_scope(pic, scope, sym)) {
if (scope->depth > 0 || pic_reg_has(pic, pic->globals, sym)) {
pic_warnf(pic, "redefining variable: ~s", pic_obj_value(sym));
}
return;
}
pic_reg_set(pic, pic->globals, sym, pic_invalid_value());
kh_put(a, &scope->locals, sym, &ret);
}
@ -514,15 +516,11 @@ index_local(codegen_context *cxt, pic_sym *sym)
static int
index_global(pic_state *pic, codegen_context *cxt, pic_sym *name)
{
extern struct pic_box *pic_vm_gref_slot(pic_state *, pic_sym *);
int pidx;
struct pic_box *slot;
slot = pic_vm_gref_slot(pic, name);
check_pool_size(pic, cxt);
pidx = (int)cxt->plen++;
cxt->pool[pidx] = (struct pic_object *)(slot);
cxt->pool[pidx] = (struct pic_object *)name;
return pidx;
}

11
extlib/benz/gc.c
View File

@ -35,7 +35,6 @@ struct pic_object {
struct pic_port port;
struct pic_error err;
struct pic_lib lib;
struct pic_box box;
struct pic_checkpoint cp;
} u;
};
@ -385,6 +384,7 @@ gc_mark_object(pic_state *pic, struct pic_object *obj)
break;
}
case PIC_TT_SYMBOL: {
LOOP(obj->u.sym.str);
break;
}
case PIC_TT_REG: {
@ -394,12 +394,6 @@ gc_mark_object(pic_state *pic, struct pic_object *obj)
pic->heap->regs = reg;
break;
}
case PIC_TT_BOX: {
if (pic_obj_p(obj->u.box.value)) {
LOOP(pic_obj_ptr(obj->u.box.value));
}
break;
}
case PIC_TT_CP: {
if (obj->u.cp.prev) {
gc_mark_object(pic, (struct pic_object *)obj->u.cp.prev);
@ -566,7 +560,7 @@ gc_finalize_object(pic_state *pic, struct pic_object *obj)
break;
}
case PIC_TT_SYMBOL: {
pic_free(pic, (void *)obj->u.sym.cstr);
/* TODO: remove this symbol's entry from pic->syms immediately */
break;
}
case PIC_TT_REG: {
@ -588,7 +582,6 @@ gc_finalize_object(pic_state *pic, struct pic_object *obj)
case PIC_TT_LIB:
case PIC_TT_RECORD:
case PIC_TT_CP:
case PIC_TT_BOX:
break;
case PIC_TT_NIL:

3
extlib/benz/include/picrin.h
View File

@ -45,7 +45,7 @@ typedef struct pic_state pic_state;
#include "picrin/read.h"
#include "picrin/gc.h"
KHASH_DECLARE(s, const char *, pic_sym *)
KHASH_DECLARE(s, pic_str *, pic_sym *)
typedef struct pic_checkpoint {
PIC_OBJECT_HEADER
@ -251,7 +251,6 @@ pic_value pic_fdisplay(pic_state *, pic_value, xFILE *);
#include "picrin/symbol.h"
#include "picrin/vector.h"
#include "picrin/reg.h"
#include "picrin/box.h"
#if defined(__cplusplus)
}

34
extlib/benz/include/picrin/box.h
View File

@ -1,34 +0,0 @@
/**
* See Copyright Notice in picrin.h
*/
#ifndef PICRIN_BOX_H
#define PICRIN_BOX_H
#if defined(__cplusplus)
extern "C" {
#endif
struct pic_box {
PIC_OBJECT_HEADER
pic_value value;
};
#define pic_box_p(v) (pic_type(v) == PIC_TT_BOX)
#define pic_box_ptr(v) ((struct pic_box *)pic_ptr(v))
PIC_INLINE struct pic_box *
pic_box(pic_state *pic, pic_value value)
{
struct pic_box *box;
box = (struct pic_box *)pic_obj_alloc(pic, sizeof(struct pic_box), PIC_TT_BOX);
box->value = value;
return box;
}
#if defined(__cplusplus)
}
#endif
#endif

29
extlib/benz/include/picrin/khash.h
View File

@ -27,6 +27,8 @@
#ifndef AC_KHASH_H
#define AC_KHASH_H
#include <stddef.h>
typedef int khint_t;
typedef khint_t khiter_t;
@ -41,23 +43,6 @@ typedef khint_t khiter_t;
#define ac_roundup32(x) \
(--(x), (x)|=(x)>>1, (x)|=(x)>>2, (x)|=(x)>>4, (x)|=(x)>>8, (x)|=(x)>>16, ++(x))
PIC_INLINE khint_t ac_X31_hash_string(const char *s)
{
khint_t h = (khint_t)*s;
if (h) for (++s ; *s; ++s) h = (h << 5) - h + (khint_t)*s;
return h;
}
PIC_INLINE khint_t ac_Wang_hash(khint_t key)
{
key += ~(key << 15);
key ^= (key >> 10);
key += (key << 3);
key ^= (key >> 6);
key += ~(key << 11);
key ^= (key >> 16);
return key;
}
#define ac_fsize(m) ((m) < 16? 1 : (m)>>4)
#define ac_hash_upper(x) ((((x) * 2) * 77 / 100 + 1) / 2)
@ -71,7 +56,7 @@ PIC_INLINE khint_t ac_Wang_hash(khint_t key)
void kh_init_##name(kh_##name##_t *h); \
void kh_destroy_##name(pic_state *, kh_##name##_t *h); \
void kh_clear_##name(kh_##name##_t *h); \
khint_t kh_get_##name(const kh_##name##_t *h, khkey_t key); \
khint_t kh_get_##name(pic_state *, const kh_##name##_t *h, khkey_t key); \
void kh_resize_##name(pic_state *, kh_##name##_t *h, khint_t new_n_buckets); \
khint_t kh_put_##name(pic_state *, kh_##name##_t *h, khkey_t key, int *ret); \
void kh_del_##name(kh_##name##_t *h, khint_t x);
@ -95,8 +80,9 @@ PIC_INLINE khint_t ac_Wang_hash(khint_t key)
h->size = h->n_occupied = 0; \
} \
} \
khint_t kh_get_##name(const kh_##name##_t *h, khkey_t key) \
khint_t kh_get_##name(pic_state *pic, const kh_##name##_t *h, khkey_t key) \
{ \
(void)pic; \
if (h->n_buckets) { \
khint_t k, i, last, mask, step = 0; \
mask = h->n_buckets - 1; \
@ -220,9 +206,6 @@ PIC_INLINE khint_t ac_Wang_hash(khint_t key)
#define kh_ptr_hash_equal(a, b) ((a) == (b))
#define kh_int_hash_func(key) (int)(key)
#define kh_int_hash_equal(a, b) ((a) == (b))
#define kh_str_hash_func(key) ac_X31_hash_string(key)
#define kh_str_hash_equal(a, b) (strcmp(a, b) == 0)
#define kh_int_hash_func2(k) ac_Wang_hash((khint_t)key)
/* --- END OF HASH FUNCTIONS --- */
@ -232,7 +215,7 @@ PIC_INLINE khint_t ac_Wang_hash(khint_t key)
#define kh_clear(name, h) kh_clear_##name(h)
#define kh_resize(name, h, s) kh_resize_##name(pic, h, s)
#define kh_put(name, h, k, r) kh_put_##name(pic, h, k, r)
#define kh_get(name, h, k) kh_get_##name(h, k)
#define kh_get(name, h, k) kh_get_##name(pic, h, k)
#define kh_del(name, h, k) kh_del_##name(h, k)
#define kh_exist(h, x) (!ac_iseither((h)->flags, (x)))

1
extlib/benz/include/picrin/reg.h
View File

@ -26,7 +26,6 @@ pic_value pic_reg_ref(pic_state *, struct pic_reg *, void *);
void pic_reg_set(pic_state *, struct pic_reg *, void *, pic_value);
void pic_reg_del(pic_state *, struct pic_reg *, void *);
bool pic_reg_has(pic_state *, struct pic_reg *, void *);
void *pic_reg_rev_ref(pic_state *, struct pic_reg *, pic_value);
#if defined(__cplusplus)
}

11
extlib/benz/include/picrin/string.h
View File

@ -20,23 +20,20 @@ void pic_rope_decref(pic_state *, struct pic_rope *);
#define pic_str_p(v) (pic_type(v) == PIC_TT_STRING)
#define pic_str_ptr(o) ((struct pic_string *)pic_ptr(o))
pic_str *pic_make_str(pic_state *, const char * /* nullable */, int);
pic_str *pic_make_str_cstr(pic_state *, const char *);
pic_str *pic_make_str(pic_state *, const char *, int);
#define pic_make_cstr(pic, cstr) pic_make_str(pic, (cstr), strlen(cstr))
#define pic_make_lit(pic, lit) pic_make_str(pic, "" lit, -((int)sizeof lit - 1))
char pic_str_ref(pic_state *, pic_str *, int);
int pic_str_len(pic_str *);
pic_str *pic_str_cat(pic_state *, pic_str *, pic_str *);
pic_str *pic_str_sub(pic_state *, pic_str *, int, int);
int pic_str_cmp(pic_state *, pic_str *, pic_str *);
int pic_str_hash(pic_state *, pic_str *);
const char *pic_str_cstr(pic_state *, pic_str *);
pic_str *pic_format(pic_state *, const char *, ...);
pic_str *pic_vformat(pic_state *, const char *, va_list);
void pic_vfformat(pic_state *, xFILE *, const char *, va_list);
pic_value pic_xformat(pic_state *, const char *, ...);
pic_value pic_xvformat(pic_state *, const char *, va_list);
pic_value pic_xvfformat(pic_state *, xFILE *, const char *, va_list);
#if defined(__cplusplus)
}

2
extlib/benz/include/picrin/symbol.h
View File

@ -13,7 +13,7 @@ struct pic_id {
union {
struct pic_symbol {
PIC_OBJECT_HEADER
const char *cstr;
pic_str *str;
} sym;
struct {
PIC_OBJECT_HEADER

3
extlib/benz/include/picrin/type.h
View File

@ -156,7 +156,6 @@ enum pic_tt {
PIC_TT_DICT,
PIC_TT_REG,
PIC_TT_RECORD,
PIC_TT_BOX,
PIC_TT_CXT,
PIC_TT_CP
};
@ -311,8 +310,6 @@ pic_type_repr(enum pic_tt tt)
return "dict";
case PIC_TT_REG:
return "reg";
case PIC_TT_BOX:
return "box";
case PIC_TT_RECORD:
return "record";
case PIC_TT_CP:

39
extlib/benz/proc.c
View File

@ -175,35 +175,24 @@ pic_get_args(pic_state *pic, const char *format, ...)
return argc;
}
struct pic_box *
pic_vm_gref_slot(pic_state *pic, pic_sym *uid) /* TODO: make this static */
{
struct pic_box *box;
if (pic_reg_has(pic, pic->globals, uid)) {
return pic_box_ptr(pic_reg_ref(pic, pic->globals, uid));
}
box = pic_box(pic, pic_invalid_value());
pic_reg_set(pic, pic->globals, uid, pic_obj_value(box));
return box;
}
static pic_value
vm_gref(pic_state *pic, struct pic_box *slot, pic_sym *uid)
vm_gref(pic_state *pic, pic_sym *uid)
{
if (pic_invalid_p(slot->value)) {
if (uid == NULL) {
uid = pic_reg_rev_ref(pic, pic->globals, pic_obj_value(slot));
}
if (! pic_reg_has(pic, pic->globals, uid)) {
pic_reg_set(pic, pic->globals, uid, pic_invalid_value());
pic_errorf(pic, "uninitialized global variable: %s", pic_symbol_name(pic, uid));
return pic_invalid_value();
}
return slot->value;
return pic_reg_ref(pic, pic->globals, uid);
}
static void
vm_gset(struct pic_box *slot, pic_value value)
vm_gset(pic_state *pic, pic_sym *uid, pic_value value)
{
slot->value = value;
pic_reg_set(pic, pic->globals, uid, value);
}
static void
@ -423,11 +412,11 @@ pic_apply(pic_state *pic, struct pic_proc *proc, int argc, pic_value *argv)
NEXT;
}
CASE(OP_GREF) {
PUSH(vm_gref(pic, (struct pic_box *)(pic->ci->irep->pool[c.a]), NULL)); /* FIXME */
PUSH(vm_gref(pic, (pic_sym *)pic->ci->irep->pool[c.a]));
NEXT;
}
CASE(OP_GSET) {
vm_gset((struct pic_box *)(pic->ci->irep->pool[c.a]), POP());
vm_gset(pic, (pic_sym *)pic->ci->irep->pool[c.a], POP());
PUSH(pic_undef_value());
NEXT;
}
@ -972,7 +961,7 @@ pic_ref(pic_state *pic, struct pic_lib *lib, const char *name)
pic_errorf(pic, "symbol \"%s\" not defined in library ~s", name, lib->name);
}
return vm_gref(pic, pic_vm_gref_slot(pic, uid), uid);
return vm_gref(pic, uid);
}
void
@ -986,7 +975,7 @@ pic_set(pic_state *pic, struct pic_lib *lib, const char *name, pic_value val)
pic_errorf(pic, "symbol \"%s\" not defined in library ~s", name, lib->name);
}
vm_gset(pic_vm_gref_slot(pic, uid), val);
vm_gset(pic, uid, val);
}
static struct pic_proc *

103
extlib/benz/string.c
View File

@ -26,8 +26,6 @@ struct pic_rope {
#define CHUNK_DECREF(c) do { \
struct pic_chunk *c_ = (c); \
if (! --c_->refcnt) { \
if (c_->str != c_->buf) \
pic_free(pic, c_->str); \
pic_free(pic, c_); \
} \
} while (0)
@ -56,7 +54,7 @@ pic_make_chunk(pic_state *pic, const char *str, size_t len)
{
struct pic_chunk *c;
c = pic_malloc(pic, sizeof(struct pic_chunk) + len);
c = pic_malloc(pic, offsetof(struct pic_chunk, buf) + len + 1);
c->refcnt = 1;
c->str = c->buf;
c->len = len;
@ -66,6 +64,19 @@ pic_make_chunk(pic_state *pic, const char *str, size_t len)
return c;
}
static struct pic_chunk *
pic_make_chunk_lit(pic_state *pic, const char *str, size_t len)
{
struct pic_chunk *c;
c = pic_malloc(pic, sizeof(struct pic_chunk));
c->refcnt = 1;
c->str = (char *)str;
c->len = len;
return c;
}
static struct pic_rope *
pic_make_rope(pic_state *pic, struct pic_chunk *c)
{
@ -213,7 +224,7 @@ rope_cstr(pic_state *pic, struct pic_rope *x)
return x->chunk->str; /* reuse cached chunk */
}
c = pic_malloc(pic, sizeof(struct pic_chunk) + x->weight);
c = pic_malloc(pic, offsetof(struct pic_chunk, buf) + x->weight + 1);
c->refcnt = 1;
c->len = x->weight;
c->str = c->buf;
@ -228,16 +239,17 @@ rope_cstr(pic_state *pic, struct pic_rope *x)
pic_str *
pic_make_str(pic_state *pic, const char *str, int len)
{
if (str == NULL && len > 0) {
pic_errorf(pic, "zero length specified against NULL ptr");
}
return pic_make_string(pic, pic_make_rope(pic, pic_make_chunk(pic, str, len)));
}
struct pic_chunk *c;
pic_str *
pic_make_str_cstr(pic_state *pic, const char *cstr)
{
return pic_make_str(pic, cstr, strlen(cstr));
if (len > 0) {
c = pic_make_chunk(pic, str, len);
} else {
if (len == 0) {
str = "";
}
c = pic_make_chunk_lit(pic, str, -len);
}
return pic_make_string(pic, pic_make_rope(pic, c));
}
int
@ -276,19 +288,31 @@ pic_str_cmp(pic_state *pic, pic_str *str1, pic_str *str2)
return strcmp(pic_str_cstr(pic, str1), pic_str_cstr(pic, str2));
}
int
pic_str_hash(pic_state *pic, pic_str *str)
{
const char *s;
int h = 0;
s = pic_str_cstr(pic, str);
while (*s) {
h = (h << 5) - h + *s++;
}
return h;
}
const char *
pic_str_cstr(pic_state *pic, pic_str *str)
{
return rope_cstr(pic, str->rope);
}
pic_value
pic_xvfformat(pic_state *pic, xFILE *file, const char *fmt, va_list ap)
static void
pic_vfformat(pic_state *pic, xFILE *file, const char *fmt, va_list ap)
{
char c;
pic_value irrs = pic_nil_value();
while ((c = *fmt++)) {
while ((c = *fmt++) != '\0') {
switch (c) {
default:
xfputc(pic, c, file);
@ -336,52 +360,17 @@ pic_xvfformat(pic_state *pic, xFILE *file, const char *fmt, va_list ap)
xfputc(pic, '\n', file);
break;
case 'a':
irrs = pic_cons(pic, pic_fdisplay(pic, va_arg(ap, pic_value), file), irrs);
pic_fdisplay(pic, va_arg(ap, pic_value), file);
break;
case 's':
irrs = pic_cons(pic, pic_fwrite(pic, va_arg(ap, pic_value), file), irrs);
pic_fwrite(pic, va_arg(ap, pic_value), file);
break;
}
break;
}
}
exit:
return pic_reverse(pic, irrs);
}
pic_value
pic_xvformat(pic_state *pic, const char *fmt, va_list ap)
{
struct pic_port *port;
pic_value irrs;
port = pic_open_output_string(pic);
irrs = pic_xvfformat(pic, port->file, fmt, ap);
irrs = pic_cons(pic, pic_obj_value(pic_get_output_string(pic, port)), irrs);
pic_close_port(pic, port);
return irrs;
}
pic_value
pic_xformat(pic_state *pic, const char *fmt, ...)
{
va_list ap;
pic_value objs;
va_start(ap, fmt);
objs = pic_xvformat(pic, fmt, ap);
va_end(ap);
return objs;
}
void
pic_vfformat(pic_state *pic, xFILE *file, const char *fmt, va_list ap)
{
pic_xvfformat(pic, file, fmt, ap);
return;
}
pic_str *
@ -547,7 +536,7 @@ pic_str_string_append(pic_state *pic)
pic_get_args(pic, "*", &argc, &argv);
str = pic_make_str(pic, NULL, 0);
str = pic_make_lit(pic, "");
for (i = 0; i < argc; ++i) {
if (! pic_str_p(argv[i])) {
pic_errorf(pic, "type error");
@ -651,7 +640,7 @@ pic_str_list_to_string(pic_state *pic)
pic_get_args(pic, "o", &list);
if (pic_length(pic, list) == 0) {
return pic_obj_value(pic_make_str(pic, NULL, 0));
return pic_obj_value(pic_make_lit(pic, ""));
}
buf = pic_malloc(pic, pic_length(pic, list));

34
extlib/benz/symbol.c
View File

@ -4,43 +4,39 @@
#include "picrin.h"
KHASH_DEFINE(s, const char *, pic_sym *, kh_str_hash_func, kh_str_hash_equal)
#define kh_pic_str_hash(a) (pic_str_hash(pic, (a)))
#define kh_pic_str_cmp(a, b) (pic_str_cmp(pic, (a), (b)) == 0)
KHASH_DEFINE(s, pic_str *, pic_sym *, kh_pic_str_hash, kh_pic_str_cmp)
pic_sym *
pic_intern_str(pic_state *pic, pic_str *str)
{
return pic_intern(pic, pic_str_cstr(pic, str));
}
pic_sym *
pic_intern(pic_state *pic, const char *cstr)
{
khash_t(s) *h = &pic->syms;
pic_sym *sym;
khiter_t it;
int ret;
char *copy;
it = kh_put(s, h, cstr, &ret);
it = kh_put(s, h, str, &ret);
if (ret == 0) { /* if exists */
sym = kh_val(h, it);
pic_gc_protect(pic, pic_obj_value(sym));
return sym;
}
copy = pic_malloc(pic, strlen(cstr) + 1);
strcpy(copy, cstr);
kh_key(h, it) = copy;
kh_val(h, it) = pic->sQUOTE; /* insert dummy */
sym = (pic_sym *)pic_obj_alloc(pic, sizeof(pic_sym), PIC_TT_SYMBOL);
sym->cstr = copy;
sym->str = str;
kh_val(h, it) = sym;
return sym;
}
pic_sym *
pic_intern(pic_state *pic, const char *cstr)
{
return pic_intern_str(pic, pic_make_cstr(pic, cstr));
}
pic_id *
pic_make_identifier(pic_state *pic, pic_id *id, struct pic_env *env)
{
@ -53,9 +49,9 @@ pic_make_identifier(pic_state *pic, pic_id *id, struct pic_env *env)
}
const char *
pic_symbol_name(pic_state PIC_UNUSED(*pic), pic_sym *sym)
pic_symbol_name(pic_state *pic, pic_sym *sym)
{
return sym->cstr;
return pic_str_cstr(pic, sym->str);
}
const char *
@ -104,7 +100,7 @@ pic_symbol_symbol_to_string(pic_state *pic)
pic_get_args(pic, "m", &sym);
return pic_obj_value(pic_make_str_cstr(pic, sym->cstr));
return pic_obj_value(sym->str);
}
static pic_value

2
extlib/benz/write.c
View File

@ -437,7 +437,7 @@ pic_printf(pic_state *pic, const char *fmt, ...)
va_start(ap, fmt);
str = pic_str_ptr(pic_car(pic, pic_xvformat(pic, fmt, ap)));
str = pic_vformat(pic, fmt, ap);
va_end(ap);