From 6556a2ec1dd9fe6c86ad37f87969d9a9872e75fe Mon Sep 17 00:00:00 2001
From: Yuichi Nishiwaki <yuichi.nishiwaki@gmail.com>
Date: Sun, 21 Sep 2014 15:33:52 +0900
Subject: [PATCH] spill out mutable-string nitro

---
 contrib/03.mutable-string/CMakeLists.txt   |  5 ++
 contrib/03.mutable-string/mutable-string.c | 91 ++++++++++++++++++++++
 contrib/05.r7rs/scheme/base.scm            |  3 +-
 extlib/benz                                |  2 +-
 piclib/picrin/base.scm                     |  3 -
 5 files changed, 99 insertions(+), 5 deletions(-)
 create mode 100644 contrib/03.mutable-string/CMakeLists.txt
 create mode 100644 contrib/03.mutable-string/mutable-string.c

diff --git a/contrib/03.mutable-string/CMakeLists.txt b/contrib/03.mutable-string/CMakeLists.txt
new file mode 100644
index 00000000..faa8402b
--- /dev/null
+++ b/contrib/03.mutable-string/CMakeLists.txt
@@ -0,0 +1,5 @@
+file(GLOB PICRIN_MUTABLE_STRING_SOURCES
+  ${PROJECT_SOURCE_DIR}/contrib/03.mutable-string/*.c)
+
+list(APPEND PICRIN_CONTRIB_INITS mutable_string)
+list(APPEND PICRIN_CONTRIB_SOURCES ${PICRIN_MUTABLE_STRING_SOURCES})
diff --git a/contrib/03.mutable-string/mutable-string.c b/contrib/03.mutable-string/mutable-string.c
new file mode 100644
index 00000000..de3ab2bc
--- /dev/null
+++ b/contrib/03.mutable-string/mutable-string.c
@@ -0,0 +1,91 @@
+#include "picrin.h"
+#include "picrin/string.h"
+
+void
+pic_str_set(pic_state *pic, pic_str *str, size_t i, char c)
+{
+  pic_str *x, *y, *z, *tmp;
+
+  if (pic_strlen(str) <= i) {
+    pic_errorf(pic, "index out of range %d", i);
+  }
+
+  x = pic_substr(pic, str, 0, i);
+  y = pic_make_str_fill(pic, 1, c);
+  z = pic_substr(pic, str, i + 1, pic_strlen(str));
+
+  tmp = pic_strcat(pic, x, pic_strcat(pic, y, z));
+
+  XROPE_INCREF(tmp->rope);
+  XROPE_DECREF(str->rope);
+  str->rope = tmp->rope;
+}
+
+static pic_value
+pic_str_string_set(pic_state *pic)
+{
+  pic_str *str;
+  char c;
+  int k;
+
+  pic_get_args(pic, "sic", &str, &k, &c);
+
+  pic_str_set(pic, str, k, c);
+  return pic_none_value();
+}
+
+static pic_value
+pic_str_string_copy_ip(pic_state *pic)
+{
+  pic_str *to, *from;
+  int n, at, start, end;
+
+  n = pic_get_args(pic, "sis|ii", &to, &at, &from, &start, &end);
+
+  switch (n) {
+  case 3:
+    start = 0;
+  case 4:
+    end = pic_strlen(from);
+  }
+  if (to == from) {
+    from = pic_substr(pic, from, 0, end);
+  }
+
+  while (start < end) {
+    pic_str_set(pic, to, at++, pic_str_ref(pic, from, start++));
+  }
+  return pic_none_value();
+}
+
+static pic_value
+pic_str_string_fill_ip(pic_state *pic)
+{
+  pic_str *str;
+  char c;
+  int n, start, end;
+
+  n = pic_get_args(pic, "sc|ii", &str, &c, &start, &end);
+
+  switch (n) {
+  case 2:
+    start = 0;
+  case 3:
+    end = pic_strlen(str);
+  }
+
+  while (start < end) {
+    pic_str_set(pic, str, start++, c);
+  }
+  return pic_none_value();
+}
+
+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);
+  }
+}
diff --git a/contrib/05.r7rs/scheme/base.scm b/contrib/05.r7rs/scheme/base.scm
index ece1bbd0..89d4b6a5 100644
--- a/contrib/05.r7rs/scheme/base.scm
+++ b/contrib/05.r7rs/scheme/base.scm
@@ -2,7 +2,8 @@
   (import (picrin base)
           (picrin macro)
           (picrin record)
-          (picrin syntax-rules))
+          (picrin syntax-rules)
+          (picrin string))
 
   ;; 4.1.2. Literal expressions
 
diff --git a/extlib/benz b/extlib/benz
index 851da542..db71ce9b 160000
--- a/extlib/benz
+++ b/extlib/benz
@@ -1 +1 @@
-Subproject commit 851da542b0fb5661044682d282b8a08c0216e12a
+Subproject commit db71ce9bfa0dabc860b13ec94e0d24b1e7fb2af0
diff --git a/piclib/picrin/base.scm b/piclib/picrin/base.scm
index d6c508b0..17497072 100644
--- a/piclib/picrin/base.scm
+++ b/piclib/picrin/base.scm
@@ -159,11 +159,8 @@
           make-string
           string-length
           string-ref
-          string-set!
           string-copy
-          string-copy!
           string-append
-          string-fill!
           string-map
           string-for-each
           string->list