xref: /freebsd/stand/ficl/softwords/ifbrack.fr (revision 26a58599a09a6181e0f5abe624021865a0c23186)
1*ca987d46SWarner Losh\ ** ficl/softwords/ifbrack.fr
2*ca987d46SWarner Losh\ ** ANS conditional compile directives [if] [else] [then]
3*ca987d46SWarner Losh\ ** Requires ficl 2.0 or greater...
4*ca987d46SWarner Losh\
5*ca987d46SWarner Losh
6*ca987d46SWarner Loshhide
7*ca987d46SWarner Losh
8*ca987d46SWarner Losh: ?[if]   ( c-addr u -- c-addr u flag )
9*ca987d46SWarner Losh    2dup s" [if]" compare-insensitive 0=
10*ca987d46SWarner Losh;
11*ca987d46SWarner Losh
12*ca987d46SWarner Losh: ?[else]   ( c-addr u -- c-addr u flag )
13*ca987d46SWarner Losh    2dup s" [else]" compare-insensitive 0=
14*ca987d46SWarner Losh;
15*ca987d46SWarner Losh
16*ca987d46SWarner Losh: ?[then]   ( c-addr u -- c-addr u flag )
17*ca987d46SWarner Losh    2dup s" [then]" compare-insensitive 0= >r
18*ca987d46SWarner Losh    2dup s" [endif]" compare-insensitive 0= r>
19*ca987d46SWarner Losh    or
20*ca987d46SWarner Losh;
21*ca987d46SWarner Losh
22*ca987d46SWarner Loshset-current
23*ca987d46SWarner Losh
24*ca987d46SWarner Losh: [else]  ( -- )
25*ca987d46SWarner Losh    1                                     \ ( level )
26*ca987d46SWarner Losh    begin
27*ca987d46SWarner Losh      begin
28*ca987d46SWarner Losh        parse-word dup  while             \ ( level addr len )
29*ca987d46SWarner Losh        ?[if] if                          \ ( level addr len )
30*ca987d46SWarner Losh            2drop 1+                      \ ( level )
31*ca987d46SWarner Losh        else                              \ ( level addr len )
32*ca987d46SWarner Losh            ?[else] if                    \ ( level addr len )
33*ca987d46SWarner Losh                 2drop 1- dup if 1+ endif
34*ca987d46SWarner Losh            else
35*ca987d46SWarner Losh                ?[then] if 2drop 1- else 2drop endif
36*ca987d46SWarner Losh            endif
37*ca987d46SWarner Losh        endif ?dup 0=  if exit endif      \ level
38*ca987d46SWarner Losh      repeat  2drop                       \ level
39*ca987d46SWarner Losh    refill 0= until                       \ level
40*ca987d46SWarner Losh    drop
41*ca987d46SWarner Losh;  immediate
42*ca987d46SWarner Losh
43*ca987d46SWarner Losh: [if]  ( flag -- )
44*ca987d46SWarner Losh0= if postpone [else] then ;  immediate
45*ca987d46SWarner Losh
46*ca987d46SWarner Losh: [then]  ( -- )  ;  immediate
47*ca987d46SWarner Losh: [endif]  ( -- )  ;  immediate
48*ca987d46SWarner Losh
49*ca987d46SWarner Loshprevious
50