altos/scheme: Add vectors

[fw/altos] / src / scheme / ao_scheme_builtin.c

diff --git a/src/scheme/ao_scheme_builtin.c b/src/scheme/ao_scheme_builtin.c
index aa8186463ef6e9ff800db683f7bf883e5591ab57..ae96df7f188690bbd30a6e15ebb1f77e9d09fc97 100644 (file)
--- a/src/scheme/ao_scheme_builtin.c
+++ b/src/scheme/ao_scheme_builtin.c
@@ -267,7 +267,6 @@ ao_scheme_do_write(struct ao_scheme_cons *cons)
                if (cons)
                        printf(" ");
        }
-       printf("\n");
        return _ao_scheme_bool_true;
 }
 
@@ -751,7 +750,7 @@ ao_poly
 ao_scheme_do_listp(struct ao_scheme_cons *cons)
 {
        ao_poly v;
-       if (!ao_scheme_check_argc(_ao_scheme_atom_led, cons, 1, 1))
+       if (!ao_scheme_check_argc(_ao_scheme_atom_list3f, cons, 1, 1))
                return AO_SCHEME_NIL;
        v = ao_scheme_arg(cons, 0);
        for (;;) {
@@ -864,5 +863,67 @@ ao_scheme_do_jiffies_per_second(struct ao_scheme_cons *cons)
        return (ao_scheme_int_poly(AO_SCHEME_JIFFIES_PER_SECOND));
 }
 
+ao_poly
+ao_scheme_do_vector(struct ao_scheme_cons *cons)
+{
+       return ao_scheme_vector_poly(ao_scheme_list_to_vector(cons));
+}
+
+ao_poly
+ao_scheme_do_vector_ref(struct ao_scheme_cons *cons)
+{
+       if (!ao_scheme_check_argc(_ao_scheme_atom_vector2dref, cons, 2, 2))
+               return AO_SCHEME_NIL;
+       if (!ao_scheme_check_argt(_ao_scheme_atom_vector2dref, cons, 0, AO_SCHEME_VECTOR, 0))
+               return AO_SCHEME_NIL;
+       return ao_scheme_vector_get(ao_scheme_arg(cons, 0), ao_scheme_arg(cons, 1));
+}
+
+ao_poly
+ao_scheme_do_vector_set(struct ao_scheme_cons *cons)
+{
+       if (!ao_scheme_check_argc(_ao_scheme_atom_vector2dset21, cons, 3, 3))
+               return AO_SCHEME_NIL;
+       if (!ao_scheme_check_argt(_ao_scheme_atom_vector2dset21, cons, 0, AO_SCHEME_VECTOR, 0))
+               return AO_SCHEME_NIL;
+       return ao_scheme_vector_set(ao_scheme_arg(cons, 0), ao_scheme_arg(cons, 1), ao_scheme_arg(cons, 2));
+}
+
+ao_poly
+ao_scheme_do_list_to_vector(struct ao_scheme_cons *cons)
+{
+       if (!ao_scheme_check_argc(_ao_scheme_atom_list2d3evector, cons, 1, 1))
+               return AO_SCHEME_NIL;
+       if (!ao_scheme_check_argt(_ao_scheme_atom_list2d3evector, cons, 0, AO_SCHEME_CONS, 0))
+               return AO_SCHEME_NIL;
+       return ao_scheme_vector_poly(ao_scheme_list_to_vector(ao_scheme_poly_cons(ao_scheme_arg(cons, 0))));
+}
+
+ao_poly
+ao_scheme_do_vector_to_list(struct ao_scheme_cons *cons)
+{
+       if (!ao_scheme_check_argc(_ao_scheme_atom_vector2d3elist, cons, 1, 1))
+               return AO_SCHEME_NIL;
+       if (!ao_scheme_check_argt(_ao_scheme_atom_vector2d3elist, cons, 0, AO_SCHEME_VECTOR, 0))
+               return AO_SCHEME_NIL;
+       return ao_scheme_cons_poly(ao_scheme_vector_to_list(ao_scheme_poly_vector(ao_scheme_arg(cons, 0))));
+}
+
+ao_poly
+ao_scheme_do_vector_length(struct ao_scheme_cons *cons)
+{
+       if (!ao_scheme_check_argc(_ao_scheme_atom_vector2d3elist, cons, 1, 1))
+               return AO_SCHEME_NIL;
+       if (!ao_scheme_check_argt(_ao_scheme_atom_vector2d3elist, cons, 0, AO_SCHEME_VECTOR, 0))
+               return AO_SCHEME_NIL;
+       return ao_scheme_integer_poly(ao_scheme_poly_vector(ao_scheme_arg(cons, 0))->length);
+}
+
+ao_poly
+ao_scheme_do_vectorp(struct ao_scheme_cons *cons)
+{
+       return ao_scheme_do_typep(AO_SCHEME_VECTOR, cons);
+}
+
 #define AO_SCHEME_BUILTIN_FUNCS
 #include "ao_scheme_builtin.h"