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