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