Commit | Line | Data |
---|---|---|
8e9db35f PB |
1 | \ @(#) condcomp.fth 98/01/26 1.2 |
2 | \ Conditional Compilation support | |
3 | \ | |
4 | \ Words: STRINGS= [IF] [ELSE] [THEN] EXISTS? | |
5 | \ | |
6 | \ Lifted from X3J14 dpANS-6 document. | |
7 | ||
8 | anew task-condcomp.fth | |
9 | ||
10 | : [ELSE] ( -- ) | |
11 | 1 | |
12 | BEGIN \ level | |
13 | BEGIN | |
14 | BL WORD \ level $word | |
15 | COUNT DUP \ level adr len len | |
16 | WHILE \ level adr len | |
17 | 2DUP S" [IF]" COMPARE 0= | |
18 | IF \ level adr len | |
19 | 2DROP 1+ \ level' | |
20 | ELSE \ level adr len | |
21 | 2DUP S" [ELSE]" | |
22 | COMPARE 0= \ level adr len flag | |
23 | IF \ level adr len | |
24 | 2DROP 1- DUP IF 1+ THEN \ level' | |
25 | ELSE \ level adr len | |
26 | S" [THEN]" COMPARE 0= | |
27 | IF | |
28 | 1- \ level' | |
29 | THEN | |
30 | THEN | |
31 | THEN | |
32 | ?DUP 0= IF EXIT THEN \ level' | |
33 | REPEAT 2DROP \ level | |
34 | REFILL 0= UNTIL \ level | |
35 | DROP | |
36 | ; IMMEDIATE | |
37 | ||
38 | : [IF] ( flag -- ) | |
39 | 0= | |
40 | IF POSTPONE [ELSE] | |
41 | THEN | |
42 | ; IMMEDIATE | |
43 | ||
44 | : [THEN] ( -- ) | |
45 | ; IMMEDIATE | |
46 | ||
47 | : EXISTS? ( <name> -- flag , true if defined ) | |
48 | bl word find | |
49 | swap drop | |
50 | ; immediate |