X-Git-Url: https://git.gag.com/?a=blobdiff_plain;f=src%2Fscheme%2Fao_scheme_cons.c;h=0b3cbf809dc08666427414f66da42a98b88d0e3c;hb=e1a6b3bf458f311d832aea7eec34935d42f8efed;hp=03dad956d6561f59e31f4e79bc3004def0c3e2a9;hpb=195cbeec19a6a44f309a9040d727d37fe4e2ec97;p=fw%2Faltos

diff --git a/src/scheme/ao_scheme_cons.c b/src/scheme/ao_scheme_cons.c
index 03dad956..0b3cbf80 100644
--- a/src/scheme/ao_scheme_cons.c
+++ b/src/scheme/ao_scheme_cons.c
@@ -24,8 +24,8 @@ static void cons_mark(void *addr)
 		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);
@@ -58,7 +58,7 @@ static void cons_move(void *addr)
 		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;
 		}
@@ -112,7 +112,7 @@ ao_scheme_cons_cdr(struct ao_scheme_cons *cons)
 	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");
+		(void) ao_scheme_error(AO_SCHEME_INVALID, "improper cdr %v", cdr);
 		return NULL;
 	}
 	return ao_scheme_poly_cons(cdr);
@@ -124,6 +124,42 @@ 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(0, cons);
+		ao_scheme_cons_stash(1, head);
+		ao_scheme_poly_stash(0, ao_scheme_cons_poly(tail));
+		new = ao_scheme_alloc(sizeof (struct ao_scheme_cons));
+		cons = ao_scheme_cons_fetch(0);
+		head = ao_scheme_cons_fetch(1);
+		tail = ao_scheme_poly_cons(ao_scheme_poly_fetch(0));
+		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_poly_type(cdr) != AO_SCHEME_CONS) {
+			tail->cdr = cdr;
+			break;
+		}
+		cons = ao_scheme_poly_cons(cdr);
+	}
+	return head;
+}
+
 void
 ao_scheme_cons_free(struct ao_scheme_cons *cons)
 {
@@ -145,16 +181,17 @@ ao_scheme_cons_write(ao_poly c)
 	ao_poly			cdr;
 	int			first = 1;
 
+	ao_scheme_print_start();
 	printf("(");
 	while (cons) {
 		if (!first)
 			printf(" ");
-		ao_scheme_poly_write(cons->car);
-		cdr = cons->cdr;
-		if (cdr == c) {
-			printf(" ...");
+		if (ao_scheme_print_mark_addr(cons)) {
+			printf("...");
 			break;
 		}
+		ao_scheme_poly_write(cons->car);
+		cdr = cons->cdr;
 		if (ao_scheme_poly_type(cdr) == AO_SCHEME_CONS) {
 			cons = ao_scheme_poly_cons(cdr);
 			first = 0;
@@ -165,6 +202,7 @@ ao_scheme_cons_write(ao_poly c)
 		}
 	}
 	printf(")");
+	ao_scheme_print_stop();
 }
 
 void
@@ -173,13 +211,15 @@ ao_scheme_cons_display(ao_poly c)
 	struct ao_scheme_cons	*cons = ao_scheme_poly_cons(c);
 	ao_poly			cdr;
 
+	ao_scheme_print_start();
 	while (cons) {
-		ao_scheme_poly_display(cons->car);
-		cdr = cons->cdr;
-		if (cdr == c) {
+		if (ao_scheme_print_mark_addr(cons)) {
 			printf("...");
 			break;
 		}
+		ao_scheme_poly_display(cons->car);
+
+		cdr = cons->cdr;
 		if (ao_scheme_poly_type(cdr) == AO_SCHEME_CONS)
 			cons = ao_scheme_poly_cons(cdr);
 		else {
@@ -187,6 +227,7 @@ ao_scheme_cons_display(ao_poly c)
 			cons = NULL;
 		}
 	}
+	ao_scheme_print_stop();
 }
 
 int
@@ -195,7 +236,7 @@ ao_scheme_cons_length(struct ao_scheme_cons *cons)
 	int	len = 0;
 	while (cons) {
 		len++;
-		cons = ao_scheme_poly_cons(cons->cdr);
+		cons = ao_scheme_cons_cdr(cons);
 	}
 	return len;
 }