CREATE BUF 0 ,
: PEEK   BUF @ 0= IF KEY BUF ! THEN BUF @ ;
: GETC   PEEK  0 BUF ! ;
: SPACE?   DUP BL = SWAP 9 14 WITHIN OR ;
: >SPACE   BEGIN PEEK SPACE? WHILE GETC DROP REPEAT ;
: DIGIT?   48 58 WITHIN ;
: >Integer   >SPACE  0
   BEGIN  PEEK DIGIT?
   WHILE  GETC [CHAR] 0 -  SWAP 10 * +  REPEAT ;
: SKIP ( xt --)
   BEGIN PEEK OVER EXECUTE WHILE GETC DROP REPEAT DROP ;
: WORD ( xt -- c-addr)  DUP >R SKIP  PAD 1+
   BEGIN PEEK R@ EXECUTE INVERT
   WHILE GETC OVER C! CHAR+
   REPEAT  R> SKIP  PAD TUCK - 1-  PAD C! ;
: INTERN ( c-addr -- c-addr)
   HERE TUCK OVER C@ CHAR+ DUP ALLOT CMOVE ;
: "?   [CHAR] " = ;
: "TYPE"   [CHAR] " EMIT  TYPE  [CHAR] " EMIT ;
: .   0 .R ;
: 3@ ( addr -- w3 w2 w1)
   [ 2 CELLS ]L + DUP @ SWAP CELL - DUP @ SWAP CELL - @ ;

CREATE BUF' 12 ALLOT
: PREPEND ( c-addr c -- c-addr)  BUF' 1+ C!
   COUNT 10 MIN DUP 1+ BUF' C!  BUF' 2 + SWAP CMOVE  BUF' ;
: >NODE ( c-addr -- n)   [CHAR] $ PREPEND  FIND
   IF EXECUTE ELSE ." unrecognized node " COUNT TYPE CR THEN ;
: NODE ( n left right -- addr)  HERE >R , , , R> ;

: CONS ( a b l -- l)  HERE >R , , , R> ;
: FIRST ( l -- a)  [ 2 CELLS ]L + @ ;
: SECOND ( l -- b)  CELL+ @ ;
: C=? ( c-addr1 c-addr2 -- t|f)  COUNT ROT COUNT COMPARE 0= ;
: LOOKUP ( c-addr l -- n t | c-addr f)
   BEGIN DUP WHILE OVER OVER FIRST C=?
     IF NIP SECOND TRUE EXIT THEN  @
   REPEAT  DROP FALSE ;

CREATE GLOBALS 0 ,  CREATE STRINGS 0 ,
: DEPTH ( pool -- n)  DUP IF SECOND 1+ THEN ;
: FISH ( c-addr pool -- n pool') TUCK LOOKUP  IF SWAP
   ELSE INTERN OVER DEPTH ROT OVER >R CONS  R> SWAP THEN ;
: >Identifier   ['] SPACE? WORD GLOBALS @ FISH GLOBALS ! ;
: >String       ['] "? WORD STRINGS @ FISH STRINGS ! ;
: >;   0 ;
: HANDLER   [CHAR] @ PREPEND  FIND DROP ;
: READER ( c-addr -- xt t | f)
   [CHAR] > PREPEND  FIND  DUP 0= IF NIP THEN ;
DEFER GETAST
: READ ( c-addr -- right left)  READER
   IF EXECUTE 0 ELSE GETAST GETAST THEN SWAP ;
: (GETAST)   ['] SPACE? WORD  DUP HANDLER >R  READ  R> NODE ;
' (GETAST) IS GETAST

CREATE PC 0 ,
: i32! ( n addr --)
   OVER           $FF AND OVER C! 1+
   OVER  8 RSHIFT $FF AND OVER C! 1+
   OVER 16 RSHIFT $FF AND OVER C! 1+
   OVER 24 RSHIFT $FF AND OVER C!    DROP DROP ;
: i32, ( n --)  HERE i32!  4 ALLOT  4 PC +! ;
: i8, ( c --)  C,  1 PC +! ;
: i8@+   DUP 1+ SWAP C@  1 PC +! ;
: i32@+ ( addr -- addr+4 n)
   i8@+                 >R  i8@+  8 LSHIFT R> OR >R
   i8@+ 16 LSHIFT R> OR >R  i8@+ 24 LSHIFT R> OR ;

CREATE #OPS 0 ,
: OP:   CREATE #OPS @ ,  1 #OPS +!  DOES> @ ;
OP: fetch  OP: store  OP: push  OP: jmp  OP: jz
OP: prtc   OP: prti   OP: prts  OP: neg  OP: not
OP: add    OP: sub    OP: mul   OP: div  OP: mod
OP: lt     OP: gt     OP: le    OP: ge
OP: eq     OP: ne     OP: and   OP: or   OP: halt

: GEN ( ast --)  3@ EXECUTE ;
: @; ( r l)  DROP DROP ;
: @Identifier   fetch i8, i32, DROP ;
: @Integer    push i8, i32, DROP ;
: @String    push i8, i32, DROP ;
: @Prtc   GEN prtc i8, DROP ;
: @Prti   GEN prti i8, DROP ;
: @Prts   GEN prts i8, DROP ;
: @Not    GEN not i8, DROP ;
: @Negate   GEN neg i8, DROP ;
: @Sequence   GEN GEN ;
: @Assign   CELL+ @ >R GEN  store i8, R> i32, ;
: @While   PC @ SWAP  GEN  jz i8, HERE >R 0 i32,
   SWAP GEN  jmp i8, i32,  PC @ R> i32! ;
: @If   GEN  jz i8, HERE >R 0 i32,
   CELL+ DUP CELL+ @ DUP @ ['] @; = IF DROP @
   ELSE SWAP @ GEN  jmp i8, HERE 0 i32,  PC @ R> i32!  >R
   THEN  GEN PC @ R> i32! ;
: BINARY   >R GEN GEN R> i8, ;
: @Subtract   sub BINARY ;  : @Add            add BINARY ;
: @Mod        mod BINARY ;  : @Multiply       mul BINARY ;
: @Divide     div BINARY ;
: @Less       lt  BINARY ;  : @LessEqual      le  BINARY ;
: @Greater    gt  BINARY ;  : @GreaterEqual   ge  BINARY ;
: @Equal      eq  BINARY ;  : @NotEqual       ne  BINARY ;
: @And        and BINARY ;  : @Or             or  BINARY ;

: REVERSE ( l -- l')  0 SWAP
   BEGIN DUP WHILE TUCK DUP @  ROT ROT  ! REPEAT  DROP ;
: .STRINGS   STRINGS @ REVERSE  BEGIN DUP
   WHILE DUP FIRST COUNT "TYPE" CR @ REPEAT DROP ;
: .HEADER ( --)
   ." Datasize: " GLOBALS @ DEPTH . SPACE
   ." Strings: "  STRINGS @ DEPTH . CR  .STRINGS ;
: GENERATE ( ast -- addr u)
   0 PC ! HERE >R  GEN halt i8,  R> PC @ ;
: ,"   [CHAR] " PARSE TUCK HERE SWAP CMOVE ALLOT ;
CREATE "OPS"
," fetch store push  jmp   jz    prtc  prti  prts  "
," neg   not   add   sub   mul   div   mod   lt    "
," gt    le    ge    eq    ne    and   or    halt  "
: .i32   i32@+ . ;
: .[i32]   [CHAR] [ EMIT .i32 [CHAR] ] EMIT ;
: .off   [CHAR] ( EMIT PC @ >R i32@+ DUP R> - . [CHAR] ) EMIT
    SPACE . ;
CREATE .INT ' .[i32] , ' .[i32] , ' .i32 , ' .off , ' .off ,
: EMIT ( addr u --)  >R 0 PC !
   BEGIN PC @ R@ <
   WHILE PC @ 5 .R SPACE  i8@+
     DUP 6 * "OPS" + 6 TYPE
     DUP 5 < IF CELLS .INT + @ EXECUTE ELSE DROP THEN CR
   REPEAT DROP R> DROP ;
GENERATE EMIT BYE