ao_scheme_poly_mark(cons->car, 1);
if (!cdr)
break;
- if (ao_scheme_poly_type(cdr) != AO_SCHEME_CONS) {
- ao_scheme_poly_mark(cdr, 1);
+ if (!ao_scheme_is_cons(cdr)) {
+ ao_scheme_poly_mark(cdr, 0);
break;
}
cons = ao_scheme_poly_cons(cdr);
cdr = cons->cdr;
if (!cdr)
break;
- if (ao_scheme_poly_base_type(cdr) != AO_SCHEME_CONS) {
+ if (!ao_scheme_is_cons(cdr)) {
(void) ao_scheme_poly_move(&cons->cdr, 0);
break;
}
cons = ao_scheme_cons_free_list;
ao_scheme_cons_free_list = ao_scheme_poly_cons(cons->cdr);
} else {
- ao_scheme_poly_stash(0, car);
- ao_scheme_poly_stash(1, cdr);
+ ao_scheme_poly_stash(car);
+ ao_scheme_poly_stash(cdr);
cons = ao_scheme_alloc(sizeof (struct ao_scheme_cons));
- cdr = ao_scheme_poly_fetch(1);
- car = ao_scheme_poly_fetch(0);
+ cdr = ao_scheme_poly_fetch();
+ car = ao_scheme_poly_fetch();
if (!cons)
return NULL;
}
ao_poly cdr = cons->cdr;
if (cdr == AO_SCHEME_NIL)
return NULL;
- if (ao_scheme_poly_type(cdr) != AO_SCHEME_CONS) {
- (void) ao_scheme_error(AO_SCHEME_INVALID, "improper list");
+ if (!ao_scheme_is_cons(cdr)) {
+ (void) ao_scheme_error(AO_SCHEME_INVALID, "improper cdr %v", cdr);
return NULL;
}
return ao_scheme_poly_cons(cdr);
}
ao_poly
-ao_scheme__cons(ao_poly car, ao_poly cdr)
+ao_scheme_cons(ao_poly car, ao_poly cdr)
{
return ao_scheme_cons_poly(ao_scheme_cons_cons(car, cdr));
}
+struct ao_scheme_cons *
+ao_scheme_cons_copy(struct ao_scheme_cons *cons)
+{
+ struct ao_scheme_cons *head = NULL;
+ struct ao_scheme_cons *tail = NULL;
+
+ while (cons) {
+ struct ao_scheme_cons *new;
+ ao_poly cdr;
+
+ ao_scheme_cons_stash(cons);
+ ao_scheme_cons_stash(head);
+ ao_scheme_cons_stash(tail);
+ new = ao_scheme_alloc(sizeof (struct ao_scheme_cons));
+ tail = ao_scheme_cons_fetch();
+ head = ao_scheme_cons_fetch();
+ cons = ao_scheme_cons_fetch();
+ if (!new)
+ return AO_SCHEME_NIL;
+ new->car = cons->car;
+ new->cdr = AO_SCHEME_NIL;
+ if (!head)
+ head = new;
+ else
+ tail->cdr = ao_scheme_cons_poly(new);
+ tail = new;
+ cdr = cons->cdr;
+ if (!ao_scheme_is_cons(cdr)) {
+ tail->cdr = cdr;
+ break;
+ }
+ cons = ao_scheme_poly_cons(cdr);
+ }
+ return head;
+}
+
void
ao_scheme_cons_free(struct ao_scheme_cons *cons)
{
}
void
-ao_scheme_cons_write(ao_poly c)
+ao_scheme_cons_write(ao_poly c, bool write)
{
struct ao_scheme_cons *cons = ao_scheme_poly_cons(c);
+ struct ao_scheme_cons *clear = cons;
ao_poly cdr;
- int first = 1;
+ int written = 0;
+ ao_scheme_print_start();
printf("(");
while (cons) {
- if (!first)
+ if (written != 0)
printf(" ");
- ao_scheme_poly_write(cons->car);
- cdr = cons->cdr;
- if (cdr == c) {
- printf(" ...");
+
+ /* Note if there's recursion in printing. Not
+ * as good as actual references, but at least
+ * we don't infinite loop...
+ */
+ if (ao_scheme_print_mark_addr(cons)) {
+ printf("...");
break;
}
- if (ao_scheme_poly_type(cdr) == AO_SCHEME_CONS) {
- cons = ao_scheme_poly_cons(cdr);
- first = 0;
- } else {
+
+ ao_scheme_poly_write(cons->car, write);
+
+ /* keep track of how many pairs have been printed */
+ written++;
+
+ cdr = cons->cdr;
+ if (!ao_scheme_is_cons(cdr)) {
printf(" . ");
- ao_scheme_poly_write(cdr);
- cons = NULL;
+ ao_scheme_poly_write(cdr, write);
+ break;
}
+ cons = ao_scheme_poly_cons(cdr);
}
printf(")");
-}
-void
-ao_scheme_cons_display(ao_poly c)
-{
- struct ao_scheme_cons *cons = ao_scheme_poly_cons(c);
- ao_poly cdr;
+ if (ao_scheme_print_stop()) {
- while (cons) {
- ao_scheme_poly_display(cons->car);
- cdr = cons->cdr;
- if (cdr == c) {
- printf("...");
- break;
- }
- if (ao_scheme_poly_type(cdr) == AO_SCHEME_CONS)
- cons = ao_scheme_poly_cons(cdr);
- else {
- ao_scheme_poly_display(cdr);
- cons = NULL;
+ /* If we're still printing, clear the print marks on
+ * all printed pairs
+ */
+ while (written--) {
+ ao_scheme_print_clear_addr(clear);
+ clear = ao_scheme_poly_cons(clear->cdr);
}
}
}
int len = 0;
while (cons) {
len++;
- cons = ao_scheme_poly_cons(cons->cdr);
+ cons = ao_scheme_cons_cdr(cons);
}
return len;
}