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, either version 2 of the License, or
7 * (at your option) any later version.
9 * This program is distributed in the hope that it will be useful, but
10 * WITHOUT ANY WARRANTY; without even the implied warranty of
11 * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
12 * General Public License for more details.
15 #include "ao_scheme.h"
17 static void cons_mark(void *addr)
19 struct ao_scheme_cons *cons = addr;
22 ao_poly cdr = cons->cdr;
24 ao_scheme_poly_mark(cons->car, 1);
27 if (ao_scheme_poly_type(cdr) != AO_SCHEME_CONS) {
28 ao_scheme_poly_mark(cdr, 1);
31 cons = ao_scheme_poly_cons(cdr);
32 if (ao_scheme_mark_memory(&ao_scheme_cons_type, cons))
37 static int cons_size(void *addr)
40 return sizeof (struct ao_scheme_cons);
43 static void cons_move(void *addr)
45 struct ao_scheme_cons *cons = addr;
52 struct ao_scheme_cons *c;
55 MDBG_MOVE("cons_move start %d (%d, %d)\n",
56 MDBG_OFFSET(cons), MDBG_OFFSET(ao_scheme_ref(cons->car)), MDBG_OFFSET(ao_scheme_ref(cons->cdr)));
57 (void) ao_scheme_poly_move(&cons->car, 1);
61 if (ao_scheme_poly_base_type(cdr) != AO_SCHEME_CONS) {
62 (void) ao_scheme_poly_move(&cons->cdr, 0);
65 c = ao_scheme_poly_cons(cdr);
66 ret = ao_scheme_move_memory(&ao_scheme_cons_type, (void **) &c);
67 if (c != ao_scheme_poly_cons(cons->cdr))
68 cons->cdr = ao_scheme_cons_poly(c);
69 MDBG_MOVE("cons_move end %d (%d, %d)\n",
70 MDBG_OFFSET(cons), MDBG_OFFSET(ao_scheme_ref(cons->car)), MDBG_OFFSET(ao_scheme_ref(cons->cdr)));
77 const struct ao_scheme_type ao_scheme_cons_type = {
84 struct ao_scheme_cons *ao_scheme_cons_free_list;
86 struct ao_scheme_cons *
87 ao_scheme_cons_cons(ao_poly car, ao_poly cdr)
89 struct ao_scheme_cons *cons;
91 if (ao_scheme_cons_free_list) {
92 cons = ao_scheme_cons_free_list;
93 ao_scheme_cons_free_list = ao_scheme_poly_cons(cons->cdr);
95 ao_scheme_poly_stash(0, car);
96 ao_scheme_poly_stash(1, cdr);
97 cons = ao_scheme_alloc(sizeof (struct ao_scheme_cons));
98 cdr = ao_scheme_poly_fetch(1);
99 car = ao_scheme_poly_fetch(0);
108 struct ao_scheme_cons *
109 ao_scheme_cons_cdr(struct ao_scheme_cons *cons)
111 ao_poly cdr = cons->cdr;
112 if (cdr == AO_SCHEME_NIL)
114 if (ao_scheme_poly_type(cdr) != AO_SCHEME_CONS) {
115 (void) ao_scheme_error(AO_SCHEME_INVALID, "improper cdr %v", cdr);
118 return ao_scheme_poly_cons(cdr);
122 ao_scheme__cons(ao_poly car, ao_poly cdr)
124 return ao_scheme_cons_poly(ao_scheme_cons_cons(car, cdr));
127 struct ao_scheme_cons *
128 ao_scheme_cons_copy(struct ao_scheme_cons *cons)
130 struct ao_scheme_cons *head = NULL;
131 struct ao_scheme_cons *tail = NULL;
134 struct ao_scheme_cons *new;
137 ao_scheme_cons_stash(0, cons);
138 ao_scheme_cons_stash(1, head);
139 ao_scheme_poly_stash(0, ao_scheme_cons_poly(tail));
140 new = ao_scheme_alloc(sizeof (struct ao_scheme_cons));
141 cons = ao_scheme_cons_fetch(0);
142 head = ao_scheme_cons_fetch(1);
143 tail = ao_scheme_poly_cons(ao_scheme_poly_fetch(0));
145 return AO_SCHEME_NIL;
146 new->car = cons->car;
147 new->cdr = AO_SCHEME_NIL;
151 tail->cdr = ao_scheme_cons_poly(new);
154 if (ao_scheme_poly_type(cdr) != AO_SCHEME_CONS) {
158 cons = ao_scheme_poly_cons(cdr);
164 ao_scheme_cons_free(struct ao_scheme_cons *cons)
167 ao_scheme_cons_check(cons);
170 ao_poly cdr = cons->cdr;
171 cons->cdr = ao_scheme_cons_poly(ao_scheme_cons_free_list);
172 ao_scheme_cons_free_list = cons;
173 cons = ao_scheme_poly_cons(cdr);
178 ao_scheme_cons_write(ao_poly c)
180 struct ao_scheme_cons *cons = ao_scheme_poly_cons(c);
188 ao_scheme_poly_write(cons->car);
194 if (ao_scheme_poly_type(cdr) == AO_SCHEME_CONS) {
195 cons = ao_scheme_poly_cons(cdr);
199 ao_scheme_poly_write(cdr);
207 ao_scheme_cons_display(ao_poly c)
209 struct ao_scheme_cons *cons = ao_scheme_poly_cons(c);
213 ao_scheme_poly_display(cons->car);
219 if (ao_scheme_poly_type(cdr) == AO_SCHEME_CONS)
220 cons = ao_scheme_poly_cons(cdr);
222 ao_scheme_poly_display(cdr);
229 ao_scheme_cons_length(struct ao_scheme_cons *cons)
234 cons = ao_scheme_cons_cdr(cons);