2 * Copyright © 2016 Keith Packard <keithp@keithp.com>
4 * This program is free software; you can redistribute it and/or modify
5 * it under the terms of the GNU General Public License as published by
6 * the Free Software Foundation; version 2 of the License.
8 * This program is distributed in the hope that it will be useful, but
9 * WITHOUT ANY WARRANTY; without even the implied warranty of
10 * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
11 * General Public License for more details.
13 * You should have received a copy of the GNU General Public License along
14 * with this program; if not, write to the Free Software Foundation, Inc.,
15 * 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA.
18 #include "ao_scheme.h"
20 static void string_mark(void *addr)
25 static int string_size(void *addr)
29 return strlen(addr) + 1;
32 static void string_move(void *addr)
37 const struct ao_scheme_type ao_scheme_string_type = {
45 ao_scheme_string_copy(char *a)
50 ao_scheme_string_stash(0, a);
51 r = ao_scheme_alloc(alen + 1);
52 a = ao_scheme_string_fetch(0);
60 ao_scheme_string_cat(char *a, char *b)
66 ao_scheme_string_stash(0, a);
67 ao_scheme_string_stash(1, b);
68 r = ao_scheme_alloc(alen + blen + 1);
69 a = ao_scheme_string_fetch(0);
70 b = ao_scheme_string_fetch(1);
79 ao_scheme_string_pack(struct ao_scheme_cons *cons)
85 len = ao_scheme_cons_length(cons);
86 ao_scheme_cons_stash(0, cons);
87 r = ao_scheme_alloc(len + 1);
88 cons = ao_scheme_cons_fetch(0);
92 if (!ao_scheme_integer_typep(ao_scheme_poly_type(cons->car)))
93 return ao_scheme_error(AO_SCHEME_INVALID, "non-int passed to pack");
94 *s++ = ao_scheme_poly_integer(cons->car);
95 cons = ao_scheme_poly_cons(cons->cdr);
98 return ao_scheme_string_poly(r);
102 ao_scheme_string_unpack(char *a)
104 struct ao_scheme_cons *cons = NULL, *tail = NULL;
108 for (i = 0; (c = a[i]); i++) {
109 struct ao_scheme_cons *n;
110 ao_scheme_cons_stash(0, cons);
111 ao_scheme_cons_stash(1, tail);
112 ao_scheme_string_stash(0, a);
113 n = ao_scheme_cons_cons(ao_scheme_int_poly(c), AO_SCHEME_NIL);
114 a = ao_scheme_string_fetch(0);
115 cons = ao_scheme_cons_fetch(0);
116 tail = ao_scheme_cons_fetch(1);
123 tail->cdr = ao_scheme_cons_poly(n);
128 return ao_scheme_cons_poly(cons);
132 ao_scheme_string_write(ao_poly p)
134 char *s = ao_scheme_poly_string(p);
161 ao_scheme_string_display(ao_poly p)
163 char *s = ao_scheme_poly_string(p);