X-Git-Url: https://git.gag.com/?a=blobdiff_plain;f=src%2Flisp%2Fao_lisp_builtin.c;h=fdca020849177c9d2684bc22cfd91ef2c7c20b0a;hb=ed6967cef5d82baacafe1c23229f44d58c838326;hp=693cc3ca9bd0f6a97a2732b50a2c36b2c08698f1;hpb=00bf2ca86b60e6501880011897cea073865c5a03;p=fw%2Faltos

diff --git a/src/lisp/ao_lisp_builtin.c b/src/lisp/ao_lisp_builtin.c
index 693cc3ca..fdca0208 100644
--- a/src/lisp/ao_lisp_builtin.c
+++ b/src/lisp/ao_lisp_builtin.c
@@ -125,7 +125,7 @@ ao_lisp_check_argt(ao_poly name, struct ao_lisp_cons *cons, int argc, int type,
 	ao_poly car = ao_lisp_arg(cons, argc);
 
 	if ((!car && !nil_ok) || ao_lisp_poly_type(car) != type)
-		return ao_lisp_error(AO_LISP_INVALID, "%s: invalid type for arg %d", ao_lisp_poly_atom(name)->name, argc);
+		return ao_lisp_error(AO_LISP_INVALID, "%s: arg %d invalid type %v", ao_lisp_poly_atom(name)->name, argc, car);
 	return _ao_lisp_bool_true;
 }
 
@@ -207,6 +207,17 @@ ao_lisp_do_set(struct ao_lisp_cons *cons)
 	return ao_lisp_atom_set(ao_lisp_arg(cons, 0), ao_lisp_arg(cons, 1));
 }
 
+ao_poly
+ao_lisp_do_def(struct ao_lisp_cons *cons)
+{
+	if (!ao_lisp_check_argc(_ao_lisp_atom_def, cons, 2, 2))
+		return AO_LISP_NIL;
+	if (!ao_lisp_check_argt(_ao_lisp_atom_def, cons, 0, AO_LISP_ATOM, 0))
+		return AO_LISP_NIL;
+
+	return ao_lisp_atom_def(ao_lisp_arg(cons, 0), ao_lisp_arg(cons, 1));
+}
+
 ao_poly
 ao_lisp_do_setq(struct ao_lisp_cons *cons)
 {
@@ -215,9 +226,9 @@ ao_lisp_do_setq(struct ao_lisp_cons *cons)
 		return AO_LISP_NIL;
 	name = cons->car;
 	if (ao_lisp_poly_type(name) != AO_LISP_ATOM)
-		return ao_lisp_error(AO_LISP_INVALID, "set! of non-atom");
-	if (!ao_lisp_atom_ref(ao_lisp_frame_current, name))
-		return ao_lisp_error(AO_LISP_INVALID, "atom not defined");
+		return ao_lisp_error(AO_LISP_INVALID, "set! of non-atom %v", name);
+	if (!ao_lisp_atom_ref(name))
+		return ao_lisp_error(AO_LISP_INVALID, "atom %v not defined", name);
 	return ao_lisp__cons(_ao_lisp_atom_set,
 			     ao_lisp__cons(ao_lisp__cons(_ao_lisp_atom_quote,
 							 ao_lisp__cons(name, AO_LISP_NIL)),
@@ -310,24 +321,30 @@ ao_lisp_math(struct ao_lisp_cons *orig_cons, enum ao_lisp_builtin_id op)
 		} 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);
+			int64_t t;
 
 			switch(op) {
 			case builtin_plus:
 				r += c;
+			check_overflow:
+				if (r < AO_LISP_MIN_BIGINT || AO_LISP_MAX_BIGINT < r)
+					goto inexact;
 				break;
 			case builtin_minus:
 				r -= c;
+				goto check_overflow;
 				break;
 			case builtin_times:
-				r *= c;
+				t = (int64_t) r * (int64_t) c;
+				if (t < AO_LISP_MIN_BIGINT || AO_LISP_MAX_BIGINT < t)
+					goto inexact;
+				r = (int32_t) t;
 				break;
 			case builtin_divide:
 				if (c != 0 && (r % c) == 0)
 					r /= c;
-				else {
-					ret = ao_lisp_float_get((float) r / (float) c);
-					continue;
-				}
+				else
+					goto inexact;
 				break;
 			case builtin_quotient:
 				if (c == 0)
@@ -354,8 +371,10 @@ ao_lisp_math(struct ao_lisp_cons *orig_cons, enum ao_lisp_builtin_id op)
 			}
 			ret = ao_lisp_integer_poly(r);
 		} else if (ao_lisp_number_typep(rt) && ao_lisp_number_typep(ct)) {
-			float r = ao_lisp_poly_number(ret);
-			float c = ao_lisp_poly_number(car);
+			float r, c;
+		inexact:
+			r = ao_lisp_poly_number(ret);
+			c = ao_lisp_poly_number(car);
 			switch(op) {
 			case builtin_plus:
 				r += c;
@@ -369,28 +388,10 @@ ao_lisp_math(struct ao_lisp_cons *orig_cons, enum ao_lisp_builtin_id op)
 			case builtin_divide:
 				r /= c;
 				break;
-#if 0
 			case builtin_quotient:
-				if (c == 0)
-					return ao_lisp_error(AO_LISP_DIVIDE_BY_ZERO, "quotient by zero");
-				if (r % c != 0 && (c < 0) != (r < 0))
-					r = r / c - 1;
-				else
-					r = r / c;
-				break;
 			case builtin_remainder:
-				if (c == 0)
-					return ao_lisp_error(AO_LISP_DIVIDE_BY_ZERO, "remainder by zero");
-				r %= c;
-				break;
 			case builtin_modulo:
-				if (c == 0)
-					return ao_lisp_error(AO_LISP_DIVIDE_BY_ZERO, "modulo by zero");
-				r %= c;
-				if ((r < 0) != (c < 0))
-					r += c;
-				break;
-#endif
+				return ao_lisp_error(AO_LISP_INVALID, "non-integer value in integer divide");
 			default:
 				break;
 			}
@@ -675,7 +676,13 @@ ao_lisp_do_typep(int type, struct ao_lisp_cons *cons)
 ao_poly
 ao_lisp_do_pairp(struct ao_lisp_cons *cons)
 {
-	return ao_lisp_do_typep(AO_LISP_CONS, cons);
+	ao_poly	v;
+	if (!ao_lisp_check_argc(_ao_lisp_atom_led, cons, 1, 1))
+		return AO_LISP_NIL;
+	v = ao_lisp_arg(cons, 0);
+	if (v != AO_LISP_NIL && ao_lisp_poly_type(v) == AO_LISP_CONS)
+		return _ao_lisp_bool_true;
+	return _ao_lisp_bool_false;
 }
 
 ao_poly