core: Support string-set!

* src/string.c (string_set_x): New function.
* src/mes.c (mes_builtins): Add it.
* include/mes/builtins.h: Declare it.
* mes/module/mes/scm.mes (string-set!): Remove broken implementation.

include/mes/builtins.h

@@ -399,6 +399,7 @@ SCM read_string (SCM port);
 SCM string_append (SCM x);
 SCM string_length (SCM string);
 SCM string_ref (SCM str, SCM k);
+SCM string_set_x (SCM str, SCM k, SCM v);
 // src/struct.mes
 SCM make_struct (SCM type, SCM fields, SCM printer);
 SCM struct_length (SCM x);

mes/module/mes/scm.mes

@@ -205,9 +205,6 @@
 (define (make-string n . fill)
   (list->string (apply make-list n fill)))
 
-(define (string-set! s k v)
-  (list->string (list-set! (string->list s) k v)))
-
 (define (substring s start . rest)
   (let* ((end (and (pair? rest) (car rest)))
          (lst (list-tail (string->list s) start)))

src/mes.c

@@ -1729,6 +1729,7 @@ mes_builtins (SCM a)            ///((internal))
   a = init_builtin (builtin_type, "string-append", -1, (function1_t) & string_append, a);
   a = init_builtin (builtin_type, "string-length", 1, (function1_t) & string_length, a);
   a = init_builtin (builtin_type, "string-ref", 2, (function1_t) & string_ref, a);
+  a = init_builtin (builtin_type, "string-set!", 3, (function1_t) & string_set_x, a);
   // src/struct.mes
   a = init_builtin (builtin_type, "make-struct", 3, (function1_t) & make_struct, a);
   a = init_builtin (builtin_type, "struct-length", 1, (function1_t) & struct_length, a);

src/string.c

@@ -252,3 +252,18 @@ string_ref (SCM str, SCM k)
   char const *p = CSTRING (str);
   return MAKE_CHAR (p[i]);
 }
+
+SCM
+string_set_x (SCM str, SCM k, SCM v)
+{
+  assert (TYPE (str) == TSTRING);
+  assert (TYPE (k) == TNUMBER);
+  assert (TYPE (v) == TCHAR);
+  size_t size = LENGTH (str);
+  size_t i = VALUE (k);
+  if (i > size)
+    error (cell_symbol_system_error, cons (MAKE_STRING0 ("value out of range"), k));
+  char *p = CSTRING (str);
+  p[i] = VALUE (v);
+  return cell_unspecified;
+}