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

integrate mutable-string.c into the core

This commit is contained in:
Yuichi Nishiwaki 2016-02-21 01:04:55 +09:00
parent 53b760cfac
commit 2246cc42d9
5 changed files with 95 additions and 109 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

1
contrib/20.r7rs/nitro.mk
View File

@ -4,7 +4,6 @@ CONTRIB_SRCS += \
contrib/20.r7rs/src/r7rs.c\
contrib/20.r7rs/src/file.c\
contrib/20.r7rs/src/load.c\
contrib/20.r7rs/src/mutable-string.c\
contrib/20.r7rs/src/system.c\
contrib/20.r7rs/src/time.c

1
contrib/20.r7rs/scheme/base.scm
View File

@ -13,7 +13,6 @@
nan?
infinite?)
(picrin macro)
(picrin string)
(scheme file))
;; 4.1.2. Literal expressions

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

@ -1,104 +0,0 @@
#include "picrin.h"
#include "picrin/extra.h"
#include "picrin/object.h"
void
pic_str_update(pic_state *pic, pic_value dst, pic_value src)
{
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)
{
pic_value str, x, y, z;
char c;
int k, len;
pic_get_args(pic, "sic", &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)
{
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 = fromlen;
}
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)
{
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 = len;
}
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);
}
void
pic_init_mutable_string(pic_state *pic)
{
pic_deflibrary(pic, "picrin.string");
pic_defun(pic, "string-set!", pic_str_string_set);
pic_defun(pic, "string-copy!", pic_str_string_copy_ip);
pic_defun(pic, "string-fill!", pic_str_string_fill_ip);
}

2
contrib/20.r7rs/src/r7rs.c
View File

@ -6,7 +6,6 @@
void pic_init_file(pic_state *);
void pic_init_load(pic_state *);
void pic_init_mutable_string(pic_state *);
void pic_init_system(pic_state *);
void pic_init_time(pic_state *);
@ -15,7 +14,6 @@ pic_init_r7rs(pic_state *pic)
{
pic_init_file(pic);
pic_init_load(pic);
pic_init_mutable_string(pic);
pic_init_system(pic);
pic_init_time(pic);

96
extlib/benz/string.c
View File

@ -239,6 +239,14 @@ rope_cstr(pic_state *pic, struct pic_rope *x)
return c->str;
}
static void
str_update(pic_state *pic, pic_value dst, pic_value src)
{
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;
}
pic_value
pic_str_value(pic_state *pic, const char *str, int len)
{
@ -478,6 +486,28 @@ pic_str_string_ref(pic_state *pic)
return pic_char_value(pic, pic_str_ref(pic, str, k));
}
static pic_value
pic_str_string_set(pic_state *pic)
{
pic_value str, x, y, z;
char c;
int k, len;
pic_get_args(pic, "sic", &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);
str_update(pic, str, pic_str_cat(pic, x, pic_str_cat(pic, y, z)));
return pic_undef_value(pic);
}
#define DEFINE_STRING_CMP(name, op) \
static pic_value \
pic_str_string_##name(pic_state *pic) \
@ -530,6 +560,67 @@ pic_str_string_copy(pic_state *pic)
return pic_str_sub(pic, str, start, end);
}
static pic_value
pic_str_string_copy_ip(pic_state *pic)
{
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 = fromlen;
}
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);
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)
{
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 = len;
}
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);
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_append(pic_state *pic)
{
@ -661,7 +752,7 @@ pic_str_string_to_list(pic_state *pic)
}
return pic_reverse(pic, list);
}
void
pic_init_str(pic_state *pic)
{
@ -670,7 +761,10 @@ pic_init_str(pic_state *pic)
pic_defun(pic, "make-string", pic_str_make_string);
pic_defun(pic, "string-length", pic_str_string_length);
pic_defun(pic, "string-ref", pic_str_string_ref);
pic_defun(pic, "string-set!", pic_str_string_set);
pic_defun(pic, "string-copy", pic_str_string_copy);
pic_defun(pic, "string-copy!", pic_str_string_copy_ip);
pic_defun(pic, "string-fill!", pic_str_string_fill_ip);
pic_defun(pic, "string-append", pic_str_string_append);
pic_defun(pic, "string-map", pic_str_string_map);
pic_defun(pic, "string-for-each", pic_str_string_for_each);