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)
27 struct ao_scheme_string *string = addr;
30 return strlen(string->val) + 2;
33 static void string_move(void *addr)
38 const struct ao_scheme_type ao_scheme_string_type = {
45 static struct ao_scheme_string *
46 ao_scheme_string_alloc(int len)
48 struct ao_scheme_string *s;
50 s = ao_scheme_alloc(len + 2);
53 s->type = AO_SCHEME_STRING;
58 struct ao_scheme_string *
59 ao_scheme_string_copy(struct ao_scheme_string *a)
61 int alen = strlen(a->val);
62 struct ao_scheme_string *r;
64 ao_scheme_string_stash(a);
65 r = ao_scheme_string_alloc(alen);
66 a = ao_scheme_string_fetch();
69 strcpy(r->val, a->val);
73 struct ao_scheme_string *
74 ao_scheme_make_string(int32_t len, char fill)
76 struct ao_scheme_string *r;
78 r = ao_scheme_string_alloc(len);
81 memset(r->val, fill, len);
85 struct ao_scheme_string *
86 ao_scheme_string_new(char *a)
88 struct ao_scheme_string *r;
90 r = ao_scheme_string_alloc(strlen(a));
97 struct ao_scheme_string *
98 ao_scheme_atom_to_string(struct ao_scheme_atom *a)
100 int alen = strlen(a->name);
101 struct ao_scheme_string *r;
103 ao_scheme_atom_stash(a);
104 r = ao_scheme_string_alloc(alen);
105 a = ao_scheme_atom_fetch();
108 strcpy(r->val, a->name);
112 struct ao_scheme_string *
113 ao_scheme_string_cat(struct ao_scheme_string *a, struct ao_scheme_string *b)
115 int alen = strlen(a->val);
116 int blen = strlen(b->val);
117 struct ao_scheme_string *r;
119 ao_scheme_string_stash(a);
120 ao_scheme_string_stash(b);
121 r = ao_scheme_string_alloc(alen + blen);
122 b = ao_scheme_string_fetch();
123 a = ao_scheme_string_fetch();
126 strcpy(r->val, a->val);
127 strcpy(r->val+alen, b->val);
132 ao_scheme_string_pack(struct ao_scheme_cons *cons)
134 struct ao_scheme_string *r;
138 len = ao_scheme_cons_length(cons);
139 ao_scheme_cons_stash(cons);
140 r = ao_scheme_string_alloc(len);
141 cons = ao_scheme_cons_fetch();
143 return AO_SCHEME_NIL;
148 ao_poly car = cons->car;
149 *rval++ = ao_scheme_poly_integer(car, &fail);
151 return ao_scheme_error(AO_SCHEME_INVALID, "non-int passed to pack");
152 cons = ao_scheme_cons_cdr(cons);
154 return ao_scheme_string_poly(r);
158 ao_scheme_string_unpack(struct ao_scheme_string *a)
160 struct ao_scheme_cons *cons = NULL, *tail = NULL;
164 for (i = 0; (c = a->val[i]); i++) {
165 struct ao_scheme_cons *n;
166 ao_scheme_cons_stash(cons);
167 ao_scheme_cons_stash(tail);
168 ao_scheme_string_stash(a);
169 n = ao_scheme_cons_cons(ao_scheme_int_poly(c), AO_SCHEME_NIL);
170 a = ao_scheme_string_fetch();
171 tail = ao_scheme_cons_fetch();
172 cons = ao_scheme_cons_fetch();
179 tail->cdr = ao_scheme_cons_poly(n);
184 return ao_scheme_cons_poly(cons);
188 ao_scheme_string_write(ao_poly p, bool write)
190 struct ao_scheme_string *s = ao_scheme_poly_string(p);
196 while ((c = *sval++)) {
235 while ((c = *sval++))