picrin/extlib/benz/string.c

523 lines
11 KiB
C
Raw Normal View History

2014-08-25 00:38:09 -04:00
/**
* See Copyright Notice in picrin.h
*/
#include "picrin.h"
#include "picrin/string.h"
#include "picrin/pair.h"
#include "picrin/port.h"
#include "picrin/error.h"
2014-08-25 00:38:09 -04:00
static pic_str *
2014-09-12 06:52:49 -04:00
make_str_rope(pic_state *pic, xrope *rope)
2014-08-25 00:38:09 -04:00
{
pic_str *str;
str = (pic_str *)pic_obj_alloc(pic, sizeof(pic_str), PIC_TT_STRING);
str->rope = rope; /* delegate ownership */
return str;
}
pic_str *
2014-09-12 06:52:49 -04:00
pic_make_str(pic_state *pic, const char *imbed, size_t len)
2014-08-25 00:38:09 -04:00
{
if (imbed == NULL && len > 0) {
pic_errorf(pic, "zero length specified against NULL ptr");
}
2014-09-12 06:52:49 -04:00
return make_str_rope(pic, xr_new_copy(imbed, len));
2014-08-25 00:38:09 -04:00
}
pic_str *
2014-09-12 06:52:49 -04:00
pic_make_str_cstr(pic_state *pic, const char *cstr)
2014-08-25 00:38:09 -04:00
{
2014-09-12 06:52:49 -04:00
return pic_make_str(pic, cstr, strlen(cstr));
2014-08-25 00:38:09 -04:00
}
pic_str *
2014-09-12 06:52:49 -04:00
pic_make_str_fill(pic_state *pic, size_t len, char fill)
{
size_t i;
char *buf = pic_malloc(pic, len);
pic_str *str;
for (i = 0; i < len; ++i) {
2014-09-08 12:23:58 -04:00
buf[i] = fill;
}
2014-09-08 12:23:58 -04:00
buf[i] = '\0';
str = pic_make_str(pic, buf, len);
pic_free(pic, buf);
return str;
}
2014-08-25 00:38:09 -04:00
size_t
pic_strlen(pic_str *str)
{
return xr_len(str->rope);
}
char
pic_str_ref(pic_state *pic, pic_str *str, size_t i)
{
int c;
c = xr_at(str->rope, i);
if (c == -1) {
pic_errorf(pic, "index out of range %d", i);
}
return (char)c;
}
pic_str *
pic_strcat(pic_state *pic, pic_str *a, pic_str *b)
{
2014-09-12 06:52:49 -04:00
return make_str_rope(pic, xr_cat(a->rope, b->rope));
2014-08-25 00:38:09 -04:00
}
pic_str *
pic_substr(pic_state *pic, pic_str *str, size_t s, size_t e)
{
2014-09-12 06:52:49 -04:00
return make_str_rope(pic, xr_sub(str->rope, s, e));
2014-08-25 00:38:09 -04:00
}
int
pic_strcmp(pic_str *str1, pic_str *str2)
{
return strcmp(xr_cstr(str1->rope), xr_cstr(str2->rope));
}
const char *
pic_str_cstr(pic_str *str)
{
return xr_cstr(str->rope);
}
pic_value
2014-08-26 00:30:08 -04:00
pic_xvfformat(pic_state *pic, xFILE *file, const char *fmt, va_list ap)
2014-08-25 00:38:09 -04:00
{
char c;
pic_value irrs = pic_nil_value();
while ((c = *fmt++)) {
switch (c) {
default:
xfputc(c, file);
break;
case '%':
c = *fmt++;
if (! c)
goto exit;
switch (c) {
default:
xfputc(c, file);
break;
case '%':
xfputc('%', file);
break;
case 'c':
xfprintf(file, "%c", va_arg(ap, int));
break;
case 's':
xfprintf(file, "%s", va_arg(ap, const char *));
break;
case 'd':
xfprintf(file, "%d", va_arg(ap, int));
break;
case 'p':
xfprintf(file, "%p", va_arg(ap, void *));
break;
case 'f':
xfprintf(file, "%f", va_arg(ap, double));
break;
}
break;
case '~':
c = *fmt++;
if (! c)
goto exit;
switch (c) {
default:
xfputc(c, file);
break;
case '~':
xfputc('~', file);
break;
case '%':
xfputc('\n', file);
break;
case 'a':
irrs = pic_cons(pic, pic_fdisplay(pic, va_arg(ap, pic_value), file), irrs);
break;
case 's':
irrs = pic_cons(pic, pic_fwrite(pic, va_arg(ap, pic_value), file), irrs);
break;
}
break;
}
}
exit:
return pic_reverse(pic, irrs);
}
pic_value
2014-08-26 00:30:08 -04:00
pic_xvformat(pic_state *pic, const char *fmt, va_list ap)
2014-08-25 00:38:09 -04:00
{
struct pic_port *port;
pic_value irrs;
port = pic_open_output_string(pic);
2014-08-26 00:30:08 -04:00
irrs = pic_xvfformat(pic, port->file, fmt, ap);
2014-08-25 00:38:09 -04:00
irrs = pic_cons(pic, pic_obj_value(pic_get_output_string(pic, port)), irrs);
pic_close_port(pic, port);
return irrs;
}
pic_value
2014-08-26 00:30:08 -04:00
pic_xformat(pic_state *pic, const char *fmt, ...)
2014-08-25 00:38:09 -04:00
{
va_list ap;
pic_value objs;
va_start(ap, fmt);
2014-08-26 00:30:08 -04:00
objs = pic_xvformat(pic, fmt, ap);
2014-08-25 00:38:09 -04:00
va_end(ap);
return objs;
}
2014-08-26 00:30:08 -04:00
void
pic_vfformat(pic_state *pic, xFILE *file, const char *fmt, va_list ap)
{
pic_xvfformat(pic, file, fmt, ap);
}
pic_str *
pic_vformat(pic_state *pic, const char *fmt, va_list ap)
{
struct pic_port *port;
pic_str *str;
port = pic_open_output_string(pic);
pic_vfformat(pic, port->file, fmt, ap);
str = pic_get_output_string(pic, port);
pic_close_port(pic, port);
return str;
}
pic_str *
pic_format(pic_state *pic, const char *fmt, ...)
{
va_list ap;
pic_str *str;
va_start(ap, fmt);
str = pic_vformat(pic, fmt, ap);
va_end(ap);
return str;
}
2014-08-25 00:38:09 -04:00
static pic_value
pic_str_string_p(pic_state *pic)
{
pic_value v;
pic_get_args(pic, "o", &v);
return pic_bool_value(pic_str_p(v));
}
2014-09-12 07:23:58 -04:00
static pic_value
pic_str_string(pic_state *pic)
{
2014-09-27 07:17:02 -04:00
size_t argc, i;
2014-09-12 07:23:58 -04:00
pic_value *argv;
pic_str *str;
char *buf;
pic_get_args(pic, "*", &argc, &argv);
2014-09-27 04:18:11 -04:00
buf = pic_alloc(pic, (size_t)argc);
2014-09-12 07:23:58 -04:00
for (i = 0; i < argc; ++i) {
pic_assert_type(pic, argv[i], char);
buf[i] = pic_char(argv[i]);
}
2014-09-27 04:18:11 -04:00
str = pic_make_str(pic, buf, (size_t)argc);
2014-09-12 07:23:58 -04:00
pic_free(pic, buf);
return pic_obj_value(str);
}
static pic_value
pic_str_make_string(pic_state *pic)
{
2014-09-27 05:48:20 -04:00
size_t len;
char c = ' ';
2014-09-27 05:48:20 -04:00
pic_get_args(pic, "k|c", &len, &c);
2014-09-12 06:52:49 -04:00
return pic_obj_value(pic_make_str_fill(pic, len, c));
}
2014-08-25 00:38:09 -04:00
static pic_value
pic_str_string_length(pic_state *pic)
{
pic_str *str;
pic_get_args(pic, "s", &str);
2014-09-27 06:40:10 -04:00
return pic_size_value(pic_strlen(str));
2014-08-25 00:38:09 -04:00
}
static pic_value
pic_str_string_ref(pic_state *pic)
{
pic_str *str;
2014-09-27 05:48:20 -04:00
size_t k;
2014-08-25 00:38:09 -04:00
2014-09-27 05:48:20 -04:00
pic_get_args(pic, "sk", &str, &k);
2014-08-25 00:38:09 -04:00
return pic_char_value(pic_str_ref(pic, str, k));
}
#define DEFINE_STRING_CMP(name, op) \
static pic_value \
pic_str_string_##name(pic_state *pic) \
{ \
2014-09-27 07:17:02 -04:00
size_t argc, i; \
2014-08-25 00:38:09 -04:00
pic_value *argv; \
\
pic_get_args(pic, "*", &argc, &argv); \
\
if (argc < 1 || ! pic_str_p(argv[0])) { \
return pic_false_value(); \
} \
\
for (i = 1; i < argc; ++i) { \
if (! pic_str_p(argv[i])) { \
return pic_false_value(); \
} \
if (! (pic_strcmp(pic_str_ptr(argv[i-1]), pic_str_ptr(argv[i])) op 0)) { \
return pic_false_value(); \
} \
} \
return pic_true_value(); \
}
DEFINE_STRING_CMP(eq, ==)
DEFINE_STRING_CMP(lt, <)
DEFINE_STRING_CMP(gt, >)
DEFINE_STRING_CMP(le, <=)
DEFINE_STRING_CMP(ge, >=)
static pic_value
pic_str_string_copy(pic_state *pic)
{
pic_str *str;
2014-09-27 05:48:20 -04:00
int n;
size_t start, end;
2014-08-25 00:38:09 -04:00
2014-09-27 05:48:20 -04:00
n = pic_get_args(pic, "s|kk", &str, &start, &end);
2014-08-25 00:38:09 -04:00
switch (n) {
case 1:
start = 0;
case 2:
end = pic_strlen(str);
}
return pic_obj_value(pic_substr(pic, str, start, end));
}
static pic_value
pic_str_string_append(pic_state *pic)
{
2014-09-27 07:17:02 -04:00
size_t argc, i;
2014-08-25 00:38:09 -04:00
pic_value *argv;
pic_str *str;
pic_get_args(pic, "*", &argc, &argv);
2014-09-12 06:52:49 -04:00
str = pic_make_str(pic, NULL, 0);
2014-08-25 00:38:09 -04:00
for (i = 0; i < argc; ++i) {
if (! pic_str_p(argv[i])) {
2014-09-16 10:43:15 -04:00
pic_errorf(pic, "type error");
2014-08-25 00:38:09 -04:00
}
str = pic_strcat(pic, str, pic_str_ptr(argv[i]));
}
return pic_obj_value(str);
}
static pic_value
pic_str_string_map(pic_state *pic)
{
struct pic_proc *proc;
pic_value *argv, vals, val;
2014-09-27 07:17:02 -04:00
size_t argc, i, len, j;
pic_str *str;
char *buf;
pic_get_args(pic, "l*", &proc, &argc, &argv);
2015-01-27 10:40:39 -05:00
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_strlen(pic_str_ptr(argv[0]));
}
for (i = 1; i < argc; ++i) {
pic_assert_type(pic, argv[i], str);
len = len < pic_strlen(pic_str_ptr(argv[i]))
? len
: pic_strlen(pic_str_ptr(argv[i]));
}
buf = pic_malloc(pic, len);
pic_try {
for (i = 0; i < len; ++i) {
vals = pic_nil_value();
2014-09-27 07:17:02 -04:00
for (j = 0; j < argc; ++j) {
pic_push(pic, pic_char_value(pic_str_ref(pic, pic_str_ptr(argv[j]), i)), vals);
}
val = pic_apply(pic, proc, vals);
pic_assert_type(pic, val, char);
buf[i] = pic_char(val);
}
str = pic_make_str(pic, buf, len);
}
pic_catch {
pic_free(pic, buf);
pic_raise(pic, pic->err);
}
pic_free(pic, buf);
return pic_obj_value(str);
}
static pic_value
pic_str_string_for_each(pic_state *pic)
{
struct pic_proc *proc;
2014-09-27 07:17:02 -04:00
size_t argc, len, i, j;
2014-09-27 11:22:03 -04:00
pic_value *argv, vals;
pic_get_args(pic, "l*", &proc, &argc, &argv);
2015-01-27 10:40:39 -05:00
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_strlen(pic_str_ptr(argv[0]));
}
for (i = 1; i < argc; ++i) {
pic_assert_type(pic, argv[i], str);
len = len < pic_strlen(pic_str_ptr(argv[i]))
? len
: pic_strlen(pic_str_ptr(argv[i]));
}
for (i = 0; i < len; ++i) {
vals = pic_nil_value();
2014-09-27 07:17:02 -04:00
for (j = 0; j < argc; ++j) {
pic_push(pic, pic_char_value(pic_str_ref(pic, pic_str_ptr(argv[j]), i)), vals);
}
2014-09-27 11:22:03 -04:00
pic_apply(pic, proc, vals);
}
return pic_none_value();
}
2014-09-10 07:09:32 -04:00
static pic_value
pic_str_list_to_string(pic_state *pic)
{
pic_str *str;
2015-01-22 05:28:31 -05:00
pic_value list, e, it;
2014-09-27 05:48:20 -04:00
size_t i = 0;
char *buf;
2014-09-10 07:09:32 -04:00
pic_get_args(pic, "o", &list);
2014-09-21 02:32:55 -04:00
if (pic_length(pic, list) == 0) {
return pic_obj_value(pic_make_str(pic, NULL, 0));
}
buf = pic_malloc(pic, pic_length(pic, list));
2014-09-10 07:09:32 -04:00
pic_try {
2015-01-22 05:28:31 -05:00
pic_for_each (e, list, it) {
2014-09-21 02:32:55 -04:00
pic_assert_type(pic, e, char);
2014-09-10 07:09:32 -04:00
2014-09-21 02:32:55 -04:00
buf[i++] = pic_char(e);
}
2014-09-10 07:09:32 -04:00
2014-09-21 02:32:55 -04:00
str = pic_make_str(pic, buf, i);
}
pic_catch {
pic_free(pic, buf);
pic_raise(pic, pic->err);
}
pic_free(pic, buf);
return pic_obj_value(str);
2014-09-10 07:09:32 -04:00
}
static pic_value
pic_str_string_to_list(pic_state *pic)
{
pic_str *str;
pic_value list;
2014-09-27 05:48:20 -04:00
int n;
size_t start, end, i;
2014-09-10 07:09:32 -04:00
2014-09-27 05:48:20 -04:00
n = pic_get_args(pic, "s|kk", &str, &start, &end);
2014-09-10 07:09:32 -04:00
switch (n) {
case 1:
start = 0;
case 2:
2014-09-27 05:48:20 -04:00
end = pic_strlen(str);
2014-09-10 07:09:32 -04:00
}
list = pic_nil_value();
for (i = start; i < end; ++i) {
pic_push(pic, pic_char_value(pic_str_ref(pic, str, i)), list);
}
return pic_reverse(pic, list);
}
2014-08-25 00:38:09 -04:00
void
pic_init_str(pic_state *pic)
{
pic_defun(pic, "string?", pic_str_string_p);
2014-09-12 07:23:58 -04:00
pic_defun(pic, "string", pic_str_string);
pic_defun(pic, "make-string", pic_str_make_string);
2014-08-25 00:38:09 -04:00
pic_defun(pic, "string-length", pic_str_string_length);
pic_defun(pic, "string-ref", pic_str_string_ref);
2014-09-08 12:23:58 -04:00
pic_defun(pic, "string-copy", pic_str_string_copy);
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);
2014-09-10 07:09:32 -04:00
pic_defun(pic, "list->string", pic_str_list_to_string);
pic_defun(pic, "string->list", pic_str_string_to_list);
2014-08-25 00:38:09 -04:00
pic_defun(pic, "string=?", pic_str_string_eq);
pic_defun(pic, "string<?", pic_str_string_lt);
pic_defun(pic, "string>?", pic_str_string_gt);
pic_defun(pic, "string<=?", pic_str_string_le);
pic_defun(pic, "string>=?", pic_str_string_ge);
}