Add immutable-string with copy-on-write semantics (issue #860).

eval.c

@@ -2012,7 +2012,7 @@ void sexp_string_utf8_set (sexp ctx, sexp str, sexp index, sexp ch) {
   p = (unsigned char*)sexp_string_data(str) + i;
   old_len = sexp_utf8_initial_byte_count(*p);
   new_len = sexp_utf8_char_byte_count(c);
-  if (old_len != new_len) { /* resize bytes if needed */
+  if (sexp_copy_on_writep(str) || old_len != new_len) { /* resize bytes if needed */
     len = sexp_string_size(str)+(new_len-old_len);
     b = sexp_make_bytes(ctx, sexp_make_fixnum(len), SEXP_VOID);
     if (! sexp_exceptionp(b)) {
@@ -2023,6 +2023,7 @@ void sexp_string_utf8_set (sexp ctx, sexp str, sexp index, sexp ch) {
       p = q + i;
     }
     sexp_string_size(str) += new_len - old_len;
+    sexp_copy_on_writep(str) = 0;
   }
   sexp_utf8_encode_char(p, new_len, c);
   if (old_len != new_len)

include/chibi/sexp.h

@@ -442,6 +442,7 @@ struct sexp_struct {
   unsigned int freep:1;
   unsigned int brokenp:1;
   unsigned int syntacticp:1;
+  unsigned int copyonwritep:1;
 #if SEXP_USE_TRACK_ALLOC_SOURCE
   const char* source;
   void* backtrace[SEXP_BACKTRACE_SIZE];
@@ -773,6 +774,7 @@ void* sexp_alloc(sexp ctx, size_t size);
 #define sexp_freep(x)            ((x)->freep)
 #define sexp_brokenp(x)          ((x)->brokenp)
 #define sexp_pointer_magic(x)    ((x)->magic)
+#define sexp_copy_on_writep(x)   ((x)->copyonwritep)
 
 #if SEXP_USE_TRACK_ALLOC_SOURCE
 #define sexp_pointer_source(x)   ((x)->source)

lib/chibi/ast.c

@@ -372,6 +372,23 @@ sexp sexp_make_immutable_op (sexp ctx, sexp self, sexp_sint_t n, sexp x) {
   return SEXP_FALSE;
 }
 
+sexp sexp_immutable_string_op (sexp ctx, sexp self, sexp_sint_t n, sexp s) {
+  sexp res;
+  sexp_assert_type(ctx, sexp_stringp, SEXP_STRING, s);
+#if SEXP_USE_PACKED_STRINGS
+  /* no sharing with packed strings */
+  res = sexp_c_string(ctx, sexp_string_data(s), sexp_string_size(s));
+#else
+  res = sexp_alloc_type(ctx, string, SEXP_STRING);
+  sexp_string_bytes(res) = sexp_string_bytes(s);
+  sexp_string_offset(res) = sexp_string_offset(s);
+  sexp_string_size(res) = sexp_string_size(s);
+  sexp_copy_on_writep(s) = 1;
+#endif
+  sexp_immutablep(res) = 1;
+  return res;
+}
+
 sexp sexp_integer_to_immediate (sexp ctx, sexp self, sexp_sint_t n, sexp i, sexp dflt) {
   sexp x = (sexp)sexp_unbox_fixnum(i);
   sexp_assert_type(ctx, sexp_fixnump, SEXP_FIXNUM, i);
@@ -756,6 +773,7 @@ sexp sexp_init_library (sexp ctx, sexp self, sexp_sint_t n, sexp env, const char
   sexp_define_foreign(ctx, env, "object-size", 1, sexp_object_size);
   sexp_define_foreign(ctx, env, "immutable?", 1, sexp_immutablep_op);
   sexp_define_foreign(ctx, env, "make-immutable!", 1, sexp_make_immutable_op);
+  sexp_define_foreign(ctx, env, "immutable-string", 1, sexp_immutable_string_op);
   sexp_define_foreign_opt(ctx, env, "integer->immediate", 2, sexp_integer_to_immediate, SEXP_FALSE);
   sexp_define_foreign_opt(ctx, env, "object->integer", 1, sexp_object_to_integer, SEXP_FALSE);
   sexp_define_foreign(ctx, env, "gc", 0, sexp_gc_op);

lib/chibi/ast.sld

@@ -41,7 +41,7 @@
    atomically thread-list abort
    string-contains string-cursor-copy! errno integer->error-string
    flatten-dot update-free-vars! setenv unsetenv safe-setenv
-   immutable? make-immutable!
+   immutable? immutable-string make-immutable!
    thread-interrupt!
    chibi-version)
   (import (chibi))