( exponentiate efficiently; see http://www.reddit.com/r/Forth/comments/azyeu/dear_rforth_im_new_to_forth_and_after_learning/ )
\ : exp ( x y -- x^y )
\ dup
\ if dup 2 mod
\ if 2 / swap tuck dup * swap recurse *
\ else 2 / swap dup * swap recurse
\ endif
\ else 2drop 1
\ endif ;
\ Suppose we use the top of the return stack for one of our variables?
\ This worked the first time I tried it:
: rexp ( y x -- x^y )
>r
dup if 2 /mod swap \ y != 0; split y into y/2 and y%2
if r@ else 1 then \ factor of the base or 1, depending on y%2
swap r> recurse dup * * \ (x^(y/2))^2 multiplied by that factor
else rdrop drop 1 \ alternatively, exponent was 0, return 1
then ;
: exp ( x y -- x^y ) swap rexp ;
\ Writing it as if I were writing C, with explicit variables; this is a bit simpler.
\ Note that I don’t have to save x and y on the stack because I don't
\ refer to them after I recurse.
variable x variable y
: cexp ( x y -- x^y ) y ! x !
y @ if
y @ 2 mod if x @ else 1 then
x @ y @ 2/ recurse dup * *
else 1 then ;
\ That’s an improvement, and it also worked the first time. What if I
\ keep just one of the variables on the stack?
variable y
: cexp2 ( x y -- x^y ) y !
y @ if
y @ 2 mod if dup else 1 then
swap y @ 2/ recurse dup * *
else drop 1 then ;
\ That’s not any better, and it was buggy the first time I ran it,
\ too, because I forgot a drop. What if I keep just the other variable
\ on the stack?
variable x
: cexp3 ( x y -- x^y ) swap x !
dup if
dup 2 mod if x @ else 1 then
swap x @ swap 2/ recurse dup * *
else drop 1 then ;
\ That one was also buggy at first, and it's not really better. But,
\ you know, we use y at the beginning and end, and x in the
\ middle. What if we arrange the stack that way?
: exp2 ( x y -- x^y )
tuck dup if
2 mod if dup else 1 then
-rot swap 2/ recurse dup * *
else 2drop drop 1 then ;
\ That one also took quite a bit of debugging. What if we use the
\ return stack instead, with the same pattern?
: exp3 ( x y -- x^y )
dup >r swap >r >r
r@ if
r> 2 mod if r@ else 1 then
r> r> 2/ recurse dup * *
else rdrop rdrop rdrop 1 then ;
\ That worked the first time.