altos/lisp: Fix some scheme compat issues

[fw/altos] / src / lisp / ao_lisp_builtin.c

diff --git a/src/lisp/ao_lisp_builtin.c b/src/lisp/ao_lisp_builtin.c
index d37d0284a53d816b90943aabaa4b5db9244d2b7d..e5370f9037bd4379aac7aaa12d573fb967f21401 100644 (file)
--- 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"