diff --git a/src/lisp.c b/src/lisp.c index 56f626e..a314a09 100644 --- a/src/lisp.c +++ b/src/lisp.c @@ -2711,7 +2711,7 @@ static inline LispVal *copy_number(LispVal *v) { } else if (INTEGERP(v)) { return make_lisp_integer(((LispInteger *) v)->value); } else { - abort(); + Fthrow(Qtype_error, Qnil); } } @@ -2719,10 +2719,10 @@ DEFUN(add, "+", (LispVal * args)) { if (NILP(args)) { return make_lisp_integer(0); } - LispVal *out = copy_number(Fhead(args)); - FOREACH(arg, Ftail(args)) { + LispVal *out = copy_number(HEAD(args)); + FOREACH(arg, TAIL(args)) { LispVal *old_out = out; - WITH_CLEANUP_DOUBLE_PTR(old_out, { + WITH_CLEANUP(old_out, { ONE_MATH_OPERAION(+, out, out, arg); // }); } @@ -2733,16 +2733,64 @@ DEFUN(sub, "-", (LispVal * args)) { if (NILP(args)) { return make_lisp_integer(0); } - LispVal *out = copy_number(Fhead(args)); - FOREACH(arg, Ftail(args)) { + LispVal *out = copy_number(HEAD(args)); + FOREACH(arg, TAIL(args)) { LispVal *old_out = out; - WITH_CLEANUP_DOUBLE_PTR(old_out, { + WITH_CLEANUP(old_out, { ONE_MATH_OPERAION(-, out, out, arg); // }); } return out; } +DEFUN(mul, "*", (LispVal * args)) { + if (NILP(args)) { + return make_lisp_integer(1); + } + LispVal *out = copy_number(HEAD(args)); + FOREACH(arg, TAIL(args)) { + LispVal *old_out = out; + WITH_CLEANUP(old_out, { + ONE_MATH_OPERAION(*, out, out, arg); // + }); + } + return out; +} + +DEFUN(div, "/", (LispVal * first, LispVal *rest)) { + if (NILP(rest)) { + if (INTEGERP(first)) { + return make_lisp_float(1.0 / ((LispInteger *) first)->value); + } else if (FLOATP(first)) { + return make_lisp_float(1.0 / ((LispFloat *) first)->value); + } else { + Fthrow(Qtype_error, Qnil); + } + } + LispVal *out = copy_number(HEAD(rest)); + FOREACH(arg, TAIL(rest)) { + LispVal *old_out = out; + WITH_CLEANUP(old_out, { + ONE_MATH_OPERAION(*, out, out, arg); // + }); + } + if (FLOATP(first)) { + LispVal *old_out = out; + ONE_MATH_OPERAION(/, out, first, out); + refcount_unref(old_out); + } else if (INTEGERP(first)) { + LispVal *old_out = out; + LispVal *ff = make_lisp_float(((LispInteger *) first)->value); + ONE_MATH_OPERAION(/, out, ff, out); + refcount_unref(ff); + refcount_unref(old_out); + } else { + refcount_unref(out); + Fthrow(Qtype_error, Qnil); + } + return out; +} + // #################### // # Vector Functions # // #################### @@ -3434,6 +3482,8 @@ static void register_symbols_and_functions(void) { REGISTER_FUNCTION(add, "(&rest nums)", "Return the sun of NUMS."); REGISTER_FUNCTION(sub, "(&rest nums)", "Return (head NUMS) - (apply '+ (tail NUMS))."); + REGISTER_FUNCTION(mul, "(&rest nums)", ""); + REGISTER_FUNCTION(div, "(first &rest rest)", ""); REGISTER_FUNCTION( if, "(cond then &rest else)", "Evaluate THEN if COND is non-nil, otherwise evaluate ELSE."); diff --git a/src/lisp.h b/src/lisp.h index 66c2cdf..bcbbe56 100644 --- a/src/lisp.h +++ b/src/lisp.h @@ -540,6 +540,8 @@ DECLARE_FUNCTION(num_eq, (LispVal * n1, LispVal *n2)); DECLARE_FUNCTION(num_gt, (LispVal * n1, LispVal *n2)); DECLARE_FUNCTION(add, (LispVal * args)); DECLARE_FUNCTION(sub, (LispVal * args)); +DECLARE_FUNCTION(mul, (LispVal * args)); +DECLARE_FUNCTION(div, (LispVal * first, LispVal *rest)); // #################### // # Vector Functions #