| 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 |