altos/scheme: add make-string builtin

[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 e2532c98746a331ae248ace4f825ab41c4d1d874..0b84a89a2b366bdb67f2cf337fa4dc2a34eac24f 100644 (file)
--- a/src/scheme/ao_scheme_builtin.c
+++ b/src/scheme/ao_scheme_builtin.c
@@ -105,17 +105,23 @@ ao_scheme_check_argc(ao_poly name, struct ao_scheme_cons *cons, int min, int max
        return _ao_scheme_bool_true;
 }
 
-ao_poly
-ao_scheme_arg(struct ao_scheme_cons *cons, int argc)
+static ao_poly
+ao_scheme_opt_arg(struct ao_scheme_cons *cons, int argc, ao_poly def)
 {
-       if (!cons)
-               return AO_SCHEME_NIL;
-       while (argc--) {
+       for (;;) {
                if (!cons)
-                       return AO_SCHEME_NIL;
+                       return def;
+               if (argc == 0)
+                       return cons->car;
                cons = ao_scheme_cons_cdr(cons);
+               argc--;
        }
-       return cons->car;
+}
+
+ao_poly
+ao_scheme_arg(struct ao_scheme_cons *cons, int argc)
+{
+       return ao_scheme_opt_arg(cons, argc, AO_SCHEME_NIL);
 }
 
 ao_poly
@@ -140,6 +146,18 @@ ao_scheme_arg_int(ao_poly name, struct ao_scheme_cons *cons, int argc)
        return i;
 }
 
+static int32_t
+ao_scheme_opt_arg_int(ao_poly name, struct ao_scheme_cons *cons, int argc, int def)
+{
+       ao_poly         p = ao_scheme_opt_arg(cons, argc, ao_scheme_int_poly(def));
+       bool            fail = false;
+       int32_t         i = ao_scheme_poly_integer(p, &fail);
+
+       if (fail)
+               (void) ao_scheme_error(AO_SCHEME_INVALID, "%v: arg %d invalid type %v", name, argc, p);
+       return i;
+}
+
 ao_poly
 ao_scheme_do_car(struct ao_scheme_cons *cons)
 {
@@ -744,17 +762,39 @@ ao_scheme_do_string_set(struct ao_scheme_cons *cons)
        val = ao_scheme_arg_int(_ao_scheme_atom_string2dset21, cons, 2);
        if (ao_scheme_exception)
                return AO_SCHEME_NIL;
+       if (!val)
+               goto fail;
        while (*string && ref) {
                ++string;
                --ref;
        }
        if (!*string)
-               return ao_scheme_error(AO_SCHEME_INVALID, "%v: string %v ref %v invalid",
-                                      _ao_scheme_atom_string2dset21,
-                                      ao_scheme_arg(cons, 0),
-                                      ao_scheme_arg(cons, 1));
+               goto fail;
        *string = val;
        return ao_scheme_int_poly(*string);
+fail:
+       return ao_scheme_error(AO_SCHEME_INVALID, "%v: %v[%v] = %v invalid",
+                              _ao_scheme_atom_string2dset21,
+                              ao_scheme_arg(cons, 0),
+                              ao_scheme_arg(cons, 1),
+                              ao_scheme_arg(cons, 2));
+}
+
+ao_poly
+ao_scheme_do_make_string(struct ao_scheme_cons *cons)
+{
+       int32_t len;
+       char    fill;
+
+       if (!ao_scheme_check_argc(_ao_scheme_atom_make2dstring, cons, 1, 2))
+               return AO_SCHEME_NIL;
+       len = ao_scheme_arg_int(_ao_scheme_atom_make2dstring, cons, 0);
+       if (ao_scheme_exception)
+               return AO_SCHEME_NIL;
+       fill = ao_scheme_opt_arg_int(_ao_scheme_atom_make2dstring, cons, 1, ' ');
+       if (ao_scheme_exception)
+               return AO_SCHEME_NIL;
+       return ao_scheme_string_poly(ao_scheme_make_string(len, fill));
 }
 
 ao_poly
@@ -1120,11 +1160,21 @@ ao_scheme_do_list_to_vector(struct ao_scheme_cons *cons)
 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))
+       int     start, end;
+
+       if (!ao_scheme_check_argc(_ao_scheme_atom_vector2d3elist, cons, 1, 3))
                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))));
+       start = ao_scheme_opt_arg_int(_ao_scheme_atom_vector2d3elist, cons, 1, ao_scheme_int_poly(0));
+       if (ao_scheme_exception)
+               return AO_SCHEME_NIL;
+       end = ao_scheme_opt_arg_int(_ao_scheme_atom_vector2d3elist, cons, 2, ao_scheme_int_poly(-1));
+       if (ao_scheme_exception)
+               return AO_SCHEME_NIL;
+       return ao_scheme_cons_poly(ao_scheme_vector_to_list(ao_scheme_poly_vector(ao_scheme_arg(cons, 0)),
+                                                           start,
+                                                           end));
 }
 
 ao_poly