X-Git-Url: https://git.gag.com/?p=fw%2Faltos;a=blobdiff_plain;f=src%2Fscheme%2Fao_scheme_vector.c;fp=src%2Fscheme%2Fao_scheme_vector.c;h=0000000000000000000000000000000000000000;hp=afdc89a86e880087f98fd2842d3c29bf7d307019;hb=ee79a205e118ea8730a02cc327d8fb79cc5f74ff;hpb=365eee3ebfe73204033089b363687228f97e5d98 diff --git a/src/scheme/ao_scheme_vector.c b/src/scheme/ao_scheme_vector.c deleted file mode 100644 index afdc89a8..00000000 --- a/src/scheme/ao_scheme_vector.c +++ /dev/null @@ -1,178 +0,0 @@ -/* - * Copyright © 2017 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" - -#ifdef AO_SCHEME_FEATURE_VECTOR - -static void vector_mark(void *addr) -{ - struct ao_scheme_vector *vector = addr; - unsigned int i; - - for (i = 0; i < vector->length; i++) { - ao_poly v = vector->vals[i]; - - ao_scheme_poly_mark(v, 1); - } -} - -static int vector_len_size(uint16_t length) -{ - return sizeof (struct ao_scheme_vector) + length * sizeof (ao_poly); -} - -static int vector_size(void *addr) -{ - struct ao_scheme_vector *vector = addr; - - return vector_len_size(vector->length); -} - -static void vector_move(void *addr) -{ - struct ao_scheme_vector *vector = addr; - unsigned int i; - - for (i = 0; i < vector->length; i++) - (void) ao_scheme_poly_move(&vector->vals[i], 1); -} - -const struct ao_scheme_type ao_scheme_vector_type = { - .mark = vector_mark, - .size = vector_size, - .move = vector_move, - .name = "vector", -}; - -struct ao_scheme_vector * -ao_scheme_vector_alloc(uint16_t length, ao_poly fill) -{ - struct ao_scheme_vector *vector; - unsigned int i; - - vector = ao_scheme_alloc(vector_len_size(length)); - if (!vector) - return NULL; - vector->type = AO_SCHEME_VECTOR; - vector->length = length; - for (i = 0; i < length; i++) - vector->vals[i] = fill; - return vector; -} - -void -ao_scheme_vector_write(ao_poly v, bool write) -{ - struct ao_scheme_vector *vector = ao_scheme_poly_vector(v); - unsigned int i; - int was_marked = 0; - - ao_scheme_print_start(); - was_marked = ao_scheme_print_mark_addr(vector); - if (was_marked) { - printf ("..."); - } else { - printf("#("); - for (i = 0; i < vector->length; i++) { - if (i != 0) - printf(" "); - ao_scheme_poly_write(vector->vals[i], write); - } - printf(")"); - } - if (ao_scheme_print_stop() && !was_marked) - ao_scheme_print_clear_addr(vector); -} - -static int32_t -ao_scheme_vector_offset(struct ao_scheme_vector *vector, ao_poly i) -{ - bool fail; - int32_t offset = ao_scheme_poly_integer(i, &fail); - - if (fail) - ao_scheme_error(AO_SCHEME_INVALID, "vector index %v not integer", i); - if (offset < 0 || vector->length <= offset) { - ao_scheme_error(AO_SCHEME_INVALID, "vector index %v out of range (max %d)", - i, vector->length); - offset = -1; - } - return offset; -} - -ao_poly -ao_scheme_vector_get(ao_poly v, ao_poly i) -{ - struct ao_scheme_vector *vector = ao_scheme_poly_vector(v); - int32_t offset = ao_scheme_vector_offset(vector, i); - - if (offset < 0) - return AO_SCHEME_NIL; - return vector->vals[offset]; -} - -ao_poly -ao_scheme_vector_set(ao_poly v, ao_poly i, ao_poly p) -{ - struct ao_scheme_vector *vector = ao_scheme_poly_vector(v); - int32_t offset = ao_scheme_vector_offset(vector, i); - - if (offset < 0) - return AO_SCHEME_NIL; - return vector->vals[offset] = p; -} - -struct ao_scheme_vector * -ao_scheme_list_to_vector(struct ao_scheme_cons *cons) -{ - uint16_t length; - uint16_t i; - struct ao_scheme_vector *vector; - - length = (uint16_t) ao_scheme_cons_length (cons); - if (ao_scheme_exception) - return NULL; - - ao_scheme_cons_stash(cons); - vector = ao_scheme_vector_alloc(length, AO_SCHEME_NIL); - cons = ao_scheme_cons_fetch(); - if (!vector) - return NULL; - i = 0; - while (cons) { - vector->vals[i++] = cons->car; - cons = ao_scheme_cons_cdr(cons); - } - return vector; -} - -struct ao_scheme_cons * -ao_scheme_vector_to_list(struct ao_scheme_vector *vector) -{ - unsigned int i; - uint16_t length = vector->length; - struct ao_scheme_cons *cons = NULL; - - for (i = length; i-- > 0;) { - ao_scheme_vector_stash(vector); - cons = ao_scheme_cons_cons(vector->vals[i], ao_scheme_cons_poly(cons)); - vector = ao_scheme_vector_fetch(); - if (!cons) - return NULL; - } - return cons; -} - -#endif /* AO_SCHEME_FEATURE_VECTOR */