diff --git a/piclib/built-in.scm b/piclib/built-in.scm index 2ceec2e7..2dcaade4 100644 --- a/piclib/built-in.scm +++ b/piclib/built-in.scm @@ -457,38 +457,7 @@ (define (list->string list) (apply string list)) -(define (string-copy! to at from . opts) - (let ((start (if (pair? opts) (car opts) 0)) - (end (if (>= (length opts) 2) - (cadr opts) - (string-length from)))) - (do ((i at (+ i 1)) - (j start (+ j 1))) - ((= j end)) - (string-set! to i (string-ref from j))))) - -(define (string-copy v . opts) - (let ((start (if (pair? opts) (car opts) 0)) - (end (if (>= (length opts) 2) - (cadr opts) - (string-length v)))) - (let ((res (make-string (string-length v)))) - (string-copy! res 0 v start end) - res))) - -(define (string-fill! v fill . opts) - (let ((start (if (pair? opts) (car opts) 0)) - (end (if (>= (length opts) 2) - (cadr opts) - (string-length v)))) - (do ((i start (+ i 1))) - ((= i end) - #f) - (string-set! v i fill)))) - -(export string string->list list->string - string-copy! string-copy - string-append string-fill!) +(export string string->list list->string) ;;; 6.8. Vector diff --git a/src/string.c b/src/string.c index 4d5ea02f..0d9a639f 100644 --- a/src/string.c +++ b/src/string.c @@ -122,6 +122,52 @@ DEFINE_STRING_CMP(gt, >) DEFINE_STRING_CMP(le, <=) DEFINE_STRING_CMP(ge, >=) +static pic_value +pic_str_string_copy(pic_state *pic) +{ + size_t len, start, end, i; + char *str; + int n; + struct pic_string *copy; + + n = pic_get_args(pic, "s|ii", &str, &len, &start, &end); + + switch (n) { + case 1: + start = 0; + case 2: + end = len; + } + + copy = pic_str_new(pic, NULL, end - start); + for (i = 0; i < end - start; ++i) { + copy->str[i] = str[start + i]; + } + return pic_obj_value(copy); +} + +static pic_value +pic_str_string_copy_ip(pic_state *pic) +{ + size_t to_len, from_len, at, start, end; + char *to_str, *from_str; + int n; + + n = pic_get_args(pic, "sis|ii", &to_str, &to_len, &at, &from_str, &from_len, &start, &end); + + switch (n) { + case 3: + start = 0; + case 4: + end = from_len; + } + + while (start < end) { + to_str[at++] = from_str[start++]; + } + return pic_none_value(); +} + static pic_value pic_str_string_append(pic_state *pic) { @@ -145,6 +191,28 @@ pic_str_string_append(pic_state *pic) return pic_obj_value(pic_str_new(pic, buf, len)); } +static pic_value +pic_str_string_fill_ip(pic_state *pic) +{ + size_t len, start, end; + char *str, c; + int n; + + n = pic_get_args(pic, "sc|ii", &str, &len, &c, &start, &end); + + switch (n) { + case 1: + start = 0; + case 2: + end = len; + } + + while (start < end) { + str[start++] = c; + } + return pic_none_value(); +} + void pic_init_str(pic_state *pic) { @@ -153,10 +221,15 @@ pic_init_str(pic_state *pic) 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=?", pic_str_string_eq); pic_defun(pic, "string?", pic_str_string_gt); pic_defun(pic, "string<=?", pic_str_string_le); pic_defun(pic, "string>=?", pic_str_string_ge); + + pic_defun(pic, "string-copy", pic_str_string_copy); + pic_defun(pic, "string-copy!", pic_str_string_copy_ip); pic_defun(pic, "string-append", pic_str_string_append); + pic_defun(pic, "string-fill!", pic_str_string_fill_ip); }