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"
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;
char buf[1];
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;
pic_rope_incref(pic, pic_str_ptr(pic, src)->rope);
pic_rope_decref(pic, pic_str_ptr(pic, dst)->rope);
pic_str_ptr(pic, dst)->rope = pic_str_ptr(pic, src)->rope;
}
static pic_value
pic_str_string_set(pic_state *pic)
{
struct pic_string *str;
pic_value str, x, y, z;
char c;
int k;
int k, len;
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);
}
static pic_value
pic_str_string_copy_ip(pic_state *pic)
{
struct pic_string *to, *from;
int n, at, start, end;
pic_value to, from, x, y, z;
int n, at, start, end, tolen, fromlen;
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) {
case 3:
start = 0;
case 4:
end = pic_str_len(pic, from);
}
if (to == from) {
from = pic_str_sub(pic, from, 0, end);
end = fromlen;
}
while (start < end) {
pic_str_set(pic, to, at++, pic_str_ref(pic, from, start++));
}
VALID_ATRANGE(pic, tolen, at, fromlen, start, end);
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);
}
static pic_value
pic_str_string_fill_ip(pic_state *pic)
{
struct pic_string *str;
char c;
int n, start, end;
pic_value str, x, y, z;
char c, *buf;
int n, start, end, len;
n = pic_get_args(pic, "sc|ii", &str, &c, &start, &end);
len = pic_str_len(pic, str);
switch (n) {
case 2:
start = 0;
case 3:
end = pic_str_len(pic, str);
end = len;
}
while (start < end) {
pic_str_set(pic, str, start++, c);
}
VALID_RANGE(pic, len, start, end);
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);
}

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

@ -19,12 +19,8 @@ pic_system_cmdline(pic_state *pic)
pic_get_args(pic, "");
for (i = 0; i < picrin_argc; ++i) {
size_t ai = pic_enter(pic);
v = pic_cons(pic, pic_obj_value(pic_cstr_value(pic, picrin_argv[i])), v);
pic_leave(pic, ai);
pic_push(pic, pic_cstr_value(pic, picrin_argv[i]), v);
}
return pic_reverse(pic, v);
}
@ -88,7 +84,7 @@ pic_system_getenv(pic_state *pic)
if (val == NULL)
return pic_nil_value(pic);
else
return pic_obj_value(pic_cstr_value(pic, val));
return pic_cstr_value(pic, val);
}
static pic_value
@ -105,7 +101,7 @@ pic_system_getenvs(pic_state *pic)
}
for (envp = picrin_envp; *envp; ++envp) {
struct pic_string *key, *val;
pic_value key, val;
int 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)));
/* 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_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);
if(result)
return pic_obj_value(pic_cstr_value(pic, result));
return pic_cstr_value(pic, result);
else
return pic_eof_object(pic);
}
@ -87,7 +87,7 @@ pic_rl_current_history(pic_state *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
@ -100,8 +100,7 @@ pic_rl_history_get(pic_state *pic)
e = history_get(i);
return e ? pic_obj_value(pic_cstr_value(pic, e->line))
: pic_false_value(pic);
return e ? pic_cstr_value(pic, e->line) : pic_false_value(pic);
}
static pic_value
@ -114,8 +113,7 @@ pic_rl_remove_history(pic_state *pic)
e = remove_history(i);
return e ? pic_obj_value(pic_cstr_value(pic, e->line))
: pic_false_value(pic);
return e ? pic_cstr_value(pic, e->line) : pic_false_value(pic);
}
static pic_value
@ -148,8 +146,7 @@ pic_rl_previous_history(pic_state *pic)
e = previous_history();
return e ? pic_obj_value(pic_cstr_value(pic, e->line))
: pic_false_value(pic);
return e ? pic_cstr_value(pic, e->line) : pic_false_value(pic);
}
static pic_value
@ -161,8 +158,7 @@ pic_rl_next_history(pic_state *pic)
e = next_history();
return e ? pic_obj_value(pic_cstr_value(pic, e->line))
: pic_false_value(pic);
return e ? pic_cstr_value(pic, e->line) : pic_false_value(pic);
}
static pic_value
@ -240,7 +236,7 @@ pic_rl_history_expand(pic_state *pic)
if(status == -1 || status == 2)
pic_errorf(pic, "%s\n", result);
return pic_obj_value(pic_cstr_value(pic, result));
return pic_cstr_value(pic, result);
}
void

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

@ -81,8 +81,7 @@ pic_regexp_regexp_match(pic_state *pic)
pic_value reg;
const char *input;
regmatch_t match[100];
pic_value matches, positions;
struct pic_string *str;
pic_value str, matches, positions;
int i, offset;
pic_get_args(pic, "oz", &reg, &input);
@ -97,7 +96,7 @@ pic_regexp_regexp_match(pic_state *pic)
offset = 0;
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);
offset += match[0].rm_eo;
@ -112,7 +111,7 @@ pic_regexp_regexp_match(pic_state *pic)
break;
}
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);
}
}
@ -141,12 +140,12 @@ pic_regexp_regexp_split(pic_state *pic)
pic_assert_type(pic, reg, regexp);
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;
}
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);
}
@ -157,7 +156,7 @@ pic_regexp_regexp_replace(pic_state *pic)
pic_value reg;
const char *input;
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);
@ -170,9 +169,7 @@ pic_regexp_regexp_replace(pic_state *pic)
input += match.rm_eo;
}
output = pic_str_cat(pic, output, pic_str_value(pic, input, strlen(input)));
return pic_obj_value(output);
return pic_str_cat(pic, output, pic_str_value(pic, input, strlen(input)));
}
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);
memset(pic_blob(pic, blob, NULL), k, (unsigned char)b);
memset(pic_blob(pic, blob, NULL), (unsigned char)b, k);
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;
}
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;

8
extlib/benz/debug.c
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);
}
}

10
extlib/benz/error.c
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;
}

27
extlib/benz/include/picrin.h
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))

6
extlib/benz/include/picrin/object.h
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 *);

11
extlib/benz/lib.c
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 *

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;
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++);
}

11
extlib/benz/number.c
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

6
extlib/benz/proc.c
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)

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)
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

242
extlib/benz/string.c
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);
}

18
extlib/benz/symbol.c
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);

21
extlib/benz/vector.c
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);

6
extlib/benz/write.c
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);

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)