git.gag.com Git - debian/pforth/blob - fth/tut.fth

   1 anew task-tut.fth
   2
   3 : SUM.OF.N.A ( N -- SUM[N] , calculate sum of N integers )
   4            0  \ starting value of SUM
   5            BEGIN
   6                OVER 0>   \ Is N greater than zero?
   7            WHILE
   8                OVER +  \ add N to sum
   9                SWAP 1- SWAP  \ decrement N
  10            REPEAT
  11            SWAP DROP  \ get rid on N
  12        ;
  13
  14 : SUM.OF.N.B  ( N -- SUM[N] )
  15     0 SWAP  \ starting value of SUM
  16     1+ 0    \ set indices for DO LOOP
  17     ?DO     \ safer than DO if N=0
  18         I +
  19     LOOP
  20 ;
  21
  22 : SUM.OF.N.C  ( N -- SUM[N] )
  23     0  \ starting value of SUM
  24     BEGIN   ( -- N' SUM )
  25         OVER +
  26         SWAP 1- SWAP
  27         OVER 0<
  28     UNTIL
  29     SWAP DROP
  30 ;
  31
  32 : SUM.OF.N.D  ( N -- SUM[N] )
  33     >R  \ put NUM on return stack
  34     0  \ starting value of SUM
  35     BEGIN   ( -- SUM )
  36         R@ +  \ add num to sum
  37         R> 1- DUP >R
  38         0<
  39     UNTIL
  40     RDROP  \ get rid of NUM
  41 ;
  42
  43 : SUM.OF.N.E  { NUM | SUM -- SUM[N] , use return stack }
  44     BEGIN
  45         NUM +-> SUM \ add NUM to SUM
  46         -1 +-> NUM  \ decrement NUM
  47         NUM 0<
  48     UNTIL
  49     SUM  \ return SUM
  50 ;
  51
  52 : SUM.OF.N.F  ( NUM -- SUM[N] , Gauss' method )
  53     DUP 1+ * 2/
  54 ;
  55
  56
  57 : TTT
  58     10 0
  59     DO
  60         I SUM.OF.N.A .
  61         I SUM.OF.N.B .
  62         I SUM.OF.N.C .
  63         I SUM.OF.N.D .
  64         I SUM.OF.N.E .
  65         I SUM.OF.N.F .
  66         CR
  67     LOOP
  68 ;
  69 TTT
  70