steve
/
factor
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

math.integers: remove a -rot usage

db4
Slava Pestov 2010-02-10 15:44:49 +13:00
parent 1a1a61549f
commit 1c9a95122a
2 changed files with 14 additions and 18 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
core/math/integers/integers-tests.factor
View File

@ -220,7 +220,7 @@ unit-test
1 random zero? [ >bignum ] when ; 1 random zero? [ >bignum ] when ;
[ t ] [ [ t ] [
1000 [ 10000 [
drop drop
random-integer random-integer
random-integer random-integer

30
core/math/integers/integers.factor
View File

@ -119,30 +119,26 @@ M: bignum (log2) bignum-log2 ; inline
: scale-denonimator ( den -- scaled-den scale' ) : scale-denonimator ( den -- scaled-den scale' )
dup twos neg [ shift ] keep ; inline dup twos neg [ shift ] keep ; inline
: pre-scale ( num den -- scale shifted-num scaled-den ) : pre-scale ( num den -- mantissa den' scale )
2dup [ log2 ] bi@ - 2dup [ log2 ] bi@ -
[ neg 54 + shift ] [ [ scale-denonimator ] dip + ] bi-curry bi* [ neg 54 + shift ] [ [ scale-denonimator ] dip + ] bi-curry bi* ; inline
-rot ; inline
! Second step: loop ! Second step: loop
: shift-mantissa ( scale mantissa -- scale' mantissa' ) : /f-loop ( mantissa den scale -- fraction-and-guard rem scale' )
[ 1 + ] [ 2/ ] bi* ; inline [ 2over /i log2 53 > ]
[ [ 2/ ] [ ] [ 1 + ] tri* ] while
: /f-loop ( scale mantissa den -- scale' fraction-and-guard rem ) [ /mod ] dip ; inline
[ 2dup /i log2 53 > ]
[ [ shift-mantissa ] dip ]
while /mod ; inline
! Third step: post-scaling ! Third step: post-scaling
: unscaled-float ( mantissa -- n ) : unscaled-float ( mantissa -- n )
52 2^ 1 - bitand 1022 52 shift bitor bits>double ; inline 52 2^ 1 - bitand 1022 52 shift bitor bits>double ; inline
: scale-float ( scale mantissa -- float' ) : scale-float ( mantissa scale -- float' )
[ dup 0 < [ neg 2^ recip ] [ 2^ ] if ] dip * ; inline dup 0 < [ neg 2^ recip ] [ 2^ ] if * ; inline
: post-scale ( scale mantissa -- n ) : post-scale ( mantissa scale -- n )
2/ dup log2 52 > [ shift-mantissa ] when [ 2/ ] dip over log2 52 > [ [ 2/ ] [ 1 + ] bi* ] when
unscaled-float scale-float ; inline [ unscaled-float ] dip scale-float ; inline
! Main word ! Main word
: /f-abs ( m n -- f ) : /f-abs ( m n -- f )
@ -153,8 +149,8 @@ M: bignum (log2) bignum-log2 ; inline
drop 1/0. drop 1/0.
] [ ] [
pre-scale pre-scale
/f-loop over odd? /f-loop
[ zero? [ 1 + ] unless ] [ drop ] if [ over odd? [ zero? [ 1 + ] unless ] [ drop ] if ] dip
post-scale post-scale
] if-zero ] if-zero
] if ; inline ] if ; inline