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

struct pic_string * -> pic_value

Browse Source
This commit is contained in:
Yuichi Nishiwaki
2016-02-20 03:26:52 +09:00
parent 5254e80932
commit 2d5fbc889e
20 changed files with 280 additions and 275 deletions
Download Patch File Download Diff File Expand all files Collapse all files
extlib/benz/blob.c
+1 -1
View File
@@ -81,7 +81,7 @@ pic_blob_make_bytevector(pic_state *pic)
blob = pic_blob_value(pic, 0, k);
memset(pic_blob(pic, blob, NULL), k, (unsigned char)b);
memset(pic_blob(pic, blob, NULL), (unsigned char)b, k);
return blob;
}
extlib/benz/bool.c
+1 -1
View File
@@ -106,7 +106,7 @@ internal_equal_p(pic_state *pic, pic_value x, pic_value y, int depth, khash_t(m)
return s1 == s2;
}
case PIC_TYPE_STRING: {
return pic_str_cmp(pic, pic_str_ptr(x), pic_str_ptr(y)) == 0;
return pic_str_cmp(pic, x, y) == 0;
}
case PIC_TYPE_BLOB: {
int xlen, ylen;
extlib/benz/debug.c
+4 -4
View File
@@ -5,12 +5,12 @@
#include "picrin.h"
#include "picrin/object.h"
struct pic_string *
pic_value
pic_get_backtrace(pic_state *pic)
{
size_t ai = pic_enter(pic);
pic_callinfo *ci;
struct pic_string *trace;
pic_value trace;
trace = pic_lit_value(pic, "");
@@ -28,7 +28,7 @@ pic_get_backtrace(pic_state *pic)
}
pic_leave(pic, ai);
pic_protect(pic, pic_obj_value(trace));
pic_protect(pic, trace);
return trace;
}
@@ -59,6 +59,6 @@ pic_print_backtrace(pic_state *pic, xFILE *file)
}
xfprintf(pic, file, "\n");
xfputs(pic, pic_str(pic, e->stack), file);
xfputs(pic, pic_str(pic, pic_obj_value(e->stack)), file);
}
}
extlib/benz/error.c
+5 -5
View File
@@ -22,7 +22,7 @@ void
pic_warnf(pic_state *pic, const char *fmt, ...)
{
va_list ap;
struct pic_string *err;
pic_value err;
va_start(ap, fmt);
err = pic_vstrf_value(pic, fmt, ap);
@@ -36,7 +36,7 @@ pic_errorf(pic_state *pic, const char *fmt, ...)
{
va_list ap;
const char *msg;
struct pic_string *err;
pic_value err;
va_start(ap, fmt);
err = pic_vstrf_value(pic, fmt, ap);
@@ -92,16 +92,16 @@ struct pic_error *
pic_make_error(pic_state *pic, const char *type, const char *msg, pic_value irrs)
{
struct pic_error *e;
struct pic_string *stack;
pic_value stack;
pic_sym *ty = pic_intern_cstr(pic, type);
stack = pic_get_backtrace(pic);
e = (struct pic_error *)pic_obj_alloc(pic, sizeof(struct pic_error), PIC_TYPE_ERROR);
e->type = ty;
e->msg = pic_cstr_value(pic, msg);
e->msg = pic_str_ptr(pic, pic_cstr_value(pic, msg));
e->irrs = irrs;
e->stack = stack;
e->stack = pic_str_ptr(pic, stack);
return e;
}
extlib/benz/include/picrin.h
+13 -14
View File
@@ -53,7 +53,6 @@ typedef struct {
struct pic_object;
struct pic_symbol;
struct pic_string;
struct pic_port;
struct pic_error;
struct pic_env;
@@ -121,7 +120,7 @@ PIC_INLINE int pic_int(pic_state *, pic_value i);
PIC_INLINE double pic_float(pic_state *, pic_value f);
PIC_INLINE char pic_char(pic_state *, pic_value c);
#define pic_bool(pic,b) (! pic_false_p(pic, b))
const char *pic_str(pic_state *, struct pic_string *);
const char *pic_str(pic_state *, pic_value str);
unsigned char *pic_blob(pic_state *, pic_value blob, int *len);
void *pic_data(pic_state *, pic_value data);
@@ -139,11 +138,11 @@ PIC_INLINE pic_value pic_true_value(pic_state *);
PIC_INLINE pic_value pic_false_value(pic_state *);
PIC_INLINE pic_value pic_bool_value(pic_state *, bool);
PIC_INLINE pic_value pic_eof_object(pic_state *);
struct pic_string *pic_str_value(pic_state *, const char *str, int len);
pic_value pic_str_value(pic_state *, const char *str, int len);
#define pic_cstr_value(pic, cstr) pic_str_value(pic, (cstr), strlen(cstr))
#define pic_lit_value(pic, lit) pic_str_value(pic, "" lit, -((int)sizeof lit - 1))
struct pic_string *pic_strf_value(pic_state *, const char *fmt, ...);
struct pic_string *pic_vstrf_value(pic_state *, const char *fmt, va_list ap);
pic_value pic_strf_value(pic_state *, const char *fmt, ...);
pic_value pic_vstrf_value(pic_state *, const char *fmt, va_list ap);
pic_value pic_blob_value(pic_state *, const unsigned char *buf, int len);
pic_value pic_data_value(pic_state *, void *ptr, const pic_data_type *type);
@@ -250,19 +249,19 @@ void pic_weak_del(pic_state *, struct pic_weak *, void *);
bool pic_weak_has(pic_state *, struct pic_weak *, void *);
/* symbol */
pic_sym *pic_intern(pic_state *, struct pic_string *);
pic_sym *pic_intern(pic_state *, pic_value str);
#define pic_intern_str(pic,s,i) pic_intern(pic, pic_str_value(pic, (s), (i)))
#define pic_intern_cstr(pic,s) pic_intern(pic, pic_cstr_value(pic, (s)))
#define pic_intern_lit(pic,lit) pic_intern(pic, pic_lit_value(pic, lit))
struct pic_string *pic_sym_name(pic_state *, pic_sym *);
pic_value pic_sym_name(pic_state *, pic_sym *);
/* string */
int pic_str_len(pic_state *, struct pic_string *);
char pic_str_ref(pic_state *, struct pic_string *, int);
struct pic_string *pic_str_cat(pic_state *, struct pic_string *, struct pic_string *);
struct pic_string *pic_str_sub(pic_state *, struct pic_string *, int, int);
int pic_str_cmp(pic_state *, struct pic_string *, struct pic_string *);
int pic_str_hash(pic_state *, struct pic_string *);
int pic_str_len(pic_state *, pic_value str);
char pic_str_ref(pic_state *, pic_value str, int i);
pic_value pic_str_cat(pic_state *, pic_value str1, pic_value str2);
pic_value pic_str_sub(pic_state *, pic_value str, int i, int j);
int pic_str_cmp(pic_state *, pic_value str1, pic_value str2);
int pic_str_hash(pic_state *, pic_value str);
/* extra stuff */
@@ -348,7 +347,7 @@ bool pic_data_type_p(pic_state *, pic_value, const pic_data_type *);
#define pic_pop(pic, place) (place = pic_cdr(pic, place))
void pic_warnf(pic_state *, const char *, ...);
struct pic_string *pic_get_backtrace(pic_state *);
pic_value pic_get_backtrace(pic_state *);
void pic_print_backtrace(pic_state *, xFILE *);
#define pic_stdin(pic) pic_port_ptr(pic_funcall(pic, "picrin.base", "current-input-port", 0))
extlib/benz/include/picrin/object.h
+3 -3
View File
@@ -120,15 +120,15 @@ struct pic_port {
xFILE *file;
};
#define pic_str_ptr(pic, o) ((struct pic_string *)pic_obj_ptr(o))
#define pic_blob_ptr(pic, o) ((struct pic_blob *)pic_obj_ptr(o))
#define pic_pair_ptr(pic, o) ((struct pic_pair *)pic_obj_ptr(o))
#define pic_blob_ptr(pic, v) ((struct pic_blob *)pic_obj_ptr(v))
#define pic_vec_ptr(pic, o) ((struct pic_vector *)pic_obj_ptr(o))
#define pic_dict_ptr(pic, o) ((struct pic_dict *)pic_obj_ptr(o))
#define pic_data_ptr(pic, o) ((struct pic_data *)pic_obj_ptr(o))
#define pic_proc_ptr(pic, o) ((struct pic_proc *)pic_obj_ptr(o))
#define pic_sym_ptr(v) ((pic_sym *)pic_obj_ptr(v))
#define pic_id_ptr(v) ((pic_id *)pic_obj_ptr(v))
#define pic_str_ptr(o) ((struct pic_string *)pic_obj_ptr(o))
#define pic_weak_ptr(v) ((struct pic_weak *)pic_obj_ptr(v))
#define pic_context_ptr(o) ((struct pic_context *)pic_obj_ptr(o))
#define pic_rec_ptr(v) ((struct pic_record *)pic_obj_ptr(v))
@@ -166,7 +166,7 @@ struct pic_env *pic_make_env(pic_state *, struct pic_env *);
pic_sym *pic_add_identifier(pic_state *, pic_id *, struct pic_env *);
pic_sym *pic_put_identifier(pic_state *, pic_id *, pic_sym *, struct pic_env *);
pic_sym *pic_find_identifier(pic_state *, pic_id *, struct pic_env *);
struct pic_string *pic_id_name(pic_state *, pic_id *);
pic_value pic_id_name(pic_state *, pic_id *);
void pic_rope_incref(pic_state *, struct pic_rope *);
void pic_rope_decref(pic_state *, struct pic_rope *);
extlib/benz/lib.c
+5 -6
View File
@@ -32,13 +32,13 @@ get_library(pic_state *pic, const char *lib)
}
static struct pic_env *
make_library_env(pic_state *pic, struct pic_string *name)
make_library_env(pic_state *pic, pic_value name)
{
struct pic_env *env;
env = (struct pic_env *)pic_obj_alloc(pic, sizeof(struct pic_env), PIC_TYPE_ENV);
env->up = NULL;
env->lib = name;
env->lib = pic_str_ptr(pic, name);
kh_init(env, &env->map);
/* set up default environment */
@@ -55,9 +55,8 @@ pic_make_library(pic_state *pic, const char *lib)
{
khash_t(ltable) *h = &pic->ltable;
const char *old_lib;
struct pic_string *name;
struct pic_env *env;
pic_value exports;
pic_value name, exports;
khiter_t it;
int ret;
@@ -74,7 +73,7 @@ pic_make_library(pic_state *pic, const char *lib)
pic_errorf(pic, "library name already in use: %s", lib);
}
kh_val(h, it).name = name;
kh_val(h, it).name = pic_str_ptr(pic, name);
kh_val(h, it).env = env;
kh_val(h, it).exports = pic_dict_ptr(pic, exports);
@@ -98,7 +97,7 @@ pic_find_library(pic_state *pic, const char *lib)
const char *
pic_current_library(pic_state *pic)
{
return pic_str(pic, pic->lib->name);
return pic_str(pic, pic_obj_value(pic->lib->name));
}
struct pic_env *
extlib/benz/macro.c
+2 -2
View File
@@ -26,12 +26,12 @@ pic_add_identifier(pic_state *pic, pic_id *id, struct pic_env *env)
{
const char *name;
pic_sym *uid;
struct pic_string *str;
pic_value str;
name = pic_str(pic, pic_id_name(pic, id));
if (env->up == NULL && pic_sym_p(pic, pic_obj_value(id))) { /* toplevel & public */
str = pic_strf_value(pic, "%s/%s", pic_str(pic, env->lib), name);
str = pic_strf_value(pic, "%s/%s", pic_str(pic, pic_obj_value(env->lib)), name);
} else {
str = pic_strf_value(pic, ".%s.%d", name, pic->ucnt++);
}
extlib/benz/number.c
+4 -7
View File
@@ -218,7 +218,7 @@ pic_number_number_to_string(pic_state *pic)
double f;
bool e;
int radix = 10;
struct pic_string *str;
pic_value str;
pic_get_args(pic, "F|i", &f, &e, &radix);
@@ -229,14 +229,11 @@ pic_number_number_to_string(pic_state *pic)
if (e) {
int ival = (int) f;
int ilen = number_string_length(ival, radix);
int s = ilen + 1;
char *buf = pic_malloc(pic, s);
char *buf = pic_alloca(pic, ilen + 1);
number_string(ival, radix, ilen, buf);
str = pic_str_value(pic, buf, s - 1);
pic_free(pic, buf);
str = pic_str_value(pic, buf, ilen);
}
else {
xFILE *file = xfopen_buf(pic, NULL, 0, "w");
@@ -249,7 +246,7 @@ pic_number_number_to_string(pic_state *pic)
xfclose(pic, file);
}
return pic_obj_value(str);
return str;
}
static pic_value
extlib/benz/proc.c
+3 -3
View File
@@ -22,7 +22,7 @@
* z char ** c string
* m pic_sym ** symbol
* v pic_value * vector object
* s struct pic_str ** string object
* s pic_value * string object
* b pic_value * bytevector object
* l pic_value * lambda object
* p struct pic_port ** port object
@@ -142,19 +142,19 @@ pic_get_args(pic_state *pic, const char *format, ...)
}
VAL_CASE('c', char, char, pic_char(pic, v))
VAL_CASE('z', str, const char *, pic_str(pic, pic_str_ptr(v)))
VAL_CASE('z', str, const char *, pic_str(pic, v))
#define PTR_CASE(c, type, ctype) \
VAL_CASE(c, type, ctype, pic_## type ##_ptr(v))
PTR_CASE('m', sym, pic_sym *)
PTR_CASE('s', str, struct pic_string *)
PTR_CASE('p', port, struct pic_port *)
PTR_CASE('e', error, struct pic_error *)
PTR_CASE('r', rec, struct pic_record *)
#define OBJ_CASE(c, type) VAL_CASE(c, type, pic_value, v)
OBJ_CASE('s', str)
OBJ_CASE('l', proc)
OBJ_CASE('b', blob)
OBJ_CASE('v', vec)
extlib/benz/read.c
+3 -4
View File
@@ -281,8 +281,7 @@ read_unsigned(pic_state *pic, xFILE *file, int c)
}
}
if (idx >= ATOF_BUF_SIZE)
read_error(pic, "number too large",
pic_obj_value(pic_str_value(pic, (const char *)buf, ATOF_BUF_SIZE)));
read_error(pic, "number too large", pic_list(pic, 1, pic_str_value(pic, (const char *)buf, ATOF_BUF_SIZE)));
if (! isdelim(c))
read_error(pic, "non-delimiter character given after number", pic_list(pic, 1, pic_char_value(pic, c)));
@@ -419,7 +418,7 @@ read_string(pic_state *pic, xFILE *file, int c)
{
char *buf;
int size, cnt;
struct pic_string *str;
pic_value str;
size = 256;
buf = pic_malloc(pic, size);
@@ -446,7 +445,7 @@ read_string(pic_state *pic, xFILE *file, int c)
str = pic_str_value(pic, buf, cnt);
pic_free(pic, buf);
return pic_obj_value(str);
return str;
}
static pic_value
extlib/benz/string.c
+107 -135
View File
@@ -94,14 +94,15 @@ pic_make_rope(pic_state *pic, struct pic_chunk *c)
return x;
}
static struct pic_string *
pic_str_valueing(pic_state *pic, struct pic_rope *rope)
static pic_value
pic_make_str(pic_state *pic, struct pic_rope *rope)
{
struct pic_string *str;
str = (struct pic_string *)pic_obj_alloc(pic, sizeof(struct pic_string), PIC_TYPE_STRING);
str->rope = rope; /* delegate ownership */
return str;
return pic_obj_value(str);
}
static size_t
@@ -237,7 +238,7 @@ rope_cstr(pic_state *pic, struct pic_rope *x)
return c->str;
}
struct pic_string *
pic_value
pic_str_value(pic_state *pic, const char *str, int len)
{
struct pic_chunk *c;
@@ -250,47 +251,47 @@ pic_str_value(pic_state *pic, const char *str, int len)
}
c = pic_make_chunk_lit(pic, str, -len);
}
return pic_str_valueing(pic, pic_make_rope(pic, c));
return pic_make_str(pic, pic_make_rope(pic, c));
}
int
pic_str_len(pic_state PIC_UNUSED(*pic), struct pic_string *str)
pic_str_len(pic_state PIC_UNUSED(*pic), pic_value str)
{
return rope_len(str->rope);
return rope_len(pic_str_ptr(pic, str)->rope);
}
char
pic_str_ref(pic_state *pic, struct pic_string *str, int i)
pic_str_ref(pic_state *pic, pic_value str, int i)
{
int c;
c = rope_at(str->rope, i);
c = rope_at(pic_str_ptr(pic, str)->rope, i);
if (c == -1) {
pic_errorf(pic, "index out of range %d", i);
}
return (char)c;
}
struct pic_string *
pic_str_cat(pic_state *pic, struct pic_string *a, struct pic_string *b)
pic_value
pic_str_cat(pic_state *pic, pic_value a, pic_value b)
{
return pic_str_valueing(pic, rope_cat(pic, a->rope, b->rope));
return pic_make_str(pic, rope_cat(pic, pic_str_ptr(pic, a)->rope, pic_str_ptr(pic, b)->rope));
}
struct pic_string *
pic_str_sub(pic_state *pic, struct pic_string *str, int s, int e)
pic_value
pic_str_sub(pic_state *pic, pic_value str, int s, int e)
{
return pic_str_valueing(pic, rope_sub(pic, str->rope, s, e));
return pic_make_str(pic, rope_sub(pic, pic_str_ptr(pic, str)->rope, s, e));
}
int
pic_str_cmp(pic_state *pic, struct pic_string *str1, struct pic_string *str2)
pic_str_cmp(pic_state *pic, pic_value str1, pic_value str2)
{
return strcmp(pic_str(pic, str1), pic_str(pic, str2));
}
int
pic_str_hash(pic_state *pic, struct pic_string *str)
pic_str_hash(pic_state *pic, pic_value str)
{
const char *s;
int h = 0;
@@ -303,9 +304,9 @@ pic_str_hash(pic_state *pic, struct pic_string *str)
}
const char *
pic_str(pic_state *pic, struct pic_string *str)
pic_str(pic_state *pic, pic_value str)
{
return rope_cstr(pic, str->rope);
return rope_cstr(pic, pic_str_ptr(pic, str)->rope);
}
static void
@@ -374,10 +375,10 @@ vfstrf(pic_state *pic, xFILE *file, const char *fmt, va_list ap)
return;
}
struct pic_string *
pic_value
pic_vstrf_value(pic_state *pic, const char *fmt, va_list ap)
{
struct pic_string *str;
pic_value str;
xFILE *file;
const char *buf;
int len;
@@ -391,11 +392,11 @@ pic_vstrf_value(pic_state *pic, const char *fmt, va_list ap)
return str;
}
struct pic_string *
pic_value
pic_strf_value(pic_state *pic, const char *fmt, ...)
{
va_list ap;
struct pic_string *str;
pic_value str;
va_start(ap, fmt);
str = pic_vstrf_value(pic, fmt, ap);
@@ -419,22 +420,18 @@ pic_str_string(pic_state *pic)
{
int argc, i;
pic_value *argv;
struct pic_string *str;
char *buf;
pic_get_args(pic, "*", &argc, &argv);
buf = pic_malloc(pic, argc);
buf = pic_alloca(pic, argc);
for (i = 0; i < argc; ++i) {
pic_assert_type(pic, argv[i], char);
buf[i] = pic_char(pic, argv[i]);
}
str = pic_str_value(pic, buf, argc);
pic_free(pic, buf);
return pic_obj_value(str);
return pic_str_value(pic, buf, argc);
}
static pic_value
@@ -443,23 +440,24 @@ pic_str_make_string(pic_state *pic)
int len;
char c = ' ';
char *buf;
pic_value ret;
pic_get_args(pic, "i|c", &len, &c);
buf = pic_malloc(pic, len);
if (len < 0) {
pic_errorf(pic, "make-string: negative length given %d", len);
}
buf = pic_alloca(pic, len);
memset(buf, c, len);
ret = pic_obj_value(pic_str_value(pic, buf, len));
pic_free(pic, buf);
return ret;
return pic_str_value(pic, buf, len);
}
static pic_value
pic_str_string_length(pic_state *pic)
{
struct pic_string *str;
pic_value str;
pic_get_args(pic, "s", &str);
@@ -469,36 +467,38 @@ pic_str_string_length(pic_state *pic)
static pic_value
pic_str_string_ref(pic_state *pic)
{
struct pic_string *str;
pic_value str;
int k;
pic_get_args(pic, "si", &str, &k);
VALID_INDEX(pic, pic_str_len(pic, str), k);
return pic_char_value(pic, pic_str_ref(pic, str, k));
}
#define DEFINE_STRING_CMP(name, op) \
static pic_value \
pic_str_string_##name(pic_state *pic) \
{ \
int argc, i; \
pic_value *argv; \
\
pic_get_args(pic, "*", &argc, &argv); \
\
if (argc < 1 || ! pic_str_p(pic, argv[0])) { \
return pic_false_value(pic); \
} \
\
for (i = 1; i < argc; ++i) { \
if (! pic_str_p(pic, argv[i])) { \
return pic_false_value(pic); \
} \
if (! (pic_str_cmp(pic, pic_str_ptr(argv[i-1]), pic_str_ptr(argv[i])) op 0)) { \
return pic_false_value(pic); \
} \
} \
return pic_true_value(pic); \
#define DEFINE_STRING_CMP(name, op) \
static pic_value \
pic_str_string_##name(pic_state *pic) \
{ \
int argc, i; \
pic_value *argv; \
\
pic_get_args(pic, "*", &argc, &argv); \
\
if (argc < 1 || ! pic_str_p(pic, argv[0])) { \
return pic_false_value(pic); \
} \
\
for (i = 1; i < argc; ++i) { \
if (! pic_str_p(pic, argv[i])) { \
return pic_false_value(pic); \
} \
if (! (pic_str_cmp(pic, argv[i-1], argv[i]) op 0)) { \
return pic_false_value(pic); \
} \
} \
return pic_true_value(pic); \
}
DEFINE_STRING_CMP(eq, ==)
@@ -510,7 +510,7 @@ DEFINE_STRING_CMP(ge, >=)
static pic_value
pic_str_string_copy(pic_state *pic)
{
struct pic_string *str;
pic_value str;
int n, start, end, len;
n = pic_get_args(pic, "s|ii", &str, &start, &end);
@@ -524,10 +524,9 @@ pic_str_string_copy(pic_state *pic)
end = len;
}
if (start < 0 || end > len || end < start)
pic_errorf(pic, "string-copy: invalid index");
VALID_RANGE(pic, len, start, end);
return pic_obj_value(pic_str_sub(pic, str, start, end));
return pic_str_sub(pic, str, start, end);
}
static pic_value
@@ -535,18 +534,15 @@ pic_str_string_append(pic_state *pic)
{
int argc, i;
pic_value *argv;
struct pic_string *str;
pic_value str = pic_lit_value(pic, "");
pic_get_args(pic, "*", &argc, &argv);
str = pic_lit_value(pic, "");
for (i = 0; i < argc; ++i) {
if (! pic_str_p(pic, argv[i])) {
pic_errorf(pic, "type error");
}
str = pic_str_cat(pic, str, pic_str_ptr(argv[i]));
pic_assert_type(pic, argv[i], str);
str = pic_str_cat(pic, str, argv[i]);
}
return pic_obj_value(str);
return str;
}
static pic_value
@@ -554,135 +550,111 @@ pic_str_string_map(pic_state *pic)
{
pic_value proc, *argv, vals, val;
int argc, i, len, j;
struct pic_string *str;
char *buf;
pic_get_args(pic, "l*", &proc, &argc, &argv);
if (argc == 0) {
pic_errorf(pic, "string-map: one or more strings expected, but got zero");
} else {
pic_assert_type(pic, argv[0], str);
len = pic_str_len(pic, pic_str_ptr(argv[0]));
}
for (i = 1; i < argc; ++i) {
len = INT_MAX;
for (i = 0; i < argc; ++i) {
int l;
pic_assert_type(pic, argv[i], str);
len = len < pic_str_len(pic, pic_str_ptr(argv[i]))
? len
: pic_str_len(pic, pic_str_ptr(argv[i]));
l = pic_str_len(pic, argv[i]);
len = len < l ? len : l;
}
buf = pic_malloc(pic, len);
pic_try {
for (i = 0; i < len; ++i) {
vals = pic_nil_value(pic);
for (j = 0; j < argc; ++j) {
pic_push(pic, pic_char_value(pic, pic_str_ref(pic, pic_str_ptr(argv[j]), i)), vals);
}
val = pic_funcall(pic, "picrin.base", "apply", 2, proc, vals);
buf = pic_alloca(pic, len);
pic_assert_type(pic, val, char);
buf[i] = pic_char(pic, val);
for (i = 0; i < len; ++i) {
vals = pic_nil_value(pic);
for (j = 0; j < argc; ++j) {
pic_push(pic, pic_char_value(pic, pic_str_ref(pic, argv[j], i)), vals);
}
str = pic_str_value(pic, buf, len);
}
pic_catch {
pic_free(pic, buf);
pic_raise(pic, pic->err);
}
vals = pic_reverse(pic, vals);
val = pic_funcall(pic, "picrin.base", "apply", 2, proc, vals);
pic_free(pic, buf);
pic_assert_type(pic, val, char);
return pic_obj_value(str);
buf[i] = pic_char(pic, val);
}
return pic_str_value(pic, buf, len);
}
static pic_value
pic_str_string_for_each(pic_state *pic)
{
int argc, len, i, j;
pic_value proc, *argv, vals;
int argc, i, len, j;
pic_get_args(pic, "l*", &proc, &argc, &argv);
if (argc == 0) {
pic_errorf(pic, "string-map: one or more strings expected, but got zero");
} else {
pic_assert_type(pic, argv[0], str);
len = pic_str_len(pic, pic_str_ptr(argv[0]));
}
for (i = 1; i < argc; ++i) {
pic_assert_type(pic, argv[i], str);
len = len < pic_str_len(pic, pic_str_ptr(argv[i]))
? len
: pic_str_len(pic, pic_str_ptr(argv[i]));
len = INT_MAX;
for (i = 0; i < argc; ++i) {
int l;
pic_assert_type(pic, argv[i], str);
l = pic_str_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_char_value(pic, pic_str_ref(pic, pic_str_ptr(argv[j]), i)), vals);
pic_push(pic, pic_char_value(pic, pic_str_ref(pic, argv[j], i)), vals);
}
vals = pic_reverse(pic, vals);
pic_funcall(pic, "picrin.base", "apply", 2, proc, vals);
}
return pic_undef_value(pic);
}
static pic_value
pic_str_list_to_string(pic_state *pic)
{
struct pic_string *str;
pic_value list, e, it;
int i;
char *buf;
pic_get_args(pic, "o", &list);
if (pic_length(pic, list) == 0) {
return pic_obj_value(pic_lit_value(pic, ""));
buf = pic_alloca(pic, pic_length(pic, list));
i = 0;
pic_for_each (e, list, it) {
pic_assert_type(pic, e, char);
buf[i++] = pic_char(pic, e);
}
buf = pic_malloc(pic, pic_length(pic, list));
pic_try {
i = 0;
pic_for_each (e, list, it) {
pic_assert_type(pic, e, char);
buf[i++] = pic_char(pic, e);
}
str = pic_str_value(pic, buf, i);
}
pic_catch {
pic_free(pic, buf);
pic_raise(pic, pic->err);
}
pic_free(pic, buf);
return pic_obj_value(str);
return pic_str_value(pic, buf, i);
}
static pic_value
pic_str_string_to_list(pic_state *pic)
{
struct pic_string *str;
pic_value list;
int n, start, end, i;
pic_value str, list;
int n, start, end, len, i;
n = pic_get_args(pic, "s|ii", &str, &start, &end);
len = pic_str_len(pic, str);
switch (n) {
case 1:
start = 0;
case 2:
end = pic_str_len(pic, str);
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, pic_char_value(pic, pic_str_ref(pic, str, i)), list);
}
extlib/benz/symbol.c
+9 -9
View File
@@ -5,20 +5,20 @@
#include "picrin.h"
#include "picrin/object.h"
#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)
#define kh_pic_str_hash(a) (pic_str_hash(pic, pic_obj_value(a)))
#define kh_pic_str_cmp(a, b) (pic_str_cmp(pic, pic_obj_value(a), pic_obj_value(b)) == 0)
KHASH_DEFINE(oblist, struct pic_string *, pic_sym *, kh_pic_str_hash, kh_pic_str_cmp)
pic_sym *
pic_intern(pic_state *pic, struct pic_string *str)
pic_intern(pic_state *pic, pic_value str)
{
khash_t(oblist) *h = &pic->oblist;
pic_sym *sym;
khiter_t it;
int ret;
it = kh_put(oblist, h, str, &ret);
it = kh_put(oblist, h, pic_str_ptr(pic, str), &ret);
if (ret == 0) { /* if exists */
sym = kh_val(h, it);
pic_protect(pic, pic_obj_value(sym));
@@ -28,7 +28,7 @@ pic_intern(pic_state *pic, struct pic_string *str)
kh_val(h, it) = pic->sQUOTE; /* dummy */
sym = (pic_sym *)pic_obj_alloc(pic, sizeof(pic_sym), PIC_TYPE_SYMBOL);
sym->str = str;
sym->str = pic_str_ptr(pic, str);
kh_val(h, it) = sym;
return sym;
@@ -45,13 +45,13 @@ pic_make_identifier(pic_state *pic, pic_id *id, struct pic_env *env)
return nid;
}
struct pic_string *
pic_value
pic_sym_name(pic_state PIC_UNUSED(*pic), pic_sym *sym)
{
return sym->str;
return pic_obj_value(sym->str);
}
struct pic_string *
pic_value
pic_id_name(pic_state *pic, pic_id *id)
{
while (! pic_sym_p(pic, pic_obj_value(id))) {
@@ -103,7 +103,7 @@ pic_symbol_symbol_to_string(pic_state *pic)
static pic_value
pic_symbol_string_to_symbol(pic_state *pic)
{
struct pic_string *str;
pic_value str;
pic_get_args(pic, "s", &str);
extlib/benz/vector.c
+10 -11
View File
@@ -248,6 +248,7 @@ pic_vec_vector_map(pic_state *pic)
for (j = 0; j < argc; ++j) {
pic_push(pic, pic_vec_ref(pic, argv[j], i), vals);
}
vals = pic_reverse(pic, vals);
pic_vec_set(pic, vec, i, pic_funcall(pic, "picrin.base", "apply", 2, proc, vals));
}
@@ -279,6 +280,7 @@ pic_vec_vector_for_each(pic_state *pic)
for (j = 0; j < argc; ++j) {
pic_push(pic, pic_vec_ref(pic, argv[j], i), vals);
}
vals = pic_reverse(pic, vals);
pic_funcall(pic, "picrin.base", "apply", 2, proc, vals);
}
@@ -335,7 +337,6 @@ pic_vec_vector_to_string(pic_state *pic)
pic_value vec, t;
char *buf;
int n, start, end, i, len;
struct pic_string *str;
n = pic_get_args(pic, "v|ii", &vec, &start, &end);
@@ -350,7 +351,7 @@ pic_vec_vector_to_string(pic_state *pic)
VALID_RANGE(pic, len, start, end);
buf = pic_malloc(pic, end - start);
buf = pic_alloca(pic, end - start);
for (i = start; i < end; ++i) {
t = pic_vec_ref(pic, vec, i);
@@ -359,29 +360,27 @@ pic_vec_vector_to_string(pic_state *pic)
buf[i - start] = pic_char(pic, t);
}
str = pic_str_value(pic, buf, end - start);
pic_free(pic, buf);
return pic_obj_value(str);
return pic_str_value(pic, buf, end - start);
}
static pic_value
pic_vec_string_to_vector(pic_state *pic)
{
struct pic_string *str;
int n, start, end, i;
pic_value vec;
pic_value str, vec;
int n, start, end, len, i;
n = pic_get_args(pic, "s|ii", &str, &start, &end);
len = pic_str_len(pic, str);
switch (n) {
case 1:
start = 0;
case 2:
end = pic_str_len(pic, str);
end = len;
}
VALID_RANGE(pic, pic_str_len(pic, str), start, end);
VALID_RANGE(pic, len, start, end);
vec = pic_make_vec(pic, end - start, NULL);
extlib/benz/write.c
+3 -3
View File
@@ -86,7 +86,7 @@ write_char(pic_state *pic, char c, xFILE *file, int mode)
}
static void
write_str(pic_state *pic, struct pic_string *str, xFILE *file, int mode)
write_str(pic_state *pic, pic_value str, xFILE *file, int mode)
{
int i;
const char *cstr = pic_str(pic, str);
@@ -312,7 +312,7 @@ write_core(struct writer_control *p, pic_value obj)
write_char(pic, pic_char(pic, obj), file, p->mode);
break;
case PIC_TYPE_STRING:
write_str(pic, pic_str_ptr(obj), file, p->mode);
write_str(pic, obj, file, p->mode);
break;
case PIC_TYPE_PAIR:
write_pair(p, obj);
@@ -442,7 +442,7 @@ pic_printf(pic_state *pic, const char *fmt, ...)
{
xFILE *file = pic_stdout(pic)->file;
va_list ap;
struct pic_string *str;
pic_value str;
va_start(ap, fmt);