Allow varargs for - * / as well as +

TODO

@@ -1,17 +1,6 @@
 Working TODO list:
 
- - Fixup Cyc_sum to use varargs and call (error) if anything bad happens. then generalize to - * /
-   can we pass the actual arg(s) to the error function?
-
- - need an error() function that will call (error) from the C runtime
-   useful for, EG, type checking
-   
-   notes:
-   can assume presence of *exception-handler-stack* global, at least for now
-   move Cyc-current-exception-handler to a runtime function, then can
-   (I think) rewrite raise to be one as well. Then should be able to call
-   into a common exception function in runtime that will in turn just
-   call raise (or just call it directly)
+ - Cyc_sum, etc: can we pass the actual arg(s) to the error function?
 
  - make *trace-level* a command-line parameter, and by default do not emit scheme code transformations in comments
  - Reduction in size of generated code

cgen.scm

@@ -403,9 +403,9 @@
      ((eq? p 'Cyc-cvar?)             "Cyc_is_cvar")
      ((eq? p 'Cyc-has-cycle?)        "Cyc_has_cycle")
      ((eq? p '+)                     "Cyc_sum")
-     ((eq? p '-)                     "__sub")
-     ((eq? p '*)                     "__mul")
-     ((eq? p '/)                     "__div")
+     ((eq? p '-)                     "Cyc_sub")
+     ((eq? p '*)                     "Cyc_mul")
+     ((eq? p '/)                     "Cyc_div")
      ((eq? p '=)                     "__num_eq")
      ((eq? p '>)                     "__num_gt")
      ((eq? p '<)                     "__num_lt")
@@ -502,6 +502,9 @@
     ((eq? p 'length) "integer_type")
     ((eq? p 'char->integer) "integer_type")
     ((eq? p '+) "common_type")
+    ((eq? p '-) "common_type")
+    ((eq? p '*) "common_type")
+    ((eq? p '/) "common_type")
     ((eq? p 'string->number) "common_type")
     ((eq? p 'list->string) "string_type")
 ;    ((eq? p 'string->list) "object")
@@ -523,7 +526,7 @@
 ;; Pass an integer arg count as the function's first parameter?
 (define (prim:arg-count? exp)
     (and (prim? exp)
-         (member exp '(error string-append +))))
+         (member exp '(error string-append + - * /))))
 
 ;; Does primitive allocate an object?
 (define (prim:allocates-object? exp)

runtime.h

@@ -96,6 +96,9 @@ static object Cyc_is_procedure(object o);
 static object Cyc_is_eof_object(object o);
 static object Cyc_is_cvar(object o);
 static common_type Cyc_sum_op(object x, object y);
+static common_type Cyc_sub_op(object x, object y);
+static common_type Cyc_mul_op(object x, object y);
+static common_type Cyc_div_op(object x, object y);
 static common_type Cyc_sum(int argc, object n, ...);
 static common_type Cyc_num_op_va_list(int argc, common_type (fn_op(object, object)), object n, va_list ns);
 static int equal(object,object);
@@ -778,29 +781,47 @@ static object __halt(object obj) {
     return nil;
 }
 
-#define __mul(c,x,y) integer_type c; c.tag = integer_tag; c.value = (((integer_type *)(x))->value * ((integer_type *)(y))->value);
-#define __sub(c,x,y) integer_type c; c.tag = integer_tag; c.value = (((integer_type *)(x))->value - ((integer_type *)(y))->value);
-#define __div(c,x,y) integer_type c; c.tag = integer_tag; c.value = (((integer_type *)(x))->value / ((integer_type *)(y))->value);
-
-static common_type Cyc_sum_op(object x, object y) {
-    common_type s;
-    int tx = type_of(x), ty = type_of(y);
-    s.double_t.tag = double_tag;
-    if (tx == integer_tag && ty == integer_tag) {
-        s.integer_t.tag = integer_tag;
-        s.integer_t.value = ((integer_type *)x)->value + ((integer_type *)y)->value;
-    } else if (tx == double_tag && ty == integer_tag) {
-        s.double_t.value = ((double_type *)x)->value + ((integer_type *)y)->value;
-    } else if (tx == integer_tag && ty == double_tag) {
-        s.double_t.value = ((integer_type *)x)->value + ((double_type *)y)->value;
-    } else if (tx == double_tag && ty == double_tag) {
-        s.double_t.value = ((double_type *)x)->value + ((double_type *)y)->value;
-    } else {
-        Cyc_rt_raise_msg("Bad argument type\n");
-    }
-    return s;
+#define declare_num_op(FUNC, FUNC_OP, FUNC_APPLY, OP) \
+static common_type FUNC_OP(object x, object y) { \
+    common_type s; \
+    int tx = type_of(x), ty = type_of(y); \
+    s.double_t.tag = double_tag; \
+    if (tx == integer_tag && ty == integer_tag) { \
+        s.integer_t.tag = integer_tag; \
+        s.integer_t.value = ((integer_type *)x)->value OP ((integer_type *)y)->value; \
+    } else if (tx == double_tag && ty == integer_tag) { \
+        s.double_t.value = ((double_type *)x)->value OP ((integer_type *)y)->value; \
+    } else if (tx == integer_tag && ty == double_tag) { \
+        s.double_t.value = ((integer_type *)x)->value OP ((double_type *)y)->value; \
+    } else if (tx == double_tag && ty == double_tag) { \
+        s.double_t.value = ((double_type *)x)->value OP ((double_type *)y)->value; \
+    } else { \
+        Cyc_rt_raise_msg("Bad argument type\n"); \
+    } \
+    return s; \
+} \
+static common_type FUNC(int argc, object n, ...) { \
+    va_list ap; \
+    va_start(ap, n); \
+    common_type result = Cyc_num_op_va_list(argc, FUNC_OP, n, ap); \
+    va_end(ap); \
+    return result; \
+} \
+static void FUNC_APPLY(int argc, object clo, object cont, object n, ...) { \
+    va_list ap; \
+    va_start(ap, n); \
+    common_type result = Cyc_num_op_va_list(argc - 1, FUNC_OP, n, ap); \
+    va_end(ap); \
+    return_funcall1(cont, &result); \
 }
 
+declare_num_op(Cyc_sum, Cyc_sum_op, dispatch_sum, +);
+declare_num_op(Cyc_sub, Cyc_sub_op, dispatch_sub, -);
+declare_num_op(Cyc_mul, Cyc_mul_op, dispatch_mul, *);
+// TODO: what about divide-by-zero, and casting to double when
+//       result contains a decimal component?
+declare_num_op(Cyc_div, Cyc_div_op, dispatch_div, /);
+
 static common_type Cyc_num_op_va_list(int argc, common_type (fn_op(object, object)), object n, va_list ns) {
   common_type sum;
   int i;
@@ -836,23 +857,6 @@ static common_type Cyc_num_op_va_list(int argc, common_type (fn_op(object, objec
   return sum;
 }
 
-static common_type Cyc_sum(int argc, object n, ...) {
-    va_list ap;
-    va_start(ap, n);
-    common_type result = Cyc_num_op_va_list(argc, Cyc_sum_op, n, ap);
-    va_end(ap);
-    return result;
-}
-
-static void dispatch_sum(int argc, object clo, object cont, object n, ...) {
-    va_list ap;
-    va_start(ap, n);
-    common_type result = Cyc_num_op_va_list(argc - 1, Cyc_sum_op, n, ap);
-    va_end(ap);
-    return_funcall1(cont, &result);
-}
-
-
 /* I/O functions */
 
 static port_type Cyc_io_current_input_port() {
@@ -985,21 +989,17 @@ static void _set_91cdr_67(object cont, object args) {
 static void _Cyc_91has_91cycle_127(object cont, object args) { 
     return_funcall1(cont, Cyc_has_cycle(car(args))); }
 static void __87(object cont, object args) {
-//    common_type n = Cyc_sum(car(args), cadr(args));
-//    return_funcall1(cont, &n); }
-// TODO: re-enable this to get varargs sum in eval:
     integer_type argc = Cyc_length(args);
     dispatch(argc.value, (function_type)dispatch_sum, cont, cont, args); }
 static void __91(object cont, object args) {
-    __sub(i, car(args), cadr(args));
-    return_funcall1(cont, &i); }
+    integer_type argc = Cyc_length(args);
+    dispatch(argc.value, (function_type)dispatch_sub, cont, cont, args); }
 static void __85(object cont, object args) {
-    __mul(i, car(args), cadr(args));
-    return_funcall1(cont, &i); }
+    integer_type argc = Cyc_length(args);
+    dispatch(argc.value, (function_type)dispatch_mul, cont, cont, args); }
 static void __95(object cont, object args) {
-    // TODO: check for div by 0
-    __div(i, car(args), cadr(args));
-    return_funcall1(cont, &i); }
+    integer_type argc = Cyc_length(args);
+    dispatch(argc.value, (function_type)dispatch_div, cont, cont, args); }
 static void _Cyc_91cvar_127(object cont, object args) {
     return_funcall1(cont, Cyc_is_cvar(car(args))); }
 static void _boolean_127(object cont, object args) {