-ao_poly
-ao_scheme_arg(struct ao_scheme_cons *cons, int argc)
-{
- return ao_scheme_opt_arg(cons, argc, AO_SCHEME_NIL);
-}
-
-ao_poly
-ao_scheme_check_argt(ao_poly name, struct ao_scheme_cons *cons, int argc, int type, int nil_ok)
-{
- ao_poly car = ao_scheme_arg(cons, argc);
-
- if ((!car && !nil_ok) || ao_scheme_poly_type(car) != type)
- return ao_scheme_error(AO_SCHEME_INVALID, "%v: arg %d invalid type %v", name, argc, car);
- return _ao_scheme_bool_true;
-}
-
-static int32_t
-ao_scheme_arg_int(ao_poly name, struct ao_scheme_cons *cons, int argc)
-{
- ao_poly p = ao_scheme_arg(cons, argc);
- 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;
-}
-
-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)
-{
- if (!ao_scheme_check_argc(_ao_scheme_atom_car, cons, 1, 1))
- return AO_SCHEME_NIL;
- if (!ao_scheme_check_argt(_ao_scheme_atom_car, cons, 0, AO_SCHEME_CONS, 0))
- return AO_SCHEME_NIL;
- return ao_scheme_poly_cons(cons->car)->car;
-}
-
-ao_poly
-ao_scheme_do_cdr(struct ao_scheme_cons *cons)
-{
- if (!ao_scheme_check_argc(_ao_scheme_atom_cdr, cons, 1, 1))
- return AO_SCHEME_NIL;
- if (!ao_scheme_check_argt(_ao_scheme_atom_cdr, cons, 0, AO_SCHEME_CONS, 0))
- return AO_SCHEME_NIL;
- return ao_scheme_poly_cons(cons->car)->cdr;
-}
-
-ao_poly
-ao_scheme_do_cons(struct ao_scheme_cons *cons)
-{
- ao_poly car, cdr;
- if(!ao_scheme_check_argc(_ao_scheme_atom_cons, cons, 2, 2))
- return AO_SCHEME_NIL;
- car = ao_scheme_arg(cons, 0);
- cdr = ao_scheme_arg(cons, 1);
- return ao_scheme_cons(car, cdr);
-}
-
-ao_poly
-ao_scheme_do_last(struct ao_scheme_cons *cons)
-{
- struct ao_scheme_cons *list;
- if (!ao_scheme_check_argc(_ao_scheme_atom_last, cons, 1, 1))
- return AO_SCHEME_NIL;
- if (!ao_scheme_check_argt(_ao_scheme_atom_last, cons, 0, AO_SCHEME_CONS, 1))
- return AO_SCHEME_NIL;
- for (list = ao_scheme_poly_cons(ao_scheme_arg(cons, 0));
- list;
- list = ao_scheme_cons_cdr(list))
- {
- if (!list->cdr)
- return list->car;
- }
- return AO_SCHEME_NIL;
-}
-
-ao_poly
-ao_scheme_do_length(struct ao_scheme_cons *cons)
-{
- if (!ao_scheme_check_argc(_ao_scheme_atom_length, cons, 1, 1))
- return AO_SCHEME_NIL;
- if (!ao_scheme_check_argt(_ao_scheme_atom_length, cons, 0, AO_SCHEME_CONS, 1))
- return AO_SCHEME_NIL;
- return ao_scheme_int_poly(ao_scheme_cons_length(ao_scheme_poly_cons(ao_scheme_arg(cons, 0))));
-}
-
-ao_poly
-ao_scheme_do_list_copy(struct ao_scheme_cons *cons)
-{
- struct ao_scheme_cons *new;
-
- if (!ao_scheme_check_argc(_ao_scheme_atom_length, cons, 1, 1))
- return AO_SCHEME_NIL;
- if (!ao_scheme_check_argt(_ao_scheme_atom_length, cons, 0, AO_SCHEME_CONS, 1))
- return AO_SCHEME_NIL;
- new = ao_scheme_cons_copy(ao_scheme_poly_cons(ao_scheme_arg(cons, 0)));
- return ao_scheme_cons_poly(new);
-}
-
-ao_poly
-ao_scheme_do_list_tail(struct ao_scheme_cons *cons)
-{
- ao_poly list;
- int32_t v;
-
- if (!ao_scheme_check_argc(_ao_scheme_atom_list2dtail, cons, 2, 2))
- return AO_SCHEME_NIL;
- if (!ao_scheme_check_argt(_ao_scheme_atom_list2dtail, cons, 0, AO_SCHEME_CONS, 1))
- return AO_SCHEME_NIL;
- list = ao_scheme_arg(cons, 0);
- v = ao_scheme_arg_int(_ao_scheme_atom_list2dtail, cons, 1);
- if (ao_scheme_exception)
- return AO_SCHEME_NIL;
- while (v > 0) {
- if (!list)
- return ao_scheme_error(AO_SCHEME_INVALID, "%v: ran off end", _ao_scheme_atom_list2dtail);
- if (!ao_scheme_is_cons(list))
- return ao_scheme_error(AO_SCHEME_INVALID, "%v: invalid list", _ao_scheme_atom_list2dtail);
- list = ao_scheme_poly_cons(list)->cdr;
- v--;
- }
- return list;
-}
-