diff --git a/src/cmp/cmpnum.lsp b/src/cmp/cmpnum.lsp
index c1977e7ed..f9429bae0 100644
--- a/src/cmp/cmpnum.lsp
+++ b/src/cmp/cmpnum.lsp
@@ -77,35 +77,30 @@
       (when (and (null t2-eq) (type>= i t2))
         (setf t2-eq i output i)))))
 
-(defun prod/plus-propagator (op1 op2)
-  (multiple-value-bind (result-type op1-type op2-type)
-        (maximum-number-type (c1form-primary-type op1)
-                             (c1form-primary-type op2))
-    (when (and (eq op1-type 'FIXNUM)
-               (eq op2-type 'FIXNUM))
-      (setf result-type 'INTEGER))
-    (values (list op1-type op2-type) result-type)))
+(defun arithmetic-propagator (op1 others integer-result)
+  (loop with op1-type = (c1form-primary-type op1)
+     with result-type = (maximum-number-type op1-type op1-type)
+     with arg-types = (list (setf op1-type result-type))
+     for op2 in others
+     for op2-type = (c1form-primary-type op2)
+     do (progn
+          (multiple-value-setq (result-type op1-type op2-type)
+            (maximum-number-type op1-type op2-type))
+          (when (and (or (eq op1-type 'FIXNUM) (eq op1-type 'INTEGER))
+                     (or (eq op2-type 'FIXNUM) (eq op2-type 'INTEGER)))
+            (setf result-type integer-result))
+          (setf arg-types (cons op2-type arg-types)
+                op1-type result-type))
+     finally (return (values (nreverse arg-types) result-type))))
 
-(def-type-propagator * (fname op1 op2)
-  (prod/plus-propagator op1 op2))
+(def-type-propagator * (fname op1 &rest others)
+  (arithmetic-propagator op1 others 'integer))
 
-(def-type-propagator + (fname op1 op2)
-  (prod/plus-propagator op1 op2))
+(def-type-propagator + (fname op1 &rest others)
+  (arithmetic-propagator op1 others 'integer))
 
-(def-type-propagator - (fname op1 &optional (op2 nil op2-p))
-  (let* ((t1 (c1form-primary-type op1))
-         (t2 (if op2-p (c1form-primary-type op2) t1)))
-    (values (if op2-p (list t1 t2) (list t1))
-            (maximum-number-type t1 t2))))
+(def-type-propagator - (fname op1 &rest others)
+  (arithmetic-propagator op1 others 'integer))
 
-(def-type-propagator / (fname op1 &optional (op2 nil op2-p))
-  (multiple-value-bind (output t1 t2)
-        (let ((t1 (c1form-primary-type op1)))
-          (if op2-p
-              (maximum-number-type t1 (c1form-primary-type op2))
-              (maximum-number-type 'FIXNUM t1)))
-    (when (and (member t1 '(FIXNUM INTEGER))
-               (member t2 '(FIXNUM INTEGER)))
-      (setf output 'RATIONAL))
-    (values (if op2-p (list t1 t2) (list t1))
-            output)))
+(def-type-propagator / (fname op1 &rest others)
+  (arithmetic-propagator op1 others 'rational))