Merge pull request #75 from SeekingMeaning/0BSD
[pforth] / fth / smart_if.fth
CommitLineData
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
1a088514 8\ Copyright 1994 3DO, Phil Burk, Larry Polansky, David Rosenboom
8e9db35f 9\
1f99f95d
S
10\ Permission to use, copy, modify, and/or distribute this
11\ software for any purpose with or without fee is hereby granted.
12\
13\ THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL
14\ WARRANTIES WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED
15\ WARRANTIES OF MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL
16\ THE AUTHOR BE LIABLE FOR ANY SPECIAL, DIRECT, INDIRECT, OR
17\ CONSEQUENTIAL DAMAGES OR ANY DAMAGES WHATSOEVER RESULTING
18\ FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN ACTION OF
19\ CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF
20\ OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
8e9db35f
PB
21
22anew task-smart_if.fth
23
24variable SMIF-XT \ execution token for conditional code
25variable SMIF-DEPTH \ depth of nested conditionals
26
27: SMIF{ ( -- , if executing, start compiling, setup depth )
28 state @ 0=
29 IF
30 :noname smif-xt !
31 1 smif-depth !
32 ELSE
33 1 smif-depth +!
34 THEN
35;
36
37: }SMIF ( -- , unnest, stop compiling, execute code and forget )
38 smif-xt @
39 IF
40 -1 smif-depth +!
41 smif-depth @ 0 <=
42 IF
43 postpone ; \ stop compiling
44 smif-xt @ execute \ execute conditional code
45 smif-xt @ >code dp ! \ forget conditional code
46 0 smif-xt ! \ clear so we don't mess up later
47 THEN
48 THEN
49;
50
51\ redefine conditionals to use smart mode
52: IF smif{ postpone if ; immediate
53: DO smif{ postpone do ; immediate
54: ?DO smif{ postpone ?do ; immediate
55: BEGIN smif{ postpone begin ; immediate
56: THEN postpone then }smif ; immediate
57: REPEAT postpone repeat }smif ; immediate
58: UNTIL postpone until }smif ; immediate
59: LOOP postpone loop }smif ; immediate
60: +LOOP postpone +loop }smif ; immediate