Commit | Line | Data |
---|---|---|
8e9db35f PB |
1 | \ @(#) smart_if.fth 98/01/26 1.2 |
2 | \ Smart Conditionals | |
3 | \ Allow use of if, do, begin, etc.outside of colon definitions. | |
4 | \ | |
5 | \ Thanks to Mitch Bradley for the idea. | |
6 | \ | |
7 | \ Author: Phil Burk | |
8 | \ Copyright 1994 3DO, Phil Burk, Larry Polansky, Devid Rosenboom | |
9 | \ | |
10 | \ The pForth software code is dedicated to the public domain, | |
11 | \ and any third party may reproduce, distribute and modify | |
12 | \ the pForth software code or any derivative works thereof | |
13 | \ without any compensation or license. The pForth software | |
14 | \ code is provided on an "as is" basis without any warranty | |
15 | \ of any kind, including, without limitation, the implied | |
16 | \ warranties of merchantability and fitness for a particular | |
17 | \ purpose and their equivalents under the laws of any jurisdiction. | |
18 | ||
19 | anew task-smart_if.fth | |
20 | ||
21 | variable SMIF-XT \ execution token for conditional code | |
22 | variable SMIF-DEPTH \ depth of nested conditionals | |
23 | ||
24 | : SMIF{ ( -- , if executing, start compiling, setup depth ) | |
25 | state @ 0= | |
26 | IF | |
27 | :noname smif-xt ! | |
28 | 1 smif-depth ! | |
29 | ELSE | |
30 | 1 smif-depth +! | |
31 | THEN | |
32 | ; | |
33 | ||
34 | : }SMIF ( -- , unnest, stop compiling, execute code and forget ) | |
35 | smif-xt @ | |
36 | IF | |
37 | -1 smif-depth +! | |
38 | smif-depth @ 0 <= | |
39 | IF | |
40 | postpone ; \ stop compiling | |
41 | smif-xt @ execute \ execute conditional code | |
42 | smif-xt @ >code dp ! \ forget conditional code | |
43 | 0 smif-xt ! \ clear so we don't mess up later | |
44 | THEN | |
45 | THEN | |
46 | ; | |
47 | ||
48 | \ redefine conditionals to use smart mode | |
49 | : IF smif{ postpone if ; immediate | |
50 | : DO smif{ postpone do ; immediate | |
51 | : ?DO smif{ postpone ?do ; immediate | |
52 | : BEGIN smif{ postpone begin ; immediate | |
53 | : THEN postpone then }smif ; immediate | |
54 | : REPEAT postpone repeat }smif ; immediate | |
55 | : UNTIL postpone until }smif ; immediate | |
56 | : LOOP postpone loop }smif ; immediate | |
57 | : +LOOP postpone +loop }smif ; immediate |