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;
57 struct ao_scheme_string *
58 ao_scheme_string_copy(struct ao_scheme_string *a)
60 int alen = strlen(a->val);
61 struct ao_scheme_string *r;
63 ao_scheme_string_stash(a);
64 r = ao_scheme_string_alloc(alen);
65 a = ao_scheme_string_fetch();
68 strcpy(r->val, a->val);
72 struct ao_scheme_string *
73 ao_scheme_string_make(char *a)
75 struct ao_scheme_string *r;
77 r = ao_scheme_string_alloc(strlen(a));
84 struct ao_scheme_string *
85 ao_scheme_atom_to_string(struct ao_scheme_atom *a)
87 int alen = strlen(a->name);
88 struct ao_scheme_string *r;
90 ao_scheme_atom_stash(a);
91 r = ao_scheme_string_alloc(alen);
92 a = ao_scheme_atom_fetch();
95 strcpy(r->val, a->name);
99 struct ao_scheme_string *
100 ao_scheme_string_cat(struct ao_scheme_string *a, struct ao_scheme_string *b)
102 int alen = strlen(a->val);
103 int blen = strlen(b->val);
104 struct ao_scheme_string *r;
106 ao_scheme_string_stash(a);
107 ao_scheme_string_stash(b);
108 r = ao_scheme_string_alloc(alen + blen);
109 b = ao_scheme_string_fetch();
110 a = ao_scheme_string_fetch();
113 strcpy(r->val, a->val);
114 strcpy(r->val+alen, b->val);
119 ao_scheme_string_pack(struct ao_scheme_cons *cons)
121 struct ao_scheme_string *r;
125 len = ao_scheme_cons_length(cons);
126 ao_scheme_cons_stash(cons);
127 r = ao_scheme_string_alloc(len);
128 cons = ao_scheme_cons_fetch();
130 return AO_SCHEME_NIL;
135 ao_poly car = cons->car;
136 *rval++ = ao_scheme_poly_integer(car, &fail);
138 return ao_scheme_error(AO_SCHEME_INVALID, "non-int passed to pack");
139 cons = ao_scheme_cons_cdr(cons);
142 return ao_scheme_string_poly(r);
146 ao_scheme_string_unpack(struct ao_scheme_string *a)
148 struct ao_scheme_cons *cons = NULL, *tail = NULL;
152 for (i = 0; (c = a->val[i]); i++) {
153 struct ao_scheme_cons *n;
154 ao_scheme_cons_stash(cons);
155 ao_scheme_cons_stash(tail);
156 ao_scheme_string_stash(a);
157 n = ao_scheme_cons_cons(ao_scheme_int_poly(c), AO_SCHEME_NIL);
158 a = ao_scheme_string_fetch();
159 tail = ao_scheme_cons_fetch();
160 cons = ao_scheme_cons_fetch();
167 tail->cdr = ao_scheme_cons_poly(n);
172 return ao_scheme_cons_poly(cons);
176 ao_scheme_string_write(ao_poly p, bool write)
178 struct ao_scheme_string *s = ao_scheme_poly_string(p);
184 while ((c = *sval++)) {
205 while ((c = *sval++))