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

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