static int string_size(void *addr)
{
+ struct ao_scheme_string *string = addr;
if (!addr)
return 0;
- return strlen(addr) + 1;
+ return strlen(string->val) + 2;
}
static void string_move(void *addr)
.name = "string",
};
-char *
-ao_scheme_string_copy(char *a)
+static struct ao_scheme_string *
+ao_scheme_string_alloc(int len)
{
- int alen = strlen(a);
+ struct ao_scheme_string *s;
- ao_scheme_string_stash(0, a);
- char *r = ao_scheme_alloc(alen + 1);
- a = ao_scheme_string_fetch(0);
+ if (len < 0)
+ return NULL;
+ s = ao_scheme_alloc(len + 2);
+ if (!s)
+ return NULL;
+ s->type = AO_SCHEME_STRING;
+ s->val[len] = '\0';
+ return s;
+}
+
+struct ao_scheme_string *
+ao_scheme_string_new(char *a)
+{
+ struct ao_scheme_string *r;
+
+ r = ao_scheme_string_alloc(strlen(a));
if (!r)
return NULL;
- strcpy(r, a);
+ strcpy(r->val, a);
return r;
}
-char *
-ao_scheme_string_cat(char *a, char *b)
+struct ao_scheme_string *
+ao_scheme_atom_to_string(struct ao_scheme_atom *a)
{
- int alen = strlen(a);
- int blen = strlen(b);
+ int alen = strlen(a->name);
+ struct ao_scheme_string *r;
- ao_scheme_string_stash(0, a);
- ao_scheme_string_stash(1, b);
- char *r = ao_scheme_alloc(alen + blen + 1);
- a = ao_scheme_string_fetch(0);
- b = ao_scheme_string_fetch(1);
+ ao_scheme_atom_stash(a);
+ r = ao_scheme_string_alloc(alen);
+ a = ao_scheme_atom_fetch();
if (!r)
return NULL;
- strcpy(r, a);
- strcpy(r+alen, b);
+ strcpy(r->val, a->name);
return r;
}
-ao_poly
+struct ao_scheme_string *
+ao_scheme_string_cat(struct ao_scheme_string *a, struct ao_scheme_string *b)
+{
+ int alen = strlen(a->val);
+ int blen = strlen(b->val);
+ struct ao_scheme_string *r;
+
+ ao_scheme_string_stash(a);
+ ao_scheme_string_stash(b);
+ r = ao_scheme_string_alloc(alen + blen);
+ b = ao_scheme_string_fetch();
+ a = ao_scheme_string_fetch();
+ if (!r)
+ return NULL;
+ strcpy(r->val, a->val);
+ strcpy(r->val+alen, b->val);
+ return r;
+}
+
+static ao_poly
ao_scheme_string_pack(struct ao_scheme_cons *cons)
{
- int len = ao_scheme_cons_length(cons);
- ao_scheme_cons_stash(0, cons);
- char *r = ao_scheme_alloc(len + 1);
- cons = ao_scheme_cons_fetch(0);
- char *s = r;
+ struct ao_scheme_string *string;
+ char *s;
+ int len;
+
+ len = ao_scheme_cons_length(cons);
+ ao_scheme_cons_stash(cons);
+ string = ao_scheme_string_alloc(len);
+ cons = ao_scheme_cons_fetch();
+ if (!string)
+ return AO_SCHEME_NIL;
+ s = string->val;
while (cons) {
- if (!ao_scheme_integer_typep(ao_scheme_poly_type(cons->car)))
- return ao_scheme_error(AO_SCHEME_INVALID, "non-int passed to pack");
- *s++ = ao_scheme_poly_integer(cons->car);
- cons = ao_scheme_poly_cons(cons->cdr);
+ ao_poly car = cons->car;
+ int32_t c;
+ if (!ao_scheme_is_integer(car) || (c = ao_scheme_poly_integer(car)) == 0)
+ return ao_scheme_error(AO_SCHEME_INVALID, "%v: Invalid %v", _ao_scheme_atom_list2d3estring, car);
+ *s++ = c;
+ cons = ao_scheme_cons_cdr(cons);
}
- *s++ = 0;
- return ao_scheme_string_poly(r);
+ return ao_scheme_string_poly(string);
}
-ao_poly
-ao_scheme_string_unpack(char *a)
-{
- struct ao_scheme_cons *cons = NULL, *tail = NULL;
- int c;
- int i;
-
- for (i = 0; (c = a[i]); i++) {
- ao_scheme_cons_stash(0, cons);
- ao_scheme_cons_stash(1, tail);
- ao_scheme_string_stash(0, a);
- struct ao_scheme_cons *n = ao_scheme_cons_cons(ao_scheme_int_poly(c), AO_SCHEME_NIL);
- a = ao_scheme_string_fetch(0);
- cons = ao_scheme_cons_fetch(0);
- tail = ao_scheme_cons_fetch(1);
-
- if (!n) {
- cons = NULL;
+static ao_poly
+ao_scheme_string_unpack(struct ao_scheme_string *a)
+{
+ ao_poly cons = AO_SCHEME_NIL;
+ int i;
+
+ for (i = strlen(a->val); --i >= 0;) {
+ ao_scheme_string_stash(a);
+ cons = ao_scheme_cons(ao_scheme_int_poly(a->val[i]), cons);
+ a = ao_scheme_string_fetch();
+ if (!cons)
break;
- }
- if (tail)
- tail->cdr = ao_scheme_cons_poly(n);
- else
- cons = n;
- tail = n;
}
- return ao_scheme_cons_poly(cons);
+ return cons;
}
void
-ao_scheme_string_write(ao_poly p)
+ao_scheme_string_write(FILE *out, ao_poly p, bool write)
{
- char *s = ao_scheme_poly_string(p);
- char c;
+ struct ao_scheme_string *s = ao_scheme_poly_string(p);
+ char *sval = s->val;
+ char c;
- putchar('"');
- while ((c = *s++)) {
- switch (c) {
- case '\n':
- printf ("\\n");
- break;
- case '\r':
- printf ("\\r");
- break;
- case '\t':
- printf ("\\t");
- break;
- default:
- if (c < ' ')
- printf("\\%03o", c);
- else
- putchar(c);
- break;
+ if (write) {
+ putc('"', out);
+ while ((c = *sval++)) {
+ switch (c) {
+ case '\a':
+ fputs("\\a", out);
+ break;
+ case '\b':
+ fputs("\\b", out);
+ break;
+ case '\t':
+ fputs("\\t", out);
+ break;
+ case '\n':
+ fputs("\\n", out);
+ break;
+ case '\r':
+ fputs("\\r", out);
+ break;
+ case '\f':
+ fputs("\\f", out);
+ break;
+ case '\v':
+ fputs("\\v", out);
+ break;
+ case '\"':
+ fputs("\\\"", out);
+ break;
+ case '\\':
+ fputs("\\\\", out);
+ break;
+ default:
+ if ((uint8_t) c < ' ')
+ fprintf(out, "\\%03o", (uint8_t) c);
+ else
+ putc(c, out);
+ break;
+ }
}
+ putc('"', out);
+ } else {
+ while ((c = *sval++))
+ putc(c, out);
}
- putchar('"');
}
-void
-ao_scheme_string_display(ao_poly p)
+ao_poly
+ao_scheme_do_stringp(struct ao_scheme_cons *cons)
+{
+ return ao_scheme_do_typep(_ao_scheme_atom_string3f, AO_SCHEME_STRING, cons);
+}
+
+ao_poly
+ao_scheme_do_list_to_string(struct ao_scheme_cons *cons)
+{
+ struct ao_scheme_cons *list;
+
+ if (!ao_scheme_parse_args(_ao_scheme_atom_list2d3estring, cons,
+ AO_SCHEME_CONS, &list,
+ AO_SCHEME_ARG_END))
+ return AO_SCHEME_NIL;
+ return ao_scheme_string_pack(list);
+}
+
+ao_poly
+ao_scheme_do_string_to_list(struct ao_scheme_cons *cons)
+{
+ struct ao_scheme_string *string;
+
+ if (!ao_scheme_parse_args(_ao_scheme_atom_string2d3elist, cons,
+ AO_SCHEME_STRING, &string,
+ AO_SCHEME_ARG_END))
+ return AO_SCHEME_NIL;
+ return ao_scheme_string_unpack(string);
+}
+
+static char *
+ao_scheme_string_ref(struct ao_scheme_string *string, int32_t r)
+{
+ char *s = string->val;
+ while (*s && r) {
+ ++s;
+ --r;
+ }
+ return s;
+}
+
+ao_poly
+ao_scheme_do_string_ref(struct ao_scheme_cons *cons)
+{
+ struct ao_scheme_string *string;
+ int32_t ref;
+ char *s;
+
+ if (!ao_scheme_parse_args(_ao_scheme_atom_string2dref, cons,
+ AO_SCHEME_STRING, &string,
+ AO_SCHEME_INT, &ref,
+ AO_SCHEME_ARG_END))
+ return AO_SCHEME_NIL;
+
+ s = ao_scheme_string_ref(string, ref);
+ if (!*s)
+ return ao_scheme_error(AO_SCHEME_INVALID, "%v: string %v ref %v invalid",
+ _ao_scheme_atom_string2dref,
+ cons->car,
+ ao_scheme_arg(cons, 1));
+ return ao_scheme_integer_poly(*s);
+}
+
+ao_poly
+ao_scheme_do_string_length(struct ao_scheme_cons *cons)
+{
+ struct ao_scheme_string *string;
+
+ if (!ao_scheme_parse_args(_ao_scheme_atom_string2dlength, cons,
+ AO_SCHEME_STRING, &string,
+ AO_SCHEME_ARG_END))
+ return AO_SCHEME_NIL;
+ return ao_scheme_integer_poly(strlen(string->val));
+}
+
+ao_poly
+ao_scheme_do_string_set(struct ao_scheme_cons *cons)
+{
+ struct ao_scheme_string *string;
+ int32_t ref;
+ int32_t val;
+ char *s;
+
+ if (!ao_scheme_parse_args(_ao_scheme_atom_string2dset21, cons,
+ AO_SCHEME_STRING, &string,
+ AO_SCHEME_INT, &ref,
+ AO_SCHEME_INT, &val,
+ AO_SCHEME_ARG_END))
+ return AO_SCHEME_NIL;
+ if (!val)
+ goto fail;
+ s = ao_scheme_string_ref(string, ref);
+ if (!*s)
+ goto fail;
+ *s = val;
+ return ao_scheme_integer_poly(val);
+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;
+ int32_t fill;
+ struct ao_scheme_string *string;
+
+ if (!ao_scheme_parse_args(_ao_scheme_atom_make2dstring, cons,
+ AO_SCHEME_INT, &len,
+ AO_SCHEME_INT|AO_SCHEME_ARG_OPTIONAL, ao_scheme_int_poly(' '), &fill,
+ AO_SCHEME_ARG_END))
+ return AO_SCHEME_NIL;
+ if (!fill)
+ return ao_scheme_error(AO_SCHEME_INVALID, "%v: fill 0 invalid",
+ _ao_scheme_atom_make2dstring);
+ string = ao_scheme_string_alloc(len);
+ if (!string)
+ return AO_SCHEME_NIL;
+ memset(string->val, fill, len);
+ return ao_scheme_string_poly(string);
+}
+
+ao_poly
+ao_scheme_do_symbol_to_string(struct ao_scheme_cons *cons)
+{
+ struct ao_scheme_atom *atom;
+
+ if (!ao_scheme_parse_args(_ao_scheme_atom_symbol2d3estring, cons,
+ AO_SCHEME_ATOM, &atom,
+ AO_SCHEME_ARG_END))
+ return AO_SCHEME_NIL;
+ return ao_scheme_string_poly(ao_scheme_atom_to_string(atom));
+}
+
+ao_poly
+ao_scheme_do_string_to_symbol(struct ao_scheme_cons *cons)
{
- char *s = ao_scheme_poly_string(p);
- char c;
+ struct ao_scheme_string *string;
- while ((c = *s++))
- putchar(c);
+ if (!ao_scheme_parse_args(_ao_scheme_atom_string2d3esymbol, cons,
+ AO_SCHEME_STRING, &string,
+ AO_SCHEME_ARG_END))
+ return AO_SCHEME_NIL;
+ return ao_scheme_atom_poly(ao_scheme_string_to_atom(string));
}
projects / fw / altos / blobdiff