switch string implementation to picrin's

contrib/03.mutable-string/mutable-string.c

@@ -6,18 +6,18 @@ 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) {
+  if (pic_str_len(str) <= i) {
     pic_errorf(pic, "index out of range %d", i);
   }
 
-  x = pic_substr(pic, str, 0, i);
+  x = pic_str_sub(pic, str, 0, i);
   y = pic_make_str_fill(pic, 1, c);
-  z = pic_substr(pic, str, i + 1, pic_strlen(str));
+  z = pic_str_sub(pic, str, i + 1, pic_str_len(str));
 
-  tmp = pic_strcat(pic, x, pic_strcat(pic, y, z));
+  tmp = pic_str_cat(pic, x, pic_str_cat(pic, y, z));
 
-  XROPE_INCREF(tmp->rope);
+  pic_rope_incref(pic, tmp->rope);
-  XROPE_DECREF(str->rope);
+  pic_rope_decref(pic, str->rope);
   str->rope = tmp->rope;
 }
 
@@ -46,10 +46,10 @@ pic_str_string_copy_ip(pic_state *pic)
   case 3:
     start = 0;
   case 4:
-    end = pic_strlen(from);
+    end = pic_str_len(from);
   }
   if (to == from) {
-    from = pic_substr(pic, from, 0, end);
+    from = pic_str_sub(pic, from, 0, end);
   }
 
   while (start < end) {
@@ -71,7 +71,7 @@ pic_str_string_fill_ip(pic_state *pic)
   case 2:
     start = 0;
   case 3:
-    end = pic_strlen(str);
+    end = pic_str_len(str);
   }
 
   while (start < end) {

contrib/03.system/src/system.c

@@ -111,7 +111,7 @@ pic_system_getenvs(pic_state *pic)
       ;
 
     key = pic_make_str(pic, *envp, i);
-    val = pic_make_str_cstr(pic, getenv(pic_str_cstr(key)));
+    val = pic_make_str_cstr(pic, getenv(pic_str_cstr(pic, key)));
 
     /* push */
     data = pic_acons(pic, pic_obj_value(key), pic_obj_value(val), data);

contrib/10.regexp/src/regexp.c

@@ -168,13 +168,13 @@ pic_regexp_regexp_replace(pic_state *pic)
   pic_assert_type(pic, reg, regexp);
 
   while (regexec(&pic_regexp_data_ptr(reg)->reg, input, 1, &match, 0) != REG_NOMATCH) {
-    output = pic_strcat(pic, output, pic_make_str(pic, input, match.rm_so));
+    output = pic_str_cat(pic, output, pic_make_str(pic, input, match.rm_so));
-    output = pic_strcat(pic, output, txt);
+    output = pic_str_cat(pic, output, txt);
 
     input += match.rm_eo;
   }
 
-  output = pic_strcat(pic, output, pic_make_str(pic, input, strlen(input)));
+  output = pic_str_cat(pic, output, pic_make_str(pic, input, strlen(input)));
 
   return pic_obj_value(output);
 }

extlib/benz/bool.c

@@ -9,9 +9,9 @@
 #include "picrin/string.h"
 
 static bool
-str_equal_p(struct pic_string *str1, struct pic_string *str2)
+str_equal_p(pic_state *pic, struct pic_string *str1, struct pic_string *str2)
 {
-  return pic_strcmp(str1, str2) == 0;
+  return pic_str_cmp(pic, str1, str2) == 0;
 }
 
 static bool
@@ -65,7 +65,7 @@ internal_equal_p(pic_state *pic, pic_value x, pic_value y, size_t depth, xhash *
 
   switch (pic_type(x)) {
   case PIC_TT_STRING:
-    return str_equal_p(pic_str_ptr(x), pic_str_ptr(y));
+    return str_equal_p(pic, pic_str_ptr(x), pic_str_ptr(y));
 
   case PIC_TT_BLOB:
     return blob_equal_p(pic_blob_ptr(x), pic_blob_ptr(y));

extlib/benz/debug.c

@@ -19,13 +19,13 @@ pic_get_backtrace(pic_state *pic)
   for (ci = pic->ci; ci != pic->cibase; --ci) {
     struct pic_proc *proc = pic_proc_ptr(ci->fp[0]);
 
-    trace = pic_strcat(pic, trace, pic_make_str_cstr(pic, "  at "));
+    trace = pic_str_cat(pic, trace, pic_make_str_cstr(pic, "  at "));
-    trace = pic_strcat(pic, trace, pic_make_str_cstr(pic, pic_symbol_name(pic, pic_proc_name(proc))));
+    trace = pic_str_cat(pic, trace, pic_make_str_cstr(pic, pic_symbol_name(pic, pic_proc_name(proc))));
 
     if (pic_proc_func_p(proc)) {
-      trace = pic_strcat(pic, trace, pic_make_str_cstr(pic, " (native function)\n"));
+      trace = pic_str_cat(pic, trace, pic_make_str_cstr(pic, " (native function)\n"));
     } else if (pic_proc_irep_p(proc)) {
-      trace = pic_strcat(pic, trace, pic_make_str_cstr(pic, " (unknown location)\n")); /* TODO */
+      trace = pic_str_cat(pic, trace, pic_make_str_cstr(pic, " (unknown location)\n")); /* TODO */
     }
   }
 
@@ -54,16 +54,16 @@ pic_print_backtrace(pic_state *pic)
     } else {
       trace = pic_make_str(pic, NULL, 0);
     }
-    trace = pic_strcat(pic, trace, pic_format(pic, "error: ~s", pic_obj_value(e->msg)));
+    trace = pic_str_cat(pic, trace, pic_format(pic, "error: ~s", pic_obj_value(e->msg)));
 
     /* TODO: print error irritants */
 
-    trace = pic_strcat(pic, trace, pic_make_str(pic, "\n", 1));
+    trace = pic_str_cat(pic, trace, pic_make_str(pic, "\n", 1));
-    trace = pic_strcat(pic, trace, e->stack);
+    trace = pic_str_cat(pic, trace, e->stack);
   }
 
   /* print! */
-  xfprintf(xstderr, "%s", pic_str_cstr(trace));
+  xfprintf(xstderr, "%s", pic_str_cstr(pic, trace));
 
   pic_gc_arena_restore(pic, ai);
 }

extlib/benz/error.c

@@ -29,7 +29,7 @@ pic_warnf(pic_state *pic, const char *fmt, ...)
   err_line = pic_xvformat(pic, fmt, ap);
   va_end(ap);
 
-  fprintf(stderr, "warn: %s\n", pic_str_cstr(pic_str_ptr(pic_car(pic, err_line))));
+  fprintf(stderr, "warn: %s\n", pic_str_cstr(pic, pic_str_ptr(pic_car(pic, err_line))));
 }
 
 void
@@ -43,7 +43,7 @@ pic_errorf(pic_state *pic, const char *fmt, ...)
   err_line = pic_xvformat(pic, fmt, ap);
   va_end(ap);
 
-  msg = pic_str_cstr(pic_str_ptr(pic_car(pic, err_line)));
+  msg = pic_str_cstr(pic, pic_str_ptr(pic_car(pic, err_line)));
   irrs = pic_cdr(pic, err_line);
 
   pic_error(pic, msg, irrs);
@@ -62,7 +62,7 @@ pic_errmsg(pic_state *pic)
     str = pic_error_ptr(pic->err)->msg;
   }
 
-  return pic_str_cstr(str);
+  return pic_str_cstr(pic, str);
 }
 
 static pic_value
@@ -260,7 +260,7 @@ pic_error_make_error_object(pic_state *pic)
 
   pic_get_args(pic, "ms*", &type, &msg, &argc, &argv);
 
-  e = pic_make_error(pic, type, pic_str_cstr(msg), pic_list_by_array(pic, argc, argv));
+  e = pic_make_error(pic, type, pic_str_cstr(pic, msg), pic_list_by_array(pic, argc, argv));
 
   return pic_obj_value(e);
 }

extlib/benz/gc.c

@@ -649,7 +649,7 @@ gc_finalize_object(pic_state *pic, struct pic_object *obj)
     break;
   }
   case PIC_TT_STRING: {
-    XROPE_DECREF(((struct pic_string *)obj)->rope);
+    pic_rope_decref(pic, ((struct pic_string *)obj)->rope);
     break;
   }
   case PIC_TT_PORT: {

extlib/benz/include/picrin.h

@@ -48,7 +48,6 @@ extern "C" {
 #include "picrin/xvect.h"
 #include "picrin/xhash.h"
 #include "picrin/xfile.h"
-#include "picrin/xrope.h"
 
 #include "picrin/value.h"
 

extlib/benz/include/picrin/string.h

@@ -11,9 +11,12 @@ extern "C" {
 
 struct pic_string {
   PIC_OBJECT_HEADER
-  xrope *rope;
+  struct pic_rope *rope;
 };
 
+void pic_rope_incref(pic_state *, struct pic_rope *);
+void pic_rope_decref(pic_state *, struct pic_rope *);
+
 #define pic_str_p(v) (pic_type(v) == PIC_TT_STRING)
 #define pic_str_ptr(o) ((struct pic_string *)pic_ptr(o))
 
@@ -21,14 +24,12 @@ pic_str *pic_make_str(pic_state *, const char * /* nullable */, size_t);
 pic_str *pic_make_str_cstr(pic_state *, const char *);
 pic_str *pic_make_str_fill(pic_state *, size_t, char);
 
-size_t pic_strlen(pic_str *);
 char pic_str_ref(pic_state *, pic_str *, size_t);
-
+size_t pic_str_len(pic_str *);
-pic_str *pic_strcat(pic_state *, pic_str *, pic_str *);
+pic_str *pic_str_cat(pic_state *, pic_str *, pic_str *);
-pic_str *pic_substr(pic_state *, pic_str *, size_t, size_t);
+pic_str *pic_str_sub(pic_state *, pic_str *, size_t, size_t);
-int pic_strcmp(pic_str *, pic_str *);
+int pic_str_cmp(pic_state *, pic_str *, pic_str *);
-
+const char *pic_str_cstr(pic_state *, pic_str *);
-const char *pic_str_cstr(pic_str *);
 
 pic_str *pic_format(pic_state *, const char *, ...);
 pic_str *pic_vformat(pic_state *, const char *, va_list);

extlib/benz/include/picrin/xrope.h

@@ -1,324 +0,0 @@
-#ifndef XROPE_H__
-#define XROPE_H__
-
-#if defined(__cplusplus)
-extern "C" {
-#endif
-
-/* public APIs */
-
-typedef struct xrope xrope;
-
-/**
- * | name         | frees buffer? | end with NULL? | complexity | misc
- * | ----         | ----          | ----           | ----       | ---
- * | xr_new_cstr  | no            | yes            | O(1)       | xr_new(_lit)
- * | xr_new_imbed | no            | no             | O(1)       |
- * | xr_new_move  | yes           | yes            | O(1)       |
- * | xr_new_copy  | yes           | no             | O(n)       |
- */
-
-#define xr_new(cstr) xr_new_cstr(cstr, strlen(cstr))
-#define xr_new_lit(cstr) xr_new_cstr(cstr, sizeof(cstr) - 1)
-PIC_INLINE xrope *xr_new_cstr(const char *, size_t);
-PIC_INLINE xrope *xr_new_imbed(const char *, size_t);
-PIC_INLINE xrope *xr_new_move(const char *, size_t);
-PIC_INLINE xrope *xr_new_copy(const char *, size_t);
-
-PIC_INLINE void XROPE_INCREF(xrope *);
-PIC_INLINE void XROPE_DECREF(xrope *);
-
-PIC_INLINE size_t xr_len(xrope *);
-PIC_INLINE char xr_at(xrope *, size_t);
-PIC_INLINE xrope *xr_cat(xrope *, xrope *);
-PIC_INLINE xrope *xr_sub(xrope *, size_t, size_t);
-PIC_INLINE const char *xr_cstr(xrope *); /* returns NULL-terminated string */
-
-
-/* impl */
-
-typedef struct {
-  char *str;
-  int refcnt;
-  size_t len;
-  char autofree, zeroterm;
-} xr_chunk;
-
-#define XR_CHUNK_INCREF(c) do {                 \
-    (c)->refcnt++;                              \
-  } while (0)
-
-#define XR_CHUNK_DECREF(c) do {                 \
-    xr_chunk *c__ = (c);                        \
-    if (! --c__->refcnt) {                      \
-      if (c__->autofree)                        \
-        free(c__->str);                         \
-      free(c__);                                \
-    }                                           \
-  } while (0)
-
-struct xrope {
-  int refcnt;
-  size_t weight;
-  xr_chunk *chunk;
-  size_t offset;
-  struct xrope *left, *right;
-};
-
-PIC_INLINE void
-XROPE_INCREF(xrope *x) {
-  x->refcnt++;
-}
-
-PIC_INLINE void
-XROPE_DECREF(xrope *x) {
-  if (! --x->refcnt) {
-    if (x->chunk) {
-      XR_CHUNK_DECREF(x->chunk);
-      free(x);
-      return;
-    }
-    XROPE_DECREF(x->left);
-    XROPE_DECREF(x->right);
-    free(x);
-  }
-}
-
-PIC_INLINE xrope *
-xr_new_cstr(const char *cstr, size_t len)
-{
-  xr_chunk *c;
-  xrope *x;
-
-  c = (xr_chunk *)malloc(sizeof(xr_chunk));
-  c->refcnt = 1;
-  c->str = (char *)cstr;
-  c->len = len;
-  c->autofree = 0;
-  c->zeroterm = 1;
-
-  x = (xrope *)malloc(sizeof(xrope));
-  x->refcnt = 1;
-  x->left = NULL;
-  x->right = NULL;
-  x->weight = c->len;
-  x->offset = 0;
-  x->chunk = c;
-
-  return x;
-}
-
-PIC_INLINE xrope *
-xr_new_imbed(const char *str, size_t len)
-{
-  xr_chunk *c;
-  xrope *x;
-
-  c = (xr_chunk *)malloc(sizeof(xr_chunk));
-  c->refcnt = 1;
-  c->str = (char *)str;
-  c->len = len;
-  c->autofree = 0;
-  c->zeroterm = 0;
-
-  x = (xrope *)malloc(sizeof(xrope));
-  x->refcnt = 1;
-  x->left = NULL;
-  x->right = NULL;
-  x->weight = c->len;
-  x->offset = 0;
-  x->chunk = c;
-
-  return x;
-}
-
-PIC_INLINE xrope *
-xr_new_move(const char *cstr, size_t len)
-{
-  xr_chunk *c;
-  xrope *x;
-
-  c = (xr_chunk *)malloc(sizeof(xr_chunk));
-  c->refcnt = 1;
-  c->str = (char *)cstr;
-  c->len = len;
-  c->autofree = 1;
-  c->zeroterm = 1;
-
-  x = (xrope *)malloc(sizeof(xrope));
-  x->refcnt = 1;
-  x->left = NULL;
-  x->right = NULL;
-  x->weight = c->len;
-  x->offset = 0;
-  x->chunk = c;
-
-  return x;
-}
-
-PIC_INLINE xrope *
-xr_new_copy(const char *str, size_t len)
-{
-  char *buf;
-  xr_chunk *c;
-  xrope *x;
-
-  buf = (char *)malloc(len + 1);
-  buf[len] = '\0';
-  memcpy(buf, str, len);
-
-  c = (xr_chunk *)malloc(sizeof(xr_chunk));
-  c->refcnt = 1;
-  c->str = buf;
-  c->len = len;
-  c->autofree = 1;
-  c->zeroterm = 1;
-
-  x = (xrope *)malloc(sizeof(xrope));
-  x->refcnt = 1;
-  x->left = NULL;
-  x->right = NULL;
-  x->weight = c->len;
-  x->offset = 0;
-  x->chunk = c;
-
-  return x;
-}
-
-PIC_INLINE size_t
-xr_len(xrope *x)
-{
-  return x->weight;
-}
-
-PIC_INLINE char
-xr_at(xrope *x, size_t i)
-{
-  if (x->weight <= i) {
-    return -1;
-  }
-  if (x->chunk) {
-    return x->chunk->str[x->offset + i];
-  }
-  return (i < x->left->weight)
-    ? xr_at(x->left, i)
-    : xr_at(x->right, i - x->left->weight);
-}
-
-PIC_INLINE xrope *
-xr_cat(xrope *x, xrope *y)
-{
-  xrope *z;
-
-  z = (xrope *)malloc(sizeof(xrope));
-  z->refcnt = 1;
-  z->left = x;
-  z->right = y;
-  z->weight = x->weight + y->weight;
-  z->offset = 0;
-  z->chunk = NULL;
-
-  XROPE_INCREF(x);
-  XROPE_INCREF(y);
-
-  return z;
-}
-
-PIC_INLINE struct xrope *
-xr_sub(xrope *x, size_t i, size_t j)
-{
-  assert(i <= j);
-  assert(j <= x->weight);
-
-  if (i == 0 && x->weight == j) {
-    XROPE_INCREF(x);
-    return x;
-  }
-
-  if (x->chunk) {
-    xrope *y;
-
-    y = (xrope *)malloc(sizeof(xrope));
-    y->refcnt = 1;
-    y->left = NULL;
-    y->right = NULL;
-    y->weight = j - i;
-    y->offset = x->offset + i;
-    y->chunk = x->chunk;
-
-    XR_CHUNK_INCREF(x->chunk);
-
-    return y;
-  }
-
-  if (j <= x->left->weight) {
-    return xr_sub(x->left, i, j);
-  }
-  else if (x->left->weight <= i) {
-    return xr_sub(x->right, i - x->left->weight, j - x->left->weight);
-  }
-  else {
-    xrope *r, *l;
-
-    l = xr_sub(x->left, i, x->left->weight);
-    r = xr_sub(x->right, 0, j - x->left->weight);
-    x = xr_cat(l, r);
-
-    XROPE_DECREF(l);
-    XROPE_DECREF(r);
-
-    return x;
-  }
-}
-
-PIC_INLINE void
-xr_fold(xrope *x, xr_chunk *c, size_t offset)
-{
-  if (x->chunk) {
-    memcpy(c->str + offset, x->chunk->str + x->offset, x->weight);
-    XR_CHUNK_DECREF(x->chunk);
-
-    x->chunk = c;
-    x->offset = offset;
-    XR_CHUNK_INCREF(c);
-    return;
-  }
-  xr_fold(x->left, c, offset);
-  xr_fold(x->right, c, offset + x->left->weight);
-
-  XROPE_DECREF(x->left);
-  XROPE_DECREF(x->right);
-  x->left = x->right = NULL;
-  x->chunk = c;
-  x->offset = offset;
-  XR_CHUNK_INCREF(c);
-}
-
-PIC_INLINE const char *
-xr_cstr(xrope *x)
-{
-  xr_chunk *c;
-
-  if (x->chunk && x->offset == 0 && x->weight == x->chunk->len && x->chunk->zeroterm) {
-    return x->chunk->str;       /* reuse cached chunk */
-  }
-
-  c = (xr_chunk *)malloc(sizeof(xr_chunk));
-  c->refcnt = 1;
-  c->len = x->weight;
-  c->autofree = 1;
-  c->zeroterm = 1;
-  c->str = (char *)malloc(c->len + 1);
-  c->str[c->len] = '\0';
-
-  xr_fold(x, c, 0);
-
-  XR_CHUNK_DECREF(c);
-  return c->str;
-}
-
-#if defined(__cplusplus)
-}
-#endif
-
-#endif

extlib/benz/port.c

@@ -415,7 +415,7 @@ pic_port_read_line(pic_state *pic)
   }
 
   str = pic_get_output_string(pic, buf);
-  if (pic_strlen(str) == 0 && c == EOF) {
+  if (pic_str_len(str) == 0 && c == EOF) {
     return pic_eof_object();
   }
   else {
@@ -456,7 +456,7 @@ pic_port_read_string(pic_state *pic){
   }
 
   str = pic_get_output_string(pic, buf);
-  if (pic_strlen(str) == 0 && c == EOF) {
+  if (pic_str_len(str) == 0 && c == EOF) {
     return pic_eof_object();
   }
   else {

extlib/benz/string.c

@@ -8,8 +8,93 @@
 #include "picrin/port.h"
 #include "picrin/error.h"
 
+struct pic_chunk {
+  char *str;
+  int refcnt;
+  size_t len;
+  char autofree;
+};
+
+struct pic_rope {
+  int refcnt;
+  size_t weight;
+  struct pic_chunk *chunk;
+  size_t offset;
+  struct pic_rope *left, *right;
+};
+
+#define CHUNK_INCREF(c) do {                    \
+    (c)->refcnt++;                              \
+  } while (0)
+
+#define CHUNK_DECREF(c) do {                    \
+    struct pic_chunk *c_ = (c);                 \
+    if (! --c_->refcnt) {                       \
+      if (c_->autofree)                         \
+        pic_free(pic, c_->str);                 \
+      pic_free(pic, c_);                         \
+    }                                           \
+  } while (0)
+
+void
+pic_rope_incref(pic_state *pic, struct pic_rope *x) {
+  PIC_UNUSED(pic);
+
+  x->refcnt++;
+}
+
+void
+pic_rope_decref(pic_state *pic, struct pic_rope *x) {
+  if (! --x->refcnt) {
+    if (x->chunk) {
+      CHUNK_DECREF(x->chunk);
+      pic_free(pic, x);
+      return;
+    }
+    pic_rope_decref(pic, x->left);
+    pic_rope_decref(pic, x->right);
+    pic_free(pic, x);
+  }
+}
+
+static struct pic_chunk *
+pic_make_chunk(pic_state *pic, const char *str, size_t len)
+{
+  char *buf;
+  struct pic_chunk *c;
+
+  buf = pic_malloc(pic, len + 1);
+  buf[len] = 0;
+
+  memcpy(buf, str, len);
+
+  c = pic_malloc(pic, sizeof(struct pic_chunk));
+  c->refcnt = 1;
+  c->str = buf;
+  c->len = len;
+  c->autofree = 1;
+
+  return c;
+}
+
+static struct pic_rope *
+pic_make_rope(pic_state *pic, struct pic_chunk *c)
+{
+  struct pic_rope *x;
+
+  x = pic_malloc(pic, sizeof(struct pic_rope));
+  x->refcnt = 1;
+  x->left = NULL;
+  x->right = NULL;
+  x->weight = c->len;
+  x->offset = 0;
+  x->chunk = c;                 /* delegate ownership */
+
+  return x;
+}
+
 static pic_str *
-make_str_rope(pic_state *pic, xrope *rope)
+pic_make_string(pic_state *pic, struct pic_rope *rope)
 {
   pic_str *str;
 
@@ -18,13 +103,147 @@ make_str_rope(pic_state *pic, xrope *rope)
   return str;
 }
 
-pic_str *
+static size_t
-pic_make_str(pic_state *pic, const char *imbed, size_t len)
+rope_len(struct pic_rope *x)
 {
-  if (imbed == NULL && len > 0) {
+  return x->weight;
+}
+
+static char
+rope_at(struct pic_rope *x, size_t i)
+{
+  while (i < x->weight) {
+    if (x->chunk) {
+      return x->chunk->str[x->offset + i];
+    }
+    if (i < x->left->weight) {
+      x = x->left;
+    } else {
+      x = x->right;
+      i -= x->left->weight;
+    }
+  }
+  return -1;
+}
+
+static struct pic_rope *
+rope_cat(pic_state *pic, struct pic_rope *x, struct pic_rope *y)
+{
+  struct pic_rope *z;
+
+  z = pic_malloc(pic, sizeof(struct pic_rope));
+  z->refcnt = 1;
+  z->left = x;
+  z->right = y;
+  z->weight = x->weight + y->weight;
+  z->offset = 0;
+  z->chunk = NULL;
+
+  pic_rope_incref(pic, x);
+  pic_rope_incref(pic, y);
+
+  return z;
+}
+
+static struct pic_rope *
+rope_sub(pic_state *pic, struct pic_rope *x, size_t i, size_t j)
+{
+  assert(i <= j);
+  assert(j <= x->weight);
+
+  if (i == 0 && x->weight == j) {
+    pic_rope_incref(pic, x);
+    return x;
+  }
+
+  if (x->chunk) {
+    struct pic_rope *y;
+
+    y = pic_malloc(pic, sizeof(struct pic_rope));
+    y->refcnt = 1;
+    y->left = NULL;
+    y->right = NULL;
+    y->weight = j - i;
+    y->offset = x->offset + i;
+    y->chunk = x->chunk;
+
+    CHUNK_INCREF(x->chunk);
+
+    return y;
+  }
+
+  if (j <= x->left->weight) {
+    return rope_sub(pic, x->left, i, j);
+  }
+  else if (x->left->weight <= i) {
+    return rope_sub(pic, x->right, i - x->left->weight, j - x->left->weight);
+  }
+  else {
+    struct pic_rope *r, *l;
+
+    l = rope_sub(pic, x->left, i, x->left->weight);
+    r = rope_sub(pic, x->right, 0, j - x->left->weight);
+    x = rope_cat(pic, l, r);
+
+    pic_rope_decref(pic, l);
+    pic_rope_decref(pic, r);
+
+    return x;
+  }
+}
+
+static void
+flatten(pic_state *pic, struct pic_rope *x, struct pic_chunk *c, size_t offset)
+{
+  if (x->chunk) {
+    memcpy(c->str + offset, x->chunk->str + x->offset, x->weight);
+    CHUNK_DECREF(x->chunk);
+
+    x->chunk = c;
+    x->offset = offset;
+    CHUNK_INCREF(c);
+    return;
+  }
+  flatten(pic, x->left, c, offset);
+  flatten(pic, x->right, c, offset + x->left->weight);
+
+  pic_rope_decref(pic, x->left);
+  pic_rope_decref(pic, x->right);
+  x->left = x->right = NULL;
+  x->chunk = c;
+  x->offset = offset;
+  CHUNK_INCREF(c);
+}
+
+static const char *
+rope_cstr(pic_state *pic, struct pic_rope *x)
+{
+  struct pic_chunk *c;
+
+  if (x->chunk && x->offset == 0 && x->weight == x->chunk->len) {
+    return x->chunk->str;       /* reuse cached chunk */
+  }
+
+  c = pic_malloc(pic, sizeof(struct pic_chunk));
+  c->refcnt = 1;
+  c->len = x->weight;
+  c->autofree = 1;
+  c->str = pic_malloc(pic, c->len + 1);
+  c->str[c->len] = '\0';
+
+  flatten(pic, x, c, 0);
+
+  CHUNK_DECREF(c);
+  return c->str;
+}
+
+pic_str *
+pic_make_str(pic_state *pic, const char *str, size_t len)
+{
+  if (str == NULL && len > 0) {
     pic_errorf(pic, "zero length specified against NULL ptr");
   }
-  return make_str_rope(pic, xr_new_copy(imbed, len));
+  return pic_make_string(pic, pic_make_rope(pic, pic_make_chunk(pic, str, len)));
 }
 
 pic_str *
@@ -53,9 +272,9 @@ pic_make_str_fill(pic_state *pic, size_t len, char fill)
 }
 
 size_t
-pic_strlen(pic_str *str)
+pic_str_len(pic_str *str)
 {
-  return xr_len(str->rope);
+  return rope_len(str->rope);
 }
 
 char
@@ -63,7 +282,7 @@ pic_str_ref(pic_state *pic, pic_str *str, size_t i)
 {
   int c;
 
-  c = xr_at(str->rope, i);
+  c = rope_at(str->rope, i);
   if (c == -1) {
     pic_errorf(pic, "index out of range %d", i);
   }
@@ -71,27 +290,27 @@ pic_str_ref(pic_state *pic, pic_str *str, size_t i)
 }
 
 pic_str *
-pic_strcat(pic_state *pic, pic_str *a, pic_str *b)
+pic_str_cat(pic_state *pic, pic_str *a, pic_str *b)
 {
-  return make_str_rope(pic, xr_cat(a->rope, b->rope));
+  return pic_make_string(pic, rope_cat(pic, a->rope, b->rope));
 }
 
 pic_str *
-pic_substr(pic_state *pic, pic_str *str, size_t s, size_t e)
+pic_str_sub(pic_state *pic, pic_str *str, size_t s, size_t e)
 {
-  return make_str_rope(pic, xr_sub(str->rope, s, e));
+  return pic_make_string(pic, rope_sub(pic, str->rope, s, e));
 }
 
 int
-pic_strcmp(pic_str *str1, pic_str *str2)
+pic_str_cmp(pic_state *pic, pic_str *str1, pic_str *str2)
 {
-  return strcmp(xr_cstr(str1->rope), xr_cstr(str2->rope));
+  return strcmp(pic_str_cstr(pic, str1), pic_str_cstr(pic, str2));
 }
 
 const char *
-pic_str_cstr(pic_str *str)
+pic_str_cstr(pic_state *pic, pic_str *str)
 {
-  return xr_cstr(str->rope);
+  return rope_cstr(pic, str->rope);
 }
 
 pic_value
@@ -275,7 +494,7 @@ pic_str_string_length(pic_state *pic)
 
   pic_get_args(pic, "s", &str);
 
-  return pic_size_value(pic_strlen(str));
+  return pic_size_value(pic_str_len(str));
 }
 
 static pic_value
@@ -306,7 +525,7 @@ pic_str_string_ref(pic_state *pic)
       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)) { \
+      if (! (pic_str_cmp(pic, pic_str_ptr(argv[i-1]), pic_str_ptr(argv[i])) op 0)) { \
 	return pic_false_value();                                       \
       }                                                                 \
     }                                                                   \
@@ -332,10 +551,10 @@ pic_str_string_copy(pic_state *pic)
   case 1:
     start = 0;
   case 2:
-    end = pic_strlen(str);
+    end = pic_str_len(str);
   }
 
-  return pic_obj_value(pic_substr(pic, str, start, end));
+  return pic_obj_value(pic_str_sub(pic, str, start, end));
 }
 
 static pic_value
@@ -352,7 +571,7 @@ pic_str_string_append(pic_state *pic)
     if (! pic_str_p(argv[i])) {
       pic_errorf(pic, "type error");
     }
-    str = pic_strcat(pic, str, pic_str_ptr(argv[i]));
+    str = pic_str_cat(pic, str, pic_str_ptr(argv[i]));
   }
   return pic_obj_value(str);
 }
@@ -372,14 +591,14 @@ pic_str_string_map(pic_state *pic)
     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]));
+    len = pic_str_len(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 = len < pic_str_len(pic_str_ptr(argv[i]))
       ? len
-      : pic_strlen(pic_str_ptr(argv[i]));
+      : pic_str_len(pic_str_ptr(argv[i]));
   }
   buf = pic_malloc(pic, len);
 
@@ -419,14 +638,14 @@ pic_str_string_for_each(pic_state *pic)
     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]));
+    len = pic_str_len(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 = len < pic_str_len(pic_str_ptr(argv[i]))
       ? len
-      : pic_strlen(pic_str_ptr(argv[i]));
+      : pic_str_len(pic_str_ptr(argv[i]));
   }
 
   for (i = 0; i < len; ++i) {
@@ -488,7 +707,7 @@ pic_str_string_to_list(pic_state *pic)
   case 1:
     start = 0;
   case 2:
-    end = pic_strlen(str);
+    end = pic_str_len(str);
   }
 
   list = pic_nil_value();

extlib/benz/symbol.c

@@ -23,15 +23,15 @@ pic_intern(pic_state *pic, pic_str *str)
   pic_sym *sym;
   char *cstr;
 
-  e = xh_get_str(&pic->syms, pic_str_cstr(str));
+  e = xh_get_str(&pic->syms, pic_str_cstr(pic, str));
   if (e) {
     sym = xh_val(e, pic_sym *);
     pic_gc_protect(pic, pic_obj_value(sym));
     return sym;
   }
 
-  cstr = pic_malloc(pic, pic_strlen(str) + 1);
+  cstr = pic_malloc(pic, pic_str_len(str) + 1);
-  strcpy(cstr, pic_str_cstr(str));
+  strcpy(cstr, pic_str_cstr(pic, str));
 
   sym = pic_make_symbol(pic, str);
   xh_put_str(&pic->syms, cstr, &sym);
@@ -55,7 +55,7 @@ pic_interned_p(pic_state *pic, pic_sym *sym)
 {
   xh_entry *e;
 
-  e = xh_get_str(&pic->syms, pic_str_cstr(sym->str));
+  e = xh_get_str(&pic->syms, pic_str_cstr(pic, sym->str));
   if (e) {
     return sym == xh_val(e, pic_sym *);
   } else {
@@ -66,9 +66,7 @@ pic_interned_p(pic_state *pic, pic_sym *sym)
 const char *
 pic_symbol_name(pic_state *pic, pic_sym *sym)
 {
-  PIC_UNUSED(pic);
+  return pic_str_cstr(pic, sym->str);
-
-  return pic_str_cstr(sym->str);
 }
 
 static pic_value

extlib/benz/vector.c

@@ -392,7 +392,7 @@ pic_vec_string_to_vector(pic_state *pic)
   case 1:
     start = 0;
   case 2:
-    end = pic_strlen(str);
+    end = pic_str_len(str);
   }
 
   if (end < start) {

extlib/benz/vm.c

@@ -254,7 +254,7 @@ pic_get_args(pic_state *pic, const char *format, ...)
       if (! pic_str_p(v)) {
         pic_errorf(pic, "pic_get_args: expected string, but got ~s", v);
       }
-      *cstr = pic_str_cstr(pic_str_ptr(v));
+      *cstr = pic_str_cstr(pic, pic_str_ptr(v));
       break;
     }
     case 'm': {
@@ -484,7 +484,7 @@ vm_push_env(pic_state *pic)
 {
   pic_callinfo *ci = pic->ci;
 
-  ci->env = (struct pic_env *)pic_obj_alloc(pic, offsetof(struct pic_env, storage) + sizeof(pic_value) * (size_t)(ci->regc), PIC_TT_ENV);
+  ci->env = (struct pic_env *)pic_obj_alloc(pic, sizeof(struct pic_env) + sizeof(pic_value) * (size_t)(ci->regc), PIC_TT_ENV);
   ci->env->up = ci->up;
   ci->env->regc = ci->regc;
   ci->env->regs = ci->regs;

extlib/benz/write.c

@@ -161,11 +161,11 @@ static void
 write_str(pic_state *pic, struct pic_string *str, xFILE *file)
 {
   size_t i;
-  const char *cstr = pic_str_cstr(str);
+  const char *cstr = pic_str_cstr(pic, str);
 
   PIC_UNUSED(pic);
 
-  for (i = 0; i < pic_strlen(str); ++i) {
+  for (i = 0; i < pic_str_len(str); ++i) {
     if (cstr[i] == '"' || cstr[i] == '\\') {
       xfputc('\\', file);
     }
@@ -197,7 +197,7 @@ write_record(pic_state *pic, struct pic_record *rec, xFILE *file)
   if (! pic_str_p(str)) {
     pic_errorf(pic, "return value from writer procedure is not of string type");
   }
-  xfprintf(file, "%s", pic_str_cstr(pic_str_ptr(str)));
+  xfprintf(file, "%s", pic_str_cstr(pic, pic_str_ptr(str)));
 
 #endif
 }
@@ -303,7 +303,7 @@ write_core(struct writer_control *p, pic_value obj)
     break;
   case PIC_TT_STRING:
     if (p->mode == DISPLAY_MODE) {
-      xfprintf(file, "%s", pic_str_cstr(pic_str_ptr(obj)));
+      xfprintf(file, "%s", pic_str_cstr(pic, pic_str_ptr(obj)));
       break;
     }
     xfprintf(file, "\"");
@@ -443,7 +443,7 @@ pic_printf(pic_state *pic, const char *fmt, ...)
 
   va_end(ap);
 
-  xprintf("%s", pic_str_cstr(str));
+  xprintf("%s", pic_str_cstr(pic, str));
   xfflush(xstdout);
 }