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

struct pic_vector * -> pic_value

This commit is contained in:
Yuichi Nishiwaki 2016-02-19 21:56:45 +09:00
parent 9f53b39a04
commit 25e19d4f00
9 changed files with 214 additions and 171 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

13
extlib/benz/bool.c
View File

@ -158,17 +158,16 @@ internal_equal_p(pic_state *pic, pic_value x, pic_value y, int depth, khash_t(m)
goto LOOP; /* tail-call optimization */
}
case PIC_TYPE_VECTOR: {
int i;
struct pic_vector *u, *v;
int i, xlen, ylen;
u = pic_vec_ptr(x);
v = pic_vec_ptr(y);
xlen = pic_vec_len(pic, x);
ylen = pic_vec_len(pic, y);
if (u->len != v->len) {
if (xlen != ylen) {
return false;
}
for (i = 0; i < u->len; ++i) {
if (! internal_equal_p(pic, u->data[i], v->data[i], depth + 1, h))
for (i = 0; i < xlen; ++i) {
if (! internal_equal_p(pic, pic_vec_ref(pic, x, i), pic_vec_ref(pic, y, i), depth + 1, h))
return false;
}
return true;

71
extlib/benz/eval.c
View File

@ -217,7 +217,7 @@ analyze_lambda(pic_state *pic, analyze_scope *up, pic_value form)
analyze_scope s, *scope = &s;
pic_value formals, body;
pic_value rest = pic_undef_value(pic);
pic_vec *args, *locals, *captures;
pic_value args, locals, captures;
int i, j;
khiter_t it;
@ -232,7 +232,7 @@ analyze_lambda(pic_state *pic, analyze_scope *up, pic_value form)
args = pic_make_vec(pic, kh_size(&scope->args), NULL);
for (i = 0; pic_pair_p(pic, formals); formals = pic_cdr(pic, formals), i++) {
args->data[i] = pic_car(pic, formals);
pic_vec_set(pic, args, i, pic_car(pic, formals));
}
if (scope->rest != NULL) {
@ -242,26 +242,26 @@ analyze_lambda(pic_state *pic, analyze_scope *up, pic_value form)
locals = pic_make_vec(pic, kh_size(&scope->locals), NULL);
j = 0;
if (scope->rest != NULL) {
locals->data[j++] = pic_obj_value(scope->rest);
pic_vec_set(pic, locals, j++, pic_obj_value(scope->rest));
}
for (it = kh_begin(&scope->locals); it < kh_end(&scope->locals); ++it) {
if (kh_exist(&scope->locals, it)) {
if (scope->rest != NULL && kh_key(&scope->locals, it) == scope->rest)
continue;
locals->data[j++] = pic_obj_value(kh_key(&scope->locals, it));
pic_vec_set(pic, locals, j++, pic_obj_value(kh_key(&scope->locals, it)));
}
}
captures = pic_make_vec(pic, kh_size(&scope->captures), NULL);
for (it = kh_begin(&scope->captures), j = 0; it < kh_end(&scope->captures); ++it) {
if (kh_exist(&scope->captures, it)) {
captures->data[j++] = pic_obj_value(kh_key(&scope->captures, it));
pic_vec_set(pic, captures, j++, pic_obj_value(kh_key(&scope->captures, it)));
}
}
analyzer_scope_destroy(pic, scope);
return pic_list(pic, 6, pic_obj_value(pic->sLAMBDA), rest, pic_obj_value(args), pic_obj_value(locals), pic_obj_value(captures), body);
return pic_list(pic, 6, pic_obj_value(pic->sLAMBDA), rest, args, locals, captures, body);
}
static pic_value
@ -360,7 +360,7 @@ pic_analyze(pic_state *pic, pic_value obj)
typedef struct codegen_context {
/* rest args variable is counted as a local */
pic_sym *rest;
pic_vec *args, *locals, *captures;
pic_value args, locals, captures;
/* actual bit code sequence */
pic_code *code;
size_t clen, ccapa;
@ -381,7 +381,7 @@ typedef struct codegen_context {
static void create_activation(pic_state *, codegen_context *);
static void
codegen_context_init(pic_state *pic, codegen_context *cxt, codegen_context *up, pic_sym *rest, pic_vec *args, pic_vec *locals, pic_vec *captures)
codegen_context_init(pic_state *pic, codegen_context *cxt, codegen_context *up, pic_sym *rest, pic_value args, pic_value locals, pic_value captures)
{
cxt->up = up;
cxt->rest = rest;
@ -422,9 +422,9 @@ codegen_context_destroy(pic_state *pic, codegen_context *cxt)
irep = pic_malloc(pic, sizeof(struct pic_irep));
irep->refc = 1;
irep->varg = cxt->rest != NULL;
irep->argc = (int)cxt->args->len + 1;
irep->localc = (int)cxt->locals->len;
irep->capturec = (int)cxt->captures->len;
irep->argc = pic_vec_len(pic, cxt->args) + 1;
irep->localc = pic_vec_len(pic, cxt->locals);
irep->capturec = pic_vec_len(pic, cxt->captures);
irep->code = pic_realloc(pic, cxt->code, sizeof(pic_code) * cxt->clen);
irep->irep = pic_realloc(pic, cxt->irep, sizeof(struct pic_irep *) * cxt->ilen);
irep->ints = pic_realloc(pic, cxt->ints, sizeof(int) * cxt->klen);
@ -481,7 +481,7 @@ codegen_context_destroy(pic_state *pic, codegen_context *cxt)
#define emit_ret(pic, cxt, tailpos) if (tailpos) emit_n(pic, cxt, OP_RET)
static int
index_capture(codegen_context *cxt, pic_sym *sym, int depth)
index_capture(pic_state *pic, codegen_context *cxt, pic_sym *sym, int depth)
{
int i;
@ -489,26 +489,26 @@ index_capture(codegen_context *cxt, pic_sym *sym, int depth)
cxt = cxt->up;
}
for (i = 0; i < cxt->captures->len; ++i) {
if (pic_sym_ptr(cxt->captures->data[i]) == sym)
for (i = 0; i < pic_vec_len(pic, cxt->captures); ++i) {
if (pic_sym_ptr(pic_vec_ref(pic, cxt->captures, i)) == sym)
return i;
}
return -1;
}
static int
index_local(codegen_context *cxt, pic_sym *sym)
index_local(pic_state *pic, codegen_context *cxt, pic_sym *sym)
{
int i, offset;
offset = 1;
for (i = 0; i < cxt->args->len; ++i) {
if (pic_sym_ptr(cxt->args->data[i]) == sym)
for (i = 0; i < pic_vec_len(pic, cxt->args); ++i) {
if (pic_sym_ptr(pic_vec_ref(pic, cxt->args, i)) == sym)
return i + offset;
}
offset += i;
for (i = 0; i < cxt->locals->len; ++i) {
if (pic_sym_ptr(cxt->locals->data[i]) == sym)
for (i = 0; i < pic_vec_len(pic, cxt->locals); ++i) {
if (pic_sym_ptr(pic_vec_ref(pic, cxt->locals, i)) == sym)
return i + offset;
}
return -1;
@ -531,10 +531,11 @@ create_activation(pic_state *pic, codegen_context *cxt)
{
int i, n;
for (i = 0; i < cxt->captures->len; ++i) {
n = index_local(cxt, pic_sym_ptr(cxt->captures->data[i]));
for (i = 0; i < pic_vec_len(pic, cxt->captures); ++i) {
pic_sym *sym = pic_sym_ptr(pic_vec_ref(pic, cxt->captures, i));
n = index_local(pic, cxt, sym);
assert(n != -1);
if (n <= cxt->args->len || cxt->rest == pic_sym_ptr(cxt->captures->data[i])) {
if (n <= pic_vec_len(pic, cxt->args) || cxt->rest == sym) {
/* copy arguments to capture variable area */
emit_i(pic, cxt, OP_LREF, n);
} else {
@ -565,7 +566,7 @@ codegen_ref(pic_state *pic, codegen_context *cxt, pic_value obj, bool tailpos)
depth = pic_int(pic, pic_list_ref(pic, obj, 1));
name = pic_sym_ptr(pic_list_ref(pic, obj, 2));
emit_r(pic, cxt, OP_CREF, depth, index_capture(cxt, name, depth));
emit_r(pic, cxt, OP_CREF, depth, index_capture(pic, cxt, name, depth));
emit_ret(pic, cxt, tailpos);
}
else if (sym == LREF) {
@ -573,11 +574,11 @@ codegen_ref(pic_state *pic, codegen_context *cxt, pic_value obj, bool tailpos)
int i;
name = pic_sym_ptr(pic_list_ref(pic, obj, 1));
if ((i = index_capture(cxt, name, 0)) != -1) {
emit_i(pic, cxt, OP_LREF, i + (int)cxt->args->len + (int)cxt->locals->len + 1);
if ((i = index_capture(pic, cxt, name, 0)) != -1) {
emit_i(pic, cxt, OP_LREF, i + pic_vec_len(pic, cxt->args) + pic_vec_len(pic, cxt->locals) + 1);
emit_ret(pic, cxt, tailpos);
} else {
emit_i(pic, cxt, OP_LREF, index_local(cxt, name));
emit_i(pic, cxt, OP_LREF, index_local(pic, cxt, name));
emit_ret(pic, cxt, tailpos);
}
}
@ -607,7 +608,7 @@ codegen_set(pic_state *pic, codegen_context *cxt, pic_value obj, bool tailpos)
depth = pic_int(pic, pic_list_ref(pic, var, 1));
name = pic_sym_ptr(pic_list_ref(pic, var, 2));
emit_r(pic, cxt, OP_CSET, depth, index_capture(cxt, name, depth));
emit_r(pic, cxt, OP_CSET, depth, index_capture(pic, cxt, name, depth));
emit_ret(pic, cxt, tailpos);
}
else if (type == LREF) {
@ -615,11 +616,11 @@ codegen_set(pic_state *pic, codegen_context *cxt, pic_value obj, bool tailpos)
int i;
name = pic_sym_ptr(pic_list_ref(pic, var, 1));
if ((i = index_capture(cxt, name, 0)) != -1) {
emit_i(pic, cxt, OP_LSET, i + (int)cxt->args->len + (int)cxt->locals->len + 1);
if ((i = index_capture(pic, cxt, name, 0)) != -1) {
emit_i(pic, cxt, OP_LSET, i + pic_vec_len(pic, cxt->args) + pic_vec_len(pic, cxt->locals) + 1);
emit_ret(pic, cxt, tailpos);
} else {
emit_i(pic, cxt, OP_LSET, index_local(cxt, name));
emit_i(pic, cxt, OP_LSET, index_local(pic, cxt, name));
emit_ret(pic, cxt, tailpos);
}
}
@ -631,7 +632,7 @@ codegen_lambda(pic_state *pic, codegen_context *cxt, pic_value obj, bool tailpos
codegen_context c, *inner_cxt = &c;
pic_value rest_opt, body;
pic_sym *rest = NULL;
pic_vec *args, *locals, *captures;
pic_value args, locals, captures;
check_irep_size(pic, cxt);
@ -640,9 +641,9 @@ codegen_lambda(pic_state *pic, codegen_context *cxt, pic_value obj, bool tailpos
if (pic_sym_p(pic, rest_opt)) {
rest = pic_sym_ptr(rest_opt);
}
args = pic_vec_ptr(pic_list_ref(pic, obj, 2));
locals = pic_vec_ptr(pic_list_ref(pic, obj, 3));
captures = pic_vec_ptr(pic_list_ref(pic, obj, 4));
args = pic_list_ref(pic, obj, 2);
locals = pic_list_ref(pic, obj, 3);
captures = pic_list_ref(pic, obj, 4);
body = pic_list_ref(pic, obj, 5);
/* emit irep */
@ -818,7 +819,7 @@ codegen(pic_state *pic, codegen_context *cxt, pic_value obj, bool tailpos)
static struct pic_irep *
pic_codegen(pic_state *pic, pic_value obj)
{
pic_vec *empty = pic_make_vec(pic, 0, NULL);
pic_value empty = pic_make_vec(pic, 0, NULL);
codegen_context c, *cxt = &c;
codegen_context_init(pic, cxt, NULL, NULL, empty, empty, empty);

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

@ -55,7 +55,6 @@ struct pic_object;
struct pic_symbol;
struct pic_pair;
struct pic_string;
struct pic_vector;
struct pic_blob;
struct pic_proc;
struct pic_port;
@ -66,7 +65,6 @@ struct pic_data;
typedef struct pic_symbol pic_sym;
typedef struct pic_id pic_id;
typedef struct pic_pair pic_pair;
typedef struct pic_vector pic_vec;
typedef void *(*pic_allocf)(void *userdata, void *ptr, size_t n);
@ -235,10 +233,10 @@ pic_value pic_reverse(pic_state *, pic_value list);
pic_value pic_append(pic_state *, pic_value xs, pic_value ys);
/* vector */
pic_vec *pic_make_vec(pic_state *, int, pic_value *);
pic_value pic_vec_ref(pic_state *, pic_vec *, int);
void pic_vec_set(pic_state *, pic_vec *, int, pic_value);
int pic_vec_len(pic_state *, pic_vec *);
pic_value pic_make_vec(pic_state *, int n, pic_value *argv);
pic_value pic_vec_ref(pic_state *, pic_value vec, int i);
void pic_vec_set(pic_state *, pic_value vec, int i, pic_value v);
int pic_vec_len(pic_state *, pic_value vec);
/* dictionary */
pic_value pic_make_dict(pic_state *);

18
extlib/benz/include/picrin/compat.h
View File

@ -203,6 +203,24 @@ memcpy(void *dst, const void *src, size_t n)
return d;
}
PIC_INLINE void *
memmove(void *dst, const void *src, size_t n)
{
const char *s = src;
char *d = dst;
if (d <= s || d >= s + n) {
memcpy(dst, src, n);
} else {
s += n;
d += n;
while (n-- > 0) {
*--d = *--s;
}
}
return d;
}
PIC_INLINE char *
strcpy(char *dst, const char *src)
{

15
extlib/benz/include/picrin/object.h
View File

@ -120,13 +120,13 @@ struct pic_port {
xFILE *file;
};
#define pic_vec_ptr(pic, o) ((struct pic_vector *)pic_obj_ptr(o))
#define pic_dict_ptr(pic, v) ((struct pic_dict *)pic_obj_ptr(v))
#define pic_sym_ptr(v) ((pic_sym *)pic_obj_ptr(v))
#define pic_id_ptr(v) ((pic_id *)pic_obj_ptr(v))
#define pic_pair_ptr(o) ((struct pic_pair *)pic_obj_ptr(o))
#define pic_blob_ptr(v) ((struct pic_blob *)pic_obj_ptr(v))
#define pic_str_ptr(o) ((struct pic_string *)pic_obj_ptr(o))
#define pic_vec_ptr(o) ((struct pic_vector *)pic_obj_ptr(o))
#define pic_weak_ptr(v) ((struct pic_weak *)pic_obj_ptr(v))
#define pic_data_ptr(o) ((struct pic_data *)pic_obj_ptr(o))
#define pic_context_ptr(o) ((struct pic_context *)pic_obj_ptr(o))
@ -143,6 +143,19 @@ struct pic_port {
struct pic_object *pic_obj_alloc(pic_state *, size_t, int type);
#define VALID_INDEX(pic, len, i) do { \
if (i < 0 || len <= i) pic_errorf(pic, "index out of range: %d", i); \
} while (0)
#define VALID_RANGE(pic, len, s, e) do { \
if (s < 0 || len < s) pic_errorf(pic, "invalid start index: %d", s); \
if (e < s || len < e) pic_errorf(pic, "invalid end index: %d", e); \
} while (0)
#define VALID_ATRANGE(pic, tolen, at, fromlen, s, e) do { \
VALID_INDEX(pic, tolen, at); \
VALID_RANGE(pic, fromlen, s, e); \
if (tolen - at < e - s) pic_errorf(pic, "invalid range"); \
} while (0)
pic_id *pic_make_identifier(pic_state *, pic_id *, struct pic_env *);
struct pic_proc *pic_make_proc(pic_state *, pic_func_t, int, pic_value *);
struct pic_proc *pic_make_proc_irep(pic_state *, struct pic_irep *, struct pic_context *);

4
extlib/benz/proc.c
View File

@ -21,7 +21,7 @@
* c char * char
* z char ** c string
* m pic_sym ** symbol
* v pic_vec ** vector object
* v pic_value * vector object
* s struct pic_str ** string object
* b struct pic_blob ** bytevector object
* l struct pic_proc ** lambda object
@ -148,7 +148,6 @@ pic_get_args(pic_state *pic, const char *format, ...)
VAL_CASE(c, type, ctype, pic_## type ##_ptr(v))
PTR_CASE('m', sym, pic_sym *)
PTR_CASE('v', vec, pic_vec *)
PTR_CASE('s', str, struct pic_string *)
PTR_CASE('b', blob, struct pic_blob *)
PTR_CASE('l', proc, struct pic_proc *)
@ -158,6 +157,7 @@ pic_get_args(pic_state *pic, const char *format, ...)
#define OBJ_CASE(c, type) VAL_CASE(c, type, pic_value, v)
OBJ_CASE('v', vec)
OBJ_CASE('d', dict)
default:

17
extlib/benz/read.c
View File

@ -590,8 +590,7 @@ read_pair(pic_state *pic, xFILE *file, int c)
static pic_value
read_vector(pic_state *pic, xFILE *file, int c)
{
pic_value list, it, elem;
pic_vec *vec;
pic_value list, it, elem, vec;
int i = 0;
list = read(pic, file, c);
@ -599,10 +598,10 @@ read_vector(pic_state *pic, xFILE *file, int c)
vec = pic_make_vec(pic, pic_length(pic, list), NULL);
pic_for_each (elem, list, it) {
vec->data[i++] = elem;
pic_vec_set(pic, vec, i++, elem);
}
return pic_obj_value(vec);
return vec;
}
static pic_value
@ -639,13 +638,13 @@ read_label_set(pic_state *pic, xFILE *file, int i)
}
if (vect) {
pic_vec *tmp;
pic_value tmp;
kh_val(h, it) = val = pic_obj_value(pic_make_vec(pic, 0, NULL));
kh_val(h, it) = val = pic_make_vec(pic, 0, NULL);
tmp = pic_vec_ptr(read(pic, file, c));
PIC_SWAP(pic_value *, tmp->data, pic_vec_ptr(val)->data);
PIC_SWAP(int, tmp->len, pic_vec_ptr(val)->len);
tmp = read(pic, file, c);
PIC_SWAP(pic_value *, pic_vec_ptr(pic, tmp)->data, pic_vec_ptr(pic, val)->data);
PIC_SWAP(int, pic_vec_ptr(pic, tmp)->len, pic_vec_ptr(pic, val)->len);
return val;
}

219
extlib/benz/vector.c
View File

@ -5,7 +5,7 @@
#include "picrin.h"
#include "picrin/object.h"
struct pic_vector *
pic_value
pic_make_vec(pic_state *pic, int len, pic_value *argv)
{
struct pic_vector *vec;
@ -21,7 +21,25 @@ pic_make_vec(pic_state *pic, int len, pic_value *argv)
} else {
memcpy(vec->data, argv, sizeof(pic_value) * len);
}
return vec;
return pic_obj_value(vec);
}
pic_value
pic_vec_ref(pic_state PIC_UNUSED(*pic), pic_value vec, int k)
{
return pic_vec_ptr(pic, vec)->data[k];
}
void
pic_vec_set(pic_state PIC_UNUSED(*pic), pic_value vec, int k, pic_value val)
{
pic_vec_ptr(pic, vec)->data[k] = val;
}
int
pic_vec_len(pic_state PIC_UNUSED(*pic), pic_value vec)
{
return pic_vec_ptr(pic, vec)->len;
}
static pic_value
@ -39,100 +57,92 @@ pic_vec_vector(pic_state *pic)
{
int argc;
pic_value *argv;
pic_vec *vec;
pic_get_args(pic, "*", &argc, &argv);
vec = pic_make_vec(pic, argc, argv);
return pic_obj_value(vec);
return pic_make_vec(pic, argc, argv);
}
static pic_value
pic_vec_make_vector(pic_state *pic)
{
pic_value v;
pic_value vec, init;
int n, k, i;
struct pic_vector *vec;
n = pic_get_args(pic, "i|o", &k, &v);
n = pic_get_args(pic, "i|o", &k, &init);
if (k < 0) {
pic_errorf(pic, "make-vector: negative length given %d", k);
}
vec = pic_make_vec(pic, k, NULL);
if (n == 2) {
for (i = 0; i < k; ++i) {
vec->data[i] = v;
pic_vec_set(pic, vec, i, init);
}
}
return pic_obj_value(vec);
return vec;
}
static pic_value
pic_vec_vector_length(pic_state *pic)
{
struct pic_vector *v;
pic_value v;
pic_get_args(pic, "v", &v);
return pic_int_value(pic, v->len);
return pic_int_value(pic, pic_vec_len(pic, v));
}
static pic_value
pic_vec_vector_ref(pic_state *pic)
{
struct pic_vector *v;
pic_value v;
int k;
pic_get_args(pic, "vi", &v, &k);
if (v->len <= k) {
pic_errorf(pic, "vector-ref: index out of range");
}
return v->data[k];
VALID_INDEX(pic, pic_vec_len(pic, v), k);
return pic_vec_ref(pic, v, k);
}
static pic_value
pic_vec_vector_set(pic_state *pic)
{
struct pic_vector *v;
pic_value v, o;
int k;
pic_value o;
pic_get_args(pic, "vio", &v, &k, &o);
if (v->len <= k) {
pic_errorf(pic, "vector-set!: index out of range");
}
v->data[k] = o;
VALID_INDEX(pic, pic_vec_len(pic, v), k);
pic_vec_set(pic, v, k, o);
return pic_undef_value(pic);
}
static pic_value
pic_vec_vector_copy_i(pic_state *pic)
{
pic_vec *to, *from;
int n, at, start, end;
pic_value to, from;
int n, at, start, end, tolen, fromlen;
n = pic_get_args(pic, "viv|ii", &to, &at, &from, &start, &end);
tolen = pic_vec_len(pic, to);
fromlen = pic_vec_len(pic, from);
switch (n) {
case 3:
start = 0;
case 4:
end = from->len;
end = fromlen;
}
if (to == from && (start <= at && at < end)) {
/* copy in reversed order */
at += end - start;
while (start < end) {
to->data[--at] = from->data[--end];
}
return pic_undef_value(pic);
}
VALID_ATRANGE(pic, tolen, at, fromlen, start, end);
while (start < end) {
to->data[at++] = from->data[start++];
}
memmove(pic_vec_ptr(pic, to)->data + at, pic_vec_ptr(pic, from)->data + start, sizeof(pic_value) * (end - start));
return pic_undef_value(pic);
}
@ -140,73 +150,72 @@ pic_vec_vector_copy_i(pic_state *pic)
static pic_value
pic_vec_vector_copy(pic_state *pic)
{
pic_vec *from, *to;
int n, start, end;
pic_value from;
int n, start, end, fromlen;
n = pic_get_args(pic, "v|ii", &from, &start, &end);
fromlen = pic_vec_len(pic, from);
switch (n) {
case 1:
start = 0;
case 2:
end = from->len;
end = fromlen;
}
if (end < start) {
pic_errorf(pic, "vector-copy: end index must not be less than start index");
}
VALID_RANGE(pic, fromlen, start, end);
to = pic_make_vec(pic, end - start, from->data + start);
return pic_obj_value(to);
return pic_make_vec(pic, end - start, pic_vec_ptr(pic, from)->data + start);
}
static pic_value
pic_vec_vector_append(pic_state *pic)
{
pic_value *argv;
int argc, i, j, len;
pic_vec *vec;
pic_value *argv, vec;
int argc, i, len;
pic_get_args(pic, "*", &argc, &argv);
len = 0;
for (i = 0; i < argc; ++i) {
pic_assert_type(pic, argv[i], vec);
len += pic_vec_ptr(argv[i])->len;
len += pic_vec_len(pic, argv[i]);
}
vec = pic_make_vec(pic, len, NULL);
len = 0;
for (i = 0; i < argc; ++i) {
for (j = 0; j < pic_vec_ptr(argv[i])->len; ++j) {
vec->data[len + j] = pic_vec_ptr(argv[i])->data[j];
}
len += pic_vec_ptr(argv[i])->len;
int l = pic_vec_len(pic, argv[i]);
memcpy(pic_vec_ptr(pic, vec)->data + len, pic_vec_ptr(pic, argv[i])->data, sizeof(pic_value) * l);
len += l;
}
return pic_obj_value(vec);
return vec;
}
static pic_value
pic_vec_vector_fill_i(pic_state *pic)
{
pic_vec *vec;
pic_value obj;
int n, start, end;
pic_value vec, obj;
int n, start, end, len;
n = pic_get_args(pic, "vo|ii", &vec, &obj, &start, &end);
len = pic_vec_len(pic, vec);
switch (n) {
case 2:
start = 0;
case 3:
end = vec->len;
end = len;
}
VALID_RANGE(pic, len, start, end);
while (start < end) {
vec->data[start++] = obj;
pic_vec_set(pic, vec, start++, obj);
}
return pic_undef_value(pic);
@ -217,18 +226,20 @@ pic_vec_vector_map(pic_state *pic)
{
struct pic_proc *proc;
int argc, i, len, j;
pic_value *argv, vals;
pic_vec *vec;
pic_value *argv, vec, vals;
pic_get_args(pic, "l*", &proc, &argc, &argv);
if (argc == 0) {
pic_errorf(pic, "vector-map: wrong number of arguments (1 for at least 2)");
}
len = INT_MAX;
for (i = 0; i < argc; ++i) {
int l;
pic_assert_type(pic, argv[i], vec);
len = len < pic_vec_ptr(argv[i])->len
? len
: pic_vec_ptr(argv[i])->len;
l = pic_vec_len(pic, argv[i]);
len = len < l ? len : l;
}
vec = pic_make_vec(pic, len, NULL);
@ -236,12 +247,12 @@ pic_vec_vector_map(pic_state *pic)
for (i = 0; i < len; ++i) {
vals = pic_nil_value(pic);
for (j = 0; j < argc; ++j) {
pic_push(pic, pic_vec_ptr(argv[j])->data[i], vals);
pic_push(pic, pic_vec_ref(pic, argv[j], i), vals);
}
vec->data[i] = pic_funcall(pic, "picrin.base", "apply", 2, pic_obj_value(proc), vals);
pic_vec_set(pic, vec, i, pic_funcall(pic, "picrin.base", "apply", 2, pic_obj_value(proc), vals));
}
return pic_obj_value(vec);
return vec;
}
static pic_value
@ -253,19 +264,22 @@ pic_vec_vector_for_each(pic_state *pic)
pic_get_args(pic, "l*", &proc, &argc, &argv);
if (argc == 0) {
pic_errorf(pic, "vector-for-each: wrong number of arguments (1 for at least 2)");
}
len = INT_MAX;
for (i = 0; i < argc; ++i) {
int l;
pic_assert_type(pic, argv[i], vec);
len = len < pic_vec_ptr(argv[i])->len
? len
: pic_vec_ptr(argv[i])->len;
l = pic_vec_len(pic, argv[i]);
len = len < l ? len : l;
}
for (i = 0; i < len; ++i) {
vals = pic_nil_value(pic);
for (j = 0; j < argc; ++j) {
pic_push(pic, pic_vec_ptr(argv[j])->data[i], vals);
pic_push(pic, pic_vec_ref(pic, argv[j], i), vals);
}
pic_funcall(pic, "picrin.base", "apply", 2, pic_obj_value(proc), vals);
}
@ -276,41 +290,43 @@ pic_vec_vector_for_each(pic_state *pic)
static pic_value
pic_vec_list_to_vector(pic_state *pic)
{
struct pic_vector *vec;
pic_value list, e, it, *data;
pic_value list, vec, e, it;
int len, i = 0;
pic_get_args(pic, "o", &list);
vec = pic_make_vec(pic, pic_length(pic, list), NULL);
data = vec->data;
len = pic_length(pic, list);
vec = pic_make_vec(pic, len, NULL);
pic_for_each (e, list, it) {
*data++ = e;
pic_vec_set(pic, vec, i++, e);
}
return pic_obj_value(vec);
return vec;
}
static pic_value
pic_vec_vector_to_list(pic_state *pic)
{
struct pic_vector *vec;
pic_value vec;
pic_value list;
int n, start, end, i;
int n, start, end, i, len;
n = pic_get_args(pic, "v|ii", &vec, &start, &end);
len = pic_vec_len(pic, vec);
switch (n) {
case 1:
start = 0;
case 2:
end = vec->len;
end = len;
}
list = pic_nil_value(pic);
VALID_RANGE(pic, len, start, end);
list = pic_nil_value(pic);
for (i = start; i < end; ++i) {
pic_push(pic, vec->data[i], list);
pic_push(pic, pic_vec_ref(pic, vec, i), list);
}
return pic_reverse(pic, list);
}
@ -318,30 +334,31 @@ pic_vec_vector_to_list(pic_state *pic)
static pic_value
pic_vec_vector_to_string(pic_state *pic)
{
pic_vec *vec;
pic_value vec, t;
char *buf;
int n, start, end, i;
int n, start, end, i, len;
struct pic_string *str;
n = pic_get_args(pic, "v|ii", &vec, &start, &end);
len = pic_vec_len(pic, vec);
switch (n) {
case 1:
start = 0;
case 2:
end = vec->len;
end = len;
}
if (end < start) {
pic_errorf(pic, "vector->string: end index must not be less than start index");
}
VALID_RANGE(pic, len, start, end);
buf = pic_malloc(pic, end - start);
for (i = start; i < end; ++i) {
pic_assert_type(pic, vec->data[i], char);
t = pic_vec_ref(pic, vec, i);
buf[i - start] = pic_char(pic, vec->data[i]);
pic_assert_type(pic, t, char);
buf[i - start] = pic_char(pic, t);
}
str = pic_str_value(pic, buf, end - start);
@ -355,7 +372,7 @@ pic_vec_string_to_vector(pic_state *pic)
{
struct pic_string *str;
int n, start, end, i;
pic_vec *vec;
pic_value vec;
n = pic_get_args(pic, "s|ii", &str, &start, &end);
@ -366,16 +383,14 @@ pic_vec_string_to_vector(pic_state *pic)
end = pic_str_len(pic, str);
}
if (end < start) {
pic_errorf(pic, "string->vector: end index must not be less than start index");
}
VALID_RANGE(pic, pic_str_len(pic, str), start, end);
vec = pic_make_vec(pic, end - start, NULL);
for (i = 0; i < end - start; ++i) {
vec->data[i] = pic_char_value(pic, pic_str_ref(pic, str, i + start));
pic_vec_set(pic, vec, i, pic_char_value(pic, pic_str_ref(pic, str, i + start)));
}
return pic_obj_value(vec);
return vec;
}
void

18
extlib/benz/write.c
View File

@ -221,16 +221,16 @@ write_pair(struct writer_control *p, struct pic_pair *pair)
}
static void
write_vec(struct writer_control *p, pic_vec *vec)
write_vec(struct writer_control *p, pic_value vec)
{
pic_state *pic = p->pic;
xFILE *file = p->file;
int i;
int i, len = pic_vec_len(pic, vec);
xfprintf(pic, file, "#(");
for (i = 0; i < vec->len; ++i) {
write_core(p, vec->data[i]);
if (i + 1 < vec->len) {
for (i = 0; i < len; ++i) {
write_core(p, pic_vec_ref(pic, vec, i));
if (i + 1 < len) {
xfprintf(pic, file, " ");
}
}
@ -315,7 +315,7 @@ write_core(struct writer_control *p, pic_value obj)
write_pair(p, pic_pair_ptr(obj));
break;
case PIC_TYPE_VECTOR:
write_vec(p, pic_vec_ptr(obj));
write_vec(p, obj);
break;
case PIC_TYPE_DICT:
write_dict(p, obj);
@ -361,9 +361,9 @@ traverse(struct writer_control *p, pic_value obj)
traverse(p, pic_cdr(pic, obj));
} else if (pic_vec_p(pic, obj)) {
/* vector */
int i;
for (i = 0; i < pic_vec_ptr(obj)->len; ++i) {
traverse(p, pic_vec_ptr(obj)->data[i]);
int i, len = pic_vec_len(pic, obj);
for (i = 0; i < len; ++i) {
traverse(p, pic_vec_ref(pic, obj, i));
}
} else {
/* dictionary */