\ FALSE compiler  Ian Osgood 2009

create vars 26 cells allot

: compile-op ( [st] str len -- [st]' str' len' )
  over c@
  case
  '%	of postpone DROP	endof
  '$	of postpone DUP		endof
  '\	of postpone SWAP	endof
  '@	of postpone ROT		endof
  'O	of postpone PICK	endof	\ 'ø
\ '(	of postpone >R		endof
\ ')	of postpone R>		endof

  '+	of postpone +		endof
  '-	of postpone -		endof
  '*	of postpone *		endof
  '/	of postpone /		endof
  '_	of postpone NEGATE	endof
  '&	of postpone AND		endof
  '|	of postpone OR		endof
  '~	of postpone INVERT	endof
\ '<	of postpone <		endof
  '=	of postpone =		endof
  '>	of postpone >		endof

  ''	of 1 /string over c@
  	   postpone LITERAL	endof
  '{	of '} scan		endof
  '"	of 1 /string 2dup '" scan \ "
  	   2swap 2 pick -
  	   postpone SLITERAL
  	   postpone TYPE	endof

  ',	of postpone EMIT	endof
  '^	of postpone KEY		endof
  '.	of 0 postpone LITERAL
           postpone .R		endof
\ 'ß 'B	flush

  ':	of postpone !		endof
  ';	of postpone @		endof

  '[	of 2>R				\ blocks: GNU Forth only
           postpone AHEAD
  	   :NONAME
  	   2R>			endof
  ']	of 2>R
  	   postpone ;      ] >R
           postpone THEN     R>
           postpone LITERAL
           2R>			endof

  '!	of postpone EXECUTE	endof
  '?	of postpone SWAP
           postpone IF
           postpone  EXECUTE
           postpone ELSE
           postpone  DROP
           postpone THEN	endof
  '#	of postpone 2>R
  	   postpone BEGIN
  	   postpone  I'			\ same as 2r@ drop
  	   postpone  EXECUTE
  	   postpone WHILE
  	   postpone  I			\ same as r@
  	   postpone  EXECUTE
  	   postpone REPEAT
  	   postpone 2RDROP	endof
  endcase ;

: compile-next ( str len -- str' len' )
  over c@ '0 '9 1+ within if
    0. 2swap >number 2swap drop
    postpone LITERAL
  else over c@ 'a 'z 1+ within if
    over c@ 'a - cells vars +
    postpone LITERAL
    1 /string
  else
    compile-op
    1 /string
  then then ;

: compile-false ( str len -- )
  begin dup while compile-next repeat 2drop
  postpone ;
  ;

: :false ( name " code" -- )
  :
  char parse
  compile-false ;

: :false-file ( name file -- )
  :
  bl parse slurp-file
  compile-false ;

\ example
:false primes " 99 9[1-$][\$@$@$@$@\/*=[1-$$[%\1-$@]?0=[\$.' ,\]?]?]#%%"