From c468ed8962b139f78ab403dccef3dc4ca19717f2 Mon Sep 17 00:00:00 2001
From: Slava Pestov <slava@slava-pestovs-macbook-pro.local>
Date: Mon, 16 Mar 2009 00:44:44 -0500
Subject: [PATCH] integer/integer partial dispatch ops now use both-fixnums?

---
 .../partial-dispatch-tests.factor             |  5 +++
 .../partial-dispatch/partial-dispatch.factor  | 34 ++++++++++++-------
 2 files changed, 27 insertions(+), 12 deletions(-)

diff --git a/basis/math/partial-dispatch/partial-dispatch-tests.factor b/basis/math/partial-dispatch/partial-dispatch-tests.factor
index bcf7bb77b0..29979b62d3 100644
--- a/basis/math/partial-dispatch/partial-dispatch-tests.factor
+++ b/basis/math/partial-dispatch/partial-dispatch-tests.factor
@@ -26,3 +26,8 @@ tools.test math kernel sequences ;
 [ fixnum-bitnot ] [ \ bitnot modular-variant ] unit-test
 [ fixnum+fast ] [ \ fixnum+ modular-variant ] unit-test
 [ fixnum+fast ] [ \ fixnum+fast modular-variant ] unit-test
+
+[ 3 ] [ 1 2 +-integer-integer ] unit-test
+[ 3 ] [ 1 >bignum 2 +-integer-integer ] unit-test
+[ 3 ] [ 1 2 >bignum +-integer-integer ] unit-test
+[ 3 ] [ 1 >bignum 2 >bignum +-integer-integer ] unit-test
\ No newline at end of file
diff --git a/basis/math/partial-dispatch/partial-dispatch.factor b/basis/math/partial-dispatch/partial-dispatch.factor
index 08cd8fb470..6679e81fcd 100644
--- a/basis/math/partial-dispatch/partial-dispatch.factor
+++ b/basis/math/partial-dispatch/partial-dispatch.factor
@@ -45,31 +45,41 @@ M: word integer-op-input-classes
         { bitnot fixnum-bitnot }
     } at swap or ;
 
+: bignum-fixnum-op-quot ( big-word -- quot )
+    '[ fixnum>bignum _ execute ] ;
+
+: fixnum-bignum-op-quot ( big-word -- quot )
+    '[ [ fixnum>bignum ] dip _ execute ] ;
+
 : integer-fixnum-op-quot ( fix-word big-word -- quot )
     [
         [ over fixnum? ] %
-        [ '[ _ execute ] , ]
-        [ '[ fixnum>bignum _ execute ] , ] bi*
-        \ if ,
+        [ '[ _ execute ] , ] [ bignum-fixnum-op-quot , ] bi* \ if ,
     ] [ ] make ;
 
 : fixnum-integer-op-quot ( fix-word big-word -- quot )
     [
         [ dup fixnum? ] %
-        [ '[ _ execute ] , ]
-        [ '[ [ fixnum>bignum ] dip _ execute ] , ] bi*
-        \ if ,
+        [ '[ _ execute ] , ] [ fixnum-bignum-op-quot , ] bi* \ if ,
+    ] [ ] make ;
+
+: integer-bignum-op-quot ( big-word -- quot )
+    [
+        [ over fixnum? ] %
+        [ fixnum-bignum-op-quot , ] [ '[ _ execute ] , ] bi \ if ,
     ] [ ] make ;
 
 : integer-integer-op-quot ( fix-word big-word -- quot )
     [
-        [ dup fixnum? ] %
-        2dup integer-fixnum-op-quot ,
+        [ 2dup both-fixnums? ] %
+        [ '[ _ execute ] , ]
         [
-            [ over fixnum? [ [ fixnum>bignum ] dip ] when ] %
-            nip ,
-        ] [ ] make ,
-        \ if ,
+            [
+                [ dup fixnum? ] %
+                [ bignum-fixnum-op-quot , ]
+                [ integer-bignum-op-quot , ] bi \ if ,
+            ] [ ] make ,
+        ] bi* \ if ,
     ] [ ] make ;
 
 : integer-op-word ( triple -- word )