Merge OneEyed's patch

[factor.git] / core / math / integers / integers.factor

diff --git a/core/math/integers/integers.factor b/core/math/integers/integers.factor
index 74a93d39bd306e50b70f6087f95716fa64ea1c90..e88caa77039fb1cb24cc792f5de53754c78a1d88 100644 (file)
--- a/core/math/integers/integers.factor
+++ b/core/math/integers/integers.factor
@@ -25,7 +25,7 @@ M: fixnum + fixnum+ ;
 M: fixnum - fixnum- ;
 M: fixnum * fixnum* ;
 M: fixnum /i fixnum/i ;
-M: fixnum /f >r >float r> >float float/f ;
+M: fixnum /f [ >float ] dip >float float/f ;
 
 M: fixnum mod fixnum-mod ;
 
@@ -40,11 +40,10 @@ M: fixnum bitnot fixnum-bitnot ;
 
 M: fixnum bit? neg shift 1 bitand 0 > ;
 
-: (fixnum-log2) ( accum n -- accum )
-    dup 1 number= [ drop ] [ >r 1+ r> 2/ (fixnum-log2) ] if ;
-    inline recursive
+: fixnum-log2 ( x -- n )
+    0 swap [ dup 1 eq? ] [ [ 1+ ] [ 2/ ] bi* ] until drop ;
 
-M: fixnum (log2) 0 swap (fixnum-log2) ;
+M: fixnum (log2) fixnum-log2 ;
 
 M: bignum >fixnum bignum>fixnum ;
 M: bignum >bignum ;
@@ -74,7 +73,7 @@ M: bignum /mod bignum/mod ;
 M: bignum bitand bignum-bitand ;
 M: bignum bitor bignum-bitor ;
 M: bignum bitxor bignum-bitxor ;
-M: bignum shift bignum-shift ;
+M: bignum shift >fixnum bignum-shift ;
 
 M: bignum bitnot bignum-bitnot ;
 M: bignum bit? bignum-bit? ;
@@ -94,7 +93,7 @@ M: bignum (log2) bignum-log2 ;
 
 : pre-scale ( num den -- scale shifted-num scaled-den )
     2dup [ log2 ] bi@ -
-    tuck [ neg 54 + shift ] [ >r scale-denonimator r> + ] 2bi*
+    [ neg 54 + shift ] [ [ scale-denonimator ] dip + ] bi-curry bi*
     -rot ; inline
 
 ! Second step: loop
@@ -103,15 +102,15 @@ M: bignum (log2) bignum-log2 ;
 
 : /f-loop ( scale mantissa den -- scale' fraction-and-guard rem )
     [ 2dup /i log2 53 > ]
-    [ >r shift-mantissa r> ]
-    [ ] while /mod ; inline
+    [ [ shift-mantissa ] dip ]
+    while /mod ; inline
 
 ! Third step: post-scaling
 : unscaled-float ( mantissa -- n )
     52 2^ 1- bitand 1022 52 shift bitor bits>double ; inline
 
 : scale-float ( scale mantissa -- float' )
-    >r dup 0 < [ neg 2^ recip ] [ 2^ ] if r> * ; inline
+    [ dup 0 < [ neg 2^ recip ] [ 2^ ] if ] dip * ; inline
 
 : post-scale ( scale mantissa -- n )
     2/ dup log2 52 > [ shift-mantissa ] when