usr/src/common/ficl/softcore/ifbrack.fr

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