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

struct pic_string * -> pic_value

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
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

85
contrib/20.r7rs/src/mutable-string.c
View File

@ -2,84 +2,93 @@
#include "picrin/object.h" #include "picrin/object.h"
void void
pic_str_set(pic_state *pic, struct pic_string *str, int i, char c) pic_str_update(pic_state *pic, pic_value dst, pic_value src)
{ {
struct pic_string *x, *y, *z, *tmp; pic_rope_incref(pic, pic_str_ptr(pic, src)->rope);
char buf[1]; pic_rope_decref(pic, pic_str_ptr(pic, dst)->rope);
pic_str_ptr(pic, dst)->rope = pic_str_ptr(pic, src)->rope;
if (pic_str_len(pic, str) <= i) {
pic_errorf(pic, "index out of range %d", i);
}
buf[0] = c;
x = pic_str_sub(pic, str, 0, i);
y = pic_str_value(pic, buf, 1);
z = pic_str_sub(pic, str, i + 1, pic_str_len(pic, str));
tmp = pic_str_cat(pic, x, pic_str_cat(pic, y, z));
pic_rope_incref(pic, tmp->rope);
pic_rope_decref(pic, str->rope);
str->rope = tmp->rope;
} }
static pic_value static pic_value
pic_str_string_set(pic_state *pic) pic_str_string_set(pic_state *pic)
{ {
struct pic_string *str; pic_value str, x, y, z;
char c; char c;
int k; int k, len;
pic_get_args(pic, "sic", &str, &k, &c); pic_get_args(pic, "sic", &str, &k, &c);
pic_str_set(pic, str, k, c); len = pic_str_len(pic, str);
VALID_INDEX(pic, len, k);
x = pic_str_sub(pic, str, 0, k);
y = pic_str_value(pic, &c, 1);
z = pic_str_sub(pic, str, k + 1, len);
pic_str_update(pic, str, pic_str_cat(pic, x, pic_str_cat(pic, y, z)));
return pic_undef_value(pic); return pic_undef_value(pic);
} }
static pic_value static pic_value
pic_str_string_copy_ip(pic_state *pic) pic_str_string_copy_ip(pic_state *pic)
{ {
struct pic_string *to, *from; pic_value to, from, x, y, z;
int n, at, start, end; int n, at, start, end, tolen, fromlen;
n = pic_get_args(pic, "sis|ii", &to, &at, &from, &start, &end); n = pic_get_args(pic, "sis|ii", &to, &at, &from, &start, &end);
tolen = pic_str_len(pic, to);
fromlen = pic_str_len(pic, from);
switch (n) { switch (n) {
case 3: case 3:
start = 0; start = 0;
case 4: case 4:
end = pic_str_len(pic, from); end = fromlen;
}
if (to == from) {
from = pic_str_sub(pic, from, 0, end);
} }
while (start < end) { VALID_ATRANGE(pic, tolen, at, fromlen, start, end);
pic_str_set(pic, to, at++, pic_str_ref(pic, from, start++));
} x = pic_str_sub(pic, to, 0, at);
y = pic_str_sub(pic, from, start, end);
z = pic_str_sub(pic, to, at + end - start, tolen);
pic_str_update(pic, to, pic_str_cat(pic, x, pic_str_cat(pic, y, z)));
return pic_undef_value(pic); return pic_undef_value(pic);
} }
static pic_value static pic_value
pic_str_string_fill_ip(pic_state *pic) pic_str_string_fill_ip(pic_state *pic)
{ {
struct pic_string *str; pic_value str, x, y, z;
char c; char c, *buf;
int n, start, end; int n, start, end, len;
n = pic_get_args(pic, "sc|ii", &str, &c, &start, &end); n = pic_get_args(pic, "sc|ii", &str, &c, &start, &end);
len = pic_str_len(pic, str);
switch (n) { switch (n) {
case 2: case 2:
start = 0; start = 0;
case 3: case 3:
end = pic_str_len(pic, str); end = len;
} }
while (start < end) { VALID_RANGE(pic, len, start, end);
pic_str_set(pic, str, start++, c);
} buf = pic_alloca(pic, end - start);
memset(buf, c, end - start);
x = pic_str_sub(pic, str, 0, start);
y = pic_str_value(pic, buf, end - start);
z = pic_str_sub(pic, str, end, len);
pic_str_update(pic, str, pic_str_cat(pic, x, pic_str_cat(pic, y, z)));
return pic_undef_value(pic); return pic_undef_value(pic);
} }

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

@ -19,12 +19,8 @@ pic_system_cmdline(pic_state *pic)
pic_get_args(pic, ""); pic_get_args(pic, "");
for (i = 0; i < picrin_argc; ++i) { for (i = 0; i < picrin_argc; ++i) {
size_t ai = pic_enter(pic); pic_push(pic, pic_cstr_value(pic, picrin_argv[i]), v);
v = pic_cons(pic, pic_obj_value(pic_cstr_value(pic, picrin_argv[i])), v);
pic_leave(pic, ai);
} }
return pic_reverse(pic, v); return pic_reverse(pic, v);
} }
@ -88,7 +84,7 @@ pic_system_getenv(pic_state *pic)
if (val == NULL) if (val == NULL)
return pic_nil_value(pic); return pic_nil_value(pic);
else else
return pic_obj_value(pic_cstr_value(pic, val)); return pic_cstr_value(pic, val);
} }
static pic_value static pic_value
@ -105,7 +101,7 @@ pic_system_getenvs(pic_state *pic)
} }
for (envp = picrin_envp; *envp; ++envp) { for (envp = picrin_envp; *envp; ++envp) {
struct pic_string *key, *val; pic_value key, val;
int i; int i;
for (i = 0; (*envp)[i] != '='; ++i) for (i = 0; (*envp)[i] != '='; ++i)
@ -115,7 +111,7 @@ pic_system_getenvs(pic_state *pic)
val = pic_cstr_value(pic, getenv(pic_str(pic, key))); val = pic_cstr_value(pic, getenv(pic_str(pic, key)));
/* push */ /* push */
data = pic_cons(pic, pic_cons(pic, pic_obj_value(key), pic_obj_value(val)), data); data = pic_cons(pic, pic_cons(pic, key, val), data);
pic_leave(pic, ai); pic_leave(pic, ai);
pic_protect(pic, data); pic_protect(pic, data);

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

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

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

@ -81,8 +81,7 @@ pic_regexp_regexp_match(pic_state *pic)
pic_value reg; pic_value reg;
const char *input; const char *input;
regmatch_t match[100]; regmatch_t match[100];
pic_value matches, positions; pic_value str, matches, positions;
struct pic_string *str;
int i, offset; int i, offset;
pic_get_args(pic, "oz", &reg, &input); pic_get_args(pic, "oz", &reg, &input);
@ -97,7 +96,7 @@ pic_regexp_regexp_match(pic_state *pic)
offset = 0; offset = 0;
while (regexec(&pic_regexp_data(pic, reg)->reg, input, 1, match, 0) != REG_NOMATCH) { while (regexec(&pic_regexp_data(pic, reg)->reg, input, 1, match, 0) != REG_NOMATCH) {
pic_push(pic, pic_obj_value(pic_str_value(pic, input, match[0].rm_eo - match[0].rm_so)), matches); pic_push(pic, pic_str_value(pic, input, match[0].rm_eo - match[0].rm_so), matches);
pic_push(pic, pic_int_value(pic, offset), positions); pic_push(pic, pic_int_value(pic, offset), positions);
offset += match[0].rm_eo; offset += match[0].rm_eo;
@ -112,7 +111,7 @@ pic_regexp_regexp_match(pic_state *pic)
break; break;
} }
str = pic_str_value(pic, input + match[i].rm_so, match[i].rm_eo - match[i].rm_so); str = pic_str_value(pic, input + match[i].rm_so, match[i].rm_eo - match[i].rm_so);
pic_push(pic, pic_obj_value(str), matches); pic_push(pic, str, matches);
pic_push(pic, pic_int_value(pic, match[i].rm_so), positions); pic_push(pic, pic_int_value(pic, match[i].rm_so), positions);
} }
} }
@ -141,12 +140,12 @@ pic_regexp_regexp_split(pic_state *pic)
pic_assert_type(pic, reg, regexp); pic_assert_type(pic, reg, regexp);
while (regexec(&pic_regexp_data(pic, reg)->reg, input, 1, &match, 0) != REG_NOMATCH) { while (regexec(&pic_regexp_data(pic, reg)->reg, input, 1, &match, 0) != REG_NOMATCH) {
pic_push(pic, pic_obj_value(pic_str_value(pic, input, match.rm_so)), output); pic_push(pic, pic_str_value(pic, input, match.rm_so), output);
input += match.rm_eo; input += match.rm_eo;
} }
pic_push(pic, pic_obj_value(pic_cstr_value(pic, input)), output); pic_push(pic, pic_cstr_value(pic, input), output);
return pic_reverse(pic, output); return pic_reverse(pic, output);
} }
@ -157,7 +156,7 @@ pic_regexp_regexp_replace(pic_state *pic)
pic_value reg; pic_value reg;
const char *input; const char *input;
regmatch_t match; regmatch_t match;
struct pic_string *txt, *output = pic_lit_value(pic, ""); pic_value txt, output = pic_lit_value(pic, "");
pic_get_args(pic, "ozs", &reg, &input, &txt); pic_get_args(pic, "ozs", &reg, &input, &txt);
@ -170,9 +169,7 @@ pic_regexp_regexp_replace(pic_state *pic)
input += match.rm_eo; input += match.rm_eo;
} }
output = pic_str_cat(pic, output, pic_str_value(pic, input, strlen(input))); return pic_str_cat(pic, output, pic_str_value(pic, input, strlen(input)));
return pic_obj_value(output);
} }
void void

2
extlib/benz/blob.c
View File

@ -81,7 +81,7 @@ pic_blob_make_bytevector(pic_state *pic)
blob = pic_blob_value(pic, 0, k); 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; return blob;
} }

2
extlib/benz/bool.c
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; return s1 == s2;
} }
case PIC_TYPE_STRING: { 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: { case PIC_TYPE_BLOB: {
int xlen, ylen; int xlen, ylen;

8
extlib/benz/debug.c
View File

@ -5,12 +5,12 @@
#include "picrin.h" #include "picrin.h"
#include "picrin/object.h" #include "picrin/object.h"
struct pic_string * pic_value
pic_get_backtrace(pic_state *pic) pic_get_backtrace(pic_state *pic)
{ {
size_t ai = pic_enter(pic); size_t ai = pic_enter(pic);
pic_callinfo *ci; pic_callinfo *ci;
struct pic_string *trace; pic_value trace;
trace = pic_lit_value(pic, ""); trace = pic_lit_value(pic, "");
@ -28,7 +28,7 @@ pic_get_backtrace(pic_state *pic)
} }
pic_leave(pic, ai); pic_leave(pic, ai);
pic_protect(pic, pic_obj_value(trace)); pic_protect(pic, trace);
return trace; return trace;
} }
@ -59,6 +59,6 @@ pic_print_backtrace(pic_state *pic, xFILE *file)
} }
xfprintf(pic, file, "\n"); xfprintf(pic, file, "\n");
xfputs(pic, pic_str(pic, e->stack), file); xfputs(pic, pic_str(pic, pic_obj_value(e->stack)), file);
} }
} }

10
extlib/benz/error.c
View File

@ -22,7 +22,7 @@ void
pic_warnf(pic_state *pic, const char *fmt, ...) pic_warnf(pic_state *pic, const char *fmt, ...)
{ {
va_list ap; va_list ap;
struct pic_string *err; pic_value err;
va_start(ap, fmt); va_start(ap, fmt);
err = pic_vstrf_value(pic, fmt, ap); err = pic_vstrf_value(pic, fmt, ap);
@ -36,7 +36,7 @@ pic_errorf(pic_state *pic, const char *fmt, ...)
{ {
va_list ap; va_list ap;
const char *msg; const char *msg;
struct pic_string *err; pic_value err;
va_start(ap, fmt); va_start(ap, fmt);
err = pic_vstrf_value(pic, fmt, ap); 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) pic_make_error(pic_state *pic, const char *type, const char *msg, pic_value irrs)
{ {
struct pic_error *e; struct pic_error *e;
struct pic_string *stack; pic_value stack;
pic_sym *ty = pic_intern_cstr(pic, type); pic_sym *ty = pic_intern_cstr(pic, type);
stack = pic_get_backtrace(pic); stack = pic_get_backtrace(pic);
e = (struct pic_error *)pic_obj_alloc(pic, sizeof(struct pic_error), PIC_TYPE_ERROR); e = (struct pic_error *)pic_obj_alloc(pic, sizeof(struct pic_error), PIC_TYPE_ERROR);
e->type = ty; 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->irrs = irrs;
e->stack = stack; e->stack = pic_str_ptr(pic, stack);
return e; return e;
} }

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

@ -53,7 +53,6 @@ typedef struct {
struct pic_object; struct pic_object;
struct pic_symbol; struct pic_symbol;
struct pic_string;
struct pic_port; struct pic_port;
struct pic_error; struct pic_error;
struct pic_env; 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 double pic_float(pic_state *, pic_value f);
PIC_INLINE char pic_char(pic_state *, pic_value c); PIC_INLINE char pic_char(pic_state *, pic_value c);
#define pic_bool(pic,b) (! pic_false_p(pic, b)) #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); unsigned char *pic_blob(pic_state *, pic_value blob, int *len);
void *pic_data(pic_state *, pic_value data); 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_false_value(pic_state *);
PIC_INLINE pic_value pic_bool_value(pic_state *, bool); PIC_INLINE pic_value pic_bool_value(pic_state *, bool);
PIC_INLINE pic_value pic_eof_object(pic_state *); 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_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)) #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, ...); pic_value 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_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_blob_value(pic_state *, const unsigned char *buf, int len);
pic_value pic_data_value(pic_state *, void *ptr, const pic_data_type *type); 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 *); bool pic_weak_has(pic_state *, struct pic_weak *, void *);
/* symbol */ /* 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_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_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)) #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 */ /* string */
int pic_str_len(pic_state *, struct pic_string *); int pic_str_len(pic_state *, pic_value str);
char pic_str_ref(pic_state *, struct pic_string *, int); char pic_str_ref(pic_state *, pic_value str, int i);
struct pic_string *pic_str_cat(pic_state *, struct pic_string *, struct pic_string *); pic_value pic_str_cat(pic_state *, pic_value str1, pic_value str2);
struct pic_string *pic_str_sub(pic_state *, struct pic_string *, int, int); pic_value pic_str_sub(pic_state *, pic_value str, int i, int j);
int pic_str_cmp(pic_state *, struct pic_string *, struct pic_string *); int pic_str_cmp(pic_state *, pic_value str1, pic_value str2);
int pic_str_hash(pic_state *, struct pic_string *); int pic_str_hash(pic_state *, pic_value str);
/* extra stuff */ /* 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)) #define pic_pop(pic, place) (place = pic_cdr(pic, place))
void pic_warnf(pic_state *, const char *, ...); 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 *); void pic_print_backtrace(pic_state *, xFILE *);
#define pic_stdin(pic) pic_port_ptr(pic_funcall(pic, "picrin.base", "current-input-port", 0)) #define pic_stdin(pic) pic_port_ptr(pic_funcall(pic, "picrin.base", "current-input-port", 0))

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

@ -120,15 +120,15 @@ struct pic_port {
xFILE *file; 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_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_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_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_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_proc_ptr(pic, o) ((struct pic_proc *)pic_obj_ptr(o))
#define pic_sym_ptr(v) ((pic_sym *)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_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_weak_ptr(v) ((struct pic_weak *)pic_obj_ptr(v))
#define pic_context_ptr(o) ((struct pic_context *)pic_obj_ptr(o)) #define pic_context_ptr(o) ((struct pic_context *)pic_obj_ptr(o))
#define pic_rec_ptr(v) ((struct pic_record *)pic_obj_ptr(v)) #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_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_put_identifier(pic_state *, pic_id *, pic_sym *, struct pic_env *);
pic_sym *pic_find_identifier(pic_state *, pic_id *, 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_incref(pic_state *, struct pic_rope *);
void pic_rope_decref(pic_state *, struct pic_rope *); void pic_rope_decref(pic_state *, struct pic_rope *);

11
extlib/benz/lib.c
View File

@ -32,13 +32,13 @@ get_library(pic_state *pic, const char *lib)
} }
static struct pic_env * 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; struct pic_env *env;
env = (struct pic_env *)pic_obj_alloc(pic, sizeof(struct pic_env), PIC_TYPE_ENV); env = (struct pic_env *)pic_obj_alloc(pic, sizeof(struct pic_env), PIC_TYPE_ENV);
env->up = NULL; env->up = NULL;
env->lib = name; env->lib = pic_str_ptr(pic, name);
kh_init(env, &env->map); kh_init(env, &env->map);
/* set up default environment */ /* set up default environment */
@ -55,9 +55,8 @@ pic_make_library(pic_state *pic, const char *lib)
{ {
khash_t(ltable) *h = &pic->ltable; khash_t(ltable) *h = &pic->ltable;
const char *old_lib; const char *old_lib;
struct pic_string *name;
struct pic_env *env; struct pic_env *env;
pic_value exports; pic_value name, exports;
khiter_t it; khiter_t it;
int ret; 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); 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).env = env;
kh_val(h, it).exports = pic_dict_ptr(pic, exports); 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 * const char *
pic_current_library(pic_state *pic) 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 * struct pic_env *

4
extlib/benz/macro.c
View File

@ -26,12 +26,12 @@ pic_add_identifier(pic_state *pic, pic_id *id, struct pic_env *env)
{ {
const char *name; const char *name;
pic_sym *uid; pic_sym *uid;
struct pic_string *str; pic_value str;
name = pic_str(pic, pic_id_name(pic, id)); name = pic_str(pic, pic_id_name(pic, id));
if (env->up == NULL && pic_sym_p(pic, pic_obj_value(id))) { /* toplevel & public */ 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 { } else {
str = pic_strf_value(pic, ".%s.%d", name, pic->ucnt++); str = pic_strf_value(pic, ".%s.%d", name, pic->ucnt++);
} }

11
extlib/benz/number.c
View File

@ -218,7 +218,7 @@ pic_number_number_to_string(pic_state *pic)
double f; double f;
bool e; bool e;
int radix = 10; int radix = 10;
struct pic_string *str; pic_value str;
pic_get_args(pic, "F|i", &f, &e, &radix); pic_get_args(pic, "F|i", &f, &e, &radix);
@ -229,14 +229,11 @@ pic_number_number_to_string(pic_state *pic)
if (e) { if (e) {
int ival = (int) f; int ival = (int) f;
int ilen = number_string_length(ival, radix); int ilen = number_string_length(ival, radix);
int s = ilen + 1; char *buf = pic_alloca(pic, ilen + 1);
char *buf = pic_malloc(pic, s);
number_string(ival, radix, ilen, buf); number_string(ival, radix, ilen, buf);
str = pic_str_value(pic, buf, s - 1); str = pic_str_value(pic, buf, ilen);
pic_free(pic, buf);
} }
else { else {
xFILE *file = xfopen_buf(pic, NULL, 0, "w"); xFILE *file = xfopen_buf(pic, NULL, 0, "w");
@ -249,7 +246,7 @@ pic_number_number_to_string(pic_state *pic)
xfclose(pic, file); xfclose(pic, file);
} }
return pic_obj_value(str); return str;
} }
static pic_value static pic_value

6
extlib/benz/proc.c
View File

@ -22,7 +22,7 @@
* z char ** c string * z char ** c string
* m pic_sym ** symbol * m pic_sym ** symbol
* v pic_value * vector object * v pic_value * vector object
* s struct pic_str ** string object * s pic_value * string object
* b pic_value * bytevector object * b pic_value * bytevector object
* l pic_value * lambda object * l pic_value * lambda object
* p struct pic_port ** port 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('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) \ #define PTR_CASE(c, type, ctype) \
VAL_CASE(c, type, ctype, pic_## type ##_ptr(v)) VAL_CASE(c, type, ctype, pic_## type ##_ptr(v))
PTR_CASE('m', sym, pic_sym *) PTR_CASE('m', sym, pic_sym *)
PTR_CASE('s', str, struct pic_string *)
PTR_CASE('p', port, struct pic_port *) PTR_CASE('p', port, struct pic_port *)
PTR_CASE('e', error, struct pic_error *) PTR_CASE('e', error, struct pic_error *)
PTR_CASE('r', rec, struct pic_record *) PTR_CASE('r', rec, struct pic_record *)
#define OBJ_CASE(c, type) VAL_CASE(c, type, pic_value, v) #define OBJ_CASE(c, type) VAL_CASE(c, type, pic_value, v)
OBJ_CASE('s', str)
OBJ_CASE('l', proc) OBJ_CASE('l', proc)
OBJ_CASE('b', blob) OBJ_CASE('b', blob)
OBJ_CASE('v', vec) OBJ_CASE('v', vec)

7
extlib/benz/read.c
View File

@ -281,8 +281,7 @@ read_unsigned(pic_state *pic, xFILE *file, int c)
} }
} }
if (idx >= ATOF_BUF_SIZE) if (idx >= ATOF_BUF_SIZE)
read_error(pic, "number too large", read_error(pic, "number too large", pic_list(pic, 1, pic_str_value(pic, (const char *)buf, ATOF_BUF_SIZE)));
pic_obj_value(pic_str_value(pic, (const char *)buf, ATOF_BUF_SIZE)));
if (! isdelim(c)) if (! isdelim(c))
read_error(pic, "non-delimiter character given after number", pic_list(pic, 1, pic_char_value(pic, 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; char *buf;
int size, cnt; int size, cnt;
struct pic_string *str; pic_value str;
size = 256; size = 256;
buf = pic_malloc(pic, size); 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); str = pic_str_value(pic, buf, cnt);
pic_free(pic, buf); pic_free(pic, buf);
return pic_obj_value(str); return str;
} }
static pic_value static pic_value

242
extlib/benz/string.c
View File

@ -94,14 +94,15 @@ pic_make_rope(pic_state *pic, struct pic_chunk *c)
return x; return x;
} }
static struct pic_string * static pic_value
pic_str_valueing(pic_state *pic, struct pic_rope *rope) pic_make_str(pic_state *pic, struct pic_rope *rope)
{ {
struct pic_string *str; struct pic_string *str;
str = (struct pic_string *)pic_obj_alloc(pic, sizeof(struct pic_string), PIC_TYPE_STRING); str = (struct pic_string *)pic_obj_alloc(pic, sizeof(struct pic_string), PIC_TYPE_STRING);
str->rope = rope; /* delegate ownership */ str->rope = rope; /* delegate ownership */
return str;
return pic_obj_value(str);
} }
static size_t static size_t
@ -237,7 +238,7 @@ rope_cstr(pic_state *pic, struct pic_rope *x)
return c->str; return c->str;
} }
struct pic_string * pic_value
pic_str_value(pic_state *pic, const char *str, int len) pic_str_value(pic_state *pic, const char *str, int len)
{ {
struct pic_chunk *c; 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); 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 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 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; int c;
c = rope_at(str->rope, i); c = rope_at(pic_str_ptr(pic, str)->rope, i);
if (c == -1) { if (c == -1) {
pic_errorf(pic, "index out of range %d", i); pic_errorf(pic, "index out of range %d", i);
} }
return (char)c; return (char)c;
} }
struct pic_string * pic_value
pic_str_cat(pic_state *pic, struct pic_string *a, struct pic_string *b) 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_value
pic_str_sub(pic_state *pic, struct pic_string *str, int s, int e) 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 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)); return strcmp(pic_str(pic, str1), pic_str(pic, str2));
} }
int int
pic_str_hash(pic_state *pic, struct pic_string *str) pic_str_hash(pic_state *pic, pic_value str)
{ {
const char *s; const char *s;
int h = 0; int h = 0;
@ -303,9 +304,9 @@ pic_str_hash(pic_state *pic, struct pic_string *str)
} }
const char * 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 static void
@ -374,10 +375,10 @@ vfstrf(pic_state *pic, xFILE *file, const char *fmt, va_list ap)
return; return;
} }
struct pic_string * pic_value
pic_vstrf_value(pic_state *pic, const char *fmt, va_list ap) pic_vstrf_value(pic_state *pic, const char *fmt, va_list ap)
{ {
struct pic_string *str; pic_value str;
xFILE *file; xFILE *file;
const char *buf; const char *buf;
int len; int len;
@ -391,11 +392,11 @@ pic_vstrf_value(pic_state *pic, const char *fmt, va_list ap)
return str; return str;
} }
struct pic_string * pic_value
pic_strf_value(pic_state *pic, const char *fmt, ...) pic_strf_value(pic_state *pic, const char *fmt, ...)
{ {
va_list ap; va_list ap;
struct pic_string *str; pic_value str;
va_start(ap, fmt); va_start(ap, fmt);
str = pic_vstrf_value(pic, fmt, ap); str = pic_vstrf_value(pic, fmt, ap);
@ -419,22 +420,18 @@ pic_str_string(pic_state *pic)
{ {
int argc, i; int argc, i;
pic_value *argv; pic_value *argv;
struct pic_string *str;
char *buf; char *buf;
pic_get_args(pic, "*", &argc, &argv); pic_get_args(pic, "*", &argc, &argv);
buf = pic_malloc(pic, argc); buf = pic_alloca(pic, argc);
for (i = 0; i < argc; ++i) { for (i = 0; i < argc; ++i) {
pic_assert_type(pic, argv[i], char); pic_assert_type(pic, argv[i], char);
buf[i] = pic_char(pic, argv[i]); buf[i] = pic_char(pic, argv[i]);
} }
str = pic_str_value(pic, buf, argc); return pic_str_value(pic, buf, argc);
pic_free(pic, buf);
return pic_obj_value(str);
} }
static pic_value static pic_value
@ -443,23 +440,24 @@ pic_str_make_string(pic_state *pic)
int len; int len;
char c = ' '; char c = ' ';
char *buf; char *buf;
pic_value ret;
pic_get_args(pic, "i|c", &len, &c); 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); memset(buf, c, len);
ret = pic_obj_value(pic_str_value(pic, buf, len)); return pic_str_value(pic, buf, len);
pic_free(pic, buf);
return ret;
} }
static pic_value static pic_value
pic_str_string_length(pic_state *pic) pic_str_string_length(pic_state *pic)
{ {
struct pic_string *str; pic_value str;
pic_get_args(pic, "s", &str); pic_get_args(pic, "s", &str);
@ -469,36 +467,38 @@ pic_str_string_length(pic_state *pic)
static pic_value static pic_value
pic_str_string_ref(pic_state *pic) pic_str_string_ref(pic_state *pic)
{ {
struct pic_string *str; pic_value str;
int k; int k;
pic_get_args(pic, "si", &str, &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)); return pic_char_value(pic, pic_str_ref(pic, str, k));
} }
#define DEFINE_STRING_CMP(name, op) \ #define DEFINE_STRING_CMP(name, op) \
static pic_value \ static pic_value \
pic_str_string_##name(pic_state *pic) \ pic_str_string_##name(pic_state *pic) \
{ \ { \
int argc, i; \ int argc, i; \
pic_value *argv; \ pic_value *argv; \
\ \
pic_get_args(pic, "*", &argc, &argv); \ pic_get_args(pic, "*", &argc, &argv); \
\ \
if (argc < 1 || ! pic_str_p(pic, argv[0])) { \ if (argc < 1 || ! pic_str_p(pic, argv[0])) { \
return pic_false_value(pic); \ return pic_false_value(pic); \
} \ } \
\ \
for (i = 1; i < argc; ++i) { \ for (i = 1; i < argc; ++i) { \
if (! pic_str_p(pic, argv[i])) { \ if (! pic_str_p(pic, argv[i])) { \
return pic_false_value(pic); \ return pic_false_value(pic); \
} \ } \
if (! (pic_str_cmp(pic, pic_str_ptr(argv[i-1]), pic_str_ptr(argv[i])) op 0)) { \ if (! (pic_str_cmp(pic, argv[i-1], argv[i]) op 0)) { \
return pic_false_value(pic); \ return pic_false_value(pic); \
} \ } \
} \ } \
return pic_true_value(pic); \ return pic_true_value(pic); \
} }
DEFINE_STRING_CMP(eq, ==) DEFINE_STRING_CMP(eq, ==)
@ -510,7 +510,7 @@ DEFINE_STRING_CMP(ge, >=)
static pic_value static pic_value
pic_str_string_copy(pic_state *pic) pic_str_string_copy(pic_state *pic)
{ {
struct pic_string *str; pic_value str;
int n, start, end, len; int n, start, end, len;
n = pic_get_args(pic, "s|ii", &str, &start, &end); n = pic_get_args(pic, "s|ii", &str, &start, &end);
@ -524,10 +524,9 @@ pic_str_string_copy(pic_state *pic)
end = len; end = len;
} }
if (start < 0 || end > len || end < start) VALID_RANGE(pic, len, start, end);
pic_errorf(pic, "string-copy: invalid index");
return pic_obj_value(pic_str_sub(pic, str, start, end)); return pic_str_sub(pic, str, start, end);
} }
static pic_value static pic_value
@ -535,18 +534,15 @@ pic_str_string_append(pic_state *pic)
{ {
int argc, i; int argc, i;
pic_value *argv; pic_value *argv;
struct pic_string *str; pic_value str = pic_lit_value(pic, "");
pic_get_args(pic, "*", &argc, &argv); pic_get_args(pic, "*", &argc, &argv);
str = pic_lit_value(pic, "");
for (i = 0; i < argc; ++i) { for (i = 0; i < argc; ++i) {
if (! pic_str_p(pic, argv[i])) { pic_assert_type(pic, argv[i], str);
pic_errorf(pic, "type error"); str = pic_str_cat(pic, str, argv[i]);
}
str = pic_str_cat(pic, str, pic_str_ptr(argv[i]));
} }
return pic_obj_value(str); return str;
} }
static pic_value static pic_value
@ -554,135 +550,111 @@ pic_str_string_map(pic_state *pic)
{ {
pic_value proc, *argv, vals, val; pic_value proc, *argv, vals, val;
int argc, i, len, j; int argc, i, len, j;
struct pic_string *str;
char *buf; char *buf;
pic_get_args(pic, "l*", &proc, &argc, &argv); pic_get_args(pic, "l*", &proc, &argc, &argv);
if (argc == 0) { if (argc == 0) {
pic_errorf(pic, "string-map: one or more strings expected, but got zero"); 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); pic_assert_type(pic, argv[i], str);
l = pic_str_len(pic, argv[i]);
len = len < pic_str_len(pic, pic_str_ptr(argv[i])) len = len < l ? len : l;
? len
: pic_str_len(pic, pic_str_ptr(argv[i]));
} }
buf = pic_malloc(pic, len);
pic_try { buf = pic_alloca(pic, len);
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);
pic_assert_type(pic, val, char); for (i = 0; i < len; ++i) {
buf[i] = pic_char(pic, val); 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); vals = pic_reverse(pic, vals);
} val = pic_funcall(pic, "picrin.base", "apply", 2, proc, vals);
pic_catch {
pic_free(pic, buf);
pic_raise(pic, pic->err);
}
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 static pic_value
pic_str_string_for_each(pic_state *pic) pic_str_string_for_each(pic_state *pic)
{ {
int argc, len, i, j;
pic_value proc, *argv, vals; pic_value proc, *argv, vals;
int argc, i, len, j;
pic_get_args(pic, "l*", &proc, &argc, &argv); pic_get_args(pic, "l*", &proc, &argc, &argv);
if (argc == 0) { if (argc == 0) {
pic_errorf(pic, "string-map: one or more strings expected, but got zero"); 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 = INT_MAX;
? len for (i = 0; i < argc; ++i) {
: pic_str_len(pic, pic_str_ptr(argv[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) { for (i = 0; i < len; ++i) {
vals = pic_nil_value(pic); vals = pic_nil_value(pic);
for (j = 0; j < argc; ++j) { 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); pic_funcall(pic, "picrin.base", "apply", 2, proc, vals);
} }
return pic_undef_value(pic); return pic_undef_value(pic);
} }
static pic_value static pic_value
pic_str_list_to_string(pic_state *pic) pic_str_list_to_string(pic_state *pic)
{ {
struct pic_string *str;
pic_value list, e, it; pic_value list, e, it;
int i; int i;
char *buf; char *buf;
pic_get_args(pic, "o", &list); pic_get_args(pic, "o", &list);
if (pic_length(pic, list) == 0) { buf = pic_alloca(pic, pic_length(pic, list));
return pic_obj_value(pic_lit_value(pic, ""));
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)); return pic_str_value(pic, buf, i);
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);
} }
static pic_value static pic_value
pic_str_string_to_list(pic_state *pic) pic_str_string_to_list(pic_state *pic)
{ {
struct pic_string *str; pic_value str, list;
pic_value list; int n, start, end, len, i;
int n, start, end, i;
n = pic_get_args(pic, "s|ii", &str, &start, &end); n = pic_get_args(pic, "s|ii", &str, &start, &end);
len = pic_str_len(pic, str);
switch (n) { switch (n) {
case 1: case 1:
start = 0; start = 0;
case 2: 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) { for (i = start; i < end; ++i) {
pic_push(pic, pic_char_value(pic, pic_str_ref(pic, str, i)), list); pic_push(pic, pic_char_value(pic, pic_str_ref(pic, str, i)), list);
} }

18
extlib/benz/symbol.c
View File

@ -5,20 +5,20 @@
#include "picrin.h" #include "picrin.h"
#include "picrin/object.h" #include "picrin/object.h"
#define kh_pic_str_hash(a) (pic_str_hash(pic, (a))) #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, (a), (b)) == 0) #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) KHASH_DEFINE(oblist, struct pic_string *, pic_sym *, kh_pic_str_hash, kh_pic_str_cmp)
pic_sym * 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; khash_t(oblist) *h = &pic->oblist;
pic_sym *sym; pic_sym *sym;
khiter_t it; khiter_t it;
int ret; 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 */ if (ret == 0) { /* if exists */
sym = kh_val(h, it); sym = kh_val(h, it);
pic_protect(pic, pic_obj_value(sym)); 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 */ kh_val(h, it) = pic->sQUOTE; /* dummy */
sym = (pic_sym *)pic_obj_alloc(pic, sizeof(pic_sym), PIC_TYPE_SYMBOL); 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; kh_val(h, it) = sym;
return sym; return sym;
@ -45,13 +45,13 @@ pic_make_identifier(pic_state *pic, pic_id *id, struct pic_env *env)
return nid; return nid;
} }
struct pic_string * pic_value
pic_sym_name(pic_state PIC_UNUSED(*pic), pic_sym *sym) 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) pic_id_name(pic_state *pic, pic_id *id)
{ {
while (! pic_sym_p(pic, pic_obj_value(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 static pic_value
pic_symbol_string_to_symbol(pic_state *pic) pic_symbol_string_to_symbol(pic_state *pic)
{ {
struct pic_string *str; pic_value str;
pic_get_args(pic, "s", &str); pic_get_args(pic, "s", &str);

21
extlib/benz/vector.c
View File

@ -248,6 +248,7 @@ pic_vec_vector_map(pic_state *pic)
for (j = 0; j < argc; ++j) { for (j = 0; j < argc; ++j) {
pic_push(pic, pic_vec_ref(pic, argv[j], i), vals); 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)); 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) { for (j = 0; j < argc; ++j) {
pic_push(pic, pic_vec_ref(pic, argv[j], i), vals); 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); 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; pic_value vec, t;
char *buf; char *buf;
int n, start, end, i, len; int n, start, end, i, len;
struct pic_string *str;
n = pic_get_args(pic, "v|ii", &vec, &start, &end); 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); VALID_RANGE(pic, len, start, end);
buf = pic_malloc(pic, end - start); buf = pic_alloca(pic, end - start);
for (i = start; i < end; ++i) { for (i = start; i < end; ++i) {
t = pic_vec_ref(pic, vec, 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); buf[i - start] = pic_char(pic, t);
} }
str = pic_str_value(pic, buf, end - start); return pic_str_value(pic, buf, end - start);
pic_free(pic, buf);
return pic_obj_value(str);
} }
static pic_value static pic_value
pic_vec_string_to_vector(pic_state *pic) pic_vec_string_to_vector(pic_state *pic)
{ {
struct pic_string *str; pic_value str, vec;
int n, start, end, i; int n, start, end, len, i;
pic_value vec;
n = pic_get_args(pic, "s|ii", &str, &start, &end); n = pic_get_args(pic, "s|ii", &str, &start, &end);
len = pic_str_len(pic, str);
switch (n) { switch (n) {
case 1: case 1:
start = 0; start = 0;
case 2: 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); vec = pic_make_vec(pic, end - start, NULL);

6
extlib/benz/write.c
View File

@ -86,7 +86,7 @@ write_char(pic_state *pic, char c, xFILE *file, int mode)
} }
static void 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; int i;
const char *cstr = pic_str(pic, str); 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); write_char(pic, pic_char(pic, obj), file, p->mode);
break; break;
case PIC_TYPE_STRING: case PIC_TYPE_STRING:
write_str(pic, pic_str_ptr(obj), file, p->mode); write_str(pic, obj, file, p->mode);
break; break;
case PIC_TYPE_PAIR: case PIC_TYPE_PAIR:
write_pair(p, obj); write_pair(p, obj);
@ -442,7 +442,7 @@ pic_printf(pic_state *pic, const char *fmt, ...)
{ {
xFILE *file = pic_stdout(pic)->file; xFILE *file = pic_stdout(pic)->file;
va_list ap; va_list ap;
struct pic_string *str; pic_value str;
va_start(ap, fmt); va_start(ap, fmt);

42
t/issue/foo-map.scm Normal file
View File

@ -0,0 +1,42 @@
(import (scheme base)
(picrin test))
(test-begin)
(define (char-inc c)
(integer->char (+ (char->integer c) 1)))
(define (char-dec c)
(integer->char (- (char->integer c) 1)))
(test "tsvcmxdmqr"
(string-map (lambda (c k)
((if (eqv? k #\+) char-inc char-dec) c))
"studlycnps xxx"
"+-+-+-+-+-"))
(test "abcdefgh"
(begin
(define s "")
(string-for-each
(lambda (a b)
(set! s (string-append s (string a b))))
"aceg hij"
"bdfh")
s))
(test #(#(1 6 9) #(2 7 10) #(3 8 11))
(vector-map vector #(1 2 3 4 5) #(6 7 8) #(9 10 11 12)))
(test "(1 4 1)(2 5 1)"
(call-with-port (open-output-string)
(lambda (port)
(parameterize ((current-output-port port))
(vector-for-each
(lambda args (display args))
#(1 2 3)
#(4 5)
#(1 1))
(get-output-string port)))))
(test-end)