urflibs/init/bootstrap/92-cond-if.f

   1 ;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
   2 ;; and now for something completely different...
   3 ;; UrForth/C Forth Engine!
   4 ;; Copyright (C) 2023 Ketmar Dark // Invisible Vector
   5 ;; GPLv3 ONLY
   6 ;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
   7
   8
   9 \ VOCABULARY ($CC-EVAL)
  10 ALSO ($CC-EVAL) DEFINITIONS
  11
  12
  13 : PARSE-NEXT-WORD  ( -- )
  14   BEGIN
  15     PARSE-SKIP-COMMENTS BL PARSE
  16   NOT-WHILE
  17     REFILL " unexpected end of file" ?NOT-ERROR
  18   REPEAT
  19   TO CURR-WORD-LEN TO CURR-WORD-ADDR
  20   \ ." |" CURR-WORD XTYPE ." |\n"
  21 ;
  22
  23 : $SKIP-CONDS-FORTH  ( toelse -- )
  24   0 >R  ( toelse | level )
  25   BEGIN
  26     PARSE-NEXT-WORD
  27     FALSE  ( toelse done? | level )
  28     CURR-WORD " [IF]" STRING:=CI IF DROP R> 1+ >R FALSE ENDIF
  29     CURR-WORD " [ENDIF]" STRING:=CI
  30     CURR-WORD " [THEN]" STRING:=CI OR
  31     IF DROP
  32       ;; in nested ifs, look only for $ENDIF
  33       R@ IF R> 1- >R FALSE
  34       ELSE
  35         ;; it doesn't matter which part we're skipping, it ends here anyway
  36         TRUE
  37       ENDIF
  38     ENDIF
  39     CURR-WORD " [ELSE]" STRING:=CI IF DROP
  40       ;; if we're skipping "true" part, go on
  41       DUP IF
  42         $IF-COUNT 1+ TO $IF-COUNT
  43         R@ 0=  \ FALSE
  44       ELSE
  45         ;; we're skipping "false" part, there should be no else
  46         " unexpected [ELSE]" ERROR
  47       ENDIF
  48     ENDIF
  49   UNTIL
  50   DROP  ;; drop `toelse`
  51   R> 0<> " oops?" ?ERROR
  52 ;
  53
  54 : $PROCESS-COND-FORTH  ( cond -- )
  55   IF $IF-COUNT 1+ TO $IF-COUNT
  56   ELSE TRUE $SKIP-CONDS-FORTH
  57   ENDIF
  58 ;
  59
  60 PREVIOUS DEFINITIONS
  61
  62
  63 : [IF]
  64   ($CC-EVAL):$PROCESS-COND-FORTH
  65 ; IMMEDIATE
  66
  67 : [ELSE]
  68   ($CC-EVAL):$IF-COUNT " unexpected [ELSE]" ?NOT-ERROR
  69   FALSE ($CC-EVAL):$SKIP-CONDS-FORTH
  70 ; IMMEDIATE
  71
  72 : [ENDIF]
  73   ($CC-EVAL):$IF-COUNT " unexpected [ENDIF]" ?NOT-ERROR
  74   ($CC-EVAL):$IF-COUNT 1- TO ($CC-EVAL):$IF-COUNT
  75 ; IMMEDIATE
  76
  77 : [THEN]
  78   ($CC-EVAL):$IF-COUNT " unexpected [THEN]" ?NOT-ERROR
  79   ($CC-EVAL):$IF-COUNT 1- TO ($CC-EVAL):$IF-COUNT
  80 ; IMMEDIATE