diff options
| -rw-r--r-- | src/scheme/ao_scheme.h | 5 | ||||
| -rw-r--r-- | src/scheme/ao_scheme_builtin.c | 30 | ||||
| -rw-r--r-- | src/scheme/ao_scheme_builtin.txt | 1 | ||||
| -rw-r--r-- | src/scheme/ao_scheme_string.c | 38 |
4 files changed, 65 insertions, 9 deletions
diff --git a/src/scheme/ao_scheme.h b/src/scheme/ao_scheme.h index 34fb2e88..68803462 100644 --- a/src/scheme/ao_scheme.h +++ b/src/scheme/ao_scheme.h @@ -710,7 +710,10 @@ struct ao_scheme_string * ao_scheme_string_copy(struct ao_scheme_string *a); struct ao_scheme_string * -ao_scheme_string_make(char *a); +ao_scheme_string_new(char *a); + +struct ao_scheme_string * +ao_scheme_make_string(int32_t len, char fill); struct ao_scheme_string * ao_scheme_atom_to_string(struct ao_scheme_atom *a); diff --git a/src/scheme/ao_scheme_builtin.c b/src/scheme/ao_scheme_builtin.c index 0da68778..0b84a89a 100644 --- a/src/scheme/ao_scheme_builtin.c +++ b/src/scheme/ao_scheme_builtin.c @@ -762,17 +762,39 @@ ao_scheme_do_string_set(struct ao_scheme_cons *cons) val = ao_scheme_arg_int(_ao_scheme_atom_string2dset21, cons, 2); if (ao_scheme_exception) return AO_SCHEME_NIL; + if (!val) + goto fail; while (*string && ref) { ++string; --ref; } if (!*string) - return ao_scheme_error(AO_SCHEME_INVALID, "%v: string %v ref %v invalid", - _ao_scheme_atom_string2dset21, - ao_scheme_arg(cons, 0), - ao_scheme_arg(cons, 1)); + goto fail; *string = val; return ao_scheme_int_poly(*string); +fail: + return ao_scheme_error(AO_SCHEME_INVALID, "%v: %v[%v] = %v invalid", + _ao_scheme_atom_string2dset21, + ao_scheme_arg(cons, 0), + ao_scheme_arg(cons, 1), + ao_scheme_arg(cons, 2)); +} + +ao_poly +ao_scheme_do_make_string(struct ao_scheme_cons *cons) +{ + int32_t len; + char fill; + + if (!ao_scheme_check_argc(_ao_scheme_atom_make2dstring, cons, 1, 2)) + return AO_SCHEME_NIL; + len = ao_scheme_arg_int(_ao_scheme_atom_make2dstring, cons, 0); + if (ao_scheme_exception) + return AO_SCHEME_NIL; + fill = ao_scheme_opt_arg_int(_ao_scheme_atom_make2dstring, cons, 1, ' '); + if (ao_scheme_exception) + return AO_SCHEME_NIL; + return ao_scheme_string_poly(ao_scheme_make_string(len, fill)); } ao_poly diff --git a/src/scheme/ao_scheme_builtin.txt b/src/scheme/ao_scheme_builtin.txt index bdadbd6a..4739f121 100644 --- a/src/scheme/ao_scheme_builtin.txt +++ b/src/scheme/ao_scheme_builtin.txt @@ -63,6 +63,7 @@ all f_lambda string_ref string-ref all f_lambda string_set string-set! all f_lambda string_copy string-copy all f_lambda string_length string-length +all f_lambda make_string make-string all f_lambda procedurep procedure? all lambda apply all f_lambda read_char read-char diff --git a/src/scheme/ao_scheme_string.c b/src/scheme/ao_scheme_string.c index dfc74966..2c636d7a 100644 --- a/src/scheme/ao_scheme_string.c +++ b/src/scheme/ao_scheme_string.c @@ -51,6 +51,7 @@ ao_scheme_string_alloc(int len) if (!s) return NULL; s->type = AO_SCHEME_STRING; + s->val[len] = '\0'; return s; } @@ -70,7 +71,19 @@ ao_scheme_string_copy(struct ao_scheme_string *a) } struct ao_scheme_string * -ao_scheme_string_make(char *a) +ao_scheme_make_string(int32_t len, char fill) +{ + struct ao_scheme_string *r; + + r = ao_scheme_string_alloc(len); + if (!r) + return NULL; + memset(r->val, fill, len); + return r; +} + +struct ao_scheme_string * +ao_scheme_string_new(char *a) { struct ao_scheme_string *r; @@ -138,7 +151,6 @@ ao_scheme_string_pack(struct ao_scheme_cons *cons) return ao_scheme_error(AO_SCHEME_INVALID, "non-int passed to pack"); cons = ao_scheme_cons_cdr(cons); } - *rval++ = 0; return ao_scheme_string_poly(r); } @@ -183,14 +195,32 @@ ao_scheme_string_write(ao_poly p, bool write) putchar('"'); while ((c = *sval++)) { switch (c) { + case '\a': + printf("\\a"); + break; + case '\b': + printf("\\b"); + break; + case '\t': + printf ("\\t"); + break; case '\n': printf ("\\n"); break; case '\r': printf ("\\r"); break; - case '\t': - printf ("\\t"); + case '\f': + printf("\\f"); + break; + case '\v': + printf("\\v"); + break; + case '\"': + printf("\\\""); + break; + case '\\': + printf("\\\\"); break; default: if (c < ' ') |