altos/scheme: Make eqv? work for numbers and strings

[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 6f9e1390c9eb6e090bb74d40872aba5439f91709..1754e6777790ecd6176c0eb3d9fd067e2ef7be11 100644 (file)
--- a/src/scheme/ao_scheme_builtin.c
+++ b/src/scheme/ao_scheme_builtin.c
@@ -319,6 +319,7 @@ 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(0, cons);
                        if (cons->cdr == AO_SCHEME_NIL) {
                                switch (op) {
                                case builtin_minus:
@@ -339,6 +340,7 @@ ao_scheme_math(struct ao_scheme_cons *orig_cons, enum ao_scheme_builtin_id op)
                                        break;
                                }
                        }
+                       cons = ao_scheme_cons_fetch(0);
                } 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);
@@ -390,7 +392,9 @@ ao_scheme_math(struct ao_scheme_cons *orig_cons, enum ao_scheme_builtin_id op)
                        default:
                                break;
                        }
+                       ao_scheme_cons_stash(0, cons);
                        ret = ao_scheme_integer_poly(r);
+                       cons = ao_scheme_cons_fetch(0);
                } else if (ao_scheme_number_typep(rt) && ao_scheme_number_typep(ct)) {
                        float r, c;
                inexact:
@@ -416,12 +420,18 @@ ao_scheme_math(struct ao_scheme_cons *orig_cons, enum ao_scheme_builtin_id op)
                        default:
                                break;
                        }
+                       ao_scheme_cons_stash(0, cons);
                        ret = ao_scheme_float_get(r);
+                       cons = ao_scheme_cons_fetch(0);
                }
-
-               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(0, 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(0);
+                       if (!ret)
+                               return ret;
+               }
                else
                        return ao_scheme_error(AO_SCHEME_INVALID, "invalid args");
        }
@@ -482,9 +492,8 @@ 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);
@@ -509,6 +518,38 @@ 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;
+                               }
+                       } 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:
+                                       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;
                                }
@@ -532,10 +573,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;
        }