X-Git-Url: https://git.gag.com/?a=blobdiff_plain;f=src%2Fscheme%2Fao_scheme_builtin.c;h=e2532c98746a331ae248ace4f825ab41c4d1d874;hb=7b5892f75a75363a656ede8befb419245aa218b5;hp=aa8186463ef6e9ff800db683f7bf883e5591ab57;hpb=1133130986a78628ea297ce1f6a023baf4382d8f;p=fw%2Faltos diff --git a/src/scheme/ao_scheme_builtin.c b/src/scheme/ao_scheme_builtin.c index aa818646..e2532c98 100644 --- a/src/scheme/ao_scheme_builtin.c +++ b/src/scheme/ao_scheme_builtin.c @@ -52,7 +52,7 @@ char *ao_scheme_args_name(uint8_t args) { case AO_SCHEME_FUNC_LAMBDA: return ao_scheme_poly_atom(_ao_scheme_atom_lambda)->name; case AO_SCHEME_FUNC_NLAMBDA: return ao_scheme_poly_atom(_ao_scheme_atom_nlambda)->name; case AO_SCHEME_FUNC_MACRO: return ao_scheme_poly_atom(_ao_scheme_atom_macro)->name; - default: return "???"; + default: return (char *) "???"; } } #else @@ -64,7 +64,7 @@ static char * ao_scheme_builtin_name(enum ao_scheme_builtin_id b) { if (b < _builtin_last) return ao_scheme_poly_atom(builtin_names[b])->name; - return "???"; + return (char *) "???"; } static const ao_poly ao_scheme_args_atoms[] = { @@ -79,14 +79,15 @@ ao_scheme_args_name(uint8_t args) args &= AO_SCHEME_FUNC_MASK; if (args < sizeof ao_scheme_args_atoms / sizeof ao_scheme_args_atoms[0]) return ao_scheme_poly_atom(ao_scheme_args_atoms[args])->name; - return "(unknown)"; + return (char *) "(unknown)"; } #endif void -ao_scheme_builtin_write(ao_poly b) +ao_scheme_builtin_write(ao_poly b, bool write) { struct ao_scheme_builtin *builtin = ao_scheme_poly_builtin(b); + (void) write; printf("%s", ao_scheme_builtin_name(builtin->func)); } @@ -123,10 +124,22 @@ ao_scheme_check_argt(ao_poly name, struct ao_scheme_cons *cons, int argc, int ty 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, "%s: arg %d invalid type %v", ao_scheme_poly_atom(name)->name, argc, car); + 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; +} + ao_poly ao_scheme_do_car(struct ao_scheme_cons *cons) { @@ -155,7 +168,7 @@ ao_scheme_do_cons(struct ao_scheme_cons *cons) return AO_SCHEME_NIL; car = ao_scheme_arg(cons, 0); cdr = ao_scheme_arg(cons, 1); - return ao_scheme__cons(car, cdr); + return ao_scheme_cons(car, cdr); } ao_poly @@ -186,6 +199,19 @@ ao_scheme_do_length(struct ao_scheme_cons *cons) 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_quote(struct ao_scheme_cons *cons) { @@ -227,10 +253,10 @@ ao_scheme_do_setq(struct ao_scheme_cons *cons) return ao_scheme_error(AO_SCHEME_INVALID, "set! of non-atom %v", name); if (!ao_scheme_atom_ref(name, NULL)) return ao_scheme_error(AO_SCHEME_INVALID, "atom %v not defined", name); - return ao_scheme__cons(_ao_scheme_atom_set, - ao_scheme__cons(ao_scheme__cons(_ao_scheme_atom_quote, - ao_scheme__cons(name, AO_SCHEME_NIL)), - cons->cdr)); + return ao_scheme_cons(_ao_scheme_atom_set, + ao_scheme_cons(ao_scheme_cons(_ao_scheme_atom_quote, + ao_scheme_cons(name, AO_SCHEME_NIL)), + cons->cdr)); } ao_poly @@ -262,12 +288,11 @@ ao_scheme_do_write(struct ao_scheme_cons *cons) ao_poly val = AO_SCHEME_NIL; while (cons) { val = cons->car; - ao_scheme_poly_write(val); + ao_scheme_poly_write(val, true); cons = ao_scheme_cons_cdr(cons); if (cons) printf(" "); } - printf("\n"); return _ao_scheme_bool_true; } @@ -277,16 +302,16 @@ ao_scheme_do_display(struct ao_scheme_cons *cons) ao_poly val = AO_SCHEME_NIL; while (cons) { val = cons->car; - ao_scheme_poly_display(val); + ao_scheme_poly_write(val, false); cons = ao_scheme_cons_cdr(cons); } return _ao_scheme_bool_true; } -ao_poly +static ao_poly ao_scheme_math(struct ao_scheme_cons *orig_cons, enum ao_scheme_builtin_id op) { - struct ao_scheme_cons *cons = cons; + struct ao_scheme_cons *cons; ao_poly ret = AO_SCHEME_NIL; for (cons = orig_cons; cons; cons = ao_scheme_cons_cdr(cons)) { @@ -296,57 +321,83 @@ ao_scheme_math(struct ao_scheme_cons *orig_cons, enum ao_scheme_builtin_id op) if (cons == orig_cons) { ret = car; + ao_scheme_cons_stash(cons); if (cons->cdr == AO_SCHEME_NIL) { switch (op) { case builtin_minus: if (ao_scheme_integer_typep(ct)) - ret = ao_scheme_integer_poly(-ao_scheme_poly_integer(ret)); + ret = ao_scheme_integer_poly(-ao_scheme_poly_integer(ret, NULL)); +#ifdef AO_SCHEME_FEATURE_FLOAT else if (ct == AO_SCHEME_FLOAT) ret = ao_scheme_float_get(-ao_scheme_poly_number(ret)); +#endif break; case builtin_divide: - if (ao_scheme_integer_typep(ct) && ao_scheme_poly_integer(ret) == 1) - ; - else if (ao_scheme_number_typep(ct)) { - float v = ao_scheme_poly_number(ret); - ret = ao_scheme_float_get(1/v); + if (ao_scheme_poly_integer(ret, NULL) == 1) { + } else { +#ifdef AO_SCHEME_FEATURE_FLOAT + if (ao_scheme_number_typep(ct)) { + float v = ao_scheme_poly_number(ret); + ret = ao_scheme_float_get(1/v); + } +#else + ret = ao_scheme_integer_poly(0); +#endif } break; default: break; } } + cons = ao_scheme_cons_fetch(); } else if (ao_scheme_integer_typep(rt) && ao_scheme_integer_typep(ct)) { - int32_t r = ao_scheme_poly_integer(ret); - int32_t c = ao_scheme_poly_integer(car); + int32_t r = ao_scheme_poly_integer(ret, NULL); + int32_t c = ao_scheme_poly_integer(car, NULL); +#ifdef AO_SCHEME_FEATURE_FLOAT int64_t t; +#endif switch(op) { case builtin_plus: r += c; check_overflow: +#ifdef AO_SCHEME_FEATURE_FLOAT if (r < AO_SCHEME_MIN_BIGINT || AO_SCHEME_MAX_BIGINT < r) goto inexact; +#endif break; case builtin_minus: r -= c; goto check_overflow; break; case builtin_times: +#ifdef AO_SCHEME_FEATURE_FLOAT t = (int64_t) r * (int64_t) c; if (t < AO_SCHEME_MIN_BIGINT || AO_SCHEME_MAX_BIGINT < t) goto inexact; r = (int32_t) t; +#else + r = r * c; +#endif break; case builtin_divide: +#ifdef AO_SCHEME_FEATURE_FLOAT if (c != 0 && (r % c) == 0) r /= c; else goto inexact; +#else + r /= c; +#endif break; case builtin_quotient: if (c == 0) return ao_scheme_error(AO_SCHEME_DIVIDE_BY_ZERO, "quotient by zero"); + r = r / c; + break; + case builtin_floor_quotient: + if (c == 0) + return ao_scheme_error(AO_SCHEME_DIVIDE_BY_ZERO, "floor-quotient by zero"); if (r % c != 0 && (c < 0) != (r < 0)) r = r / c - 1; else @@ -367,7 +418,10 @@ ao_scheme_math(struct ao_scheme_cons *orig_cons, enum ao_scheme_builtin_id op) default: break; } + ao_scheme_cons_stash(cons); ret = ao_scheme_integer_poly(r); + cons = ao_scheme_cons_fetch(); +#ifdef AO_SCHEME_FEATURE_FLOAT } else if (ao_scheme_number_typep(rt) && ao_scheme_number_typep(ct)) { float r, c; inexact: @@ -387,18 +441,26 @@ ao_scheme_math(struct ao_scheme_cons *orig_cons, enum ao_scheme_builtin_id op) r /= c; break; case builtin_quotient: + case builtin_floor_quotient: case builtin_remainder: case builtin_modulo: return ao_scheme_error(AO_SCHEME_INVALID, "non-integer value in integer divide"); default: break; } + ao_scheme_cons_stash(cons); ret = ao_scheme_float_get(r); + cons = ao_scheme_cons_fetch(); +#endif } - - else if (rt == AO_SCHEME_STRING && ct == AO_SCHEME_STRING && op == builtin_plus) + else if (rt == AO_SCHEME_STRING && ct == AO_SCHEME_STRING && op == builtin_plus) { + ao_scheme_cons_stash(cons); ret = ao_scheme_string_poly(ao_scheme_string_cat(ao_scheme_poly_string(ret), - ao_scheme_poly_string(car))); + ao_scheme_poly_string(car))); + cons = ao_scheme_cons_fetch(); + if (!ret) + return ret; + } else return ao_scheme_error(AO_SCHEME_INVALID, "invalid args"); } @@ -435,6 +497,12 @@ ao_scheme_do_quotient(struct ao_scheme_cons *cons) return ao_scheme_math(cons, builtin_quotient); } +ao_poly +ao_scheme_do_floor_quotient(struct ao_scheme_cons *cons) +{ + return ao_scheme_math(cons, builtin_floor_quotient); +} + ao_poly ao_scheme_do_modulo(struct ao_scheme_cons *cons) { @@ -447,7 +515,7 @@ ao_scheme_do_remainder(struct ao_scheme_cons *cons) return ao_scheme_math(cons, builtin_remainder); } -ao_poly +static ao_poly ao_scheme_compare(struct ao_scheme_cons *cons, enum ao_scheme_builtin_id op) { ao_poly left; @@ -459,15 +527,44 @@ ao_scheme_compare(struct ao_scheme_cons *cons, enum ao_scheme_builtin_id op) for (cons = ao_scheme_cons_cdr(cons); cons; cons = ao_scheme_cons_cdr(cons)) { ao_poly right = cons->car; - if (op == builtin_equal) { - if (left != right) - return _ao_scheme_bool_false; + if (op == builtin_equal && left == right) { + ; } else { uint8_t lt = ao_scheme_poly_type(left); uint8_t rt = ao_scheme_poly_type(right); if (ao_scheme_integer_typep(lt) && ao_scheme_integer_typep(rt)) { - int32_t l = ao_scheme_poly_integer(left); - int32_t r = ao_scheme_poly_integer(right); + int32_t l = ao_scheme_poly_integer(left, NULL); + int32_t r = ao_scheme_poly_integer(right, NULL); + + switch (op) { + case builtin_less: + if (!(l < r)) + return _ao_scheme_bool_false; + break; + case builtin_greater: + if (!(l > r)) + return _ao_scheme_bool_false; + break; + case builtin_less_equal: + if (!(l <= r)) + return _ao_scheme_bool_false; + break; + case builtin_greater_equal: + if (!(l >= r)) + return _ao_scheme_bool_false; + break; + case builtin_equal: + if (!(l == r)) + return _ao_scheme_bool_false; + default: + break; + } +#ifdef AO_SCHEME_FEATURE_FLOAT + } else if (ao_scheme_number_typep(lt) && ao_scheme_number_typep(rt)) { + float l, r; + + l = ao_scheme_poly_number(left); + r = ao_scheme_poly_number(right); switch (op) { case builtin_less: @@ -486,12 +583,16 @@ ao_scheme_compare(struct ao_scheme_cons *cons, enum ao_scheme_builtin_id op) if (!(l >= r)) return _ao_scheme_bool_false; break; + case builtin_equal: + if (!(l == r)) + return _ao_scheme_bool_false; default: break; } +#endif /* AO_SCHEME_FEATURE_FLOAT */ } else if (lt == AO_SCHEME_STRING && rt == AO_SCHEME_STRING) { - int c = strcmp(ao_scheme_poly_string(left), - ao_scheme_poly_string(right)); + int c = strcmp(ao_scheme_poly_string(left)->val, + ao_scheme_poly_string(right)->val); switch (op) { case builtin_less: if (!(c < 0)) @@ -509,10 +610,15 @@ ao_scheme_compare(struct ao_scheme_cons *cons, enum ao_scheme_builtin_id op) if (!(c >= 0)) return _ao_scheme_bool_false; break; + case builtin_equal: + if (!(c == 0)) + return _ao_scheme_bool_false; + break; default: break; } - } + } else + return _ao_scheme_bool_false; } left = right; } @@ -569,6 +675,88 @@ ao_scheme_do_string_to_list(struct ao_scheme_cons *cons) return ao_scheme_string_unpack(ao_scheme_poly_string(ao_scheme_arg(cons, 0))); } +ao_poly +ao_scheme_do_string_ref(struct ao_scheme_cons *cons) +{ + char *string; + int32_t ref; + if (!ao_scheme_check_argc(_ao_scheme_atom_string2dref, cons, 2, 2)) + return AO_SCHEME_NIL; + if (!ao_scheme_check_argt(_ao_scheme_atom_string2dref, cons, 0, AO_SCHEME_STRING, 0)) + return AO_SCHEME_NIL; + ref = ao_scheme_arg_int(_ao_scheme_atom_string2dref, cons, 1); + if (ao_scheme_exception) + return AO_SCHEME_NIL; + string = ao_scheme_poly_string(ao_scheme_arg(cons, 0))->val; + while (*string && ref) { + ++string; + --ref; + } + if (!*string) + return ao_scheme_error(AO_SCHEME_INVALID, "%v: string %v ref %v invalid", + _ao_scheme_atom_string2dref, + ao_scheme_arg(cons, 0), + ao_scheme_arg(cons, 1)); + return ao_scheme_int_poly(*string); +} + +ao_poly +ao_scheme_do_string_length(struct ao_scheme_cons *cons) +{ + struct ao_scheme_string *string; + + if (!ao_scheme_check_argc(_ao_scheme_atom_string2dlength, cons, 1, 1)) + return AO_SCHEME_NIL; + if (!ao_scheme_check_argt(_ao_scheme_atom_string2dlength, cons, 0, AO_SCHEME_STRING, 0)) + return AO_SCHEME_NIL; + string = ao_scheme_poly_string(ao_scheme_arg(cons, 0)); + return ao_scheme_integer_poly(strlen(string->val)); +} + +ao_poly +ao_scheme_do_string_copy(struct ao_scheme_cons *cons) +{ + struct ao_scheme_string *string; + + if (!ao_scheme_check_argc(_ao_scheme_atom_string2dcopy, cons, 1, 1)) + return AO_SCHEME_NIL; + if (!ao_scheme_check_argt(_ao_scheme_atom_string2dcopy, cons, 0, AO_SCHEME_STRING, 0)) + return AO_SCHEME_NIL; + string = ao_scheme_poly_string(ao_scheme_arg(cons, 0)); + return ao_scheme_string_poly(ao_scheme_string_copy(string)); +} + +ao_poly +ao_scheme_do_string_set(struct ao_scheme_cons *cons) +{ + char *string; + int32_t ref; + int32_t val; + + if (!ao_scheme_check_argc(_ao_scheme_atom_string2dset21, cons, 3, 3)) + return AO_SCHEME_NIL; + if (!ao_scheme_check_argt(_ao_scheme_atom_string2dset21, cons, 0, AO_SCHEME_STRING, 0)) + return AO_SCHEME_NIL; + string = ao_scheme_poly_string(ao_scheme_arg(cons, 0))->val; + ref = ao_scheme_arg_int(_ao_scheme_atom_string2dset21, cons, 1); + if (ao_scheme_exception) + return AO_SCHEME_NIL; + val = ao_scheme_arg_int(_ao_scheme_atom_string2dset21, cons, 2); + if (ao_scheme_exception) + return AO_SCHEME_NIL; + 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)); + *string = val; + return ao_scheme_int_poly(*string); +} + ao_poly ao_scheme_do_flush_output(struct ao_scheme_cons *cons) { @@ -581,10 +769,11 @@ ao_scheme_do_flush_output(struct ao_scheme_cons *cons) ao_poly ao_scheme_do_led(struct ao_scheme_cons *cons) { - ao_poly led; + int32_t led; if (!ao_scheme_check_argc(_ao_scheme_atom_led, cons, 1, 1)) return AO_SCHEME_NIL; - if (!ao_scheme_check_argt(_ao_scheme_atom_led, cons, 0, AO_SCHEME_INT, 0)) + led = ao_scheme_arg_int(_ao_scheme_atom_led, cons, 0); + if (ao_scheme_exception) return AO_SCHEME_NIL; led = ao_scheme_arg(cons, 0); ao_scheme_os_led(ao_scheme_poly_int(led)); @@ -594,13 +783,14 @@ ao_scheme_do_led(struct ao_scheme_cons *cons) ao_poly ao_scheme_do_delay(struct ao_scheme_cons *cons) { - ao_poly delay; - if (!ao_scheme_check_argc(_ao_scheme_atom_led, cons, 1, 1)) + int32_t delay; + + if (!ao_scheme_check_argc(_ao_scheme_atom_delay, cons, 1, 1)) return AO_SCHEME_NIL; - if (!ao_scheme_check_argt(_ao_scheme_atom_led, cons, 0, AO_SCHEME_INT, 0)) + delay = ao_scheme_arg_int(_ao_scheme_atom_delay, cons, 0); + if (ao_scheme_exception) return AO_SCHEME_NIL; - delay = ao_scheme_arg(cons, 0); - ao_scheme_os_delay(ao_scheme_poly_int(delay)); + ao_scheme_os_delay(delay); return delay; } @@ -678,7 +868,7 @@ ao_scheme_do_pairp(struct ao_scheme_cons *cons) if (!ao_scheme_check_argc(_ao_scheme_atom_led, cons, 1, 1)) return AO_SCHEME_NIL; v = ao_scheme_arg(cons, 0); - if (v != AO_SCHEME_NIL && ao_scheme_poly_type(v) == AO_SCHEME_CONS) + if (ao_scheme_is_pair(v)) return _ao_scheme_bool_true; return _ao_scheme_bool_false; } @@ -686,6 +876,7 @@ ao_scheme_do_pairp(struct ao_scheme_cons *cons) ao_poly ao_scheme_do_integerp(struct ao_scheme_cons *cons) { +#ifdef AO_SCHEME_FEATURE_BIGINT if (!ao_scheme_check_argc(_ao_scheme_atom_led, cons, 1, 1)) return AO_SCHEME_NIL; switch (ao_scheme_poly_type(ao_scheme_arg(cons, 0))) { @@ -695,21 +886,32 @@ ao_scheme_do_integerp(struct ao_scheme_cons *cons) default: return _ao_scheme_bool_false; } +#else + return ao_scheme_do_typep(AO_SCHEME_INT, cons); +#endif } ao_poly ao_scheme_do_numberp(struct ao_scheme_cons *cons) { +#if defined(AO_SCHEME_FEATURE_BIGINT) || defined(AO_SCHEME_FEATURE_FLOAT) if (!ao_scheme_check_argc(_ao_scheme_atom_led, cons, 1, 1)) return AO_SCHEME_NIL; switch (ao_scheme_poly_type(ao_scheme_arg(cons, 0))) { case AO_SCHEME_INT: +#ifdef AO_SCHEME_FEATURE_BIGINT case AO_SCHEME_BIGINT: +#endif +#ifdef AO_SCHEME_FEATURE_FLOAT case AO_SCHEME_FLOAT: +#endif return _ao_scheme_bool_true; default: return _ao_scheme_bool_false; } +#else + return ao_scheme_do_integerp(cons); +#endif } ao_poly @@ -751,13 +953,13 @@ 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 (;;) { if (v == AO_SCHEME_NIL) return _ao_scheme_bool_true; - if (ao_scheme_poly_type(v) != AO_SCHEME_CONS) + if (!ao_scheme_is_cons(v)) return _ao_scheme_bool_false; v = ao_scheme_poly_cons(v)->cdr; } @@ -790,7 +992,7 @@ ao_scheme_do_symbol_to_string(struct ao_scheme_cons *cons) return AO_SCHEME_NIL; if (!ao_scheme_check_argt(_ao_scheme_atom_led, cons, 0, AO_SCHEME_ATOM, 0)) return AO_SCHEME_NIL; - return ao_scheme_string_poly(ao_scheme_string_copy(ao_scheme_poly_atom(ao_scheme_arg(cons, 0))->name)); + return ao_scheme_string_poly(ao_scheme_atom_to_string(ao_scheme_poly_atom(ao_scheme_arg(cons, 0)))); } ao_poly @@ -801,7 +1003,7 @@ ao_scheme_do_string_to_symbol(struct ao_scheme_cons *cons) if (!ao_scheme_check_argt(_ao_scheme_atom_led, cons, 0, AO_SCHEME_STRING, 0)) return AO_SCHEME_NIL; - return ao_scheme_atom_poly(ao_scheme_atom_intern(ao_scheme_poly_string(ao_scheme_arg(cons, 0)))); + return ao_scheme_atom_poly(ao_scheme_string_to_atom(ao_scheme_poly_string(ao_scheme_arg(cons, 0))));; } ao_poly @@ -821,7 +1023,7 @@ ao_scheme_do_write_char(struct ao_scheme_cons *cons) return AO_SCHEME_NIL; if (!ao_scheme_check_argt(_ao_scheme_atom_led, cons, 0, AO_SCHEME_INT, 0)) return AO_SCHEME_NIL; - putchar(ao_scheme_poly_integer(ao_scheme_arg(cons, 0))); + putchar(ao_scheme_poly_integer(ao_scheme_arg(cons, 0), NULL)); return _ao_scheme_bool_true; } @@ -864,5 +1066,84 @@ ao_scheme_do_jiffies_per_second(struct ao_scheme_cons *cons) return (ao_scheme_int_poly(AO_SCHEME_JIFFIES_PER_SECOND)); } +#ifdef AO_SCHEME_FEATURE_VECTOR + +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_make_vector(struct ao_scheme_cons *cons) +{ + int32_t k; + + if (!ao_scheme_check_argc(_ao_scheme_atom_make2dvector, cons, 2, 2)) + return AO_SCHEME_NIL; + k = ao_scheme_arg_int(_ao_scheme_atom_make2dvector, cons, 0); + if (ao_scheme_exception) + return AO_SCHEME_NIL; + return ao_scheme_vector_poly(ao_scheme_vector_alloc(k, ao_scheme_arg(cons, 1))); +} + +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); +} + +#endif /* AO_SCHEME_FEATURE_VECTOR */ + #define AO_SCHEME_BUILTIN_FUNCS #include "ao_scheme_builtin.h"