/* * Copyright © 2016 Keith Packard * * This program is free software; you can redistribute it and/or modify * it under the terms of the GNU General Public License as published by * the Free Software Foundation, either version 2 of the License, or * (at your option) any later version. * * This program is distributed in the hope that it will be useful, but * WITHOUT ANY WARRANTY; without even the implied warranty of * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU * General Public License for more details. */ #include "ao_scheme.h" static void cons_mark(void *addr) { struct ao_scheme_cons *cons = addr; for (;;) { ao_poly cdr = cons->cdr; 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); break; } cons = ao_scheme_poly_cons(cdr); if (ao_scheme_mark_memory(&ao_scheme_cons_type, cons)) break; } } static int cons_size(void *addr) { (void) addr; return sizeof (struct ao_scheme_cons); } static void cons_move(void *addr) { struct ao_scheme_cons *cons = addr; if (!cons) return; for (;;) { ao_poly cdr; struct ao_scheme_cons *c; int ret; MDBG_MOVE("cons_move start %d (%d, %d)\n", MDBG_OFFSET(cons), MDBG_OFFSET(ao_scheme_ref(cons->car)), MDBG_OFFSET(ao_scheme_ref(cons->cdr))); (void) ao_scheme_poly_move(&cons->car, 1); cdr = cons->cdr; if (!cdr) break; if (ao_scheme_poly_base_type(cdr) != AO_SCHEME_CONS) { (void) ao_scheme_poly_move(&cons->cdr, 0); break; } c = ao_scheme_poly_cons(cdr); ret = ao_scheme_move_memory(&ao_scheme_cons_type, (void **) &c); if (c != ao_scheme_poly_cons(cons->cdr)) cons->cdr = ao_scheme_cons_poly(c); MDBG_MOVE("cons_move end %d (%d, %d)\n", MDBG_OFFSET(cons), MDBG_OFFSET(ao_scheme_ref(cons->car)), MDBG_OFFSET(ao_scheme_ref(cons->cdr))); if (ret) break; cons = c; } } const struct ao_scheme_type ao_scheme_cons_type = { .mark = cons_mark, .size = cons_size, .move = cons_move, .name = "cons", }; struct ao_scheme_cons *ao_scheme_cons_free_list; struct ao_scheme_cons * ao_scheme_cons_cons(ao_poly car, ao_poly cdr) { struct ao_scheme_cons *cons; if (ao_scheme_cons_free_list) { 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); cons = ao_scheme_alloc(sizeof (struct ao_scheme_cons)); cdr = ao_scheme_poly_fetch(1); car = ao_scheme_poly_fetch(0); if (!cons) return NULL; } cons->car = car; cons->cdr = cdr; return cons; } struct ao_scheme_cons * ao_scheme_cons_cdr(struct ao_scheme_cons *cons) { 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 cdr %v", cdr); return NULL; } return ao_scheme_poly_cons(cdr); } ao_poly 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) { #if DBG_FREE_CONS ao_scheme_cons_check(cons); #endif while (cons) { ao_poly cdr = cons->cdr; cons->cdr = ao_scheme_cons_poly(ao_scheme_cons_free_list); ao_scheme_cons_free_list = cons; cons = ao_scheme_poly_cons(cdr); } } void ao_scheme_cons_write(ao_poly c) { struct ao_scheme_cons *cons = ao_scheme_poly_cons(c); ao_poly cdr; int first = 1; printf("("); while (cons) { if (!first) printf(" "); ao_scheme_poly_write(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); first = 0; } else { printf(" . "); ao_scheme_poly_write(cdr); cons = NULL; } } printf(")"); } void ao_scheme_cons_display(ao_poly c) { struct ao_scheme_cons *cons = ao_scheme_poly_cons(c); ao_poly cdr; 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; } } } int ao_scheme_cons_length(struct ao_scheme_cons *cons) { int len = 0; while (cons) { len++; cons = ao_scheme_cons_cdr(cons); } return len; }