gforth-tutorial/13-loops.fth

\ `begin` marks the start of a loop.
\ `again` jumps back to `begin` (goto style).


: endless ( -- )
  0 begin
    dup . 1+
  again ;

endless

\ At run-time `while` consumes a flag; if it is 0, execution
\ continues behind the `repeat`; if the flag is non-zero,
\ execution continues behind the `while`. `repeat` jumps
\ back to begin, just like again.

\ `2/` is right shift by 1, which is division by 2 of
\ integers.

: log2 ( +n1 -- n2 )
  \ logarithmus dualis of n1>0, rounded down to the next
  \ integer
  assert( dup 0> )  \ `assert(` is non-standard!
  2/ 0 begin
    over 0> while
    1+ swap 2/ swap
  repeat
  nip ;


\ A version without `assert(`, simply without the check:

: log2 ( +n1 -- n2 )

  \ divide by 2 and start with a counter of 0, which is 1
  \ less than the number of divisions already performed. For
  \ example 8 log2 should be 3, since 2³=8, but the division
  \ is possible 4 times, until we reach 0: 8 is 1000, so the
  \ right shifted intermediate results will be: 1000 -> 0100
  \ -> 0010 -> 0001 -> 0000, 4 shifts.
  2/ 0
  \ So starting with 8 we have on the stack: 4 0. `begin`
  \ acts as a label we can jump to later.
  begin
    \ Copy the second cell. If the value is still greater
    \ than 0, continue with the loop. `while` will continue
    \ with the part that comes after `while`, if a -1 is on
    \ top of the stack. So the basic structure is:
    \ begin CONDITION while CONSEQUENCE repeat/again
    over 0> while
    \ We still got 4 0 on the stack in the first
    \ iteration. Calculate + 1, since we passed the
    \ condition once, so the number was divisable by 2. Then
    \ we have 4 1 on the stack.
    1+
    \ The next thing we need to do is to right shift (divide
    \ by 2) again. But the counter is the first cell, so we
    \ need to swap it with the number, to be able to right
    \ shift the number, instead of the counter.
    swap
    \ Right shift, divide by 2.
    2/
    \ Swap the numbers back again, so that the condition of
    \ `while` still works.
    swap
    \ Then repeat, until the condition becomes false.
  repeat
  \ We only want the counter to be left on the stack, so
  \ drop the number, which is at second cell.
  nip ;

7 log2 .
8 log2 .

\ `until` consumes a flag; if it is non-zero, execution
\ continues at the `begin`, otherwise after the `until`.

: log2 ( +n1 -- n2 )
  \ Start with -1, so that we are again 1 less than the
  \ possible number of shifts until the number becomes zero.
  -1
  \ Begin the loop.
  begin
    \ Increase the counter. Initially to zero.
    1+
    \ Right shift the number.
    swap 2/ swap
    \ Put the result of the <= 0 check to the top of the
    \ stack.
    over 0 <=
    \ Continue, if the condition is not yet met.
  until
  \ We only want the counter to be left on the stack, so
  \ drop the number, which is at second cell.
  nip ;


\ Assignment: Write a definition for computing the greatest
\ common divisor.

: gcd ( +n1 +n2 -- +n3 )
  begin
    .s cr
    dup 0> while
    2dup
    \ n1 n2 -> n1 n2 n1 n2
    mod
    \ n1 n2 n1 n2 -> n1 n2 remainder
    rot drop
    \ n2 remainder
  repeat
  drop ;


\ counted loops

: ^ ( n1 u -- n )
  \ n = the uth power of n1
  1
  \ 1 is the neutral element of multiplication
  \ n1 u 1
  swap
  \ swapped to get the number for the power back to the top
  \ of the stack for future operations.
  \ n1 1 u
  0
  \ put a 0 on top, so that `u+do` performs the correct
  \ number of iterations
  \ n1 1 u 0
  u+do
  \ how does `u+do` work?
  over *
loop
nip ;
3 2 ^ .
4 3 ^ .


: fac ( u -- u! )
  1
  \ 10 1
  swap
  \ 1 10
  1+
  \ 1 11
  1
  \ 1 11 1
  u+do .s cr
  \ (11 - 1 = 10 times the iteration)
  i
  .s cr
  *
loop ;
5 fac .
7 fac .

\ I found another way of looping in a counted way:

: 10count ( -- )
  \ count to 10
  10 0 ?DO
    i .
  LOOP ;

\ Leave a loop at condition becoming true:

: limited-count ( -- )
  10 0 ?DO
    i  \ put the counter on the stack
    dup .  \ output the counter
    3 =  \ check if equal to 3
    IF LEAVE
    THEN LOOP ;

\ Go in steps other than 1:

: 10-stepped-count ( -- )
  \ count to 10
  10 0 ?DO
    i .
  2 +LOOP ;

: 1024-stepped-count ( -- )
  \ count to 10
  1025 0 ?DO
    i .
  i 0 = IF 1 ELSE i THEN
  .s cr
  +LOOP ;

: counting-stepped-count ( -- )
  \ count to 10
  0  \ starting point
  10 0 ?DO
    i +
    .s cr  \ output stack
  LOOP ;

\ It seems loops can only be used inside definitions, which
\ is a bit disappointing. Is there no way to use loops
\ interactively in GForth?

\ `u+do` is a GForth extension, which ensures, that the 2
\ arguments on the stack are "correct" in the way, that
\ upper limit is greater than lower limit. If one used `?DO`
\ instead, it would run towards the maximum integer number,
\ then wrap around to negative numbers and up to the "upper"
\ limit again. `u+` stands for "unsigned positive".

: 10count ( -- )
  \ count to 10
  0  \ start at 0
  10 0  \ upper lower
  u+do
    .s cr  \ output stack
    1 +
  loop
  drop ;

\ Now try with incorrect arguments:

: 10count ( -- )
  \ count to 10
  0
  0 10  \ lower upper
  u+do
    .s cr  \ output stack
    1 +
  loop
  drop ;

\ This only prints `ok`. Try the same with `?do`. Should
\ result in an almost endless loop.

: 10count ( -- )
  \ count to 10
  0
  0 10  \ lower upper
  ?do
    .s cr  \ output stack
    1 +
  loop
  drop ;

\ Maybe this facility could be used to implement a more
\ elegant version?

: timesdo ( n1 n2 -- )
  \ do something for n1 - n2 times
  ;

\ But I have no idea how to make this word.

\ Assignment: Write a definition for computing the nth
\ Fibonacci number.

: fib-step ( u1 u2 -- u2 u)
  \ assuming we have 2 subsequent fibonacci numbers on the
  \ stack, calculate the next one
  dup  \ u1 u2 u2
  rot  \ u2 u2 u1
  +  \ u2 u3
  \ nip \ u3
;

: neg? ( n1 -- f ) 0< ;
: not ( f1 -- f ) 0= ;

: fib ( u1 -- u )
  \ calculate the nth fibonacci number:
  \ 1 1 2 3 5 8 13 21 34 55.
  \ 10 -> 55
  dup neg? not
  if
    \ put lower limit on the stack, +2, because we put the
    \ first 2 elements of the series on the stack already.
    0 2 +
    \ put series start on the stack
    1 1 2swap
    \ 1 1 u1 2
    u+do
    fib-step
    loop
    nip
  else
    ." fib only works with positive integers"
  then ;