git.gag.com Git - debian/pforth/blob - fth/condcomp.fth

   1 \ @(#) condcomp.fth 98/01/26 1.2
   2 \ Conditional Compilation support
   3 \
   4 \ Words: STRINGS= [IF] [ELSE] [THEN] EXISTS?
   5 \
   6 \ Lifted from X3J14 dpANS-6 document.
   7
   8 anew task-condcomp.fth
   9
  10 : [ELSE]  ( -- )
  11     1
  12     BEGIN                                 \ level
  13       BEGIN
  14         BL WORD                           \ level $word
  15         COUNT  DUP                        \ level adr len len
  16       WHILE                               \ level adr len
  17         2DUP  S" [IF]"  COMPARE 0=
  18         IF                                \ level adr len
  19           2DROP 1+                        \ level'
  20         ELSE                              \ level adr len
  21           2DUP  S" [ELSE]"
  22           COMPARE 0=                      \ level adr len flag
  23           IF                              \ level adr len
  24              2DROP 1- DUP IF 1+ THEN      \ level'
  25           ELSE                            \ level adr len
  26             S" [THEN]"  COMPARE 0=
  27             IF
  28               1-                          \ level'
  29             THEN
  30           THEN
  31         THEN
  32         ?DUP 0=  IF EXIT THEN             \ level'
  33       REPEAT  2DROP                       \ level
  34     REFILL 0= UNTIL                       \ level
  35     DROP
  36 ;  IMMEDIATE
  37
  38 : [IF]  ( flag -- )
  39     0=
  40     IF POSTPONE [ELSE]
  41     THEN
  42 ;  IMMEDIATE
  43
  44 : [THEN]  ( -- )
  45 ;  IMMEDIATE
  46
  47 : EXISTS? ( <name> -- flag , true if defined )
  48     bl word find
  49     nip 0<>
  50 ; immediate
  51
  52 : [DEFINED] ( <name> -- flag , true if defined, ANS )
  53     bl word find
  54     nip 0<>
  55 ; immediate
  56
  57 : [UNDEFINED] ( <name> -- flag , true if not defined, ANS )
  58     bl word find
  59     nip 0=
  60 ; immediate