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.
This commit is contained in:
parent
bafe4c81ef
commit
6b4a0ed8a2
|
@ -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);
|
||||
|
|
|
@ -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)))
|
||||
|
|
|
@ -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);
|
||||
|
|
15
src/string.c
15
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;
|
||||
}
|
||||
|
|
Loading…
Reference in New Issue