RosettaCodeData/Task/Ethiopian-multiplication/Factor/ethiopian-multiplication.factor
Ingy döt Net db842d013d A-M baby
2013-04-10 21:29:02 -07:00

17 lines
366 B
Factor

USING: arrays kernel math multiline sequences ;
IN: ethiopian-multiplication
/*
This function is built-in
: odd? ( n -- ? ) 1 bitand 1 number= ;
*/
: double ( n -- 2*n ) 2 * ;
: halve ( n -- n/2 ) 2 /i ;
: ethiopian-mult ( a b -- a*b )
[ 0 ] 2dip
[ dup 0 > ] [
[ odd? [ + ] [ drop ] if ] 2keep
[ double ] [ halve ] bi*
] while 2drop ;