X-Git-Url: https://git.gag.com/?a=blobdiff_plain;f=src%2Flisp%2Fao_lisp_builtin.c;h=e5370f9037bd4379aac7aaa12d573fb967f21401;hb=12a1f6ad48f2b924f71239effeb90afca75a090f;hp=d37d0284a53d816b90943aabaa4b5db9244d2b7d;hpb=e1acf5eb12aceda7aa838df031c1da1129d0fa5d;p=fw%2Faltos diff --git a/src/lisp/ao_lisp_builtin.c b/src/lisp/ao_lisp_builtin.c index d37d0284..e5370f90 100644 --- a/src/lisp/ao_lisp_builtin.c +++ b/src/lisp/ao_lisp_builtin.c @@ -85,7 +85,7 @@ ao_lisp_args_name(uint8_t args) #endif void -ao_lisp_builtin_print(ao_poly b) +ao_lisp_builtin_write(ao_poly b) { struct ao_lisp_builtin *builtin = ao_lisp_poly_builtin(b); printf("%s", ao_lisp_builtin_name(builtin->func)); @@ -247,30 +247,30 @@ ao_lisp_do_while(struct ao_lisp_cons *cons) } ao_poly -ao_lisp_do_print(struct ao_lisp_cons *cons) +ao_lisp_do_write(struct ao_lisp_cons *cons) { ao_poly val = AO_LISP_NIL; while (cons) { val = cons->car; - ao_lisp_poly_print(val); + ao_lisp_poly_write(val); cons = ao_lisp_poly_cons(cons->cdr); if (cons) printf(" "); } printf("\n"); - return val; + return _ao_lisp_bool_true; } ao_poly -ao_lisp_do_patom(struct ao_lisp_cons *cons) +ao_lisp_do_display(struct ao_lisp_cons *cons) { ao_poly val = AO_LISP_NIL; while (cons) { val = cons->car; - ao_lisp_poly_patom(val); + ao_lisp_poly_display(val); cons = ao_lisp_poly_cons(cons->cdr); } - return val; + return _ao_lisp_bool_true; } ao_poly @@ -290,10 +290,10 @@ ao_lisp_math(struct ao_lisp_cons *cons, enum ao_lisp_builtin_id op) if (cons->cdr == AO_LISP_NIL && ct == AO_LISP_INT) { switch (op) { case builtin_minus: - ret = ao_lisp_int_poly(-ao_lisp_poly_int(ret)); + ret = ao_lisp_integer_poly(-ao_lisp_poly_integer(ret)); break; case builtin_divide: - switch (ao_lisp_poly_int(ret)) { + switch (ao_lisp_poly_integer(ret)) { case 0: return ao_lisp_error(AO_LISP_DIVIDE_BY_ZERO, "divide by zero"); case 1: @@ -307,9 +307,9 @@ ao_lisp_math(struct ao_lisp_cons *cons, enum ao_lisp_builtin_id op) break; } } - } else if (rt == AO_LISP_INT && ct == AO_LISP_INT) { - int r = ao_lisp_poly_int(ret); - int c = ao_lisp_poly_int(car); + } else if (ao_lisp_integer_typep(rt) && ao_lisp_integer_typep(ct)) { + int32_t r = ao_lisp_poly_integer(ret); + int32_t c = ao_lisp_poly_integer(car); switch(op) { case builtin_plus: @@ -349,7 +349,7 @@ ao_lisp_math(struct ao_lisp_cons *cons, enum ao_lisp_builtin_id op) default: break; } - ret = ao_lisp_int_poly(r); + ret = ao_lisp_integer_poly(r); } else if (rt == AO_LISP_STRING && ct == AO_LISP_STRING && op == builtin_plus) @@ -427,9 +427,9 @@ ao_lisp_compare(struct ao_lisp_cons *cons, enum ao_lisp_builtin_id op) } else { uint8_t lt = ao_lisp_poly_type(left); uint8_t rt = ao_lisp_poly_type(right); - if (lt == AO_LISP_INT && rt == AO_LISP_INT) { - int l = ao_lisp_poly_int(left); - int r = ao_lisp_poly_int(right); + if (ao_lisp_integer_typep(lt) && ao_lisp_integer_typep(rt)) { + int32_t l = ao_lisp_poly_integer(left); + int32_t r = ao_lisp_poly_integer(right); switch (op) { case builtin_less: @@ -533,9 +533,9 @@ ao_lisp_do_string_to_list(struct ao_lisp_cons *cons) } ao_poly -ao_lisp_do_flush(struct ao_lisp_cons *cons) +ao_lisp_do_flush_output(struct ao_lisp_cons *cons) { - if (!ao_lisp_check_argc(_ao_lisp_atom_flush, cons, 0, 0)) + if (!ao_lisp_check_argc(_ao_lisp_atom_flush2doutput, cons, 0, 0)) return AO_LISP_NIL; ao_lisp_os_flush(); return _ao_lisp_bool_true; @@ -643,7 +643,15 @@ ao_lisp_do_pairp(struct ao_lisp_cons *cons) ao_poly ao_lisp_do_numberp(struct ao_lisp_cons *cons) { - return ao_lisp_do_typep(AO_LISP_INT, cons); + if (!ao_lisp_check_argc(_ao_lisp_atom_led, cons, 1, 1)) + return AO_LISP_NIL; + switch (ao_lisp_poly_type(ao_lisp_arg(cons, 0))) { + case AO_LISP_INT: + case AO_LISP_BIGINT: + return _ao_lisp_bool_true; + default: + return _ao_lisp_bool_false; + } } ao_poly @@ -738,5 +746,65 @@ ao_lisp_do_string_to_symbol(struct ao_lisp_cons *cons) return ao_lisp_atom_poly(ao_lisp_atom_intern(ao_lisp_poly_string(ao_lisp_arg(cons, 0)))); } +ao_poly +ao_lisp_do_read_char(struct ao_lisp_cons *cons) +{ + int c; + if (!ao_lisp_check_argc(_ao_lisp_atom_led, cons, 0, 0)) + return AO_LISP_NIL; + c = getchar(); + return ao_lisp_int_poly(c); +} + +ao_poly +ao_lisp_do_write_char(struct ao_lisp_cons *cons) +{ + if (!ao_lisp_check_argc(_ao_lisp_atom_led, cons, 1, 1)) + return AO_LISP_NIL; + if (!ao_lisp_check_argt(_ao_lisp_atom_led, cons, 0, AO_LISP_INT, 0)) + return AO_LISP_NIL; + putchar(ao_lisp_poly_integer(ao_lisp_arg(cons, 0))); + return _ao_lisp_bool_true; +} + +ao_poly +ao_lisp_do_exit(struct ao_lisp_cons *cons) +{ + if (!ao_lisp_check_argc(_ao_lisp_atom_led, cons, 0, 0)) + return AO_LISP_NIL; + ao_lisp_exception |= AO_LISP_EXIT; + return _ao_lisp_bool_true; +} + +ao_poly +ao_lisp_do_current_jiffy(struct ao_lisp_cons *cons) +{ + int jiffy; + + if (!ao_lisp_check_argc(_ao_lisp_atom_led, cons, 0, 0)) + return AO_LISP_NIL; + jiffy = ao_lisp_os_jiffy(); + return (ao_lisp_int_poly(jiffy)); +} + +ao_poly +ao_lisp_do_current_second(struct ao_lisp_cons *cons) +{ + int second; + + if (!ao_lisp_check_argc(_ao_lisp_atom_led, cons, 0, 0)) + return AO_LISP_NIL; + second = ao_lisp_os_jiffy() / AO_LISP_JIFFIES_PER_SECOND; + return (ao_lisp_int_poly(second)); +} + +ao_poly +ao_lisp_do_jiffies_per_second(struct ao_lisp_cons *cons) +{ + if (!ao_lisp_check_argc(_ao_lisp_atom_led, cons, 0, 0)) + return AO_LISP_NIL; + return (ao_lisp_int_poly(AO_LISP_JIFFIES_PER_SECOND)); +} + #define AO_LISP_BUILTIN_FUNCS #include "ao_lisp_builtin.h"