\ ----- GATE -----
\ Albert Nijhof - dec 2003

 forth definitions

 : } postpone exit postpone then ; immediate

 vocabulary fsa
 fsa also definitions 

 here abs constant syntax        \ Voor herkenning

 : ?syntax ( x -- ) syntax <> abort" syntax error " ;

 : onaf   cr .s true abort"  Undefined gate " ;

 : gatea  ( ccc -- body )        \ ccc = naam van een gate
   ' >body dup cell+ @ ?syntax ;

 : ifornoif ( pos/neg -- )
   0< if postpone } syntax }     \ Er komt meer.
         postpone ; swap ! ;     \ Dit was de slotregel.

 forth definitions \ De gebruikerswoorden

 : gate ( ccc -- )               \ Declareer gate ccc.
   create ['] onaf , syntax ,    \ Voor identificatie
   does>  begin @ execute
          ?dup 0= until ; \ De motor

 : == ( ccc -- gatea xt syntax ) \ Definieer gate ccc.
   gatea :noname
   syntax ;

 : -if- ( syntax -- -syntax ) ?syntax
   postpone if
   syntax negate ; immediate

 : goto ( gatea xt -+syntax ccc -- )
   dup abs ?syntax
   gatea postpone literal
   ifornoif ; immediate

 : ready ( gatea xt -+syntax -- )
   dup abs ?syntax
   postpone false
   ifornoif ; immediate

 previous forth

\  Voorbeeld met INTERPRED
\ -----Albert Nijhof - dec 2003

0 [if]

De code aan het begin dient voor het omzetten van strings naar getallen.
Om niet in details te verzanden is ondersteuning van double numbers
weggelaten. 

Typ KWIT en de zaak gaat lopen.
Je kunt KWIT weer verlaten door een fout te maken. 

[then]

(  : } postpone exit postpone then ; immediate )

   : s>cijfers ( a n -- x ) 0 0 2swap
     >number if -13 throw then 2drop ;

   : minteken? ( a n -- vlag )
     1 >   swap c@ [char] - =   and ;

   : s>number ( a n - x ) 2dup minteken?
     if   1 /string s>cijfers negate }
          s>cijfers ;

   : ?stack depth 0< if -4 throw then ;

 gate interpred
 gate compiling
 gate executing

 == interpred
  state @ -if- goto compiling
  goto executing

 == executing
  bl word dup c@ 0= -if- drop ."  ok!" ready
  find              -if- execute       goto interpred
  count s>number                       goto executing

 == compiling
  bl word dup c@ 0= -if- drop ."  ok?" ready
  find s>d          -if- drop compile, goto compiling
  ( xt imm? )       -if- execute       goto interpred
  count s>number postpone literal      goto compiling

 : kwit begin ?stack cr query interpred again ; 

\ ----- einde