Imported Debian patch 21-11
[debian/pforth] / 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